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