summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authordefanor <defanor@uberspace.net>2017-12-19 02:43:21 +0300
committerdefanor <defanor@uberspace.net>2017-12-19 02:43:21 +0300
commit7f5d0b170099704d1a2016e2af1d9bfbde7ea1ad (patch)
tree33a28920e6d60e73e154c8185e7318c473ec01d4
parent6e368bc36c603a23e57a5baa14556446a8603a8e (diff)
downloadpancake-7f5d0b170099704d1a2016e2af1d9bfbde7ea1ad.zip
pancake-7f5d0b170099704d1a2016e2af1d9bfbde7ea1ad.tar.gz
pancake-7f5d0b170099704d1a2016e2af1d9bfbde7ea1ad.tar.bz2
Enable a user to specify a configuration file
This covers both command-line options and the "load config" (former "reload config") command.
-rw-r--r--Pancake.hs59
-rw-r--r--Pancake/Command.hs12
-rw-r--r--Pancake/Configuration.hs13
-rw-r--r--README3
-rw-r--r--pancake.111
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[ <path>]: 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"