{-# 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 "")