From b402fc7e7d98b91831bcc24b3f047e65518fa2f7 Mon Sep 17 00:00:00 2001 From: Simon Michael Date: Wed, 29 Mar 2017 08:00:30 -0700 Subject: [PATCH] lib: optserror -> usageError, consolidate with other error functions (#529) --- hledger-lib/Hledger/Data/RawOptions.hs | 9 ++------- hledger-lib/Hledger/Reports/ReportOptions.hs | 18 +++++++++--------- hledger-lib/Hledger/Utils.hs | 4 ++-- hledger-lib/Hledger/Utils/UTF8IOCompat.hs | 7 +++++++ hledger-ui/Hledger/UI/UIOptions.hs | 2 +- hledger-web/Hledger/Web/WebOptions.hs | 2 +- hledger/Hledger/Cli/CliOptions.hs | 8 ++++---- hledger/Hledger/Cli/Main.hs | 6 +++--- 8 files changed, 29 insertions(+), 27 deletions(-) diff --git a/hledger-lib/Hledger/Data/RawOptions.hs b/hledger-lib/Hledger/Data/RawOptions.hs index 07552fa8d..b2df79d49 100644 --- a/hledger-lib/Hledger/Data/RawOptions.hs +++ b/hledger-lib/Hledger/Data/RawOptions.hs @@ -17,8 +17,7 @@ module Hledger.Data.RawOptions ( maybestringopt, listofstringopt, intopt, - maybeintopt, - optserror + maybeintopt ) where @@ -58,12 +57,8 @@ maybeintopt :: String -> RawOpts -> Maybe Int maybeintopt name rawopts = let ms = maybestringopt name rawopts in case ms of Nothing -> Nothing - Just s -> Just $ readDef (optserror $ "could not parse "++name++" number: "++s) s + Just s -> Just $ readDef (usageError $ "could not parse "++name++" number: "++s) s intopt :: String -> RawOpts -> Int intopt name = fromMaybe 0 . maybeintopt name --- | Raise an error, showing the specified message plus a hint about --help. -optserror :: String -> a -optserror = error' . (++ " (run with --help for usage)") - diff --git a/hledger-lib/Hledger/Reports/ReportOptions.hs b/hledger-lib/Hledger/Reports/ReportOptions.hs index 9c438dbec..7ca7403ab 100644 --- a/hledger-lib/Hledger/Reports/ReportOptions.hs +++ b/hledger-lib/Hledger/Reports/ReportOptions.hs @@ -152,11 +152,11 @@ checkRawOpts rawopts -- our standard behaviour is to accept conflicting options actually, -- using the last one - more forgiving for overriding command-line aliases -- | countopts ["change","cumulative","historical"] > 1 --- = optserror "please specify at most one of --change, --cumulative, --historical" +-- = usageError "please specify at most one of --change, --cumulative, --historical" -- | countopts ["flat","tree"] > 1 --- = optserror "please specify at most one of --flat, --tree" +-- = usageError "please specify at most one of --flat, --tree" -- | countopts ["daily","weekly","monthly","quarterly","yearly"] > 1 --- = optserror "please specify at most one of --daily, " +-- = usageError "please specify at most one of --daily, " | otherwise = rawopts -- where -- countopts = length . filter (`boolopt` rawopts) @@ -164,7 +164,7 @@ checkRawOpts rawopts -- | Do extra validation of report options, raising an error if there's a problem. checkReportOpts :: ReportOpts -> ReportOpts checkReportOpts ropts@ReportOpts{..} = - either optserror (const ropts) $ do + either usageError (const ropts) $ do case depth_ of Just d | d < 0 -> Left "--depth should have a positive number" _ -> Right () @@ -208,11 +208,11 @@ beginDatesFromRawOpts d = catMaybes . map (begindatefromrawopt d) where begindatefromrawopt d (n,v) | n == "begin" = - either (\e -> optserror $ "could not parse "++n++" date: "++parseErrorPretty e) Just $ + either (\e -> usageError $ "could not parse "++n++" date: "++parseErrorPretty e) Just $ fixSmartDateStrEither' d (T.pack v) | n == "period" = case - either (\e -> optserror $ "could not parse period option: "++parseErrorPretty e) id $ + either (\e -> usageError $ "could not parse period option: "++parseErrorPretty e) id $ parsePeriodExpr d (stripquotes $ T.pack v) of (_, DateSpan (Just b) _) -> Just b @@ -226,11 +226,11 @@ endDatesFromRawOpts d = catMaybes . map (enddatefromrawopt d) where enddatefromrawopt d (n,v) | n == "end" = - either (\e -> optserror $ "could not parse "++n++" date: "++parseErrorPretty e) Just $ + either (\e -> usageError $ "could not parse "++n++" date: "++parseErrorPretty e) Just $ fixSmartDateStrEither' d (T.pack v) | n == "period" = case - either (\e -> optserror $ "could not parse period option: "++parseErrorPretty e) id $ + either (\e -> usageError $ "could not parse period option: "++parseErrorPretty e) id $ parsePeriodExpr d (stripquotes $ T.pack v) of (_, DateSpan _ (Just e)) -> Just e @@ -244,7 +244,7 @@ intervalFromRawOpts = lastDef NoInterval . catMaybes . map intervalfromrawopt where intervalfromrawopt (n,v) | n == "period" = - either (\e -> optserror $ "could not parse period option: "++parseErrorPretty e) (Just . fst) $ + either (\e -> usageError $ "could not parse period option: "++parseErrorPretty e) (Just . fst) $ parsePeriodExpr nulldate (stripquotes $ T.pack v) -- reference date does not affect the interval | n == "daily" = Just $ Days 1 | n == "weekly" = Just $ Weeks 1 diff --git a/hledger-lib/Hledger/Utils.hs b/hledger-lib/Hledger/Utils.hs index 6a2b48086..21c651c7c 100644 --- a/hledger-lib/Hledger/Utils.hs +++ b/hledger-lib/Hledger/Utils.hs @@ -28,7 +28,7 @@ module Hledger.Utils (---- provide these frequently used modules - or not, for c -- Debug.Trace.trace, -- module Data.PPrint, -- module Hledger.Utils.UTF8IOCompat - SystemString,fromSystemString,toSystemString,error',userError', + SystemString,fromSystemString,toSystemString,error',userError',usageError, -- the rest need to be done in each module I think ) where @@ -58,7 +58,7 @@ import Hledger.Utils.Test import Hledger.Utils.Tree -- import Prelude hiding (readFile,writeFile,appendFile,getContents,putStr,putStrLn) -- import Hledger.Utils.UTF8IOCompat (readFile,writeFile,appendFile,getContents,putStr,putStrLn) -import Hledger.Utils.UTF8IOCompat (SystemString,fromSystemString,toSystemString,error',userError') +import Hledger.Utils.UTF8IOCompat (SystemString,fromSystemString,toSystemString,error',userError',usageError) -- tuples diff --git a/hledger-lib/Hledger/Utils/UTF8IOCompat.hs b/hledger-lib/Hledger/Utils/UTF8IOCompat.hs index cca7ee7b3..d1f28820d 100644 --- a/hledger-lib/Hledger/Utils/UTF8IOCompat.hs +++ b/hledger-lib/Hledger/Utils/UTF8IOCompat.hs @@ -16,6 +16,7 @@ do the right thing, so this file is a no-op and on its way to being removed. Not carefully tested. -} +-- TODO obsolete ? module Hledger.Utils.UTF8IOCompat ( readFile, @@ -33,6 +34,7 @@ module Hledger.Utils.UTF8IOCompat ( toSystemString, error', userError', + usageError, ) where @@ -130,3 +132,8 @@ error' = -- | A SystemString-aware version of userError. userError' :: String -> IOError userError' = userError . toSystemString + +-- | A SystemString-aware version of error that adds a usage hint. +usageError :: String -> a +usageError = error' . (++ " (use -h to see usage)") + diff --git a/hledger-ui/Hledger/UI/UIOptions.hs b/hledger-ui/Hledger/UI/UIOptions.hs index f00631cb9..62d35513e 100644 --- a/hledger-ui/Hledger/UI/UIOptions.hs +++ b/hledger-ui/Hledger/UI/UIOptions.hs @@ -80,7 +80,7 @@ rawOptsToUIOpts rawopts = checkUIOpts <$> do checkUIOpts :: UIOpts -> UIOpts checkUIOpts opts = - either optserror (const opts) $ do + either usageError (const opts) $ do case maybestringopt "theme" $ rawopts_ $ cliopts_ opts of Just t | not $ elem t themeNames -> Left $ "invalid theme name: "++t _ -> Right () diff --git a/hledger-web/Hledger/Web/WebOptions.hs b/hledger-web/Hledger/Web/WebOptions.hs index 681d756a8..dae399c37 100644 --- a/hledger-web/Hledger/Web/WebOptions.hs +++ b/hledger-web/Hledger/Web/WebOptions.hs @@ -85,7 +85,7 @@ rawOptsToWebOpts rawopts = checkWebOpts <$> do checkWebOpts :: WebOpts -> WebOpts checkWebOpts wopts = - either optserror (const wopts) $ do + either usageError (const wopts) $ do let h = host_ wopts if any (not . (`elem` ".0123456789")) h then Left $ "--host requires an IP address, not "++show h diff --git a/hledger/Hledger/Cli/CliOptions.hs b/hledger/Hledger/Cli/CliOptions.hs index 9db4ad4a0..70c7a9caa 100644 --- a/hledger/Hledger/Cli/CliOptions.hs +++ b/hledger/Hledger/Cli/CliOptions.hs @@ -412,7 +412,7 @@ rawOptsToCliOpts rawopts = checkCliOpts <$> do -- | Do final validation of processed opts, raising an error if there is trouble. checkCliOpts :: CliOpts -> CliOpts checkCliOpts opts = - either optserror (const opts) $ do + either usageError (const opts) $ do -- XXX move to checkReportOpts or move _format to CliOpts case lineFormatFromOpts $ reportopts_ opts of Left err -> Left $ "could not parse format option: "++err @@ -444,7 +444,7 @@ checkCliOpts opts = getHledgerCliOpts :: Mode RawOpts -> IO CliOpts getHledgerCliOpts mode' = do args' <- getArgs - let rawopts = either optserror decodeRawOpts $ process mode' args' + let rawopts = either usageError decodeRawOpts $ process mode' args' opts <- rawOptsToCliOpts rawopts debugArgs args' opts when ("help" `inRawOpts` rawopts_ opts) $ putStr longhelp >> exitSuccess @@ -549,7 +549,7 @@ widthFromOpts :: CliOpts -> Int widthFromOpts CliOpts{width_=Nothing, available_width_=w} = w widthFromOpts CliOpts{width_=Just s} = case runParser (read `fmap` some digitChar <* eof :: ParsecT Dec String Identity Int) "(unknown)" s of - Left e -> optserror $ "could not parse width option: "++show e + Left e -> usageError $ "could not parse width option: "++show e Right w -> w -- for register: @@ -567,7 +567,7 @@ registerWidthsFromOpts :: CliOpts -> (Int, Maybe Int) registerWidthsFromOpts CliOpts{width_=Nothing, available_width_=w} = (w, Nothing) registerWidthsFromOpts CliOpts{width_=Just s} = case runParser registerwidthp "(unknown)" s of - Left e -> optserror $ "could not parse width option: "++show e + Left e -> usageError $ "could not parse width option: "++show e Right ws -> ws where registerwidthp :: (Stream s, Char ~ Token s) => ParsecT Dec s m (Int, Maybe Int) diff --git a/hledger/Hledger/Cli/Main.hs b/hledger/Hledger/Cli/Main.hs index 6537dddb8..ba65977a8 100644 --- a/hledger/Hledger/Cli/Main.hs +++ b/hledger/Hledger/Cli/Main.hs @@ -73,7 +73,7 @@ import Hledger.Cli.Tests import Hledger.Cli.Utils import Hledger.Cli.Version import Hledger.Data.Dates (getCurrentDay) -import Hledger.Data.RawOptions (RawOpts, optserror) +import Hledger.Data.RawOptions (RawOpts) import Hledger.Reports.ReportOptions (period_, interval_, queryFromOpts) import Hledger.Utils @@ -164,7 +164,7 @@ argsToCliOpts :: [String] -> [String] -> IO CliOpts argsToCliOpts args addons = do let args' = moveFlagsAfterCommand args - cmdargsopts = either optserror id $ process (mainmode addons) args' + cmdargsopts = either usageError id $ process (mainmode addons) args' cmdargsopts' = decodeRawOpts cmdargsopts rawOptsToCliOpts cmdargsopts' @@ -414,7 +414,7 @@ main = do | cmd == "convert" = error' (modeHelp oldconvertmode) >> exitFailure -- shouldn't reach here - | otherwise = optserror ("could not understand the arguments "++show args) >> exitFailure + | otherwise = usageError ("could not understand the arguments "++show args) >> exitFailure runHledgerCommand