{-# LANGUAGE FlexibleContexts #-}
module Network.URI.PlugIns.Rewriters(parseRewriter, parseRewriters, Rewriter, applyRewriter) where

import Text.RE.Tools.Edit
import Text.RE.TDFA.String
import Network.URI (URI, uriToString, parseAbsoluteURI)
import Data.Maybe (catMaybes, fromMaybe)

import System.Directory as Dir
import System.FilePath ((</>))
import Control.Concurrent.Async (forConcurrently)

type Rewriter = Edits Maybe RE String
parseRewriter :: FilePath -> IO Rewriter
parseRewriter :: FilePath -> IO Rewriter
parseRewriter FilePath
filepath = do
    FilePath
source <- FilePath -> IO FilePath
readFile FilePath
filepath
    let parseLine :: FilePath -> Maybe (SearchReplace RE s)
parseLine FilePath
line | [FilePath
pattern, FilePath
template] <- FilePath -> [FilePath]
words FilePath
line = FilePath -> FilePath -> Maybe (SearchReplace RE s)
forall (m :: * -> *) s.
(Monad m, MonadFail m, Functor m, IsRegex RE s) =>
FilePath -> FilePath -> m (SearchReplace RE s)
compileSearchReplace FilePath
pattern FilePath
template
                | [FilePath
pattern] <- FilePath -> [FilePath]
words FilePath
line = FilePath -> FilePath -> Maybe (SearchReplace RE s)
forall (m :: * -> *) s.
(Monad m, MonadFail m, Functor m, IsRegex RE s) =>
FilePath -> FilePath -> m (SearchReplace RE s)
compileSearchReplace FilePath
pattern FilePath
"about:blank"
                | Bool
otherwise = Maybe (SearchReplace RE s)
forall a. Maybe a
Nothing
    let edits :: [SearchReplace RE FilePath]
edits = [Maybe (SearchReplace RE FilePath)] -> [SearchReplace RE FilePath]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe (SearchReplace RE FilePath)]
 -> [SearchReplace RE FilePath])
-> [Maybe (SearchReplace RE FilePath)]
-> [SearchReplace RE FilePath]
forall a b. (a -> b) -> a -> b
$ (FilePath -> Maybe (SearchReplace RE FilePath))
-> [FilePath] -> [Maybe (SearchReplace RE FilePath)]
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> Maybe (SearchReplace RE FilePath)
forall s. IsRegex RE s => FilePath -> Maybe (SearchReplace RE s)
parseLine ([FilePath] -> [Maybe (SearchReplace RE FilePath)])
-> [FilePath] -> [Maybe (SearchReplace RE FilePath)]
forall a b. (a -> b) -> a -> b
$ FilePath -> [FilePath]
lines FilePath
source
    Rewriter -> IO Rewriter
forall (m :: * -> *) a. Monad m => a -> m a
return (Rewriter -> IO Rewriter) -> Rewriter -> IO Rewriter
forall a b. (a -> b) -> a -> b
$ [Edit Maybe RE FilePath] -> Rewriter
forall (m :: * -> *) re s. [Edit m re s] -> Edits m re s
Select ([Edit Maybe RE FilePath] -> Rewriter)
-> [Edit Maybe RE FilePath] -> Rewriter
forall a b. (a -> b) -> a -> b
$ (SearchReplace RE FilePath -> Edit Maybe RE FilePath)
-> [SearchReplace RE FilePath] -> [Edit Maybe RE FilePath]
forall a b. (a -> b) -> [a] -> [b]
map SearchReplace RE FilePath -> Edit Maybe RE FilePath
forall (m :: * -> *) re s. SearchReplace re s -> Edit m re s
Template [SearchReplace RE FilePath]
edits

parseRewriters :: String -> IO Rewriter
parseRewriters :: FilePath -> IO Rewriter
parseRewriters FilePath
app = do
    FilePath
dir <- XdgDirectory -> FilePath -> IO FilePath
Dir.getXdgDirectory XdgDirectory
Dir.XdgConfig FilePath
"nz.geek.adrian.hurl"
    Bool
exists <- FilePath -> IO Bool
Dir.doesDirectoryExist FilePath
dir
    if Bool
exists then do
        [Edit Maybe RE FilePath]
rewriters <- FilePath -> IO [Edit Maybe RE FilePath]
loadRewriters FilePath
dir

        let inner :: FilePath
inner = FilePath
dir FilePath -> FilePath -> FilePath
</> FilePath
app
        Bool
innerExists <- FilePath -> IO Bool
Dir.doesDirectoryExist FilePath
dir
        if Bool
innerExists then do
            [Edit Maybe RE FilePath]
appRewriters <- FilePath -> IO [Edit Maybe RE FilePath]
loadRewriters FilePath
inner
            Rewriter -> IO Rewriter
forall (m :: * -> *) a. Monad m => a -> m a
return (Rewriter -> IO Rewriter) -> Rewriter -> IO Rewriter
forall a b. (a -> b) -> a -> b
$ [Edit Maybe RE FilePath] -> Rewriter
forall (m :: * -> *) re s. [Edit m re s] -> Edits m re s
Select ([Edit Maybe RE FilePath]
appRewriters [Edit Maybe RE FilePath]
-> [Edit Maybe RE FilePath] -> [Edit Maybe RE FilePath]
forall a. [a] -> [a] -> [a]
++ [Edit Maybe RE FilePath]
rewriters)
        else Rewriter -> IO Rewriter
forall (m :: * -> *) a. Monad m => a -> m a
return (Rewriter -> IO Rewriter) -> Rewriter -> IO Rewriter
forall a b. (a -> b) -> a -> b
$ [Edit Maybe RE FilePath] -> Rewriter
forall (m :: * -> *) re s. [Edit m re s] -> Edits m re s
Select [Edit Maybe RE FilePath]
rewriters
    else Rewriter -> IO Rewriter
forall (m :: * -> *) a. Monad m => a -> m a
return (Rewriter -> IO Rewriter) -> Rewriter -> IO Rewriter
forall a b. (a -> b) -> a -> b
$ [Edit Maybe RE FilePath] -> Rewriter
forall (m :: * -> *) re s. [Edit m re s] -> Edits m re s
Select []
  where
    loadRewriters :: FilePath -> IO [Edit Maybe RE FilePath]
loadRewriters FilePath
dir = do
        [FilePath]
files <- FilePath -> IO [FilePath]
Dir.listDirectory FilePath
dir
        [[Edit Maybe RE FilePath]]
raw <- [FilePath]
-> (FilePath -> IO [Edit Maybe RE FilePath])
-> IO [[Edit Maybe RE FilePath]]
forall (t :: * -> *) a b.
Traversable t =>
t a -> (a -> IO b) -> IO (t b)
forConcurrently [FilePath]
files ((FilePath -> IO [Edit Maybe RE FilePath])
 -> IO [[Edit Maybe RE FilePath]])
-> (FilePath -> IO [Edit Maybe RE FilePath])
-> IO [[Edit Maybe RE FilePath]]
forall a b. (a -> b) -> a -> b
$ \FilePath
file -> do
            Bool
exists <- FilePath -> IO Bool
doesFileExist FilePath
file
            if Bool
exists then do
                Rewriter
rewriter <- FilePath -> IO Rewriter
parseRewriter FilePath
file
                [Edit Maybe RE FilePath] -> IO [Edit Maybe RE FilePath]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Edit Maybe RE FilePath] -> IO [Edit Maybe RE FilePath])
-> [Edit Maybe RE FilePath] -> IO [Edit Maybe RE FilePath]
forall a b. (a -> b) -> a -> b
$ case Rewriter
rewriter of
                    Select [Edit Maybe RE FilePath]
x -> [Edit Maybe RE FilePath]
x
                    Pipe [Edit Maybe RE FilePath]
x -> [Edit Maybe RE FilePath]
x
            else [Edit Maybe RE FilePath] -> IO [Edit Maybe RE FilePath]
forall (m :: * -> *) a. Monad m => a -> m a
return []
        [Edit Maybe RE FilePath] -> IO [Edit Maybe RE FilePath]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Edit Maybe RE FilePath] -> IO [Edit Maybe RE FilePath])
-> [Edit Maybe RE FilePath] -> IO [Edit Maybe RE FilePath]
forall a b. (a -> b) -> a -> b
$ [[Edit Maybe RE FilePath]] -> [Edit Maybe RE FilePath]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Edit Maybe RE FilePath]]
raw

applyRewriter :: Rewriter -> URI -> Maybe URI
applyRewriter :: Rewriter -> URI -> Maybe URI
applyRewriter Rewriter
rewriter URI
uri = FilePath -> Maybe URI
parseAbsoluteURI (FilePath -> Maybe URI) -> Maybe FilePath -> Maybe URI
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<
        LineNo -> Rewriter -> FilePath -> Maybe FilePath
forall re s (m :: * -> *).
(IsRegex re s, Monad m, Functor m) =>
LineNo -> Edits m re s -> s -> m s
applyEdits LineNo
firstLine Rewriter
rewriter ((FilePath -> FilePath) -> URI -> FilePath -> FilePath
uriToString FilePath -> FilePath
forall a. a -> a
id URI
uri FilePath
"")