module System.Console.Haskeline.Prefs(
                        Prefs(..),
                        defaultPrefs,
                        readPrefs,
                        CompletionType(..),
                        BellStyle(..),
                        EditMode(..),
                        HistoryDuplicates(..),
                        lookupKeyBinding
                        ) where

import Control.Monad.Catch (handle)
import Control.Exception (IOException)
import Data.Char(isSpace,toLower)
import Data.List(foldl')
import qualified Data.Map as Map
import System.Console.Haskeline.Key

{- |
'Prefs' allow the user to customize the terminal-style line-editing interface.  They are
read by default from @~/.haskeline@; to override that behavior, use
'readPrefs' and @runInputTWithPrefs@.

Each line of a @.haskeline@ file defines
one field of the 'Prefs' datatype; field names are case-insensitive and
unparseable lines are ignored.  For example:

> editMode: Vi
> completionType: MenuCompletion
> maxhistorysize: Just 40

-}
data Prefs = Prefs { Prefs -> BellStyle
bellStyle :: !BellStyle,
                     Prefs -> EditMode
editMode :: !EditMode,
                     Prefs -> Maybe Int
maxHistorySize :: !(Maybe Int),
                     Prefs -> HistoryDuplicates
historyDuplicates :: HistoryDuplicates,
                     Prefs -> CompletionType
completionType :: !CompletionType,
                     Prefs -> Bool
completionPaging :: !Bool, 
                        -- ^ When listing completion alternatives, only display
                        -- one screen of possibilities at a time.
                     Prefs -> Maybe Int
completionPromptLimit :: !(Maybe Int),
                        -- ^ If more than this number of completion
                        -- possibilities are found, then ask before listing
                        -- them.
                     Prefs -> Bool
listCompletionsImmediately :: !Bool,
                        -- ^ If 'False', completions with multiple possibilities
                        -- will ring the bell and only display them if the user
                        -- presses @TAB@ again.
                     Prefs -> Map Key [Key]
customBindings :: Map.Map Key [Key],
                        -- (termName, keysequence, key)
                     Prefs -> [(Maybe String, String, Key)]
customKeySequences :: [(Maybe String, String,Key)]
                     }
                        deriving Int -> Prefs -> ShowS
[Prefs] -> ShowS
Prefs -> String
(Int -> Prefs -> ShowS)
-> (Prefs -> String) -> ([Prefs] -> ShowS) -> Show Prefs
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Prefs] -> ShowS
$cshowList :: [Prefs] -> ShowS
show :: Prefs -> String
$cshow :: Prefs -> String
showsPrec :: Int -> Prefs -> ShowS
$cshowsPrec :: Int -> Prefs -> ShowS
External instance of the constraint type Show Char
External instance of the constraint type Show Char
External instance of the constraint type forall a. Show a => Show [a]
External instance of the constraint type Show Char
External instance of the constraint type forall a. Show a => Show [a]
External instance of the constraint type Show Char
External instance of the constraint type forall a. Show a => Show (Maybe a)
External instance of the constraint type forall a. Show a => Show [a]
External instance of the constraint type Show Char
External instance of the constraint type forall a b c. (Show a, Show b, Show c) => Show (a, b, c)
External instance of the constraint type Show Key
External instance of the constraint type Show Int
External instance of the constraint type forall a b c. (Show a, Show b, Show c) => Show (a, b, c)
External instance of the constraint type forall a. Show a => Show (Maybe a)
External instance of the constraint type forall a. Show a => Show [a]
External instance of the constraint type Show Char
External instance of the constraint type forall a. Show a => Show [a]
External instance of the constraint type Show Char
External instance of the constraint type Show Key
External instance of the constraint type forall a. Show a => Show [a]
External instance of the constraint type forall a. Show a => Show [a]
External instance of the constraint type Show Key
External instance of the constraint type Show Key
External instance of the constraint type forall k a. (Show k, Show a) => Show (Map k a)
External instance of the constraint type Show Bool
External instance of the constraint type Show Bool
External instance of the constraint type Show Int
External instance of the constraint type forall a. Show a => Show (Maybe a)
External instance of the constraint type forall a. Show a => Show (Maybe a)
External instance of the constraint type Show Int
External instance of the constraint type Ord Int
Instance of class: Show of the constraint type Show CompletionType
Instance of class: Show of the constraint type Show BellStyle
Instance of class: Show of the constraint type Show EditMode
Instance of class: Show of the constraint type Show HistoryDuplicates
Show

data CompletionType = ListCompletion | MenuCompletion
            deriving (ReadPrec [CompletionType]
ReadPrec CompletionType
Int -> ReadS CompletionType
ReadS [CompletionType]
(Int -> ReadS CompletionType)
-> ReadS [CompletionType]
-> ReadPrec CompletionType
-> ReadPrec [CompletionType]
-> Read CompletionType
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CompletionType]
$creadListPrec :: ReadPrec [CompletionType]
readPrec :: ReadPrec CompletionType
$creadPrec :: ReadPrec CompletionType
readList :: ReadS [CompletionType]
$creadList :: ReadS [CompletionType]
readsPrec :: Int -> ReadS CompletionType
$creadsPrec :: Int -> ReadS CompletionType
External instance of the constraint type Monad ReadPrec
External instance of the constraint type Monad ReadPrec
Instance of class: Read of the constraint type Read CompletionType
Read,Int -> CompletionType -> ShowS
[CompletionType] -> ShowS
CompletionType -> String
(Int -> CompletionType -> ShowS)
-> (CompletionType -> String)
-> ([CompletionType] -> ShowS)
-> Show CompletionType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CompletionType] -> ShowS
$cshowList :: [CompletionType] -> ShowS
show :: CompletionType -> String
$cshow :: CompletionType -> String
showsPrec :: Int -> CompletionType -> ShowS
$cshowsPrec :: Int -> CompletionType -> ShowS
Show)


data BellStyle = NoBell | VisualBell | AudibleBell
                    deriving (Int -> BellStyle -> ShowS
[BellStyle] -> ShowS
BellStyle -> String
(Int -> BellStyle -> ShowS)
-> (BellStyle -> String)
-> ([BellStyle] -> ShowS)
-> Show BellStyle
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BellStyle] -> ShowS
$cshowList :: [BellStyle] -> ShowS
show :: BellStyle -> String
$cshow :: BellStyle -> String
showsPrec :: Int -> BellStyle -> ShowS
$cshowsPrec :: Int -> BellStyle -> ShowS
Show, ReadPrec [BellStyle]
ReadPrec BellStyle
Int -> ReadS BellStyle
ReadS [BellStyle]
(Int -> ReadS BellStyle)
-> ReadS [BellStyle]
-> ReadPrec BellStyle
-> ReadPrec [BellStyle]
-> Read BellStyle
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [BellStyle]
$creadListPrec :: ReadPrec [BellStyle]
readPrec :: ReadPrec BellStyle
$creadPrec :: ReadPrec BellStyle
readList :: ReadS [BellStyle]
$creadList :: ReadS [BellStyle]
readsPrec :: Int -> ReadS BellStyle
$creadsPrec :: Int -> ReadS BellStyle
External instance of the constraint type Monad ReadPrec
External instance of the constraint type Monad ReadPrec
Instance of class: Read of the constraint type Read BellStyle
Read)

data EditMode = Vi | Emacs
                    deriving (Int -> EditMode -> ShowS
[EditMode] -> ShowS
EditMode -> String
(Int -> EditMode -> ShowS)
-> (EditMode -> String) -> ([EditMode] -> ShowS) -> Show EditMode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EditMode] -> ShowS
$cshowList :: [EditMode] -> ShowS
show :: EditMode -> String
$cshow :: EditMode -> String
showsPrec :: Int -> EditMode -> ShowS
$cshowsPrec :: Int -> EditMode -> ShowS
Show,ReadPrec [EditMode]
ReadPrec EditMode
Int -> ReadS EditMode
ReadS [EditMode]
(Int -> ReadS EditMode)
-> ReadS [EditMode]
-> ReadPrec EditMode
-> ReadPrec [EditMode]
-> Read EditMode
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [EditMode]
$creadListPrec :: ReadPrec [EditMode]
readPrec :: ReadPrec EditMode
$creadPrec :: ReadPrec EditMode
readList :: ReadS [EditMode]
$creadList :: ReadS [EditMode]
readsPrec :: Int -> ReadS EditMode
$creadsPrec :: Int -> ReadS EditMode
External instance of the constraint type Monad ReadPrec
External instance of the constraint type Monad ReadPrec
Instance of class: Read of the constraint type Read EditMode
Read)

data HistoryDuplicates = AlwaysAdd | IgnoreConsecutive | IgnoreAll
                    deriving (Int -> HistoryDuplicates -> ShowS
[HistoryDuplicates] -> ShowS
HistoryDuplicates -> String
(Int -> HistoryDuplicates -> ShowS)
-> (HistoryDuplicates -> String)
-> ([HistoryDuplicates] -> ShowS)
-> Show HistoryDuplicates
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HistoryDuplicates] -> ShowS
$cshowList :: [HistoryDuplicates] -> ShowS
show :: HistoryDuplicates -> String
$cshow :: HistoryDuplicates -> String
showsPrec :: Int -> HistoryDuplicates -> ShowS
$cshowsPrec :: Int -> HistoryDuplicates -> ShowS
Show,ReadPrec [HistoryDuplicates]
ReadPrec HistoryDuplicates
Int -> ReadS HistoryDuplicates
ReadS [HistoryDuplicates]
(Int -> ReadS HistoryDuplicates)
-> ReadS [HistoryDuplicates]
-> ReadPrec HistoryDuplicates
-> ReadPrec [HistoryDuplicates]
-> Read HistoryDuplicates
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [HistoryDuplicates]
$creadListPrec :: ReadPrec [HistoryDuplicates]
readPrec :: ReadPrec HistoryDuplicates
$creadPrec :: ReadPrec HistoryDuplicates
readList :: ReadS [HistoryDuplicates]
$creadList :: ReadS [HistoryDuplicates]
readsPrec :: Int -> ReadS HistoryDuplicates
$creadsPrec :: Int -> ReadS HistoryDuplicates
External instance of the constraint type Monad ReadPrec
External instance of the constraint type Monad ReadPrec
Instance of class: Read of the constraint type Read HistoryDuplicates
Read)

-- | The default preferences which may be overwritten in the
-- @.haskeline@ file.
defaultPrefs :: Prefs
defaultPrefs :: Prefs
defaultPrefs = Prefs :: BellStyle
-> EditMode
-> Maybe Int
-> HistoryDuplicates
-> CompletionType
-> Bool
-> Maybe Int
-> Bool
-> Map Key [Key]
-> [(Maybe String, String, Key)]
-> Prefs
Prefs {bellStyle :: BellStyle
bellStyle = BellStyle
AudibleBell,
                      maxHistorySize :: Maybe Int
maxHistorySize = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
100,
                      editMode :: EditMode
editMode = EditMode
Emacs,
                      completionType :: CompletionType
completionType = CompletionType
ListCompletion,
                      completionPaging :: Bool
completionPaging = Bool
True,
                      completionPromptLimit :: Maybe Int
completionPromptLimit = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
100,
                      listCompletionsImmediately :: Bool
listCompletionsImmediately = Bool
True,
                      historyDuplicates :: HistoryDuplicates
historyDuplicates = HistoryDuplicates
AlwaysAdd,
                      customBindings :: Map Key [Key]
customBindings = Map Key [Key]
forall k a. Map k a
Map.empty,
                      customKeySequences :: [(Maybe String, String, Key)]
customKeySequences = []
                    }

mkSettor :: Read a => (a -> Prefs -> Prefs) -> String -> Prefs -> Prefs
mkSettor :: (a -> Prefs -> Prefs) -> String -> Prefs -> Prefs
mkSettor a -> Prefs -> Prefs
f String
str = (Prefs -> Prefs)
-> (a -> Prefs -> Prefs) -> Maybe a -> Prefs -> Prefs
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Prefs -> Prefs
forall a. a -> a
id a -> Prefs -> Prefs
f (String -> Maybe a
forall a. Read a => String -> Maybe a
Evidence bound by a type signature of the constraint type Read a
readMaybe String
str)

readMaybe :: Read a => String -> Maybe a
readMaybe :: String -> Maybe a
readMaybe String
str = case ReadS a
forall a. Read a => ReadS a
Evidence bound by a type signature of the constraint type Read a
reads String
str of
                [(a
x,String
_)] -> a -> Maybe a
forall a. a -> Maybe a
Just a
x
                [(a, String)]
_ -> Maybe a
forall a. Maybe a
Nothing


settors :: [(String, String -> Prefs -> Prefs)]
settors :: [(String, String -> Prefs -> Prefs)]
settors = [(String
"bellstyle", (BellStyle -> Prefs -> Prefs) -> String -> Prefs -> Prefs
forall a.
Read a =>
(a -> Prefs -> Prefs) -> String -> Prefs -> Prefs
Instance of class: Read of the constraint type Read BellStyle
mkSettor ((BellStyle -> Prefs -> Prefs) -> String -> Prefs -> Prefs)
-> (BellStyle -> Prefs -> Prefs) -> String -> Prefs -> Prefs
forall a b. (a -> b) -> a -> b
$ \BellStyle
x Prefs
p -> Prefs
p {bellStyle :: BellStyle
bellStyle = BellStyle
x})
          ,(String
"editmode", (EditMode -> Prefs -> Prefs) -> String -> Prefs -> Prefs
forall a.
Read a =>
(a -> Prefs -> Prefs) -> String -> Prefs -> Prefs
Instance of class: Read of the constraint type Read EditMode
mkSettor ((EditMode -> Prefs -> Prefs) -> String -> Prefs -> Prefs)
-> (EditMode -> Prefs -> Prefs) -> String -> Prefs -> Prefs
forall a b. (a -> b) -> a -> b
$ \EditMode
x Prefs
p -> Prefs
p {editMode :: EditMode
editMode = EditMode
x})
          ,(String
"maxhistorysize", (Maybe Int -> Prefs -> Prefs) -> String -> Prefs -> Prefs
forall a.
Read a =>
(a -> Prefs -> Prefs) -> String -> Prefs -> Prefs
External instance of the constraint type forall a. Read a => Read (Maybe a)
External instance of the constraint type Read Int
mkSettor ((Maybe Int -> Prefs -> Prefs) -> String -> Prefs -> Prefs)
-> (Maybe Int -> Prefs -> Prefs) -> String -> Prefs -> Prefs
forall a b. (a -> b) -> a -> b
$ \Maybe Int
x Prefs
p -> Prefs
p {maxHistorySize :: Maybe Int
maxHistorySize = Maybe Int
x})
          ,(String
"completiontype", (CompletionType -> Prefs -> Prefs) -> String -> Prefs -> Prefs
forall a.
Read a =>
(a -> Prefs -> Prefs) -> String -> Prefs -> Prefs
Instance of class: Read of the constraint type Read CompletionType
mkSettor ((CompletionType -> Prefs -> Prefs) -> String -> Prefs -> Prefs)
-> (CompletionType -> Prefs -> Prefs) -> String -> Prefs -> Prefs
forall a b. (a -> b) -> a -> b
$ \CompletionType
x Prefs
p -> Prefs
p {completionType :: CompletionType
completionType = CompletionType
x})
          ,(String
"completionpaging", (Bool -> Prefs -> Prefs) -> String -> Prefs -> Prefs
forall a.
Read a =>
(a -> Prefs -> Prefs) -> String -> Prefs -> Prefs
External instance of the constraint type Read Bool
mkSettor ((Bool -> Prefs -> Prefs) -> String -> Prefs -> Prefs)
-> (Bool -> Prefs -> Prefs) -> String -> Prefs -> Prefs
forall a b. (a -> b) -> a -> b
$ \Bool
x Prefs
p -> Prefs
p {completionPaging :: Bool
completionPaging = Bool
x})
          ,(String
"completionpromptlimit", (Maybe Int -> Prefs -> Prefs) -> String -> Prefs -> Prefs
forall a.
Read a =>
(a -> Prefs -> Prefs) -> String -> Prefs -> Prefs
External instance of the constraint type forall a. Read a => Read (Maybe a)
External instance of the constraint type Read Int
mkSettor ((Maybe Int -> Prefs -> Prefs) -> String -> Prefs -> Prefs)
-> (Maybe Int -> Prefs -> Prefs) -> String -> Prefs -> Prefs
forall a b. (a -> b) -> a -> b
$ \Maybe Int
x Prefs
p -> Prefs
p {completionPromptLimit :: Maybe Int
completionPromptLimit = Maybe Int
x})
          ,(String
"listcompletionsimmediately", (Bool -> Prefs -> Prefs) -> String -> Prefs -> Prefs
forall a.
Read a =>
(a -> Prefs -> Prefs) -> String -> Prefs -> Prefs
External instance of the constraint type Read Bool
mkSettor ((Bool -> Prefs -> Prefs) -> String -> Prefs -> Prefs)
-> (Bool -> Prefs -> Prefs) -> String -> Prefs -> Prefs
forall a b. (a -> b) -> a -> b
$ \Bool
x Prefs
p -> Prefs
p {listCompletionsImmediately :: Bool
listCompletionsImmediately = Bool
x})
          ,(String
"historyduplicates", (HistoryDuplicates -> Prefs -> Prefs) -> String -> Prefs -> Prefs
forall a.
Read a =>
(a -> Prefs -> Prefs) -> String -> Prefs -> Prefs
Instance of class: Read of the constraint type Read HistoryDuplicates
mkSettor ((HistoryDuplicates -> Prefs -> Prefs) -> String -> Prefs -> Prefs)
-> (HistoryDuplicates -> Prefs -> Prefs)
-> String
-> Prefs
-> Prefs
forall a b. (a -> b) -> a -> b
$ \HistoryDuplicates
x Prefs
p -> Prefs
p {historyDuplicates :: HistoryDuplicates
historyDuplicates = HistoryDuplicates
x})
          ,(String
"bind", String -> Prefs -> Prefs
addCustomBinding)
          ,(String
"keyseq", String -> Prefs -> Prefs
addCustomKeySequence)
          ]

addCustomBinding :: String -> Prefs -> Prefs
addCustomBinding :: String -> Prefs -> Prefs
addCustomBinding String
str Prefs
p = case (String -> Maybe Key) -> [String] -> Maybe [Key]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
External instance of the constraint type Monad Maybe
External instance of the constraint type Traversable []
mapM String -> Maybe Key
parseKey (String -> [String]
words String
str) of
    Just (Key
k:[Key]
ks) -> Prefs
p {customBindings :: Map Key [Key]
customBindings = Key -> [Key] -> Map Key [Key] -> Map Key [Key]
forall k a. Ord k => k -> a -> Map k a -> Map k a
External instance of the constraint type Ord Key
Map.insert Key
k [Key]
ks (Prefs -> Map Key [Key]
customBindings Prefs
p)}
    Maybe [Key]
_ -> Prefs
p

addCustomKeySequence :: String -> Prefs -> Prefs
addCustomKeySequence :: String -> Prefs -> Prefs
addCustomKeySequence String
str = (Prefs -> Prefs)
-> ((Maybe String, String, Key) -> Prefs -> Prefs)
-> Maybe (Maybe String, String, Key)
-> Prefs
-> Prefs
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Prefs -> Prefs
forall a. a -> a
id (Maybe String, String, Key) -> Prefs -> Prefs
addKS Maybe (Maybe String, String, Key)
maybeParse
    where
        maybeParse :: Maybe (Maybe String, String,Key)
        maybeParse :: Maybe (Maybe String, String, Key)
maybeParse = case String -> [String]
words String
str of
            [String
cstr,String
kstr] -> Maybe String
-> String -> String -> Maybe (Maybe String, String, Key)
forall {b} {a}.
Read b =>
a -> String -> String -> Maybe (a, b, Key)
External instance of the constraint type forall a. Read a => Read [a]
External instance of the constraint type Read Char
parseWords Maybe String
forall a. Maybe a
Nothing String
cstr String
kstr
            [String
term,String
cstr,String
kstr] -> Maybe String
-> String -> String -> Maybe (Maybe String, String, Key)
forall {b} {a}.
Read b =>
a -> String -> String -> Maybe (a, b, Key)
External instance of the constraint type forall a. Read a => Read [a]
External instance of the constraint type Read Char
parseWords (String -> Maybe String
forall a. a -> Maybe a
Just String
term) String
cstr String
kstr
            [String]
_ -> Maybe (Maybe String, String, Key)
forall a. Maybe a
Nothing
        parseWords :: a -> String -> String -> Maybe (a, b, Key)
parseWords a
mterm String
cstr String
kstr = do
            Key
k <- String -> Maybe Key
parseKey String
kstr
            b
cs <- String -> Maybe b
forall a. Read a => String -> Maybe a
Evidence bound by a type signature of the constraint type Read b
readMaybe String
cstr
            (a, b, Key) -> Maybe (a, b, Key)
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad Maybe
return (a
mterm,b
cs,Key
k)
        addKS :: (Maybe String, String, Key) -> Prefs -> Prefs
addKS (Maybe String, String, Key)
ks Prefs
p = Prefs
p {customKeySequences :: [(Maybe String, String, Key)]
customKeySequences = (Maybe String, String, Key)
ks(Maybe String, String, Key)
-> [(Maybe String, String, Key)] -> [(Maybe String, String, Key)]
forall a. a -> [a] -> [a]
:Prefs -> [(Maybe String, String, Key)]
customKeySequences Prefs
p}

lookupKeyBinding :: Key -> Prefs -> [Key]
lookupKeyBinding :: Key -> Prefs -> [Key]
lookupKeyBinding Key
k = [Key] -> Key -> Map Key [Key] -> [Key]
forall k a. Ord k => a -> k -> Map k a -> a
External instance of the constraint type Ord Key
Map.findWithDefault [Key
k] Key
k (Map Key [Key] -> [Key])
-> (Prefs -> Map Key [Key]) -> Prefs -> [Key]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Prefs -> Map Key [Key]
customBindings

-- | Read 'Prefs' from a given file.  If there is an error reading the file,
-- the 'defaultPrefs' will be returned.
readPrefs :: FilePath -> IO Prefs
readPrefs :: String -> IO Prefs
readPrefs String
file = (IOException -> IO Prefs) -> IO Prefs -> IO Prefs
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
(e -> m a) -> m a -> m a
External instance of the constraint type Exception IOException
External instance of the constraint type MonadCatch IO
handle (\(IOException
_::IOException) -> Prefs -> IO Prefs
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad IO
return Prefs
defaultPrefs) (IO Prefs -> IO Prefs) -> IO Prefs -> IO Prefs
forall a b. (a -> b) -> a -> b
$ do
    [String]
ls <- (String -> [String]) -> IO String -> IO [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
External instance of the constraint type Functor IO
fmap String -> [String]
lines (IO String -> IO [String]) -> IO String -> IO [String]
forall a b. (a -> b) -> a -> b
$ String -> IO String
readFile String
file
    Prefs -> IO Prefs
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad IO
return (Prefs -> IO Prefs) -> Prefs -> IO Prefs
forall a b. (a -> b) -> a -> b
$! (Prefs -> String -> Prefs) -> Prefs -> [String] -> Prefs
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
External instance of the constraint type Foldable []
foldl' Prefs -> String -> Prefs
applyField Prefs
defaultPrefs [String]
ls
  where
    applyField :: Prefs -> String -> Prefs
applyField Prefs
p String
l = case (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
External instance of the constraint type Eq Char
==Char
':') String
l of
                (String
name,String
val)  -> case String
-> [(String, String -> Prefs -> Prefs)]
-> Maybe (String -> Prefs -> Prefs)
forall a b. Eq a => a -> [(a, b)] -> Maybe b
External instance of the constraint type forall a. Eq a => Eq [a]
External instance of the constraint type Eq Char
lookup ((Char -> Char) -> ShowS
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ ShowS
trimSpaces String
name) [(String, String -> Prefs -> Prefs)]
settors of
                        Maybe (String -> Prefs -> Prefs)
Nothing -> Prefs
p
                        Just String -> Prefs -> Prefs
set -> String -> Prefs -> Prefs
set (Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
1 String
val) Prefs
p  -- drop initial ":", don't crash if val==""
    trimSpaces :: ShowS
trimSpaces = (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
forall a. [a] -> [a]
reverse ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
forall a. [a] -> [a]
reverse