From 7f5d0b170099704d1a2016e2af1d9bfbde7ea1ad Mon Sep 17 00:00:00 2001 From: defanor Date: Tue, 19 Dec 2017 02:43:21 +0300 Subject: Enable a user to specify a configuration file This covers both command-line options and the "load config" (former "reload config") command. --- Pancake.hs | 59 ++++++++++++++++++++++++++++-------------------- Pancake/Command.hs | 12 +++++++--- Pancake/Configuration.hs | 13 +++++++---- README | 3 ++- pancake.1 | 11 +++++---- 5 files changed, 60 insertions(+), 38 deletions(-) diff --git a/Pancake.hs b/Pancake.hs index d99a411..ae6b649 100644 --- a/Pancake.hs +++ b/Pancake.hs @@ -96,9 +96,9 @@ printDoc uri doc = do modify (\s -> s { position = rows }) -- | Updates 'LoopState' with user configuration. -updateConfig :: MonadIO m => StateT LoopState m () -updateConfig = do - c <- loadConfig +updateConfig :: MonadIO m => Maybe FilePath -> StateT LoopState m () +updateConfig mp = do + c <- loadConfig mp u <- prepareUnclutter c modify $ \s -> s { conf = c, unclutterRegexps = u } @@ -309,7 +309,7 @@ command ShowCurrent = do _ -> pure () command (Shortcut u q) = command . GoTo Nothing . RURI . fromJust . parseURI $ u ++ escapeURIString isUnreserved q -command ReloadConfig = updateConfig +command (LoadConfig p) = updateConfig p command Quit = liftIO $ do dir <- getXdgDirectory XdgCache "pancake" exists <- doesDirectoryExist dir @@ -344,7 +344,8 @@ eventLoop = do handleAsync other = throw other -- | Command-line options. -data Option = OVersion | OHelp | OEmbedded deriving (Show) +data Option = OVersion | OHelp | OEmbedded | OConfig FilePath + deriving (Show, Eq) -- | Command-line option descriptions for 'getOpt'. options :: [OptDescr Option] @@ -352,7 +353,10 @@ options = [ Option [] ["version"] (NoArg OVersion) "show version number and exit" , Option [] ["help"] (NoArg OHelp) "show help message and exit" , Option ['e'] ["embedded"] (NoArg OEmbedded) - "run in the embedded mode" ] + "run in the embedded mode" + , Option ['c'] ["config"] (ReqArg OConfig "FILE") + "load configuration from a specified file" + ] -- | Loads configuration and runs 'eventLoop'. main :: IO () @@ -361,22 +365,27 @@ main = do -- A hack to receive SIGINT reliably. tid <- myThreadId _ <- installHandler sigINT (Catch (throwTo tid UserInterrupt)) Nothing - let run cmd e = do - let maybeCommand = - if null cmd - then pure () - else get >>= \st -> command (parseCommand (conf st) (unwords cmd)) - _ <- runStateT (updateConfig >> maybeCommand >> eventLoop) - (LS ([],[]) 0 [] def e False [] Nothing) - pure () - let opt = getOpt Permute options args - case opt of - (_, _, errors) -> mapM_ putErrLn errors - case opt of - ([], cmd, _) -> run cmd False - ([OEmbedded], cmd, _) -> run cmd True - ([OVersion], [], _) -> putStrLn $ "pancake " ++ showVersion version - _ -> do - p <- getProgName - putStrLn $ - usageInfo ("Usage: " ++ p ++ " [option ...] [command ...]") options + let (opts, cmd, errors) = getOpt Permute options args + run + | OVersion `elem` opts = putStrLn $ "pancake " ++ showVersion version + | OHelp `elem` opts || not (null errors) = do + mapM_ putErrLn errors + p <- getProgName + putStrLn $ usageInfo + ("Usage: " ++ p ++ " [option ...] [command ...]") options + | otherwise = do + let maybeCommand = + if null cmd + then pure () + else get + >>= \st -> command (parseCommand (conf st) (unwords cmd)) + _ <- runStateT + (updateConfig (findConf opts) >> maybeCommand >> eventLoop) + (LS ([],[]) 0 [] def (OEmbedded `elem` opts) False [] Nothing) + pure () + run + where + findConf :: [Option] -> Maybe FilePath + findConf [] = Nothing + findConf (OConfig fp:_) = Just fp + findConf (_:xs) = findConf xs diff --git a/Pancake/Command.hs b/Pancake/Command.hs index 4c34a19..52ace06 100644 --- a/Pancake/Command.hs +++ b/Pancake/Command.hs @@ -59,7 +59,7 @@ data Command = Quit | Show Int | ShowCurrent | Shortcut String String - | ReloadConfig + | LoadConfig (Maybe FilePath) | SetWidth (Maybe Int) | Redisplay deriving (Show, Eq) @@ -75,7 +75,6 @@ basicCommand = choice . map (\(s, c) -> try (string s <* eof) *> pure c) $ , ("[", Back) , ("]", Forward) , (",", GoTo Nothing RCurrent) - , ("reload config", ReloadConfig) , ("help", Help) , ("?", ShowCurrent) , ("redisplay", Redisplay) @@ -151,7 +150,13 @@ pNat = read <$> many1 digit -- | 'SetWidth' command parser. setWidth :: Parser Command setWidth = string "set width" - *> (SetWidth <$> optionMaybe (spaces *> pNat)) + *> (SetWidth <$> optionMaybe (space *> pNat)) + <* eof + +-- | 'LoadConfig' command parser. +loadConf :: Parser Command +loadConf = string "load config" + *> (LoadConfig <$> optionMaybe (space *> many1 anyChar)) <* eof -- | Command parser. @@ -166,5 +171,6 @@ command c = , saveCurrent "save current" , save "save" , setWidth "set width" + , loadConf "load config" , goTo "follow uri" ]) diff --git a/Pancake/Configuration.hs b/Pancake/Configuration.hs index ae42f65..772725e 100644 --- a/Pancake/Configuration.hs +++ b/Pancake/Configuration.hs @@ -116,11 +116,14 @@ instance Default Config where "-w \"\n-pancake-\nuri: %{url_effective}\ntype: %{content_type}\n\" " -- | Loads configuration from an XDG config directory. -loadConfig :: MonadIO m => m Config -loadConfig = liftIO $ do - dir <- getXdgDirectory XdgConfig "pancake" - createDirectoryIfMissing True dir - let configPath = dir "config.yaml" +loadConfig :: MonadIO m => Maybe FilePath -> m Config +loadConfig mp = liftIO $ do + configPath <- case mp of + Nothing -> do + dir <- getXdgDirectory XdgConfig "pancake" + createDirectoryIfMissing True dir + pure $ dir "config.yaml" + Just p -> pure p exists <- doesFileExist configPath if exists then do diff --git a/README b/README index 5105c09..7de9384 100644 --- a/README +++ b/README @@ -59,7 +59,8 @@ Commands :quit or EOF: quit pancake, cleaning the cache :[: back :]: forward -:reload config: reload config +:load config[ ]: load configuration from a specified file or + reload it from the default one :help: show a help message :?: show current URI :RET (empty): show the next 2/3 of a page, if pagination is enabled diff --git a/pancake.1 b/pancake.1 index 6d64617..38db77a 100644 --- a/pancake.1 +++ b/pancake.1 @@ -4,7 +4,7 @@ pancake - a CLI/Emacs web/gopher/file browser .SH SYNOPSIS -pancake [\fIoption ...\fR] [\fcommand\fR ...] +pancake [\fIoption ...\fR] [--] [\fIcommand ...\fR] .SH DESCRIPTION Pancake utilizes pandoc and external downloaders such as curl, adding @@ -21,8 +21,10 @@ as emacs, rlwrap, tmux, screen. Print version and exit. .IP "\fB\-\-help\fR" Print a help message. -.IP "\fB\-\-embedded\fR" +.IP "\fB\-e, \-\-embedded\fR" Run in the embedded mode. +.IP "\fB\-c \fIFILE\fB, \-\-config=\fIFILE\fB\fR" +Load configuration from a specified file. .SH COMMANDS .IP "\fBquit\fR or EOF" @@ -31,8 +33,9 @@ quit pancake, cleaning the cache back .IP "\fB]\fR" forward -.IP "\fBreload config\fR" -reload config +.IP "\fBload config\fR[ \fIpath\fR]" +load configuration from a specified file or reload it from the default +one .IP "\fBhelp\fR" show a help message .IP "\fB?\fR" -- cgit v1.2.3