    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
    $cshowsPrec :: Int -> Prefs -> ShowS
    showsPrec :: Int -> Prefs -> ShowS
    $cshow :: Prefs -> String
    show :: Prefs -> String
    $cshowList :: [Prefs] -> ShowS
    showList :: [Prefs] -> ShowS
    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
    $creadsPrec :: Int -> ReadS CompletionType
    readsPrec :: Int -> ReadS CompletionType
    $creadList :: ReadS [CompletionType]
    readList :: ReadS [CompletionType]
    $creadPrec :: ReadPrec CompletionType
    readPrec :: ReadPrec CompletionType
    $creadListPrec :: ReadPrec [CompletionType]
    readListPrec :: ReadPrec [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
    $cshowsPrec :: Int -> CompletionType -> ShowS
    showsPrec :: Int -> CompletionType -> ShowS
    $cshow :: CompletionType -> String
    show :: CompletionType -> String
    $cshowList :: [CompletionType] -> ShowS
    showList :: [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
    $cshowsPrec :: Int -> BellStyle -> ShowS
    showsPrec :: Int -> BellStyle -> ShowS
    $cshow :: BellStyle -> String
    show :: BellStyle -> String
    $cshowList :: [BellStyle] -> ShowS
    showList :: [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
    $creadsPrec :: Int -> ReadS BellStyle
    readsPrec :: Int -> ReadS BellStyle
    $creadList :: ReadS [BellStyle]
    readList :: ReadS [BellStyle]
    $creadPrec :: ReadPrec BellStyle
    readPrec :: ReadPrec BellStyle
    $creadListPrec :: ReadPrec [BellStyle]
    readListPrec :: ReadPrec [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
    $cshowsPrec :: Int -> EditMode -> ShowS
    showsPrec :: Int -> EditMode -> ShowS
    $cshow :: EditMode -> String
    show :: EditMode -> String
    $cshowList :: [EditMode] -> ShowS
    showList :: [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
    $creadsPrec :: Int -> ReadS EditMode
    readsPrec :: Int -> ReadS EditMode
    $creadList :: ReadS [EditMode]
    readList :: ReadS [EditMode]
    $creadPrec :: ReadPrec EditMode
    readPrec :: ReadPrec EditMode
    $creadListPrec :: ReadPrec [EditMode]
    readListPrec :: ReadPrec [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
    $cshowsPrec :: Int -> HistoryDuplicates -> ShowS
    showsPrec :: Int -> HistoryDuplicates -> ShowS
    $cshow :: HistoryDuplicates -> String
    show :: HistoryDuplicates -> String
    $cshowList :: [HistoryDuplicates] -> ShowS
    showList :: [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
    $creadsPrec :: Int -> ReadS HistoryDuplicates
    readsPrec :: Int -> ReadS HistoryDuplicates
    $creadList :: ReadS [HistoryDuplicates]
    readList :: ReadS [HistoryDuplicates]
    $creadPrec :: ReadPrec HistoryDuplicates
    readPrec :: ReadPrec HistoryDuplicates
    $creadListPrec :: ReadPrec [HistoryDuplicates]
    readListPrec :: ReadPrec [HistoryDuplicates]
    Read)

    -- | The default preferences which may be overwritten in the
    -- @.haskeline@ file.
    defaultPrefs :: Prefs
    defaultPrefs :: Prefs
    defaultPrefs = 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 :: forall a.
    Read a =>
    (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
    readMaybe String
    str)

    readMaybe :: Read a => String -> Maybe a
    readMaybe :: forall a. Read a => String -> Maybe a
    readMaybe String
    str = case ReadS a
    forall a. Read a => ReadS 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
    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 = x})
              ,(String
    "editmode", (EditMode -> Prefs -> Prefs) -> String -> Prefs -> Prefs
    forall a.
    Read a =>
    (a -> Prefs -> Prefs) -> String -> Prefs -> Prefs
    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 = x})
              ,(String
    "maxhistorysize", (Maybe Int -> Prefs -> Prefs) -> String -> Prefs -> Prefs
    forall a.
    Read a =>
    (a -> Prefs -> Prefs) -> String -> Prefs -> Prefs
    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 = x})
              ,(String
    "completiontype", (CompletionType -> Prefs -> Prefs) -> String -> Prefs -> Prefs
    forall a.
    Read a =>
    (a -> Prefs -> Prefs) -> String -> Prefs -> Prefs
    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 = x})
              ,(String
    "completionpaging", (Bool -> Prefs -> Prefs) -> String -> Prefs -> Prefs
    forall a.
    Read a =>
    (a -> Prefs -> Prefs) -> String -> Prefs -> Prefs
    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 = x})
              ,(String
    "completionpromptlimit", (Maybe Int -> Prefs -> Prefs) -> String -> Prefs -> Prefs
    forall a.
    Read a =>
    (a -> Prefs -> Prefs) -> String -> Prefs -> Prefs
    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 = x})
              ,(String
    "listcompletionsimmediately", (Bool -> Prefs -> Prefs) -> String -> Prefs -> Prefs
    forall a.
    Read a =>
    (a -> Prefs -> Prefs) -> String -> Prefs -> Prefs
    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 = x})
              ,(String
    "historyduplicates", (HistoryDuplicates -> Prefs -> Prefs) -> String -> Prefs -> Prefs
    forall a.
    Read a =>
    (a -> Prefs -> Prefs) -> String -> Prefs -> Prefs
    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 = 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)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM String -> Maybe Key
    parseKey (String -> [String]
    words String
    str) of
        Just (Key
    k:[Key]
    ks) -> Prefs
    p {customBindings = Map.insert k ks (customBindings 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)
    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)
    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
                k <- String -> Maybe Key
    parseKey String
    kstr
                cs <- readMaybe cstr
                return (mterm,cs,k)
            addKS :: (Maybe String, String, Key) -> Prefs -> Prefs
    addKS (Maybe String, String, Key)
    ks Prefs
    p = Prefs
    p {customKeySequences = ks:customKeySequences 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
    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.
    (HasCallStack, MonadCatch m, Exception e) =>
    (e -> m a) -> m a -> m a
    handle (\(IOException
    _::IOException) -> Prefs -> IO Prefs
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Prefs
    defaultPrefs) (IO Prefs -> IO Prefs) -> IO Prefs -> IO Prefs
    forall a b. (a -> b) -> a -> b
    $ do
        ls <- (String -> [String]) -> IO String -> IO [String]
    forall a b. (a -> b) -> IO a -> IO b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    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
        return $! foldl' applyField defaultPrefs 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
    ==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
    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