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

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

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

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