{-# LANGUAGE RecordWildCards, PatternGuards, TemplateHaskell, CPP #-}
module Input.Settings(
Settings(..), loadSettings
) where
import Control.Exception (catch, throwIO)
import Data.List.Extra
import Data.Maybe
import Language.Haskell.TH.Syntax (lift, runIO)
import System.FilePath
import System.IO.Error (isDoesNotExistError)
import System.IO.Extra
import qualified Data.Map.Strict as Map
import Paths_hoogle
data Setting
=
RenameTag String String
|
ReorderModule String String Int
deriving Read
data Settings = Settings
{renameTag :: String -> String
,reorderModule :: String -> String -> Int
}
readFileSettings :: FilePath -> String -> IO [Setting]
readFileSettings file backup = do
src <- readFileUTF8 file `catch` \e ->
if isDoesNotExistError e
then return backup
else throwIO e
return $ concat $ zipWith f [1..] $ map trim $ lines src
where
f i s | null s = []
| "--" `isPrefixOf` s = []
| [(x,"")] <- reads s = [x]
| otherwise = error $ file ++ ":" ++ show i ++ ": Failure to parse, got: " ++ s
loadSettings :: IO Settings
loadSettings = do
dataDir <- getDataDir
#ifdef PROFILE
let backup = ""
#else
let backup = $(runIO (readFileUTF8 "misc/settings.txt") >>= lift)
#endif
src <- readFileSettings (dataDir </> "misc/settings.txt") backup
return $ createSettings src
createSettings :: [Setting] -> Settings
createSettings xs = Settings{..}
where
renameTag = \x -> fromMaybe x $ f x
where f = literals [(a,b) | RenameTag a b <- xs]
reorderModule = \pkg -> case f pkg of
[] -> const 0
xs -> let f = wildcards xs
in \mod -> last $ 0 : f mod
where f = wildcards [(a,(b,c)) | ReorderModule a b c <- xs]
literals :: [(String, a)] -> String -> Maybe a
literals xs = \x -> Map.lookup x mp
where mp = Map.fromList xs
wildcards :: [(String, a)] -> String -> [a]
wildcards xs x = [b | (a,b) <- xs, matchWildcard a x]
matchWildcard :: String -> String -> Bool
matchWildcard ['*'] ys = True
matchWildcard ('*':xs) ys = any (matchWildcard xs) $ tails ys
matchWildcard (x:xs) (y:ys) = x == y && matchWildcard xs ys
matchWildcard [] [] = True
matchWildcard _ _ = False