lib: optserror -> usageError, consolidate with other error functions (#529)

hledger-lib/Hledger/Data/RawOptions.hs

@@ -17,8 +17,7 @@ module Hledger.Data.RawOptions (
   maybestringopt,
   listofstringopt,
   intopt,
-  maybeintopt,
+  maybeintopt
-  optserror
 )
 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)")
-

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

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

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)")  
+

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 ()

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

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)

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