module System.Console.Haskeline.Prefs(
Prefs(..),
defaultPrefs,
readPrefs,
CompletionType(..),
BellStyle(..),
EditMode(..)
) where
import Data.Char(isSpace,toLower)
import Data.List(foldl')
import System.Console.Haskeline.MonadException(handle,IOException)
data Prefs = Prefs { bellStyle :: !BellStyle,
editMode :: !EditMode,
maxHistorySize :: !(Maybe Int),
completionType :: !CompletionType,
completionPaging :: !Bool,
completionPromptLimit :: !(Maybe Int),
listCompletionsImmediately :: !Bool
}
deriving (Read,Show)
data CompletionType = ListCompletion | MenuCompletion
deriving (Read,Show)
data BellStyle = NoBell | VisualBell | AudibleBell
deriving (Show, Read)
data EditMode = Vi | Emacs
deriving (Show,Read)
defaultPrefs :: Prefs
defaultPrefs = Prefs {bellStyle = AudibleBell,
maxHistorySize = Just 100,
editMode = Emacs,
completionType = ListCompletion,
completionPaging = True,
completionPromptLimit = Just 100,
listCompletionsImmediately = True
}
mkSettor :: Read a => (a -> Prefs -> Prefs) -> String -> Prefs -> Prefs
mkSettor f str = case reads str of
[(x,_)] -> f x
_ -> id
settors :: [(String, String -> Prefs -> Prefs)]
settors = [("bellstyle", mkSettor $ \x p -> p {bellStyle = x})
,("editmode", mkSettor $ \x p -> p {editMode = x})
,("maxhistorysize", mkSettor $ \x p -> p {maxHistorySize = x})
,("completiontype", mkSettor $ \x p -> p {completionType = x})
,("completionpaging", mkSettor $ \x p -> p {completionPaging = x})
,("completionpromptlimit", mkSettor $ \x p -> p {completionPromptLimit = x})
,("listcompletionsimmediately", mkSettor $ \x p -> p {listCompletionsImmediately = x})
]
readPrefs :: FilePath -> IO Prefs
readPrefs file = handle (\(_::IOException) -> return defaultPrefs) $ do
ls <- fmap lines $ readFile file
return $ foldl' applyField defaultPrefs ls
where
applyField p l = case break (==':') l of
(name,val) -> case lookup (map toLower $ trimSpaces name) settors of
Nothing -> p
Just set -> set (drop 1 val) p
trimSpaces = dropWhile isSpace . reverse . dropWhile isSpace . reverse