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
toWebOpts :: RawOpts -> IO WebOpts
toWebOpts rawopts = do
rawOptsToWebOpts :: RawOpts -> IO WebOpts
rawOptsToWebOpts rawopts = checkWebOpts <$> do
cliopts <- rawOptsToCliOpts rawopts
let p = fromMaybe defport $ maybeintopt "port" rawopts
return defwebopts {
@ -80,11 +80,9 @@ toWebOpts rawopts = do
where
stripTrailingSlash = reverse . dropWhile (=='/') . reverse -- yesod don't like it
checkWebOpts :: WebOpts -> IO WebOpts
checkWebOpts opts = do
_ <- checkCliOpts $ cliopts_ opts
return opts
checkWebOpts :: WebOpts -> WebOpts
checkWebOpts = id
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
cmdargsopts = processValue (mainmode addons) args'
cmdargsopts' = decodeRawOpts cmdargsopts
rawOptsToCliOpts cmdargsopts' >>= checkCliOpts
rawOptsToCliOpts cmdargsopts'
-- | A hacky workaround for cmdargs not accepting flags before the
-- subcommand name: try to detect and move such flags after the