    {-# LANGUAGE RecordWildCards, PatternGuards, TemplateHaskell, CPP #-}

    -- | Module for reading settings files.
    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

    -- | Settings values. Later settings always override earlier settings.
    data Setting
        = -- | Given a Cabal tag/author rename it from the LHS to the RHS.
          --   If the RHS is blank, delete the tag.
          RenameTag String String
        | -- | Change the priority of a module. Given package name, module name, new priority.
          --   Use * for wildcard matches. All un-reordered modules are 0
          ReorderModule String String Int
        deriving ReadPrec [Setting]
    ReadPrec Setting
    Int -> ReadS Setting
    ReadS [Setting]
    (Int -> ReadS Setting)
    -> ReadS [Setting]
    -> ReadPrec Setting
    -> ReadPrec [Setting]
    -> Read Setting
    forall a.
    (Int -> ReadS a)
    -> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
    readListPrec :: ReadPrec [Setting]
    $creadListPrec :: ReadPrec [Setting]
    readPrec :: ReadPrec Setting
    $creadPrec :: ReadPrec Setting
    readList :: ReadS [Setting]
    $creadList :: ReadS [Setting]
    readsPrec :: Int -> ReadS Setting
    $creadsPrec :: Int -> ReadS Setting
    Read

    data Settings = Settings
        {Settings -> String -> String
    renameTag :: String -> String -- ^ Rename a cabal tag
        ,Settings -> String -> String -> Int
    reorderModule :: String -> String -> Int
        }

    readFileSettings :: FilePath -> String -> IO [Setting]
    readFileSettings :: String -> String -> IO [Setting]
    readFileSettings file :: String
    file backup :: String
    backup = do
        String
    src <- String -> IO String
    readFileUTF8 String
    file IO String -> (IOError -> IO String) -> IO String
    forall e a. Exception e => IO a -> (e -> IO a) -> IO a
    `catch` \e :: IOError
    e ->
            if IOError -> Bool
    isDoesNotExistError IOError
    e
                then String -> IO String
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure String
    backup
                else IOError -> IO String
    forall e a. Exception e => e -> IO a
    throwIO IOError
    e
        [Setting] -> IO [Setting]
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ([Setting] -> IO [Setting]) -> [Setting] -> IO [Setting]
    forall a b. (a -> b) -> a -> b
    $ [[Setting]] -> [Setting]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat ([[Setting]] -> [Setting]) -> [[Setting]] -> [Setting]
    forall a b. (a -> b) -> a -> b
    $ (Integer -> String -> [Setting])
    -> Integer -> [String] -> [[Setting]]
    forall a b c. Enum a => (a -> b -> c) -> a -> [b] -> [c]
    zipWithFrom Integer -> String -> [Setting]
    forall a a. (Read a, Show a) => a -> String -> [a]
    f 1 ([String] -> [[Setting]]) -> [String] -> [[Setting]]
    forall a b. (a -> b) -> a -> b
    $ (String -> String) -> [String] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map String -> String
    trim ([String] -> [String]) -> [String] -> [String]
    forall a b. (a -> b) -> a -> b
    $ String -> [String]
    lines String
    src
        where
            f :: a -> String -> [a]
    f i :: a
    i s :: String
    s | String -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null String
    s = []
                  | "--" String -> String -> Bool
    forall a. Eq a => [a] -> [a] -> Bool
    `isPrefixOf` String
    s = []
                  | [(x :: a
    x,"")] <- ReadS a
    forall a. Read a => ReadS a
    reads String
    s = [a
    x]
                  | Bool
    otherwise = String -> [a]
    forall a. HasCallStack => String -> a
    error (String -> [a]) -> String -> [a]
    forall a b. (a -> b) -> a -> b
    $ String
    file String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ ":" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ a -> String
    forall a. Show a => a -> String
    show a
    i String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ ": Failure to parse, got: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    s

    -- | Fix bad names in the Cabal file.
    loadSettings :: IO Settings
    loadSettings :: IO Settings
    loadSettings = do
        String
    dataDir <- IO String
    getDataDir
    #ifdef PROFILE
        -- profiling and TemplateHaskell don't play well
        let backup = ""
    #else
        let backup :: String
    backup = $(runIO (readFileUTF8 "misc/settings.txt") >>= lift)
    #endif
        [Setting]
    src <- String -> String -> IO [Setting]
    readFileSettings (String
    dataDir String -> String -> String
    </> "misc/settings.txt") String
    backup
        Settings -> IO Settings
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Settings -> IO Settings) -> Settings -> IO Settings
    forall a b. (a -> b) -> a -> b
    $ [Setting] -> Settings
    createSettings [Setting]
    src

    createSettings :: [Setting] -> Settings
    createSettings :: [Setting] -> Settings
    createSettings xs :: [Setting]
    xs = Settings :: (String -> String) -> (String -> String -> Int) -> Settings
    Settings{..}
        where
            renameTag :: String -> String
    renameTag = \x :: String
    x -> String -> Maybe String -> String
    forall a. a -> Maybe a -> a
    fromMaybe String
    x (Maybe String -> String) -> Maybe String -> String
    forall a b. (a -> b) -> a -> b
    $ String -> Maybe String
    f String
    x
                where f :: String -> Maybe String
    f = [(String, String)] -> String -> Maybe String
    forall a. [(String, a)] -> String -> Maybe a
    literals [(String
    a,String
    b) | RenameTag a :: String
    a b :: String
    b <- [Setting]
    xs]

            reorderModule :: String -> String -> Int
    reorderModule = \pkg :: String
    pkg -> case String -> [(String, Int)]
    f String
    pkg of
                                        [] -> Int -> String -> Int
    forall a b. a -> b -> a
    const 0
                                        xs :: [(String, Int)]
    xs -> let f :: String -> [Int]
    f = [(String, Int)] -> String -> [Int]
    forall a. [(String, a)] -> String -> [a]
    wildcards [(String, Int)]
    xs
                                              in \mod :: String
    mod -> Int -> [Int] -> Int
    forall a. a -> [a] -> a
    lastDef 0 (String -> [Int]
    f String
    mod)
                where f :: String -> [(String, Int)]
    f = [(String, (String, Int))] -> String -> [(String, Int)]
    forall a. [(String, a)] -> String -> [a]
    wildcards [(String
    a,(String
    b,Int
    c)) | ReorderModule a :: String
    a b :: String
    b c :: Int
    c <- [Setting]
    xs]

    ---------------------------------------------------------------------
    -- SPECIAL LOOKUPS

    literals :: [(String, a)] -> String -> Maybe a
    literals :: [(String, a)] -> String -> Maybe a
    literals xs :: [(String, a)]
    xs = \x :: String
    x -> String -> Map String a -> Maybe a
    forall k a. Ord k => k -> Map k a -> Maybe a
    Map.lookup String
    x Map String a
    mp
        where mp :: Map String a
    mp = [(String, a)] -> Map String a
    forall k a. Ord k => [(k, a)] -> Map k a
    Map.fromList [(String, a)]
    xs

    wildcards :: [(String, a)] -> String -> [a]
    wildcards :: [(String, a)] -> String -> [a]
    wildcards xs :: [(String, a)]
    xs x :: String
    x = [a
    b | (a :: String
    a,b :: a
    b) <- [(String, a)]
    xs, String -> String -> Bool
    matchWildcard String
    a String
    x]

    matchWildcard :: String -> String -> Bool
    matchWildcard :: String -> String -> Bool
    matchWildcard ['*'] ys :: String
    ys = Bool
    True -- special common case
    matchWildcard ('*':xs :: String
    xs) ys :: String
    ys = (String -> Bool) -> [String] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any (String -> String -> Bool
    matchWildcard String
    xs) ([String] -> Bool) -> [String] -> Bool
    forall a b. (a -> b) -> a -> b
    $ String -> [String]
    forall a. [a] -> [[a]]
    tails String
    ys
    matchWildcard (x :: Char
    x:xs :: String
    xs) (y :: Char
    y:ys :: String
    ys) = Char
    x Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    y Bool -> Bool -> Bool
    && String -> String -> Bool
    matchWildcard String
    xs String
    ys
    matchWildcard [] [] = Bool
    True
    matchWildcard _ _ = Bool
    False