mirror of
https://github.com/simonmichael/hledger.git
synced 2024-12-24 19:02:46 +03:00
;review, tag all error calls with an easier to find PARTIAL: comment (#1312)
This commit is contained in:
Simon Michael
parent
c60ad79727
commit
3f55c23603
@ -466,6 +466,7 @@ instance Num MixedAmount where
|
||||
fromInteger i = Mixed [fromInteger i]
|
||||
negate (Mixed as) = Mixed $ map negate as
|
||||
(+) (Mixed as) (Mixed bs) = normaliseMixedAmount $ Mixed $ as ++ bs
|
||||
-- PARTIAL:
|
||||
(*) = error' "error, mixed amounts do not support multiplication"
|
||||
abs = error' "error, mixed amounts do not support abs"
|
||||
signum = error' "error, mixed amounts do not support signum"
|
||||
|
||||
@ -59,7 +59,7 @@ commoditysymbols =
|
||||
-- | Look up one of the sample commodities' symbol by name.
|
||||
comm :: String -> CommoditySymbol
|
||||
comm name = snd $ fromMaybe
|
||||
(error' "commodity lookup failed")
|
||||
(error' "commodity lookup failed") -- PARTIAL:
|
||||
(find (\n -> fst n == name) commoditysymbols)
|
||||
|
||||
-- | Find the conversion rate between two commodities. Currently returns 1.
|
||||
|
||||
@ -241,7 +241,7 @@ splitspan start next span@(DateSpan (Just s) (Just e))
|
||||
| otherwise = DateSpan (Just subs) (Just sube) : splitspan' start next (DateSpan (Just sube) (Just e))
|
||||
where subs = start s
|
||||
sube = next subs
|
||||
splitspan' _ _ _ = error' "won't happen, avoids warnings"
|
||||
splitspan' _ _ _ = error' "won't happen, avoids warnings" -- PARTIAL:
|
||||
|
||||
-- | Count the days in a DateSpan, or if it is open-ended return Nothing.
|
||||
daysInSpan :: DateSpan -> Maybe Integer
|
||||
@ -344,7 +344,7 @@ parsePeriodExpr refdate s = parsewith (periodexprp refdate <* eof) (T.toLower s)
|
||||
-- | Like parsePeriodExpr, but call error' on failure.
|
||||
parsePeriodExpr' :: Day -> Text -> (Interval, DateSpan)
|
||||
parsePeriodExpr' refdate s =
|
||||
either (error' . ("failed to parse:" ++) . customErrorBundlePretty) id $
|
||||
either (error' . ("failed to parse:" ++) . customErrorBundlePretty) id $ -- PARTIAL:
|
||||
parsePeriodExpr refdate s
|
||||
|
||||
maybePeriod :: Day -> Text -> Maybe (Interval,DateSpan)
|
||||
@ -385,6 +385,7 @@ spanFromSmartDate refdate sdate = DateSpan (Just b) (Just e)
|
||||
span (SmartRel This Year) = (thisyear refdate, nextyear refdate)
|
||||
span (SmartRel Last Year) = (prevyear refdate, thisyear refdate)
|
||||
span (SmartRel Next Year) = (nextyear refdate, startofyear $ addGregorianYearsClip 2 refdate)
|
||||
-- PARTIAL:
|
||||
span s@(SmartYMD Nothing Nothing Nothing) = error' $ "Ill-defined SmartDate " ++ show s
|
||||
span s@(SmartYMD (Just _) Nothing (Just _)) = error' $ "Ill-defined SmartDate " ++ show s
|
||||
span (SmartYMD y m (Just d)) = (day, nextday day) where day = fromGregorian (fromMaybe ry y) (fromMaybe rm m) d
|
||||
@ -398,7 +399,7 @@ spanFromSmartDate refdate sdate = DateSpan (Just b) (Just e)
|
||||
-- the provided reference date, or raise an error.
|
||||
fixSmartDateStr :: Day -> Text -> String
|
||||
fixSmartDateStr d s =
|
||||
either (error' . printf "could not parse date %s %s" (show s) . show) id $
|
||||
either (error' . printf "could not parse date %s %s" (show s) . show) id $ -- PARTIAL:
|
||||
(fixSmartDateStrEither d s :: Either (ParseErrorBundle Text CustomErr) String)
|
||||
|
||||
-- | A safe version of fixSmartDateStr.
|
||||
@ -562,6 +563,7 @@ startofyear day = fromGregorian y 1 1 where (y,_,_) = toGregorian day
|
||||
-- 2017-01-01
|
||||
nthdayofyearcontaining :: Month -> MonthDay -> Day -> Day
|
||||
nthdayofyearcontaining m md date
|
||||
-- PARTIAL:
|
||||
| not (validMonth m) = error' $ "nthdayofyearcontaining: invalid month "++show m
|
||||
| not (validDay md) = error' $ "nthdayofyearcontaining: invalid day " ++show md
|
||||
| mmddOfSameYear <= date = mmddOfSameYear
|
||||
@ -590,6 +592,7 @@ nthdayofyearcontaining m md date
|
||||
-- 2017-10-30
|
||||
nthdayofmonthcontaining :: MonthDay -> Day -> Day
|
||||
nthdayofmonthcontaining md date
|
||||
-- PARTIAL:
|
||||
| not (validDay md) = error' $ "nthdayofmonthcontaining: invalid day " ++show md
|
||||
| nthOfSameMonth <= date = nthOfSameMonth
|
||||
| otherwise = nthOfPrevMonth
|
||||
@ -645,8 +648,10 @@ nthweekdayofmonthcontaining n wd d | nthWeekdaySameMonth <= d = nthWeekdaySameM
|
||||
nthWeekdayPrevMonth = advancetonthweekday n wd $ prevmonth d
|
||||
|
||||
-- | Advance to nth weekday wd after given start day s
|
||||
-- Can call error.
|
||||
advancetonthweekday :: Int -> WeekDay -> Day -> Day
|
||||
advancetonthweekday n wd s =
|
||||
-- PARTIAL:
|
||||
maybe err (addWeeks (n-1)) $ firstMatch (>=s) $ iterate (addWeeks 1) $ firstweekday s
|
||||
where
|
||||
err = error' "advancetonthweekday: should not happen"
|
||||
@ -694,7 +699,7 @@ parsedateM s = asum [
|
||||
-- >>> parsedate "2008/02/03"
|
||||
-- 2008-02-03
|
||||
parsedate :: String -> Day
|
||||
parsedate s = fromMaybe (error' $ "could not parse date \"" ++ s ++ "\"")
|
||||
parsedate s = fromMaybe (error' $ "could not parse date \"" ++ s ++ "\"") -- PARTIAL:
|
||||
(parsedateM s)
|
||||
-- doctests I haven't been able to make compatible with both GHC 7 and 8
|
||||
-- -- >>> parsedate "2008/02/03/"
|
||||
|
||||
@ -311,7 +311,7 @@ journalCashAccountQuery :: Journal -> Query
|
||||
journalCashAccountQuery j =
|
||||
case M.lookup Cash (jdeclaredaccounttypes j) of
|
||||
Just _ -> journalAccountTypeQuery [Cash] notused j
|
||||
where notused = error' "journalCashAccountQuery: this should not have happened!" -- XXX ugly
|
||||
where notused = error' "journalCashAccountQuery: this should not have happened!" -- PARTIAL:
|
||||
Nothing -> And [journalAssetAccountQuery j
|
||||
,Not $ Acct "(investment|receivable|:A/R|:fixed)"
|
||||
]
|
||||
|
||||
@ -242,6 +242,7 @@ writeJsonFile f = TL.writeFile f . toJsonText
|
||||
readJsonFile :: FromJSON a => FilePath -> IO a
|
||||
readJsonFile f = do
|
||||
bl <- BL.readFile f
|
||||
-- PARTIAL:
|
||||
let v = fromMaybe (error $ "could not decode JSON in "++show f++" to target value")
|
||||
(decode bl :: Maybe Value)
|
||||
case fromJSON v :: FromJSON a => Result a of
|
||||
|
||||
@ -38,7 +38,7 @@ _ptgen str = do
|
||||
t = T.pack str
|
||||
(i,s) = parsePeriodExpr' nulldate t
|
||||
case checkPeriodicTransactionStartDate i s t of
|
||||
Just e -> error' e
|
||||
Just e -> error' e -- PARTIAL:
|
||||
Nothing ->
|
||||
mapM_ (putStr . showTransaction) $
|
||||
runPeriodicTransaction
|
||||
@ -50,7 +50,7 @@ _ptgenspan str span = do
|
||||
t = T.pack str
|
||||
(i,s) = parsePeriodExpr' nulldate t
|
||||
case checkPeriodicTransactionStartDate i s t of
|
||||
Just e -> error' e
|
||||
Just e -> error' e -- PARTIAL:
|
||||
Nothing ->
|
||||
mapM_ (putStr . showTransaction) $
|
||||
runPeriodicTransaction
|
||||
|
||||
@ -94,7 +94,7 @@ entryFromTimeclockInOut :: TimeclockEntry -> TimeclockEntry -> Transaction
|
||||
entryFromTimeclockInOut i o
|
||||
| otime >= itime = t
|
||||
| otherwise =
|
||||
error' $ "clock-out time less than clock-in time in:\n" ++ showTransaction t
|
||||
error' $ "clock-out time less than clock-in time in:\n" ++ showTransaction t -- PARTIAL:
|
||||
where
|
||||
t = Transaction {
|
||||
tindex = 0,
|
||||
|
||||
@ -167,7 +167,7 @@ amountApplyValuation priceoracle styles periodlast mreportlast today ismultiperi
|
||||
case v of
|
||||
AtCost Nothing -> styleAmount styles $ amountCost a
|
||||
AtCost mc -> amountValueAtDate priceoracle styles mc periodlast $ styleAmount styles $ amountCost a
|
||||
AtThen _mc -> error' unsupportedValueThenError -- TODO
|
||||
AtThen _mc -> error' unsupportedValueThenError -- PARTIAL:
|
||||
-- amountValueAtDate priceoracle styles mc periodlast a -- posting date unknown, handle like AtEnd
|
||||
AtEnd mc -> amountValueAtDate priceoracle styles mc periodlast a
|
||||
AtNow mc -> amountValueAtDate priceoracle styles mc today a
|
||||
@ -402,7 +402,7 @@ node m = fst . fst . mkNode m
|
||||
-- lowest-sorting label is used.
|
||||
pathEdgeLabels :: (Show b, Ord b) => Gr a b -> [Node] -> [b]
|
||||
pathEdgeLabels g = map frommaybe . map (nodesEdgeLabel g) . pathEdges
|
||||
where frommaybe = fromMaybe (error' "pathEdgeLabels: expected no Nothings here")
|
||||
where frommaybe = fromMaybe (error' "pathEdgeLabels: expected no Nothings here") -- PARTIAL:
|
||||
|
||||
-- | Convert a path to node pairs representing the path's edges.
|
||||
pathEdges :: [Node] -> [(Node,Node)]
|
||||
|
||||
@ -282,7 +282,7 @@ parseQueryTerm _ (T.stripPrefix "status:" -> Just s) =
|
||||
case parseStatus s of Left e -> Left $ "\"status:"++T.unpack s++"\" gave a parse error: " ++ e
|
||||
Right st -> Right $ Left $ StatusQ st
|
||||
parseQueryTerm _ (T.stripPrefix "real:" -> Just s) = Right $ Left $ Real $ parseBool s || T.null s
|
||||
parseQueryTerm _ (T.stripPrefix "amt:" -> Just s) = Right $ Left $ Amt ord q where (ord, q) = either error id $ parseAmountQueryTerm s
|
||||
parseQueryTerm _ (T.stripPrefix "amt:" -> Just s) = Right $ Left $ Amt ord q where (ord, q) = either error id $ parseAmountQueryTerm s -- PARTIAL:
|
||||
parseQueryTerm _ (T.stripPrefix "empty:" -> Just s) = Right $ Left $ Empty $ parseBool s
|
||||
parseQueryTerm _ (T.stripPrefix "depth:" -> Just s)
|
||||
| n >= 0 = Right $ Left $ Depth n
|
||||
|
||||
@ -90,7 +90,7 @@ journalDefaultFilename = ".hledger.journal"
|
||||
-- | Read a Journal from the given text, assuming journal format; or
|
||||
-- throw an error.
|
||||
readJournal' :: Text -> IO Journal
|
||||
readJournal' t = readJournal def Nothing t >>= either error' return
|
||||
readJournal' t = readJournal def Nothing t >>= either error' return -- PARTIAL:
|
||||
|
||||
-- | @readJournal iopts mfile txt@
|
||||
--
|
||||
@ -116,7 +116,7 @@ readJournal iopts mpath txt = do
|
||||
|
||||
-- | Read the default journal file specified by the environment, or raise an error.
|
||||
defaultJournal :: IO Journal
|
||||
defaultJournal = defaultJournalPath >>= readJournalFile def >>= either error' return
|
||||
defaultJournal = defaultJournalPath >>= readJournalFile def >>= either error' return -- PARTIAL:
|
||||
|
||||
-- | Get the default journal file path specified by the environment.
|
||||
-- Like ledger, we look first for the LEDGER_FILE environment
|
||||
|
||||
@ -713,7 +713,7 @@ amountp' :: String -> Amount
|
||||
amountp' s =
|
||||
case runParser (evalStateT (amountp <* eof) nulljournal) "" (T.pack s) of
|
||||
Right amt -> amt
|
||||
Left err -> error' $ show err -- XXX should throwError
|
||||
Left err -> error' $ show err -- PARTIAL: XXX should throwError
|
||||
|
||||
-- | Parse a mixed amount from a string, or get an error.
|
||||
mamountp' :: String -> MixedAmount
|
||||
|
||||
@ -101,7 +101,7 @@ reader = Reader
|
||||
{rFormat = "csv"
|
||||
,rExtensions = ["csv","tsv","ssv"]
|
||||
,rReadFn = parse
|
||||
,rParser = error' "sorry, CSV files can't be included yet"
|
||||
,rParser = error' "sorry, CSV files can't be included yet" -- PARTIAL:
|
||||
}
|
||||
|
||||
-- | Parse and post-process a "Journal" from CSV data, or give an error.
|
||||
@ -908,6 +908,7 @@ transactionFromCsvRecord sourcepos rules record = t
|
||||
|
||||
mdateformat = rule "date-format"
|
||||
date = fromMaybe "" $ fieldval "date"
|
||||
-- PARTIAL:
|
||||
date' = fromMaybe (error' $ mkdateerror "date" date mdateformat) $ parsedate' date
|
||||
mdate2 = fieldval "date2"
|
||||
mdate2' = maybe Nothing (maybe (error' $ mkdateerror "date2" (fromMaybe "" mdate2) mdateformat) Just . parsedate') mdate2
|
||||
@ -1010,7 +1011,7 @@ getAmount rules record currency p1IsVirtual n =
|
||||
[] -> Nothing
|
||||
[(f,a)] | "-out" `isSuffixOf` f -> Just (-a) -- for -out fields, flip the sign
|
||||
[(_,a)] -> Just a
|
||||
fs -> error' $ unlines $ [
|
||||
fs -> error' $ unlines $ [ -- PARTIAL:
|
||||
"multiple non-zero amounts or multiple zero amounts assigned,"
|
||||
,"please ensure just one. (https://hledger.org/csv.html#amount)"
|
||||
," " ++ showRecord record
|
||||
@ -1028,7 +1029,7 @@ getAmount rules record currency p1IsVirtual n =
|
||||
-- The CSV rules and record are provided for the error message.
|
||||
parseAmount :: CsvRules -> CsvRecord -> String -> String -> MixedAmount
|
||||
parseAmount rules record currency amountstr =
|
||||
either mkerror (Mixed . (:[])) $
|
||||
either mkerror (Mixed . (:[])) $ -- PARTIAL:
|
||||
runParser (evalStateT (amountp <* eof) nulljournal) "" $
|
||||
T.pack $ (currency++) $ simplifySign amountstr
|
||||
where
|
||||
@ -1086,7 +1087,7 @@ mkBalanceAssertion rules record (amt, pos) = assrt{baamount=amt, baposition=pos}
|
||||
Just "==" -> nullassertion{batotal=True}
|
||||
Just "=*" -> nullassertion{bainclusive=True}
|
||||
Just "==*" -> nullassertion{batotal=True, bainclusive=True}
|
||||
Just x -> error' $ unlines
|
||||
Just x -> error' $ unlines -- PARTIAL:
|
||||
[ "balance-type \"" ++ x ++"\" is invalid. Use =, ==, =* or ==*."
|
||||
, showRecord record
|
||||
, showRules rules record
|
||||
|
||||
@ -110,13 +110,14 @@ accountTransactionsReport ropts j reportq thisacctq = (label, items)
|
||||
filter (matchesTransaction thisacctq . filterTransactionPostings (And [realq, statusq])) ts2
|
||||
|
||||
-- maybe convert these transactions to cost or value
|
||||
-- PARTIAL:
|
||||
prices = journalPriceOracle (infer_value_ ropts) j
|
||||
styles = journalCommodityStyles j
|
||||
periodlast =
|
||||
fromMaybe (error' "journalApplyValuation: expected a non-empty journal") $ -- XXX shouldn't happen
|
||||
reportPeriodOrJournalLastDay ropts j
|
||||
mreportlast = reportPeriodLastDay ropts
|
||||
today = fromMaybe (error' "journalApplyValuation: could not pick a valuation date, ReportOpts today_ is unset") $ today_ ropts
|
||||
today = fromMaybe (error' "journalApplyValuation: could not pick a valuation date, ReportOpts today_ is unset") $ today_ ropts -- XXX shouldn't happen
|
||||
multiperiod = interval_ ropts /= NoInterval
|
||||
tval = case value_ ropts of
|
||||
Just v -> \t -> transactionApplyValuation prices styles periodlast mreportlast today multiperiod t v
|
||||
|
||||
@ -101,7 +101,7 @@ budgetReport ropts' assrt reportspan d j = dbg1 "sortedbudgetreport" budgetrepor
|
||||
-- their purpose is to set goal amounts (of change) per account and period.
|
||||
budgetJournal :: Bool -> ReportOpts -> DateSpan -> Journal -> Journal
|
||||
budgetJournal assrt _ropts reportspan j =
|
||||
either error' id $ journalBalanceTransactions assrt j{ jtxns = budgetts }
|
||||
either error' id $ journalBalanceTransactions assrt j{ jtxns = budgetts } -- PARTIAL:
|
||||
where
|
||||
budgetspan = dbg2 "budgetspan" $ reportspan
|
||||
budgetts =
|
||||
@ -218,7 +218,7 @@ budgetReportAsText ropts@ReportOpts{..} budgetr =
|
||||
(showDateSpan $ periodicReportSpan budgetr)
|
||||
(case value_ of
|
||||
Just (AtCost _mc) -> ", valued at cost"
|
||||
Just (AtThen _mc) -> error' unsupportedValueThenError -- TODO
|
||||
Just (AtThen _mc) -> error' unsupportedValueThenError -- PARTIAL:
|
||||
Just (AtEnd _mc) -> ", valued at period ends"
|
||||
Just (AtNow _mc) -> ", current value"
|
||||
-- XXX duplicates the above
|
||||
|
||||
@ -45,7 +45,7 @@ entriesReport ropts@ReportOpts{..} q j@Journal{..} =
|
||||
where
|
||||
periodlast = fromMaybe today $ reportPeriodOrJournalLastDay ropts j
|
||||
mreportlast = reportPeriodLastDay ropts
|
||||
today = fromMaybe (error' "erValue: could not pick a valuation date, ReportOpts today_ is unset") today_ -- should not happen
|
||||
today = fromMaybe (error' "erValue: could not pick a valuation date, ReportOpts today_ is unset") today_ -- PARTIAL: should not happen
|
||||
|
||||
tests_EntriesReport = tests "EntriesReport" [
|
||||
tests "entriesReport" [
|
||||
|
||||
@ -318,7 +318,7 @@ accumValueAmounts :: ReportOpts -> Journal -> PriceOracle -> [DateSpan]
|
||||
-> HashMap ClippedAccountName Account
|
||||
-> HashMap ClippedAccountName (Map DateSpan Account)
|
||||
-> HashMap ClippedAccountName (Map DateSpan Account)
|
||||
accumValueAmounts ropts j priceoracle colspans startbals acctchanges =
|
||||
accumValueAmounts ropts j priceoracle colspans startbals acctchanges = -- PARTIAL:
|
||||
HM.mapWithKey processRow $ acctchanges <> (mempty <$ startbals)
|
||||
where
|
||||
-- Must accumulate before valuing, since valuation can change without any
|
||||
@ -565,10 +565,13 @@ subaccountTallies as = foldr incrementParent mempty allaccts
|
||||
allaccts = expandAccountNames as
|
||||
incrementParent a = HM.insertWith (+) (parentAccountName a) 1
|
||||
|
||||
-- | Helper to calculate the percentage from two mixed. Keeps the sign of the first argument.
|
||||
-- | A helper: what percentage is the second mixed amount of the first ?
|
||||
-- Keeps the sign of the first amount.
|
||||
-- Uses unifyMixedAmount to unify each argument and then divides them.
|
||||
-- Both amounts should be in the same, single commodity.
|
||||
-- This can call error if the arguments are not right.
|
||||
perdivide :: MixedAmount -> MixedAmount -> MixedAmount
|
||||
perdivide a b = fromMaybe (error' errmsg) $ do
|
||||
perdivide a b = fromMaybe (error' errmsg) $ do -- PARTIAL:
|
||||
a' <- unifyMixedAmount a
|
||||
b' <- unifyMixedAmount b
|
||||
guard $ amountIsZero a' || amountIsZero b' || acommodity a' == acommodity b'
|
||||
|
||||
@ -76,7 +76,7 @@ postingsReport ropts@ReportOpts{..} q j =
|
||||
styles = journalCommodityStyles j
|
||||
priceoracle = journalPriceOracle infer_value_ j
|
||||
multiperiod = interval_ /= NoInterval
|
||||
today = fromMaybe (error' "postingsReport: could not pick a valuation date, ReportOpts today_ is unset") today_
|
||||
today = fromMaybe (error' "postingsReport: could not pick a valuation date, ReportOpts today_ is unset") today_ -- PARTIAL:
|
||||
|
||||
-- postings to be included in the report, and similarly-matched postings before the report start date
|
||||
(precedingps, reportps) = matchedPostingsBeforeAndDuring ropts q j reportspan
|
||||
@ -95,7 +95,7 @@ postingsReport ropts@ReportOpts{..} q j =
|
||||
where
|
||||
mreportlast = reportPeriodLastDay ropts
|
||||
reportorjournallast =
|
||||
fromMaybe (error' "postingsReport: expected a non-empty journal") $ -- XXX shouldn't happen
|
||||
fromMaybe (error' "postingsReport: expected a non-empty journal") $ -- PARTIAL: shouldn't happen
|
||||
reportPeriodOrJournalLastDay ropts j
|
||||
|
||||
-- Posting report items ready for display.
|
||||
@ -118,7 +118,7 @@ postingsReport ropts@ReportOpts{..} q j =
|
||||
-- XXX constrain valuation type to AtDate daybeforereportstart here ?
|
||||
where
|
||||
daybeforereportstart =
|
||||
maybe (error' "postingsReport: expected a non-empty journal") -- XXX shouldn't happen
|
||||
maybe (error' "postingsReport: expected a non-empty journal") -- PARTIAL: shouldn't happen
|
||||
(addDays (-1))
|
||||
$ reportPeriodOrJournalStart ropts j
|
||||
|
||||
|
||||
@ -327,7 +327,7 @@ intervalFromRawOpts = lastDef NoInterval . collectopts intervalfromrawopt
|
||||
(\e -> usageError $ "could not parse period option: "++customErrorBundlePretty e)
|
||||
extractIntervalOrNothing $
|
||||
parsePeriodExpr
|
||||
(error' "intervalFromRawOpts: did not expect to need today's date here") -- should not happen; we are just getting the interval, which does not use the reference date
|
||||
(error' "intervalFromRawOpts: did not expect to need today's date here") -- PARTIAL: should not happen; we are just getting the interval, which does not use the reference date
|
||||
(stripquotes $ T.pack v)
|
||||
| n == "daily" = Just $ Days 1
|
||||
| n == "weekly" = Just $ Weeks 1
|
||||
@ -466,7 +466,7 @@ queryFromOpts :: Day -> ReportOpts -> Query
|
||||
queryFromOpts d ropts = simplifyQuery . And $ [flagsq, argsq]
|
||||
where
|
||||
flagsq = queryFromOptsOnly d ropts
|
||||
argsq = fst $ either error' id $ parseQuery d (T.pack $ query_ ropts) -- TODO:
|
||||
argsq = fst $ either error' id $ parseQuery d (T.pack $ query_ ropts) -- PARTIAL:
|
||||
|
||||
-- | Convert report options to a query, ignoring any non-flag command line arguments.
|
||||
queryFromOptsOnly :: Day -> ReportOpts -> Query
|
||||
@ -484,7 +484,7 @@ queryFromOptsOnly _d ReportOpts{..} = simplifyQuery $ And flagsq
|
||||
-- | Convert report options and arguments to query options.
|
||||
-- If there is a parsing problem, this function calls error.
|
||||
queryOptsFromOpts :: Day -> ReportOpts -> [QueryOpt]
|
||||
queryOptsFromOpts d = snd . either error' id . parseQuery d . T.pack . query_
|
||||
queryOptsFromOpts d = snd . either error' id . parseQuery d . T.pack . query_ -- PARTIAL:
|
||||
|
||||
-- Report dates.
|
||||
|
||||
|
||||
@ -162,7 +162,8 @@ applyN n f | n < 1 = id
|
||||
expandPath :: FilePath -> FilePath -> IO FilePath -- general type sig for use in reader parsers
|
||||
expandPath _ "-" = return "-"
|
||||
expandPath curdir p = (if isRelative p then (curdir </>) else id) `liftM` expandHomePath p
|
||||
|
||||
-- PARTIAL:
|
||||
|
||||
-- | Expand user home path indicated by tilde prefix
|
||||
expandHomePath :: FilePath -> IO FilePath
|
||||
expandHomePath = \case
|
||||
|
||||
@ -108,7 +108,7 @@ fromparse
|
||||
fromparse = either parseerror id
|
||||
|
||||
parseerror :: (Show t, Show (Token t), Show e) => ParseErrorBundle t e -> a
|
||||
parseerror e = error' $ showParseError e
|
||||
parseerror e = error' $ showParseError e -- PARTIAL:
|
||||
|
||||
showParseError
|
||||
:: (Show t, Show (Token t), Show e)
|
||||
|
||||
@ -130,6 +130,7 @@ replaceMatch replpat s matchgroups = pre ++ repl ++ post
|
||||
replaceBackReference :: MatchText String -> String -> String
|
||||
replaceBackReference grps ('\\':s@(_:_)) | all isDigit s =
|
||||
case read s of n | n `elem` indices grps -> fst (grps ! n)
|
||||
-- PARTIAL:D
|
||||
_ -> error' $ "no match group exists for backreference \"\\"++s++"\""
|
||||
replaceBackReference _ s = error' $ "replaceBackReference called on non-numeric-backreference \""++s++"\", shouldn't happen"
|
||||
|
||||
|
||||
@ -116,7 +116,7 @@ asInit d reset ui@UIState{
|
||||
}
|
||||
|
||||
|
||||
asInit _ _ _ = error "init function called with wrong screen type, should not happen"
|
||||
asInit _ _ _ = error "init function called with wrong screen type, should not happen" -- PARTIAL:
|
||||
|
||||
asDraw :: UIState -> [Widget Name]
|
||||
asDraw UIState{aopts=_uopts@UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts}}
|
||||
@ -222,7 +222,7 @@ asDraw UIState{aopts=_uopts@UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts}}
|
||||
,("q", str "quit")
|
||||
]
|
||||
|
||||
asDraw _ = error "draw function called with wrong screen type, should not happen"
|
||||
asDraw _ = error "draw function called with wrong screen type, should not happen" -- PARTIAL:
|
||||
|
||||
asDrawItem :: (Int,Int) -> Bool -> AccountsScreenItem -> Widget Name
|
||||
asDrawItem (acctwidth, balwidth) selected AccountsScreenItem{..} =
|
||||
@ -393,7 +393,7 @@ asHandle ui0@UIState{
|
||||
where
|
||||
journalspan = journalDateSpan False j
|
||||
|
||||
asHandle _ _ = error "event handler called with wrong screen type, should not happen"
|
||||
asHandle _ _ = error "event handler called with wrong screen type, should not happen" -- PARTIAL:
|
||||
|
||||
asSetSelectedAccount a s@AccountsScreen{} = s & asSelectedAccount .~ a
|
||||
asSetSelectedAccount _ s = s
|
||||
|
||||
@ -41,7 +41,7 @@ errorScreen = ErrorScreen{
|
||||
|
||||
esInit :: Day -> Bool -> UIState -> UIState
|
||||
esInit _ _ ui@UIState{aScreen=ErrorScreen{}} = ui
|
||||
esInit _ _ _ = error "init function called with wrong screen type, should not happen"
|
||||
esInit _ _ _ = error "init function called with wrong screen type, should not happen" -- PARTIAL:
|
||||
|
||||
esDraw :: UIState -> [Widget Name]
|
||||
esDraw UIState{aopts=UIOpts{cliopts_=copts@CliOpts{}}
|
||||
@ -72,7 +72,7 @@ esDraw UIState{aopts=UIOpts{cliopts_=copts@CliOpts{}}
|
||||
,("q", "quit")
|
||||
]
|
||||
|
||||
esDraw _ = error "draw function called with wrong screen type, should not happen"
|
||||
esDraw _ = error "draw function called with wrong screen type, should not happen" -- PARTIAL:
|
||||
|
||||
esHandle :: UIState -> BrickEvent Name AppEvent -> EventM Name (Next UIState)
|
||||
esHandle ui@UIState{aScreen=ErrorScreen{..}
|
||||
@ -111,7 +111,7 @@ esHandle ui@UIState{aScreen=ErrorScreen{..}
|
||||
VtyEvent (EvKey (KChar 'z') [MCtrl]) -> suspend ui
|
||||
_ -> continue ui
|
||||
|
||||
esHandle _ _ = error "event handler called with wrong screen type, should not happen"
|
||||
esHandle _ _ = error "event handler called with wrong screen type, should not happen" -- PARTIAL:
|
||||
|
||||
-- | Parse the file name, line and column number from a hledger parse error message, if possible.
|
||||
-- Temporary, we should keep the original parse error location. XXX
|
||||
|
||||
@ -108,7 +108,7 @@ runBrickUi uopts@UIOpts{cliopts_=copts@CliOpts{inputopts_=_iopts,reportopts_=rop
|
||||
where
|
||||
q = queryFromOpts d ropts
|
||||
datespanfromargs = queryDateSpan (date2_ ropts) $ fst $
|
||||
either error' id $ parseQuery d (T.pack $ query_ ropts)
|
||||
either error' id $ parseQuery d (T.pack $ query_ ropts) -- PARTIAL:
|
||||
periodfromoptsandargs =
|
||||
dateSpanAsPeriod $ spansIntersect [periodAsDateSpan $ period_ ropts, datespanfromargs]
|
||||
filteredQueryArg = \case
|
||||
@ -130,7 +130,7 @@ runBrickUi uopts@UIOpts{cliopts_=copts@CliOpts{inputopts_=_iopts,reportopts_=rop
|
||||
Just apat -> (rsSetAccount acct False registerScreen, [ascr'])
|
||||
where
|
||||
acct = headDef
|
||||
(error' $ "--register "++apat++" did not match any account")
|
||||
(error' $ "--register "++apat++" did not match any account") -- PARTIAL:
|
||||
$ filter (regexMatches apat . T.unpack) $ journalAccountNames j
|
||||
-- Initialising the accounts screen is awkward, requiring
|
||||
-- another temporary UIState value..
|
||||
|
||||
@ -135,7 +135,7 @@ rsInit d reset ui@UIState{aopts=_uopts@UIOpts{cliopts_=CliOpts{reportopts_=ropts
|
||||
ts = map rsItemTransaction displayitems
|
||||
endidx = length displayitems - 1
|
||||
|
||||
rsInit _ _ _ = error "init function called with wrong screen type, should not happen"
|
||||
rsInit _ _ _ = error "init function called with wrong screen type, should not happen" -- PARTIAL:
|
||||
|
||||
rsDraw :: UIState -> [Widget Name]
|
||||
rsDraw UIState{aopts=_uopts@UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts}}
|
||||
@ -248,7 +248,7 @@ rsDraw UIState{aopts=_uopts@UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts}}
|
||||
-- ,("q", "quit")
|
||||
]
|
||||
|
||||
rsDraw _ = error "draw function called with wrong screen type, should not happen"
|
||||
rsDraw _ = error "draw function called with wrong screen type, should not happen" -- PARTIAL:
|
||||
|
||||
rsDrawItem :: (Int,Int,Int,Int,Int) -> Bool -> RegisterScreenItem -> Widget Name
|
||||
rsDrawItem (datewidth,descwidth,acctswidth,changewidth,balwidth) selected RegisterScreenItem{..} =
|
||||
@ -396,7 +396,7 @@ rsHandle ui@UIState{
|
||||
MouseDown _ _ _ _ -> continue ui
|
||||
MouseUp _ _ _ -> continue ui
|
||||
|
||||
rsHandle _ _ = error "event handler called with wrong screen type, should not happen"
|
||||
rsHandle _ _ = error "event handler called with wrong screen type, should not happen" -- PARTIAL:
|
||||
|
||||
isBlankElement mel = ((rsItemDate . snd) <$> mel) == Just ""
|
||||
|
||||
|
||||
@ -55,7 +55,7 @@ tsInit _d _reset ui@UIState{aopts=UIOpts{cliopts_=CliOpts{reportopts_=_ropts}}
|
||||
-- (acommodity$head$amounts$pamount$head$tpostings$snd$tsTransaction)
|
||||
-- `seq`
|
||||
ui
|
||||
tsInit _ _ _ = error "init function called with wrong screen type, should not happen"
|
||||
tsInit _ _ _ = error "init function called with wrong screen type, should not happen" -- PARTIAL:
|
||||
|
||||
tsDraw :: UIState -> [Widget Name]
|
||||
tsDraw UIState{aopts=UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts}}
|
||||
@ -76,10 +76,10 @@ tsDraw UIState{aopts=UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts}}
|
||||
prices = journalPriceOracle (infer_value_ ropts) j
|
||||
styles = journalCommodityStyles j
|
||||
periodlast =
|
||||
fromMaybe (error' "TransactionScreen: expected a non-empty journal") $ -- XXX shouldn't happen
|
||||
fromMaybe (error' "TransactionScreen: expected a non-empty journal") $ -- PARTIAL: shouldn't happen
|
||||
reportPeriodOrJournalLastDay ropts j
|
||||
mreportlast = reportPeriodLastDay ropts
|
||||
today = fromMaybe (error' "TransactionScreen: could not pick a valuation date, ReportOpts today_ is unset") $ today_ ropts
|
||||
today = fromMaybe (error' "TransactionScreen: could not pick a valuation date, ReportOpts today_ is unset") $ today_ ropts -- PARTIAL:
|
||||
multiperiod = interval_ ropts /= NoInterval
|
||||
|
||||
render $ defaultLayout toplabel bottomlabel $ str $
|
||||
@ -126,7 +126,7 @@ tsDraw UIState{aopts=UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts}}
|
||||
,("q", "quit")
|
||||
]
|
||||
|
||||
tsDraw _ = error "draw function called with wrong screen type, should not happen"
|
||||
tsDraw _ = error "draw function called with wrong screen type, should not happen" -- PARTIAL:
|
||||
|
||||
tsHandle :: UIState -> BrickEvent Name AppEvent -> EventM Name (Next UIState)
|
||||
tsHandle ui@UIState{aScreen=s@TransactionScreen{tsTransaction=(i,t)
|
||||
@ -204,7 +204,7 @@ tsHandle ui@UIState{aScreen=s@TransactionScreen{tsTransaction=(i,t)
|
||||
VtyEvent (EvKey (KChar 'z') [MCtrl]) -> suspend ui
|
||||
_ -> continue ui
|
||||
|
||||
tsHandle _ _ = error "event handler called with wrong screen type, should not happen"
|
||||
tsHandle _ _ = error "event handler called with wrong screen type, should not happen" -- PARTIAL:
|
||||
|
||||
-- Got to redo the register screen's transactions report, to get the latest transactions list for this screen.
|
||||
-- XXX Duplicates rsInit. Why do we have to do this as well as regenerateScreens ?
|
||||
|
||||
@ -86,7 +86,7 @@ undecorateLinks xs0@(x:_) =
|
||||
let (link, xs1) = span (isJust . fst) xs0
|
||||
(comma, xs2) = span (isNothing . fst) xs1
|
||||
in (acct, (map snd link, map snd comma)) : undecorateLinks xs2
|
||||
_ -> error "link name not decorated with account"
|
||||
_ -> error "link name not decorated with account" -- PARTIAL:
|
||||
|
||||
decorateLinks :: [(acct, ([char], [char]))] -> [(Maybe acct, char)]
|
||||
decorateLinks =
|
||||
|
||||
@ -134,7 +134,7 @@ rawOptsToWebOpts rawopts =
|
||||
maybestringopt "base-url" rawopts
|
||||
caps' = join $ T.splitOn "," . T.pack <$> listofstringopt "capabilities" rawopts
|
||||
caps = case traverse capabilityFromText caps' of
|
||||
Left e -> error' ("Unknown capability: " ++ T.unpack e)
|
||||
Left e -> error' ("Unknown capability: " ++ T.unpack e) -- PARTIAL:
|
||||
Right [] -> [CapView, CapAdd]
|
||||
Right xs -> xs
|
||||
sock = stripTrailingSlash <$> maybestringopt "socket" rawopts
|
||||
|
||||
@ -91,7 +91,7 @@ addForm j today = identifyForm "add" $ \extra -> do
|
||||
|
||||
listField = Field
|
||||
{ fieldParse = const . pure . Right . Just . dropWhileEnd T.null
|
||||
, fieldView = error "Don't render using this!"
|
||||
, fieldView = error "Don't render using this!" -- PARTIAL:
|
||||
, fieldEnctype = UrlEncoded
|
||||
}
|
||||
|
||||
|
||||
@ -323,7 +323,7 @@ hledgerCommandMode :: CommandDoc -> [Flag RawOpts] -> [(String, [Flag RawOpts])]
|
||||
-> [Flag RawOpts] -> ([Arg RawOpts], Maybe (Arg RawOpts)) -> Mode RawOpts
|
||||
hledgerCommandMode doc unnamedflaggroup namedflaggroups hiddenflaggroup argsdescr =
|
||||
case parseCommandDoc doc of
|
||||
Nothing -> error' $ "Could not parse command doc:\n"++doc++"\n"
|
||||
Nothing -> error' $ "Could not parse command doc:\n"++doc++"\n" -- PARTIAL:
|
||||
Just (names, shorthelp, longhelplines) ->
|
||||
(defCommandMode names) {
|
||||
modeHelp = shorthelp
|
||||
|
||||
@ -304,7 +304,7 @@ tests_Commands = tests "Commands" [
|
||||
let
|
||||
ignoresourcepos j = j{jtxns=map (\t -> t{tsourcepos=nullsourcepos}) (jtxns j)}
|
||||
sameParse str1 str2 = do
|
||||
j1 <- readJournal def Nothing str1 >>= either error' (return . ignoresourcepos)
|
||||
j1 <- readJournal def Nothing str1 >>= either error' (return . ignoresourcepos) -- PARTIAL:
|
||||
j2 <- readJournal def Nothing str2 >>= either error' (return . ignoresourcepos)
|
||||
j1 @?= j2{jlastreadtime=jlastreadtime j1, jfiles=jfiles j1} --, jparsestate=jparsestate j1}
|
||||
sameParse
|
||||
@ -322,19 +322,19 @@ tests_Commands = tests "Commands" [
|
||||
)
|
||||
|
||||
,test "preserves \"virtual\" posting type" $ do
|
||||
j <- readJournal def Nothing "apply account test\n2008/12/07 One\n (from) $-1\n (to) $1\n" >>= either error' return
|
||||
j <- readJournal def Nothing "apply account test\n2008/12/07 One\n (from) $-1\n (to) $1\n" >>= either error' return -- PARTIAL:
|
||||
let p = head $ tpostings $ head $ jtxns j
|
||||
paccount p @?= "test:from"
|
||||
ptype p @?= VirtualPosting
|
||||
]
|
||||
|
||||
,test "alias directive" $ do
|
||||
j <- readJournal def Nothing "!alias expenses = equity:draw:personal\n1/1\n (expenses:food) 1\n" >>= either error' return
|
||||
j <- readJournal def Nothing "!alias expenses = equity:draw:personal\n1/1\n (expenses:food) 1\n" >>= either error' return -- PARTIAL:
|
||||
let p = head $ tpostings $ head $ jtxns j
|
||||
paccount p @?= "equity:draw:personal:food"
|
||||
|
||||
,test "Y default year directive" $ do
|
||||
j <- readJournal def Nothing defaultyear_journal_txt >>= either error' return
|
||||
j <- readJournal def Nothing defaultyear_journal_txt >>= either error' return -- PARTIAL:
|
||||
tdate (head $ jtxns j) @?= fromGregorian 2009 1 1
|
||||
|
||||
,test "ledgerAccountNames" $
|
||||
|
||||
@ -121,7 +121,7 @@ getAndAddTransactions es@EntryState{..} = (do
|
||||
let defaultPrevInput = PrevInput{prevDateAndCode=Nothing, prevDescAndCmnt=Nothing, prevAccount=[], prevAmountAndCmnt=[]}
|
||||
mt <- runInputT (setComplete noCompletion defaultSettings) (System.Console.Wizard.run $ haskeline $ confirmedTransactionWizard defaultPrevInput es [])
|
||||
case mt of
|
||||
Nothing -> error "Could not interpret the input, restarting" -- caught below causing a restart, I believe
|
||||
Nothing -> error "Could not interpret the input, restarting" -- caught below causing a restart, I believe -- PARTIAL:
|
||||
Just t -> do
|
||||
j <- if debug_ esOpts > 0
|
||||
then do hPrintf stderr "Skipping journal add due to debug mode.\n"
|
||||
|
||||
@ -74,10 +74,10 @@ aregister opts@CliOpts{rawopts_=rawopts,reportopts_=ropts} j = do
|
||||
d <- getCurrentDay
|
||||
-- the first argument specifies the account, any remaining arguments are a filter query
|
||||
let args' = listofstringopt "args" rawopts
|
||||
when (null args') $ error' "aregister needs an account, please provide an account name or pattern"
|
||||
when (null args') $ error' "aregister needs an account, please provide an account name or pattern" -- PARTIAL:
|
||||
let
|
||||
(apat:queryargs) = args'
|
||||
acct = headDef (error' $ show apat++" did not match any account") $
|
||||
acct = headDef (error' $ show apat++" did not match any account") $ -- PARTIAL:
|
||||
filter (regexMatches apat . T.unpack) $ journalAccountNames j
|
||||
-- gather report options
|
||||
inclusive = True -- tree_ ropts
|
||||
@ -108,7 +108,7 @@ aregister opts@CliOpts{rawopts_=rawopts,reportopts_=ropts} j = do
|
||||
render | fmt=="json" = (++"\n") . T.unpack . TL.toStrict . encodeToLazyText . toJSON
|
||||
| fmt=="csv" = (++"\n") . printCSV . accountTransactionsReportAsCsv reportq thisacctq
|
||||
| fmt=="txt" = accountTransactionsReportAsText opts reportq thisacctq
|
||||
| otherwise = const $ error' $ unsupportedOutputFormatError fmt
|
||||
| otherwise = const $ error' $ unsupportedOutputFormatError fmt -- PARTIAL:
|
||||
where
|
||||
fmt = outputFormatFromOpts opts
|
||||
|
||||
|
||||
@ -304,6 +304,7 @@ balancemode = hledgerCommandMode
|
||||
-- | The balance command, prints a balance report.
|
||||
balance :: CliOpts -> Journal -> IO ()
|
||||
balance opts@CliOpts{rawopts_=rawopts,reportopts_=ropts@ReportOpts{..}} j = do
|
||||
-- PARTIAL:
|
||||
d <- getCurrentDay
|
||||
case lineFormatFromOpts ropts of
|
||||
Left err -> error' $ unlines [err]
|
||||
@ -494,7 +495,7 @@ multiBalanceReportAsHtml ropts mbr =
|
||||
multiBalanceReportHtmlRows :: ReportOpts -> MultiBalanceReport -> (Html (), [Html ()], Maybe (Html ()))
|
||||
multiBalanceReportHtmlRows ropts mbr =
|
||||
let
|
||||
headingsrow:rest | transpose_ ropts = error' "Sorry, --transpose is not supported with HTML output yet"
|
||||
headingsrow:rest | transpose_ ropts = error' "Sorry, --transpose is not supported with HTML output yet" -- PARTIAL:
|
||||
| otherwise = multiBalanceReportAsCsv ropts mbr
|
||||
(bodyrows, mtotalsrow) | no_total_ ropts = (rest, Nothing)
|
||||
| otherwise = (init rest, Just $ last rest)
|
||||
@ -581,7 +582,7 @@ multiBalanceReportAsText ropts@ReportOpts{..} r =
|
||||
(showDateSpan $ periodicReportSpan r)
|
||||
(case value_ of
|
||||
Just (AtCost _mc) -> ", valued at cost"
|
||||
Just (AtThen _mc) -> error' unsupportedValueThenError -- TODO -- ", valued at period ends" -- handled like AtEnd for now
|
||||
Just (AtThen _mc) -> error' unsupportedValueThenError -- TODO -- ", valued at period ends" -- handled like AtEnd for now -- PARTIAL:
|
||||
Just (AtEnd _mc) -> ", valued at period ends"
|
||||
Just (AtNow _mc) -> ", current value"
|
||||
-- XXX duplicates the above
|
||||
|
||||
@ -87,7 +87,7 @@ matching ppl ppr = do
|
||||
|
||||
readJournalFile' :: FilePath -> IO Journal
|
||||
readJournalFile' fn =
|
||||
readJournalFile definputopts {ignore_assertions_ = True} fn >>= either error' return
|
||||
readJournalFile definputopts {ignore_assertions_ = True} fn >>= either error' return -- PARTIAL:
|
||||
|
||||
matchingPostings :: AccountName -> Journal -> [PostingWithPath]
|
||||
matchingPostings acct j = filter ((== acct) . paccount . ppposting) $ allPostingsWithPath j
|
||||
|
||||
@ -34,7 +34,7 @@ importcmd opts@CliOpts{rawopts_=rawopts,inputopts_=iopts} j = do
|
||||
dryrun = boolopt "dry-run" rawopts
|
||||
iopts' = iopts{new_=True, new_save_=not dryrun}
|
||||
case inputfiles of
|
||||
[] -> error' "please provide one or more input files as arguments"
|
||||
[] -> error' "please provide one or more input files as arguments" -- PARTIAL:
|
||||
fs -> do
|
||||
enewj <- readJournalFiles iopts' fs
|
||||
case enewj of
|
||||
|
||||
@ -62,7 +62,7 @@ printEntries opts@CliOpts{reportopts_=ropts} j = do
|
||||
"csv" -> (++"\n") . printCSV . entriesReportAsCsv
|
||||
"json" -> (++"\n") . TL.unpack . toJsonText
|
||||
"sql" -> entriesReportAsSql
|
||||
_ -> const $ error' $ unsupportedOutputFormatError fmt
|
||||
_ -> const $ error' $ unsupportedOutputFormatError fmt -- PARTIAL:
|
||||
writeOutput opts $ render $ entriesReport ropts q j
|
||||
|
||||
entriesReportAsText :: CliOpts -> EntriesReport -> String
|
||||
|
||||
@ -64,7 +64,7 @@ register opts@CliOpts{reportopts_=ropts} j = do
|
||||
render | fmt=="txt" = postingsReportAsText
|
||||
| fmt=="csv" = const ((++"\n") . printCSV . postingsReportAsCsv)
|
||||
| fmt=="json" = const ((++"\n") . TL.unpack . toJsonText)
|
||||
| otherwise = const $ error' $ unsupportedOutputFormatError fmt
|
||||
| otherwise = const $ error' $ unsupportedOutputFormatError fmt -- PARTIAL:
|
||||
writeOutput opts $ render opts $ postingsReport ropts (queryFromOpts d ropts) j
|
||||
|
||||
postingsReportAsCsv :: PostingsReport -> CSV
|
||||
|
||||
@ -40,7 +40,7 @@ rewrite opts@CliOpts{rawopts_=rawopts,reportopts_=ropts} j@Journal{jtxns=ts} = d
|
||||
-- rewrite matched transactions
|
||||
d <- getCurrentDay
|
||||
let modifiers = transactionModifierFromOpts opts : jtxnmodifiers j
|
||||
let j' = j{jtxns=either error' id $ modifyTransactions d modifiers ts}
|
||||
let j' = j{jtxns=either error' id $ modifyTransactions d modifiers ts} -- PARTIAL:
|
||||
-- run the print command, showing all transactions, or show diffs
|
||||
printOrDiff rawopts opts{reportopts_=ropts{query_=""}} j j'
|
||||
|
||||
@ -52,7 +52,7 @@ transactionModifierFromOpts CliOpts{rawopts_=rawopts,reportopts_=ropts} =
|
||||
where
|
||||
q = T.pack $ query_ ropts
|
||||
ps = map (parseposting . T.pack) $ listofstringopt "add-posting" rawopts
|
||||
parseposting t = either (error' . errorBundlePretty) id ep
|
||||
parseposting t = either (error' . errorBundlePretty) id ep -- PARTIAL:
|
||||
where
|
||||
ep = runIdentity (runJournalParser (postingp Nothing <* eof) t')
|
||||
t' = " " <> t <> "\n" -- inject space and newline for proper parsing
|
||||
|
||||
@ -214,7 +214,7 @@ internalRateOfReturn showCashFlow prettyTables (OneSpan spanBegin spanEnd valueB
|
||||
#endif
|
||||
(0.000000000001,10000) (interestSum spanEnd totalCF) of
|
||||
Root rate -> return ((rate-1)*100)
|
||||
NotBracketed -> error' "Error: No solution -- not bracketed."
|
||||
NotBracketed -> error' "Error: No solution -- not bracketed." -- PARTIAL:
|
||||
SearchFailed -> error' "Error: Failed to find solution."
|
||||
|
||||
type CashFlow = [(Day, Quantity)]
|
||||
@ -236,5 +236,5 @@ unMix :: MixedAmount -> Quantity
|
||||
unMix a =
|
||||
case (normaliseMixedAmount $ mixedAmountCost a) of
|
||||
(Mixed [a]) -> aquantity a
|
||||
_ -> error' "MixedAmount failed to normalize"
|
||||
_ -> error' "MixedAmount failed to normalize" -- PARTIAL:
|
||||
|
||||
|
||||
@ -82,7 +82,7 @@ showLedgerStats l today span =
|
||||
path = journalFilePath j
|
||||
ts = sortOn tdate $ filter (spanContainsDate span . tdate) $ jtxns j
|
||||
as = nub $ map paccount $ concatMap tpostings ts
|
||||
cs = either error' Map.keys $ commodityStylesFromAmounts $ concatMap (amounts . pamount) $ concatMap tpostings ts
|
||||
cs = either error' Map.keys $ commodityStylesFromAmounts $ concatMap (amounts . pamount) $ concatMap tpostings ts -- PARTIAL:
|
||||
lastdate | null ts = Nothing
|
||||
| otherwise = Just $ tdate $ last ts
|
||||
lastelapsed = fmap (diffDays today) lastdate
|
||||
|
||||
@ -140,7 +140,7 @@ main = do
|
||||
hasVersion = ("--version" `elem`)
|
||||
hasDetailedVersion = ("--version+" `elem`)
|
||||
printUsage = putStr $ showModeUsage $ mainmode addons
|
||||
badCommandError = error' ("command "++rawcmd++" is not recognized, run with no command to see a list") >> exitFailure
|
||||
badCommandError = error' ("command "++rawcmd++" is not recognized, run with no command to see a list") >> exitFailure -- PARTIAL:
|
||||
hasHelpFlag args = any (`elem` args) ["-h","--help"]
|
||||
f `orShowHelp` mode
|
||||
| hasHelpFlag args = putStr $ showModeUsage mode
|
||||
|
||||
@ -73,7 +73,7 @@ withJournalDo opts cmd = do
|
||||
journalpaths <- journalFilePathFromOpts opts
|
||||
readJournalFiles (inputopts_ opts) journalpaths
|
||||
>>= mapM (journalTransform opts)
|
||||
>>= either error' cmd
|
||||
>>= either error' cmd -- PARTIAL:
|
||||
|
||||
-- | Apply some extra post-parse transformations to the journal, if
|
||||
-- specified by options. These happen after journal validation, but
|
||||
@ -139,7 +139,7 @@ journalAddForecast CliOpts{inputopts_=iopts, reportopts_=ropts} j = do
|
||||
]
|
||||
-- With --auto enabled, transaction modifiers are also applied to forecast txns
|
||||
forecasttxns' =
|
||||
(if auto_ iopts then either error' id . modifyTransactions today (jtxnmodifiers j) else id)
|
||||
(if auto_ iopts then either error' id . modifyTransactions today (jtxnmodifiers j) else id) -- PARTIAL:
|
||||
forecasttxns
|
||||
|
||||
return $
|
||||
@ -150,7 +150,7 @@ journalAddForecast CliOpts{inputopts_=iopts, reportopts_=ropts} j = do
|
||||
journalBalanceTransactions' iopts j =
|
||||
let assrt = not . ignore_assertions_ $ iopts
|
||||
in
|
||||
either error' id $ journalBalanceTransactions assrt j
|
||||
either error' id $ journalBalanceTransactions assrt j -- PARTIAL:
|
||||
|
||||
-- | Write some output to stdout or to a file selected by --output-file.
|
||||
-- If the file exists it will be overwritten.
|
||||
|
||||
@ -63,5 +63,5 @@ binaryfilename progname = prettify $ splitAtElement '.' buildversion
|
||||
prettify (major:minor:bugfix:[]) = prettify [major,minor,bugfix,"0"]
|
||||
prettify (major:minor:[]) = prettify [major,minor,"0","0"]
|
||||
prettify (major:[]) = prettify [major,"0","0","0"]
|
||||
prettify [] = error' "VERSION is empty, please fix"
|
||||
prettify [] = error' "VERSION is empty, please fix" -- PARTIAL:
|
||||
prettify _ = error' "VERSION has too many components, please fix"
|
||||
|
||||
@ -34,7 +34,7 @@ main = do
|
||||
benchWithTimeit = do
|
||||
getCurrentDirectory >>= printf "Benchmarking hledger in %s with timeit\n"
|
||||
let opts = defcliopts{output_file_=Just outputfile}
|
||||
(t0,j) <- timeit ("read "++inputfile) $ either error id <$> readJournalFile def inputfile
|
||||
(t0,j) <- timeit ("read "++inputfile) $ either error id <$> readJournalFile def inputfile -- PARTIAL:
|
||||
(t1,_) <- timeit ("print") $ print' opts j
|
||||
(t2,_) <- timeit ("register") $ register opts j
|
||||
(t3,_) <- timeit ("balance") $ balance opts j
|
||||
@ -50,9 +50,9 @@ timeit name action = do
|
||||
benchWithCriterion = do
|
||||
getCurrentDirectory >>= printf "Benchmarking hledger in %s with criterion\n"
|
||||
let opts = defcliopts{output_file_=Just "/dev/null"}
|
||||
j <- either error id <$> readJournalFile def inputfile
|
||||
j <- either error id <$> readJournalFile def inputfile -- PARTIAL:
|
||||
Criterion.Main.defaultMainWith defaultConfig $ [
|
||||
bench ("read "++inputfile) $ nfIO $ (either error const <$> readJournalFile def inputfile),
|
||||
bench ("read "++inputfile) $ nfIO $ (either error const <$> readJournalFile def inputfile), -- PARTIAL:
|
||||
bench ("print") $ nfIO $ print' opts j,
|
||||
bench ("register") $ nfIO $ register opts j,
|
||||
bench ("balance") $ nfIO $ balance opts j,
|
||||
|
||||
Loading…
Reference in New Issue
Block a user