cli, web: fix options breakage

This commit is contained in:
Simon Michael 2015-08-28 10:49:43 -07:00
parent c897c03469
commit 2af8d7598e
2 changed files with 6 additions and 8 deletions

View File

@ -66,8 +66,8 @@ defwebopts = WebOpts
-- instance Default WebOpts where def = defwebopts -- instance Default WebOpts where def = defwebopts
toWebOpts :: RawOpts -> IO WebOpts rawOptsToWebOpts :: RawOpts -> IO WebOpts
toWebOpts rawopts = do rawOptsToWebOpts rawopts = checkWebOpts <$> do
cliopts <- rawOptsToCliOpts rawopts cliopts <- rawOptsToCliOpts rawopts
let p = fromMaybe defport $ maybeintopt "port" rawopts let p = fromMaybe defport $ maybeintopt "port" rawopts
return defwebopts { return defwebopts {
@ -80,11 +80,9 @@ toWebOpts rawopts = do
where where
stripTrailingSlash = reverse . dropWhile (=='/') . reverse -- yesod don't like it stripTrailingSlash = reverse . dropWhile (=='/') . reverse -- yesod don't like it
checkWebOpts :: WebOpts -> IO WebOpts checkWebOpts :: WebOpts -> WebOpts
checkWebOpts opts = do checkWebOpts = id
_ <- checkCliOpts $ cliopts_ opts
return opts
getHledgerWebOpts :: IO WebOpts getHledgerWebOpts :: IO WebOpts
getHledgerWebOpts = processArgs webmode >>= return . decodeRawOpts >>= toWebOpts >>= checkWebOpts getHledgerWebOpts = processArgs webmode >>= return . decodeRawOpts >>= rawOptsToWebOpts

View File

@ -144,7 +144,7 @@ argsToCliOpts args addons = do
args' = moveFlagsAfterCommand args args' = moveFlagsAfterCommand args
cmdargsopts = processValue (mainmode addons) args' cmdargsopts = processValue (mainmode addons) args'
cmdargsopts' = decodeRawOpts cmdargsopts cmdargsopts' = decodeRawOpts cmdargsopts
rawOptsToCliOpts cmdargsopts' >>= checkCliOpts rawOptsToCliOpts cmdargsopts'
-- | A hacky workaround for cmdargs not accepting flags before the -- | A hacky workaround for cmdargs not accepting flags before the
-- subcommand name: try to detect and move such flags after the -- subcommand name: try to detect and move such flags after the