    {-# LANGUAGE CPP, FlexibleContexts, ScopedTypeVariables, OverloadedStrings #-}
    {-
    Copyright (C) 2009 John MacFarlane <jgm@berkeley.edu>

    This program is free software; you can redistribute it and/or modify
    it under the terms of the GNU General Public License as published by
    the Free Software Foundation; either version 2 of the License, or
    (at your option) any later version.

    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    GNU General Public License for more details.

    You should have received a copy of the GNU General Public License
    along with this program; if not, write to the Free Software
    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
    -}

    {- | Functions for parsing command line options and reading the config file.
    -}

    module Network.Gitit.Config ( getConfigFromFile
                                , getConfigFromFiles
                                , getDefaultConfig
                                , readMimeTypesFile )
    where
    import Network.Gitit.Types
    import Network.Gitit.Server (mimeTypes)
    import Network.Gitit.Framework
    import Network.Gitit.Authentication (formAuthHandlers, rpxAuthHandlers, httpAuthHandlers, githubAuthHandlers)
    import Network.Gitit.Util (parsePageType, readFileUTF8)
    import System.Log.Logger (logM, Priority(..))
    import System.IO (hPutStrLn, stderr)
    import System.Exit (ExitCode(..), exitWith)
    import qualified Data.Map as M
    import Data.List (intercalate, foldl')
    import Data.Char (toLower, toUpper, isAlphaNum)
    import qualified Data.Text as T
    import Data.Text (Text)
    import Paths_gitit (getDataFileName)
    import System.FilePath ((</>))
    import Text.Pandoc hiding (ERROR, WARNING, MathJax, MathML, WebTeX, getDataFileName)
    import qualified Control.Exception as E
    import Network.OAuth.OAuth2 (OAuth2(..))
    import URI.ByteString (parseURI, laxURIParserOptions)
    import qualified Data.ByteString.Char8 as BS
    import Network.Gitit.Compat.Except
    import Control.Monad
    import Control.Monad.Trans
    import Text.Parsec
    import Text.Read (readMaybe)

    -- | Get configuration from config file.
    getConfigFromFile :: FilePath -> IO Config
    getConfigFromFile :: String -> IO Config
    getConfigFromFile String
    fname = [String] -> IO Config
    getConfigFromFiles [String
    fname]

    -- | Get configuration from config files, or default.
    getConfigFromFiles :: [FilePath] -> IO Config
    getConfigFromFiles :: [String] -> IO Config
    getConfigFromFiles [String]
    fnames = do
      -- we start with default values from the data file
      String
    cp <- String -> IO String
    getDataFileName String
    "data/default.conf"
      ConfigMap
    cfgmap <- (ConfigMap -> String -> IO ConfigMap)
    -> ConfigMap -> [String] -> IO ConfigMap
    forall (t :: * -> *) (m :: * -> *) b a.
    (Foldable t, Monad m) =>
    (b -> a -> m b) -> b -> t a -> m b
    foldM ConfigMap -> String -> IO ConfigMap
    alterConfigMap ConfigMap
    forall a. Monoid a => a
    mempty (String
    cp String -> [String] -> [String]
    forall a. a -> [a] -> [a]
    : [String]
    fnames)
      Either String Config
    res <- ExceptT String IO Config -> IO (Either String Config)
    forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
    runExceptT (ExceptT String IO Config -> IO (Either String Config))
    -> ExceptT String IO Config -> IO (Either String Config)
    forall a b. (a -> b) -> a -> b
    $ ConfigMap -> ExceptT String IO Config
    extractConfig ConfigMap
    cfgmap
      case Either String Config
    res of
        Right Config
    conf -> Config -> IO Config
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Config
    conf
        Left String
    e -> do
          Handle -> String -> IO ()
    hPutStrLn Handle
    stderr (String
    "Error parsing config:\n" String -> String -> String
    forall a. Semigroup a => a -> a -> a
    <> String
    e)
          ExitCode -> IO Config
    forall a. ExitCode -> IO a
    exitWith (Int -> ExitCode
    ExitFailure Int
    1)

    type ConfigMap = M.Map (Text, Text) Text

    alterConfigMap :: ConfigMap -> FilePath -> IO ConfigMap
    alterConfigMap :: ConfigMap -> String -> IO ConfigMap
    alterConfigMap ConfigMap
    cfmap String
    fname = do
      Text
    contents <- String -> IO Text
    readFileUTF8 String
    fname
      let contents' :: Text
    contents' = Text
    "[DEFAULT]\n" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    contents
      case String -> Text -> Either String [Section]
    parseConfig String
    fname Text
    contents' of
        Left String
    msg -> do
          Handle -> String -> IO ()
    hPutStrLn Handle
    stderr (String
    "Error parsing config " String -> String -> String
    forall a. Semigroup a => a -> a -> a
    <> String
    fname String -> String -> String
    forall a. Semigroup a => a -> a -> a
    <> String
    ":\n" String -> String -> String
    forall a. Semigroup a => a -> a -> a
    <> String
    msg)
          ExitCode -> IO ConfigMap
    forall a. ExitCode -> IO a
    exitWith (Int -> ExitCode
    ExitFailure Int
    1)
        Right [Section]
    secs -> ConfigMap -> IO ConfigMap
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (ConfigMap -> IO ConfigMap) -> ConfigMap -> IO ConfigMap
    forall a b. (a -> b) -> a -> b
    $ (ConfigMap -> Section -> ConfigMap)
    -> ConfigMap -> [Section] -> ConfigMap
    forall b a. (b -> a -> b) -> b -> [a] -> b
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl' ConfigMap -> Section -> ConfigMap
    go ConfigMap
    cfmap [Section]
    secs
          where
            go :: ConfigMap -> Section -> ConfigMap
    go ConfigMap
    cfmap' (Section Text
    name [(Text, Text)]
    fields) = (ConfigMap -> (Text, Text) -> ConfigMap)
    -> ConfigMap -> [(Text, Text)] -> ConfigMap
    forall b a. (b -> a -> b) -> b -> [a] -> b
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl' (Text -> ConfigMap -> (Text, Text) -> ConfigMap
    forall {a} {b} {a}.
    (Ord a, Ord b) =>
    a -> Map (a, b) a -> (b, a) -> Map (a, b) a
    go' Text
    name) ConfigMap
    cfmap' [(Text, Text)]
    fields
            go' :: a -> Map (a, b) a -> (b, a) -> Map (a, b) a
    go' a
    name Map (a, b) a
    cfmap' (b
    k,a
    v) = (a, b) -> a -> Map (a, b) a -> Map (a, b) a
    forall k a. Ord k => k -> a -> Map k a -> Map k a
    M.insert (a
    name, b
    k) a
    v Map (a, b) a
    cfmap'

    -- | Returns the default gitit configuration.
    getDefaultConfig :: IO Config
    getDefaultConfig :: IO Config
    getDefaultConfig = [String] -> IO Config
    getConfigFromFiles []

    data Section = Section Text [(Text, Text)]
      deriving (Int -> Section -> String -> String
    [Section] -> String -> String
    Section -> String
    (Int -> Section -> String -> String)
    -> (Section -> String)
    -> ([Section] -> String -> String)
    -> Show Section
    forall a.
    (Int -> a -> String -> String)
    -> (a -> String) -> ([a] -> String -> String) -> Show a
    $cshowsPrec :: Int -> Section -> String -> String
    showsPrec :: Int -> Section -> String -> String
    $cshow :: Section -> String
    show :: Section -> String
    $cshowList :: [Section] -> String -> String
    showList :: [Section] -> String -> String
    Show)

    parseConfig :: FilePath -> Text -> Either String [Section]
    parseConfig :: String -> Text -> Either String [Section]
    parseConfig String
    fname Text
    txt = (ParseError -> Either String [Section])
    -> ([Section] -> Either String [Section])
    -> Either ParseError [Section]
    -> Either String [Section]
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
    either (String -> Either String [Section]
    forall a b. a -> Either a b
    Left (String -> Either String [Section])
    -> (ParseError -> String) -> ParseError -> Either String [Section]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ParseError -> String
    forall a. Show a => a -> String
    show) [Section] -> Either String [Section]
    forall a b. b -> Either a b
    Right (Either ParseError [Section] -> Either String [Section])
    -> Either ParseError [Section] -> Either String [Section]
    forall a b. (a -> b) -> a -> b
    $ Parsec Text () [Section]
    -> String -> Text -> Either ParseError [Section]
    forall s t a.
    Stream s Identity t =>
    Parsec s () a -> String -> s -> Either ParseError a
    parse (ParsecT Text () Identity Section -> Parsec Text () [Section]
    forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
    many ParsecT Text () Identity Section
    pSection) String
    fname Text
    txt

    pSection :: Parsec Text () Section
    pSection :: ParsecT Text () Identity Section
    pSection = do
      ParsecT Text () Identity () -> ParsecT Text () Identity ()
    forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
    skipMany (ParsecT Text () Identity ()
    pComment ParsecT Text () Identity ()
    -> ParsecT Text () Identity () -> ParsecT Text () Identity ()
    forall s u (m :: * -> *) a.
    ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
    <|> (ParsecT Text () Identity Char
    forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
    space ParsecT Text () Identity Char
    -> ParsecT Text () Identity () -> ParsecT Text () Identity ()
    forall a b.
    ParsecT Text () Identity a
    -> ParsecT Text () Identity b -> ParsecT Text () Identity b
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
    *> ParsecT Text () Identity ()
    forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
    spaces))
      Text -> [(Text, Text)] -> Section
    Section (Text -> [(Text, Text)] -> Section)
    -> ParsecT Text () Identity Text
    -> ParsecT Text () Identity ([(Text, Text)] -> Section)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> ParsecT Text () Identity Text
    pSectionName ParsecT Text () Identity ([(Text, Text)] -> Section)
    -> ParsecT Text () Identity [(Text, Text)]
    -> ParsecT Text () Identity Section
    forall a b.
    ParsecT Text () Identity (a -> b)
    -> ParsecT Text () Identity a -> ParsecT Text () Identity b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> ParsecT Text () Identity (Text, Text)
    -> ParsecT Text () Identity [(Text, Text)]
    forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
    many ParsecT Text () Identity (Text, Text)
    pValue

    pComment :: Parsec Text () ()
    pComment :: ParsecT Text () Identity ()
    pComment = Char -> ParsecT Text () Identity Char
    forall s (m :: * -> *) u.
    Stream s m Char =>
    Char -> ParsecT s u m Char
    char Char
    '#' ParsecT Text () Identity Char
    -> ParsecT Text () Identity () -> ParsecT Text () Identity ()
    forall a b.
    ParsecT Text () Identity a
    -> ParsecT Text () Identity b -> ParsecT Text () Identity b
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
    *> ParsecT Text () Identity Char -> ParsecT Text () Identity ()
    forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
    skipMany ((Char -> Bool) -> ParsecT Text () Identity Char
    forall s (m :: * -> *) u.
    Stream s m Char =>
    (Char -> Bool) -> ParsecT s u m Char
    satisfy (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Char
    '\n')) ParsecT Text () Identity ()
    -> ParsecT Text () Identity Char -> ParsecT Text () Identity ()
    forall a b.
    ParsecT Text () Identity a
    -> ParsecT Text () Identity b -> ParsecT Text () Identity a
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
    <* ParsecT Text () Identity Char
    forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
    newline

    pKeyChar :: Parsec Text () Char
    pKeyChar :: ParsecT Text () Identity Char
    pKeyChar = (Char -> Bool) -> ParsecT Text () Identity Char
    forall s (m :: * -> *) u.
    Stream s m Char =>
    (Char -> Bool) -> ParsecT s u m Char
    satisfy (\Char
    c -> Char -> Bool
    isAlphaNum Char
    c Bool -> Bool -> Bool
    || Char
    c Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    '_' Bool -> Bool -> Bool
    || Char
    c Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    '.' Bool -> Bool -> Bool
    || Char
    c Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    '-')

    pSectionName :: Parsec Text () Text
    pSectionName :: ParsecT Text () Identity Text
    pSectionName = do
      Char -> ParsecT Text () Identity Char
    forall s (m :: * -> *) u.
    Stream s m Char =>
    Char -> ParsecT s u m Char
    char Char
    '['
      Text -> Text
    T.toUpper (Text -> Text) -> (String -> Text) -> String -> Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> Text
    T.pack (String -> Text)
    -> ParsecT Text () Identity String -> ParsecT Text () Identity Text
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> ParsecT Text () Identity Char
    -> ParsecT Text () Identity Char -> ParsecT Text () Identity String
    forall s (m :: * -> *) t u a end.
    Stream s m t =>
    ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
    manyTill ParsecT Text () Identity Char
    forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
    letter (Char -> ParsecT Text () Identity Char
    forall s (m :: * -> *) u.
    Stream s m Char =>
    Char -> ParsecT s u m Char
    char Char
    ']')

    pValue :: Parsec Text () (Text, Text)
    pValue :: ParsecT Text () Identity (Text, Text)
    pValue = ParsecT Text () Identity (Text, Text)
    -> ParsecT Text () Identity (Text, Text)
    forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
    try (ParsecT Text () Identity (Text, Text)
     -> ParsecT Text () Identity (Text, Text))
    -> ParsecT Text () Identity (Text, Text)
    -> ParsecT Text () Identity (Text, Text)
    forall a b. (a -> b) -> a -> b
    $ do
      ParsecT Text () Identity () -> ParsecT Text () Identity ()
    forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
    skipMany (ParsecT Text () Identity ()
    pComment ParsecT Text () Identity ()
    -> ParsecT Text () Identity () -> ParsecT Text () Identity ()
    forall s u (m :: * -> *) a.
    ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
    <|> (ParsecT Text () Identity Char
    forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
    space ParsecT Text () Identity Char
    -> ParsecT Text () Identity () -> ParsecT Text () Identity ()
    forall a b.
    ParsecT Text () Identity a
    -> ParsecT Text () Identity b -> ParsecT Text () Identity b
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
    *> ParsecT Text () Identity ()
    forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
    spaces))
      Text
    k <- String -> Text
    T.pack (String -> Text)
    -> ParsecT Text () Identity String -> ParsecT Text () Identity Text
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> ParsecT Text () Identity Char
    -> ParsecT Text () Identity Char -> ParsecT Text () Identity String
    forall s (m :: * -> *) t u a end.
    Stream s m t =>
    ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
    manyTill ParsecT Text () Identity Char
    pKeyChar (Char -> ParsecT Text () Identity Char
    forall s (m :: * -> *) u.
    Stream s m Char =>
    Char -> ParsecT s u m Char
    char Char
    ':')
      ParsecT Text () Identity Char -> ParsecT Text () Identity ()
    forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
    skipMany (String -> ParsecT Text () Identity Char
    forall s (m :: * -> *) u.
    Stream s m Char =>
    String -> ParsecT s u m Char
    oneOf String
    " \t")
      Text
    v <- String -> Text
    T.pack (String -> Text)
    -> ParsecT Text () Identity String -> ParsecT Text () Identity Text
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> ParsecT Text () Identity Char
    -> ParsecT Text () Identity Char -> ParsecT Text () Identity String
    forall s (m :: * -> *) t u a end.
    Stream s m t =>
    ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
    manyTill ParsecT Text () Identity Char
    forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
    anyChar ParsecT Text () Identity Char
    forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
    newline
      ParsecT Text () Identity () -> ParsecT Text () Identity ()
    forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
    skipMany (ParsecT Text () Identity ()
    pComment ParsecT Text () Identity ()
    -> ParsecT Text () Identity () -> ParsecT Text () Identity ()
    forall s u (m :: * -> *) a.
    ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
    <|> (ParsecT Text () Identity Char
    forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
    space ParsecT Text () Identity Char
    -> ParsecT Text () Identity () -> ParsecT Text () Identity ()
    forall a b.
    ParsecT Text () Identity a
    -> ParsecT Text () Identity b -> ParsecT Text () Identity b
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
    *> ParsecT Text () Identity ()
    forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
    spaces))
      Text
    vs <- [Text] -> Text
    T.unlines ([Text] -> Text)
    -> ParsecT Text () Identity [Text] -> ParsecT Text () Identity Text
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> ParsecT Text () Identity Text -> ParsecT Text () Identity [Text]
    forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
    many ParsecT Text () Identity Text
    pMultiline
      (Text, Text) -> ParsecT Text () Identity (Text, Text)
    forall a. a -> ParsecT Text () Identity a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Text -> Text
    T.toLower Text
    k, Text
    v Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    vs)

    pMultiline :: Parsec Text () Text
    pMultiline :: ParsecT Text () Identity Text
    pMultiline = ParsecT Text () Identity Text -> ParsecT Text () Identity Text
    forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
    try (ParsecT Text () Identity Text -> ParsecT Text () Identity Text)
    -> ParsecT Text () Identity Text -> ParsecT Text () Identity Text
    forall a b. (a -> b) -> a -> b
    $ do
      ParsecT Text () Identity ()
    forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
    spaces
      Char -> ParsecT Text () Identity Char
    forall s (m :: * -> *) u.
    Stream s m Char =>
    Char -> ParsecT s u m Char
    char Char
    '>'
      ParsecT Text () Identity Char -> ParsecT Text () Identity ()
    forall s (m :: * -> *) t u a.
    Stream s m t =>
    ParsecT s u m a -> ParsecT s u m ()
    optional (Char -> ParsecT Text () Identity Char
    forall s (m :: * -> *) u.
    Stream s m Char =>
    Char -> ParsecT s u m Char
    char Char
    ' ')
      String -> Text
    T.pack (String -> Text)
    -> ParsecT Text () Identity String -> ParsecT Text () Identity Text
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> ParsecT Text () Identity Char
    -> ParsecT Text () Identity Char -> ParsecT Text () Identity String
    forall s (m :: * -> *) t u a end.
    Stream s m t =>
    ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
    manyTill ParsecT Text () Identity Char
    forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
    anyChar ParsecT Text () Identity Char
    forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
    newline

    extractConfig :: ConfigMap -> ExceptT String IO Config
    extractConfig :: ConfigMap -> ExceptT String IO Config
    extractConfig ConfigMap
    cfgmap = do
      let get :: Text -> Text -> f String
    get Text
    name Text
    field = f String -> (Text -> f String) -> Maybe Text -> f String
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe (String -> f String
    forall a. a -> f a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure String
    forall a. Monoid a => a
    mempty) (String -> f String
    forall a. a -> f a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (String -> f String) -> (Text -> String) -> Text -> f String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Text -> String
    T.unpack) (Maybe Text -> f String) -> Maybe Text -> f String
    forall a b. (a -> b) -> a -> b
    $ (Text, Text) -> ConfigMap -> Maybe Text
    forall k a. Ord k => k -> Map k a -> Maybe a
    M.lookup (Text
    name, Text
    field) ConfigMap
    cfgmap
      String
    cfRepositoryType <- Text -> Text -> ExceptT String IO String
    forall {f :: * -> *}. Applicative f => Text -> Text -> f String
    get Text
    "DEFAULT" Text
    "repository-type"
      String
    cfRepositoryPath <- Text -> Text -> ExceptT String IO String
    forall {f :: * -> *}. Applicative f => Text -> Text -> f String
    get Text
    "DEFAULT" Text
    "repository-path"
      String
    cfDefaultPageType <- Text -> Text -> ExceptT String IO String
    forall {f :: * -> *}. Applicative f => Text -> Text -> f String
    get Text
    "DEFAULT" Text
    "default-page-type"
      String
    cfDefaultExtension <- Text -> Text -> ExceptT String IO String
    forall {f :: * -> *}. Applicative f => Text -> Text -> f String
    get Text
    "DEFAULT" Text
    "default-extension"
      String
    cfMathMethod <- Text -> Text -> ExceptT String IO String
    forall {f :: * -> *}. Applicative f => Text -> Text -> f String
    get Text
    "DEFAULT" Text
    "math"
      String
    cfMathjaxScript <- Text -> Text -> ExceptT String IO String
    forall {f :: * -> *}. Applicative f => Text -> Text -> f String
    get Text
    "DEFAULT" Text
    "mathjax-script"
      Bool
    cfShowLHSBirdTracks <- Text -> Text -> ExceptT String IO String
    forall {f :: * -> *}. Applicative f => Text -> Text -> f String
    get Text
    "DEFAULT" Text
    "show-lhs-bird-tracks" ExceptT String IO String
    -> (String -> ExceptT String IO Bool) -> ExceptT String IO Bool
    forall a b.
    ExceptT String IO a
    -> (a -> ExceptT String IO b) -> ExceptT String IO b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= String -> ExceptT String IO Bool
    forall (m :: * -> *). Monad m => String -> ExceptT String m Bool
    readBool
      String
    cfRequireAuthentication <- Text -> Text -> ExceptT String IO String
    forall {f :: * -> *}. Applicative f => Text -> Text -> f String
    get Text
    "DEFAULT" Text
    "require-authentication"
      String
    cfAuthenticationMethod <- Text -> Text -> ExceptT String IO String
    forall {f :: * -> *}. Applicative f => Text -> Text -> f String
    get Text
    "DEFAULT" Text
    "authentication-method"
      String
    cfUserFile <- Text -> Text -> ExceptT String IO String
    forall {f :: * -> *}. Applicative f => Text -> Text -> f String
    get Text
    "DEFAULT" Text
    "user-file"
      Int
    cfSessionTimeout <- Text -> Text -> ExceptT String IO String
    forall {f :: * -> *}. Applicative f => Text -> Text -> f String
    get Text
    "DEFAULT" Text
    "session-timeout" ExceptT String IO String
    -> (String -> ExceptT String IO Int) -> ExceptT String IO Int
    forall a b.
    ExceptT String IO a
    -> (a -> ExceptT String IO b) -> ExceptT String IO b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= String -> ExceptT String IO Int
    forall (m :: * -> *) a.
    (Monad m, Num a, Read a) =>
    String -> ExceptT String m a
    readNumber
      String
    cfTemplatesDir <- Text -> Text -> ExceptT String IO String
    forall {f :: * -> *}. Applicative f => Text -> Text -> f String
    get Text
    "DEFAULT" Text
    "templates-dir"
      String
    cfLogFile <- Text -> Text -> ExceptT String IO String
    forall {f :: * -> *}. Applicative f => Text -> Text -> f String
    get Text
    "DEFAULT" Text
    "log-file"
      String
    cfLogLevel <- Text -> Text -> ExceptT String IO String
    forall {f :: * -> *}. Applicative f => Text -> Text -> f String
    get Text
    "DEFAULT" Text
    "log-level"
      String
    cfStaticDir <- Text -> Text -> ExceptT String IO String
    forall {f :: * -> *}. Applicative f => Text -> Text -> f String
    get Text
    "DEFAULT" Text
    "static-dir"
      String
    cfPlugins <- Text -> Text -> ExceptT String IO String
    forall {f :: * -> *}. Applicative f => Text -> Text -> f String
    get Text
    "DEFAULT" Text
    "plugins"
      Bool
    cfTableOfContents <- Text -> Text -> ExceptT String IO String
    forall {f :: * -> *}. Applicative f => Text -> Text -> f String
    get Text
    "DEFAULT" Text
    "table-of-contents" ExceptT String IO String
    -> (String -> ExceptT String IO Bool) -> ExceptT String IO Bool
    forall a b.
    ExceptT String IO a
    -> (a -> ExceptT String IO b) -> ExceptT String IO b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= String -> ExceptT String IO Bool
    forall (m :: * -> *). Monad m => String -> ExceptT String m Bool
    readBool
      Integer
    cfMaxUploadSize <- Text -> Text -> ExceptT String IO String
    forall {f :: * -> *}. Applicative f => Text -> Text -> f String
    get Text
    "DEFAULT" Text
    "max-upload-size" ExceptT String IO String
    -> (String -> ExceptT String IO Integer)
    -> ExceptT String IO Integer
    forall a b.
    ExceptT String IO a
    -> (a -> ExceptT String IO b) -> ExceptT String IO b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= String -> ExceptT String IO Integer
    forall (m :: * -> *) a.
    (Monad m, Num a, Read a) =>
    String -> ExceptT String m a
    readSize
      Integer
    cfMaxPageSize <- Text -> Text -> ExceptT String IO String
    forall {f :: * -> *}. Applicative f => Text -> Text -> f String
    get Text
    "DEFAULT" Text
    "max-page-size" ExceptT String IO String
    -> (String -> ExceptT String IO Integer)
    -> ExceptT String IO Integer
    forall a b.
    ExceptT String IO a
    -> (a -> ExceptT String IO b) -> ExceptT String IO b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= String -> ExceptT String IO Integer
    forall (m :: * -> *) a.
    (Monad m, Num a, Read a) =>
    String -> ExceptT String m a
    readSize
      String
    cfAddress <- Text -> Text -> ExceptT String IO String
    forall {f :: * -> *}. Applicative f => Text -> Text -> f String
    get Text
    "DEFAULT" Text
    "address"
      Int
    cfPort <- Text -> Text -> ExceptT String IO String
    forall {f :: * -> *}. Applicative f => Text -> Text -> f String
    get Text
    "DEFAULT" Text
    "port" ExceptT String IO String
    -> (String -> ExceptT String IO Int) -> ExceptT String IO Int
    forall a b.
    ExceptT String IO a
    -> (a -> ExceptT String IO b) -> ExceptT String IO b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= String -> ExceptT String IO Int
    forall (m :: * -> *) a.
    (Monad m, Num a, Read a) =>
    String -> ExceptT String m a
    readNumber
      Bool
    cfDebugMode <- Text -> Text -> ExceptT String IO String
    forall {f :: * -> *}. Applicative f => Text -> Text -> f String
    get Text
    "DEFAULT" Text
    "debug-mode" ExceptT String IO String
    -> (String -> ExceptT String IO Bool) -> ExceptT String IO Bool
    forall a b.
    ExceptT String IO a
    -> (a -> ExceptT String IO b) -> ExceptT String IO b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= String -> ExceptT String IO Bool
    forall (m :: * -> *). Monad m => String -> ExceptT String m Bool
    readBool
      String
    cfFrontPage <- Text -> Text -> ExceptT String IO String
    forall {f :: * -> *}. Applicative f => Text -> Text -> f String
    get Text
    "DEFAULT" Text
    "front-page"
      String
    cfNoEdit <- Text -> Text -> ExceptT String IO String
    forall {f :: * -> *}. Applicative f => Text -> Text -> f String
    get Text
    "DEFAULT" Text
    "no-edit"
      String
    cfNoDelete <- Text -> Text -> ExceptT String IO String
    forall {f :: * -> *}. Applicative f => Text -> Text -> f String
    get Text
    "DEFAULT" Text
    "no-delete"
      String
    cfDefaultSummary <- Text -> Text -> ExceptT String IO String
    forall {f :: * -> *}. Applicative f => Text -> Text -> f String
    get Text
    "DEFAULT" Text
    "default-summary"
      String
    cfDeleteSummary <- Text -> Text -> ExceptT String IO String
    forall {f :: * -> *}. Applicative f => Text -> Text -> f String
    get Text
    "DEFAULT" Text
    "delete-summary"
      Bool
    cfDisableRegistration <- Text -> Text -> ExceptT String IO String
    forall {f :: * -> *}. Applicative f => Text -> Text -> f String
    get Text
    "DEFAULT" Text
    "disable-registration" ExceptT String IO String
    -> (String -> ExceptT String IO Bool) -> ExceptT String IO Bool
    forall a b.
    ExceptT String IO a
    -> (a -> ExceptT String IO b) -> ExceptT String IO b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= String -> ExceptT String IO Bool
    forall (m :: * -> *). Monad m => String -> ExceptT String m Bool
    readBool
      String
    cfAccessQuestion <- Text -> Text -> ExceptT String IO String
    forall {f :: * -> *}. Applicative f => Text -> Text -> f String
    get Text
    "DEFAULT" Text
    "access-question"
      String
    cfAccessQuestionAnswers <- Text -> Text -> ExceptT String IO String
    forall {f :: * -> *}. Applicative f => Text -> Text -> f String
    get Text
    "DEFAULT" Text
    "access-question-answers"
      Bool
    cfUseRecaptcha <- Text -> Text -> ExceptT String IO String
    forall {f :: * -> *}. Applicative f => Text -> Text -> f String
    get Text
    "DEFAULT" Text
    "use-recaptcha" ExceptT String IO String
    -> (String -> ExceptT String IO Bool) -> ExceptT String IO Bool
    forall a b.
    ExceptT String IO a
    -> (a -> ExceptT String IO b) -> ExceptT String IO b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= String -> ExceptT String IO Bool
    forall (m :: * -> *). Monad m => String -> ExceptT String m Bool
    readBool
      String
    cfRecaptchaPublicKey <- Text -> Text -> ExceptT String IO String
    forall {f :: * -> *}. Applicative f => Text -> Text -> f String
    get Text
    "DEFAULT" Text
    "recaptcha-public-key"
      String
    cfRecaptchaPrivateKey <- Text -> Text -> ExceptT String IO String
    forall {f :: * -> *}. Applicative f => Text -> Text -> f String
    get Text
    "DEFAULT" Text
    "recaptcha-private-key"
      String
    cfRPXDomain <- Text -> Text -> ExceptT String IO String
    forall {f :: * -> *}. Applicative f => Text -> Text -> f String
    get Text
    "DEFAULT" Text
    "rpx-domain"
      String
    cfRPXKey <- Text -> Text -> ExceptT String IO String
    forall {f :: * -> *}. Applicative f => Text -> Text -> f String
    get Text
    "DEFAULT" Text
    "rpx-key"
      Bool
    cfCompressResponses <- Text -> Text -> ExceptT String IO String
    forall {f :: * -> *}. Applicative f => Text -> Text -> f String
    get Text
    "DEFAULT" Text
    "compress-responses" ExceptT String IO String
    -> (String -> ExceptT String IO Bool) -> ExceptT String IO Bool
    forall a b.
    ExceptT String IO a
    -> (a -> ExceptT String IO b) -> ExceptT String IO b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= String -> ExceptT String IO Bool
    forall (m :: * -> *). Monad m => String -> ExceptT String m Bool
    readBool
      Bool
    cfUseCache <- Text -> Text -> ExceptT String IO String
    forall {f :: * -> *}. Applicative f => Text -> Text -> f String
    get Text
    "DEFAULT" Text
    "use-cache" ExceptT String IO String
    -> (String -> ExceptT String IO Bool) -> ExceptT String IO Bool
    forall a b.
    ExceptT String IO a
    -> (a -> ExceptT String IO b) -> ExceptT String IO b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= String -> ExceptT String IO Bool
    forall (m :: * -> *). Monad m => String -> ExceptT String m Bool
    readBool
      String
    cfCacheDir <- Text -> Text -> ExceptT String IO String
    forall {f :: * -> *}. Applicative f => Text -> Text -> f String
    get Text
    "DEFAULT" Text
    "cache-dir"
      String
    cfMimeTypesFile <- Text -> Text -> ExceptT String IO String
    forall {f :: * -> *}. Applicative f => Text -> Text -> f String
    get Text
    "DEFAULT" Text
    "mime-types-file"
      String
    cfMailCommand <- Text -> Text -> ExceptT String IO String
    forall {f :: * -> *}. Applicative f => Text -> Text -> f String
    get Text
    "DEFAULT" Text
    "mail-command"
      String
    cfResetPasswordMessage <- Text -> Text -> ExceptT String IO String
    forall {f :: * -> *}. Applicative f => Text -> Text -> f String
    get Text
    "DEFAULT" Text
    "reset-password-message"
      Bool
    cfUseFeed <- Text -> Text -> ExceptT String IO String
    forall {f :: * -> *}. Applicative f => Text -> Text -> f String
    get Text
    "DEFAULT" Text
    "use-feed" ExceptT String IO String
    -> (String -> ExceptT String IO Bool) -> ExceptT String IO Bool
    forall a b.
    ExceptT String IO a
    -> (a -> ExceptT String IO b) -> ExceptT String IO b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= String -> ExceptT String IO Bool
    forall (m :: * -> *). Monad m => String -> ExceptT String m Bool
    readBool
      String
    cfBaseUrl <- Text -> Text -> ExceptT String IO String
    forall {f :: * -> *}. Applicative f => Text -> Text -> f String
    get Text
    "DEFAULT" Text
    "base-url"
      Bool
    cfAbsoluteUrls <- Text -> Text -> ExceptT String IO String
    forall {f :: * -> *}. Applicative f => Text -> Text -> f String
    get Text
    "DEFAULT" Text
    "absolute-urls" ExceptT String IO String
    -> (String -> ExceptT String IO Bool) -> ExceptT String IO Bool
    forall a b.
    ExceptT String IO a
    -> (a -> ExceptT String IO b) -> ExceptT String IO b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= String -> ExceptT String IO Bool
    forall (m :: * -> *). Monad m => String -> ExceptT String m Bool
    readBool
      String
    cfWikiTitle <- Text -> Text -> ExceptT String IO String
    forall {f :: * -> *}. Applicative f => Text -> Text -> f String
    get Text
    "DEFAULT" Text
    "wiki-title"
      Integer
    cfFeedDays <- Text -> Text -> ExceptT String IO String
    forall {f :: * -> *}. Applicative f => Text -> Text -> f String
    get Text
    "DEFAULT" Text
    "feed-days" ExceptT String IO String
    -> (String -> ExceptT String IO Integer)
    -> ExceptT String IO Integer
    forall a b.
    ExceptT String IO a
    -> (a -> ExceptT String IO b) -> ExceptT String IO b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= String -> ExceptT String IO Integer
    forall (m :: * -> *) a.
    (Monad m, Num a, Read a) =>
    String -> ExceptT String m a
    readNumber
      Integer
    cfFeedRefreshTime <- Text -> Text -> ExceptT String IO String
    forall {f :: * -> *}. Applicative f => Text -> Text -> f String
    get Text
    "DEFAULT" Text
    "feed-refresh-time" ExceptT String IO String
    -> (String -> ExceptT String IO Integer)
    -> ExceptT String IO Integer
    forall a b.
    ExceptT String IO a
    -> (a -> ExceptT String IO b) -> ExceptT String IO b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= String -> ExceptT String IO Integer
    forall (m :: * -> *) a.
    (Monad m, Num a, Read a) =>
    String -> ExceptT String m a
    readNumber
      String
    cfPandocUserData <- Text -> Text -> ExceptT String IO String
    forall {f :: * -> *}. Applicative f => Text -> Text -> f String
    get Text
    "DEFAULT" Text
    "pandoc-user-data"
      Bool
    cfXssSanitize <- Text -> Text -> ExceptT String IO String
    forall {f :: * -> *}. Applicative f => Text -> Text -> f String
    get Text
    "DEFAULT" Text
    "xss-sanitize" ExceptT String IO String
    -> (String -> ExceptT String IO Bool) -> ExceptT String IO Bool
    forall a b.
    ExceptT String IO a
    -> (a -> ExceptT String IO b) -> ExceptT String IO b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= String -> ExceptT String IO Bool
    forall (m :: * -> *). Monad m => String -> ExceptT String m Bool
    readBool
      Int
    cfRecentActivityDays <- Text -> Text -> ExceptT String IO String
    forall {f :: * -> *}. Applicative f => Text -> Text -> f String
    get Text
    "DEFAULT" Text
    "recent-activity-days" ExceptT String IO String
    -> (String -> ExceptT String IO Int) -> ExceptT String IO Int
    forall a b.
    ExceptT String IO a
    -> (a -> ExceptT String IO b) -> ExceptT String IO b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= String -> ExceptT String IO Int
    forall (m :: * -> *) a.
    (Monad m, Num a, Read a) =>
    String -> ExceptT String m a
    readNumber
      let (PageType
    pt, Bool
    lhs) = String -> (PageType, Bool)
    parsePageType String
    cfDefaultPageType
      let markupHelpFile :: String
    markupHelpFile = PageType -> String
    forall a. Show a => a -> String
    show PageType
    pt String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ if Bool
    lhs then String
    "+LHS" else String
    ""
      String
    markupHelpPath <- IO String -> ExceptT String IO String
    forall a. IO a -> ExceptT String IO a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO String -> ExceptT String IO String)
    -> IO String -> ExceptT String IO String
    forall a b. (a -> b) -> a -> b
    $ String -> IO String
    getDataFileName (String -> IO String) -> String -> IO String
    forall a b. (a -> b) -> a -> b
    $ String
    "data" String -> String -> String
    </> String
    "markupHelp" String -> String -> String
    </> String
    markupHelpFile
      Text
    markupHelp' <- IO Text -> ExceptT String IO Text
    forall a. IO a -> ExceptT String IO a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO Text -> ExceptT String IO Text)
    -> IO Text -> ExceptT String IO Text
    forall a b. (a -> b) -> a -> b
    $ String -> IO Text
    readFileUTF8 String
    markupHelpPath
      Text
    markupHelpText <- IO Text -> ExceptT String IO Text
    forall a. IO a -> ExceptT String IO a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO Text -> ExceptT String IO Text)
    -> IO Text -> ExceptT String IO Text
    forall a b. (a -> b) -> a -> b
    $ Either PandocError Text -> IO Text
    forall a. Either PandocError a -> IO a
    handleError (Either PandocError Text -> IO Text)
    -> Either PandocError Text -> IO Text
    forall a b. (a -> b) -> a -> b
    $ PandocPure Text -> Either PandocError Text
    forall a. PandocPure a -> Either PandocError a
    runPure (PandocPure Text -> Either PandocError Text)
    -> PandocPure Text -> Either PandocError Text
    forall a b. (a -> b) -> a -> b
    $ do
        Pandoc
    helpDoc <- ReaderOptions -> Text -> PandocPure Pandoc
    forall (m :: * -> *) a.
    (PandocMonad m, ToSources a) =>
    ReaderOptions -> a -> m Pandoc
    readMarkdown ReaderOptions
    forall a. Default a => a
    def{ readerExtensions = getDefaultExtensions "markdown" } Text
    markupHelp'
        WriterOptions -> Pandoc -> PandocPure Text
    forall (m :: * -> *).
    PandocMonad m =>
    WriterOptions -> Pandoc -> m Text
    writeHtml5String WriterOptions
    forall a. Default a => a
    def Pandoc
    helpDoc

      Map String String
    mimeMap' <- IO (Map String String) -> ExceptT String IO (Map String String)
    forall a. IO a -> ExceptT String IO a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO (Map String String) -> ExceptT String IO (Map String String))
    -> IO (Map String String) -> ExceptT String IO (Map String String)
    forall a b. (a -> b) -> a -> b
    $ String -> IO (Map String String)
    readMimeTypesFile String
    cfMimeTypesFile
      let authMethod :: String
    authMethod = (Char -> Char) -> String -> String
    forall a b. (a -> b) -> [a] -> [b]
    map Char -> Char
    toLower String
    cfAuthenticationMethod
      let stripTrailingSlash :: String -> String
    stripTrailingSlash = String -> String
    forall a. [a] -> [a]
    reverse (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Char -> Bool) -> String -> String
    forall a. (a -> Bool) -> [a] -> [a]
    dropWhile (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    ==Char
    '/') (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String
    forall a. [a] -> [a]
    reverse
      FileStoreType
    repotype' <- case (Char -> Char) -> String -> String
    forall a b. (a -> b) -> [a] -> [b]
    map Char -> Char
    toLower String
    cfRepositoryType of
                        String
    "git"       -> FileStoreType -> ExceptT String IO FileStoreType
    forall a. a -> ExceptT String IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure FileStoreType
    Git
                        String
    "darcs"     -> FileStoreType -> ExceptT String IO FileStoreType
    forall a. a -> ExceptT String IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure FileStoreType
    Darcs
                        String
    "mercurial" -> FileStoreType -> ExceptT String IO FileStoreType
    forall a. a -> ExceptT String IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure FileStoreType
    Mercurial
                        String
    x           -> String -> ExceptT String IO FileStoreType
    forall a. String -> ExceptT String IO a
    forall e (m :: * -> *) a. MonadError e m => e -> m a
    throwError (String -> ExceptT String IO FileStoreType)
    -> String -> ExceptT String IO FileStoreType
    forall a b. (a -> b) -> a -> b
    $ String
    "Unknown repository type: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    x
      Bool -> ExceptT String IO () -> ExceptT String IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (String
    authMethod String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    == String
    "rpx" Bool -> Bool -> Bool
    && String
    cfRPXDomain String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    == String
    "") (ExceptT String IO () -> ExceptT String IO ())
    -> ExceptT String IO () -> ExceptT String IO ()
    forall a b. (a -> b) -> a -> b
    $
         IO () -> ExceptT String IO ()
    forall a. IO a -> ExceptT String IO a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> ExceptT String IO ()) -> IO () -> ExceptT String IO ()
    forall a b. (a -> b) -> a -> b
    $ String -> Priority -> String -> IO ()
    logM String
    "gitit" Priority
    WARNING String
    "rpx-domain is not set"

      GithubConfig
    ghConfig <- ConfigMap -> ExceptT String IO GithubConfig
    extractGithubConfig ConfigMap
    cfgmap

      Bool -> ExceptT String IO () -> ExceptT String IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (String -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null String
    cfUserFile) (ExceptT String IO () -> ExceptT String IO ())
    -> ExceptT String IO () -> ExceptT String IO ()
    forall a b. (a -> b) -> a -> b
    $
         IO () -> ExceptT String IO ()
    forall a. IO a -> ExceptT String IO a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> ExceptT String IO ()) -> IO () -> ExceptT String IO ()
    forall a b. (a -> b) -> a -> b
    $ String -> Priority -> String -> IO ()
    logM String
    "gitit" Priority
    ERROR String
    "user-file is empty"

      Config -> ExceptT String IO Config
    forall a. a -> ExceptT String IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Config{
          repositoryPath :: String
    repositoryPath       = String
    cfRepositoryPath
        , repositoryType :: FileStoreType
    repositoryType       = FileStoreType
    repotype'
        , defaultPageType :: PageType
    defaultPageType      = PageType
    pt
        , defaultExtension :: String
    defaultExtension     = String
    cfDefaultExtension
        , mathMethod :: MathMethod
    mathMethod           = case (Char -> Char) -> String -> String
    forall a b. (a -> b) -> [a] -> [b]
    map Char -> Char
    toLower String
    cfMathMethod of
                                      String
    "mathml"   -> MathMethod
    MathML
                                      String
    "mathjax"  -> String -> MathMethod
    MathJax String
    cfMathjaxScript
                                      String
    "google"   -> String -> MathMethod
    WebTeX String
    "http://chart.apis.google.com/chart?cht=tx&chl="
                                      String
    _          -> MathMethod
    RawTeX
        , defaultLHS :: Bool
    defaultLHS           = Bool
    lhs
        , showLHSBirdTracks :: Bool
    showLHSBirdTracks    = Bool
    cfShowLHSBirdTracks
        , withUser :: Handler -> Handler
    withUser             = case String
    authMethod of
                                      String
    "form"     -> Handler -> Handler
    withUserFromSession
                                      String
    "github"   -> Handler -> Handler
    withUserFromSession
                                      String
    "http"     -> Handler -> Handler
    withUserFromHTTPAuth
                                      String
    "rpx"      -> Handler -> Handler
    withUserFromSession
                                      String
    _          -> Handler -> Handler
    forall a. a -> a
    id
        , requireAuthentication :: AuthenticationLevel
    requireAuthentication = case (Char -> Char) -> String -> String
    forall a b. (a -> b) -> [a] -> [b]
    map Char -> Char
    toLower String
    cfRequireAuthentication of
                                       String
    "none"    -> AuthenticationLevel
    Never
                                       String
    "modify"  -> AuthenticationLevel
    ForModify
                                       String
    "read"    -> AuthenticationLevel
    ForRead
                                       String
    _         -> AuthenticationLevel
    ForModify

        , authHandler :: Handler
    authHandler          = case String
    authMethod of
                                      String
    "form"     -> [Handler] -> Handler
    forall (t :: * -> *) (m :: * -> *) a.
    (Foldable t, MonadPlus m) =>
    t (m a) -> m a
    msum ([Handler] -> Handler) -> [Handler] -> Handler
    forall a b. (a -> b) -> a -> b
    $ Bool -> [Handler]
    formAuthHandlers Bool
    cfDisableRegistration
                                      String
    "github"   -> [Handler] -> Handler
    forall (t :: * -> *) (m :: * -> *) a.
    (Foldable t, MonadPlus m) =>
    t (m a) -> m a
    msum ([Handler] -> Handler) -> [Handler] -> Handler
    forall a b. (a -> b) -> a -> b
    $ GithubConfig -> [Handler]
    githubAuthHandlers GithubConfig
    ghConfig
                                      String
    "http"     -> [Handler] -> Handler
    forall (t :: * -> *) (m :: * -> *) a.
    (Foldable t, MonadPlus m) =>
    t (m a) -> m a
    msum [Handler]
    httpAuthHandlers
                                      String
    "rpx"      -> [Handler] -> Handler
    forall (t :: * -> *) (m :: * -> *) a.
    (Foldable t, MonadPlus m) =>
    t (m a) -> m a
    msum [Handler]
    rpxAuthHandlers
                                      String
    _          -> Handler
    forall a. ServerPartT (ReaderT WikiState IO) a
    forall (m :: * -> *) a. MonadPlus m => m a
    mzero
        , userFile :: String
    userFile             = String
    cfUserFile
        , sessionTimeout :: Int
    sessionTimeout       = Int
    cfSessionTimeout Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    60  -- convert minutes -> seconds
        , templatesDir :: String
    templatesDir         = String
    cfTemplatesDir
        , logFile :: String
    logFile              = String
    cfLogFile
        , logLevel :: Priority
    logLevel             = let levelString :: String
    levelString = (Char -> Char) -> String -> String
    forall a b. (a -> b) -> [a] -> [b]
    map Char -> Char
    toUpper String
    cfLogLevel
                                     levels :: [String]
    levels = [String
    "DEBUG", String
    "INFO", String
    "NOTICE", String
    "WARNING", String
    "ERROR",
                                               String
    "CRITICAL", String
    "ALERT", String
    "EMERGENCY"]
                                 in  if String
    levelString String -> [String] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [String]
    levels
                                        then String -> Priority
    forall a. Read a => String -> a
    read String
    levelString
                                        else String -> Priority
    forall a. HasCallStack => String -> a
    error (String -> Priority) -> String -> Priority
    forall a b. (a -> b) -> a -> b
    $ String
    "Invalid log-level.\nLegal values are: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String -> [String] -> String
    forall a. [a] -> [[a]] -> [a]
    intercalate String
    ", " [String]
    levels
        , staticDir :: String
    staticDir            = String
    cfStaticDir
        , pluginModules :: [String]
    pluginModules        = String -> [String]
    splitCommaList String
    cfPlugins
        , tableOfContents :: Bool
    tableOfContents      = Bool
    cfTableOfContents
        , maxUploadSize :: Integer
    maxUploadSize        = Integer
    cfMaxUploadSize
        , maxPageSize :: Integer
    maxPageSize          = Integer
    cfMaxPageSize
        , address :: String
    address              = String
    cfAddress
        , portNumber :: Int
    portNumber           = Int
    cfPort
        , debugMode :: Bool
    debugMode            = Bool
    cfDebugMode
        , frontPage :: String
    frontPage            = String
    cfFrontPage
        , noEdit :: [String]
    noEdit               = String -> [String]
    splitCommaList String
    cfNoEdit
        , noDelete :: [String]
    noDelete             = String -> [String]
    splitCommaList String
    cfNoDelete
        , defaultSummary :: String
    defaultSummary       = String
    cfDefaultSummary
        , deleteSummary :: String
    deleteSummary        = String
    cfDeleteSummary
        , disableRegistration :: Bool
    disableRegistration  = Bool
    cfDisableRegistration
        , accessQuestion :: Maybe (String, [String])
    accessQuestion       = if String -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null String
    cfAccessQuestion
                                    then Maybe (String, [String])
    forall a. Maybe a
    Nothing
                                    else (String, [String]) -> Maybe (String, [String])
    forall a. a -> Maybe a
    Just (String
    cfAccessQuestion,
                                               String -> [String]
    splitCommaList String
    cfAccessQuestionAnswers)
        , useRecaptcha :: Bool
    useRecaptcha         = Bool
    cfUseRecaptcha
        , recaptchaPublicKey :: String
    recaptchaPublicKey   = String
    cfRecaptchaPublicKey
        , recaptchaPrivateKey :: String
    recaptchaPrivateKey  = String
    cfRecaptchaPrivateKey
        , rpxDomain :: String
    rpxDomain            = String
    cfRPXDomain
        , rpxKey :: String
    rpxKey               = String
    cfRPXKey
        , compressResponses :: Bool
    compressResponses    = Bool
    cfCompressResponses
        , useCache :: Bool
    useCache             = Bool
    cfUseCache
        , cacheDir :: String
    cacheDir             = String
    cfCacheDir
        , mimeMap :: Map String String
    mimeMap              = Map String String
    mimeMap'
        , mailCommand :: String
    mailCommand          = String
    cfMailCommand
        , resetPasswordMessage :: String
    resetPasswordMessage = String
    cfResetPasswordMessage
        , markupHelp :: Text
    markupHelp           = Text
    markupHelpText
        , useFeed :: Bool
    useFeed              = Bool
    cfUseFeed
        , baseUrl :: String
    baseUrl              = String -> String
    stripTrailingSlash String
    cfBaseUrl
        , useAbsoluteUrls :: Bool
    useAbsoluteUrls      = Bool
    cfAbsoluteUrls
        , wikiTitle :: String
    wikiTitle            = String
    cfWikiTitle
        , feedDays :: Integer
    feedDays             = Integer
    cfFeedDays
        , feedRefreshTime :: Integer
    feedRefreshTime      = Integer
    cfFeedRefreshTime
        , pandocUserData :: Maybe String
    pandocUserData       = if String -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null String
    cfPandocUserData
                                    then Maybe String
    forall a. Maybe a
    Nothing
                                    else String -> Maybe String
    forall a. a -> Maybe a
    Just String
    cfPandocUserData
        , xssSanitize :: Bool
    xssSanitize          = Bool
    cfXssSanitize
        , recentActivityDays :: Int
    recentActivityDays   = Int
    cfRecentActivityDays
        , githubAuth :: GithubConfig
    githubAuth           = GithubConfig
    ghConfig
        }

    extractGithubConfig ::  ConfigMap -> ExceptT String IO GithubConfig
    extractGithubConfig :: ConfigMap -> ExceptT String IO GithubConfig
    extractGithubConfig ConfigMap
    cfgmap = do
      String
    cfOauthClientId <- Text -> ExceptT String IO String
    getGithubProp Text
    "oauthclientid"
      String
    cfOauthClientSecret <- Text -> ExceptT String IO String
    getGithubProp Text
    "oauthclientsecret"
      URIRef Absolute
    cfOauthCallback <- Text -> ExceptT String IO (URIRef Absolute)
    getUrlProp Text
    "oauthcallback"
      URIRef Absolute
    cfOauthOAuthorizeEndpoint  <- Text -> ExceptT String IO (URIRef Absolute)
    getUrlProp Text
    "oauthoauthorizeendpoint"
      URIRef Absolute
    cfOauthAccessTokenEndpoint <- Text -> ExceptT String IO (URIRef Absolute)
    getUrlProp Text
    "oauthaccesstokenendpoint"
      String
    cfOrg' <- Text -> ExceptT String IO String
    getGithubProp Text
    "github-org"
      let cfOrg :: Maybe String
    cfOrg = if String -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null String
    cfOrg'
                    then String -> Maybe String
    forall a. a -> Maybe a
    Just String
    cfOrg'
                    else Maybe String
    forall a. Maybe a
    Nothing
      let cfgOAuth2 :: OAuth2
    cfgOAuth2 = OAuth2 {
                            oauth2ClientId :: Text
    oauth2ClientId = String -> Text
    T.pack String
    cfOauthClientId
                          , oauth2ClientSecret :: Text
    oauth2ClientSecret = String -> Text
    T.pack String
    cfOauthClientSecret
                          , oauth2RedirectUri :: URIRef Absolute
    oauth2RedirectUri = URIRef Absolute
    cfOauthCallback
                          , oauth2AuthorizeEndpoint :: URIRef Absolute
    oauth2AuthorizeEndpoint = URIRef Absolute
    cfOauthOAuthorizeEndpoint
                          , oauth2TokenEndpoint :: URIRef Absolute
    oauth2TokenEndpoint = URIRef Absolute
    cfOauthAccessTokenEndpoint
                          }
      GithubConfig -> ExceptT String IO GithubConfig
    forall a. a -> ExceptT String IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (GithubConfig -> ExceptT String IO GithubConfig)
    -> GithubConfig -> ExceptT String IO GithubConfig
    forall a b. (a -> b) -> a -> b
    $ OAuth2 -> Maybe Text -> GithubConfig
    githubConfig OAuth2
    cfgOAuth2 (Maybe Text -> GithubConfig) -> Maybe Text -> GithubConfig
    forall a b. (a -> b) -> a -> b
    $ (String -> Text) -> Maybe String -> Maybe Text
    forall a b. (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap String -> Text
    T.pack Maybe String
    cfOrg
     where
      get :: Text -> Text -> f String
    get Text
    name Text
    field = f String -> (Text -> f String) -> Maybe Text -> f String
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe (String -> f String
    forall a. a -> f a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure String
    forall a. Monoid a => a
    mempty) (String -> f String
    forall a. a -> f a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (String -> f String) -> (Text -> String) -> Text -> f String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Text -> String
    T.unpack) (Maybe Text -> f String) -> Maybe Text -> f String
    forall a b. (a -> b) -> a -> b
    $ (Text, Text) -> ConfigMap -> Maybe Text
    forall k a. Ord k => k -> Map k a -> Maybe a
    M.lookup (Text
    name, Text
    field) ConfigMap
    cfgmap
      getGithubProp :: Text -> ExceptT String IO String
    getGithubProp = Text -> Text -> ExceptT String IO String
    forall {f :: * -> *}. Applicative f => Text -> Text -> f String
    get Text
    "GITHUB"
      getUrlProp :: Text -> ExceptT String IO (URIRef Absolute)
    getUrlProp Text
    prop = Text -> ExceptT String IO String
    getGithubProp Text
    prop ExceptT String IO String
    -> (String -> ExceptT String IO (URIRef Absolute))
    -> ExceptT String IO (URIRef Absolute)
    forall a b.
    ExceptT String IO a
    -> (a -> ExceptT String IO b) -> ExceptT String IO b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= \String
    s ->
                          case URIParserOptions
    -> ByteString -> Either URIParseError (URIRef Absolute)
    parseURI URIParserOptions
    laxURIParserOptions (String -> ByteString
    BS.pack String
    s) of
                            Left URIParseError
    e    -> String -> ExceptT String IO (URIRef Absolute)
    forall a. String -> ExceptT String IO a
    forall e (m :: * -> *) a. MonadError e m => e -> m a
    throwError (String -> ExceptT String IO (URIRef Absolute))
    -> String -> ExceptT String IO (URIRef Absolute)
    forall a b. (a -> b) -> a -> b
    $ String
    "couldn't parse url " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    s
                                                         String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    " from (Github/" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Text -> String
    T.unpack Text
    prop
                                                         String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "): " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ URIParseError -> String
    forall a. Show a => a -> String
    show URIParseError
    e
                            Right URIRef Absolute
    uri -> URIRef Absolute -> ExceptT String IO (URIRef Absolute)
    forall a. a -> ExceptT String IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return URIRef Absolute
    uri

    -- | Read a file associating mime types with extensions, and return a
    -- map from extensions to types. Each line of the file consists of a
    -- mime type, followed by space, followed by a list of zero or more
    -- extensions, separated by spaces. Example: text/plain txt text
    readMimeTypesFile :: FilePath -> IO (M.Map String String)
    readMimeTypesFile :: String -> IO (Map String String)
    readMimeTypesFile String
    f = IO (Map String String)
    -> (SomeException -> IO (Map String String))
    -> IO (Map String String)
    forall e a. Exception e => IO a -> (e -> IO a) -> IO a
    E.catch
      ((String -> Map String String -> Map String String)
    -> Map String String -> [String] -> Map String String
    forall a b. (a -> b -> b) -> b -> [a] -> b
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr ([String] -> Map String String -> Map String String
    forall {a}. Ord a => [a] -> Map a a -> Map a a
    go ([String] -> Map String String -> Map String String)
    -> (String -> [String])
    -> String
    -> Map String String
    -> Map String String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> [String]
    words)  Map String String
    forall k a. Map k a
    M.empty ([String] -> Map String String)
    -> (Text -> [String]) -> Text -> Map String String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> [String]
    lines (String -> [String]) -> (Text -> String) -> Text -> [String]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Text -> String
    T.unpack (Text -> Map String String) -> IO Text -> IO (Map String String)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> String -> IO Text
    readFileUTF8 String
    f)
      SomeException -> IO (Map String String)
    handleMimeTypesFileNotFound
         where go :: [a] -> Map a a -> Map a a
    go []     Map a a
    m = Map a a
    m  -- skip blank lines
               go (a
    x:[a]
    xs) Map a a
    m = (a -> Map a a -> Map a a) -> Map a a -> [a] -> Map a a
    forall a b. (a -> b -> b) -> b -> [a] -> b
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr (a -> a -> Map a a -> Map a a
    forall k a. Ord k => k -> a -> Map k a -> Map k a
    `M.insert` a
    x) Map a a
    m [a]
    xs
               handleMimeTypesFileNotFound :: SomeException -> IO (Map String String)
    handleMimeTypesFileNotFound (SomeException
    e :: E.SomeException) = do
                 String -> Priority -> String -> IO ()
    logM String
    "gitit" Priority
    WARNING (String -> IO ()) -> String -> IO ()
    forall a b. (a -> b) -> a -> b
    $ String
    "Could not read mime types file: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++
                   String
    f String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "\n" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ SomeException -> String
    forall a. Show a => a -> String
    show SomeException
    e String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "\n" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "Using defaults instead."
                 Map String String -> IO (Map String String)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Map String String
    mimeTypes

    readNumber :: (Monad m, Num a, Read a) => String -> ExceptT String m a
    readNumber :: forall (m :: * -> *) a.
    (Monad m, Num a, Read a) =>
    String -> ExceptT String m a
    readNumber String
    x = case String -> Maybe a
    forall a. Read a => String -> Maybe a
    readMaybe String
    x of
                         Just a
    n -> a -> ExceptT String m a
    forall a. a -> ExceptT String m a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure a
    n
                         Maybe a
    _ -> String -> ExceptT String m a
    forall a. String -> ExceptT String m a
    forall e (m :: * -> *) a. MonadError e m => e -> m a
    throwError (String -> ExceptT String m a) -> String -> ExceptT String m a
    forall a b. (a -> b) -> a -> b
    $ String
    "Could not parse " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    x String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    " as an integer."

    readSize :: (Monad m, Num a, Read a) => String -> ExceptT String m a
    readSize :: forall (m :: * -> *) a.
    (Monad m, Num a, Read a) =>
    String -> ExceptT String m a
    readSize [] = String -> ExceptT String m a
    forall (m :: * -> *) a.
    (Monad m, Num a, Read a) =>
    String -> ExceptT String m a
    readNumber String
    ""
    readSize String
    x =
      case String -> Char
    forall a. HasCallStack => [a] -> a
    last String
    x of
           Char
    'K' -> (a -> a -> a
    forall a. Num a => a -> a -> a
    * a
    1000) (a -> a) -> ExceptT String m a -> ExceptT String m a
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> String -> ExceptT String m a
    forall (m :: * -> *) a.
    (Monad m, Num a, Read a) =>
    String -> ExceptT String m a
    readNumber (String -> String
    forall a. HasCallStack => [a] -> [a]
    init String
    x)
           Char
    'M' -> (a -> a -> a
    forall a. Num a => a -> a -> a
    * a
    1000000) (a -> a) -> ExceptT String m a -> ExceptT String m a
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> String -> ExceptT String m a
    forall (m :: * -> *) a.
    (Monad m, Num a, Read a) =>
    String -> ExceptT String m a
    readNumber (String -> String
    forall a. HasCallStack => [a] -> [a]
    init String
    x)
           Char
    'G' -> (a -> a -> a
    forall a. Num a => a -> a -> a
    *  a
    1000000000) (a -> a) -> ExceptT String m a -> ExceptT String m a
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> String -> ExceptT String m a
    forall (m :: * -> *) a.
    (Monad m, Num a, Read a) =>
    String -> ExceptT String m a
    readNumber (String -> String
    forall a. HasCallStack => [a] -> [a]
    init String
    x)
           Char
    _       -> String -> ExceptT String m a
    forall (m :: * -> *) a.
    (Monad m, Num a, Read a) =>
    String -> ExceptT String m a
    readNumber String
    x

    splitCommaList :: String -> [String]
    splitCommaList :: String -> [String]
    splitCommaList String
    l =
      let (String
    first,String
    rest) = (Char -> Bool) -> String -> (String, String)
    forall a. (a -> Bool) -> [a] -> ([a], [a])
    break (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    ',') String
    l
          first' :: String
    first' = String -> String
    lrStrip String
    first
      in case String
    rest of
             []     -> [String
    first' | Bool -> Bool
    not (String -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null String
    first')]
             (Char
    _:String
    rs) -> String
    first' String -> [String] -> [String]
    forall a. a -> [a] -> [a]
    : String -> [String]
    splitCommaList String
    rs

    lrStrip :: String -> String
    lrStrip :: String -> String
    lrStrip = String -> String
    forall a. [a] -> [a]
    reverse (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Char -> Bool) -> String -> String
    forall a. (a -> Bool) -> [a] -> [a]
    dropWhile Char -> Bool
    isWhitespace (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String
    forall a. [a] -> [a]
    reverse (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Char -> Bool) -> String -> String
    forall a. (a -> Bool) -> [a] -> [a]
    dropWhile Char -> Bool
    isWhitespace
        where isWhitespace :: Char -> Bool
    isWhitespace = (Char -> String -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [Char
    ' ',Char
    '\t',Char
    '\n'])

    readBool :: Monad m => String -> ExceptT String m Bool
    readBool :: forall (m :: * -> *). Monad m => String -> ExceptT String m Bool
    readBool String
    s =
      case (Char -> Char) -> String -> String
    forall a b. (a -> b) -> [a] -> [b]
    map Char -> Char
    toLower String
    s of
        String
    "yes" -> Bool -> ExceptT String m Bool
    forall a. a -> ExceptT String m a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Bool
    True
        String
    "y" -> Bool -> ExceptT String m Bool
    forall a. a -> ExceptT String m a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Bool
    True
        String
    "no" -> Bool -> ExceptT String m Bool
    forall a. a -> ExceptT String m a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Bool
    False
        String
    "n" -> Bool -> ExceptT String m Bool
    forall a. a -> ExceptT String m a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Bool
    False
        String
    "true" -> Bool -> ExceptT String m Bool
    forall a. a -> ExceptT String m a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Bool
    True
        String
    "t" -> Bool -> ExceptT String m Bool
    forall a. a -> ExceptT String m a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Bool
    True
        String
    "false" -> Bool -> ExceptT String m Bool
    forall a. a -> ExceptT String m a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Bool
    False
        String
    "f" -> Bool -> ExceptT String m Bool
    forall a. a -> ExceptT String m a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Bool
    False
        String
    _ -> String -> ExceptT String m Bool
    forall a. String -> ExceptT String m a
    forall e (m :: * -> *) a. MonadError e m => e -> m a
    throwError (String -> ExceptT String m Bool)
    -> String -> ExceptT String m Bool
    forall a b. (a -> b) -> a -> b
    $ String
    "Could not read " String -> String -> String
    forall a. Semigroup a => a -> a -> a
    <> String
    s String -> String -> String
    forall a. Semigroup a => a -> a -> a
    <> String
    " as boolean"