diff --git a/hledger-lib/Hledger/Data/RawOptions.hs b/hledger-lib/Hledger/Data/RawOptions.hs index 674ae7cff..e2c46deea 100644 --- a/hledger-lib/Hledger/Data/RawOptions.hs +++ b/hledger-lib/Hledger/Data/RawOptions.hs @@ -21,7 +21,9 @@ module Hledger.Data.RawOptions ( maybestringopt, listofstringopt, intopt, + posintopt, maybeintopt, + maybeposintopt, maybecharopt ) where @@ -91,12 +93,35 @@ maybecharopt name (RawOpts rawopts) = lookup name rawopts >>= headMay listofstringopt :: String -> RawOpts -> [String] listofstringopt name (RawOpts rawopts) = [v | (k,v) <- rawopts, k==name] +-- | Reads the named option's Int argument, if it is present. +-- An argument that is too small or too large will raise an error. maybeintopt :: String -> RawOpts -> Maybe Int -maybeintopt name rawopts = - let ms = maybestringopt name rawopts in - case ms of Nothing -> Nothing - Just s -> Just $ readDef (usageError $ "could not parse "++name++" number: "++s) s +maybeintopt = maybeclippedintopt minBound maxBound +-- | Reads the named option's natural-number argument, if it is present. +-- An argument that is negative or too large will raise an error. +maybeposintopt :: String -> RawOpts -> Maybe Int +maybeposintopt = maybeclippedintopt 0 maxBound + +-- | Reads the named option's Int argument. If not present it will +-- return 0. An argument that is too small or too large will raise an error. intopt :: String -> RawOpts -> Int intopt name = fromMaybe 0 . maybeintopt name +-- | Reads the named option's natural-number argument. If not present it will +-- return 0. An argument that is negative or too large will raise an error. +posintopt :: String -> RawOpts -> Int +posintopt name = fromMaybe 0 . maybeposintopt name + +-- | Reads the named option's Int argument, if it is present. An argument +-- that does not fit within the given bounds will raise an error. +maybeclippedintopt :: Int -> Int -> String -> RawOpts -> Maybe Int +maybeclippedintopt minVal maxVal name = + fmap (intOrError . readOrError) . maybestringopt name + where + readOrError s = readDef (usageError $ "could not parse " ++ name ++ " number: " ++ s) s + intOrError n | n >= toInteger minVal && n <= toInteger maxVal = fromInteger n + | otherwise = usageError $ "argument to " ++ name + ++ " must lie in the range " + ++ show minVal ++ " to " ++ show maxVal + ++ ", but is " ++ show n diff --git a/hledger-lib/Hledger/Reports/MultiBalanceReport.hs b/hledger-lib/Hledger/Reports/MultiBalanceReport.hs index 8df8c978e..b4d88b9c8 100644 --- a/hledger-lib/Hledger/Reports/MultiBalanceReport.hs +++ b/hledger-lib/Hledger/Reports/MultiBalanceReport.hs @@ -434,13 +434,13 @@ displayedAccounts ropts q valuedaccts displayedName name | flat_ ropts = DisplayName name droppedName 1 - | otherwise = DisplayName name leaf $ level - boringParents + | otherwise = DisplayName name leaf . max 0 $ level - boringParents where droppedName = accountNameDrop (drop_ ropts) name leaf = accountNameFromComponents . reverse . map accountLeafName $ droppedName : takeWhile notDisplayed parents - level = accountNameLevel name - drop_ ropts + level = max 0 $ accountNameLevel name - drop_ ropts parents = take (level - 1) $ parentAccountNames name boringParents = if no_elide_ ropts then 0 else length $ filter notDisplayed parents notDisplayed = not . (`HM.member` displayedAccts) diff --git a/hledger-lib/Hledger/Reports/ReportOptions.hs b/hledger-lib/Hledger/Reports/ReportOptions.hs index d595b9aa5..4196fd75d 100644 --- a/hledger-lib/Hledger/Reports/ReportOptions.hs +++ b/hledger-lib/Hledger/Reports/ReportOptions.hs @@ -176,7 +176,7 @@ rawOptsToReportOpts rawopts = checkReportOpts <$> do ,statuses_ = statusesFromRawOpts rawopts' ,value_ = valuationTypeFromRawOpts rawopts' ,infer_value_ = boolopt "infer-value" rawopts' - ,depth_ = maybeintopt "depth" rawopts' + ,depth_ = maybeposintopt "depth" rawopts' ,display_ = maybedisplayopt d rawopts' ,date2_ = boolopt "date2" rawopts' ,empty_ = boolopt "empty" rawopts' @@ -188,7 +188,7 @@ rawOptsToReportOpts rawopts = checkReportOpts <$> do ,related_ = boolopt "related" rawopts' ,balancetype_ = balancetypeopt rawopts' ,accountlistmode_ = accountlistmodeopt rawopts' - ,drop_ = intopt "drop" rawopts' + ,drop_ = posintopt "drop" rawopts' ,row_total_ = boolopt "row-total" rawopts' ,no_total_ = boolopt "no-total" rawopts' ,sort_amount_ = boolopt "sort-amount" rawopts' diff --git a/hledger-ui/Hledger/UI/UIState.hs b/hledger-ui/Hledger/UI/UIState.hs index d4a21606b..bbbd1210d 100644 --- a/hledger-ui/Hledger/UI/UIState.hs +++ b/hledger-ui/Hledger/UI/UIState.hs @@ -49,14 +49,14 @@ uiShowStatus copts ss = _ -> map showstatus $ sort ss where numstatuses = length [minBound..maxBound::Status] - style = maybeintopt "status-toggles" $ rawopts_ copts + style = maybeposintopt "status-toggles" $ rawopts_ copts showstatus Cleared = "cleared" showstatus Pending = "pending" showstatus Unmarked = "unmarked" reportOptsToggleStatusSomehow :: Status -> CliOpts -> ReportOpts -> ReportOpts reportOptsToggleStatusSomehow s copts ropts = - case maybeintopt "status-toggles" $ rawopts_ copts of + case maybeposintopt "status-toggles" $ rawopts_ copts of Just 2 -> reportOptsToggleStatus2 s ropts Just 3 -> reportOptsToggleStatus3 s ropts -- Just 4 -> reportOptsToggleStatus4 s ropts diff --git a/hledger-web/Hledger/Web/WebOptions.hs b/hledger-web/Hledger/Web/WebOptions.hs index 9f0b4e477..649044242 100644 --- a/hledger-web/Hledger/Web/WebOptions.hs +++ b/hledger-web/Hledger/Web/WebOptions.hs @@ -128,7 +128,7 @@ rawOptsToWebOpts rawopts = checkWebOpts <$> do cliopts <- rawOptsToCliOpts rawopts let h = fromMaybe defhost $ maybestringopt "host" rawopts - p = fromMaybe defport $ maybeintopt "port" rawopts + p = fromMaybe defport $ maybeposintopt "port" rawopts b = maybe (defbaseurl h p) stripTrailingSlash $ maybestringopt "base-url" rawopts diff --git a/hledger/Hledger/Cli/CliOptions.hs b/hledger/Hledger/Cli/CliOptions.hs index 9426228d5..b29e6d914 100644 --- a/hledger/Hledger/Cli/CliOptions.hs +++ b/hledger/Hledger/Cli/CliOptions.hs @@ -446,7 +446,7 @@ rawOptsToCliOpts rawopts = checkCliOpts <$> do ,reportopts_ = ropts ,output_file_ = maybestringopt "output-file" rawopts ,output_format_ = maybestringopt "output-format" rawopts - ,debug_ = intopt "debug" rawopts + ,debug_ = posintopt "debug" rawopts ,no_new_accounts_ = boolopt "no-new-accounts" rawopts -- add ,width_ = maybestringopt "width" rawopts ,available_width_ = availablewidth