hledger-lib 0.21.3 → 0.22

raw patch · 12 files changed

+566/−185 lines, 12 filesdep +data-pprintdep +regex-compat-tdfadep −regex-compatPVP ok

version bump matches the API change (PVP)

Dependencies added: data-pprint, regex-compat-tdfa

Dependencies removed: regex-compat

API changes (from Hackage documentation)

Files

• Hledger/Data/Account.hs +3/−7
• Hledger/Data/Amount.hs +18/−7
• Hledger/Data/Dates.hs +39/−6
• Hledger/Data/Journal.hs +15/−1
• Hledger/Data/Transaction.hs +33/−25
• Hledger/Data/Types.hs +29/−26
• Hledger/Query.hs +56/−22
• Hledger/Read/CsvReader.hs +17/−4
• Hledger/Read/JournalReader.hs +7/−11
• Hledger/Reports.hs +262/−53
• Hledger/Utils.hs +79/−17
• hledger-lib.cabal +8/−6

@@ -49,8 +49,8 @@   , aboring = False   } --- | Derive an account tree with balances from a set of postings.--- (*ledger's core feature.) The accounts are returned in a list, but+-- | Derive 1. an account tree and 2. their balances from a list of postings.+-- (ledger's core feature). The accounts are returned in a list, but -- retain their tree structure; the first one is the root of the tree. accountsFromPostings :: [Posting] -> [Account] accountsFromPostings ps =@@ -58,10 +58,9 @@     acctamts = [(paccount p,pamount p) | p <- ps]     grouped = groupBy (\a b -> fst a == fst b) $ sort $ acctamts     summed = map (\as@((aname,_):_) -> (aname, sum $ map snd as)) grouped -- always non-empty-    setebalance a = a{aebalance=lookupJustDef nullmixedamt (aname a) summed}     nametree = treeFromPaths $ map (expandAccountName . fst) summed     acctswithnames = nameTreeToAccount "root" nametree-    acctswithebals = mapAccounts setebalance acctswithnames+    acctswithebals = mapAccounts setebalance acctswithnames where setebalance a = a{aebalance=lookupJustDef nullmixedamt (aname a) summed}     acctswithibals = sumAccounts acctswithebals     acctswithparents = tieAccountParents acctswithibals     acctsflattened = flattenAccounts acctswithparents@@ -101,9 +100,6 @@     | otherwise = any (anyAccounts p) $ asubs a  -- | Add subaccount-inclusive balances to an account tree.--- -- , also noting--- -- whether it has an interesting balance or interesting subs to help--- -- with eliding later. sumAccounts :: Account -> Account sumAccounts a   | null $ asubs a = a{aibalance=aebalance a}

@@ -115,7 +115,14 @@ ------------------------------------------------------------------------------- -- Amount -instance Show Amount where show = showAmountDebug+instance Show Amount where+  show _a@Amount{..}+    --  debugLevel < 3 = showAmountWithoutPrice a+    --  debugLevel < 6 = showAmount a+    | debugLevel < 9 =+       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)  instance Num Amount where     abs a@Amount{aquantity=q}    = a{aquantity=abs q}@@ -229,11 +236,11 @@ withPrecision :: Amount -> Int -> Amount withPrecision = flip setAmountPrecision --- | Get the unambiguous string representation of an amount, for debugging.+-- | Get a string representation of an amount for debugging,+-- appropriate to the current debug level. 9 shows maximum detail. showAmountDebug :: Amount -> String showAmountDebug Amount{acommodity="AUTO"} = "(missing)"-showAmountDebug Amount{..} = printf "Amount {acommodity=%s, aquantity=%s, aprice=%s, astyle=%s}"-                                   (show acommodity) (show aquantity) (showPriceDebug aprice) (show astyle)+showAmountDebug Amount{..} = printf "Amount {acommodity=%s, aquantity=%s, aprice=%s, astyle=%s}" (show acommodity) (show aquantity) (showPriceDebug aprice) (show astyle)  -- | Get the string representation of an amount, without any \@ price. showAmountWithoutPrice :: Amount -> String@@ -323,7 +330,11 @@ ------------------------------------------------------------------------------- -- MixedAmount -instance Show MixedAmount where show = showMixedAmountDebug+instance Show MixedAmount where+  show+    --  debugLevel < 3 = intercalate "\\n" . lines . showMixedAmountWithoutPrice+    --  debugLevel < 6 = intercalate "\\n" . lines . showMixedAmount+    | otherwise      = showMixedAmountDebug  instance Num MixedAmount where     fromInteger i = Mixed [fromInteger i]@@ -450,9 +461,9 @@ showMixedAmount :: MixedAmount -> String showMixedAmount m = vConcatRightAligned $ map showAmount $ amounts $  normaliseMixedAmountPreservingFirstPrice m --- | Compact labelled trace of a mixed amount.+-- | Compact labelled trace of a mixed amount, for debugging. ltraceamount :: String -> MixedAmount -> MixedAmount-ltraceamount s = tracewith (((s ++ ": ") ++).showMixedAmount)+ltraceamount s = traceWith (((s ++ ": ") ++).showMixedAmount)  -- | Set the display precision in the amount's commodities. setMixedAmountPrecision :: Int -> MixedAmount -> MixedAmount

@@ -31,6 +31,7 @@   parsedateM,   parsedate,   showDate,+  showDateSpan,   elapsedSeconds,   prevday,   parsePeriodExpr,@@ -39,6 +40,9 @@   failIfInvalidYear,   datesepchar,   datesepchars,+  spanStart,+  spanEnd,+  spansSpan,   spanIntersect,   spansIntersect,   spanUnion,@@ -64,7 +68,7 @@ import Data.Time.Calendar.OrdinalDate import Data.Time.Clock import Data.Time.LocalTime-import Safe (readMay)+import Safe (headMay, lastMay, readMay) import System.Locale (defaultTimeLocale) import Test.HUnit import Text.ParserCombinators.Parsec@@ -77,6 +81,15 @@ showDate :: Day -> String showDate = formatTime defaultTimeLocale "%C%y/%m/%d" +showDateSpan (DateSpan from to) =+  concat+    [maybe "" showdate from+    ,"-"+    ,maybe "" (showdate . prevday) to+    ]+  where+    showdate = formatTime defaultTimeLocale "%C%y/%m/%d"+ -- | Get the current local date. getCurrentDay :: IO Day getCurrentDay = do@@ -98,6 +111,16 @@ elapsedSeconds :: Fractional a => UTCTime -> UTCTime -> a elapsedSeconds t1 = realToFrac . diffUTCTime t1 +spanStart :: DateSpan -> Maybe Day+spanStart (DateSpan d _) = d++spanEnd :: DateSpan -> Maybe Day+spanEnd (DateSpan _ d) = d++-- | 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. splitSpan :: Interval -> DateSpan -> [DateSpan] splitSpan _ (DateSpan Nothing Nothing) = [DateSpan Nothing Nothing]@@ -144,7 +167,9 @@ 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.+-- 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@@ -598,19 +623,27 @@   optional (string "from" >> many spacenonewline)   b <- smartdate   many spacenonewline-  optional (string "to" >> many spacenonewline)+  optional (choice [string "to", string "-"] >> many spacenonewline)   e <- smartdate   return $ DateSpan (Just $ fixSmartDate rdate b) (Just $ fixSmartDate rdate e)  fromdatespan :: Day -> GenParser Char st DateSpan fromdatespan rdate = do-  string "from" >> many spacenonewline-  b <- smartdate+  b <- choice [+    do+      string "from" >> many spacenonewline+      smartdate+    ,+    do+      d <- smartdate+      string "-"+      return d+    ]   return $ DateSpan (Just $ fixSmartDate rdate b) Nothing  todatespan :: Day -> GenParser Char st DateSpan todatespan rdate = do-  string "to" >> many spacenonewline+  choice [string "to", string "-"] >> many spacenonewline   e <- smartdate   return $ DateSpan Nothing (Just $ fixSmartDate rdate e) 

@@ -76,7 +76,21 @@   instance Show Journal where-    show j = printf "Journal %s with %d transactions, %d accounts: %s, commodity styles: %s"+  show j+    | debugLevel < 3 = printf "Journal %s with %d transactions, %d accounts"+             (journalFilePath j)+             (length (jtxns j) ++              length (jmodifiertxns j) ++              length (jperiodictxns j))+             (length accounts)+    | debugLevel < 6 = printf "Journal %s with %d transactions, %d accounts: %s"+             (journalFilePath j)+             (length (jtxns j) ++              length (jmodifiertxns j) ++              length (jperiodictxns j))+             (length accounts)+             (show accounts)+    | otherwise = printf "Journal %s with %d transactions, %d accounts: %s, commodity styles: %s"              (journalFilePath j)              (length (jtxns j) +               length (jmodifiertxns j) +

@@ -106,20 +106,18 @@           pstatus=True,           paccount="a",           pamount=Mixed [usd 1, hrs 2],-          pcomment="pcomment1\npcomment2\n",+          pcomment="\npcomment2\n",           ptype=RegularPosting,           ptags=[("ptag1","val1"),("ptag2","val2")]           }        ]       }       `gives` unlines [-      "2012/05/14=2012/05/15 (code) desc",-      "    ;tcomment1",-      "    ;tcomment2",+      "2012/05/14=2012/05/15 (code) desc    ; tcomment1",+      "    ; tcomment2",       "                $1.00",       "    * a          2.0h",-      "    ;pcomment1",-      "    ;pcomment2",+      "    ; pcomment2",       ""       ]  ]@@ -128,30 +126,39 @@ showTransaction' :: Bool -> Transaction -> String showTransaction' elide t =     unlines $ [descriptionline]-              ++ multilinecomment+              ++ newlinecomments               ++ (postingsAsLines elide t (tpostings t))               ++ [""]     where-      descriptionline = rstrip $ concat [date, status, code, desc, inlinecomment]+      descriptionline = rstrip $ concat [date, status, code, desc, samelinecomment]       date = showdate (tdate t) ++ maybe "" showedate (tdate2 t)       showdate = printf "%-10s" . showDate       showedate = printf "=%s" . showdate       status = if tstatus t then " *" else ""       code = if length (tcode t) > 0 then printf " (%s)" $ tcode t else ""       desc = if null d then "" else " " ++ d where d = tdescription t-      (inlinecomment, multilinecomment) = commentLines $ tcomment t+      (samelinecomment, newlinecomments) =+        case renderCommentLines (tcomment t) of []   -> ("",[])+                                                c:cs -> (c,cs) --- Render a transaction or posting's comment as indented, semicolon-prefixed comment lines ---- an inline comment (when it's a single line) or multiple lines.-commentLines :: String -> (String, [String])-commentLines s-    | null s = ("", [])-    | length ls == 1 = (prefix $ head ls, [])-    | otherwise = ("", (prefix $ head ls):(map prefix $ tail ls))+-- Render a transaction or posting's comment as indented, semicolon-prefixed comment lines.+renderCommentLines :: String -> [String]+renderCommentLines s  = case lines s of ("":ls) -> "":map commentprefix ls+                                        ls      -> map commentprefix ls     where-      ls = lines s-      prefix = indent . (";"++)+      commentprefix = indent . ("; "++) +-- -- Render a transaction or posting's comment as semicolon-prefixed comment lines -+-- -- an inline (same-line) comment if it's a single line, otherwise multiple indented lines.+-- commentLines' :: String -> (String, [String])+-- commentLines' s+--     | null s = ("", [])+--     | length ls == 1 = (prefix $ head ls, [])+--     | otherwise = ("", (prefix $ head ls):(map prefix $ tail ls))+--     where+--       ls = lines s+--       prefix = indent . (";"++)+ postingsAsLines :: Bool -> Transaction -> [Posting] -> [String] postingsAsLines elide t ps     | elide && length ps > 1 && isTransactionBalanced Nothing t -- imprecise balanced check@@ -161,11 +168,13 @@ postingAsLines :: Bool -> [Posting] -> Posting -> [String] postingAsLines elideamount ps p =     postinglines-    ++ multilinecomment+    ++ newlinecomments   where-    postinglines = map rstrip $ lines $ concatTopPadded [showacct p, "  ", amount, inlinecomment]+    postinglines = map rstrip $ lines $ concatTopPadded [showacct p, "  ", amount, samelinecomment]     amount = if elideamount then "" else showamt (pamount p)-    (inlinecomment, multilinecomment) = commentLines $ pcomment p+    (samelinecomment, newlinecomments) =+      case renderCommentLines (pcomment p) of []   -> ("",[])+                                              c:cs -> (c,cs)     showacct p =       indent $ showstatus p ++ printf (printf "%%-%ds" w) (showAccountName Nothing (ptype p) (paccount p))         where@@ -188,10 +197,9 @@       }      `gives` [       "                $1.00",-      "    * a          2.0h",-      "    ;pcomment1",-      "    ;pcomment2",-      "    ;  tag3: val3  "+      "    * a          2.0h    ; pcomment1",+      "    ; pcomment2",+      "    ;   tag3: val3  "       ]  ] 

@@ -1,4 +1,4 @@-{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveDataTypeable, StandaloneDeriving #-} {-|  Most data types are defined here to avoid import cycles.@@ -20,28 +20,28 @@ module Hledger.Data.Types where import Control.Monad.Error (ErrorT)+import Data.Data import qualified Data.Map as M import Data.Time.Calendar import Data.Time.LocalTime-import Data.Typeable-import System.Time (ClockTime)+import System.Time (ClockTime(..))   type SmartDate = (String,String,String)  data WhichDate = PrimaryDate | SecondaryDate deriving (Eq,Show) -data DateSpan = DateSpan (Maybe Day) (Maybe Day) deriving (Eq,Show,Ord)+data DateSpan = DateSpan (Maybe Day) (Maybe Day) deriving (Eq,Show,Ord,Data,Typeable)  data Interval = NoInterval               | Days Int | Weeks Int | Months Int | Quarters Int | Years Int               | DayOfMonth Int | DayOfWeek Int               -- WeekOfYear Int | MonthOfYear Int | QuarterOfYear Int-                deriving (Eq,Show,Ord)+                deriving (Eq,Show,Ord,Data,Typeable)  type AccountName = String -data Side = L | R deriving (Eq,Show,Read,Ord)+data Side = L | R deriving (Eq,Show,Read,Ord,Typeable,Data)  type Commodity = String       @@ -49,7 +49,7 @@  -- | An amount's price (none, per unit, or total) in another commodity. -- Note the price should be a positive number, although this is not enforced.-data Price = NoPrice | UnitPrice Amount | TotalPrice Amount deriving (Eq,Ord)+data Price = NoPrice | UnitPrice Amount | TotalPrice Amount deriving (Eq,Ord,Typeable,Data)  -- | Display style for an amount. data AmountStyle = AmountStyle {@@ -59,21 +59,21 @@       asdecimalpoint :: Char,        -- ^ character used as decimal point       asseparator :: Char,           -- ^ character used for separating digit groups (eg thousands)       asseparatorpositions :: [Int]  -- ^ positions of digit group separators, counting leftward from decimal point-} deriving (Eq,Ord,Show,Read)+} deriving (Eq,Ord,Read,Show,Typeable,Data)  data Amount = Amount {       acommodity :: Commodity,       aquantity :: Quantity,       aprice :: Price,                -- ^ the (fixed) price for this amount, if any       astyle :: AmountStyle-    } deriving (Eq,Ord)+    } deriving (Eq,Ord,Typeable,Data) -newtype MixedAmount = Mixed [Amount] deriving (Eq,Ord)+newtype MixedAmount = Mixed [Amount] deriving (Eq,Ord,Typeable,Data)  data PostingType = RegularPosting | VirtualPosting | BalancedVirtualPosting-                   deriving (Eq,Show)+                   deriving (Eq,Show,Typeable,Data) -type Tag = (String, String)+type Tag = (String, String)  -- ^ A tag name and (possibly empty) value.  data Posting = Posting {       pdate :: Maybe Day,  -- ^ this posting's date, if different from the transaction's@@ -81,13 +81,13 @@       pstatus :: Bool,       paccount :: AccountName,       pamount :: MixedAmount,-      pcomment :: String, -- ^ this posting's non-tag comment lines, as a single non-indented string+      pcomment :: String, -- ^ this posting's comment lines, as a single non-indented multi-line string       ptype :: PostingType,-      ptags :: [Tag],+      ptags :: [Tag], -- ^ tag names and values, extracted from the comment       pbalanceassertion :: Maybe MixedAmount,  -- ^ optional: the expected balance in the account after this posting       ptransaction :: Maybe Transaction    -- ^ this posting's parent transaction (co-recursive types).                                            -- Tying this knot gets tedious, Maybe makes it easier/optional.-    }+    } deriving (Typeable,Data)  -- The equality test for postings ignores the parent transaction's -- identity, to avoid infinite loops.@@ -100,35 +100,35 @@       tstatus :: Bool,  -- XXX tcleared ?       tcode :: String,       tdescription :: String,-      tcomment :: String, -- ^ this transaction's non-tag comment lines, as a single non-indented string-      ttags :: [Tag],+      tcomment :: String, -- ^ this transaction's comment lines, as a single non-indented multi-line string+      ttags :: [Tag], -- ^ tag names and values, extracted from the comment       tpostings :: [Posting],            -- ^ this transaction's postings-      tpreceding_comment_lines :: String-    } deriving (Eq)+      tpreceding_comment_lines :: String -- ^ any comment lines immediately preceding this transaction+    } deriving (Eq,Typeable,Data)  data ModifierTransaction = ModifierTransaction {       mtvalueexpr :: String,       mtpostings :: [Posting]-    } deriving (Eq)+    } deriving (Eq,Typeable,Data)  data PeriodicTransaction = PeriodicTransaction {       ptperiodicexpr :: String,       ptpostings :: [Posting]-    } deriving (Eq)+    } deriving (Eq,Typeable,Data) -data TimeLogCode = SetBalance | SetRequiredHours | In | Out | FinalOut deriving (Eq,Ord) +data TimeLogCode = SetBalance | SetRequiredHours | In | Out | FinalOut deriving (Eq,Ord,Typeable,Data)  data TimeLogEntry = TimeLogEntry {       tlcode :: TimeLogCode,       tldatetime :: LocalTime,       tlcomment :: String-    } deriving (Eq,Ord)+    } deriving (Eq,Ord,Typeable,Data)  data HistoricalPrice = HistoricalPrice {       hdate :: Day,       hcommodity :: Commodity,       hamount :: Amount-    } deriving (Eq) -- & Show (in Amount.hs)+    } deriving (Eq,Typeable,Data) -- & Show (in Amount.hs)  type Year = Integer @@ -143,8 +143,11 @@                                         --   specified with "account" directive(s). Concatenated, these                                         --   are the account prefix prepended to parsed account names.     , ctxAliases   :: ![(AccountName,AccountName)] -- ^ the current list of account name aliases in effect-    } deriving (Read, Show, Eq)+    } deriving (Read, Show, Eq, Data, Typeable) +deriving instance Data (ClockTime)+deriving instance Typeable (ClockTime)+ data Journal = Journal {       jmodifiertxns :: [ModifierTransaction],       jperiodictxns :: [PeriodicTransaction],@@ -159,7 +162,7 @@                                             -- order encountered (XXX reversed, cf journalAddFile).       filereadtime :: ClockTime,            -- ^ when this journal was last read from its file(s)       jcommoditystyles :: M.Map Commodity AmountStyle  -- ^ how to display amounts in each commodity-    } deriving (Eq, Typeable)+    } deriving (Eq, Typeable, Data)  -- | A JournalUpdate is some transformation of a Journal. It can do I/O or -- raise an error.

@@ -1,3 +1,4 @@+{-# LANGUAGE DeriveDataTypeable #-} {-|  A general query system for matching things (accounts, postings,@@ -32,6 +33,7 @@   tests_Hledger_Query ) where+import Data.Data import Data.Either import Data.List import Data.Maybe@@ -43,7 +45,7 @@ import Hledger.Utils import Hledger.Data.Types import Hledger.Data.AccountName-import Hledger.Data.Amount (nullamt)+import Hledger.Data.Amount (amount, usd) import Hledger.Data.Dates import Hledger.Data.Posting import Hledger.Data.Transaction@@ -64,19 +66,40 @@            | 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+           | 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 ?            | Depth Int        -- ^ match if account depth is less than or equal to this value            | Tag String (Maybe String)  -- ^ match if a tag with this exact name, and with value                                         -- matching the regexp if provided, exists-    deriving (Show, Eq)+    deriving (Eq,Data,Typeable) +-- custom Show implementation to show strings more accurately, eg for debugging regexps+instance Show Query where+  show Any           = "Any"+  show None          = "None"+  show (Not q)       = "Not ("   ++ show q  ++ ")"+  show (Or qs)       = "Or ("    ++ show qs ++ ")"+  show (And qs)      = "And ("   ++ show qs ++ ")"+  show (Code r)      = "Code "   ++ show r+  show (Desc r)      = "Desc "   ++ show r+  show (Acct r)      = "Acct "   ++ show r+  show (Date ds)     = "Date ("  ++ show ds ++ ")"+  show (Date2 ds)    = "Date2 (" ++ show ds ++ ")"+  show (Status b)    = "Status " ++ show b+  show (Real b)      = "Real "   ++ show b+  show (Amt ord qty) = "Amt "    ++ show ord ++ " " ++ show qty+  show (Sym r)       = "Sym "    ++ show r+  show (Empty b)     = "Empty "  ++ show b+  show (Depth n)     = "Depth "  ++ show n+  show (Tag s ms)    = "Tag "    ++ show s ++ " (" ++ show ms ++ ")"+ -- | A query option changes a query's/report's behaviour and output in some way. data QueryOpt = QueryOptInAcctOnly AccountName  -- ^ show an account register focussed on this account               | QueryOptInAcct AccountName      -- ^ as above but include sub-accounts in the account register            -- | QueryOptCostBasis      -- ^ show amounts converted to cost where possible            -- | QueryOptDate2  -- ^ show secondary dates instead of primary dates-    deriving (Show, Eq)+    deriving (Show, Eq, Data, Typeable)  -- parsing @@ -174,12 +197,14 @@ prefixes = map (++":") [      "inacctonly"     ,"inacct"+    ,"amt"     ,"code"     ,"desc"     ,"acct"     ,"date"     ,"edate"     ,"status"+    ,"sym"     ,"real"     ,"empty"     ,"depth"@@ -216,9 +241,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) = parseAmountTest s+parseQueryTerm _ ('a':'m':'t':':':s) = Left $ Amt op q where (op, 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 _ ('t':'a':'g':':':s) = Left $ Tag n v where (n,v) = parseTag s parseQueryTerm _ "" = Left $ Any parseQueryTerm d s = parseQueryTerm d $ defaultprefix++":"++s@@ -244,21 +270,23 @@  ]  -- can fail-parseAmountTest :: String -> (Ordering, Quantity)-parseAmountTest s =+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')-    _      -> err-  where err = error' $ "could not parse as operator followed by numeric quantity: "++s+    s'     -> (EQ, readDef err s')+  where+    err = error' $ "could not parse as '=', '<', or '>' (optional) followed by a numeric quantity: " ++ s -tests_parseAmountTest = [-  "parseAmountTest" ~: do-    let s `gives` r = parseAmountTest s `is` r+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)   ] @@ -509,6 +537,7 @@ -- matchesPosting (Empty False) Posting{pamount=a} = True -- matchesPosting (Empty True) Posting{pamount=a} = isZeroMixedAmount a matchesPosting (Empty _) _ = True+matchesPosting (Sym r) Posting{pamount=Mixed as} = any (regexMatchesCI $ "^" ++ r ++ "$") $ map acommodity as matchesPosting (Tag n Nothing) p = isJust $ lookupTagByName n $ postingAllTags p matchesPosting (Tag n (Just v)) p = isJust $ lookupTagByNameAndValue (n,v) $ postingAllTags p -- matchesPosting _ _ = False@@ -516,7 +545,7 @@ -- | 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 [nullamt])+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@@ -537,16 +566,20 @@     assertBool "real:1 on real posting" $ (Real True) `matchesPosting` nullposting{ptype=RegularPosting}     assertBool "real:1 on virtual posting fails" $ not $ (Real True) `matchesPosting` nullposting{ptype=VirtualPosting}     assertBool "real:1 on balanced virtual posting fails" $ not $ (Real True) `matchesPosting` nullposting{ptype=BalancedVirtualPosting}-    assertBool "" $ (Acct "'b") `matchesPosting` nullposting{paccount="'b"}-    assertBool "" $ not $ (Tag "a" (Just "r$")) `matchesPosting` nullposting-    assertBool "" $ (Tag "foo" Nothing) `matchesPosting` nullposting{ptags=[("foo","")]}-    assertBool "" $ (Tag "foo" Nothing) `matchesPosting` nullposting{ptags=[("foo","baz")]}-    assertBool "" $ (Tag "foo" (Just "a")) `matchesPosting` nullposting{ptags=[("foo","bar")]}-    assertBool "" $ not $ (Tag "foo" (Just "a$")) `matchesPosting` nullposting{ptags=[("foo","bar")]}-    assertBool "" $ not $ (Tag " foo " (Just "a")) `matchesPosting` nullposting{ptags=[("foo","bar")]}-    assertBool "" $ not $ (Tag "foo foo" (Just " ar ba ")) `matchesPosting` nullposting{ptags=[("foo foo","bar bar")]}+    assertBool "a" $ (Acct "'b") `matchesPosting` nullposting{paccount="'b"}+    assertBool "b" $ not $ (Tag "a" (Just "r$")) `matchesPosting` nullposting+    assertBool "c" $ (Tag "foo" Nothing) `matchesPosting` nullposting{ptags=[("foo","")]}+    assertBool "d" $ (Tag "foo" Nothing) `matchesPosting` nullposting{ptags=[("foo","baz")]}+    assertBool "e" $ (Tag "foo" (Just "a")) `matchesPosting` nullposting{ptags=[("foo","bar")]}+    assertBool "f" $ not $ (Tag "foo" (Just "a$")) `matchesPosting` nullposting{ptags=[("foo","bar")]}+    assertBool "g" $ not $ (Tag " foo " (Just "a")) `matchesPosting` nullposting{ptags=[("foo","bar")]}+    assertBool "h" $ not $ (Tag "foo foo" (Just " ar ba ")) `matchesPosting` nullposting{ptags=[("foo foo","bar bar")]}     -- a tag match on a posting also sees inherited tags-    assertBool "" $ (Tag "txntag" Nothing) `matchesPosting` nullposting{ptransaction=Just nulltransaction{ttags=[("txntag","")]}}+    assertBool "i" $ (Tag "txntag" Nothing) `matchesPosting` nullposting{ptransaction=Just nulltransaction{ttags=[("txntag","")]}}+    assertBool "j" $ not $ (Sym "$") `matchesPosting` nullposting{pamount=Mixed [usd 1]} -- becomes "^$$", ie testing for null symbol+    assertBool "k" $ (Sym "\\$") `matchesPosting` nullposting{pamount=Mixed [usd 1]} -- have to quote $ for regexpr+    assertBool "l" $ (Sym "shekels") `matchesPosting` nullposting{pamount=Mixed [amount{acommodity="shekels"}]}+    assertBool "m" $ not $ (Sym "shek") `matchesPosting` nullposting{pamount=Mixed [amount{acommodity="shekels"}]}  ]  -- | Does the match expression match this transaction ?@@ -566,6 +599,7 @@ matchesTransaction q@(Amt _ _) t = any (q `matchesPosting`) $ tpostings t matchesTransaction (Empty _) _ = True matchesTransaction (Depth d) t = any (Depth d `matchesPosting`) $ tpostings t+matchesTransaction q@(Sym _) t = any (q `matchesPosting`) $ tpostings t matchesTransaction (Tag n Nothing) t = isJust $ lookupTagByName n $ transactionAllTags t matchesTransaction (Tag n (Just v)) t = isJust $ lookupTagByNameAndValue (n,v) $ transactionAllTags t @@ -603,7 +637,7 @@  ++ tests_words''  ++ tests_filterQuery  ++ tests_parseQueryTerm- ++ tests_parseAmountTest+ ++ tests_parseAmountQueryTerm  ++ tests_parseQuery  ++ tests_matchesAccount  ++ tests_matchesPosting

@@ -22,7 +22,7 @@ import Control.Monad import Control.Monad.Error -- import Test.HUnit-import Data.Char (toLower, isDigit)+import Data.Char (toLower, isDigit, isSpace) import Data.List import Data.Maybe import Data.Ord@@ -85,7 +85,7 @@    -- parse csv   records <- (either throwerr id . validateCsv) `fmap` parseCsv csvfile csvdata-  dbg 1 $ ppShow $ take 3 records+  return $ dbg "" $ take 3 records    -- identify header lines   -- let (headerlines, datalines) = identifyHeaderLines records@@ -98,7 +98,7 @@    then hPrintf stderr "creating default conversion rules file %s, edit this file for better results\n" rulesfile    else hPrintf stderr "using conversion rules file %s\n" rulesfile   rules <- either (throwerr.show) id `fmap` parseRulesFile rulesfile-  dbg 1 $ ppShow rules+  return $ dbg "" rules    -- apply skip directive   let headerlines = maybe 0 oneorerror $ getDirective "skip" rules@@ -319,7 +319,7 @@  parseRulesFile :: FilePath -> IO (Either ParseError CsvRules) parseRulesFile f = do-  s <- readFile' f+  s <- readFile' f >>= expandIncludes   let rules = parseCsvRules f s   return $ case rules of              Left e -> Left e@@ -328,6 +328,19 @@                           Right r -> Right r   where     toParseError s = newErrorMessage (Message s) (initialPos "")++-- | Pre-parse csv rules to interpolate included files, recursively.+-- This is a cheap hack to avoid rewriting the existing parser.+expandIncludes :: String -> IO String+expandIncludes s = do+  let (ls,rest) = break (isPrefixOf "include") $ lines s+  case rest of+    [] -> return $ unlines ls+    (('i':'n':'c':'l':'u':'d':'e':f):ls') -> do+      let f' = dropWhile isSpace f+      included <- readFile f' >>= expandIncludes+      return $ unlines [unlines ls, included, unlines ls']+    ls' -> return $ unlines $ ls ++ ls'   -- should never get here  parseCsvRules :: FilePath -> String -> Either ParseError CsvRules -- parseCsvRules rulesfile s = runParser csvrulesfile nullrules{baseAccount=takeBaseName rulesfile} rulesfile s

@@ -817,19 +817,15 @@ followingcomment :: GenParser Char JournalContext String followingcomment =   -- ptrace "followingcomment"-  (do first <- many spacenonewline >> followingcommentline-      rest <- many (try (many1 spacenonewline >> followingcommentline))-      return $ unlines $ first:rest-  ) <|>-  do-    many spacenonewline >> newline-    rest <- many (try (many1 spacenonewline >> followingcommentline))    -    return $ unlines rest+  do samelinecomment <- many spacenonewline >> (try commentline <|> (newline >> return ""))+     newlinecomments <- many (try (many1 spacenonewline >> commentline))+     return $ unlines $ samelinecomment:newlinecomments -followingcommentline :: GenParser Char JournalContext String-followingcommentline = do-  -- ptrace "followingcommentline"+commentline :: GenParser Char JournalContext String+commentline = do+  -- ptrace "commentline"   char ';'+  many spacenonewline   l <- anyChar `manyTill` eolof   optional newline   return l

@@ -1,16 +1,18 @@-{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE RecordWildCards, DeriveDataTypeable, FlexibleInstances #-} {-|  Generate several common kinds of report from a journal, as \"*Report\" - simple intermediate data structures intended to be easily rendered as text, html, json, csv etc. by hledger commands, hamlet templates,-javascript, or whatever. This is under Hledger.Cli since it depends-on the command-line options, should move to hledger-lib later.+javascript, or whatever.  -}  module Hledger.Reports (+  -- * Report options+  -- |    ReportOpts(..),+  BalanceType(..),   DisplayExp,   FormatStr,   defreportopts,@@ -21,16 +23,20 @@   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,@@ -39,12 +45,25 @@   transactionsReportByCommodity,   journalTransactionsReport,   accountTransactionsReport,-  -- * Accounts report-  AccountsReport,-  AccountsReportItem,-  accountsReport,-  -- * Other "reports"++  -- * 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 )@@ -68,6 +87,9 @@ 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.@@ -80,10 +102,11 @@     ,cost_           :: Bool     ,depth_          :: Maybe Int     ,display_        :: Maybe DisplayExp-    ,date2_      :: Bool+    ,date2_          :: Bool     ,empty_          :: Bool     ,no_elide_       :: Bool     ,real_           :: Bool+    ,balancetype_    :: BalanceType -- for balance command     ,flat_           :: Bool -- for balance command     ,drop_           :: Int  -- "     ,no_total_       :: Bool -- "@@ -94,12 +117,20 @@     ,yearly_         :: Bool     ,format_         :: Maybe FormatStr     ,related_        :: Bool+    ,average_        :: Bool     ,query_          :: String -- all arguments, as a string- } deriving (Show)+ } 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@@ -124,6 +155,8 @@     def     def     def+    def+    def  instance Default ReportOpts where def = defreportopts @@ -224,8 +257,8 @@ -------------------------------------------------------------------------------  -- | A journal entries report is a list of whole transactions as--- originally entered in the journal (mostly). Used by eg hledger's print--- command and hledger-web's journal entries view.+-- 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 @@ -248,20 +281,21 @@  -- | 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+                          ,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 (+))+                          (totallabel, postingsReportItems ps nullposting wd depth startbal runningcalcfn 1)     where       ps | interval == NoInterval = displayableps          | otherwise              = summarisePostingsByInterval interval depth empty reportspan displayableps@@ -273,8 +307,8 @@                                         $ dbg "ps3" $ (if related_ opts then concatMap relatedPostings else id)                                         $ dbg "ps2" $ filter (q' `matchesPosting`)                                         $ dbg "ps1" $ journalPostings j'-      dbg :: Show a => String -> a -> a-      dbg = flip const+      -- enable to debug just this function+      -- dbg :: Show a => String -> a -> a       -- dbg = lstrace        empty = queryEmpty q@@ -293,14 +327,16 @@       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 -> (MixedAmount -> MixedAmount -> MixedAmount) -> [PostingsReportItem]-postingsReportItems [] _ _ _ _ _ = []-postingsReportItems (p:ps) pprev wd d b sumfn = i:(postingsReportItems ps p wd d b' sumfn)+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@@ -309,7 +345,7 @@       isdifferentdate = case wd of PrimaryDate   -> postingDate p  /= postingDate pprev                                    SecondaryDate -> postingDate2 p /= postingDate2 pprev       p' = p{paccount=clipAccountName d $ paccount p}-      b' = b `sumfn` pamount 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@@ -425,6 +461,8 @@ -- 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                           )@@ -480,11 +518,9 @@ filterMixedAmountByCommodity :: Commodity -> MixedAmount -> MixedAmount filterMixedAmountByCommodity c (Mixed as) = Mixed $ filter ((==c). acommodity) as --- | Select transactions from the whole journal for a transactions report,--- with no \"current\" account. The end result is similar to--- "postingsReport" except it uses queries and transaction-based report--- items and the items are most recent first. Used by eg hledger-web's--- journal view.+-- | 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@@ -494,7 +530,7 @@  ------------------------------------------------------------------------------- --- | Select transactions within one or more \"current\" accounts, and make a+-- | 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).@@ -505,9 +541,9 @@ --    shows the accurate historical running balance for the current account(s). --    Otherwise it shows a running total starting at 0. ----- Currently, reporting intervals are not supported, and report items are--- most recent first. Used by eg hledger-web's account register view.---+-- 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@@ -577,21 +613,28 @@  ------------------------------------------------------------------------------- --- | An accounts report is a list of account names (full and short--- variants) with their balances, appropriate indentation for rendering as--- a hierarchy, and grand total.-type AccountsReport = ([AccountsReportItem] -- line items, one per account+-- | 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                       )-type AccountsReportItem = (AccountName  -- full account name-                          ,AccountName  -- short account name for display (the leaf name, prefixed by any boring parents immediately above)-                          ,Int          -- how many steps to indent this account (0 with --flat, otherwise the 0-based account depth excluding boring parents)-                          ,MixedAmount) -- account balance, includes subs unless --flat is present+-- | * 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.-accountsReport :: ReportOpts -> Query -> Journal -> AccountsReport-accountsReport opts q j = (items, total)+balanceReport :: ReportOpts -> Query -> Journal -> BalanceReport+balanceReport opts q j = (items, total)     where       l =  ledgerFromJournal q $ journalSelectingAmountFromOpts opts j       accts = clipAccounts (queryDepth q) $ ledgerRootAccount l@@ -605,8 +648,9 @@                        | otherwise   = fromMaybe nullacct . pruneAccounts (isZeroMixedAmount.aibalance)             markboring | no_elide_ opts = id                        | otherwise      = markBoringParentAccounts-      items = map (accountsReportItem opts) accts'+      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@@ -617,8 +661,8 @@     mark a | length (asubs a) == 1 && isZeroMixedAmount (aebalance a) = a{aboring=True}            | otherwise = a -accountsReportItem :: ReportOpts -> Account -> AccountsReportItem-accountsReportItem opts a@Account{aname=name, aibalance=ibal}+balanceReportItem :: ReportOpts -> Account -> BalanceReportItem+balanceReportItem opts a@Account{aname=name, aibalance=ibal}   | flat_ opts = (name, name,       0,      ibal)   | otherwise  = (name, elidedname, indent, ibal)   where@@ -630,6 +674,171 @@  ------------------------------------------------------------------------------- +-- | 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@@ -811,20 +1020,20 @@ -}  ] -tests_accountsReport =+tests_balanceReport =   let (opts,journal) `gives` r = do          let (eitems, etotal) = r-             (aitems, atotal) = accountsReport opts (queryFromOpts nulldate opts) journal+             (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 [ -   "accountsReport with no args on null journal" ~: do+   "balanceReport with no args on null journal" ~: do    (defreportopts, nulljournal) `gives` ([], Mixed [nullamt]) -  ,"accountsReport with no args on sample journal" ~: do+  ,"balanceReport with no args on sample journal" ~: do    (defreportopts, samplejournal) `gives`     ([       ("assets","assets",0, mamountp' "$-1.00")@@ -840,7 +1049,7 @@      ],      Mixed [nullamt]) -  ,"accountsReport with --depth=N" ~: do+  ,"balanceReport with --depth=N" ~: do    (defreportopts{depth_=Just 1}, samplejournal) `gives`     ([       ("assets",      "assets",      0, mamountp' "$-1.00")@@ -850,7 +1059,7 @@      ],      Mixed [nullamt]) -  ,"accountsReport with depth:N" ~: do+  ,"balanceReport with depth:N" ~: do    (defreportopts{query_="depth:1"}, samplejournal) `gives`     ([       ("assets",      "assets",      0, mamountp' "$-1.00")@@ -860,7 +1069,7 @@      ],      Mixed [nullamt]) -  ,"accountsReport with a date or secondary date span" ~: do+  ,"balanceReport with a date or secondary date span" ~: do    (defreportopts{query_="date:'in 2009'"}, samplejournal2) `gives`     ([],      Mixed [nullamt])@@ -871,7 +1080,7 @@      ],      Mixed [nullamt]) -  ,"accountsReport with desc:" ~: do+  ,"balanceReport with desc:" ~: do    (defreportopts{query_="desc:income"}, samplejournal) `gives`     ([       ("assets:bank:checking","assets:bank:checking",0,mamountp' "$1.00")@@ -879,7 +1088,7 @@      ],      Mixed [nullamt]) -  ,"accountsReport with not:desc:" ~: do+  ,"balanceReport with not:desc:" ~: do    (defreportopts{query_="not:desc:income"}, samplejournal) `gives`     ([       ("assets","assets",0, mamountp' "$-2.00")@@ -1003,7 +1212,7 @@               ,"  c:d                   "               ]) >>= either error' return        let j' = journalCanonicaliseAmounts $ journalConvertAmountsToCost j -- enable cost basis adjustment-       accountsReportAsText defreportopts (accountsReport defreportopts Any j') `is`+       balanceReportAsText defreportopts (balanceReport defreportopts Any j') `is`          ["                $500  a:b"          ,"               $-500  c:d"          ,"--------------------"@@ -1048,7 +1257,7 @@  ++ tests_summarisePostingsByInterval  ++ tests_postingsReport  -- ++ tests_isInterestingIndented- ++ tests_accountsReport+ ++ tests_balanceReport  ++ [   -- ,"summarisePostingsInDateSpan" ~: do   --   let gives (b,e,depth,showempty,ps) =

@@ -21,6 +21,7 @@                           ---- all of this one:                           module Hledger.Utils,                           Debug.Trace.trace,+                          module Data.PPrint,                           -- module Hledger.Utils.UTF8IOCompat                           SystemString,fromSystemString,toSystemString,error',userError',                           ppShow@@ -31,16 +32,22 @@ import Control.Monad.Error (MonadIO) import Control.Monad.IO.Class (liftIO) import Data.Char+import Data.Data import Data.List import qualified Data.Map as M import Data.Maybe+import Data.PPrint import Data.Time.Clock import Data.Time.LocalTime import Data.Tree import Debug.Trace+import Safe (readDef) import System.Directory (getHomeDirectory)+import System.Environment (getArgs)+import System.Exit import System.FilePath((</>), isRelative) import System.IO+import System.IO.Unsafe (unsafePerformIO) import Test.HUnit import Text.ParserCombinators.Parsec import Text.Printf@@ -339,25 +346,25 @@ -- http://hackage.haskell.org/packages/archive/htrace/0.1/doc/html/Debug-HTrace.html -- http://hackage.haskell.org/packages/archive/traced/2009.7.20/doc/html/Debug-Traced.html --- | trace (print on stdout at runtime) a showable expression+-- | Trace (print on stdout at runtime) a showable value. -- (for easily tracing in the middle of a complex expression) strace :: Show a => a -> a strace a = trace (show a) a --- | labelled trace showable - like strace, with a label prepended-lstrace :: Show a => String -> a -> a-lstrace l a = trace (l ++ ": " ++ show a) a+-- | Labelled trace - like strace, with a label prepended.+ltrace :: Show a => String -> a -> a+ltrace l a = trace (l ++ ": " ++ show a) a --- | monadic trace - like strace, but works as a standalone line in a monad+-- | Monadic trace - like strace, but works as a standalone line in a monad. mtrace :: (Monad m, Show a) => a -> m a mtrace a = strace a `seq` return a --- | trace an expression using a custom show function-tracewith :: (a -> String) -> a -> a-tracewith f e = trace (f e) e+-- | Custom trace - like strace, with a custom show function.+traceWith :: (a -> String) -> a -> a+traceWith f e = trace (f e) e  -- | Parsec trace - show the current parsec position and next input,--- and the provided string if it's non-null.+-- and the provided label if it's non-null. ptrace :: String -> GenParser Char st () ptrace msg = do   pos <- getPosition@@ -369,17 +376,72 @@   where     peeklength = 30 -debugLevel = 0+-- | Global debug level, which controls the verbosity of debug output+-- on the console. The default is 0 meaning no debug output. The+-- @--debug@ command line flag sets it to 1, or @--debug=N@ sets it to+-- a higher value (note: not @--debug N@ for some reason).  This uses+-- unsafePerformIO and can be accessed from anywhere and before normal+-- command-line processing. After command-line processing, it is also+-- available as the @debug_@ field of 'Hledger.Cli.Options.CliOpts'.+debugLevel :: Int+debugLevel = case snd $ break (=="--debug") args of+               "--debug":[]  -> 1+               "--debug":n:_ -> readDef 1 n+               _             ->+                 case take 1 $ filter ("--debug" `isPrefixOf`) args of+                   ['-':'-':'d':'e':'b':'u':'g':'=':v] -> readDef 1 v+                   _                                   -> 0 --- | Print a message to the console if the global debugLevel is--- greater than the level we are called with.-dbg :: Monad m => Float -> String -> m ()-dbg  level msg = when (level <= debugLevel) $ trace msg $ return ()+    where+      args = unsafePerformIO getArgs --- | Print a message and parsec position info to the console if the--- global debugLevel is greater than the level we are called with.--- pdbg :: GenParser m => Float -> String -> m ()+-- | 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++-- | Print a showable value to the console, with a message, if the+-- debug level is at or above the specified level (uses+-- unsafePerformIO).+-- Values are displayed with show, all on one line, which is hard to read.+dbgshow :: Show a => Int -> String -> a -> a+dbgshow level+    | debugLevel >= level = ltrace+    | otherwise           = flip const++-- | Print a showable value to the console, with a message, if the+-- debug level is at or above the specified level (uses+-- unsafePerformIO).+-- 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++-- | Print a showable value to the console, with a message, if the+-- debug level is at or above the specified level (uses+-- unsafePerformIO).+-- Values are displayed with pprint. Field names are not shown, but the+-- output is compact with smart line wrapping, long data elided,+-- and slow calculations timed out.+dbgpprint :: Data a => Int -> String -> a -> a+dbgpprint level msg a+    | debugLevel >= level = unsafePerformIO $ do+                              pprint a >>= putStrLn . ((msg++": \n") ++) . show+                              return a+    | otherwise           = a+++-- | Like dbg, then exit the program. Uses unsafePerformIO.+dbgExit :: Show a => String -> a -> a+dbgExit msg = const (unsafePerformIO exitFailure) . dbg msg++-- | Print a message and parsec debug info (parse position and next+-- input) to the console when the debug level is at or above+-- this level. Uses unsafePerformIO.+-- pdbgAt :: GenParser m => Float -> String -> m () pdbg level msg = when (level <= debugLevel) $ ptrace msg+  -- parsing 

@@ -1,5 +1,6 @@ name:           hledger-lib-version: 0.21.3+version: 0.22+stability:      beta category:       Finance synopsis:       Core data types, parsers and utilities for the hledger accounting tool. description:@@ -16,8 +17,7 @@ maintainer:     Simon Michael <simon@joyful.com> homepage:       http://hledger.org bug-reports:    http://hledger.org/bugs-stability:      beta-tested-with:    GHC==7.2.2, GHC==7.4.2, GHC==7.6.1+tested-with:    GHC==7.4.2, GHC==7.6.3 cabal-version:  >= 1.10 build-type:     Simple -- data-dir:       data@@ -54,12 +54,13 @@                   Hledger.Reports                   Hledger.Utils                   Hledger.Utils.UTF8IOCompat-  Build-Depends:+  build-depends:                   base >= 4.3 && < 5                  ,bytestring                  ,cmdargs >= 0.10 && < 0.11                  ,containers                  ,csv+                 ,data-pprint >= 0.2.3 && < 0.3                  ,directory                  ,filepath                  ,mtl@@ -67,7 +68,7 @@                  ,old-time                  ,parsec                  ,pretty-show-                 ,regex-compat == 0.95.*+                 ,regex-compat-tdfa == 0.95.*                  ,regexpr >= 0.5.1                  ,safe >= 0.2                  ,split >= 0.1 && < 0.3@@ -90,6 +91,7 @@                , cmdargs                , containers                , csv+               , data-pprint >= 0.2.3 && < 0.3                , directory                , filepath                , HUnit@@ -98,7 +100,7 @@                , old-time                , parsec                , pretty-show-               , regex-compat+               , regex-compat-tdfa                , regexpr                , safe                , split