{-# 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 = 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 = 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 = forall a. Maybe a
Nothing
    let edits :: [SearchReplace RE String]
edits = forall a. [Maybe a] -> [a]
catMaybes forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall {s}. IsRegex RE s => String -> Maybe (SearchReplace RE s)
parseLine forall a b. (a -> b) -> a -> b
$ String -> [String]
lines String
source
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) re s. [Edit m re s] -> Edits m re s
Select forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map 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
            forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) re s. [Edit m re s] -> Edits m re s
Select ([Edit Maybe RE String]
appRewriters forall a. [a] -> [a] -> [a]
++ [Edit Maybe RE String]
rewriters)
        else forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) re s. [Edit m re s] -> Edits m re s
Select [Edit Maybe RE String]
rewriters
    else forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ 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 <- forall (t :: * -> *) a b.
Traversable t =>
t a -> (a -> IO b) -> IO (t b)
forConcurrently [String]
files 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
                forall (m :: * -> *) a. Monad m => a -> m a
return 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 forall (m :: * -> *) a. Monad m => a -> m a
return []
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ 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 forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<
        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 forall a. a -> a
id URI
uri String
"")