hledger-lib 0.22.2 → 0.23

raw patch · 28 files changed

+2113/−1601 lines, 28 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGES +6/−0
• Hledger/Data.hs +3/−0
• Hledger/Data/Account.hs +47/−5
• Hledger/Data/Amount.hs +4/−4
• Hledger/Data/Commodity.hs +2/−2
• Hledger/Data/Dates.hs +23/−19
• Hledger/Data/FormatStrings.hs +0/−118
• Hledger/Data/Journal.hs +54/−11
• Hledger/Data/Ledger.hs +7/−6
• Hledger/Data/OutputFormat.hs +118/−0
• Hledger/Data/Posting.hs +18/−3
• Hledger/Data/RawOptions.hs +68/−0
• Hledger/Data/Transaction.hs +1/−1
• Hledger/Data/Types.hs +5/−5
• Hledger/Query.hs +86/−37
• Hledger/Read.hs +12/−10
• Hledger/Read/JournalReader.hs +88/−74
• Hledger/Read/TimelogReader.hs +3/−3
• Hledger/Reports.hs +31/−1285
• Hledger/Reports/BalanceHistoryReport.hs +34/−0
• Hledger/Reports/BalanceReport.hs +349/−0
• Hledger/Reports/EntriesReport.hs +51/−0
• Hledger/Reports/MultiBalanceReports.hs +167/−0
• Hledger/Reports/PostingsReport.hs +368/−0
• Hledger/Reports/ReportOptions.hs +295/−0
• Hledger/Reports/TransactionsReports.hs +196/−0
• Hledger/Utils.hs +64/−13
• hledger-lib.cabal +13/−5

@@ -1,3 +1,9 @@+API-ish changes in hledger-lib. For user-visible changes, see the hledger changelog.++0.23 (2014/5/1)++- orDatesFrom -> spanDefaultsFrom+ 0.22.2 (2014/4/16)  - display years before 1000 with four digits, not three

@@ -16,6 +16,7 @@                module Hledger.Data.Journal,                module Hledger.Data.Ledger,                module Hledger.Data.Posting,+               module Hledger.Data.RawOptions,                module Hledger.Data.TimeLog,                module Hledger.Data.Transaction,                module Hledger.Data.Types,@@ -32,10 +33,12 @@ import Hledger.Data.Journal import Hledger.Data.Ledger import Hledger.Data.Posting+import Hledger.Data.RawOptions import Hledger.Data.TimeLog import Hledger.Data.Transaction import Hledger.Data.Types +tests_Hledger_Data :: Test tests_Hledger_Data = TestList     [      tests_Hledger_Data_Account

@@ -10,6 +10,7 @@ module Hledger.Data.Account where import Data.List+import Data.Maybe import qualified Data.Map as M import Safe (headMay, lookupJustDef) import Test.HUnit@@ -24,9 +25,10 @@  -- deriving instance Show Account instance Show Account where-    show Account{..} = printf "Account %s (boring:%s, ebalance:%s, ibalance:%s)"-                       aname  +    show Account{..} = printf "Account %s (boring:%s, postings:%d, ebalance:%s, ibalance:%s)"+                       aname                        (if aboring then "y" else "n" :: String)+                       anumpostings                        (showMixedAmount aebalance)                        (showMixedAmount aibalance) @@ -44,6 +46,7 @@   { aname = ""   , aparent = Nothing   , asubs = []+  , anumpostings = 0   , aebalance = nullmixedamt   , aibalance = nullmixedamt   , aboring = False@@ -57,10 +60,12 @@   let     acctamts = [(paccount p,pamount p) | p <- ps]     grouped = groupBy (\a b -> fst a == fst b) $ sort $ acctamts+    counted = [(a, length acctamts) | acctamts@((a,_):_) <- grouped]     summed = map (\as@((aname,_):_) -> (aname, sum $ map snd as)) grouped -- always non-empty     nametree = treeFromPaths $ map (expandAccountName . fst) summed     acctswithnames = nameTreeToAccount "root" nametree-    acctswithebals = mapAccounts setebalance acctswithnames where setebalance a = a{aebalance=lookupJustDef nullmixedamt (aname a) summed}+    acctswithnumps = mapAccounts setnumps    acctswithnames where setnumps    a = a{anumpostings=fromMaybe 0 $ lookup (aname a) counted}+    acctswithebals = mapAccounts setebalance acctswithnumps where setebalance a = a{aebalance=lookupJustDef nullmixedamt (aname a) summed}     acctswithibals = sumAccounts acctswithebals     acctswithparents = tieAccountParents acctswithibals     acctsflattened = flattenAccounts acctswithparents@@ -115,15 +120,52 @@     where       subs = map (clipAccounts (d-1)) $ asubs a +-- | Remove subaccounts below the specified depth, aggregating their balance at the depth limit+-- (accounts at the depth limit will have any sub-balances merged into their exclusive balance).+clipAccountsAndAggregate :: Int -> [Account] -> [Account]+clipAccountsAndAggregate d as = combined+    where+      clipped  = [a{aname=clipAccountName d $ aname a} | a <- as]+      combined = [a{aebalance=sum (map aebalance same)}+                  | same@(a:_) <- groupBy (\a1 a2 -> aname a1 == aname a2) clipped]+{-+test cases, assuming d=1:++assets:cash 1 1+assets:checking 1 1+->+as:       [assets:cash 1 1, assets:checking 1 1]+clipped:  [assets 1 1, assets 1 1]+combined: [assets 2 2]++assets 0 2+ assets:cash 1 1+ assets:checking 1 1+->+as:       [assets 0 2, assets:cash 1 1, assets:checking 1 1]+clipped:  [assets 0 2, assets 1 1, assets 1 1]+combined: [assets 2 2]++assets 0 2+ assets:bank 1 2+  assets:bank:checking 1 1+->+as:       [assets 0 2, assets:bank 1 2, assets:bank:checking 1 1]+clipped:  [assets 0 2, assets 1 2, assets 1 1]+combined: [assets 2 2]++-}+ -- | Remove all leaf accounts and subtrees matching a predicate. pruneAccounts :: (Account -> Bool) -> Account -> Maybe Account pruneAccounts p = headMay . prune   where     prune a-      | null prunedsubs = if p a then [] else [a]-      | otherwise       = [a{asubs=prunedsubs}]+      | null prunedsubs = if p a then [] else [a']+      | otherwise       = [a']       where         prunedsubs = concatMap prune $ asubs a+        a' = a{asubs=prunedsubs}  -- | Flatten an account tree into a list, which is sometimes -- convenient. Note since accounts link to their parents/subs, the

@@ -117,9 +117,9 @@  instance Show Amount where   show _a@Amount{..}-    --  debugLevel < 3 = showAmountWithoutPrice a-    --  debugLevel < 6 = showAmount a-    | debugLevel < 9 =+    --  debugLevel < 2 = showAmountWithoutPrice a+    --  debugLevel < 3 = showAmount a+    | debugLevel < 6 =        printf "Amount {acommodity=%s, aquantity=%s, ..}" (show acommodity) (show aquantity)     | otherwise      = --showAmountDebug a        printf "Amount {acommodity=%s, aquantity=%s, aprice=%s, astyle=%s}" (show acommodity) (show aquantity) (showPriceDebug aprice) (show astyle)@@ -332,7 +332,7 @@  instance Show MixedAmount where   show-    --  debugLevel < 3 = intercalate "\\n" . lines . showMixedAmountWithoutPrice+    | debugLevel < 3 = intercalate "\\n" . lines . showMixedAmountWithoutPrice     --  debugLevel < 6 = intercalate "\\n" . lines . showMixedAmount     | otherwise      = showMixedAmountDebug 

@@ -17,8 +17,8 @@ import Hledger.Utils  --- characters than can't be in a non-quoted commodity symbol-nonsimplecommoditychars = "0123456789-.@;\n \"{}=" :: String+-- characters that may not be used in a non-quoted commodity symbol+nonsimplecommoditychars = "0123456789-+.@;\n \"{}=" :: String  quoteCommoditySymbolIfNeeded s | any (`elem` nonsimplecommoditychars) s = "\"" ++ s ++ "\""                                | otherwise = s

@@ -45,9 +45,9 @@   spansSpan,   spanIntersect,   spansIntersect,+  spanDefaultsFrom,   spanUnion,   spansUnion,-  orDatesFrom,   smartdate,   splitSpan,   fixSmartDate,@@ -77,17 +77,20 @@ import Hledger.Data.Types import Hledger.Utils ++-- Help ppShow parse and line-wrap DateSpans better in debug output.+instance Show DateSpan where+    show (DateSpan s1 s2) = "DateSpan \"" ++ show s1 ++ "\" \"" ++ show s2 ++ "\""+ showDate :: Day -> String showDate = formatTime defaultTimeLocale "%0C%y/%m/%d"  showDateSpan (DateSpan from to) =   concat-    [maybe "" showdate from+    [maybe "" showDate from     ,"-"-    ,maybe "" (showdate . prevday) to+    ,maybe "" (showDate . prevday) to     ]-  where-    showdate = formatTime defaultTimeLocale "%C%y/%m/%d"  -- | Get the current local date. getCurrentDay :: IO Day@@ -116,11 +119,14 @@ spanEnd :: DateSpan -> Maybe Day spanEnd (DateSpan _ d) = d +-- might be useful later: http://en.wikipedia.org/wiki/Allen%27s_interval_algebra + -- | Get overall span enclosing multiple sequentially ordered spans. spansSpan :: [DateSpan] -> DateSpan spansSpan spans = DateSpan (maybe Nothing spanStart $ headMay spans) (maybe Nothing spanEnd $ lastMay spans) --- | Split a DateSpan into one or more consecutive spans at the specified interval.+-- | Split a DateSpan into one or more consecutive whole spans of the specified length which enclose it.+-- If no interval is specified, the original span is returned. splitSpan :: Interval -> DateSpan -> [DateSpan] splitSpan _ (DateSpan Nothing Nothing) = [DateSpan Nothing Nothing] splitSpan NoInterval     s = [s]@@ -165,14 +171,6 @@ spanContainsDate (DateSpan (Just b) Nothing)  d = d >= b spanContainsDate (DateSpan (Just b) (Just e)) d = d >= b && d < e     --- | Combine two datespans, filling any unspecified dates in the first--- with dates from the second. Not a clip operation, just uses the--- second's start/end dates as defaults when the first does not--- specify them.-orDatesFrom (DateSpan a1 b1) (DateSpan a2 b2) = DateSpan a b-    where a = if isJust a1 then a1 else a2-          b = if isJust b1 then b1 else b2- -- | Calculate the intersection of a number of datespans. spansIntersect [] = nulldatespan spansIntersect [d] = d@@ -184,6 +182,12 @@       b = latest b1 b2       e = earliest e1 e2 +-- | Fill any unspecified dates in the first span with the dates from+-- the second one. Sort of a one-way spanIntersect.+spanDefaultsFrom (DateSpan a1 b1) (DateSpan a2 b2) = DateSpan a b+    where a = if isJust a1 then a1 else a2+          b = if isJust b1 then b1 else b2+ -- | Calculate the union of a number of datespans. spansUnion [] = nulldatespan spansUnion [d] = d@@ -674,11 +678,11 @@   ,"period expressions" ~: do     let todaysdate = parsedate "2008/11/26"     let str `gives` result = show (parsewith (periodexpr todaysdate) str) `is` ("Right " ++ result)-    "from aug to oct"           `gives` "(NoInterval,DateSpan (Just 2008-08-01) (Just 2008-10-01))"-    "aug to oct"                `gives` "(NoInterval,DateSpan (Just 2008-08-01) (Just 2008-10-01))"-    "every 3 days in aug"       `gives` "(Days 3,DateSpan (Just 2008-08-01) (Just 2008-09-01))"-    "daily from aug"            `gives` "(Days 1,DateSpan (Just 2008-08-01) Nothing)"-    "every week to 2009"        `gives` "(Weeks 1,DateSpan Nothing (Just 2009-01-01))"+    "from aug to oct"           `gives` "(NoInterval,DateSpan \"Just 2008-08-01\" \"Just 2008-10-01\")"+    "aug to oct"                `gives` "(NoInterval,DateSpan \"Just 2008-08-01\" \"Just 2008-10-01\")"+    "every 3 days in aug"       `gives` "(Days 3,DateSpan \"Just 2008-08-01\" \"Just 2008-09-01\")"+    "daily from aug"            `gives` "(Days 1,DateSpan \"Just 2008-08-01\" \"Nothing\")"+    "every week to 2009"        `gives` "(Weeks 1,DateSpan \"Nothing\" \"Just 2009-01-01\")"    ,"splitSpan" ~: do     let gives (interval, span) = (splitSpan interval span `is`)

@@ -1,118 +0,0 @@-module Hledger.Data.FormatStrings (-          parseFormatString-        , formatStrings-        , formatValue-        , FormatString(..)-        , HledgerFormatField(..)-        , tests-        ) where--import Numeric-import Data.Char (isPrint)-import Data.Maybe-import Test.HUnit-import Text.ParserCombinators.Parsec-import Text.Printf--import Hledger.Data.Types---formatValue :: Bool -> Maybe Int -> Maybe Int -> String -> String-formatValue leftJustified min max value = printf formatS value-    where-      l = if leftJustified then "-" else ""-      min' = maybe "" show min-      max' = maybe "" (\i -> "." ++ (show i)) max-      formatS = "%" ++ l ++ min' ++ max' ++ "s"--parseFormatString :: String -> Either String [FormatString]-parseFormatString input = case (runParser formatStrings () "(unknown)") input of-    Left y -> Left $ show y-    Right x -> Right x--{--Parsers--}--field :: GenParser Char st HledgerFormatField-field = do-        try (string "account" >> return AccountField)-    <|> try (string "depth_spacer" >> return DepthSpacerField)-    <|> try (string "date" >> return DescriptionField)-    <|> try (string "description" >> return DescriptionField)-    <|> try (string "total" >> return TotalField)-    <|> try (many1 digit >>= (\s -> return $ FieldNo $ read s))--formatField :: GenParser Char st FormatString-formatField = do-    char '%'-    leftJustified <- optionMaybe (char '-')-    minWidth <- optionMaybe (many1 $ digit)-    maxWidth <- optionMaybe (do char '.'; many1 $ digit) -- TODO: Can this be (char '1') *> (many1 digit)-    char '('-    f <- field-    char ')'-    return $ FormatField (isJust leftJustified) (parseDec minWidth) (parseDec maxWidth) f-    where-      parseDec s = case s of-        Just text -> Just m where ((m,_):_) = readDec text-        _ -> Nothing--formatLiteral :: GenParser Char st FormatString-formatLiteral = do-    s <- many1 c-    return $ FormatLiteral s-    where-      isPrintableButNotPercentage x = isPrint x && (not $ x == '%')-      c =     (satisfy isPrintableButNotPercentage <?> "printable character")-          <|> try (string "%%" >> return '%')--formatStr :: GenParser Char st FormatString-formatStr =-        formatField-    <|> formatLiteral--formatStrings :: GenParser Char st [FormatString]-formatStrings = many formatStr--testFormat :: FormatString -> String -> String -> Assertion-testFormat fs value expected = assertEqual name expected actual-    where-        (name, actual) = case fs of-            FormatLiteral l -> ("literal", formatValue False Nothing Nothing l)-            FormatField leftJustify min max _ -> ("field", formatValue leftJustify min max value)--testParser :: String -> [FormatString] -> Assertion-testParser s expected = case (parseFormatString s) of-    Left  error -> assertFailure $ show error-    Right actual -> assertEqual ("Input: " ++ s) expected actual--tests = test [ formattingTests ++ parserTests ]--formattingTests = [-      testFormat (FormatLiteral " ")                                ""            " "-    , testFormat (FormatField False Nothing Nothing DescriptionField)    "description" "description"-    , testFormat (FormatField False (Just 20) Nothing DescriptionField)  "description" "         description"-    , testFormat (FormatField False Nothing (Just 20) DescriptionField)  "description" "description"-    , testFormat (FormatField True Nothing (Just 20) DescriptionField)   "description" "description"-    , testFormat (FormatField True (Just 20) Nothing DescriptionField)   "description" "description         "-    , testFormat (FormatField True (Just 20) (Just 20) DescriptionField) "description" "description         "-    , testFormat (FormatField True Nothing (Just 3) DescriptionField)    "description" "des"-    ]--parserTests = [-      testParser ""                             []-    , testParser "D"                            [FormatLiteral "D"]-    , testParser "%(date)"                      [FormatField False Nothing Nothing DescriptionField]-    , testParser "%(total)"                     [FormatField False Nothing Nothing TotalField]-    , testParser "Hello %(date)!"               [FormatLiteral "Hello ", FormatField False Nothing Nothing DescriptionField, FormatLiteral "!"]-    , testParser "%-(date)"                     [FormatField True Nothing Nothing DescriptionField]-    , testParser "%20(date)"                    [FormatField False (Just 20) Nothing DescriptionField]-    , testParser "%.10(date)"                   [FormatField False Nothing (Just 10) DescriptionField]-    , testParser "%20.10(date)"                 [FormatField False (Just 20) (Just 10) DescriptionField]-    , testParser "%20(account) %.10(total)\n"   [ FormatField False (Just 20) Nothing AccountField-                                                , FormatLiteral " "-                                                , FormatField False Nothing (Just 10) TotalField-                                                , FormatLiteral "\n"-                                                ]-  ]

@@ -1,3 +1,4 @@+-- {-# LANGUAGE CPP #-} {-|  A 'Journal' is a set of transactions, plus optional related data.  This is@@ -19,8 +20,10 @@   journalConvertAmountsToCost,   journalFinalise,   -- * Filtering-  filterJournalPostings,   filterJournalTransactions,+  filterJournalPostings,+  filterJournalPostingAmounts,+  filterPostingAmount,   -- * Querying   journalAccountNames,   journalAccountNamesUsed,@@ -28,6 +31,7 @@   journalAmounts,   -- journalCanonicalCommodities,   journalDateSpan,+  journalDescriptions,   journalFilePath,   journalFilePaths,   journalPostings,@@ -153,13 +157,19 @@ addTimeLogEntry :: TimeLogEntry -> Journal -> Journal addTimeLogEntry tle l0 = l0 { open_timelog_entries = tle : open_timelog_entries l0 } +-- | Unique transaction descriptions used in this journal.+journalDescriptions :: Journal -> [String]+journalDescriptions = nub . sort . map tdescription . jtxns++-- | All postings from this journal's transactions, in order. journalPostings :: Journal -> [Posting] journalPostings = concatMap tpostings . jtxns --- | All account names used in this journal.+-- | Unique account names posted to in this journal. journalAccountNamesUsed :: Journal -> [AccountName] journalAccountNamesUsed = sort . accountNamesFromPostings . journalPostings +-- | Unique account names in this journal, including parent accounts containing no postings. journalAccountNames :: Journal -> [AccountName] journalAccountNames = sort . expandAccountNames . journalAccountNamesUsed @@ -228,6 +238,17 @@     where       filtertransactionpostings t@Transaction{tpostings=ps} = t{tpostings=filter (q `matchesPosting`) ps} +-- Within each posting's amount, keep only the parts matching the query.+-- This can leave unbalanced transactions.+filterJournalPostingAmounts :: Query -> Journal -> Journal+filterJournalPostingAmounts q j@Journal{jtxns=ts} = j{jtxns=map filtertransactionpostings ts}+    where+      filtertransactionpostings t@Transaction{tpostings=ps} = t{tpostings=map (filterPostingAmount q) ps}++-- | Filter out all parts of this posting's amount which do not match the query.+filterPostingAmount :: Query -> Posting -> Posting+filterPostingAmount q p@Posting{pamount=Mixed as} = p{pamount=Mixed $ filter (q `matchesAmount`) as}+ -- | Keep only transactions matching the query expression. filterJournalTransactions :: Query -> Journal -> Journal filterJournalTransactions q j@Journal{jtxns=ts} = j{jtxns=filter (q `matchesTransaction`) ts}@@ -415,10 +436,10 @@     assertion = pbalanceassertion p     Just assertedbal = assertion     bal' = sum $ [bal] ++ map pamount ps-    err = printf "Balance assertion failed for account %s on %s\n%safter\n   %s\nexpected balance is %s, actual balance was %s."+    err = printf "Balance assertion failed for account %s on %s\n%sAfter posting:\n   %s\nexpected balance is %s, actual balance was %s."                  (paccount p)                  (show $ postingDate p)-                 (maybe "" (("In\n"++).show) $ ptransaction p)+                 (maybe "" (("In transaction:\n"++).show) $ ptransaction p)                  (show p)                  (showMixedAmount assertedbal)                  (showMixedAmount bal')@@ -524,15 +545,36 @@ journalAmounts :: Journal -> [Amount] journalAmounts = concatMap flatten . journalMixedAmounts where flatten (Mixed as) = as --- | The (fully specified) date span containing this journal's transactions,--- or DateSpan Nothing Nothing if there are none.-journalDateSpan :: Journal -> DateSpan-journalDateSpan j-    | null ts = DateSpan Nothing Nothing-    | otherwise = DateSpan (Just $ tdate $ head ts) (Just $ addDays 1 $ tdate $ last ts)+-- | The fully specified date span enclosing the dates (primary or secondary)+-- of all this journal's transactions and postings, or DateSpan Nothing Nothing+-- if there are none.+journalDateSpan :: Bool -> Journal -> DateSpan+journalDateSpan secondary j+    | null ts   = DateSpan Nothing Nothing+    | otherwise = DateSpan (Just earliest) (Just $ addDays 1 latest)     where-      ts = sortBy (comparing tdate) $ jtxns j+      earliest = minimum dates+      latest   = maximum dates+      dates    = pdates ++ tdates+      tdates   = map (if secondary then transactionDate2 else tdate) ts+      pdates   = concatMap (catMaybes . map (if secondary then (Just . postingDate2) else pdate) . tpostings) ts+      ts       = jtxns j +-- #ifdef TESTS+test_journalDateSpan = do+ "journalDateSpan" ~: do+  assertEqual "" (DateSpan (Just $ fromGregorian 2014 1 10) (Just $ fromGregorian 2014 10 11))+                 (journalDateSpan True j)+  where+    j = nulljournal{jtxns = [nulltransaction{tdate = parsedate "2014/02/01"+                                            ,tpostings = [posting{pdate=Just (parsedate "2014/01/10")}]+                                            }+                            ,nulltransaction{tdate = parsedate "2014/09/01"+                                            ,tpostings = [posting{pdate2=Just (parsedate "2014/10/10")}]+                                            }+                            ]}+-- #endif+ -- Misc helpers  -- | Check if a set of hledger account/description filter patterns matches the@@ -662,6 +704,7 @@  tests_Hledger_Data_Journal = TestList $  [+  test_journalDateSpan   -- "query standard account types" ~:   --  do   --   let j = journal1

@@ -35,16 +35,17 @@   laccounts = []   } --- | Filter a journal's transactions with the given query, then derive a--- ledger containing the chart of accounts and balances. If the query--- includes a depth limit, that will affect the ledger's journal but not--- the account tree.+-- | Filter a journal's transactions with the given query, then derive+-- a ledger containing the chart of accounts and balances. If the+-- query includes a depth limit, that will affect the this ledger's+-- journal but not the ledger's account tree. ledgerFromJournal :: Query -> Journal -> Ledger ledgerFromJournal q j = nullledger{ljournal=j'', laccounts=as}   where     (q',depthq)  = (filterQuery (not . queryIsDepth) q, filterQuery queryIsDepth q)-    j' = filterJournalPostings q' j-    as = accountsFromPostings $ journalPostings j'+    j'  = filterJournalPostingAmounts (filterQuery queryIsSym q) $ -- remove amount parts which the query's sym: terms would exclude+          filterJournalPostings q' j+    as  = accountsFromPostings $ journalPostings j'     j'' = filterJournalPostings depthq j'  -- | List a ledger's account names.

@@ -0,0 +1,118 @@+module Hledger.Data.OutputFormat (+          parseStringFormat+        , formatsp+        , formatValue+        , OutputFormat(..)+        , HledgerFormatField(..)+        , tests+        ) where++import Numeric+import Data.Char (isPrint)+import Data.Maybe+import Test.HUnit+import Text.ParserCombinators.Parsec+import Text.Printf++import Hledger.Data.Types+++formatValue :: Bool -> Maybe Int -> Maybe Int -> String -> String+formatValue leftJustified min max value = printf formatS value+    where+      l = if leftJustified then "-" else ""+      min' = maybe "" show min+      max' = maybe "" (\i -> "." ++ (show i)) max+      formatS = "%" ++ l ++ min' ++ max' ++ "s"++parseStringFormat :: String -> Either String [OutputFormat]+parseStringFormat input = case (runParser formatsp () "(unknown)") input of+    Left y -> Left $ show y+    Right x -> Right x++{-+Parsers+-}++field :: GenParser Char st HledgerFormatField+field = do+        try (string "account" >> return AccountField)+    <|> try (string "depth_spacer" >> return DepthSpacerField)+    <|> try (string "date" >> return DescriptionField)+    <|> try (string "description" >> return DescriptionField)+    <|> try (string "total" >> return TotalField)+    <|> try (many1 digit >>= (\s -> return $ FieldNo $ read s))++formatField :: GenParser Char st OutputFormat+formatField = do+    char '%'+    leftJustified <- optionMaybe (char '-')+    minWidth <- optionMaybe (many1 $ digit)+    maxWidth <- optionMaybe (do char '.'; many1 $ digit) -- TODO: Can this be (char '1') *> (many1 digit)+    char '('+    f <- field+    char ')'+    return $ FormatField (isJust leftJustified) (parseDec minWidth) (parseDec maxWidth) f+    where+      parseDec s = case s of+        Just text -> Just m where ((m,_):_) = readDec text+        _ -> Nothing++formatLiteral :: GenParser Char st OutputFormat+formatLiteral = do+    s <- many1 c+    return $ FormatLiteral s+    where+      isPrintableButNotPercentage x = isPrint x && (not $ x == '%')+      c =     (satisfy isPrintableButNotPercentage <?> "printable character")+          <|> try (string "%%" >> return '%')++formatp :: GenParser Char st OutputFormat+formatp =+        formatField+    <|> formatLiteral++formatsp :: GenParser Char st [OutputFormat]+formatsp = many formatp++testFormat :: OutputFormat -> String -> String -> Assertion+testFormat fs value expected = assertEqual name expected actual+    where+        (name, actual) = case fs of+            FormatLiteral l -> ("literal", formatValue False Nothing Nothing l)+            FormatField leftJustify min max _ -> ("field", formatValue leftJustify min max value)++testParser :: String -> [OutputFormat] -> Assertion+testParser s expected = case (parseStringFormat s) of+    Left  error -> assertFailure $ show error+    Right actual -> assertEqual ("Input: " ++ s) expected actual++tests = test [ formattingTests ++ parserTests ]++formattingTests = [+      testFormat (FormatLiteral " ")                                ""            " "+    , testFormat (FormatField False Nothing Nothing DescriptionField)    "description" "description"+    , testFormat (FormatField False (Just 20) Nothing DescriptionField)  "description" "         description"+    , testFormat (FormatField False Nothing (Just 20) DescriptionField)  "description" "description"+    , testFormat (FormatField True Nothing (Just 20) DescriptionField)   "description" "description"+    , testFormat (FormatField True (Just 20) Nothing DescriptionField)   "description" "description         "+    , testFormat (FormatField True (Just 20) (Just 20) DescriptionField) "description" "description         "+    , testFormat (FormatField True Nothing (Just 3) DescriptionField)    "description" "des"+    ]++parserTests = [+      testParser ""                             []+    , testParser "D"                            [FormatLiteral "D"]+    , testParser "%(date)"                      [FormatField False Nothing Nothing DescriptionField]+    , testParser "%(total)"                     [FormatField False Nothing Nothing TotalField]+    , testParser "Hello %(date)!"               [FormatLiteral "Hello ", FormatField False Nothing Nothing DescriptionField, FormatLiteral "!"]+    , testParser "%-(date)"                     [FormatField True Nothing Nothing DescriptionField]+    , testParser "%20(date)"                    [FormatField False (Just 20) Nothing DescriptionField]+    , testParser "%.10(date)"                   [FormatField False Nothing (Just 10) DescriptionField]+    , testParser "%20.10(date)"                 [FormatField False (Just 20) (Just 10) DescriptionField]+    , testParser "%20(account) %.10(total)\n"   [ FormatField False (Just 20) Nothing AccountField+                                                , FormatLiteral " "+                                                , FormatField False Nothing (Just 10) TotalField+                                                , FormatLiteral "\n"+                                                ]+  ]

@@ -26,7 +26,9 @@   postingDate,   postingDate2,   isPostingInDateSpan,+  isPostingInDateSpan',   postingsDateSpan,+  postingsDateSpan',   -- * account name operations   accountNamesFromPostings,   accountNamePostingType,@@ -145,11 +147,11 @@  -- | Tags for this posting including any inherited from its parent transaction. postingAllTags :: Posting -> [Tag]-postingAllTags p = ptags p ++ maybe [] transactionAllTags (ptransaction p)+postingAllTags p = ptags p ++ maybe [] ttags (ptransaction p) --- | Tags for this transaction including any inherited from above, when that is implemented.+-- | Tags for this transaction including any from its postings. transactionAllTags :: Transaction -> [Tag]-transactionAllTags t = ttags t+transactionAllTags t = ttags t ++ concatMap ptags (tpostings t)  -- Get the other postings from this posting's transaction. relatedPostings :: Posting -> [Posting]@@ -160,6 +162,11 @@ isPostingInDateSpan :: DateSpan -> Posting -> Bool isPostingInDateSpan s = spanContainsDate s . postingDate +-- --date2-sensitive version, separate for now to avoid disturbing multiBalanceReport.+isPostingInDateSpan' :: WhichDate -> DateSpan -> Posting -> Bool+isPostingInDateSpan' PrimaryDate   s = spanContainsDate s . postingDate+isPostingInDateSpan' SecondaryDate s = spanContainsDate s . postingDate2+ isEmptyPosting :: Posting -> Bool isEmptyPosting = isZeroMixedAmount . pamount @@ -169,6 +176,14 @@ postingsDateSpan [] = DateSpan Nothing Nothing postingsDateSpan ps = DateSpan (Just $ postingDate $ head ps') (Just $ addDays 1 $ postingDate $ last ps')     where ps' = sortBy (comparing postingDate) ps++-- --date2-sensitive version, as above.+postingsDateSpan' :: WhichDate -> [Posting] -> DateSpan+postingsDateSpan' _  [] = DateSpan Nothing Nothing+postingsDateSpan' wd ps = DateSpan (Just $ postingdate $ head ps') (Just $ addDays 1 $ postingdate $ last ps')+    where+      ps' = sortBy (comparing postingdate) ps+      postingdate = if wd == PrimaryDate then postingDate else postingDate2  -- AccountName stuff that depends on PostingType 

@@ -0,0 +1,68 @@+{-|++hledger's cmdargs modes parse command-line arguments to an+intermediate format, RawOpts (an association list), rather than a+fixed ADT like CliOpts. This allows the modes and flags to be reused+more easily by hledger commands/scripts in this and other packages.++-}++module Hledger.Data.RawOptions (+  RawOpts,+  setopt,+  setboolopt,+  inRawOpts,+  boolopt,+  stringopt,+  maybestringopt,+  listofstringopt,+  intopt,+  maybeintopt,+  optserror+)+where++import Data.Maybe+import Safe++import Hledger.Utils+++-- | The result of running cmdargs: an association list of option names to string values.+type RawOpts = [(String,String)]++setopt :: String -> String -> RawOpts -> RawOpts+setopt name val = (++ [(name, quoteIfNeeded val)])++setboolopt :: String -> RawOpts -> RawOpts+setboolopt name = (++ [(name,"")])++-- | Is the named option present ?+inRawOpts :: String -> RawOpts -> Bool+inRawOpts name = isJust . lookup name++boolopt :: String -> RawOpts -> Bool+boolopt = inRawOpts++maybestringopt :: String -> RawOpts -> Maybe String+maybestringopt name = maybe Nothing (Just . stripquotes) . lookup name++stringopt :: String -> RawOpts -> String+stringopt name = fromMaybe "" . maybestringopt name++listofstringopt :: String -> RawOpts -> [String]+listofstringopt name rawopts = [v | (k,v) <- rawopts, k==name]++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++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)")+

@@ -270,7 +270,7 @@ balanceTransaction :: Maybe (Map.Map Commodity AmountStyle) -> Transaction -> Either String Transaction balanceTransaction styles t@Transaction{tpostings=ps}     | length rwithoutamounts > 1 || length bvwithoutamounts > 1-        = Left $ printerr "could not balance this transaction (too many missing amounts)"+        = Left $ printerr "could not balance this transaction (can't have more than one missing amount; remember to put 2 or more spaces before amounts)"     | not $ isTransactionBalanced styles t''' = Left $ printerr $ nonzerobalanceerror t'''     | otherwise = Right t''''     where

@@ -31,7 +31,7 @@  data WhichDate = PrimaryDate | SecondaryDate deriving (Eq,Show) -data DateSpan = DateSpan (Maybe Day) (Maybe Day) deriving (Eq,Show,Ord,Data,Typeable)+data DateSpan = DateSpan (Maybe Day) (Maybe Day) deriving (Eq,Ord,Data,Typeable)  data Interval = NoInterval               | Days Int | Weeks Int | Months Int | Quarters Int | Years Int@@ -169,13 +169,13 @@ type JournalUpdate = ErrorT String IO (Journal -> Journal)  -- | The id of a data format understood by hledger, eg @journal@ or @csv@.-type Format = String+type StorageFormat = String  -- | A hledger journal reader is a triple of format name, format-detecting -- predicate, and a parser to Journal. data Reader = Reader {      -- name of the format this reader handles-     rFormat   :: Format+     rFormat   :: StorageFormat      -- quickly check if this reader can probably handle the given file path and file content     ,rDetector :: FilePath -> String -> Bool      -- parse the given string, using the given parse rules file if any, returning a journal or error aware of the given file path@@ -195,7 +195,7 @@   | FieldNo Int     deriving (Show, Eq) -data FormatString =+data OutputFormat =     FormatLiteral String   | FormatField Bool        -- Left justified ?                 (Maybe Int) -- Min width@@ -210,7 +210,7 @@   aname :: AccountName,     -- ^ this account's full name   aebalance :: MixedAmount, -- ^ this account's balance, excluding subaccounts   asubs :: [Account],       -- ^ sub-accounts-  -- anumpostings :: Int       -- ^ number of postings to this account+  anumpostings :: Int,      -- ^ number of postings to this account   -- derived from the above:   aibalance :: MixedAmount, -- ^ this account's balance, including subaccounts   aparent :: Maybe Account, -- ^ parent account

@@ -16,9 +16,11 @@   filterQuery,   -- * accessors   queryIsNull,+  queryIsAcct,   queryIsDepth,   queryIsDate,   queryIsStartDateOnly,+  queryIsSym,   queryStartDate,   queryDateSpan,   queryDepth,@@ -26,9 +28,12 @@   inAccount,   inAccountQuery,   -- * matching-  matchesAccount,-  matchesPosting,   matchesTransaction,+  matchesPosting,+  matchesAccount,+  matchesMixedAmount,+  matchesAmount,+  words'',   -- * tests   tests_Hledger_Query )@@ -45,7 +50,7 @@ import Hledger.Utils import Hledger.Data.Types import Hledger.Data.AccountName-import Hledger.Data.Amount (amount, usd)+import Hledger.Data.Amount (amount, nullamt, usd) import Hledger.Data.Dates import Hledger.Data.Posting import Hledger.Data.Transaction@@ -65,7 +70,7 @@            | Date2 DateSpan   -- ^ match if secondary date in this date span            | Status Bool      -- ^ match if cleared status has this value            | Real Bool        -- ^ match if "realness" (involves a real non-virtual account ?) has this value-           | Amt Ordering Quantity   -- ^ match if the amount's numeric quantity is less than/greater than/equal to some value+           | Amt OrdPlus Quantity  -- ^ match if the amount's numeric quantity is less than/greater than/equal to/unsignedly equal to some value            | Sym String       -- ^ match if the entire commodity symbol is matched by this regexp            | Empty Bool       -- ^ if true, show zero-amount postings/accounts which are usually not shown                               --   more of a query option than a query criteria ?@@ -165,18 +170,17 @@ words'' :: [String] -> String -> [String] words'' prefixes = fromparse . parsewith maybeprefixedquotedphrases -- XXX     where-      maybeprefixedquotedphrases = choice' [prefixedQuotedPattern, quotedPattern, pattern] `sepBy` many1 spacenonewline+      maybeprefixedquotedphrases = choice' [prefixedQuotedPattern, singleQuotedPattern, doubleQuotedPattern, pattern] `sepBy` many1 spacenonewline       prefixedQuotedPattern = do         not' <- fromMaybe "" `fmap` (optionMaybe $ string "not:")         let allowednexts | null not' = prefixes                          | otherwise = prefixes ++ [""]         next <- choice' $ map string allowednexts         let prefix = not' ++ next-        p <- quotedPattern+        p <- singleQuotedPattern <|> doubleQuotedPattern         return $ prefix ++ stripquotes p-      quotedPattern = do-        p <- between (oneOf "'\"") (oneOf "'\"") $ many $ noneOf "'\""-        return $ stripquotes p+      singleQuotedPattern = between (char '\'') (char '\'') (many $ noneOf "'") >>= return . stripquotes+      doubleQuotedPattern = between (char '"') (char '"') (many $ noneOf "\"") >>= return . stripquotes       pattern = many (noneOf " \n\r")  tests_words'' = [@@ -204,7 +208,7 @@     ,"date"     ,"edate"     ,"status"-    ,"sym"+    ,"cur"     ,"real"     ,"empty"     ,"depth"@@ -241,10 +245,10 @@                                     Right (_,span) -> Left $ Date2 span parseQueryTerm _ ('s':'t':'a':'t':'u':'s':':':s) = Left $ Status $ parseStatus s parseQueryTerm _ ('r':'e':'a':'l':':':s) = Left $ Real $ parseBool s-parseQueryTerm _ ('a':'m':'t':':':s) = Left $ Amt op q where (op, q) = parseAmountQueryTerm s+parseQueryTerm _ ('a':'m':'t':':':s) = Left $ Amt ord q where (ord, q) = parseAmountQueryTerm s parseQueryTerm _ ('e':'m':'p':'t':'y':':':s) = Left $ Empty $ parseBool s parseQueryTerm _ ('d':'e':'p':'t':'h':':':s) = Left $ Depth $ readDef 0 s-parseQueryTerm _ ('s':'y':'m':':':s) = Left $ Sym s+parseQueryTerm _ ('c':'u':'r':':':s) = Left $ Sym s -- support cur: as an alias parseQueryTerm _ ('t':'a':'g':':':s) = Left $ Tag n v where (n,v) = parseTag s parseQueryTerm _ "" = Left $ Any parseQueryTerm d s = parseQueryTerm d $ defaultprefix++":"++s@@ -269,25 +273,43 @@     -- "amt:>10000.10" `gives` (Left $ Amt GT 10000.1)  ] ++data OrdPlus = Lt | Gt | Eq | AbsLt | AbsGt | AbsEq+ deriving (Show,Eq,Data,Typeable)+ -- can fail-parseAmountQueryTerm :: String -> (Ordering, Quantity)-parseAmountQueryTerm s =-  case s of-    ""     -> err-    '<':s' -> (LT, readDef err s')-    '=':s' -> (EQ, readDef err s')-    '>':s' -> (GT, readDef err s')-    s'     -> (EQ, readDef err s')+parseAmountQueryTerm :: String -> (OrdPlus, Quantity)+parseAmountQueryTerm s' =+  case s' of+    -- feel free to do this a smarter way+    ""        -> err+    '<':'+':s -> (Lt, readDef err s)+    '>':'+':s -> (Gt, readDef err s)+    '=':'+':s -> (Eq, readDef err s)+    '+':s     -> (Eq, readDef err s)+    '<':'-':s -> (Lt, negate $ readDef err s)+    '>':'-':s -> (Gt, negate $ readDef err s)+    '=':'-':s -> (Eq, negate $ readDef err s)+    '-':s     -> (Eq, negate $ readDef err s)+    '<':s     -> let n = readDef err s in case n of 0 -> (Lt, 0)+                                                    _ -> (AbsLt, n)+    '>':s     -> let n = readDef err s in case n of 0 -> (Gt, 0)+                                                    _ -> (AbsGt, n)+    '=':s     -> (AbsEq, readDef err s)+    s         -> (AbsEq, readDef err s)   where-    err = error' $ "could not parse as '=', '<', or '>' (optional) followed by a numeric quantity: " ++ s+    err = error' $ "could not parse as '=', '<', or '>' (optional) followed by a (optionally signed) numeric quantity: " ++ s'  tests_parseAmountQueryTerm = [   "parseAmountQueryTerm" ~: do     let s `gives` r = parseAmountQueryTerm s `is` r-    "<0" `gives` (LT,0)-    "=0.23" `gives` (EQ,0.23)-    "0.23" `gives` (EQ,0.23)-    ">10000.10" `gives` (GT,10000.1)+    "<0" `gives` (Lt,0) -- special case for convenience, since AbsLt 0 would be always false+    ">0" `gives` (Gt,0) -- special case for convenience and consistency with above+    ">10000.10" `gives` (AbsGt,10000.1)+    "=0.23" `gives` (AbsEq,0.23)+    "0.23" `gives` (AbsEq,0.23)+    "=+0.23" `gives` (Eq,0.23)+    "-0.23" `gives` (Eq,(-0.23))   ]  parseTag :: String -> (String, Maybe String)@@ -381,6 +403,7 @@  queryIsDate :: Query -> Bool queryIsDate (Date _) = True+queryIsDate (Date2 _) = True queryIsDate _ = False  queryIsDesc :: Query -> Bool@@ -391,6 +414,10 @@ queryIsAcct (Acct _) = True queryIsAcct _ = False +queryIsSym :: Query -> Bool+queryIsSym (Sym _) = True+queryIsSym _ = False+ -- | Does this query specify a start date and nothing else (that would -- filter postings prior to the date) ? -- When the flag is true, look for a starting secondary date instead.@@ -517,6 +544,35 @@     assertBool "" $ not $ (Tag "a" Nothing) `matchesAccount` "a"  ] +matchesMixedAmount :: Query -> MixedAmount -> Bool+matchesMixedAmount q (Mixed []) = q `matchesAmount` nullamt+matchesMixedAmount q (Mixed as) = any (q `matchesAmount`) as++-- | Does the match expression match this (simple) amount ?+matchesAmount :: Query -> Amount -> Bool+matchesAmount (Not q) a = not $ q `matchesAmount` a+matchesAmount (Any) _ = True+matchesAmount (None) _ = False+matchesAmount (Or qs) a = any (`matchesAmount` a) qs+matchesAmount (And qs) a = all (`matchesAmount` a) qs+--+matchesAmount (Amt ord n) a = compareAmount ord n a+matchesAmount (Sym r) a = regexMatchesCI ("^" ++ r ++ "$") $ acommodity a+--+matchesAmount _ _ = True++-- | Is this simple (single-amount) mixed amount's quantity less than, greater than, equal to, or unsignedly equal to this number ?+-- For multi-amount (multiple commodities, or just unsimplified) mixed amounts this is always true.++-- | Is this amount's quantity less than, greater than, equal to, or unsignedly equal to this number ?+compareAmount :: OrdPlus -> Quantity -> Amount -> Bool+compareAmount ord q Amount{aquantity=aq} = case ord of Lt    -> aq <  q+                                                       Gt    -> aq >  q+                                                       Eq    -> aq == q+                                                       AbsLt -> abs aq <  abs q+                                                       AbsGt -> abs aq >  abs q+                                                       AbsEq -> abs aq == abs q+ -- | Does the match expression match this posting ? matchesPosting :: Query -> Posting -> Bool matchesPosting (Not q) p = not $ q `matchesPosting` p@@ -531,8 +587,9 @@ matchesPosting (Date2 span) p = span `spanContainsDate` postingDate2 p matchesPosting (Status v) p = v == postingCleared p matchesPosting (Real v) p = v == isReal p-matchesPosting (Depth d) Posting{paccount=a} = Depth d `matchesAccount` a-matchesPosting (Amt op n) Posting{pamount=a} = compareMixedAmount op n a+matchesPosting q@(Depth _) Posting{paccount=a} = q `matchesAccount` a+matchesPosting q@(Amt _ _) Posting{pamount=amt} = q `matchesMixedAmount` amt+-- matchesPosting q@(Amt _ _) Posting{pamount=amt} = q `matchesMixedAmount` amt -- matchesPosting (Empty v) Posting{pamount=a} = v == isZeroMixedAmount a -- matchesPosting (Empty False) Posting{pamount=a} = True -- matchesPosting (Empty True) Posting{pamount=a} = isZeroMixedAmount a@@ -542,14 +599,6 @@ matchesPosting (Tag n (Just v)) p = isJust $ lookupTagByNameAndValue (n,v) $ postingAllTags p -- matchesPosting _ _ = False --- | Is this simple mixed amount's quantity less than, equal to, or greater than this number ?--- For complext mixed amounts (with multiple commodities), this is always true.-compareMixedAmount :: Ordering -> Quantity -> MixedAmount -> Bool-compareMixedAmount op q (Mixed [])  = compareMixedAmount op q (Mixed [amount])--- compareMixedAmount op q (Mixed [a]) = strace (compare (strace $ aquantity a) (strace q)) == op-compareMixedAmount op q (Mixed [a]) = compare (aquantity a) q == op-compareMixedAmount _ _ _            = True- tests_matchesPosting = [    "matchesPosting" ~: do     -- matching posting status..@@ -613,8 +662,8 @@    assertBool "" $ (Desc "x x") `matchesTransaction` nulltransaction{tdescription="x x"}    -- see posting for more tag tests    assertBool "" $ (Tag "foo" (Just "a")) `matchesTransaction` nulltransaction{ttags=[("foo","bar")]}-   -- a tag match on a transaction usually ignores posting tags-   assertBool "" $ not $ (Tag "postingtag" Nothing) `matchesTransaction` nulltransaction{tpostings=[nullposting{ptags=[("postingtag","")]}]}+   -- a tag match on a transaction also matches posting tags+   assertBool "" $ (Tag "postingtag" Nothing) `matchesTransaction` nulltransaction{tpostings=[nullposting{ptags=[("postingtag","")]}]}  ]  lookupTagByName :: String -> [Tag] -> Maybe Tag

@@ -18,11 +18,13 @@        requireJournalFileExists,        ensureJournalFileExists,        -- * Parsers used elsewhere-       accountname,+       postingp,+       accountnamep,        amountp,        amountp',        mamountp',-       code,+       numberp,+       codep,        -- * Tests        samplejournal,        tests_Hledger_Read,@@ -112,7 +114,7 @@ -- - otherwise, try them all. -- -- A CSV conversion rules file may also be specified for use by the CSV reader.-readJournal :: Maybe Format -> Maybe FilePath -> Maybe FilePath -> String -> IO (Either String Journal)+readJournal :: Maybe StorageFormat -> Maybe FilePath -> Maybe FilePath -> String -> IO (Either String Journal) readJournal format rulesfile path s =   -- trace (show (format, rulesfile, path)) $   tryReaders $ readersFor (format, path, s)@@ -132,19 +134,19 @@         path' = fromMaybe "(string)" path  -- | Which readers are worth trying for this (possibly unspecified) format, filepath, and data ?-readersFor :: (Maybe Format, Maybe FilePath, String) -> [Reader]+readersFor :: (Maybe StorageFormat, Maybe FilePath, String) -> [Reader] readersFor (format,path,s) =     case format of -     Just f  -> case readerForFormat f of Just r  -> [r]-                                          Nothing -> []+     Just f  -> case readerForStorageFormat f of Just r  -> [r]+                                                 Nothing -> []      Nothing -> case path of Nothing  -> readers                              Just "-" -> readers                              Just p   -> case readersForPathAndData (p,s) of [] -> readers                                                                              rs -> rs  -- | Find the (first) reader which can handle the given format, if any.-readerForFormat :: Format -> Maybe Reader-readerForFormat s | null rs = Nothing+readerForStorageFormat :: StorageFormat -> Maybe Reader+readerForStorageFormat s | null rs = Nothing                   | otherwise = Just $ head rs     where        rs = filter ((s==).rFormat) readers :: [Reader]@@ -157,7 +159,7 @@ -- an error message, using the specified data format or trying all known -- formats. A CSV conversion rules file may be specified for better -- conversion of that format.-readJournalFile :: Maybe Format -> Maybe FilePath -> FilePath -> IO (Either String Journal)+readJournalFile :: Maybe StorageFormat -> Maybe FilePath -> FilePath -> IO (Either String Journal) readJournalFile format rulesfile "-" = do   hSetNewlineMode stdin universalNewlineMode   getContents >>= readJournal format rulesfile (Just "(stdin)")@@ -173,7 +175,7 @@   exists <- doesFileExist f   when (not exists) $ do     hPrintf stderr "The hledger journal file \"%s\" was not found.\n" f-    hPrintf stderr "Please create it first, eg with hledger add or a text editor.\n"+    hPrintf stderr "Please create it first, eg with \"hledger add\" or a text editor.\n"     hPrintf stderr "Or, specify an existing journal file with -f or LEDGER_FILE.\n"     exitFailure 

@@ -26,13 +26,16 @@   directive,   defaultyeardirective,   historicalpricedirective,-  datetime,-  code,-  accountname,+  datetimep,+  codep,+  accountnamep,+  postingp,   amountp,   amountp',   mamountp',-  emptyline+  numberp,+  emptyorcommentlinep,+  followingcommentp #ifdef TESTS   -- * Tests   -- disabled by default, HTF not available on windows@@ -158,7 +161,7 @@                            , liftM (return . addModifierTransaction) modifiertransaction                            , liftM (return . addPeriodicTransaction) periodictransaction                            , liftM (return . addHistoricalPrice) historicalpricedirective-                           , emptyline >> return (return id)+                           , emptyorcommentlinep >> return (return id)                            ] <?> "journal transaction or directive"  -- cf http://ledger-cli.org/3.0/doc/ledger3.html#Command-Directives@@ -206,7 +209,7 @@ accountdirective = do   string "account"   many1 spacenonewline-  parent <- accountname+  parent <- accountnamep   newline   pushParentAccount parent   return $ return id@@ -271,7 +274,7 @@ historicalpricedirective = do   char 'P' <?> "historical price"   many spacenonewline-  date <- try (do {LocalTime d _ <- datetime; return d}) <|> date -- a time is ignored+  date <- try (do {LocalTime d _ <- datetimep; return d}) <|> date -- a time is ignored   many1 spacenonewline   symbol <- commoditysymbol   many spacenonewline@@ -322,9 +325,9 @@   date <- date <?> "transaction"   edate <- optionMaybe (secondarydate date) <?> "secondary date"   status <- status <?> "cleared flag"-  code <- code <?> "transaction code"+  code <- codep <?> "transaction code"   description <- descriptionp >>= return . strip-  comment <- try followingcomment <|> (newline >> return "")+  comment <- try followingcommentp <|> (newline >> return "")   let tags = tagsInComment comment   postings <- postings   return $ txnTieKnot $ Transaction date edate status code description comment tags postings ""@@ -442,8 +445,8 @@ -- timezone will be ignored; the time is treated as local time.  Fewer -- digits are allowed, except in the timezone. The year may be omitted if -- a default year has already been set.-datetime :: GenParser Char JournalContext LocalTime-datetime = do+datetimep :: GenParser Char JournalContext LocalTime+datetimep = do   day <- date   many1 spacenonewline   h <- many1 digit@@ -486,8 +489,8 @@ status :: GenParser Char JournalContext Bool status = try (do { many spacenonewline; (char '*' <|> char '!') <?> "status"; return True } ) <|> return False -code :: GenParser Char JournalContext String-code = try (do { many1 spacenonewline; char '(' <?> "code"; code <- anyChar `manyTill` char ')'; return code } ) <|> return ""+codep :: GenParser Char JournalContext String+codep = try (do { many1 spacenonewline; char '(' <?> "codep"; code <- anyChar `manyTill` char ')'; return code } ) <|> return ""  -- Parse the following whitespace-beginning lines as postings, posting tags, and/or comments. postings :: GenParser Char JournalContext [Posting]@@ -512,7 +515,7 @@   _ <- fixedlotprice   many spacenonewline   ctx <- getState-  comment <- try followingcomment <|> (newline >> return "")+  comment <- try followingcommentp <|> (newline >> return "")   let tags = tagsInComment comment   -- oh boy   d  <- maybe (return Nothing) (either (fail.show) (return.Just)) (parseWithCtx ctx date `fmap` dateValueFromTags tags)@@ -569,7 +572,7 @@ -- | Parse an account name, then apply any parent account prefix and/or account aliases currently in effect. modifiedaccountname :: GenParser Char JournalContext AccountName modifiedaccountname = do-  a <- accountname+  a <- accountnamep   prefix <- getParentAccount   let prefixed = prefix `joinAccountNames` a   aliases <- getAccountAliases@@ -579,12 +582,12 @@ -- them, and are terminated by two or more spaces. They should have one or -- more components of at least one character, separated by the account -- separator char.-accountname :: GenParser Char st AccountName-accountname = do+accountnamep :: GenParser Char st AccountName+accountnamep = do     a <- many1 (nonspace <|> singlespace)     let a' = striptrailingspace a     when (accountNameFromComponents (accountNameComponents a') /= a')-         (fail $ "accountname seems ill-formed: "++a')+         (fail $ "account name seems ill-formed: "++a')     return a'     where        singlespace = try (do {spacenonewline; do {notFollowedBy spacenonewline; return ' '}})@@ -646,21 +649,27 @@ mamountp' :: String -> MixedAmount mamountp' = mixed . amountp' +signp :: GenParser Char JournalContext String+signp = do+  sign <- optionMaybe $ oneOf "+-"+  return $ case sign of Just '-' -> "-"+                        _        -> ""+ leftsymbolamount :: GenParser Char JournalContext Amount leftsymbolamount = do-  sign <- optionMaybe $ string "-"-  let applysign = if isJust sign then negate else id+  sign <- signp   c <- commoditysymbol    sp <- many spacenonewline-  (q,prec,dec,sep,seppos) <- number+  (q,prec,dec,sep,seppos) <- numberp   let s = amountstyle{ascommodityside=L, ascommodityspaced=not $ null sp, asdecimalpoint=dec, asprecision=prec, asseparator=sep, asseparatorpositions=seppos}   p <- priceamount+  let applysign = if sign=="-" then negate else id   return $ applysign $ Amount c q p s   <?> "left-symbol amount"  rightsymbolamount :: GenParser Char JournalContext Amount rightsymbolamount = do-  (q,prec,dec,sep,seppos) <- number+  (q,prec,dec,sep,seppos) <- numberp   sp <- many spacenonewline   c <- commoditysymbol   p <- priceamount@@ -670,12 +679,12 @@  nosymbolamount :: GenParser Char JournalContext Amount nosymbolamount = do-  (q,prec,dec,sep,seppos) <- number+  (q,prec,dec,sep,seppos) <- numberp   p <- priceamount   defcs <- getCommodityAndStyle   let (c,s) = case defcs of-        Just (c',s') -> (c',s')-        Nothing -> ("", amountstyle{asdecimalpoint=dec, asprecision=prec, asseparator=sep, asseparatorpositions=seppos})+        Just (defc,defs) -> (defc, defs{asprecision=max (asprecision defs) prec})+        Nothing          -> ("", amountstyle{asdecimalpoint=dec, asprecision=prec, asseparator=sep, asseparatorpositions=seppos})   return $ Amount c q p s   <?> "no-symbol amount" @@ -743,25 +752,26 @@ -- and separator characters (defaulting to . and ,), and the positions of -- separators (counting leftward from the decimal point, the last is -- assumed to repeat).-number :: GenParser Char JournalContext (Quantity, Int, Char, Char, [Int])-number = do-  sign <- optionMaybe $ string "-"+numberp :: GenParser Char JournalContext (Quantity, Int, Char, Char, [Int])+numberp = do+  sign <- signp   parts <- many1 $ choice' [many1 digit, many1 $ char ',', many1 $ char '.']   let numeric = isNumber . headDef '_'-      (_, puncparts) = partition numeric parts+      (numparts, puncparts) = partition numeric parts       (ok,decimalpoint',separator') =-          case puncparts of-            []     -> (True, Nothing, Nothing)  -- no punctuation chars-            [d:""] -> (True, Just d, Nothing)   -- just one punctuation char, assume it's a decimal point-            [_]    -> (False, Nothing, Nothing) -- adjacent punctuation chars, not ok-            _:_:_  -> let (s:ss, d) = (init puncparts, last puncparts) -- two or more punctuation chars-                     in if (any ((/=1).length) puncparts  -- adjacent punctuation chars, not ok-                            || any (s/=) ss                -- separator chars differ, not ok-                            || head parts == s)            -- number begins with a separator char, not ok-                         then (False, Nothing, Nothing)-                         else if s == d-                               then (True, Nothing, Just $ head s) -- just one kind of punctuation, assume separator chars-                               else (True, Just $ head d, Just $ head s) -- separators and a decimal point+          case (numparts,puncparts) of+            ([],_)     -> (False, Nothing, Nothing)  -- no digits+            (_,[])     -> (True, Nothing, Nothing)  -- no punctuation chars+            (_,[d:""]) -> (True, Just d, Nothing)   -- just one punctuation char, assume it's a decimal point+            (_,[_])    -> (False, Nothing, Nothing) -- adjacent punctuation chars, not ok+            (_,_:_:_)  -> let (s:ss, d) = (init puncparts, last puncparts) -- two or more punctuation chars+                          in if (any ((/=1).length) puncparts  -- adjacent punctuation chars, not ok+                                 || any (s/=) ss                -- separator chars differ, not ok+                                 || head parts == s)            -- number begins with a separator char, not ok+                              then (False, Nothing, Nothing)+                              else if s == d+                                    then (True, Nothing, Just $ head s) -- just one kind of punctuation, assume separator chars+                                    else (True, Just $ head d, Just $ head s) -- separators and a decimal point   when (not ok) (fail $ "number seems ill-formed: "++concat parts)   let (intparts',fracparts') = span ((/= decimalpoint') . Just . head) parts       (intparts, fracpart) = (filter numeric intparts', filter numeric fracparts')@@ -771,8 +781,7 @@       precision = length frac       int' = if null int then "0" else int       frac' = if null frac then "0" else frac-      sign' = fromMaybe "" sign-      quantity = read $ sign'++int'++"."++frac' -- this read should never fail+      quantity = read $ sign++int'++"."++frac' -- this read should never fail       (decimalpoint, separator) = case (decimalpoint', separator') of (Just d,  Just s)   -> (d,s)                                                                       (Just '.',Nothing)  -> ('.',',')                                                                       (Just ',',Nothing)  -> (',','.')@@ -780,12 +789,12 @@                                                                       (Nothing, Just ',') -> ('.',',')                                                                       _                   -> ('.',',')   return (quantity,precision,decimalpoint,separator,separatorpositions)-  <?> "number"+  <?> "numberp"  #ifdef TESTS-test_number = do-      let s `is` n = assertParseEqual' (parseWithCtx nullctx number s) n-          assertFails = assertBool . isLeft . parseWithCtx nullctx number +test_numberp = do+      let s `is` n = assertParseEqual' (parseWithCtx nullctx numberp s) n+          assertFails = assertBool . isLeft . parseWithCtx nullctx numberp        assertFails ""       "0"          `is` (0, 0, '.', ',', [])       "1"          `is` (1, 0, '.', ',', [])@@ -808,23 +817,28 @@  -- comment parsers -emptyline :: GenParser Char JournalContext ()-emptyline = do many spacenonewline-               optional $ (char ';' <?> "comment") >> many (noneOf "\n")-               newline-               return ()+emptyorcommentlinep :: GenParser Char JournalContext ()+emptyorcommentlinep = do+  many spacenonewline >> (comment <|> (many spacenonewline >> newline >> return ""))+  return () -followingcomment :: GenParser Char JournalContext String-followingcomment =-  -- ptrace "followingcomment"-  do samelinecomment <- many spacenonewline >> (try commentline <|> (newline >> return ""))-     newlinecomments <- many (try (many1 spacenonewline >> commentline))+followingcommentp :: GenParser Char JournalContext String+followingcommentp =+  -- ptrace "followingcommentp"+  do samelinecomment <- many spacenonewline >> (try semicoloncomment <|> (newline >> return ""))+     newlinecomments <- many (try (many1 spacenonewline >> semicoloncomment))      return $ unlines $ samelinecomment:newlinecomments -commentline :: GenParser Char JournalContext String-commentline = do-  -- ptrace "commentline"-  char ';'+comment :: GenParser Char JournalContext String+comment = commentStartingWith "#;"++semicoloncomment :: GenParser Char JournalContext String+semicoloncomment = commentStartingWith ";"++commentStartingWith :: String -> GenParser Char JournalContext String+commentStartingWith cs = do+  -- ptrace "commentStartingWith"+  oneOf cs   many spacenonewline   l <- anyChar `manyTill` eolof   optional newline@@ -892,12 +906,12 @@ {- old hunit tests  test_Hledger_Read_JournalReader = TestList $ concat [-    test_number,+    test_numberp,     test_amountp,     test_spaceandamountormissing,     test_tagcomment,     test_inlinecomment,-    test_commentlines,+    test_comments,     test_ledgerDateSyntaxToTags,     test_postingp,     test_transaction,@@ -913,18 +927,18 @@      assertParse (parseWithCtx nullctx directive "account some:account\n")      assertParse (parseWithCtx nullctx (directive >> directive) "!account a\nend\n") -  ,"commentline" ~: do-     assertParse (parseWithCtx nullctx commentline "; some comment \n")-     assertParse (parseWithCtx nullctx commentline " \t; x\n")-     assertParse (parseWithCtx nullctx commentline ";x")+  ,"comment" ~: do+     assertParse (parseWithCtx nullctx comment "; some comment \n")+     assertParse (parseWithCtx nullctx comment " \t; x\n")+     assertParse (parseWithCtx nullctx comment "#x")    ,"date" ~: do      assertParse (parseWithCtx nullctx date "2011/1/1")      assertParseFailure (parseWithCtx nullctx date "1/1")      assertParse (parseWithCtx nullctx{ctxYear=Just 2011} date "1/1") -  ,"datetime" ~: do-      let p = do {t <- datetime; eof; return t}+  ,"datetimep" ~: do+      let p = do {t <- datetimep; eof; return t}           bad = assertParseFailure . parseWithCtx nullctx p           good = assertParse . parseWithCtx nullctx p       bad "2011/1/1"@@ -962,11 +976,11 @@      assertParse (parseWithCtx nullctx endtagdirective "end tag \n")      assertParse (parseWithCtx nullctx endtagdirective "pop \n") -  ,"accountname" ~: do-    assertBool "accountname parses a normal accountname" (isRight $ parsewith accountname "a:b:c")-    assertBool "accountname rejects an empty inner component" (isLeft $ parsewith accountname "a::c")-    assertBool "accountname rejects an empty leading component" (isLeft $ parsewith accountname ":b:c")-    assertBool "accountname rejects an empty trailing component" (isLeft $ parsewith accountname "a:b:")+  ,"accountnamep" ~: do+    assertBool "accountnamep parses a normal account name" (isRight $ parsewith accountnamep "a:b:c")+    assertBool "accountnamep rejects an empty inner component" (isLeft $ parsewith accountnamep "a::c")+    assertBool "accountnamep rejects an empty leading component" (isLeft $ parsewith accountnamep ":b:c")+    assertBool "accountnamep rejects an empty trailing component" (isLeft $ parsewith accountnamep "a:b:")    ,"leftsymbolamount" ~: do     assertParseEqual (parseWithCtx nullctx leftsymbolamount "$1")  (usd 1 `withPrecision` 0)

@@ -56,7 +56,7 @@ import Hledger.Data -- XXX too much reuse ? import Hledger.Read.JournalReader (-  directive, historicalpricedirective, defaultyeardirective, emptyline, datetime,+  directive, historicalpricedirective, defaultyeardirective, emptyorcommentlinep, datetimep,   parseJournalWith, getParentAccount   ) import Hledger.Utils@@ -91,7 +91,7 @@       timelogItem = choice [ directive                           , liftM (return . addHistoricalPrice) historicalpricedirective                           , defaultyeardirective-                          , emptyline >> return (return id)+                          , emptyorcommentlinep >> return (return id)                           , liftM (return . addTimeLogEntry)  timelogentry                           ] <?> "timelog entry, or default year or historical price directive" @@ -100,7 +100,7 @@ timelogentry = do   code <- oneOf "bhioO"   many1 spacenonewline-  datetime <- datetime+  datetime <- datetimep   comment <- optionMaybe (many1 spacenonewline >> liftM2 (++) getParentAccount restofline)   return $ TimeLogEntry (read [code]) datetime (maybe "" rstrip comment) 

@@ -9,1289 +9,35 @@ -}  module Hledger.Reports (-  -- * Report options-  -- | -  ReportOpts(..),-  BalanceType(..),-  DisplayExp,-  FormatStr,-  defreportopts,-  dateSpanFromOpts,-  intervalFromOpts,-  clearedValueFromOpts,-  whichDateFromOpts,-  journalSelectingAmountFromOpts,-  queryFromOpts,-  queryOptsFromOpts,-  reportSpans,-  -- * Entries report-  -- | -  EntriesReport,-  EntriesReportItem,-  entriesReport,-  -- * Postings report-  -- | -  PostingsReport,-  PostingsReportItem,-  postingsReport,-  mkpostingsReportItem, -- XXX for showPostingWithBalanceForVty in Hledger.Cli.Register-  -- * Transactions report-  -- | -  TransactionsReport,-  TransactionsReportItem,-  triDate,-  triBalance,-  triSimpleBalance,-  transactionsReportByCommodity,-  journalTransactionsReport,-  accountTransactionsReport,--  -- * Balance reports-  {-|-  These are used for the various modes of the balance command-  (see "Hledger.Cli.Balance").-  -}-  BalanceReport,-  BalanceReportItem,-  balanceReport,-  MultiBalanceReport(..),-  MultiBalanceReportItem,-  RenderableAccountName,-  periodBalanceReport,-  cumulativeOrHistoricalBalanceReport,--  -- * Other reports-  -- | -  accountBalanceHistory,--  -- * Tests-  tests_Hledger_Reports-)-where--import Control.Monad-import Data.List-import Data.Maybe--- import qualified Data.Map as M-import Data.Ord-import Data.Time.Calendar--- import Data.Tree-import Safe (headMay, lastMay)-import System.Console.CmdArgs  -- for defaults support-import Test.HUnit-import Text.ParserCombinators.Parsec-import Text.Printf--import Hledger.Data-import Hledger.Read (mamountp')-import Hledger.Query-import Hledger.Utils----------------------------------------------------------------------------------- report options handling---- | Standard options for customising report filtering and output,--- corresponding to hledger's command-line options and query language--- arguments. Used in hledger-lib and above.-data ReportOpts = ReportOpts {-     begin_          :: Maybe Day-    ,end_            :: Maybe Day-    ,period_         :: Maybe (Interval,DateSpan)-    ,cleared_        :: Bool-    ,uncleared_      :: Bool-    ,cost_           :: Bool-    ,depth_          :: Maybe Int-    ,display_        :: Maybe DisplayExp-    ,date2_          :: Bool-    ,empty_          :: Bool-    ,no_elide_       :: Bool-    ,real_           :: Bool-    ,balancetype_    :: BalanceType -- for balance command-    ,flat_           :: Bool -- for balance command-    ,drop_           :: Int  -- "-    ,no_total_       :: Bool -- "-    ,daily_          :: Bool-    ,weekly_         :: Bool-    ,monthly_        :: Bool-    ,quarterly_      :: Bool-    ,yearly_         :: Bool-    ,format_         :: Maybe FormatStr-    ,related_        :: Bool-    ,average_        :: Bool-    ,query_          :: String -- all arguments, as a string- } deriving (Show, Data, Typeable)--type DisplayExp = String-type FormatStr = String---- | Which balance is being shown in a multi-column balance report.-data BalanceType = PeriodBalance     -- ^ The change of balance in each period.-                 | CumulativeBalance -- ^ The accumulated balance at each period's end, starting from zero at the report start date.-                 | HistoricalBalance -- ^ The historical balance at each period's end, starting from the account balances at the report start date.-  deriving (Eq,Show,Data,Typeable)-instance Default BalanceType where def = PeriodBalance--defreportopts = ReportOpts-    def-    def-    def-    def-    def-    def-    def-    def-    def-    def-    def-    def-    def-    def-    def-    def-    def-    def-    def-    def-    def-    def-    def-    def-    def--instance Default ReportOpts where def = defreportopts---- | Figure out the date span we should report on, based on any--- begin/end/period options provided. A period option will cause begin and--- end options to be ignored.-dateSpanFromOpts :: Day -> ReportOpts -> DateSpan-dateSpanFromOpts _ ReportOpts{..} =-    case period_ of Just (_,span) -> span-                    Nothing -> DateSpan begin_ end_---- | Figure out the reporting interval, if any, specified by the options.--- --period overrides --daily overrides --weekly overrides --monthly etc.-intervalFromOpts :: ReportOpts -> Interval-intervalFromOpts ReportOpts{..} =-    case period_ of-      Just (interval,_) -> interval-      Nothing -> i-          where i | daily_ = Days 1-                  | weekly_ = Weeks 1-                  | monthly_ = Months 1-                  | quarterly_ = Quarters 1-                  | yearly_ = Years 1-                  | otherwise =  NoInterval---- | Get a maybe boolean representing the last cleared/uncleared option if any.-clearedValueFromOpts :: ReportOpts -> Maybe Bool-clearedValueFromOpts ReportOpts{..} | cleared_   = Just True-                                    | uncleared_ = Just False-                                    | otherwise  = Nothing---- depthFromOpts :: ReportOpts -> Int--- depthFromOpts opts = min (fromMaybe 99999 $ depth_ opts) (queryDepth $ queryFromOpts nulldate opts)---- | Report which date we will report on based on --date2.-whichDateFromOpts :: ReportOpts -> WhichDate-whichDateFromOpts ReportOpts{..} = if date2_ then SecondaryDate else PrimaryDate---- | Select the Transaction date accessor based on --date2.-transactionDateFn :: ReportOpts -> (Transaction -> Day)-transactionDateFn ReportOpts{..} = if date2_ then transactionDate2 else tdate---- | Select the Posting date accessor based on --date2.-postingDateFn :: ReportOpts -> (Posting -> Day)-postingDateFn ReportOpts{..} = if date2_ then postingDate2 else postingDate----- | Convert this journal's postings' amounts to the cost basis amounts if--- specified by options.-journalSelectingAmountFromOpts :: ReportOpts -> Journal -> Journal-journalSelectingAmountFromOpts opts-    | cost_ opts = journalConvertAmountsToCost-    | otherwise = id---- | Convert report options and arguments to a query.-queryFromOpts :: Day -> ReportOpts -> Query-queryFromOpts d opts@ReportOpts{..} = simplifyQuery $ And $ [flagsq, argsq]-  where-    flagsq = And $-              [(if date2_ then Date2 else Date) $ dateSpanFromOpts d opts]-              ++ (if real_ then [Real True] else [])-              ++ (if empty_ then [Empty True] else []) -- ?-              ++ (maybe [] ((:[]) . Status) (clearedValueFromOpts opts))-              ++ (maybe [] ((:[]) . Depth) depth_)-    argsq = fst $ parseQuery d query_--tests_queryFromOpts = [- "queryFromOpts" ~: do-  assertEqual "" Any (queryFromOpts nulldate defreportopts)-  assertEqual "" (Acct "a") (queryFromOpts nulldate defreportopts{query_="a"})-  assertEqual "" (Desc "a a") (queryFromOpts nulldate defreportopts{query_="desc:'a a'"})-  assertEqual "" (Date $ mkdatespan "2012/01/01" "2013/01/01")-                 (queryFromOpts nulldate defreportopts{begin_=Just (parsedate "2012/01/01")-                                                      ,query_="date:'to 2013'"-                                                      })-  assertEqual "" (Date2 $ mkdatespan "2012/01/01" "2013/01/01")-                 (queryFromOpts nulldate defreportopts{query_="edate:'in 2012'"})-  assertEqual "" (Or [Acct "a a", Acct "'b"])-                 (queryFromOpts nulldate defreportopts{query_="'a a' 'b"})- ]---- | Convert report options and arguments to query options.-queryOptsFromOpts :: Day -> ReportOpts -> [QueryOpt]-queryOptsFromOpts d ReportOpts{..} = flagsqopts ++ argsqopts-  where-    flagsqopts = []-    argsqopts = snd $ parseQuery d query_--tests_queryOptsFromOpts = [- "queryOptsFromOpts" ~: do-  assertEqual "" [] (queryOptsFromOpts nulldate defreportopts)-  assertEqual "" [] (queryOptsFromOpts nulldate defreportopts{query_="a"})-  assertEqual "" [] (queryOptsFromOpts nulldate defreportopts{begin_=Just (parsedate "2012/01/01")-                                                             ,query_="date:'to 2013'"-                                                             })- ]------------------------------------------------------------------------------------- | A journal entries report is a list of whole transactions as--- originally entered in the journal (mostly). This is used by eg--- hledger's print command and hledger-web's journal entries view.-type EntriesReport = [EntriesReportItem]-type EntriesReportItem = Transaction---- | Select transactions for an entries report.-entriesReport :: ReportOpts -> Query -> Journal -> EntriesReport-entriesReport opts q j =-  sortBy (comparing date) $ filter (q `matchesTransaction`) ts-    where-      date = transactionDateFn opts-      ts = jtxns $ journalSelectingAmountFromOpts opts j--tests_entriesReport = [-  "entriesReport" ~: do-    assertEqual "not acct" 1 (length $ entriesReport defreportopts (Not $ Acct "bank") samplejournal)-    let span = mkdatespan "2008/06/01" "2008/07/01"-    assertEqual "date" 3 (length $ entriesReport defreportopts (Date $ span) samplejournal)- ]------------------------------------------------------------------------------------- | A postings report is a list of postings with a running total, a label--- for the total field, and a little extra transaction info to help with rendering.--- This is used eg for the register command.-type PostingsReport = (String               -- label for the running balance column XXX remove-                      ,[PostingsReportItem] -- line items, one per posting-                      )-type PostingsReportItem = (Maybe Day    -- posting date, if this is the first posting in a transaction or if it's different from the previous posting's date-                          ,Maybe String -- transaction description, if this is the first posting in a transaction-                          ,Posting      -- the posting, possibly with account name depth-clipped-                          ,MixedAmount  -- the running total after this posting (or with --average, the running average)-                          )---- | Select postings from the journal and add running balance and other--- information to make a postings report. Used by eg hledger's register command.-postingsReport :: ReportOpts -> Query -> Journal -> PostingsReport-postingsReport opts q j = -- trace ("q: "++show q++"\nq': "++show q') $-                          (totallabel, postingsReportItems ps nullposting wd depth startbal runningcalcfn 1)-    where-      ps | interval == NoInterval = displayableps-         | otherwise              = summarisePostingsByInterval interval depth empty reportspan displayableps-      j' = journalSelectingAmountFromOpts opts j-      wd = whichDateFromOpts opts-      -- delay depth filtering until the end-      (depth, q') = (queryDepth q, filterQuery (not . queryIsDepth) q)-      (precedingps, displayableps, _) =   dbg "ps4" $ postingsMatchingDisplayExpr displayexpr opts-                                        $ dbg "ps3" $ (if related_ opts then concatMap relatedPostings else id)-                                        $ dbg "ps2" $ filter (q' `matchesPosting`)-                                        $ dbg "ps1" $ journalPostings j'-      -- enable to debug just this function-      -- dbg :: Show a => String -> a -> a-      -- dbg = lstrace--      empty = queryEmpty q-      displayexpr = display_ opts  -- XXX-      interval = intervalFromOpts opts -- XXX-      journalspan = journalDateSpan j'-      -- requestedspan should be the intersection of any span specified-      -- with period options and any span specified with display option.-      -- The latter is not easily available, fake it for now.-      requestedspan = periodspan `spanIntersect` displayspan-      periodspan = queryDateSpan secondarydate q-      secondarydate = whichDateFromOpts opts == SecondaryDate-      displayspan = postingsDateSpan ps-          where (_,ps,_) = postingsMatchingDisplayExpr displayexpr opts $ journalPostings j'-      matchedspan = postingsDateSpan displayableps-      reportspan | empty     = requestedspan `orDatesFrom` journalspan-                 | otherwise = requestedspan `spanIntersect` matchedspan-      startbal = sumPostings precedingps-      runningcalcfn | average_ opts = \i avg amt -> avg + (amt - avg) `divideMixedAmount` (fromIntegral i)-                    | otherwise     = \_ bal amt -> bal + amt--totallabel = "Total"-balancelabel = "Balance"---- | Generate postings report line items.-postingsReportItems :: [Posting] -> Posting -> WhichDate -> Int -> MixedAmount -> (Int -> MixedAmount -> MixedAmount -> MixedAmount) -> Int -> [PostingsReportItem]-postingsReportItems [] _ _ _ _ _ _ = []-postingsReportItems (p:ps) pprev wd d b runningcalcfn itemnum = i:(postingsReportItems ps p wd d b' runningcalcfn (itemnum+1))-    where-      i = mkpostingsReportItem showdate showdesc wd p' b'-      showdate = isfirstintxn || isdifferentdate-      showdesc = isfirstintxn-      isfirstintxn = ptransaction p /= ptransaction pprev-      isdifferentdate = case wd of PrimaryDate   -> postingDate p  /= postingDate pprev-                                   SecondaryDate -> postingDate2 p /= postingDate2 pprev-      p' = p{paccount=clipAccountName d $ paccount p}-      b' = runningcalcfn itemnum b (pamount p)---- | Generate one postings report line item, containing the posting,--- the current running balance, and optionally the posting date and/or--- the transaction description.-mkpostingsReportItem :: Bool -> Bool -> WhichDate -> Posting -> MixedAmount -> PostingsReportItem-mkpostingsReportItem showdate showdesc wd p b = (if showdate then Just date else Nothing, if showdesc then Just desc else Nothing, p, b)-    where-      date = case wd of PrimaryDate   -> postingDate p-                        SecondaryDate -> postingDate2 p-      desc = maybe "" tdescription $ ptransaction p---- | Date-sort and split a list of postings into three spans - postings matched--- by the given display expression, and the preceding and following postings.--- XXX always sorts by primary date, should sort by secondary date if expression is about that-postingsMatchingDisplayExpr :: Maybe String -> ReportOpts -> [Posting] -> ([Posting],[Posting],[Posting])-postingsMatchingDisplayExpr d opts ps = (before, matched, after)-    where-      sorted = sortBy (comparing (postingDateFn opts)) ps-      (before, rest) = break (displayExprMatches d) sorted-      (matched, after) = span (displayExprMatches d) rest---- | Does this display expression allow this posting to be displayed ?--- Raises an error if the display expression can't be parsed.-displayExprMatches :: Maybe String -> Posting -> Bool-displayExprMatches Nothing  _ = True-displayExprMatches (Just d) p = (fromparse $ parsewith datedisplayexpr d) p---- | Parse a hledger display expression, which is a simple date test like--- "d>[DATE]" or "d<=[DATE]", and return a "Posting"-matching predicate.-datedisplayexpr :: GenParser Char st (Posting -> Bool)-datedisplayexpr = do-  char 'd'-  op <- compareop-  char '['-  (y,m,d) <- smartdate-  char ']'-  let date    = parsedate $ printf "%04s/%02s/%02s" y m d-      test op = return $ (`op` date) . postingDate-  case op of-    "<"  -> test (<)-    "<=" -> test (<=)-    "="  -> test (==)-    "==" -> test (==)-    ">=" -> test (>=)-    ">"  -> test (>)-    _    -> mzero- where-  compareop = choice $ map (try . string) ["<=",">=","==","<","=",">"]---- -- | Clip the account names to the specified depth in a list of postings.--- depthClipPostings :: Maybe Int -> [Posting] -> [Posting]--- depthClipPostings depth = map (depthClipPosting depth)---- -- | Clip a posting's account name to the specified depth.--- depthClipPosting :: Maybe Int -> Posting -> Posting--- depthClipPosting Nothing p = p--- depthClipPosting (Just d) p@Posting{paccount=a} = p{paccount=clipAccountName d a}---- XXX confusing, refactor---- | Convert a list of postings into summary postings. Summary postings--- are one per account per interval and aggregated to the specified depth--- if any.-summarisePostingsByInterval :: Interval -> Int -> Bool -> DateSpan -> [Posting] -> [Posting]-summarisePostingsByInterval interval depth empty reportspan ps = concatMap summarisespan $ splitSpan interval reportspan-    where-      summarisespan s = summarisePostingsInDateSpan s depth empty (postingsinspan s)-      postingsinspan s = filter (isPostingInDateSpan s) ps--tests_summarisePostingsByInterval = [-  "summarisePostingsByInterval" ~: do-    summarisePostingsByInterval (Quarters 1) 99999 False (DateSpan Nothing Nothing) [] ~?= []- ]---- | Given a date span (representing a reporting interval) and a list of--- postings within it: aggregate the postings so there is only one per--- account, and adjust their date/description so that they will render--- as a summary for this interval.------ As usual with date spans the end date is exclusive, but for display--- purposes we show the previous day as end date, like ledger.------ When a depth argument is present, postings to accounts of greater--- depth are aggregated where possible.------ The showempty flag includes spans with no postings and also postings--- with 0 amount.-summarisePostingsInDateSpan :: DateSpan -> Int -> Bool -> [Posting] -> [Posting]-summarisePostingsInDateSpan (DateSpan b e) depth showempty ps-    | null ps && (isNothing b || isNothing e) = []-    | null ps && showempty = [summaryp]-    | otherwise = summaryps'-    where-      summaryp = summaryPosting b' ("- "++ showDate (addDays (-1) e'))-      b' = fromMaybe (maybe nulldate postingDate $ headMay ps) b-      e' = fromMaybe (maybe (addDays 1 nulldate) postingDate $ lastMay ps) e-      summaryPosting date desc = nullposting{ptransaction=Just nulltransaction{tdate=date,tdescription=desc}}-      summaryps' = (if showempty then id else filter (not . isZeroMixedAmount . pamount)) summaryps-      summaryps = [summaryp{paccount=a,pamount=balance a} | a <- clippedanames]-      clippedanames = nub $ map (clipAccountName depth) anames-      anames = sort $ nub $ map paccount ps-      -- aggregate balances by account, like ledgerFromJournal, then do depth-clipping-      accts = accountsFromPostings ps-      balance a = maybe nullmixedamt bal $ lookupAccount a accts -        where-          bal = if isclipped a then aibalance else aebalance-          isclipped a = accountNameLevel a >= depth------------------------------------------------------------------------------------- | A transactions report includes a list of transactions--- (posting-filtered and unfiltered variants), a running balance, and some--- other information helpful for rendering a register view (a flag--- indicating multiple other accounts and a display string describing--- them) with or without a notion of current account(s).--- Two kinds of report use this data structure, see journalTransactionsReport--- and accountTransactionsReport below for detais.-type TransactionsReport = (String                   -- label for the balance column, eg "balance" or "total"-                          ,[TransactionsReportItem] -- line items, one per transaction-                          )-type TransactionsReportItem = (Transaction -- the corresponding transaction-                              ,Transaction -- the transaction with postings to the current account(s) removed-                              ,Bool        -- is this a split, ie more than one other account posting-                              ,String      -- a display string describing the other account(s), if any-                              ,MixedAmount -- the amount posted to the current account(s) (or total amount posted)-                              ,MixedAmount -- the running balance for the current account(s) after this transaction-                              )--triDate (t,_,_,_,_,_) = tdate t-triAmount (_,_,_,_,a,_) = a-triBalance (_,_,_,_,_,a) = a-triSimpleBalance (_,_,_,_,_,Mixed a) = case a of [] -> "0"-                                                 (Amount{aquantity=q}):_ -> show q---- Split a transactions report whose items may involve several commodities,--- into one or more single-commodity transactions reports.-transactionsReportByCommodity :: TransactionsReport -> [TransactionsReport]-transactionsReportByCommodity tr =-  [filterTransactionsReportByCommodity c tr | c <- transactionsReportCommodities tr]-  where-    transactionsReportCommodities (_,items) =-      nub $ sort $ map acommodity $ concatMap (amounts . triAmount) items---- Remove transaction report items and item amount (and running--- balance amount) components that don't involve the specified--- commodity. Other item fields such as the transaction are left unchanged.-filterTransactionsReportByCommodity :: Commodity -> TransactionsReport -> TransactionsReport-filterTransactionsReportByCommodity c (label,items) =-  (label, fixTransactionsReportItemBalances $ concat [filterTransactionsReportItemByCommodity c i | i <- items])-  where-    filterTransactionsReportItemByCommodity c (t,t2,s,o,a,bal)-      | c `elem` cs = [item']-      | otherwise   = []-      where-        cs = map acommodity $ amounts a-        item' = (t,t2,s,o,a',bal)-        a' = filterMixedAmountByCommodity c a--    fixTransactionsReportItemBalances [] = []-    fixTransactionsReportItemBalances [i] = [i]-    fixTransactionsReportItemBalances items = reverse $ i:(go startbal is)-      where-        i:is = reverse items-        startbal = filterMixedAmountByCommodity c $ triBalance i-        go _ [] = []-        go bal ((t,t2,s,o,amt,_):is) = (t,t2,s,o,amt,bal'):go bal' is-          where bal' = bal + amt---- | Filter out all but the specified commodity from this amount.-filterMixedAmountByCommodity :: Commodity -> MixedAmount -> MixedAmount-filterMixedAmountByCommodity c (Mixed as) = Mixed $ filter ((==c). acommodity) as---- | Select transactions from the whole journal. This is similar to a--- "postingsReport" except with transaction-based report items which--- are ordered most recent first. This is used by eg hledger-web's journal view.-journalTransactionsReport :: ReportOpts -> Journal -> Query -> TransactionsReport-journalTransactionsReport _ Journal{jtxns=ts} m = (totallabel, items)-   where-     ts' = sortBy (comparing tdate) $ filter (not . null . tpostings) $ map (filterTransactionPostings m) ts-     items = reverse $ accountTransactionsReportItems m Nothing nullmixedamt id ts'-     -- XXX items' first element should be the full transaction with all postings------------------------------------------------------------------------------------- | Select transactions within one or more current accounts, and make a--- transactions report relative to those account(s). This means:------ 1. it shows transactions from the point of view of the current account(s).---    The transaction amount is the amount posted to the current account(s).---    The other accounts' names are provided. ------ 2. With no transaction filtering in effect other than a start date, it---    shows the accurate historical running balance for the current account(s).---    Otherwise it shows a running total starting at 0.------ This is used by eg hledger-web's account register view. Currently,--- reporting intervals are not supported, and report items are most--- recent first.-accountTransactionsReport :: ReportOpts -> Journal -> Query -> Query -> TransactionsReport-accountTransactionsReport opts j m thisacctquery = (label, items)- where-     -- transactions affecting this account, in date order-     ts = sortBy (comparing tdate) $ filter (matchesTransaction thisacctquery) $ jtxns $-          journalSelectingAmountFromOpts opts j-     -- starting balance: if we are filtering by a start date and nothing else,-     -- the sum of postings to this account before that date; otherwise zero.-     (startbal,label) | queryIsNull m                           = (nullmixedamt,        balancelabel)-                      | queryIsStartDateOnly (date2_ opts) m = (sumPostings priorps, balancelabel)-                      | otherwise                                 = (nullmixedamt,        totallabel)-                      where-                        priorps = -- ltrace "priorps" $-                                  filter (matchesPosting-                                          (-- ltrace "priormatcher" $-                                           And [thisacctquery, tostartdatequery]))-                                         $ transactionsPostings ts-                        tostartdatequery = Date (DateSpan Nothing startdate)-                        startdate = queryStartDate (date2_ opts) m-     items = reverse $ accountTransactionsReportItems m (Just thisacctquery) startbal negate ts---- | Generate transactions report items from a list of transactions,--- using the provided query and current account queries, starting balance,--- sign-setting function and balance-summing function.-accountTransactionsReportItems :: Query -> Maybe Query -> MixedAmount -> (MixedAmount -> MixedAmount) -> [Transaction] -> [TransactionsReportItem]-accountTransactionsReportItems _ _ _ _ [] = []-accountTransactionsReportItems query thisacctquery bal signfn (t:ts) =-    -- This is used for both accountTransactionsReport and journalTransactionsReport,-    -- which makes it a bit overcomplicated-    case i of Just i' -> i':is-              Nothing -> is-    where-      tmatched@Transaction{tpostings=psmatched} = filterTransactionPostings query t-      (psthisacct,psotheracct) = case thisacctquery of Just m  -> partition (matchesPosting m) psmatched-                                                       Nothing -> ([],psmatched)-      numotheraccts = length $ nub $ map paccount psotheracct-      amt = negate $ sum $ map pamount psthisacct-      acct | isNothing thisacctquery = summarisePostings psmatched -- journal register-           | numotheraccts == 0 = "transfer between " ++ summarisePostingAccounts psthisacct-           | otherwise          = prefix              ++ summarisePostingAccounts psotheracct-           where prefix = maybe "" (\b -> if b then "from " else "to ") $ isNegativeMixedAmount amt-      (i,bal') = case psmatched of-           [] -> (Nothing,bal)-           _  -> (Just (t, tmatched, numotheraccts > 1, acct, a, b), b)-                 where-                  a = signfn amt-                  b = bal + a-      is = accountTransactionsReportItems query thisacctquery bal' signfn ts---- | Generate a short readable summary of some postings, like--- "from (negatives) to (positives)".-summarisePostings :: [Posting] -> String-summarisePostings ps =-    case (summarisePostingAccounts froms, summarisePostingAccounts tos) of-       ("",t) -> "to "++t-       (f,"") -> "from "++f-       (f,t)  -> "from "++f++" to "++t-    where-      (froms,tos) = partition (fromMaybe False . isNegativeMixedAmount . pamount) ps---- | Generate a simplified summary of some postings' accounts.-summarisePostingAccounts :: [Posting] -> String-summarisePostingAccounts = intercalate ", " . map accountLeafName . nub . map paccount--filterTransactionPostings :: Query -> Transaction -> Transaction-filterTransactionPostings m t@Transaction{tpostings=ps} = t{tpostings=filter (m `matchesPosting`) ps}------------------------------------------------------------------------------------- | A list of account names plus rendering info, along with their--- balances as of the end of the reporting period, and the grand--- total. Used for the balance command's single-column mode.-type BalanceReport = ([BalanceReportItem] -- line items, one per account-                      ,MixedAmount          -- total balance of all accounts-                      )--- | * Full account name,------ * short account name for display (the leaf name, prefixed by any boring parents immediately above),------ * how many steps to indent this account (the 0-based account depth excluding boring parents, or 0 with --flat),--- --- * account balance (including subaccounts (XXX unless --flat)).-type BalanceReportItem = (AccountName-                          ,AccountName-                          ,Int-                          ,MixedAmount)---- | Select accounts, and get their balances at the end of the selected--- period, and misc. display information, for an accounts report.-balanceReport :: ReportOpts -> Query -> Journal -> BalanceReport-balanceReport opts q j = (items, total)-    where-      l =  ledgerFromJournal q $ journalSelectingAmountFromOpts opts j-      accts = clipAccounts (queryDepth q) $ ledgerRootAccount l-      accts'-          | flat_ opts = filterzeros $ tail $ flattenAccounts accts-          | otherwise  = filter (not.aboring) $ tail $ flattenAccounts $ markboring $ prunezeros accts-          where-            filterzeros | empty_ opts = id-                        | otherwise = filter (not . isZeroMixedAmount . aebalance)-            prunezeros | empty_ opts = id-                       | otherwise   = fromMaybe nullacct . pruneAccounts (isZeroMixedAmount.aibalance)-            markboring | no_elide_ opts = id-                       | otherwise      = markBoringParentAccounts-      items = map (balanceReportItem opts) accts'-      total = sum [amt | (a,_,indent,amt) <- items, if flat_ opts then accountNameLevel a == 1 else indent == 0]-              -- XXX check account level == 1 is valid when top-level accounts excluded---- | In an account tree with zero-balance leaves removed, mark the--- elidable parent accounts (those with one subaccount and no balance--- of their own).-markBoringParentAccounts :: Account -> Account-markBoringParentAccounts = tieAccountParents . mapAccounts mark-  where-    mark a | length (asubs a) == 1 && isZeroMixedAmount (aebalance a) = a{aboring=True}-           | otherwise = a--balanceReportItem :: ReportOpts -> Account -> BalanceReportItem-balanceReportItem opts a@Account{aname=name, aibalance=ibal}-  | flat_ opts = (name, name,       0,      ibal)-  | otherwise  = (name, elidedname, indent, ibal)-  where-    elidedname = accountNameFromComponents (adjacentboringparentnames ++ [accountLeafName name])-    adjacentboringparentnames = reverse $ map (accountLeafName.aname) $ takeWhile aboring $ parents-    indent = length $ filter (not.aboring) parents-    parents = init $ parentAccounts a-------------------------------------------------------------------------------------- | A multi(column) balance report is a list of accounts, each with a list of--- balances corresponding to the report's column periods. The balances' meaning depends--- on the type of balance report (see 'BalanceType' and "Hledger.Cli.Balance").--- Also included are the overall total for each period, the date span for each period,--- and some additional rendering info for the accounts.------ * The date span for each report column,--- --- * line items (one per account),--- --- * the final total for each report column.-newtype MultiBalanceReport = MultiBalanceReport-  ([DateSpan]-  ,[MultiBalanceReportItem]-  ,[MixedAmount]-  )---- | * The account name with rendering hints,------ * the account's balance (per-period balance, cumulative ending--- balance, or historical ending balance) in each of the report's--- periods.-type MultiBalanceReportItem =-  (RenderableAccountName-  ,[MixedAmount]-  )---- | * Full account name,--- --- * ledger-style short account name (the leaf name, prefixed by any boring parents immediately above),--- --- * indentation steps to use when rendering a ledger-style account tree--- (the 0-based depth of this account excluding boring parents; or with --flat, 0)-type RenderableAccountName =-  (AccountName-  ,AccountName-  ,Int-  )--instance Show MultiBalanceReport where-    -- use ppShow to break long lists onto multiple lines-    -- we have to add some bogus extra shows here to help ppShow parse the output-    -- and wrap tuples and lists properly-    show (MultiBalanceReport (spans, items, totals)) =-        "MultiBalanceReport (ignore extra quotes):\n" ++ ppShow (show spans, map show items, totals)---- | Select accounts and get their period balance (change of balance) in each--- period, plus misc. display information, for a period balance report.-periodBalanceReport :: ReportOpts -> Query -> Journal -> MultiBalanceReport-periodBalanceReport opts q j = MultiBalanceReport (spans, items, totals)-    where-      (q',depthq)  = (filterQuery (not . queryIsDepth) q, filterQuery queryIsDepth q)-      clip = filter (depthq `matchesAccount`)-      j' = filterJournalPostings q' $ journalSelectingAmountFromOpts opts j-      ps = journalPostings j'--      -- the requested span is the span of the query (which is-      -- based on -b/-e/-p opts and query args IIRC).-      requestedspan = queryDateSpan (date2_ opts) q--      -- the report's span will be the requested span intersected with-      -- the selected data's span; or with -E, the requested span-      -- limited by the journal's overall span.-      reportspan | empty_ opts = requestedspan `orDatesFrom` journalspan-                 | otherwise   = requestedspan `spanIntersect` matchedspan-        where-          journalspan = journalDateSpan j'-          matchedspan = postingsDateSpan ps--      -- first implementation, probably inefficient-      spans               = dbg "1 " $ splitSpan (intervalFromOpts opts) reportspan-      psPerSpan           = dbg "3"  $ [filter (isPostingInDateSpan s) ps | s <- spans]-      acctnames           = dbg "4"  $ sort $ clip $ -                            -- expandAccountNames $ -                            accountNamesFromPostings ps-      allAcctsZeros       = dbg "5"  $ [(a, nullmixedamt) | a <- acctnames]-      someAcctBalsPerSpan = dbg "6"  $ [[(aname a, aibalance a) | a <- drop 1 $ accountsFromPostings ps, depthq `matchesAccount` aname a, aname a `elem` acctnames] | ps <- psPerSpan]-      balsPerSpan         = dbg "7"  $ [sortBy (comparing fst) $ unionBy (\(a,_) (a',_) -> a == a') acctbals allAcctsZeros | acctbals <- someAcctBalsPerSpan]-      balsPerAcct         = dbg "8"  $ transpose balsPerSpan-      acctsAndBals        = dbg "8.5" $ zip acctnames (map (map snd) balsPerAcct)-      items               = dbg "9"  $ [((a, a, accountNameLevel a), bs) | (a,bs) <- acctsAndBals, empty_ opts || any (not . isZeroMixedAmount) bs]-      highestLevelBalsPerSpan =-                            dbg "9.5" $ [[b | (a,b) <- spanbals, not $ any (`elem` acctnames) $ init $ expandAccountName a] | spanbals <- balsPerSpan]-      totals              = dbg "10" $ map sum highestLevelBalsPerSpan------------------------------------------------------------------------------------- | Calculate the overall span and per-period date spans for a report--- based on command-line options, the parsed search query, and the--- journal data. If a reporting interval is specified, the report span--- will be enlarged to include a whole number of report periods.--- Reports will sometimes trim these spans further when appropriate.-reportSpans ::  ReportOpts -> Query -> Journal -> (DateSpan, [DateSpan])-reportSpans opts q j = (reportspan, spans)-  where-    -- get the requested span from the query, which is based on-    -- -b/-e/-p opts and query args.-    requestedspan = queryDateSpan (date2_ opts) q--    -- set the start and end date to the journal's if not specified-    requestedspan' = requestedspan `orDatesFrom` journalDateSpan j--    -- if there's a reporting interval, calculate the report periods-    -- which enclose the requested span-    spans = dbg "spans" $ splitSpan (intervalFromOpts opts) requestedspan'--    -- the overall report span encloses the periods-    reportspan = DateSpan-                 (maybe Nothing spanStart $ headMay spans)-                 (maybe Nothing spanEnd   $ lastMay spans)---- | Select accounts and get their ending balance in each period, plus--- account name display information, for a cumulative or historical balance report.-cumulativeOrHistoricalBalanceReport :: ReportOpts -> Query -> Journal -> MultiBalanceReport-cumulativeOrHistoricalBalanceReport opts q j = MultiBalanceReport (periodbalancespans, items, totals)-    where-      -- select/adjust basic report dates-      (reportspan, _) = reportSpans opts q j--      -- rewrite query to use adjusted dates-      dateless  = filterQuery (not . queryIsDate)-      depthless = filterQuery (not . queryIsDepth)-      q' = dateless $ depthless q-      -- reportq = And [q', Date reportspan]--      -- get starting balances and accounts from preceding txns-      precedingq = And [q', Date $ DateSpan Nothing (spanStart reportspan)]-      (startbalanceitems,_) = balanceReport opts{flat_=True,empty_=True} precedingq j-      startacctbals = dbg "startacctbals"   $ map (\(a,_,_,b) -> (a,b)) startbalanceitems-      -- acctsWithStartingBalance = map fst $ filter (not . isZeroMixedAmount . snd) startacctbals-      startingBalanceFor a | balancetype_ opts == HistoricalBalance = fromMaybe nullmixedamt $ lookup a startacctbals-                           | otherwise = nullmixedamt--      -- get balance changes by period-      MultiBalanceReport (periodbalancespans,periodbalanceitems,_) = dbg "changes" $ periodBalanceReport opts q j-      balanceChangesByAcct = map (\((a,_,_),bs) -> (a,bs)) periodbalanceitems-      acctsWithBalanceChanges = map fst $ filter ((any (not . isZeroMixedAmount)) . snd) balanceChangesByAcct-      balanceChangesFor a = fromMaybe (error $ "no data for account: a") $ -- XXX-                            lookup a balanceChangesByAcct--      -- accounts to report on-      reportaccts -- = dbg' "reportaccts" $ (dbg' "acctsWithStartingBalance" acctsWithStartingBalance) `union` (dbg' "acctsWithBalanceChanges" acctsWithBalanceChanges)-                  = acctsWithBalanceChanges--      -- sum balance changes to get ending balances for each period-      endingBalancesFor a = -          dbg "ending balances" $ drop 1 $ scanl (+) (startingBalanceFor a) $-          dbg "balance changes" $ balanceChangesFor a--      items  = dbg "items"  $ [((a,a,0), endingBalancesFor a) | a <- reportaccts]--      -- sum highest-level account balances in each column for column totals-      totals = dbg "totals" $ map sum highestlevelbalsbycol-          where-            highestlevelbalsbycol = transpose $ map endingBalancesFor highestlevelaccts-            highestlevelaccts =-                dbg "highestlevelaccts" $-                [a | a <- reportaccts, not $ any (`elem` reportaccts) $ init $ expandAccountName a]--      -- enable to debug just this function-      -- dbg :: Show a => String -> a -> a-      -- dbg = lstrace-        ------------------------------------------------------------------------------------ | Get the historical running inclusive balance of a particular account,--- from earliest to latest posting date.--- XXX Accounts should know the Ledger & Journal they came from-accountBalanceHistory :: ReportOpts -> Journal -> Account -> [(Day, MixedAmount)]-accountBalanceHistory ropts j a = [(getdate t, bal) | (t,_,_,_,_,bal) <- items]-  where-    (_,items) = journalTransactionsReport ropts j acctquery-    inclusivebal = True-    acctquery = Acct $ (if inclusivebal then accountNameToAccountRegex else accountNameToAccountOnlyRegex) $ aname a-    getdate = if date2_ ropts then transactionDate2 else tdate------------------------------------------------------------------------------------- TESTS--tests_postingsReport = [-  "postingsReport" ~: do--   -- with the query specified explicitly-   let (query, journal) `gives` n = (length $ snd $ postingsReport defreportopts query journal) `is` n-   (Any, nulljournal) `gives` 0-   (Any, samplejournal) `gives` 11-   -- register --depth just clips account names-   (Depth 2, samplejournal) `gives` 11-   (And [Depth 1, Status True, Acct "expenses"], samplejournal) `gives` 2-   (And [And [Depth 1, Status True], Acct "expenses"], samplejournal) `gives` 2--   -- with query and/or command-line options-   assertEqual "" 11 (length $ snd $ postingsReport defreportopts Any samplejournal)-   assertEqual ""  9 (length $ snd $ postingsReport defreportopts{monthly_=True} Any samplejournal)-   assertEqual "" 19 (length $ snd $ postingsReport defreportopts{monthly_=True} (Empty True) samplejournal)-   assertEqual ""  4 (length $ snd $ postingsReport defreportopts (Acct "assets:bank:checking") samplejournal)--   -- (defreportopts, And [Acct "a a", Acct "'b"], samplejournal2) `gives` 0-   -- [(Just (parsedate "2008-01-01","income"),assets:bank:checking             $1,$1)-   -- ,(Nothing,income:salary                   $-1,0)-   -- ,(Just (2008-06-01,"gift"),assets:bank:checking             $1,$1)-   -- ,(Nothing,income:gifts                    $-1,0)-   -- ,(Just (2008-06-02,"save"),assets:bank:saving               $1,$1)-   -- ,(Nothing,assets:bank:checking            $-1,0)-   -- ,(Just (2008-06-03,"eat & shop"),expenses:food                    $1,$1)-   -- ,(Nothing,expenses:supplies                $1,$2)-   -- ,(Nothing,assets:cash                     $-2,0)-   -- ,(Just (2008-12-31,"pay off"),liabilities:debts                $1,$1)-   -- ,(Nothing,assets:bank:checking            $-1,0)-   -- ]--{--    let opts = defreportopts-    (postingsReportAsText opts $ postingsReport opts (queryFromOpts date1 opts) j) `is` unlines-     ["2008/01/01 income               assets:bank:checking             $1           $1"-     ,"                                income:salary                   $-1            0"-     ,"2008/06/01 gift                 assets:bank:checking             $1           $1"-     ,"                                income:gifts                    $-1            0"-     ,"2008/06/02 save                 assets:bank:saving               $1           $1"-     ,"                                assets:bank:checking            $-1            0"-     ,"2008/06/03 eat & shop           expenses:food                    $1           $1"-     ,"                                expenses:supplies                $1           $2"-     ,"                                assets:cash                     $-2            0"-     ,"2008/12/31 pay off              liabilities:debts                $1           $1"-     ,"                                assets:bank:checking            $-1            0"-     ]--  ,"postings report with cleared option" ~:-   do -    let opts = defreportopts{cleared_=True}-    j <- readJournal' sample_journal_str-    (postingsReportAsText opts $ postingsReport opts (queryFromOpts date1 opts) j) `is` unlines-     ["2008/06/03 eat & shop           expenses:food                    $1           $1"-     ,"                                expenses:supplies                $1           $2"-     ,"                                assets:cash                     $-2            0"-     ,"2008/12/31 pay off              liabilities:debts                $1           $1"-     ,"                                assets:bank:checking            $-1            0"-     ]--  ,"postings report with uncleared option" ~:-   do -    let opts = defreportopts{uncleared_=True}-    j <- readJournal' sample_journal_str-    (postingsReportAsText opts $ postingsReport opts (queryFromOpts date1 opts) j) `is` unlines-     ["2008/01/01 income               assets:bank:checking             $1           $1"-     ,"                                income:salary                   $-1            0"-     ,"2008/06/01 gift                 assets:bank:checking             $1           $1"-     ,"                                income:gifts                    $-1            0"-     ,"2008/06/02 save                 assets:bank:saving               $1           $1"-     ,"                                assets:bank:checking            $-1            0"-     ]--  ,"postings report sorts by date" ~:-   do -    j <- readJournal' $ unlines-        ["2008/02/02 a"-        ,"  b  1"-        ,"  c"-        ,""-        ,"2008/01/01 d"-        ,"  e  1"-        ,"  f"-        ]-    let opts = defreportopts-    registerdates (postingsReportAsText opts $ postingsReport opts (queryFromOpts date1 opts) j) `is` ["2008/01/01","2008/02/02"]--  ,"postings report with account pattern" ~:-   do-    j <- samplejournal-    let opts = defreportopts{patterns_=["cash"]}-    (postingsReportAsText opts $ postingsReport opts (queryFromOpts date1 opts) j) `is` unlines-     ["2008/06/03 eat & shop           assets:cash                     $-2          $-2"-     ]--  ,"postings report with account pattern, case insensitive" ~:-   do -    j <- samplejournal-    let opts = defreportopts{patterns_=["cAsH"]}-    (postingsReportAsText opts $ postingsReport opts (queryFromOpts date1 opts) j) `is` unlines-     ["2008/06/03 eat & shop           assets:cash                     $-2          $-2"-     ]--  ,"postings report with display expression" ~:-   do -    j <- samplejournal-    let gives displayexpr = -            (registerdates (postingsReportAsText opts $ postingsReport opts (queryFromOpts date1 opts) j) `is`)-                where opts = defreportopts{display_=Just displayexpr}-    "d<[2008/6/2]"  `gives` ["2008/01/01","2008/06/01"]-    "d<=[2008/6/2]" `gives` ["2008/01/01","2008/06/01","2008/06/02"]-    "d=[2008/6/2]"  `gives` ["2008/06/02"]-    "d>=[2008/6/2]" `gives` ["2008/06/02","2008/06/03","2008/12/31"]-    "d>[2008/6/2]"  `gives` ["2008/06/03","2008/12/31"]--  ,"postings report with period expression" ~:-   do -    j <- samplejournal-    let periodexpr `gives` dates = do-          j' <- samplejournal-          registerdates (postingsReportAsText opts $ postingsReport opts (queryFromOpts date1 opts) j') `is` dates-              where opts = defreportopts{period_=maybePeriod date1 periodexpr}-    ""     `gives` ["2008/01/01","2008/06/01","2008/06/02","2008/06/03","2008/12/31"]-    "2008" `gives` ["2008/01/01","2008/06/01","2008/06/02","2008/06/03","2008/12/31"]-    "2007" `gives` []-    "june" `gives` ["2008/06/01","2008/06/02","2008/06/03"]-    "monthly" `gives` ["2008/01/01","2008/06/01","2008/12/01"]-    "quarterly" `gives` ["2008/01/01","2008/04/01","2008/10/01"]-    let opts = defreportopts{period_=maybePeriod date1 "yearly"}-    (postingsReportAsText opts $ postingsReport opts (queryFromOpts date1 opts) j) `is` unlines-     ["2008/01/01 - 2008/12/31         assets:bank:saving               $1           $1"-     ,"                                assets:cash                     $-2          $-1"-     ,"                                expenses:food                    $1            0"-     ,"                                expenses:supplies                $1           $1"-     ,"                                income:gifts                    $-1            0"-     ,"                                income:salary                   $-1          $-1"-     ,"                                liabilities:debts                $1            0"-     ]-    let opts = defreportopts{period_=maybePeriod date1 "quarterly"}-    registerdates (postingsReportAsText opts $ postingsReport opts (queryFromOpts date1 opts) j) `is` ["2008/01/01","2008/04/01","2008/10/01"]-    let opts = defreportopts{period_=maybePeriod date1 "quarterly",empty_=True}-    registerdates (postingsReportAsText opts $ postingsReport opts (queryFromOpts date1 opts) j) `is` ["2008/01/01","2008/04/01","2008/07/01","2008/10/01"]--  ]--  , "postings report with depth arg" ~:-   do -    j <- samplejournal-    let opts = defreportopts{depth_=Just 2}-    (postingsReportAsText opts $ postingsReport opts (queryFromOpts date1 opts) j) `is` unlines-     ["2008/01/01 income               assets:bank                      $1           $1"-     ,"                                income:salary                   $-1            0"-     ,"2008/06/01 gift                 assets:bank                      $1           $1"-     ,"                                income:gifts                    $-1            0"-     ,"2008/06/02 save                 assets:bank                      $1           $1"-     ,"                                assets:bank                     $-1            0"-     ,"2008/06/03 eat & shop           expenses:food                    $1           $1"-     ,"                                expenses:supplies                $1           $2"-     ,"                                assets:cash                     $-2            0"-     ,"2008/12/31 pay off              liabilities:debts                $1           $1"-     ,"                                assets:bank                     $-1            0"-     ]---}- ]--tests_balanceReport =-  let (opts,journal) `gives` r = do-         let (eitems, etotal) = r-             (aitems, atotal) = balanceReport opts (queryFromOpts nulldate opts) journal-         assertEqual "items" eitems aitems-         -- assertEqual "" (length eitems) (length aitems)-         -- mapM (\(e,a) -> assertEqual "" e a) $ zip eitems aitems-         assertEqual "total" etotal atotal-  in [--   "balanceReport with no args on null journal" ~: do-   (defreportopts, nulljournal) `gives` ([], Mixed [nullamt])--  ,"balanceReport with no args on sample journal" ~: do-   (defreportopts, samplejournal) `gives`-    ([-      ("assets","assets",0, mamountp' "$-1.00")-     ,("assets:bank:saving","bank:saving",1, mamountp' "$1.00")-     ,("assets:cash","cash",1, mamountp' "$-2.00")-     ,("expenses","expenses",0, mamountp' "$2.00")-     ,("expenses:food","food",1, mamountp' "$1.00")-     ,("expenses:supplies","supplies",1, mamountp' "$1.00")-     ,("income","income",0, mamountp' "$-2.00")-     ,("income:gifts","gifts",1, mamountp' "$-1.00")-     ,("income:salary","salary",1, mamountp' "$-1.00")-     ,("liabilities:debts","liabilities:debts",0, mamountp' "$1.00")-     ],-     Mixed [nullamt])--  ,"balanceReport with --depth=N" ~: do-   (defreportopts{depth_=Just 1}, samplejournal) `gives`-    ([-      ("assets",      "assets",      0, mamountp' "$-1.00")-     ,("expenses",    "expenses",    0, mamountp'  "$2.00")-     ,("income",      "income",      0, mamountp' "$-2.00")-     ,("liabilities", "liabilities", 0, mamountp'  "$1.00")-     ],-     Mixed [nullamt])--  ,"balanceReport with depth:N" ~: do-   (defreportopts{query_="depth:1"}, samplejournal) `gives`-    ([-      ("assets",      "assets",      0, mamountp' "$-1.00")-     ,("expenses",    "expenses",    0, mamountp'  "$2.00")-     ,("income",      "income",      0, mamountp' "$-2.00")-     ,("liabilities", "liabilities", 0, mamountp'  "$1.00")-     ],-     Mixed [nullamt])--  ,"balanceReport with a date or secondary date span" ~: do-   (defreportopts{query_="date:'in 2009'"}, samplejournal2) `gives`-    ([],-     Mixed [nullamt])-   (defreportopts{query_="edate:'in 2009'"}, samplejournal2) `gives`-    ([-      ("assets:bank:checking","assets:bank:checking",0,mamountp' "$1.00")-     ,("income:salary","income:salary",0,mamountp' "$-1.00")-     ],-     Mixed [nullamt])--  ,"balanceReport with desc:" ~: do-   (defreportopts{query_="desc:income"}, samplejournal) `gives`-    ([-      ("assets:bank:checking","assets:bank:checking",0,mamountp' "$1.00")-     ,("income:salary","income:salary",0, mamountp' "$-1.00")-     ],-     Mixed [nullamt])--  ,"balanceReport with not:desc:" ~: do-   (defreportopts{query_="not:desc:income"}, samplejournal) `gives`-    ([-      ("assets","assets",0, mamountp' "$-2.00")-     ,("assets:bank","bank",1, Mixed [nullamt])-     ,("assets:bank:checking","checking",2,mamountp' "$-1.00")-     ,("assets:bank:saving","saving",2, mamountp' "$1.00")-     ,("assets:cash","cash",1, mamountp' "$-2.00")-     ,("expenses","expenses",0, mamountp' "$2.00")-     ,("expenses:food","food",1, mamountp' "$1.00")-     ,("expenses:supplies","supplies",1, mamountp' "$1.00")-     ,("income:gifts","income:gifts",0, mamountp' "$-1.00")-     ,("liabilities:debts","liabilities:debts",0, mamountp' "$1.00")-     ],-     Mixed [nullamt])---{--    ,"accounts report with account pattern o" ~:-     defreportopts{patterns_=["o"]} `gives`-     ["                  $1  expenses:food"-     ,"                 $-2  income"-     ,"                 $-1    gifts"-     ,"                 $-1    salary"-     ,"--------------------"-     ,"                 $-1"-     ]--    ,"accounts report with account pattern o and --depth 1" ~:-     defreportopts{patterns_=["o"],depth_=Just 1} `gives`-     ["                  $1  expenses"-     ,"                 $-2  income"-     ,"--------------------"-     ,"                 $-1"-     ]--    ,"accounts report with account pattern a" ~:-     defreportopts{patterns_=["a"]} `gives`-     ["                 $-1  assets"-     ,"                  $1    bank:saving"-     ,"                 $-2    cash"-     ,"                 $-1  income:salary"-     ,"                  $1  liabilities:debts"-     ,"--------------------"-     ,"                 $-1"-     ]--    ,"accounts report with account pattern e" ~:-     defreportopts{patterns_=["e"]} `gives`-     ["                 $-1  assets"-     ,"                  $1    bank:saving"-     ,"                 $-2    cash"-     ,"                  $2  expenses"-     ,"                  $1    food"-     ,"                  $1    supplies"-     ,"                 $-2  income"-     ,"                 $-1    gifts"-     ,"                 $-1    salary"-     ,"                  $1  liabilities:debts"-     ,"--------------------"-     ,"                   0"-     ]--    ,"accounts report with unmatched parent of two matched subaccounts" ~: -     defreportopts{patterns_=["cash","saving"]} `gives`-     ["                 $-1  assets"-     ,"                  $1    bank:saving"-     ,"                 $-2    cash"-     ,"--------------------"-     ,"                 $-1"-     ]--    ,"accounts report with multi-part account name" ~: -     defreportopts{patterns_=["expenses:food"]} `gives`-     ["                  $1  expenses:food"-     ,"--------------------"-     ,"                  $1"-     ]--    ,"accounts report with negative account pattern" ~:-     defreportopts{patterns_=["not:assets"]} `gives`-     ["                  $2  expenses"-     ,"                  $1    food"-     ,"                  $1    supplies"-     ,"                 $-2  income"-     ,"                 $-1    gifts"-     ,"                 $-1    salary"-     ,"                  $1  liabilities:debts"-     ,"--------------------"-     ,"                  $1"-     ]--    ,"accounts report negative account pattern always matches full name" ~: -     defreportopts{patterns_=["not:e"]} `gives`-     ["--------------------"-     ,"                   0"-     ]--    ,"accounts report negative patterns affect totals" ~: -     defreportopts{patterns_=["expenses","not:food"]} `gives`-     ["                  $1  expenses:supplies"-     ,"--------------------"-     ,"                  $1"-     ]--    ,"accounts report with -E shows zero-balance accounts" ~:-     defreportopts{patterns_=["assets"],empty_=True} `gives`-     ["                 $-1  assets"-     ,"                  $1    bank"-     ,"                   0      checking"-     ,"                  $1      saving"-     ,"                 $-2    cash"-     ,"--------------------"-     ,"                 $-1"-     ]--    ,"accounts report with cost basis" ~: do-       j <- (readJournal Nothing Nothing Nothing $ unlines-              [""-              ,"2008/1/1 test           "-              ,"  a:b          10h @ $50"-              ,"  c:d                   "-              ]) >>= either error' return-       let j' = journalCanonicaliseAmounts $ journalConvertAmountsToCost j -- enable cost basis adjustment-       balanceReportAsText defreportopts (balanceReport defreportopts Any j') `is`-         ["                $500  a:b"-         ,"               $-500  c:d"-         ,"--------------------"-         ,"                   0"-         ]--}- ]--Right samplejournal2 = journalBalanceTransactions $ -         nulljournal-         {jtxns = [-           txnTieKnot $ Transaction {-             tdate=parsedate "2008/01/01",-             tdate2=Just $ parsedate "2009/01/01",-             tstatus=False,-             tcode="",-             tdescription="income",-             tcomment="",-             ttags=[],-             tpostings=-                 [posting {paccount="assets:bank:checking", pamount=Mixed [usd 1]}-                 ,posting {paccount="income:salary", pamount=missingmixedamt}-                 ],-             tpreceding_comment_lines=""-           }-          ]-         }-         --- tests_isInterestingIndented = [---   "isInterestingIndented" ~: do ---    let (opts, journal, acctname) `gives` r = isInterestingIndented opts l acctname `is` r---           where l = ledgerFromJournal (queryFromOpts nulldate opts) journal-     ---    (defreportopts, samplejournal, "expenses") `gives` True---  ]--tests_Hledger_Reports :: Test-tests_Hledger_Reports = TestList $-    tests_queryFromOpts- ++ tests_queryOptsFromOpts- ++ tests_entriesReport- ++ tests_summarisePostingsByInterval- ++ tests_postingsReport- -- ++ tests_isInterestingIndented- ++ tests_balanceReport- ++ [-  -- ,"summarisePostingsInDateSpan" ~: do-  --   let gives (b,e,depth,showempty,ps) =-  --           (summarisePostingsInDateSpan (mkdatespan b e) depth showempty ps `is`)-  --   let ps =-  --           [-  --            nullposting{lpdescription="desc",lpaccount="expenses:food:groceries",lpamount=Mixed [usd 1]}-  --           ,nullposting{lpdescription="desc",lpaccount="expenses:food:dining",   lpamount=Mixed [usd 2]}-  --           ,nullposting{lpdescription="desc",lpaccount="expenses:food",          lpamount=Mixed [usd 4]}-  --           ,nullposting{lpdescription="desc",lpaccount="expenses:food:dining",   lpamount=Mixed [usd 8]}-  --           ]-  --   ("2008/01/01","2009/01/01",0,9999,False,[]) `gives`-  --    []-  --   ("2008/01/01","2009/01/01",0,9999,True,[]) `gives`-  --    [-  --     nullposting{lpdate=parsedate "2008/01/01",lpdescription="- 2008/12/31"}-  --    ]-  --   ("2008/01/01","2009/01/01",0,9999,False,ts) `gives`-  --    [-  --     nullposting{lpdate=parsedate "2008/01/01",lpdescription="- 2008/12/31",lpaccount="expenses:food",          lpamount=Mixed [usd 4]}-  --    ,nullposting{lpdate=parsedate "2008/01/01",lpdescription="- 2008/12/31",lpaccount="expenses:food:dining",   lpamount=Mixed [usd 10]}-  --    ,nullposting{lpdate=parsedate "2008/01/01",lpdescription="- 2008/12/31",lpaccount="expenses:food:groceries",lpamount=Mixed [usd 1]}-  --    ]-  --   ("2008/01/01","2009/01/01",0,2,False,ts) `gives`-  --    [-  --     nullposting{lpdate=parsedate "2008/01/01",lpdescription="- 2008/12/31",lpaccount="expenses:food",lpamount=Mixed [usd 15]}-  --    ]-  --   ("2008/01/01","2009/01/01",0,1,False,ts) `gives`-  --    [-  --     nullposting{lpdate=parsedate "2008/01/01",lpdescription="- 2008/12/31",lpaccount="expenses",lpamount=Mixed [usd 15]}-  --    ]-  --   ("2008/01/01","2009/01/01",0,0,False,ts) `gives`-  --    [-  --     nullposting{lpdate=parsedate "2008/01/01",lpdescription="- 2008/12/31",lpaccount="",lpamount=Mixed [usd 15]}-  --    ]-+  module Hledger.Reports.ReportOptions,+  module Hledger.Reports.EntriesReport,+  module Hledger.Reports.PostingsReport,+  module Hledger.Reports.TransactionsReports,+  module Hledger.Reports.BalanceReport,+  module Hledger.Reports.MultiBalanceReports,+  module Hledger.Reports.BalanceHistoryReport,++  -- * Tests+  tests_Hledger_Reports+)+where++import Test.HUnit++import Hledger.Reports.ReportOptions+import Hledger.Reports.EntriesReport+import Hledger.Reports.PostingsReport+import Hledger.Reports.TransactionsReports+import Hledger.Reports.BalanceReport+import Hledger.Reports.MultiBalanceReports+import Hledger.Reports.BalanceHistoryReport++tests_Hledger_Reports :: Test+tests_Hledger_Reports = TestList $+ -- ++ tests_isInterestingIndented+ [+ tests_Hledger_Reports_ReportOptions,+ tests_Hledger_Reports_EntriesReport,+ tests_Hledger_Reports_PostingsReport,+ tests_Hledger_Reports_BalanceReport  ]

@@ -0,0 +1,34 @@+{-# LANGUAGE RecordWildCards, DeriveDataTypeable, FlexibleInstances #-}+{-|++Account balance history report.++-}++module Hledger.Reports.BalanceHistoryReport (+  accountBalanceHistory++  -- -- * Tests+  -- tests_Hledger_Reports_BalanceReport+)+where++import Data.Time.Calendar+-- import Test.HUnit++import Hledger.Data+import Hledger.Query+import Hledger.Reports.ReportOptions+import Hledger.Reports.TransactionsReports+++-- | Get the historical running inclusive balance of a particular account,+-- from earliest to latest posting date.+accountBalanceHistory :: ReportOpts -> Journal -> Account -> [(Day, MixedAmount)]+accountBalanceHistory ropts j a = [(getdate t, bal) | (t,_,_,_,_,bal) <- items]+  where+    (_,items) = journalTransactionsReport ropts j acctquery+    inclusivebal = True+    acctquery = Acct $ (if inclusivebal then accountNameToAccountRegex else accountNameToAccountOnlyRegex) $ aname a+    getdate = if date2_ ropts then transactionDate2 else tdate+

@@ -0,0 +1,349 @@+{-# LANGUAGE RecordWildCards, DeriveDataTypeable, FlexibleInstances, ScopedTypeVariables #-}+{-|++Balance report, used by the balance command.++-}++module Hledger.Reports.BalanceReport (+  BalanceReport,+  BalanceReportItem,+  RenderableAccountName,+  balanceReport,+  flatShowsExclusiveBalance,++  -- * Tests+  tests_Hledger_Reports_BalanceReport+)+where++import Data.Maybe+import Test.HUnit++import Hledger.Data+import Hledger.Read (mamountp')+import Hledger.Query+import Hledger.Utils+import Hledger.Reports.ReportOptions+++-- | A simple single-column balance report. It has:+--+-- 1. a list of rows, each containing a renderable account name and a corresponding amount+--+-- 2. the final total of the amounts+type BalanceReport = ([BalanceReportItem], MixedAmount)+type BalanceReportItem = (RenderableAccountName, MixedAmount)++-- | A renderable account name includes some additional hints for rendering accounts in a balance report.+-- It has:+--+-- * The full account name+-- +-- * The ledger-style short elided account name (the leaf name, prefixed by any boring parents immediately above)+-- +-- * The number of indentation steps to use when rendering a ledger-style account tree+--   (normally the 0-based depth of this account excluding boring parents, or 0 with --flat).+type RenderableAccountName = (AccountName, AccountName, Int)++-- | When true (the default), this makes balance --flat reports and their implementation clearer.+-- Single/multi-col balance reports currently aren't all correct if this is false.+flatShowsExclusiveBalance    = True++-- | Enabling this makes balance --flat --empty also show parent accounts without postings,+-- in addition to those with postings and a zero balance. Disabling it shows only the latter.+-- No longer supported, but leave this here for a bit.+-- flatShowsPostinglessAccounts = True++-- | Generate a simple balance report, containing the matched accounts and+-- their balances (change of balance) during the specified period.+-- This is like periodBalanceReport with a single column (but more mature,+-- eg this can do hierarchical display).+balanceReport :: ReportOpts -> Query -> Journal -> BalanceReport+balanceReport opts q j = (items, total)+    where+      -- dbg = const id -- exclude from debug output+      dbg s = let p = "balanceReport" in Hledger.Utils.dbg (p++" "++s)  -- add prefix in debug output++      accts = ledgerRootAccount $ ledgerFromJournal q $ journalSelectingAmountFromOpts opts j+      accts' :: [Account]+          | flat_ opts = dbg "accts" $ +                         filterzeros $+                         filterempty $+                         drop 1 $ clipAccountsAndAggregate (queryDepth q) $ flattenAccounts accts+          | otherwise  = dbg "accts" $ +                         filter (not.aboring) $+                         drop 1 $ flattenAccounts $+                         markboring $ +                         prunezeros $ clipAccounts (queryDepth q) accts+          where+            balance     = if flat_ opts then aebalance else aibalance+            filterzeros = if empty_ opts then id else filter (not . isZeroMixedAmount . balance)+            filterempty = filter (\a -> anumpostings a > 0 || not (isZeroMixedAmount (balance a)))+            prunezeros  = if empty_ opts then id else fromMaybe nullacct . pruneAccounts (isZeroMixedAmount . balance)+            markboring  = if no_elide_ opts then id else markBoringParentAccounts+      items = dbg "items" $ map (balanceReportItem opts q) accts'+      total | not (flat_ opts) = dbg "total" $ sum [amt | ((_,_,indent),amt) <- items, indent == 0]+            | otherwise        = dbg "total" $+                                 if flatShowsExclusiveBalance+                                 then sum $ map snd items+                                 else sum $ map aebalance $ clipAccountsAndAggregate 1 accts'++-- | In an account tree with zero-balance leaves removed, mark the+-- elidable parent accounts (those with one subaccount and no balance+-- of their own).+markBoringParentAccounts :: Account -> Account+markBoringParentAccounts = tieAccountParents . mapAccounts mark+  where+    mark a | length (asubs a) == 1 && isZeroMixedAmount (aebalance a) = a{aboring=True}+           | otherwise = a++balanceReportItem :: ReportOpts -> Query -> Account -> BalanceReportItem+balanceReportItem opts _ a@Account{aname=name}+  | flat_ opts = ((name, name,       0),      (if flatShowsExclusiveBalance then aebalance else aibalance) a)+  | otherwise  = ((name, elidedname, indent), aibalance a)+  where+    elidedname = accountNameFromComponents (adjacentboringparentnames ++ [accountLeafName name])+    adjacentboringparentnames = reverse $ map (accountLeafName.aname) $ takeWhile aboring $ parents+    indent = length $ filter (not.aboring) parents+    parents = init $ parentAccounts a++-- -- the above using the newer multi balance report code:+-- balanceReport' opts q j = (items, total)+--   where+--     MultiBalanceReport (_,mbrrows,mbrtotals) = periodBalanceReport opts q j+--     items = [(a,a',n, headDef 0 bs) | ((a,a',n), bs) <- mbrrows]+--     total = headDef 0 mbrtotals++tests_balanceReport =+  let (opts,journal) `gives` r = do+         let (eitems, etotal) = r+             (aitems, atotal) = balanceReport opts (queryFromOpts nulldate opts) journal+         assertEqual "items" eitems aitems+         -- assertEqual "" (length eitems) (length aitems)+         -- mapM (\(e,a) -> assertEqual "" e a) $ zip eitems aitems+         assertEqual "total" etotal atotal+  in [++   "balanceReport with no args on null journal" ~: do+   (defreportopts, nulljournal) `gives` ([], Mixed [nullamt])++  ,"balanceReport with no args on sample journal" ~: do+   (defreportopts, samplejournal) `gives`+    ([+      (("assets","assets",0), mamountp' "$-1.00")+     ,(("assets:bank:saving","bank:saving",1), mamountp' "$1.00")+     ,(("assets:cash","cash",1), mamountp' "$-2.00")+     ,(("expenses","expenses",0), mamountp' "$2.00")+     ,(("expenses:food","food",1), mamountp' "$1.00")+     ,(("expenses:supplies","supplies",1), mamountp' "$1.00")+     ,(("income","income",0), mamountp' "$-2.00")+     ,(("income:gifts","gifts",1), mamountp' "$-1.00")+     ,(("income:salary","salary",1), mamountp' "$-1.00")+     ,(("liabilities:debts","liabilities:debts",0), mamountp' "$1.00")+     ],+     Mixed [nullamt])++  ,"balanceReport with --depth=N" ~: do+   (defreportopts{depth_=Just 1}, samplejournal) `gives`+    ([+      (("assets",      "assets",      0), mamountp' "$-1.00")+     ,(("expenses",    "expenses",    0), mamountp'  "$2.00")+     ,(("income",      "income",      0), mamountp' "$-2.00")+     ,(("liabilities", "liabilities", 0), mamountp'  "$1.00")+     ],+     Mixed [nullamt])++  ,"balanceReport with depth:N" ~: do+   (defreportopts{query_="depth:1"}, samplejournal) `gives`+    ([+      (("assets",      "assets",      0), mamountp' "$-1.00")+     ,(("expenses",    "expenses",    0), mamountp'  "$2.00")+     ,(("income",      "income",      0), mamountp' "$-2.00")+     ,(("liabilities", "liabilities", 0), mamountp'  "$1.00")+     ],+     Mixed [nullamt])++  ,"balanceReport with a date or secondary date span" ~: do+   (defreportopts{query_="date:'in 2009'"}, samplejournal2) `gives`+    ([],+     Mixed [nullamt])+   (defreportopts{query_="edate:'in 2009'"}, samplejournal2) `gives`+    ([+      (("assets:bank:checking","assets:bank:checking",0),mamountp' "$1.00")+     ,(("income:salary","income:salary",0),mamountp' "$-1.00")+     ],+     Mixed [nullamt])++  ,"balanceReport with desc:" ~: do+   (defreportopts{query_="desc:income"}, samplejournal) `gives`+    ([+      (("assets:bank:checking","assets:bank:checking",0),mamountp' "$1.00")+     ,(("income:salary","income:salary",0), mamountp' "$-1.00")+     ],+     Mixed [nullamt])++  ,"balanceReport with not:desc:" ~: do+   (defreportopts{query_="not:desc:income"}, samplejournal) `gives`+    ([+      (("assets","assets",0), mamountp' "$-2.00")+     ,(("assets:bank","bank",1), Mixed [nullamt])+     ,(("assets:bank:checking","checking",2),mamountp' "$-1.00")+     ,(("assets:bank:saving","saving",2), mamountp' "$1.00")+     ,(("assets:cash","cash",1), mamountp' "$-2.00")+     ,(("expenses","expenses",0), mamountp' "$2.00")+     ,(("expenses:food","food",1), mamountp' "$1.00")+     ,(("expenses:supplies","supplies",1), mamountp' "$1.00")+     ,(("income:gifts","income:gifts",0), mamountp' "$-1.00")+     ,(("liabilities:debts","liabilities:debts",0), mamountp' "$1.00")+     ],+     Mixed [nullamt])+++{-+    ,"accounts report with account pattern o" ~:+     defreportopts{patterns_=["o"]} `gives`+     ["                  $1  expenses:food"+     ,"                 $-2  income"+     ,"                 $-1    gifts"+     ,"                 $-1    salary"+     ,"--------------------"+     ,"                 $-1"+     ]++    ,"accounts report with account pattern o and --depth 1" ~:+     defreportopts{patterns_=["o"],depth_=Just 1} `gives`+     ["                  $1  expenses"+     ,"                 $-2  income"+     ,"--------------------"+     ,"                 $-1"+     ]++    ,"accounts report with account pattern a" ~:+     defreportopts{patterns_=["a"]} `gives`+     ["                 $-1  assets"+     ,"                  $1    bank:saving"+     ,"                 $-2    cash"+     ,"                 $-1  income:salary"+     ,"                  $1  liabilities:debts"+     ,"--------------------"+     ,"                 $-1"+     ]++    ,"accounts report with account pattern e" ~:+     defreportopts{patterns_=["e"]} `gives`+     ["                 $-1  assets"+     ,"                  $1    bank:saving"+     ,"                 $-2    cash"+     ,"                  $2  expenses"+     ,"                  $1    food"+     ,"                  $1    supplies"+     ,"                 $-2  income"+     ,"                 $-1    gifts"+     ,"                 $-1    salary"+     ,"                  $1  liabilities:debts"+     ,"--------------------"+     ,"                   0"+     ]++    ,"accounts report with unmatched parent of two matched subaccounts" ~: +     defreportopts{patterns_=["cash","saving"]} `gives`+     ["                 $-1  assets"+     ,"                  $1    bank:saving"+     ,"                 $-2    cash"+     ,"--------------------"+     ,"                 $-1"+     ]++    ,"accounts report with multi-part account name" ~: +     defreportopts{patterns_=["expenses:food"]} `gives`+     ["                  $1  expenses:food"+     ,"--------------------"+     ,"                  $1"+     ]++    ,"accounts report with negative account pattern" ~:+     defreportopts{patterns_=["not:assets"]} `gives`+     ["                  $2  expenses"+     ,"                  $1    food"+     ,"                  $1    supplies"+     ,"                 $-2  income"+     ,"                 $-1    gifts"+     ,"                 $-1    salary"+     ,"                  $1  liabilities:debts"+     ,"--------------------"+     ,"                  $1"+     ]++    ,"accounts report negative account pattern always matches full name" ~: +     defreportopts{patterns_=["not:e"]} `gives`+     ["--------------------"+     ,"                   0"+     ]++    ,"accounts report negative patterns affect totals" ~: +     defreportopts{patterns_=["expenses","not:food"]} `gives`+     ["                  $1  expenses:supplies"+     ,"--------------------"+     ,"                  $1"+     ]++    ,"accounts report with -E shows zero-balance accounts" ~:+     defreportopts{patterns_=["assets"],empty_=True} `gives`+     ["                 $-1  assets"+     ,"                  $1    bank"+     ,"                   0      checking"+     ,"                  $1      saving"+     ,"                 $-2    cash"+     ,"--------------------"+     ,"                 $-1"+     ]++    ,"accounts report with cost basis" ~: do+       j <- (readJournal Nothing Nothing Nothing $ unlines+              [""+              ,"2008/1/1 test           "+              ,"  a:b          10h @ $50"+              ,"  c:d                   "+              ]) >>= either error' return+       let j' = journalCanonicaliseAmounts $ journalConvertAmountsToCost j -- enable cost basis adjustment+       balanceReportAsText defreportopts (balanceReport defreportopts Any j') `is`+         ["                $500  a:b"+         ,"               $-500  c:d"+         ,"--------------------"+         ,"                   0"+         ]+-}+ ]++Right samplejournal2 = journalBalanceTransactions $ +         nulljournal+         {jtxns = [+           txnTieKnot $ Transaction {+             tdate=parsedate "2008/01/01",+             tdate2=Just $ parsedate "2009/01/01",+             tstatus=False,+             tcode="",+             tdescription="income",+             tcomment="",+             ttags=[],+             tpostings=+                 [posting {paccount="assets:bank:checking", pamount=Mixed [usd 1]}+                 ,posting {paccount="income:salary", pamount=missingmixedamt}+                 ],+             tpreceding_comment_lines=""+           }+          ]+         }+         +-- tests_isInterestingIndented = [+--   "isInterestingIndented" ~: do +--    let (opts, journal, acctname) `gives` r = isInterestingIndented opts l acctname `is` r+--           where l = ledgerFromJournal (queryFromOpts nulldate opts) journal+     +--    (defreportopts, samplejournal, "expenses") `gives` True+--  ]++tests_Hledger_Reports_BalanceReport :: Test+tests_Hledger_Reports_BalanceReport = TestList $+    tests_balanceReport

@@ -0,0 +1,51 @@+{-# LANGUAGE RecordWildCards, DeriveDataTypeable, FlexibleInstances #-}+{-|++Journal entries report, used by the print command.++-}++module Hledger.Reports.EntriesReport (+  EntriesReport,+  EntriesReportItem,+  entriesReport,+  -- * Tests+  tests_Hledger_Reports_EntriesReport+)+where++import Data.List+import Data.Ord+import Test.HUnit++import Hledger.Data+import Hledger.Query+import Hledger.Reports.ReportOptions+++-- | A journal entries report is a list of whole transactions as+-- originally entered in the journal (mostly). This is used by eg+-- hledger's print command and hledger-web's journal entries view.+type EntriesReport = [EntriesReportItem]+type EntriesReportItem = Transaction++-- | Select transactions for an entries report.+entriesReport :: ReportOpts -> Query -> Journal -> EntriesReport+entriesReport opts q j =+  sortBy (comparing date) $ filter (q `matchesTransaction`) ts+    where+      date = transactionDateFn opts+      ts = jtxns $ journalSelectingAmountFromOpts opts j++tests_entriesReport :: [Test]+tests_entriesReport = [+  "entriesReport" ~: do+    assertEqual "not acct" 1 (length $ entriesReport defreportopts (Not $ Acct "bank") samplejournal)+    let sp = mkdatespan "2008/06/01" "2008/07/01"+    assertEqual "date" 3 (length $ entriesReport defreportopts (Date sp) samplejournal)+ ]++tests_Hledger_Reports_EntriesReport :: Test+tests_Hledger_Reports_EntriesReport = TestList $+ tests_entriesReport+

@@ -0,0 +1,167 @@+{-# LANGUAGE RecordWildCards, DeriveDataTypeable, FlexibleInstances, ScopedTypeVariables #-}+{-|++Multi-column balance reports, used by the balance command.++-}++module Hledger.Reports.MultiBalanceReports (+  MultiBalanceReport(..),+  MultiBalanceReportRow,+  multiBalanceReport++  -- -- * Tests+  -- tests_Hledger_Reports_MultiBalanceReport+)+where++import Data.List+import Data.Maybe+import Data.Ord+import Safe+-- import Test.HUnit++import Hledger.Data+import Hledger.Query+import Hledger.Utils+import Hledger.Reports.ReportOptions+import Hledger.Reports.BalanceReport+++-- | A multi balance report is a balance report with one or more columns. It has:+--+-- 1. a list of each column's date span+--+-- 2. a list of rows, each containing a renderable account name and the amounts to show in each column+--+-- 3. a list of each column's final total+--+-- The meaning of the amounts depends on the type of multi balance+-- report, of which there are three: periodic, cumulative and historical+-- (see 'BalanceType' and "Hledger.Cli.Balance").+newtype MultiBalanceReport = MultiBalanceReport ([DateSpan]+                                                ,[MultiBalanceReportRow]+                                                ,[MixedAmount]+                                                )++-- | A row in a multi balance report has+--+-- * An account name, with rendering hints+--+-- * A list of amounts to be shown in each of the report's columns.+type MultiBalanceReportRow = (RenderableAccountName, [MixedAmount])++instance Show MultiBalanceReport where+    -- use ppShow to break long lists onto multiple lines+    -- we add some bogus extra shows here to help ppShow parse the output+    -- and wrap tuples and lists properly+    show (MultiBalanceReport (spans, items, totals)) =+        "MultiBalanceReport (ignore extra quotes):\n" ++ ppShow (show spans, map show items, totals)++-- type alias just to remind us which AccountNames might be depth-clipped, below.+type ClippedAccountName = AccountName++-- | Generate a multicolumn balance report for the matched accounts,+-- showing the change of balance, accumulated balance, or historical balance+-- in each of the specified periods.+multiBalanceReport :: ReportOpts -> Query -> Journal -> MultiBalanceReport+multiBalanceReport opts q j = MultiBalanceReport (displayspans, items, totals)+    where+      symq       = dbg "symq"   $ filterQuery queryIsSym $ dbg "requested q" q+      depthq     = dbg "depthq" $ filterQuery queryIsDepth q+      depth      = queryDepth depthq+      depthless  = dbg "depthless" . filterQuery (not . queryIsDepth)+      datelessq  = dbg "datelessq"  $ filterQuery (not . queryIsDate) q+      dateqcons  = if date2_ opts then Date2 else Date+      precedingq = dbg "precedingq" $ And [datelessq, dateqcons $ DateSpan Nothing (spanStart reportspan)]+      requestedspan  = dbg "requestedspan"  $ queryDateSpan (date2_ opts) q                              -- span specified by -b/-e/-p options and query args+      requestedspan' = dbg "requestedspan'" $ requestedspan `spanDefaultsFrom` journalDateSpan (date2_ opts) j  -- if open-ended, close it using the journal's end dates+      intervalspans  = dbg "intervalspans"  $ splitSpan (intervalFromOpts opts) requestedspan'           -- interval spans enclosing it+      reportspan     = dbg "reportspan"     $ DateSpan (maybe Nothing spanStart $ headMay intervalspans) -- the requested span enlarged to a whole number of intervals+                                                       (maybe Nothing spanEnd   $ lastMay intervalspans)+      newdatesq = dbg "newdateq" $ dateqcons reportspan+      reportq  = dbg "reportq" $ depthless $ And [datelessq, newdatesq] -- user's query enlarged to whole intervals and with no depth limit++      ps :: [Posting] =+          dbg "ps" $+          journalPostings $+          filterJournalPostingAmounts symq $     -- remove amount parts excluded by cur:+          filterJournalPostings reportq $        -- remove postings not matched by (adjusted) query+          journalSelectingAmountFromOpts opts j++      displayspans = dbg "displayspans" $ splitSpan (intervalFromOpts opts) displayspan+        where+          displayspan+            | empty_ opts = dbg "displayspan (-E)" $ reportspan                                -- all the requested intervals+            | otherwise   = dbg "displayspan"      $ requestedspan `spanIntersect` matchedspan -- exclude leading/trailing empty intervals+          matchedspan = dbg "matchedspan" $ postingsDateSpan' (whichDateFromOpts opts) ps++      psPerSpan :: [[Posting]] =+          dbg "psPerSpan" $+          [filter (isPostingInDateSpan' (whichDateFromOpts opts) s) ps | s <- displayspans]++      postedAcctBalChangesPerSpan :: [[(ClippedAccountName, MixedAmount)]] =+          dbg "postedAcctBalChangesPerSpan" $+          map postingAcctBals psPerSpan+          where+            postingAcctBals :: [Posting] -> [(ClippedAccountName, MixedAmount)]+            postingAcctBals ps = [(aname a, (if tree_ opts then aibalance else aebalance) a) | a <- as]+                where+                  as = depthLimit $ +                       (if tree_ opts then id else filter ((>0).anumpostings)) $+                       drop 1 $ accountsFromPostings ps+                  depthLimit+                      | tree_ opts = filter ((depthq `matchesAccount`).aname) -- exclude deeper balances+                      | otherwise  = clipAccountsAndAggregate depth -- aggregate deeper balances at the depth limit++      postedAccts :: [AccountName] =+          dbg "postedAccts" $+          sort $ accountNamesFromPostings ps++      displayedAccts :: [ClippedAccountName] =+          dbg "displayedAccts" $+          (if tree_ opts then expandAccountNames else id) $+          nub $ map (clipAccountName depth) postedAccts++      acctBalChangesPerSpan :: [[(ClippedAccountName, MixedAmount)]] =+          dbg "acctBalChangesPerSpan" $+          [sortBy (comparing fst) $ unionBy (\(a,_) (a',_) -> a == a') postedacctbals zeroes+           | postedacctbals <- postedAcctBalChangesPerSpan]+          where zeroes = [(a, nullmixedamt) | a <- displayedAccts]++      acctBalChanges :: [(ClippedAccountName, [MixedAmount])] =+          dbg "acctBalChanges" $+          [(a, map snd abs) | abs@((a,_):_) <- transpose acctBalChangesPerSpan] -- never null, or used when null...++      -- starting balances and accounts from transactions before the report start date+      startacctbals = dbg "startacctbals" $ map (\((a,_,_),b) -> (a,b)) $ startbalanceitems+          where+            (startbalanceitems,_) = dbg "starting balance report" $ balanceReport opts' precedingq j+                                    where+                                      opts' | tree_ opts = opts{no_elide_=True}+                                            | otherwise  = opts{flat_=True}+      startingBalanceFor a = fromMaybe nullmixedamt $ lookup a startacctbals++      items :: [MultiBalanceReportRow] =+          dbg "items" $+          [((a, accountLeafName a, accountNameLevel a), displayedBals)+           | (a,changes) <- acctBalChanges+           , let displayedBals = case balancetype_ opts of+                                  HistoricalBalance -> drop 1 $ scanl (+) (startingBalanceFor a) changes+                                  CumulativeBalance -> drop 1 $ scanl (+) nullmixedamt changes+                                  _                 -> changes+           , empty_ opts || any (not . isZeroMixedAmount) displayedBals+           ]++      totals :: [MixedAmount] =+          dbg "totals" $+          map sum balsbycol+          where+            balsbycol = transpose [bs | ((a,_,_),bs) <- items, not (tree_ opts) || a `elem` highestlevelaccts]+            highestlevelaccts     =+                dbg "highestlevelaccts" $+                [a | a <- displayedAccts, not $ any (`elem` displayedAccts) $ init $ expandAccountName a]++      dbg s = let p = "multiBalanceReport" in Hledger.Utils.dbg (p++" "++s)  -- add prefix in debug output+      -- dbg = const id  -- exclude from debug output+

@@ -0,0 +1,368 @@+{-# LANGUAGE RecordWildCards, DeriveDataTypeable, FlexibleInstances #-}+{-|++Postings report, used by the register command.++-}++module Hledger.Reports.PostingsReport (+  PostingsReport,+  PostingsReportItem,+  postingsReport,+  mkpostingsReportItem,++  -- * Tests+  tests_Hledger_Reports_PostingsReport+)+where++import Data.List+import Data.Maybe+import Data.Time.Calendar+import Safe (headMay, lastMay)+import Test.HUnit++import Hledger.Data+import Hledger.Query+import Hledger.Utils+import Hledger.Reports.ReportOptions+++-- | A postings report is a list of postings with a running total, a label+-- for the total field, and a little extra transaction info to help with rendering.+-- This is used eg for the register command.+type PostingsReport = (String               -- label for the running balance column XXX remove+                      ,[PostingsReportItem] -- line items, one per posting+                      )+type PostingsReportItem = (Maybe Day    -- posting date, if this is the first posting in a transaction or if it's different from the previous posting's date+                          ,Maybe String -- transaction description, if this is the first posting in a transaction+                          ,Posting      -- the posting, possibly with account name depth-clipped+                          ,MixedAmount  -- the running total after this posting (or with --average, the running average)+                          )++-- | Select postings from the journal and add running balance and other+-- information to make a postings report. Used by eg hledger's register command.+postingsReport :: ReportOpts -> Query -> Journal -> PostingsReport+postingsReport opts q j = (totallabel, items)+    where+      -- figure out adjusted queries & spans like multiBalanceReport+      symq = dbg "symq"   $ filterQuery queryIsSym $ dbg "requested q" q+      depth = queryDepth q+      depthless = filterQuery (not . queryIsDepth)+      datelessq = filterQuery (not . queryIsDate) q+      dateqcons  = if date2_ opts then Date2 else Date+      requestedspan  = dbg "requestedspan"  $ queryDateSpan (date2_ opts) q                              -- span specified by -b/-e/-p options and query args+      requestedspan' = dbg "requestedspan'" $ requestedspan `spanDefaultsFrom` journalDateSpan (date2_ opts) j  -- if open-ended, close it using the journal's end dates+      intervalspans  = dbg "intervalspans"  $ splitSpan (intervalFromOpts opts) requestedspan' -- interval spans enclosing it+      reportstart    = dbg "reportstart"    $ maybe Nothing spanStart $ headMay intervalspans+      reportend      = dbg "reportend"      $ maybe Nothing spanEnd   $ lastMay intervalspans+      reportspan     = dbg "reportspan"     $ DateSpan reportstart reportend  -- the requested span enlarged to a whole number of intervals+      beforestartq   = dbg "beforestartq"   $ dateqcons $ DateSpan Nothing reportstart+      beforeendq     = dbg "beforeendq"     $ dateqcons $ DateSpan Nothing reportend+      reportq        = dbg "reportq"        $ depthless $ And [datelessq, beforeendq] -- user's query with no start date, end date on an interval boundary and no depth limit++      pstoend = +          dbg "ps4" $ map (filterPostingAmount symq) $                            -- remove amount parts which the query's cur: terms would exclude+          dbg "ps3" $ (if related_ opts then concatMap relatedPostings else id) $ -- with -r, replace each with its sibling postings+          dbg "ps2" $ filter (reportq `matchesPosting`) $                         -- filter postings by the query, including before the report start date, ignoring depth+          dbg "ps1" $ journalPostings $ journalSelectingAmountFromOpts opts j+      (precedingps, reportps) = dbg "precedingps, reportps" $ span (beforestartq `matchesPosting`) pstoend++      empty = queryEmpty q+      -- displayexpr = display_ opts  -- XXX+      interval = intervalFromOpts opts -- XXX++      whichdate = whichDateFromOpts opts+      itemps | interval == NoInterval = reportps+             | otherwise              = summarisePostingsByInterval interval whichdate depth empty reportspan reportps+      items = postingsReportItems itemps nullposting whichdate depth startbal runningcalc 1+        where+          startbal = if balancetype_ opts == HistoricalBalance then sumPostings precedingps else 0+          runningcalc | average_ opts = \i avg amt -> avg + (amt - avg) `divideMixedAmount` (fromIntegral i) -- running average+                      | otherwise     = \_ bal amt -> bal + amt                                              -- running total++      dbg s = let p = "postingsReport" in Hledger.Utils.dbg (p++" "++s)  -- add prefix in debug output+      -- dbg = const id  -- exclude from debug output++totallabel = "Total"++-- | Generate postings report line items.+postingsReportItems :: [Posting] -> Posting -> WhichDate -> Int -> MixedAmount -> (Int -> MixedAmount -> MixedAmount -> MixedAmount) -> Int -> [PostingsReportItem]+postingsReportItems [] _ _ _ _ _ _ = []+postingsReportItems (p:ps) pprev wd d b runningcalcfn itemnum = i:(postingsReportItems ps p wd d b' runningcalcfn (itemnum+1))+    where+      i = mkpostingsReportItem showdate showdesc wd p' b'+      showdate = isfirstintxn || isdifferentdate+      showdesc = isfirstintxn+      isfirstintxn = ptransaction p /= ptransaction pprev+      isdifferentdate = case wd of PrimaryDate   -> postingDate p  /= postingDate pprev+                                   SecondaryDate -> postingDate2 p /= postingDate2 pprev+      p' = p{paccount=clipAccountName d $ paccount p}+      b' = runningcalcfn itemnum b (pamount p)++-- | Generate one postings report line item, containing the posting,+-- the current running balance, and optionally the posting date and/or+-- the transaction description.+mkpostingsReportItem :: Bool -> Bool -> WhichDate -> Posting -> MixedAmount -> PostingsReportItem+mkpostingsReportItem showdate showdesc wd p b = (if showdate then Just date else Nothing, if showdesc then Just desc else Nothing, p, b)+    where+      date = case wd of PrimaryDate   -> postingDate p+                        SecondaryDate -> postingDate2 p+      desc = maybe "" tdescription $ ptransaction p++-- | Convert a list of postings into summary postings. Summary postings+-- are one per account per interval and aggregated to the specified depth+-- if any.+summarisePostingsByInterval :: Interval -> WhichDate -> Int -> Bool -> DateSpan -> [Posting] -> [Posting]+summarisePostingsByInterval interval wd depth empty reportspan ps = concatMap summarisespan $ splitSpan interval reportspan+    where+      summarisespan s = summarisePostingsInDateSpan s wd depth empty (postingsinspan s)+      postingsinspan s = filter (isPostingInDateSpan' wd s) ps++tests_summarisePostingsByInterval = [+  "summarisePostingsByInterval" ~: do+    summarisePostingsByInterval (Quarters 1) PrimaryDate 99999 False (DateSpan Nothing Nothing) [] ~?= []+ ]++-- | Given a date span (representing a reporting interval) and a list of+-- postings within it: aggregate the postings so there is only one per+-- account, and adjust their date/description so that they will render+-- as a summary for this interval.+--+-- As usual with date spans the end date is exclusive, but for display+-- purposes we show the previous day as end date, like ledger.+--+-- When a depth argument is present, postings to accounts of greater+-- depth are aggregated where possible.+--+-- The showempty flag includes spans with no postings and also postings+-- with 0 amount.+summarisePostingsInDateSpan :: DateSpan -> WhichDate -> Int -> Bool -> [Posting] -> [Posting]+summarisePostingsInDateSpan (DateSpan b e) wd depth showempty ps+    | null ps && (isNothing b || isNothing e) = []+    | null ps && showempty = [summaryp]+    | otherwise = summaryps'+    where+      summaryp = summaryPosting b' ("- "++ showDate (addDays (-1) e'))+      b' = fromMaybe (maybe nulldate postingdate $ headMay ps) b+      e' = fromMaybe (maybe (addDays 1 nulldate) postingdate $ lastMay ps) e+      postingdate = if wd == PrimaryDate then postingDate else postingDate2+      summaryPosting date desc = nullposting{ptransaction=Just nulltransaction{tdate=date,tdescription=desc}}+      summaryps' = (if showempty then id else filter (not . isZeroMixedAmount . pamount)) summaryps+      summaryps = [summaryp{paccount=a,pamount=balance a} | a <- clippedanames]+      clippedanames = nub $ map (clipAccountName depth) anames+      anames = sort $ nub $ map paccount ps+      -- aggregate balances by account, like ledgerFromJournal, then do depth-clipping+      accts = accountsFromPostings ps+      balance a = maybe nullmixedamt bal $ lookupAccount a accts +        where+          bal = if isclipped a then aibalance else aebalance+          isclipped a = accountNameLevel a >= depth++-- tests_summarisePostingsInDateSpan = [+  --  "summarisePostingsInDateSpan" ~: do+  --   let gives (b,e,depth,showempty,ps) =+  --           (summarisePostingsInDateSpan (mkdatespan b e) depth showempty ps `is`)+  --   let ps =+  --           [+  --            nullposting{lpdescription="desc",lpaccount="expenses:food:groceries",lpamount=Mixed [usd 1]}+  --           ,nullposting{lpdescription="desc",lpaccount="expenses:food:dining",   lpamount=Mixed [usd 2]}+  --           ,nullposting{lpdescription="desc",lpaccount="expenses:food",          lpamount=Mixed [usd 4]}+  --           ,nullposting{lpdescription="desc",lpaccount="expenses:food:dining",   lpamount=Mixed [usd 8]}+  --           ]+  --   ("2008/01/01","2009/01/01",0,9999,False,[]) `gives`+  --    []+  --   ("2008/01/01","2009/01/01",0,9999,True,[]) `gives`+  --    [+  --     nullposting{lpdate=parsedate "2008/01/01",lpdescription="- 2008/12/31"}+  --    ]+  --   ("2008/01/01","2009/01/01",0,9999,False,ts) `gives`+  --    [+  --     nullposting{lpdate=parsedate "2008/01/01",lpdescription="- 2008/12/31",lpaccount="expenses:food",          lpamount=Mixed [usd 4]}+  --    ,nullposting{lpdate=parsedate "2008/01/01",lpdescription="- 2008/12/31",lpaccount="expenses:food:dining",   lpamount=Mixed [usd 10]}+  --    ,nullposting{lpdate=parsedate "2008/01/01",lpdescription="- 2008/12/31",lpaccount="expenses:food:groceries",lpamount=Mixed [usd 1]}+  --    ]+  --   ("2008/01/01","2009/01/01",0,2,False,ts) `gives`+  --    [+  --     nullposting{lpdate=parsedate "2008/01/01",lpdescription="- 2008/12/31",lpaccount="expenses:food",lpamount=Mixed [usd 15]}+  --    ]+  --   ("2008/01/01","2009/01/01",0,1,False,ts) `gives`+  --    [+  --     nullposting{lpdate=parsedate "2008/01/01",lpdescription="- 2008/12/31",lpaccount="expenses",lpamount=Mixed [usd 15]}+  --    ]+  --   ("2008/01/01","2009/01/01",0,0,False,ts) `gives`+  --    [+  --     nullposting{lpdate=parsedate "2008/01/01",lpdescription="- 2008/12/31",lpaccount="",lpamount=Mixed [usd 15]}+  --    ]++tests_postingsReport = [+  "postingsReport" ~: do++   -- with the query specified explicitly+   let (query, journal) `gives` n = (length $ snd $ postingsReport defreportopts query journal) `is` n+   (Any, nulljournal) `gives` 0+   (Any, samplejournal) `gives` 11+   -- register --depth just clips account names+   (Depth 2, samplejournal) `gives` 11+   (And [Depth 1, Status True, Acct "expenses"], samplejournal) `gives` 2+   (And [And [Depth 1, Status True], Acct "expenses"], samplejournal) `gives` 2++   -- with query and/or command-line options+   assertEqual "" 11 (length $ snd $ postingsReport defreportopts Any samplejournal)+   assertEqual ""  9 (length $ snd $ postingsReport defreportopts{monthly_=True} Any samplejournal)+   assertEqual "" 19 (length $ snd $ postingsReport defreportopts{monthly_=True} (Empty True) samplejournal)+   assertEqual ""  4 (length $ snd $ postingsReport defreportopts (Acct "assets:bank:checking") samplejournal)++   -- (defreportopts, And [Acct "a a", Acct "'b"], samplejournal2) `gives` 0+   -- [(Just (parsedate "2008-01-01","income"),assets:bank:checking             $1,$1)+   -- ,(Nothing,income:salary                   $-1,0)+   -- ,(Just (2008-06-01,"gift"),assets:bank:checking             $1,$1)+   -- ,(Nothing,income:gifts                    $-1,0)+   -- ,(Just (2008-06-02,"save"),assets:bank:saving               $1,$1)+   -- ,(Nothing,assets:bank:checking            $-1,0)+   -- ,(Just (2008-06-03,"eat & shop"),expenses:food                    $1,$1)+   -- ,(Nothing,expenses:supplies                $1,$2)+   -- ,(Nothing,assets:cash                     $-2,0)+   -- ,(Just (2008-12-31,"pay off"),liabilities:debts                $1,$1)+   -- ,(Nothing,assets:bank:checking            $-1,0)+   -- ]++{-+    let opts = defreportopts+    (postingsReportAsText opts $ postingsReport opts (queryFromOpts date1 opts) j) `is` unlines+     ["2008/01/01 income               assets:bank:checking             $1           $1"+     ,"                                income:salary                   $-1            0"+     ,"2008/06/01 gift                 assets:bank:checking             $1           $1"+     ,"                                income:gifts                    $-1            0"+     ,"2008/06/02 save                 assets:bank:saving               $1           $1"+     ,"                                assets:bank:checking            $-1            0"+     ,"2008/06/03 eat & shop           expenses:food                    $1           $1"+     ,"                                expenses:supplies                $1           $2"+     ,"                                assets:cash                     $-2            0"+     ,"2008/12/31 pay off              liabilities:debts                $1           $1"+     ,"                                assets:bank:checking            $-1            0"+     ]++  ,"postings report with cleared option" ~:+   do +    let opts = defreportopts{cleared_=True}+    j <- readJournal' sample_journal_str+    (postingsReportAsText opts $ postingsReport opts (queryFromOpts date1 opts) j) `is` unlines+     ["2008/06/03 eat & shop           expenses:food                    $1           $1"+     ,"                                expenses:supplies                $1           $2"+     ,"                                assets:cash                     $-2            0"+     ,"2008/12/31 pay off              liabilities:debts                $1           $1"+     ,"                                assets:bank:checking            $-1            0"+     ]++  ,"postings report with uncleared option" ~:+   do +    let opts = defreportopts{uncleared_=True}+    j <- readJournal' sample_journal_str+    (postingsReportAsText opts $ postingsReport opts (queryFromOpts date1 opts) j) `is` unlines+     ["2008/01/01 income               assets:bank:checking             $1           $1"+     ,"                                income:salary                   $-1            0"+     ,"2008/06/01 gift                 assets:bank:checking             $1           $1"+     ,"                                income:gifts                    $-1            0"+     ,"2008/06/02 save                 assets:bank:saving               $1           $1"+     ,"                                assets:bank:checking            $-1            0"+     ]++  ,"postings report sorts by date" ~:+   do +    j <- readJournal' $ unlines+        ["2008/02/02 a"+        ,"  b  1"+        ,"  c"+        ,""+        ,"2008/01/01 d"+        ,"  e  1"+        ,"  f"+        ]+    let opts = defreportopts+    registerdates (postingsReportAsText opts $ postingsReport opts (queryFromOpts date1 opts) j) `is` ["2008/01/01","2008/02/02"]++  ,"postings report with account pattern" ~:+   do+    j <- samplejournal+    let opts = defreportopts{patterns_=["cash"]}+    (postingsReportAsText opts $ postingsReport opts (queryFromOpts date1 opts) j) `is` unlines+     ["2008/06/03 eat & shop           assets:cash                     $-2          $-2"+     ]++  ,"postings report with account pattern, case insensitive" ~:+   do +    j <- samplejournal+    let opts = defreportopts{patterns_=["cAsH"]}+    (postingsReportAsText opts $ postingsReport opts (queryFromOpts date1 opts) j) `is` unlines+     ["2008/06/03 eat & shop           assets:cash                     $-2          $-2"+     ]++  ,"postings report with display expression" ~:+   do +    j <- samplejournal+    let gives displayexpr = +            (registerdates (postingsReportAsText opts $ postingsReport opts (queryFromOpts date1 opts) j) `is`)+                where opts = defreportopts{display_=Just displayexpr}+    "d<[2008/6/2]"  `gives` ["2008/01/01","2008/06/01"]+    "d<=[2008/6/2]" `gives` ["2008/01/01","2008/06/01","2008/06/02"]+    "d=[2008/6/2]"  `gives` ["2008/06/02"]+    "d>=[2008/6/2]" `gives` ["2008/06/02","2008/06/03","2008/12/31"]+    "d>[2008/6/2]"  `gives` ["2008/06/03","2008/12/31"]++  ,"postings report with period expression" ~:+   do +    j <- samplejournal+    let periodexpr `gives` dates = do+          j' <- samplejournal+          registerdates (postingsReportAsText opts $ postingsReport opts (queryFromOpts date1 opts) j') `is` dates+              where opts = defreportopts{period_=maybePeriod date1 periodexpr}+    ""     `gives` ["2008/01/01","2008/06/01","2008/06/02","2008/06/03","2008/12/31"]+    "2008" `gives` ["2008/01/01","2008/06/01","2008/06/02","2008/06/03","2008/12/31"]+    "2007" `gives` []+    "june" `gives` ["2008/06/01","2008/06/02","2008/06/03"]+    "monthly" `gives` ["2008/01/01","2008/06/01","2008/12/01"]+    "quarterly" `gives` ["2008/01/01","2008/04/01","2008/10/01"]+    let opts = defreportopts{period_=maybePeriod date1 "yearly"}+    (postingsReportAsText opts $ postingsReport opts (queryFromOpts date1 opts) j) `is` unlines+     ["2008/01/01 - 2008/12/31         assets:bank:saving               $1           $1"+     ,"                                assets:cash                     $-2          $-1"+     ,"                                expenses:food                    $1            0"+     ,"                                expenses:supplies                $1           $1"+     ,"                                income:gifts                    $-1            0"+     ,"                                income:salary                   $-1          $-1"+     ,"                                liabilities:debts                $1            0"+     ]+    let opts = defreportopts{period_=maybePeriod date1 "quarterly"}+    registerdates (postingsReportAsText opts $ postingsReport opts (queryFromOpts date1 opts) j) `is` ["2008/01/01","2008/04/01","2008/10/01"]+    let opts = defreportopts{period_=maybePeriod date1 "quarterly",empty_=True}+    registerdates (postingsReportAsText opts $ postingsReport opts (queryFromOpts date1 opts) j) `is` ["2008/01/01","2008/04/01","2008/07/01","2008/10/01"]++  ]++  , "postings report with depth arg" ~:+   do +    j <- samplejournal+    let opts = defreportopts{depth_=Just 2}+    (postingsReportAsText opts $ postingsReport opts (queryFromOpts date1 opts) j) `is` unlines+     ["2008/01/01 income               assets:bank                      $1           $1"+     ,"                                income:salary                   $-1            0"+     ,"2008/06/01 gift                 assets:bank                      $1           $1"+     ,"                                income:gifts                    $-1            0"+     ,"2008/06/02 save                 assets:bank                      $1           $1"+     ,"                                assets:bank                     $-1            0"+     ,"2008/06/03 eat & shop           expenses:food                    $1           $1"+     ,"                                expenses:supplies                $1           $2"+     ,"                                assets:cash                     $-2            0"+     ,"2008/12/31 pay off              liabilities:debts                $1           $1"+     ,"                                assets:bank                     $-1            0"+     ]++-}+ ]++tests_Hledger_Reports_PostingsReport :: Test+tests_Hledger_Reports_PostingsReport = TestList $+    tests_summarisePostingsByInterval+ ++ tests_postingsReport+

@@ -0,0 +1,295 @@+{-# LANGUAGE RecordWildCards, DeriveDataTypeable #-}+{-|++Options common to most hledger reports.++-}++module Hledger.Reports.ReportOptions (+  ReportOpts(..),+  BalanceType(..),+  FormatStr,+  defreportopts,+  rawOptsToReportOpts,+  dateSpanFromOpts,+  intervalFromOpts,+  clearedValueFromOpts,+  whichDateFromOpts,+  journalSelectingAmountFromOpts,+  queryFromOpts,+  queryFromOptsOnly,+  queryOptsFromOpts,+  transactionDateFn,+  postingDateFn,++  tests_Hledger_Reports_ReportOptions+)+where++import Data.Data (Data)+import Data.Typeable (Typeable)+import Data.Time.Calendar+import System.Console.CmdArgs.Default  -- some additional default stuff+import Test.HUnit++import Hledger.Data+import Hledger.Query+import Hledger.Utils+++type FormatStr = String++-- | Which balance is being shown in a multi-column balance report.+data BalanceType = PeriodBalance     -- ^ The change of balance in each period.+                 | CumulativeBalance -- ^ The accumulated balance at each period's end, starting from zero at the report start date.+                 | HistoricalBalance -- ^ The historical balance at each period's end, starting from the account balances at the report start date.+  deriving (Eq,Show,Data,Typeable)++instance Default BalanceType where def = PeriodBalance++-- | Standard options for customising report filtering and output,+-- corresponding to hledger's command-line options and query language+-- arguments. Used in hledger-lib and above.+data ReportOpts = ReportOpts {+     begin_          :: Maybe Day+    ,end_            :: Maybe Day+    ,period_         :: Maybe (Interval,DateSpan)+    ,cleared_        :: Bool+    ,uncleared_      :: Bool+    ,cost_           :: Bool+    ,depth_          :: Maybe Int+    ,display_        :: Maybe DisplayExp+    ,date2_          :: Bool+    ,empty_          :: Bool+    ,no_elide_       :: Bool+    ,real_           :: Bool+    ,daily_          :: Bool+    ,weekly_         :: Bool+    ,monthly_        :: Bool+    ,quarterly_      :: Bool+    ,yearly_         :: Bool+    ,format_         :: Maybe FormatStr+    ,query_          :: String -- all arguments, as a string+    -- register+    ,average_        :: Bool+    ,related_        :: Bool+    -- balance+    ,balancetype_    :: BalanceType+    ,flat_           :: Bool -- mutually+    ,tree_           :: Bool -- exclusive+    ,drop_           :: Int+    ,no_total_       :: Bool+ } deriving (Show, Data, Typeable)++instance Default ReportOpts where def = defreportopts++defreportopts :: ReportOpts+defreportopts = ReportOpts+    def+    def+    def+    def+    def+    def+    def+    def+    def+    def+    def+    def+    def+    def+    def+    def+    def+    def+    def+    def+    def+    def+    def+    def+    def+    def++rawOptsToReportOpts :: RawOpts -> IO ReportOpts+rawOptsToReportOpts rawopts = do+  d <- getCurrentDay+  return defreportopts{+     begin_       = maybesmartdateopt d "begin" rawopts+    ,end_         = maybesmartdateopt d "end" rawopts+    ,period_      = maybeperiodopt d rawopts+    ,cleared_     = boolopt "cleared" rawopts+    ,uncleared_   = boolopt "uncleared" rawopts+    ,cost_        = boolopt "cost" rawopts+    ,depth_       = maybeintopt "depth" rawopts+    ,display_     = maybedisplayopt d rawopts+    ,date2_       = boolopt "date2" rawopts+    ,empty_       = boolopt "empty" rawopts+    ,no_elide_    = boolopt "no-elide" rawopts+    ,real_        = boolopt "real" rawopts+    ,daily_       = boolopt "daily" rawopts+    ,weekly_      = boolopt "weekly" rawopts+    ,monthly_     = boolopt "monthly" rawopts+    ,quarterly_   = boolopt "quarterly" rawopts+    ,yearly_      = boolopt "yearly" rawopts+    ,format_      = maybestringopt "format" rawopts+    ,query_       = unwords $ listofstringopt "args" rawopts -- doesn't handle an arg like "" right+    ,average_     = boolopt "average" rawopts+    ,related_     = boolopt "related" rawopts+    ,balancetype_ = balancetypeopt rawopts+    ,flat_        = boolopt "flat" rawopts+    ,tree_        = boolopt "tree" rawopts+    ,drop_        = intopt "drop" rawopts+    ,no_total_    = boolopt "no-total" rawopts+    }++balancetypeopt :: RawOpts -> BalanceType+balancetypeopt rawopts+    | length [o | o <- ["cumulative","historical"], isset o] > 1+                         = optserror "please specify at most one of --cumulative and --historical"+    | isset "cumulative" = CumulativeBalance+    | isset "historical" = HistoricalBalance+    | otherwise          = PeriodBalance+    where+      isset = flip boolopt rawopts++maybesmartdateopt :: Day -> String -> RawOpts -> Maybe Day+maybesmartdateopt d name rawopts =+        case maybestringopt name rawopts of+          Nothing -> Nothing+          Just s -> either+                    (\e -> optserror $ "could not parse "++name++" date: "++show e)+                    Just+                    $ fixSmartDateStrEither' d s++type DisplayExp = String++maybedisplayopt :: Day -> RawOpts -> Maybe DisplayExp+maybedisplayopt d rawopts =+    maybe Nothing (Just . regexReplaceBy "\\[.+?\\]" fixbracketeddatestr) $ maybestringopt "display" rawopts+    where+      fixbracketeddatestr "" = ""+      fixbracketeddatestr s = "[" ++ fixSmartDateStr d (init $ tail s) ++ "]"++maybeperiodopt :: Day -> RawOpts -> Maybe (Interval,DateSpan)+maybeperiodopt d rawopts =+    case maybestringopt "period" rawopts of+      Nothing -> Nothing+      Just s -> either+                (\e -> optserror $ "could not parse period option: "++show e)+                Just+                $ parsePeriodExpr d s++-- | Figure out the date span we should report on, based on any+-- begin/end/period options provided. A period option will cause begin and+-- end options to be ignored.+dateSpanFromOpts :: Day -> ReportOpts -> DateSpan+dateSpanFromOpts _ ReportOpts{..} =+    case period_ of Just (_,span) -> span+                    Nothing -> DateSpan begin_ end_++-- | Figure out the reporting interval, if any, specified by the options.+-- --period overrides --daily overrides --weekly overrides --monthly etc.+intervalFromOpts :: ReportOpts -> Interval+intervalFromOpts ReportOpts{..} =+    case period_ of+      Just (interval,_) -> interval+      Nothing -> i+          where i | daily_ = Days 1+                  | weekly_ = Weeks 1+                  | monthly_ = Months 1+                  | quarterly_ = Quarters 1+                  | yearly_ = Years 1+                  | otherwise =  NoInterval++-- | Get a maybe boolean representing the last cleared/uncleared option if any.+clearedValueFromOpts :: ReportOpts -> Maybe Bool+clearedValueFromOpts ReportOpts{..} | cleared_   = Just True+                                    | uncleared_ = Just False+                                    | otherwise  = Nothing++-- depthFromOpts :: ReportOpts -> Int+-- depthFromOpts opts = min (fromMaybe 99999 $ depth_ opts) (queryDepth $ queryFromOpts nulldate opts)++-- | Report which date we will report on based on --date2.+whichDateFromOpts :: ReportOpts -> WhichDate+whichDateFromOpts ReportOpts{..} = if date2_ then SecondaryDate else PrimaryDate++-- | Select the Transaction date accessor based on --date2.+transactionDateFn :: ReportOpts -> (Transaction -> Day)+transactionDateFn ReportOpts{..} = if date2_ then transactionDate2 else tdate++-- | Select the Posting date accessor based on --date2.+postingDateFn :: ReportOpts -> (Posting -> Day)+postingDateFn ReportOpts{..} = if date2_ then postingDate2 else postingDate+++-- | Convert this journal's postings' amounts to the cost basis amounts if+-- specified by options.+journalSelectingAmountFromOpts :: ReportOpts -> Journal -> Journal+journalSelectingAmountFromOpts opts+    | cost_ opts = journalConvertAmountsToCost+    | otherwise = id++-- | Convert report options and arguments to a query.+queryFromOpts :: Day -> ReportOpts -> Query+queryFromOpts d opts@ReportOpts{..} = simplifyQuery $ And $ [flagsq, argsq]+  where+    flagsq = And $+              [(if date2_ then Date2 else Date) $ dateSpanFromOpts d opts]+              ++ (if real_ then [Real True] else [])+              ++ (if empty_ then [Empty True] else []) -- ?+              ++ (maybe [] ((:[]) . Status) (clearedValueFromOpts opts))+              ++ (maybe [] ((:[]) . Depth) depth_)+    argsq = fst $ parseQuery d query_++-- | Convert report options to a query, ignoring any non-flag command line arguments.+queryFromOptsOnly :: Day -> ReportOpts -> Query+queryFromOptsOnly d opts@ReportOpts{..} = simplifyQuery flagsq+  where+    flagsq = And $+              [(if date2_ then Date2 else Date) $ dateSpanFromOpts d opts]+              ++ (if real_ then [Real True] else [])+              ++ (if empty_ then [Empty True] else []) -- ?+              ++ (maybe [] ((:[]) . Status) (clearedValueFromOpts opts))+              ++ (maybe [] ((:[]) . Depth) depth_)++tests_queryFromOpts :: [Test]+tests_queryFromOpts = [+ "queryFromOpts" ~: do+  assertEqual "" Any (queryFromOpts nulldate defreportopts)+  assertEqual "" (Acct "a") (queryFromOpts nulldate defreportopts{query_="a"})+  assertEqual "" (Desc "a a") (queryFromOpts nulldate defreportopts{query_="desc:'a a'"})+  assertEqual "" (Date $ mkdatespan "2012/01/01" "2013/01/01")+                 (queryFromOpts nulldate defreportopts{begin_=Just (parsedate "2012/01/01")+                                                      ,query_="date:'to 2013'"+                                                      })+  assertEqual "" (Date2 $ mkdatespan "2012/01/01" "2013/01/01")+                 (queryFromOpts nulldate defreportopts{query_="edate:'in 2012'"})+  assertEqual "" (Or [Acct "a a", Acct "'b"])+                 (queryFromOpts nulldate defreportopts{query_="'a a' 'b"})+ ]++-- | Convert report options and arguments to query options.+queryOptsFromOpts :: Day -> ReportOpts -> [QueryOpt]+queryOptsFromOpts d ReportOpts{..} = flagsqopts ++ argsqopts+  where+    flagsqopts = []+    argsqopts = snd $ parseQuery d query_++tests_queryOptsFromOpts :: [Test]+tests_queryOptsFromOpts = [+ "queryOptsFromOpts" ~: do+  assertEqual "" [] (queryOptsFromOpts nulldate defreportopts)+  assertEqual "" [] (queryOptsFromOpts nulldate defreportopts{query_="a"})+  assertEqual "" [] (queryOptsFromOpts nulldate defreportopts{begin_=Just (parsedate "2012/01/01")+                                                             ,query_="date:'to 2013'"+                                                             })+ ]+++tests_Hledger_Reports_ReportOptions :: Test+tests_Hledger_Reports_ReportOptions = TestList $+    tests_queryFromOpts+ ++ tests_queryOptsFromOpts

@@ -0,0 +1,196 @@+{-# LANGUAGE RecordWildCards, DeriveDataTypeable, FlexibleInstances #-}+{-|++Whole-journal, account-centric, and per-commodity transactions reports, used by hledger-web.++-}++module Hledger.Reports.TransactionsReports (+  TransactionsReport,+  TransactionsReportItem,+  triDate,+  triBalance,+  triSimpleBalance,+  journalTransactionsReport,+  accountTransactionsReport,+  transactionsReportByCommodity++  -- -- * Tests+  -- tests_Hledger_Reports_TransactionsReports+)+where++import Data.List+import Data.Maybe+import Data.Ord+-- import Test.HUnit++import Hledger.Data+import Hledger.Query+import Hledger.Reports.ReportOptions+++-- | A transactions report includes a list of transactions+-- (posting-filtered and unfiltered variants), a running balance, and some+-- other information helpful for rendering a register view (a flag+-- indicating multiple other accounts and a display string describing+-- them) with or without a notion of current account(s).+-- Two kinds of report use this data structure, see journalTransactionsReport+-- and accountTransactionsReport below for detais.+type TransactionsReport = (String                   -- label for the balance column, eg "balance" or "total"+                          ,[TransactionsReportItem] -- line items, one per transaction+                          )+type TransactionsReportItem = (Transaction -- the corresponding transaction+                              ,Transaction -- the transaction with postings to the current account(s) removed+                              ,Bool        -- is this a split, ie more than one other account posting+                              ,String      -- a display string describing the other account(s), if any+                              ,MixedAmount -- the amount posted to the current account(s) (or total amount posted)+                              ,MixedAmount -- the running balance for the current account(s) after this transaction+                              )++triDate (t,_,_,_,_,_) = tdate t+triAmount (_,_,_,_,a,_) = a+triBalance (_,_,_,_,_,a) = a+triSimpleBalance (_,_,_,_,_,Mixed a) = case a of [] -> "0"+                                                 (Amount{aquantity=q}):_ -> show q++-------------------------------------------------------------------------------++-- | Select transactions from the whole journal. This is similar to a+-- "postingsReport" except with transaction-based report items which+-- are ordered most recent first. This is used by eg hledger-web's journal view.+journalTransactionsReport :: ReportOpts -> Journal -> Query -> TransactionsReport+journalTransactionsReport _ Journal{jtxns=ts} m = (totallabel, items)+   where+     ts' = sortBy (comparing tdate) $ filter (not . null . tpostings) $ map (filterTransactionPostings m) ts+     items = reverse $ accountTransactionsReportItems m Nothing nullmixedamt id ts'+     -- XXX items' first element should be the full transaction with all postings++-------------------------------------------------------------------------------++-- | Select transactions within one or more current accounts, and make a+-- transactions report relative to those account(s). This means:+--+-- 1. it shows transactions from the point of view of the current account(s).+--    The transaction amount is the amount posted to the current account(s).+--    The other accounts' names are provided. +--+-- 2. With no transaction filtering in effect other than a start date, it+--    shows the accurate historical running balance for the current account(s).+--    Otherwise it shows a running total starting at 0.+--+-- This is used by eg hledger-web's account register view. Currently,+-- reporting intervals are not supported, and report items are most+-- recent first.+accountTransactionsReport :: ReportOpts -> Journal -> Query -> Query -> TransactionsReport+accountTransactionsReport opts j m thisacctquery = (label, items)+ where+     -- transactions affecting this account, in date order+     ts = sortBy (comparing tdate) $ filter (matchesTransaction thisacctquery) $ jtxns $+          journalSelectingAmountFromOpts opts j+     -- starting balance: if we are filtering by a start date and nothing else,+     -- the sum of postings to this account before that date; otherwise zero.+     (startbal,label) | queryIsNull m                           = (nullmixedamt,        balancelabel)+                      | queryIsStartDateOnly (date2_ opts) m = (sumPostings priorps, balancelabel)+                      | otherwise                                 = (nullmixedamt,        totallabel)+                      where+                        priorps = -- ltrace "priorps" $+                                  filter (matchesPosting+                                          (-- ltrace "priormatcher" $+                                           And [thisacctquery, tostartdatequery]))+                                         $ transactionsPostings ts+                        tostartdatequery = Date (DateSpan Nothing startdate)+                        startdate = queryStartDate (date2_ opts) m+     items = reverse $ accountTransactionsReportItems m (Just thisacctquery) startbal negate ts++totallabel = "Total"+balancelabel = "Balance"++-- | Generate transactions report items from a list of transactions,+-- using the provided query and current account queries, starting balance,+-- sign-setting function and balance-summing function.+accountTransactionsReportItems :: Query -> Maybe Query -> MixedAmount -> (MixedAmount -> MixedAmount) -> [Transaction] -> [TransactionsReportItem]+accountTransactionsReportItems _ _ _ _ [] = []+accountTransactionsReportItems query thisacctquery bal signfn (t:ts) =+    -- This is used for both accountTransactionsReport and journalTransactionsReport,+    -- which makes it a bit overcomplicated+    case i of Just i' -> i':is+              Nothing -> is+    where+      tmatched@Transaction{tpostings=psmatched} = filterTransactionPostings query t+      (psthisacct,psotheracct) = case thisacctquery of Just m  -> partition (matchesPosting m) psmatched+                                                       Nothing -> ([],psmatched)+      numotheraccts = length $ nub $ map paccount psotheracct+      amt = negate $ sum $ map pamount psthisacct+      acct | isNothing thisacctquery = summarisePostings psmatched -- journal register+           | numotheraccts == 0 = "transfer between " ++ summarisePostingAccounts psthisacct+           | otherwise          = prefix              ++ summarisePostingAccounts psotheracct+           where prefix = maybe "" (\b -> if b then "from " else "to ") $ isNegativeMixedAmount amt+      (i,bal') = case psmatched of+           [] -> (Nothing,bal)+           _  -> (Just (t, tmatched, numotheraccts > 1, acct, a, b), b)+                 where+                  a = signfn amt+                  b = bal + a+      is = accountTransactionsReportItems query thisacctquery bal' signfn ts++-- | Generate a short readable summary of some postings, like+-- "from (negatives) to (positives)".+summarisePostings :: [Posting] -> String+summarisePostings ps =+    case (summarisePostingAccounts froms, summarisePostingAccounts tos) of+       ("",t) -> "to "++t+       (f,"") -> "from "++f+       (f,t)  -> "from "++f++" to "++t+    where+      (froms,tos) = partition (fromMaybe False . isNegativeMixedAmount . pamount) ps++-- | Generate a simplified summary of some postings' accounts.+summarisePostingAccounts :: [Posting] -> String+summarisePostingAccounts = intercalate ", " . map accountLeafName . nub . map paccount++filterTransactionPostings :: Query -> Transaction -> Transaction+filterTransactionPostings m t@Transaction{tpostings=ps} = t{tpostings=filter (m `matchesPosting`) ps}++-------------------------------------------------------------------------------++-- | Split a transactions report whose items may involve several commodities,+-- into one or more single-commodity transactions reports.+transactionsReportByCommodity :: TransactionsReport -> [TransactionsReport]+transactionsReportByCommodity tr =+  [filterTransactionsReportByCommodity c tr | c <- transactionsReportCommodities tr]+  where+    transactionsReportCommodities (_,items) =+      nub $ sort $ map acommodity $ concatMap (amounts . triAmount) items++-- Remove transaction report items and item amount (and running+-- balance amount) components that don't involve the specified+-- commodity. Other item fields such as the transaction are left unchanged.+filterTransactionsReportByCommodity :: Commodity -> TransactionsReport -> TransactionsReport+filterTransactionsReportByCommodity c (label,items) =+  (label, fixTransactionsReportItemBalances $ concat [filterTransactionsReportItemByCommodity c i | i <- items])+  where+    filterTransactionsReportItemByCommodity c (t,t2,s,o,a,bal)+      | c `elem` cs = [item']+      | otherwise   = []+      where+        cs = map acommodity $ amounts a+        item' = (t,t2,s,o,a',bal)+        a' = filterMixedAmountByCommodity c a++    fixTransactionsReportItemBalances [] = []+    fixTransactionsReportItemBalances [i] = [i]+    fixTransactionsReportItemBalances items = reverse $ i:(go startbal is)+      where+        i:is = reverse items+        startbal = filterMixedAmountByCommodity c $ triBalance i+        go _ [] = []+        go bal ((t,t2,s,o,amt,_):is) = (t,t2,s,o,amt,bal'):go bal' is+          where bal' = bal + amt++-- | Filter out all but the specified commodity from this amount.+filterMixedAmountByCommodity :: Commodity -> MixedAmount -> MixedAmount+filterMixedAmountByCommodity c (Mixed as) = Mixed $ filter ((==c). acommodity) as++-------------------------------------------------------------------------------+

@@ -91,7 +91,7 @@             | last s == '\n' = s             | otherwise = s ++ "\n" --- | Wrap a string in single quotes, and \-prefix any embedded single+-- | Wrap a string in double quotes, and \-prefix any embedded single -- quotes, if it contains whitespace and is not already single- or -- double-quoted. quoteIfSpaced :: String -> String@@ -99,6 +99,22 @@                 | not $ any (`elem` s) whitespacechars = s                 | otherwise = "'"++escapeSingleQuotes s++"'" +-- | Double-quote this string if it contains whitespace, single quotes+-- or double-quotes, escaping the quotes as needed.+quoteIfNeeded s | any (`elem` s) (quotechars++whitespacechars) = "\"" ++ escapeDoubleQuotes s ++ "\""+                | otherwise = s++-- | Single-quote this string if it contains whitespace or double-quotes.+-- No good for strings containing single quotes.+singleQuoteIfNeeded s | any (`elem` s) whitespacechars = "'"++s++"'"+                      | otherwise = s++quotechars      = "'\""+whitespacechars = " \t\n\r"++escapeDoubleQuotes :: String -> String+escapeDoubleQuotes = regexReplace "\"" "\""+ escapeSingleQuotes :: String -> String escapeSingleQuotes = regexReplace "'" "\'" @@ -111,21 +127,16 @@ words' "" = [] words' s  = map stripquotes $ fromparse $ parsewith p s     where-      p = do ss <- (quotedPattern <|> pattern) `sepBy` many1 spacenonewline+      p = do ss <- (singleQuotedPattern <|> doubleQuotedPattern <|> pattern) `sepBy` many1 spacenonewline              -- eof              return ss       pattern = many (noneOf whitespacechars)-      quotedPattern = between (oneOf "'\"") (oneOf "'\"") $ many $ noneOf "'\""+      singleQuotedPattern = between (char '\'') (char '\'') (many $ noneOf "'")+      doubleQuotedPattern = between (char '"') (char '"') (many $ noneOf "\"")  -- | Quote-aware version of unwords - single-quote strings which contain whitespace unwords' :: [String] -> String-unwords' = unwords . map singleQuoteIfNeeded---- | Single-quote this string if it contains whitespace or double-quotes-singleQuoteIfNeeded s | any (`elem` s) whitespacechars = "'"++s++"'"-                      | otherwise = s--whitespacechars = " \t\n\r"+unwords' = unwords . map quoteIfNeeded  -- | Strip one matching pair of single or double quotes on the ends of a string. stripquotes :: String -> String@@ -215,6 +226,23 @@       fit w = take w . (++ repeat ' ')       blankline = replicate w ' ' +-- tuples++first3  (x,_,_) = x+second3 (_,x,_) = x+third3  (_,_,x) = x++first4  (x,_,_,_) = x+second4 (_,x,_,_) = x+third4  (_,_,x,_) = x+fourth4 (_,_,_,x) = x++first5  (x,_,_,_,_) = x+second5 (_,x,_,_,_) = x+third5  (_,_,x,_,_) = x+fourth5 (_,_,_,x,_) = x+fifth5  (_,_,_,_,x) = x+ -- math  difforzero :: (Num a, Ord a) => a -> a -> a@@ -406,8 +434,25 @@ -- | Print a message and a showable value to the console if the global -- debug level is non-zero.  Uses unsafePerformIO. dbg :: Show a => String -> a -> a-dbg = dbgppshow 1+dbg = dbg1 +dbg0 :: Show a => String -> a -> a+dbg0 = dbgAt 0++dbg1 :: Show a => String -> a -> a+dbg1 = dbgAt 1++dbg2 :: Show a => String -> a -> a+dbg2 = dbgAt 2++-- | Print a message and a showable value to the console if the global+-- debug level is at or above the specified level.  Uses unsafePerformIO.+dbgAt :: Show a => Int -> String -> a -> a+dbgAt lvl = dbgppshow lvl++dbgAtM :: Show a => Int -> String -> a -> IO ()+dbgAtM lvl lbl x = dbgAt lvl lbl x `seq` return ()+ -- | Print a showable value to the console, with a message, if the -- debug level is at or above the specified level (uses -- unsafePerformIO).@@ -423,8 +468,14 @@ -- Values are displayed with ppShow, each field/constructor on its own line. dbgppshow :: Show a => Int -> String -> a -> a dbgppshow level-    | debugLevel >= level = \s -> traceWith (((s++": ")++) . ppShow)-    | otherwise           = flip const+    | debugLevel < level = flip const+    | otherwise = \s a -> let p = ppShow a+                              ls = lines p+                              nlorspace | length ls > 1 = "\n"+                                        | otherwise     = " " ++ take (10 - length s) (repeat ' ')+                              ls' | length ls > 1 = map (" "++) ls+                                  | otherwise     = ls+                          in trace (s++":"++nlorspace++intercalate "\n" ls') a  -- -- | Print a showable value to the console, with a message, if the -- -- debug level is at or above the specified level (uses

@@ -1,7 +1,7 @@ name:           hledger-lib-version: 0.22.2-stability:      beta-category:       Finance+version:        0.23+stability:      stable+category:       Finance, Console synopsis:       Core data types, parsers and utilities for the hledger accounting tool. description:                 hledger is a library and set of user tools for working@@ -17,7 +17,7 @@ maintainer:     Simon Michael <simon@joyful.com> homepage:       http://hledger.org bug-reports:    http://hledger.org/bugs-tested-with:    GHC==7.2.2, GHC==7.4.2, GHC==7.6.3, GHC==7.8+tested-with:    GHC==7.2.2, GHC==7.4.2, GHC==7.6.3, GHC==7.8.2 cabal-version:  >= 1.10 build-type:     Simple -- data-dir:       data@@ -42,10 +42,11 @@                   Hledger.Data.Amount                   Hledger.Data.Commodity                   Hledger.Data.Dates-                  Hledger.Data.FormatStrings+                  Hledger.Data.OutputFormat                   Hledger.Data.Journal                   Hledger.Data.Ledger                   Hledger.Data.Posting+                  Hledger.Data.RawOptions                   Hledger.Data.TimeLog                   Hledger.Data.Transaction                   Hledger.Data.Types@@ -55,6 +56,13 @@                   Hledger.Read.JournalReader                   Hledger.Read.TimelogReader                   Hledger.Reports+                  Hledger.Reports.ReportOptions+                  Hledger.Reports.BalanceHistoryReport+                  Hledger.Reports.BalanceReport+                  Hledger.Reports.EntriesReport+                  Hledger.Reports.MultiBalanceReports+                  Hledger.Reports.PostingsReport+                  Hledger.Reports.TransactionsReports                   Hledger.Utils                   Hledger.Utils.UTF8IOCompat   build-depends: