hledger-lib 0.25.1 → 0.26

raw patch · 20 files changed

+547/−418 lines, 20 filesdep −regexprPVP ok

version bump matches the API change (PVP)

Dependencies removed: regexpr

API changes (from Hackage documentation)

Files

• CHANGES +9/−0
• Hledger/Data/AccountName.hs +1/−0
• Hledger/Data/Amount.hs +1/−1
• Hledger/Data/Dates.hs +3/−3
• Hledger/Data/Journal.hs +12/−12
• Hledger/Data/Posting.hs +27/−22
• Hledger/Data/TimeLog.hs +1/−1
• Hledger/Data/Transaction.hs +146/−118
• Hledger/Data/Types.hs +21/−4
• Hledger/Query.hs +46/−62
• Hledger/Read.hs +23/−14
• Hledger/Read/CsvReader.hs +14/−6
• Hledger/Read/JournalReader.hs +105/−58
• Hledger/Reports/BalanceReport.hs +9/−9
• Hledger/Reports/MultiBalanceReports.hs +31/−31
• Hledger/Reports/PostingsReport.hs +22/−22
• Hledger/Reports/ReportOptions.hs +7/−3
• Hledger/Utils/Debug.hs +66/−38
• Hledger/Utils/Regex.hs +2/−11
• hledger-lib.cabal +1/−3

@@ -2,11 +2,20 @@ User-visible changes appear in hledger's change log.  +0.26 (2015/7/12)++- allow year parser to handle arbitrarily large years+- Journal's Show instance reported one too many accounts+- some cleanup of debug trace helpers+- tighten up some date and account name parsers (don't accept leading spaces; hadddocks)+- drop regexpr dependency+ 0.25.1 (2015/4/29)  - support/require base-compat >0.8 (#245)  0.25 (2015/4/7)+  - GHC 7.10 compatibility (#239) 

@@ -59,6 +59,7 @@       parentAccountNames' "" = []       parentAccountNames' a = a : parentAccountNames' (parentAccountName a) +-- | Is the first account a parent or other ancestor of (and not the same as) the second ? isAccountNamePrefixOf :: AccountName -> AccountName -> Bool isAccountNamePrefixOf = isPrefixOf . (++ [acctsepchar]) 

@@ -184,7 +184,7 @@  -- | Convert an amount to the commodity of its assigned price, if any.  Notes: ----- - price amounts must be MixedAmounts with exactly one component Amount (or there will be a runtime error)+-- - price amounts must be MixedAmounts with exactly one component Amount (or there will be a runtime error) XXX -- -- - price amounts should be positive, though this is not currently enforced costOfAmount :: Amount -> Amount

@@ -134,8 +134,8 @@                          ,(2,[28,29])                          ,(3,[31])                          ,(4,[30])-                         ,(5,[30])-                         ,(6,[31])+                         ,(5,[31])+                         ,(6,[30])                          ,(7,[31])                          ,(8,[31])                          ,(9,[30])@@ -493,7 +493,7 @@ datesepchar = oneOf datesepchars  validYear, validMonth, validDay :: String -> Bool-validYear s = length s >= 4 && isJust (readMay s :: Maybe Int)+validYear s = length s >= 4 && isJust (readMay s :: Maybe Year) validMonth s = maybe False (\n -> n>=1 && n<=12) $ readMay s validDay s = maybe False (\n -> n>=1 && n<=31) $ readMay s 

@@ -106,7 +106,7 @@              (show accounts)              (show $ jcommoditystyles j)              -- ++ (show $ journalTransactions l)-             where accounts = flatten $ journalAccountNameTree j+             where accounts = filter (/= "root") $ flatten $ journalAccountNameTree j  -- showJournalDebug j = unlines [ --                       show j@@ -212,9 +212,9 @@ journalAssetAccountQuery _ = Acct "^assets?(:|$)"  -- | A query for Liability accounts in this journal.--- This is currently hard-coded to the case-insensitive regex @^liabilit(y|ies)(:|$)@.+-- This is currently hard-coded to the case-insensitive regex @^(debts?|liabilit(y|ies))(:|$)@. journalLiabilityAccountQuery  :: Journal -> Query-journalLiabilityAccountQuery _ = Acct "^liabilit(y|ies)(:|$)"+journalLiabilityAccountQuery _ = Acct "^(debts?|liabilit(y|ies))(:|$)"  -- | A query for Equity accounts in this journal. -- This is currently hard-coded to the case-insensitive regex @^equity(:|$)@.@@ -392,10 +392,10 @@   --  else (dbgtrace $   --        "applying additional command-line aliases:\n"   --        ++ chomp (unlines $ map (" "++) $ lines $ ppShow aliases))) $-  j{jtxns=map fixtransaction ts}+  j{jtxns=map dotransaction ts}     where-      fixtransaction t@Transaction{tpostings=ps} = t{tpostings=map fixposting ps}-      fixposting p@Posting{paccount=a} = p{paccount=accountNameApplyAliases aliases a}+      dotransaction t@Transaction{tpostings=ps} = t{tpostings=map doposting ps}+      doposting p@Posting{paccount=a} = p{paccount= accountNameApplyAliases aliases a}  -- | Do post-parse processing on a journal to make it ready for use: check -- all transactions balance, canonicalise amount formats, close any open@@ -495,7 +495,7 @@ journalCanonicaliseAmounts j@Journal{jtxns=ts} = j''     where       j'' = j'{jtxns=map fixtransaction ts}-      j' = j{jcommoditystyles = canonicalStyles $ dbgAt 8 "journalAmounts" $ journalAmounts j}+      j' = j{jcommoditystyles = canonicalStyles $ dbg8 "journalAmounts" $ journalAmounts j}       fixtransaction t@Transaction{tpostings=ps} = t{tpostings=map fixposting ps}       fixposting p@Posting{pamount=a} = p{pamount=fixmixedamount a}       fixmixedamount (Mixed as) = Mixed $ map fixamount as@@ -674,7 +674,7 @@              tsourcepos=nullsourcepos,              tdate=parsedate "2008/01/01",              tdate2=Nothing,-             tstatus=False,+             tstatus=Uncleared,              tcode="",              tdescription="income",              tcomment="",@@ -690,7 +690,7 @@              tsourcepos=nullsourcepos,              tdate=parsedate "2008/06/01",              tdate2=Nothing,-             tstatus=False,+             tstatus=Uncleared,              tcode="",              tdescription="gift",              tcomment="",@@ -706,7 +706,7 @@              tsourcepos=nullsourcepos,              tdate=parsedate "2008/06/02",              tdate2=Nothing,-             tstatus=False,+             tstatus=Uncleared,              tcode="",              tdescription="save",              tcomment="",@@ -722,7 +722,7 @@              tsourcepos=nullsourcepos,              tdate=parsedate "2008/06/03",              tdate2=Nothing,-             tstatus=True,+             tstatus=Cleared,              tcode="",              tdescription="eat & shop",              tcomment="",@@ -738,7 +738,7 @@              tsourcepos=nullsourcepos,              tdate=parsedate "2008/12/31",              tdate2=Nothing,-             tstatus=False,+             tstatus=Uncleared,              tcode="",              tdescription="pay off",              tcomment="",

@@ -13,7 +13,7 @@   posting,   post,   -- * operations-  postingCleared,+  postingStatus,   isReal,   isVirtual,   isBalancedVirtual,@@ -37,7 +37,6 @@   joinAccountNames,   concatAccountNames,   accountNameApplyAliases,-  accountNameApplyOneAlias,   -- * arithmetic   sumPostings,   -- * rendering@@ -68,7 +67,7 @@ nullposting = Posting                 {pdate=Nothing                 ,pdate2=Nothing-                ,pstatus=False+                ,pstatus=Uncleared                 ,paccount=""                 ,pamount=nullmixedamt                 ,pcomment=""@@ -138,14 +137,15 @@                 ,maybe Nothing (Just . tdate) $ ptransaction p                 ] --- |Is this posting cleared? If this posting was individually marked--- as cleared, returns True. Otherwise, return the parent--- transaction's cleared status or, if there is no parent--- transaction, return False.-postingCleared :: Posting -> Bool-postingCleared p = if pstatus p-                    then True-                    else maybe False tstatus $ ptransaction p+-- | Get a posting's cleared status: cleared or pending if those are+-- explicitly set, otherwise the cleared status of its parent+-- transaction, or uncleared if there is no parent transaction. (Note+-- Uncleared's ambiguity, it can mean "uncleared" or "don't know".+postingStatus :: Posting -> ClearedStatus+postingStatus Posting{pstatus=s, ptransaction=mt}+  | s == Uncleared = case mt of Just t  -> tstatus t+                                Nothing -> Uncleared+  | otherwise = s  -- | Tags for this posting including any inherited from its parent transaction. postingAllTags :: Posting -> [Tag]@@ -219,22 +219,27 @@ concatAccountNames as = accountNameWithPostingType t $ intercalate ":" $ map accountNameWithoutPostingType as     where t = headDef RegularPosting $ filter (/= RegularPosting) $ map accountNamePostingType as --- | Rewrite an account name using all applicable aliases from the given list, in sequence.+-- | Rewrite an account name using all matching aliases from the given list, in sequence.+-- Each alias sees the result of applying the previous aliases. accountNameApplyAliases :: [AccountAlias] -> AccountName -> AccountName accountNameApplyAliases aliases a = accountNameWithPostingType atype aname'   where     (aname,atype) = (accountNameWithoutPostingType a, accountNamePostingType a)-    matchingaliases = filter (\(re,_) -> regexMatchesCI re aname) aliases-    aname' = foldl (flip (uncurry regexReplaceCI)) aname matchingaliases+    aname' = foldl+             (\acct alias -> dbg6 "result" $ aliasReplace (dbg6 "alias" alias) (dbg6 "account" acct))+             aname+             aliases --- | Rewrite an account name using the first applicable alias from the given list, if any.-accountNameApplyOneAlias :: [AccountAlias] -> AccountName -> AccountName-accountNameApplyOneAlias aliases a = accountNameWithPostingType atype aname'-  where-    (aname,atype) = (accountNameWithoutPostingType a, accountNamePostingType a)-    firstmatchingalias = headDef Nothing $ map Just $ filter (\(re,_) -> regexMatchesCI re aname) aliases-    applyAlias = uncurry regexReplaceCI-    aname' = maybe id applyAlias firstmatchingalias $ aname+-- aliasMatches :: AccountAlias -> AccountName -> Bool+-- aliasMatches (BasicAlias old _) a = old `isAccountNamePrefixOf` a+-- aliasMatches (RegexAlias re  _) a = regexMatchesCI re a++aliasReplace :: AccountAlias -> AccountName -> AccountName+aliasReplace (BasicAlias old new) a+  | old `isAccountNamePrefixOf` a || old == a = new ++ drop (length old) a+  | otherwise = a+aliasReplace (RegexAlias re repl) a = regexReplaceCI re repl a+  tests_Hledger_Data_Posting = TestList [ 

@@ -82,7 +82,7 @@             tsourcepos   = tlsourcepos i,             tdate        = idate,             tdate2       = Nothing,-            tstatus      = True,+            tstatus      = Cleared,             tcode        = "",             tdescription = desc,             tcomment     = "",

@@ -64,7 +64,7 @@                     tsourcepos=nullsourcepos,                     tdate=nulldate,                     tdate2=Nothing,-                    tstatus=False,+                    tstatus=Uncleared,                     tcode="",                     tdescription="",                     tcomment="",@@ -102,14 +102,14 @@     nulltransaction{       tdate=parsedate "2012/05/14",       tdate2=Just $ parsedate "2012/05/15",-      tstatus=False,+      tstatus=Uncleared,       tcode="code",       tdescription="desc",       tcomment="tcomment1\ntcomment2\n",       ttags=[("ttag1","val1")],       tpostings=[         nullposting{-          pstatus=True,+          pstatus=Cleared,           paccount="a",           pamount=Mixed [usd 1, hrs 2],           pcomment="\npcomment2\n",@@ -140,7 +140,9 @@       date = showdate (tdate t) ++ maybe "" showedate (tdate2 t)       showdate = printf "%-10s" . showDate       showedate = printf "=%s" . showdate-      status = if tstatus t then " *" else ""+      status | tstatus t == Cleared = " *"+             | tstatus t == Pending = " !"+             | otherwise            = ""       code = if length (tcode t) > 0 then printf " (%s)" $ tcode t else ""       desc = if null d then "" else " " ++ d where d = tdescription t       (samelinecomment, newlinecomments) =@@ -184,7 +186,7 @@     showacct p =       indent $ showstatus p ++ printf (printf "%%-%ds" w) (showAccountName Nothing (ptype p) (paccount p))         where-          showstatus p = if pstatus p then "* " else ""+          showstatus p = if pstatus p == Cleared then "* " else ""           w = maximum $ map (length . paccount) ps     showamt =         padleft 12 . showMixedAmount@@ -194,7 +196,7 @@     let p `gives` ls = assertEqual "" ls (postingAsLines False [p] p)     posting `gives` ["                 0"]     posting{-      pstatus=True,+      pstatus=Cleared,       paccount="a",       pamount=Mixed [usd 1, hrs 2],       pcomment="pcomment1\npcomment2\n  tag3: val3  \n",@@ -259,110 +261,136 @@       canonicalise = maybe id canonicaliseMixedAmount styles  -- | Ensure this transaction is balanced, possibly inferring a missing--- amount or conversion price, or return an error message.------ Balancing is affected by commodity display precisions, so those may--- be provided.------ We can infer a missing real amount when there are multiple real--- postings and exactly one of them is amountless (likewise for--- balanced virtual postings). Inferred amounts are converted to cost--- basis when possible.------ We can infer a conversion price when all real amounts are specified--- and the sum of real postings' amounts is exactly two--- non-explicitly-priced amounts in different commodities (likewise--- for balanced virtual postings).+-- amount or conversion price(s), or return an error message.+-- Balancing is affected by commodity display precisions, so those can+-- (optionally) be provided. 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 (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-      -- maybe infer missing amounts-      (rwithamounts, rwithoutamounts)   = partition hasAmount $ realPostings t-      (bvwithamounts, bvwithoutamounts) = partition hasAmount $ balancedVirtualPostings t-      ramounts  = map pamount rwithamounts-      bvamounts = map pamount bvwithamounts-      t' = t{tpostings=map inferamount ps}-          where-            inferamount p | not (hasAmount p) && isReal p            = p{pamount = costOfMixedAmount (- sum ramounts)}-                          | not (hasAmount p) && isBalancedVirtual p = p{pamount = costOfMixedAmount (- sum bvamounts)}-                          | otherwise                             = p--      -- maybe infer conversion prices, for real postings-      rmixedamountsinorder = map pamount $ realPostings t'-      ramountsinorder = concatMap amounts rmixedamountsinorder-      rcommoditiesinorder  = map acommodity ramountsinorder-      rsumamounts  = amounts $ sum rmixedamountsinorder-      -- assumption: the sum of mixed amounts is normalised (one simple amount per commodity)-      t'' = if length rsumamounts == 2 && all ((==NoPrice).aprice) rsumamounts && t'==t-             then t'{tpostings=map inferprice ps}-             else t'+balanceTransaction styles t =+  case inferBalancingAmount t of+    Left err -> Left err+    Right t' -> let t'' = inferBalancingPrices t'+                in if isTransactionBalanced styles t''+                   then Right $ txnTieKnot t''+                   else Left $ printerr $ nonzerobalanceerror t''+     where+      printerr s = intercalate "\n" [s, showTransactionUnelided t]+      nonzerobalanceerror :: Transaction -> String+      nonzerobalanceerror t = printf "could not balance this transaction (%s%s%s)" rmsg sep bvmsg           where-            -- assumption: a posting's mixed amount contains one simple amount-            inferprice p@Posting{pamount=Mixed [a@Amount{acommodity=c,aprice=NoPrice}], ptype=RegularPosting}-                = p{pamount=Mixed [a{aprice=conversionprice c}]}-                where-                  conversionprice c | c == unpricedcommodity-                                        -- assign a balancing price. Use @@ for more exact output when possible.-                                        -- invariant: prices should always be positive. Enforced with "abs"-                                        = if length ramountsinunpricedcommodity == 1-                                           then TotalPrice $ abs targetcommodityamount `withPrecision` maxprecision-                                           else UnitPrice $ abs (targetcommodityamount `divideAmount` (aquantity unpricedamount)) `withPrecision` maxprecision-                                    | otherwise = NoPrice-                      where-                        unpricedcommodity     = head $ filter (`elem` (map acommodity rsumamounts)) rcommoditiesinorder-                        unpricedamount        = head $ filter ((==unpricedcommodity).acommodity) rsumamounts-                        targetcommodityamount = head $ filter ((/=unpricedcommodity).acommodity) rsumamounts-                        ramountsinunpricedcommodity = filter ((==unpricedcommodity).acommodity) ramountsinorder-            inferprice p = p+            (rsum, _, bvsum) = transactionPostingBalances t+            rmsg | isReallyZeroMixedAmountCost rsum = ""+                 | otherwise = "real postings are off by " ++ showMixedAmount (costOfMixedAmount rsum)+            bvmsg | isReallyZeroMixedAmountCost bvsum = ""+                  | otherwise = "balanced virtual postings are off by " ++ showMixedAmount (costOfMixedAmount bvsum)+            sep = if not (null rmsg) && not (null bvmsg) then "; " else "" :: String -      -- maybe infer prices for balanced virtual postings. Just duplicates the above for now.-      bvmixedamountsinorder = map pamount $ balancedVirtualPostings t''-      bvamountsinorder = concatMap amounts bvmixedamountsinorder-      bvcommoditiesinorder  = map acommodity bvamountsinorder-      bvsumamounts  = amounts $ sum bvmixedamountsinorder-      t''' = if length bvsumamounts == 2 && all ((==NoPrice).aprice) bvsumamounts && t'==t -- XXX could check specifically for bv amount inferring-             then t''{tpostings=map inferprice ps}-             else t''-          where-            inferprice p@Posting{pamount=Mixed [a@Amount{acommodity=c,aprice=NoPrice}], ptype=BalancedVirtualPosting}-                = p{pamount=Mixed [a{aprice=conversionprice c}]}-                where-                  conversionprice c | c == unpricedcommodity-                                        = if length bvamountsinunpricedcommodity == 1-                                           then TotalPrice $ abs targetcommodityamount `withPrecision` maxprecision-                                           else UnitPrice $ abs (targetcommodityamount `divideAmount` (aquantity unpricedamount)) `withPrecision` maxprecision-                                    | otherwise = NoPrice-                      where-                        unpricedcommodity     = head $ filter (`elem` (map acommodity bvsumamounts)) bvcommoditiesinorder-                        unpricedamount        = head $ filter ((==unpricedcommodity).acommodity) bvsumamounts-                        targetcommodityamount = head $ filter ((/=unpricedcommodity).acommodity) bvsumamounts-                        bvamountsinunpricedcommodity = filter ((==unpricedcommodity).acommodity) bvamountsinorder-            inferprice p = p+-- | Infer up to one missing amount for this transactions's real postings, and+-- likewise for its balanced virtual postings, if needed; or return an error+-- message if we can't.+--+-- We can infer a missing amount when there are multiple postings and exactly+-- one of them is amountless. If the amounts had price(s) the inferred amount+-- have the same price(s), and will be converted to the price commodity.+-- +inferBalancingAmount :: Transaction -> Either String Transaction+inferBalancingAmount t@Transaction{tpostings=ps}+  | length amountlessrealps > 1+      = Left $ printerr "could not balance this transaction - can't have more than one real posting with no amount (remember to put 2 or more spaces before amounts)"+  | length amountlessbvps > 1+      = Left $ printerr "could not balance this transaction - can't have more than one balanced virtual posting with no amount (remember to put 2 or more spaces before amounts)"+  | otherwise+      = Right t{tpostings=map inferamount ps}+  where+    printerr s = intercalate "\n" [s, showTransactionUnelided t]+    ((amountfulrealps, amountlessrealps), realsum) = (partition hasAmount (realPostings t), sum $ map pamount amountfulrealps)+    ((amountfulbvps, amountlessbvps), bvsum)       = (partition hasAmount (balancedVirtualPostings t), sum $ map pamount amountfulbvps)+    inferamount p@Posting{ptype=RegularPosting}         | not (hasAmount p) = p{pamount=costOfMixedAmount (-realsum)}+    inferamount p@Posting{ptype=BalancedVirtualPosting} | not (hasAmount p) = p{pamount=costOfMixedAmount (-bvsum)}+    inferamount p = p -      -- tie the knot so eg relatedPostings works right-      t'''' = txnTieKnot t'''+-- | Infer prices for this transaction's posting amounts, if needed to make+-- the postings balance, and if possible. This is done once for the real+-- postings and again (separately) for the balanced virtual postings. When+-- it's not possible, the transaction is left unchanged.+-- +-- The simplest example is a transaction with two postings, each in a+-- different commodity, with no prices specified. In this case we'll add a+-- price to the first posting such that it can be converted to the commodity+-- of the second posting (with -B), and such that the postings balance.+-- +-- In general, we can infer a conversion price when the sum of posting amounts+-- contains exactly two different commodities and no explicit prices.  Also+-- all postings are expected to contain an explicit amount (no missing+-- amounts) in a single commodity. Otherwise no price inferring is attempted.+-- +-- The transaction itself could contain more than two commodities, and/or+-- prices, if they cancel out; what matters is that the sum of posting amounts+-- contains exactly two commodities and zero prices.+-- +-- There can also be more than two postings in either of the commodities.+-- +-- We want to avoid excessive display of digits when the calculated price is+-- an irrational number, while hopefully also ensuring the displayed numbers+-- make sense if the user does a manual calculation. This is (mostly) achieved+-- in two ways:+-- +-- - when there is only one posting in the "from" commodity, a total price+--   (@@) is used, and all available decimal digits are shown+-- +-- - otherwise, a suitable averaged unit price (@) is applied to the relevant+--   postings, with display precision equal to the summed display precisions+--   of the two commodities being converted between, or 2, whichever is larger.+-- +-- (We don't always calculate a good-looking display precision for unit prices+-- when the commodity display precisions are low, eg when a journal doesn't+-- use any decimal places. The minimum of 2 helps make the prices shown by the+-- print command a bit less surprising in this case. Could do better.)+-- +inferBalancingPrices :: Transaction -> Transaction+inferBalancingPrices t@Transaction{tpostings=ps} = t{tpostings=ps'}+  where+    ps' = map (priceInferrerFor t BalancedVirtualPosting) $+          map (priceInferrerFor t RegularPosting) $+          ps -      printerr s = intercalate "\n" [s, showTransactionUnelided t]+-- | Generate a posting update function which assigns a suitable balancing+-- price to the posting, if and as appropriate for the given transaction and+-- posting type (real or balanced virtual).+priceInferrerFor :: Transaction -> PostingType -> (Posting -> Posting)+priceInferrerFor t pt = inferprice+  where+    postings       = filter ((==pt).ptype) $ tpostings t+    pmixedamounts  = map pamount postings+    pamounts       = concatMap amounts pmixedamounts+    pcommodities   = map acommodity pamounts+    sumamounts     = amounts $ sum pmixedamounts -- sum normalises to one amount per commodity & price+    sumcommodities = map acommodity sumamounts+    sumprices      = filter (/=NoPrice) $ map aprice sumamounts+    caninferprices = length sumcommodities == 2 && null sumprices -nonzerobalanceerror :: Transaction -> String-nonzerobalanceerror t = printf "could not balance this transaction (%s%s%s)" rmsg sep bvmsg-    where-      (rsum, _, bvsum) = transactionPostingBalances t-      rmsg | isReallyZeroMixedAmountCost rsum = ""-           | otherwise = "real postings are off by " ++ showMixedAmount (costOfMixedAmount rsum)-      bvmsg | isReallyZeroMixedAmountCost bvsum = ""-            | otherwise = "balanced virtual postings are off by " ++ showMixedAmount (costOfMixedAmount bvsum)-      sep = if not (null rmsg) && not (null bvmsg) then "; " else "" :: String+    inferprice p@Posting{pamount=Mixed [a]}+      | caninferprices && ptype p == pt && acommodity a == fromcommodity+        = p{pamount=Mixed [a{aprice=conversionprice}]}+      where+        fromcommodity = head $ filter (`elem` sumcommodities) pcommodities -- these heads are ugly but should be safe+        conversionprice+          | fromcount==1 = TotalPrice $ abs toamount `withPrecision` maxprecision+          | otherwise    = UnitPrice $ abs unitprice `withPrecision` unitprecision+          where+            fromcount     = length $ filter ((==fromcommodity).acommodity) pamounts+            fromamount    = head $ filter ((==fromcommodity).acommodity) sumamounts+            tocommodity   = head $ filter (/=fromcommodity) sumcommodities+            toamount      = head $ filter ((==tocommodity).acommodity) sumamounts+            unitprice     = toamount `divideAmount` (aquantity fromamount)+            unitprecision = max 2 ((asprecision $ astyle $ toamount) + (asprecision $ astyle $ fromamount))+    inferprice p = p  -- Get a transaction's secondary date, defaulting to the primary date. transactionDate2 :: Transaction -> Day transactionDate2 t = fromMaybe (tdate t) $ tdate2 t --- | Ensure a transaction's postings refer back to it.+-- | Ensure a transaction's postings refer back to it, so that eg+-- relatedPostings works right. txnTieKnot :: Transaction -> Transaction txnTieKnot t@Transaction{tpostings=ps} = t{tpostings=map (settxn t) ps} @@ -382,7 +410,7 @@         ,"    assets:checking"         ,""         ])-       (let t = Transaction nullsourcepos (parsedate "2007/01/28") Nothing False "" "coopportunity" "" []+       (let t = Transaction nullsourcepos (parsedate "2007/01/28") Nothing Uncleared "" "coopportunity" "" []                 [posting{paccount="expenses:food:groceries", pamount=Mixed [usd 47.18], ptransaction=Just t}                 ,posting{paccount="assets:checking", pamount=Mixed [usd (-47.18)], ptransaction=Just t}                 ] ""@@ -396,7 +424,7 @@         ,"    assets:checking               $-47.18"         ,""         ])-       (let t = Transaction nullsourcepos (parsedate "2007/01/28") Nothing False "" "coopportunity" "" []+       (let t = Transaction nullsourcepos (parsedate "2007/01/28") Nothing Uncleared "" "coopportunity" "" []                 [posting{paccount="expenses:food:groceries", pamount=Mixed [usd 47.18], ptransaction=Just t}                 ,posting{paccount="assets:checking", pamount=Mixed [usd (-47.18)], ptransaction=Just t}                 ] ""@@ -412,7 +440,7 @@         ,""         ])        (showTransaction-        (txnTieKnot $ Transaction nullsourcepos (parsedate "2007/01/28") Nothing False "" "coopportunity" "" []+        (txnTieKnot $ Transaction nullsourcepos (parsedate "2007/01/28") Nothing Uncleared "" "coopportunity" "" []          [posting{paccount="expenses:food:groceries", pamount=Mixed [usd 47.18]}          ,posting{paccount="assets:checking", pamount=Mixed [usd (-47.19)]}          ] ""))@@ -425,7 +453,7 @@         ,""         ])        (showTransaction-        (txnTieKnot $ Transaction nullsourcepos (parsedate "2007/01/28") Nothing False "" "coopportunity" "" []+        (txnTieKnot $ Transaction nullsourcepos (parsedate "2007/01/28") Nothing Uncleared "" "coopportunity" "" []          [posting{paccount="expenses:food:groceries", pamount=Mixed [usd 47.18]}          ] "")) @@ -437,7 +465,7 @@         ,""         ])        (showTransaction-        (txnTieKnot $ Transaction nullsourcepos (parsedate "2007/01/28") Nothing False "" "coopportunity" "" []+        (txnTieKnot $ Transaction nullsourcepos (parsedate "2007/01/28") Nothing Uncleared "" "coopportunity" "" []          [posting{paccount="expenses:food:groceries", pamount=missingmixedamt}          ] "")) @@ -450,7 +478,7 @@         ,""         ])        (showTransaction-        (txnTieKnot $ Transaction nullsourcepos (parsedate "2010/01/01") Nothing False "" "x" "" []+        (txnTieKnot $ Transaction nullsourcepos (parsedate "2010/01/01") Nothing Uncleared "" "x" "" []          [posting{paccount="a", pamount=Mixed [num 1 `at` (usd 2 `withPrecision` 0)]}          ,posting{paccount="b", pamount= missingmixedamt}          ] ""))@@ -458,19 +486,19 @@   ,"balanceTransaction" ~: do      assertBool "detect unbalanced entry, sign error"                     (isLeft $ balanceTransaction Nothing-                           (Transaction nullsourcepos (parsedate "2007/01/28") Nothing False "" "test" "" []+                           (Transaction nullsourcepos (parsedate "2007/01/28") Nothing Uncleared "" "test" "" []                             [posting{paccount="a", pamount=Mixed [usd 1]}                             ,posting{paccount="b", pamount=Mixed [usd 1]}                             ] ""))       assertBool "detect unbalanced entry, multiple missing amounts"                     (isLeft $ balanceTransaction Nothing-                           (Transaction nullsourcepos (parsedate "2007/01/28") Nothing False "" "test" "" []+                           (Transaction nullsourcepos (parsedate "2007/01/28") Nothing Uncleared "" "test" "" []                             [posting{paccount="a", pamount=missingmixedamt}                             ,posting{paccount="b", pamount=missingmixedamt}                             ] "")) -     let e = balanceTransaction Nothing (Transaction nullsourcepos (parsedate "2007/01/28") Nothing False "" "" "" []+     let e = balanceTransaction Nothing (Transaction nullsourcepos (parsedate "2007/01/28") Nothing Uncleared "" "" "" []                            [posting{paccount="a", pamount=Mixed [usd 1]}                            ,posting{paccount="b", pamount=missingmixedamt}                            ] "")@@ -481,7 +509,7 @@                         Right e' -> (pamount $ last $ tpostings e')                         Left _ -> error' "should not happen") -     let e = balanceTransaction Nothing (Transaction nullsourcepos (parsedate "2011/01/01") Nothing False "" "" "" []+     let e = balanceTransaction Nothing (Transaction nullsourcepos (parsedate "2011/01/01") Nothing Uncleared "" "" "" []                            [posting{paccount="a", pamount=Mixed [usd 1.35]}                            ,posting{paccount="b", pamount=Mixed [eur (-1)]}                            ] "")@@ -493,49 +521,49 @@                         Left _ -> error' "should not happen")       assertBool "balanceTransaction balances based on cost if there are unit prices" (isRight $-       balanceTransaction Nothing (Transaction nullsourcepos (parsedate "2011/01/01") Nothing False "" "" "" []+       balanceTransaction Nothing (Transaction nullsourcepos (parsedate "2011/01/01") Nothing Uncleared "" "" "" []                            [posting{paccount="a", pamount=Mixed [usd 1 `at` eur 2]}                            ,posting{paccount="a", pamount=Mixed [usd (-2) `at` eur 1]}                            ] ""))       assertBool "balanceTransaction balances based on cost if there are total prices" (isRight $-       balanceTransaction Nothing (Transaction nullsourcepos (parsedate "2011/01/01") Nothing False "" "" "" []+       balanceTransaction Nothing (Transaction nullsourcepos (parsedate "2011/01/01") Nothing Uncleared "" "" "" []                            [posting{paccount="a", pamount=Mixed [usd 1    @@ eur 1]}                            ,posting{paccount="a", pamount=Mixed [usd (-2) @@ eur 1]}                            ] ""))    ,"isTransactionBalanced" ~: do-     let t = Transaction nullsourcepos (parsedate "2009/01/01") Nothing False "" "a" "" []+     let t = Transaction nullsourcepos (parsedate "2009/01/01") Nothing Uncleared "" "a" "" []              [posting{paccount="b", pamount=Mixed [usd 1.00], ptransaction=Just t}              ,posting{paccount="c", pamount=Mixed [usd (-1.00)], ptransaction=Just t}              ] ""      assertBool "detect balanced" (isTransactionBalanced Nothing t)-     let t = Transaction nullsourcepos (parsedate "2009/01/01") Nothing False "" "a" "" []+     let t = Transaction nullsourcepos (parsedate "2009/01/01") Nothing Uncleared "" "a" "" []              [posting{paccount="b", pamount=Mixed [usd 1.00], ptransaction=Just t}              ,posting{paccount="c", pamount=Mixed [usd (-1.01)], ptransaction=Just t}              ] ""      assertBool "detect unbalanced" (not $ isTransactionBalanced Nothing t)-     let t = Transaction nullsourcepos (parsedate "2009/01/01") Nothing False "" "a" "" []+     let t = Transaction nullsourcepos (parsedate "2009/01/01") Nothing Uncleared "" "a" "" []              [posting{paccount="b", pamount=Mixed [usd 1.00], ptransaction=Just t}              ] ""      assertBool "detect unbalanced, one posting" (not $ isTransactionBalanced Nothing t)-     let t = Transaction nullsourcepos (parsedate "2009/01/01") Nothing False "" "a" "" []+     let t = Transaction nullsourcepos (parsedate "2009/01/01") Nothing Uncleared "" "a" "" []              [posting{paccount="b", pamount=Mixed [usd 0], ptransaction=Just t}              ] ""      assertBool "one zero posting is considered balanced for now" (isTransactionBalanced Nothing t)-     let t = Transaction nullsourcepos (parsedate "2009/01/01") Nothing False "" "a" "" []+     let t = Transaction nullsourcepos (parsedate "2009/01/01") Nothing Uncleared "" "a" "" []              [posting{paccount="b", pamount=Mixed [usd 1.00], ptransaction=Just t}              ,posting{paccount="c", pamount=Mixed [usd (-1.00)], ptransaction=Just t}              ,posting{paccount="d", pamount=Mixed [usd 100], ptype=VirtualPosting, ptransaction=Just t}              ] ""      assertBool "virtual postings don't need to balance" (isTransactionBalanced Nothing t)-     let t = Transaction nullsourcepos (parsedate "2009/01/01") Nothing False "" "a" "" []+     let t = Transaction nullsourcepos (parsedate "2009/01/01") Nothing Uncleared "" "a" "" []              [posting{paccount="b", pamount=Mixed [usd 1.00], ptransaction=Just t}              ,posting{paccount="c", pamount=Mixed [usd (-1.00)], ptransaction=Just t}              ,posting{paccount="d", pamount=Mixed [usd 100], ptype=BalancedVirtualPosting, ptransaction=Just t}              ] ""      assertBool "balanced virtual postings need to balance among themselves" (not $ isTransactionBalanced Nothing t)-     let t = Transaction nullsourcepos (parsedate "2009/01/01") Nothing False "" "a" "" []+     let t = Transaction nullsourcepos (parsedate "2009/01/01") Nothing Uncleared "" "a" "" []              [posting{paccount="b", pamount=Mixed [usd 1.00], ptransaction=Just t}              ,posting{paccount="c", pamount=Mixed [usd (-1.00)], ptransaction=Just t}              ,posting{paccount="d", pamount=Mixed [usd 100], ptype=BalancedVirtualPosting, ptransaction=Just t}

@@ -5,7 +5,7 @@ Here is an overview of the hledger data model:  > Journal                  -- a journal is read from one or more data files. It contains..->  [Transaction]           -- journal transactions (aka entries), which have date, status, code, description and..+>  [Transaction]           -- journal transactions (aka entries), which have date, cleared status, code, description and.. >   [Posting]              -- multiple account postings, which have account name and amount >  [HistoricalPrice]       -- historical commodity prices >@@ -48,7 +48,16 @@  type AccountName = String -type AccountAlias = (Regexp,Replacement)+data AccountAlias = BasicAlias AccountName AccountName+                  | RegexAlias Regexp Replacement+  deriving (+  Eq+  ,Read+  ,Show+  ,Ord+  ,Data+  ,Typeable+  )  data Side = L | R deriving (Eq,Show,Read,Ord,Typeable,Data) @@ -107,10 +116,18 @@  type Tag = (String, String)  -- ^ A tag name and (possibly empty) value. +data ClearedStatus = Uncleared | Pending | Cleared+                   deriving (Eq,Ord,Typeable,Data)++instance Show ClearedStatus where -- custom show+  show Uncleared = ""             -- a bad idea+  show Pending   = "!"            -- don't do it+  show Cleared   = "*"+ data Posting = Posting {       pdate :: Maybe Day,  -- ^ this posting's date, if different from the transaction's       pdate2 :: Maybe Day,  -- ^ this posting's secondary date, if different from the transaction's-      pstatus :: Bool,+      pstatus :: ClearedStatus,       paccount :: AccountName,       pamount :: MixedAmount,       pcomment :: String, -- ^ this posting's comment lines, as a single non-indented multi-line string@@ -130,7 +147,7 @@       tsourcepos :: SourcePos,       tdate :: Day,       tdate2 :: Maybe Day,-      tstatus :: Bool,  -- XXX tcleared ?+      tstatus :: ClearedStatus,       tcode :: String,       tdescription :: String,       tcomment :: String, -- ^ this transaction's comment lines, as a single non-indented multi-line string

@@ -28,7 +28,6 @@   queryDateSpan,   queryDateSpan',   queryDepth,-  queryEmpty,   inAccount,   inAccountQuery,   -- * matching@@ -47,7 +46,7 @@ import Data.List import Data.Maybe import Data.Time.Calendar-import Safe (readDef, headDef, headMay)+import Safe (readDef, headDef) import Test.HUnit -- import Text.ParserCombinators.Parsec import Text.Parsec hiding (Empty)@@ -68,19 +67,19 @@            | Not Query        -- ^ negate this match            | Or [Query]       -- ^ match if any of these match            | And [Query]      -- ^ match if all of these match-           | Code String      -- ^ match if code matches this regexp-           | Desc String      -- ^ match if description matches this regexp-           | Acct String      -- ^ match postings whose account matches this regexp+           | Code Regexp      -- ^ match if code matches this regexp+           | Desc Regexp      -- ^ match if description matches this regexp+           | Acct Regexp      -- ^ match postings whose account matches this regexp            | Date DateSpan    -- ^ match if primary date in this date span            | Date2 DateSpan   -- ^ match if secondary date in this date span-           | Status Bool      -- ^ match if cleared status has this value+           | Status ClearedStatus  -- ^ match txns/postings with this cleared status (Status Uncleared matches all states except cleared)            | Real Bool        -- ^ match if "realness" (involves a real non-virtual account ?) has this 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+           | Sym Regexp       -- ^ 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+           | Tag Regexp (Maybe Regexp)  -- ^ match if a tag's name, and optionally its value, is matched by these respective regexps                                         -- matching the regexp if provided, exists     deriving (Eq,Data,Typeable) @@ -249,8 +248,10 @@ parseQueryTerm d ('d':'a':'t':'e':':':s) =         case parsePeriodExpr d s of Left e         -> error' $ "\"date:"++s++"\" gave a "++showDateParseError e                                     Right (_,span) -> Left $ Date span-parseQueryTerm _ ('s':'t':'a':'t':'u':'s':':':s) = Left $ Status $ parseStatus s-parseQueryTerm _ ('r':'e':'a':'l':':':s) = Left $ Real $ parseBool s+parseQueryTerm _ ('s':'t':'a':'t':'u':'s':':':s) = +        case parseStatus s of Left e   -> error' $ "\"status:"++s++"\" gave a parse error: " ++ e+                              Right st -> Left $ Status st+parseQueryTerm _ ('r':'e':'a':'l':':':s) = Left $ Real $ parseBool s || null 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@@ -265,9 +266,11 @@     "a" `gives` (Left $ Acct "a")     "acct:expenses:autres d\233penses" `gives` (Left $ Acct "expenses:autres d\233penses")     "not:desc:a b" `gives` (Left $ Not $ Desc "a b")-    "status:1" `gives` (Left $ Status True)-    "status:0" `gives` (Left $ Status False)-    "status:" `gives` (Left $ Status False)+    "status:1" `gives` (Left $ Status Cleared)+    "status:*" `gives` (Left $ Status Cleared)+    "status:!" `gives` (Left $ Status Pending)+    "status:0" `gives` (Left $ Status Uncleared)+    "status:" `gives` (Left $ Status Uncleared)     "real:1" `gives` (Left $ Real True)     "date:2008" `gives` (Left $ Date $ DateSpan (Just $ parsedate "2008/01/01") (Just $ parsedate "2009/01/01"))     "date:from 2012/5/17" `gives` (Left $ Date $ DateSpan (Just $ parsedate "2012/05/17") Nothing)@@ -326,15 +329,17 @@     "-0.23" `gives` (Eq,(-0.23))   ] -parseTag :: String -> (String, Maybe String)+parseTag :: String -> (Regexp, Maybe Regexp) parseTag s | '=' `elem` s = (n, Just $ tail v)            | otherwise    = (s, Nothing)            where (n,v) = break (=='=') s --- -- , treating "*" or "!" as synonyms for "1".--- | Parse the boolean value part of a "status:" query.-parseStatus :: String -> Bool-parseStatus s = s `elem` (truestrings) -- ++ ["*","!"])+-- | Parse the value part of a "status:" query, or return an error.+parseStatus :: String -> Either String ClearedStatus+parseStatus s | s `elem` ["*","1"] = Right Cleared+              | s `elem` ["!"]     = Right Pending+              | s `elem` ["","0"]  = Right Uncleared+              | otherwise          = Left $ "could not parse "++show s++" as a status (should be *, ! or empty)"  -- | Parse the boolean value part of a "status:" query. "1" means true, -- anything else will be parsed as false without error.@@ -399,7 +404,7 @@   let (q,p) `gives` r = assertEqual "" r (filterQuery p q)   (Any, queryIsDepth) `gives` Any   (Depth 1, queryIsDepth) `gives` Depth 1-  (And [And [Status True,Depth 1]], not . queryIsDepth) `gives` Status True+  (And [And [Status Cleared,Depth 1]], not . queryIsDepth) `gives` Status Cleared   -- (And [Date nulldatespan, Not (Or [Any, Depth 1])], queryIsDepth) `gives` And [Not (Or [Depth 1])]  ] @@ -535,23 +540,6 @@     queryDepth' (And qs) = concatMap queryDepth' qs     queryDepth' _ = [] --- | The empty (zero amount) status specified by this query, defaulting to false.-queryEmpty :: Query -> Bool-queryEmpty = headDef False . queryEmpty'-  where-    queryEmpty' (Empty v) = [v]-    queryEmpty' (Or qs) = concatMap queryEmpty' qs-    queryEmpty' (And qs) = concatMap queryEmpty' qs-    queryEmpty' _ = []---- -- | The "include empty" option specified by this query, defaulting to false.--- emptyQueryOpt :: [QueryOpt] -> Bool--- emptyQueryOpt = headDef False . emptyQueryOpt'---   where---     emptyQueryOpt' [] = False---     emptyQueryOpt' (QueryOptEmpty v:_) = v---     emptyQueryOpt' (_:vs) = emptyQueryOpt' vs- -- | The account we are currently focussed on, if any, and whether subaccounts are included. -- Just looks at the first query option. inAccount :: [QueryOpt] -> Maybe (AccountName,Bool)@@ -643,7 +631,8 @@ matchesPosting (Acct r) p = regexMatchesCI r $ paccount p matchesPosting (Date span) p = span `spanContainsDate` postingDate p matchesPosting (Date2 span) p = span `spanContainsDate` postingDate2 p-matchesPosting (Status v) p = v == postingCleared p+matchesPosting (Status Uncleared) p = postingStatus p /= Cleared+matchesPosting (Status s) p = postingStatus p == s matchesPosting (Real v) p = v == isReal p matchesPosting q@(Depth _) Posting{paccount=a} = q `matchesAccount` a matchesPosting q@(Amt _ _) Posting{pamount=amt} = q `matchesMixedAmount` amt@@ -653,23 +642,22 @@ -- 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 (Tag n v) p = not $ null $ matchedTags n v $ postingAllTags p -- matchesPosting _ _ = False  tests_matchesPosting = [    "matchesPosting" ~: do     -- matching posting status..-    assertBool "positive match on true posting status"  $-                   (Status True)  `matchesPosting` nullposting{pstatus=True}-    assertBool "negative match on true posting status"  $-               not $ (Not $ Status True)  `matchesPosting` nullposting{pstatus=True}-    assertBool "positive match on false posting status" $-                   (Status False) `matchesPosting` nullposting{pstatus=False}-    assertBool "negative match on false posting status" $-               not $ (Not $ Status False) `matchesPosting` nullposting{pstatus=False}+    assertBool "positive match on cleared posting status"  $+                   (Status Cleared)  `matchesPosting` nullposting{pstatus=Cleared}+    assertBool "negative match on cleared posting status"  $+               not $ (Not $ Status Cleared)  `matchesPosting` nullposting{pstatus=Cleared}+    assertBool "positive match on unclered posting status" $+                   (Status Uncleared) `matchesPosting` nullposting{pstatus=Uncleared}+    assertBool "negative match on unclered posting status" $+               not $ (Not $ Status Uncleared) `matchesPosting` nullposting{pstatus=Uncleared}     assertBool "positive match on true posting status acquired from transaction" $-                   (Status True) `matchesPosting` nullposting{pstatus=False,ptransaction=Just nulltransaction{tstatus=True}}+                   (Status Cleared) `matchesPosting` nullposting{pstatus=Uncleared,ptransaction=Just nulltransaction{tstatus=Cleared}}     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}@@ -701,14 +689,14 @@ matchesTransaction q@(Acct _) t = any (q `matchesPosting`) $ tpostings t matchesTransaction (Date span) t = spanContainsDate span $ tdate t matchesTransaction (Date2 span) t = spanContainsDate span $ transactionDate2 t-matchesTransaction (Status v) t = v == tstatus t+matchesTransaction (Status Uncleared) t = tstatus t /= Cleared+matchesTransaction (Status s) t = tstatus t == s matchesTransaction (Real v) t = v == hasRealPostings t 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+matchesTransaction (Tag n v) t = not $ null $ matchedTags n v $ transactionAllTags t  -- matchesTransaction _ _ = False @@ -724,17 +712,13 @@    assertBool "" $ (Tag "postingtag" Nothing) `matchesTransaction` nulltransaction{tpostings=[nullposting{ptags=[("postingtag","")]}]}  ] -lookupTagByName :: String -> [Tag] -> Maybe Tag-lookupTagByName namepat tags = headMay [(n,v) | (n,v) <- tags, matchTagName namepat n]--lookupTagByNameAndValue :: Tag -> [Tag] -> Maybe Tag-lookupTagByNameAndValue (namepat, valpat) tags = headMay [(n,v) | (n,v) <- tags, matchTagName namepat n, matchTagValue valpat v]--matchTagName :: String -> String -> Bool-matchTagName pat name = pat == name--matchTagValue :: String -> String -> Bool-matchTagValue pat value = regexMatchesCI pat value+-- | Filter a list of tags by matching against their names and+-- optionally also their values.+matchedTags :: Regexp -> Maybe Regexp -> [Tag] -> [Tag]+matchedTags namepat valuepat tags = filter (match namepat valuepat) tags+  where+    match npat Nothing     (n,_) = regexMatchesCI npat n+    match npat (Just vpat) (n,v) = regexMatchesCI npat n && regexMatchesCI vpat v  -- tests 

@@ -15,6 +15,7 @@        readJournal,        readJournal',        readJournalFile,+       readJournalFiles,        requireJournalFileExists,        ensureJournalFileExists,        -- * Parsers used elsewhere@@ -25,6 +26,7 @@        mamountp',        numberp,        codep,+       accountaliasp,        -- * Tests        samplejournal,        tests_Hledger_Read,@@ -38,7 +40,7 @@ import System.Environment (getEnv) import System.Exit (exitFailure) import System.FilePath ((</>))-import System.IO (IOMode(..), withFile, stdin, stderr, hSetNewlineMode, universalNewlineMode)+import System.IO (IOMode(..), openFile, stdin, stderr, hSetNewlineMode, universalNewlineMode) import Test.HUnit import Text.Printf @@ -50,7 +52,7 @@ import Hledger.Read.CsvReader as CsvReader import Hledger.Utils import Prelude hiding (getContents, writeFile)-import Hledger.Utils.UTF8IOCompat (getContents, hGetContents, writeFile)+import Hledger.Utils.UTF8IOCompat (hGetContents, writeFile)   journalEnvVar           = "LEDGER_FILE"@@ -126,9 +128,9 @@         firstSuccessOrBestError :: [String] -> [Reader] -> IO (Either String Journal)         firstSuccessOrBestError [] []        = return $ Left "no readers found"         firstSuccessOrBestError errs (r:rs) = do-          dbgAtM 1 "trying reader" (rFormat r)+          dbg1IO "trying reader" (rFormat r)           result <- (runExceptT . (rParser r) rulesfile assrt path') s-          dbgAtM 1 "reader result" $ either id show result+          dbg1IO "reader result" $ either id show result           case result of Right j -> return $ Right j                       -- success!                          Left e  -> firstSuccessOrBestError (errs++[e]) rs -- keep trying         firstSuccessOrBestError (e:_) []    = return $ Left e              -- none left, return first error@@ -137,7 +139,7 @@ -- | Which readers are worth trying for this (possibly unspecified) format, filepath, and data ? readersFor :: (Maybe StorageFormat, Maybe FilePath, String) -> [Reader] readersFor (format,path,s) =-    dbg ("possible readers for "++show (format,path,elideRight 30 s)) $+    dbg1 ("possible readers for "++show (format,path,elideRight 30 s)) $     case format of      Just f  -> case readerForStorageFormat f of Just r  -> [r]                                                  Nothing -> []@@ -162,17 +164,24 @@ -- conversion of that format. Also there is a flag specifying whether -- to check or ignore balance assertions in the journal. readJournalFile :: Maybe StorageFormat -> Maybe FilePath -> Bool -> FilePath -> IO (Either String Journal)-readJournalFile format rulesfile assrt "-" = do-  hSetNewlineMode stdin universalNewlineMode-  getContents >>= readJournal format rulesfile assrt (Just "-")-readJournalFile format rulesfile assrt f = do-  requireJournalFileExists f-  withFile f ReadMode $ \h -> do+readJournalFile format rulesfile assrt f = readJournalFiles format rulesfile assrt [f]++readJournalFiles :: Maybe StorageFormat -> Maybe FilePath -> Bool -> [FilePath] -> IO (Either String Journal)+readJournalFiles format rulesfile assrt f = do+  contents <- fmap concat $ mapM readFileAnyNewline f+  readJournal format rulesfile assrt (listToMaybe f) contents+ where+  readFileAnyNewline f = do+    requireJournalFileExists f+    h <- fileHandle f     hSetNewlineMode h universalNewlineMode-    hGetContents h >>= readJournal format rulesfile assrt (Just f)+    hGetContents h+  fileHandle "-" = return stdin+  fileHandle f = openFile f ReadMode  -- | If the specified journal file does not exist, give a helpful error and quit. requireJournalFileExists :: FilePath -> IO ()+requireJournalFileExists "-" = return () requireJournalFileExists f = do   exists <- doesFileExist f   when (not exists) $ do@@ -186,7 +195,7 @@ ensureJournalFileExists f = do   exists <- doesFileExist f   when (not exists) $ do-    hPrintf stderr "Creating hledger journal file \"%s\".\n" f+    hPrintf stderr "Creating hledger journal file %s.\n" f     -- note Hledger.Utils.UTF8.* do no line ending conversion on windows,     -- we currently require unix line endings on all platforms.     newJournalContent >>= writeFile f@@ -230,7 +239,7 @@ tests_Hledger_Read = TestList $   tests_readJournal'   ++ [-   -- tests_Hledger_Read_JournalReader,+   tests_Hledger_Read_JournalReader,    tests_Hledger_Read_TimelogReader,    tests_Hledger_Read_CsvReader, 

@@ -51,7 +51,7 @@ import Hledger.Data import Hledger.Utils.UTF8IOCompat (getContents) import Hledger.Utils-import Hledger.Read.JournalReader (amountp)+import Hledger.Read.JournalReader (amountp, statusp)   reader :: Reader@@ -101,7 +101,7 @@   let rules = case rules_ of               Right (t::CsvRules) -> t               Left err -> throwerr $ show err-  dbgAtM 2 "rules" rules+  dbg2IO "rules" rules    -- apply skip directive   let skip = maybe 0 oneorerror $ getDirective "skip" rules@@ -113,10 +113,10 @@   -- parsec seems to fail if you pass it "-" here   let parsecfilename = if csvfile == "-" then "(stdin)" else csvfile   records <- (either throwerr id .-              dbgAt 2 "validateCsv" . validateCsv skip .-              dbgAt 2 "parseCsv")+              dbg2 "validateCsv" . validateCsv skip .+              dbg2 "parseCsv")              `fmap` parseCsv parsecfilename csvdata-  dbgAtM 1 "first 3 csv records" $ take 3 records+  dbg1IO "first 3 csv records" $ take 3 records    -- identify header lines   -- let (headerlines, datalines) = identifyHeaderLines records@@ -602,7 +602,15 @@        ++"or "++maybe "add a" (const "change your") mskip++" skip rule"       ,"for m/d/y or d/m/y dates, use date-format %-m/%-d/%Y or date-format %-d/%-m/%Y"       ]-    status      = maybe False ((=="*") . render) $ mfieldtemplate "status"+    status      =+      case mfieldtemplate "status" of+        Nothing  -> Uncleared+        Just str -> either statuserror id $ runParser (statusp <* eof) nullctx "" $ render str+          where+            statuserror err = error' $ unlines+              ["error: could not parse \""++str++"\" as a cleared status (should be *, ! or empty)"+              ,"the parse error is:      "++show err+              ]     code        = maybe "" render $ mfieldtemplate "code"     description = maybe "" render $ mfieldtemplate "description"     comment     = maybe "" render $ mfieldtemplate "comment"

@@ -36,10 +36,13 @@   amountp',   mamountp',   numberp,+  statusp,   emptyorcommentlinep,-  followingcommentp-#ifdef TESTS+  followingcommentp,+  accountaliasp   -- * Tests+  ,tests_Hledger_Read_JournalReader+#ifdef TESTS   -- disabled by default, HTF not available on windows   ,htf_thisModulesTests   ,htf_Hledger_Read_JournalReader_importedTests@@ -58,6 +61,7 @@ import Data.Time.Calendar import Data.Time.LocalTime import Safe (headDef, lastDef)+import Test.HUnit #ifdef TESTS import Test.Framework import Text.Parsec.Error@@ -243,13 +247,34 @@ aliasdirective = do   string "alias"   many1 spacenonewline-  orig <- many1 $ noneOf "="-  char '='-  alias <- restofline-  addAccountAlias (accountNameWithoutPostingType $ strip orig-                  ,accountNameWithoutPostingType $ strip alias)+  alias <- accountaliasp+  addAccountAlias alias   return $ return id +accountaliasp :: Stream [Char] m Char => ParsecT [Char] st m AccountAlias+accountaliasp = regexaliasp <|> basicaliasp++basicaliasp :: Stream [Char] m Char => ParsecT [Char] st m AccountAlias+basicaliasp = do+  -- pdbg 0 "basicaliasp"+  old <- rstrip <$> (many1 $ noneOf "=")+  char '='+  many spacenonewline+  new <- rstrip <$> anyChar `manyTill` eolof  -- don't require a final newline, good for cli options+  return $ BasicAlias old new++regexaliasp :: Stream [Char] m Char => ParsecT [Char] st m AccountAlias+regexaliasp = do+  -- pdbg 0 "regexaliasp"+  char '/'+  re <- many1 $ noneOf "/\n\r" -- paranoid: don't try to read past line end+  char '/'+  many spacenonewline+  char '='+  many spacenonewline+  repl <- rstrip <$> anyChar `manyTill` eolof+  return $ RegexAlias re repl+ endaliasesdirective :: ParsecT [Char] JournalContext (ExceptT String IO) JournalUpdate endaliasesdirective = do   string "end aliases"@@ -345,7 +370,7 @@   date <- datep <?> "transaction"   edate <- optionMaybe (secondarydatep date) <?> "secondary date"   lookAhead (spacenonewline <|> newline) <?> "whitespace or newline"-  status <- status <?> "cleared flag"+  status <- statusp <?> "cleared status"   code <- codep <?> "transaction code"   description <- descriptionp >>= return . strip   comment <- try followingcommentp <|> (newline >> return "")@@ -385,14 +410,14 @@      nulltransaction{       tdate=parsedate "2012/05/14",       tdate2=Just $ parsedate "2012/05/15",-      tstatus=False,+      tstatus=Uncleared,       tcode="code",       tdescription="desc",       tcomment=" tcomment1\n tcomment2\n ttag1: val1\n",       ttags=[("ttag1","val1")],       tpostings=[         nullposting{-          pstatus=True,+          pstatus=Cleared,           paccount="a",           pamount=Mixed [usd 1],           pcomment=" pcomment1\n pcomment2\n ptag1: val1\n  ptag2: val2\n",@@ -403,6 +428,13 @@         ],       tpreceding_comment_lines=""       }+    unlines [+      "2015/1/1",+      ]+     `gives`+     nulltransaction{+      tdate=parsedate "2015/01/01",+      }      assertRight $ parseWithCtx nullctx transaction $ unlines       ["2007/01/28 coopportunity"@@ -441,8 +473,10 @@     assertEqual 2 (let Right t = p in length $ tpostings t) #endif --- | Parse a date in YYYY/MM/DD format. Fewer digits are allowed. The year--- may be omitted if a default year has already been set.+-- | Parse a date in YYYY/MM/DD format.+-- Hyphen (-) and period (.) are also allowed as separators.+-- The year may be omitted if a default year has been set.+-- Leading zeroes may be omitted. datep :: Stream [Char] m t => ParsecT [Char] JournalContext m Day datep = do   -- hacky: try to ensure precise errors for invalid dates@@ -464,10 +498,12 @@     Just date -> return date   <?> "full or partial date" --- | Parse a date and time in YYYY/MM/DD HH:MM[:SS][+-ZZZZ] format.  Any--- 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.+-- | Parse a date and time in YYYY/MM/DD HH:MM[:SS][+-ZZZZ] format.+-- Hyphen (-) and period (.) are also allowed as date separators.+-- The year may be omitted if a default year has been set.+-- Seconds are optional.+-- The timezone is optional and ignored (the time is always interpreted as a local time).+-- Leading zeroes may be omitted (except in a timezone). datetimep :: Stream [Char] m Char => ParsecT [Char] JournalContext m LocalTime datetimep = do   day <- datep@@ -509,15 +545,21 @@   edate <- withDefaultYear primarydate datep   return edate -status :: Stream [Char] m Char => ParsecT [Char] JournalContext m Bool-status = try (do { many spacenonewline; (char '*' <|> char '!') <?> "status"; return True } ) <|> return False+statusp :: Stream [Char] m Char => ParsecT [Char] JournalContext m ClearedStatus+statusp =+  choice'+    [ many spacenonewline >> char '*' >> return Cleared+    , many spacenonewline >> char '!' >> return Pending+    , return Uncleared+    ]+    <?> "cleared status"  codep :: Stream [Char] m Char => ParsecT [Char] JournalContext m 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 :: Stream [Char] m Char => ParsecT [Char] JournalContext m [Posting]-postings = many1 (try postingp) <?> "postings"+postings = many (try postingp) <?> "postings"  -- linebeginningwithspaces :: Stream [Char] m Char => ParsecT [Char] JournalContext m String -- linebeginningwithspaces = do@@ -529,7 +571,7 @@ postingp :: Stream [Char] m Char => ParsecT [Char] JournalContext m Posting postingp = do   many1 spacenonewline-  status <- status+  status <- statusp   many spacenonewline   account <- modifiedaccountname   let (ptype, account') = (accountNamePostingType account, unbracket account)@@ -619,21 +661,24 @@   aliases <- getAccountAliases   return $ accountNameApplyAliases aliases prefixed --- | Parse an account name. Account names may have single spaces inside--- 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.+-- | Parse an account name. Account names start with a non-space, may+-- have single spaces inside them, and are terminated by two or more+-- spaces (or end of input). Also they have one or more components of+-- at least one character, separated by the account separator char.+-- (This parser will also consume one following space, if present.) accountnamep :: Stream [Char] m Char => ParsecT [Char] st m AccountName accountnamep = do-    a <- many1 (nonspace <|> singlespace)-    let a' = striptrailingspace a-    when (accountNameFromComponents (accountNameComponents a') /= a')-         (fail $ "account name seems ill-formed: "++a')-    return a'+    a <- do+      c <- nonspace+      cs <- striptrailingspace <$> many (nonspace <|> singlespace)+      return $ c:cs+    when (accountNameFromComponents (accountNameComponents a) /= a)+         (fail $ "account name seems ill-formed: "++a)+    return a     where       singlespace = try (do {spacenonewline; do {notFollowedBy spacenonewline; return ' '}})-      -- couldn't avoid consuming a final space sometimes, harmless-      striptrailingspace s = if last s == ' ' then init s else s+      striptrailingspace "" = ""+      striptrailingspace s  = if last s == ' ' then init s else s  -- accountnamechar = notFollowedBy (oneOf "()[]") >> nonspace --     <?> "account name character (non-bracket, non-parenthesis, non-whitespace)"@@ -816,7 +861,7 @@   -- ptrace "numberp"   sign <- signp   parts <- many1 $ choice' [many1 digit, many1 $ char ',', many1 $ char '.']-  dbgAt 8 "numberp parsed" (sign,parts) `seq` return ()+  dbg8 "numberp parsed" (sign,parts) `seq` return ()    -- check the number is well-formed and identify the decimal point and digit   -- group separator characters used, if any@@ -854,40 +899,38 @@       frac' = if null frac then "0" else frac       quantity = read $ sign++int'++"."++frac' -- this read should never fail -  return $ dbgAt 8 "numberp quantity,precision,mdecimalpoint,mgrps" (quantity,precision,mdecimalpoint,mgrps)+  return $ dbg8 "numberp quantity,precision,mdecimalpoint,mgrps" (quantity,precision,mdecimalpoint,mgrps)   <?> "numberp"   where     numeric = isNumber . headDef '_' -#ifdef TESTS-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, '.', ',', [])-      "1.1"        `is` (1.1, 1, '.', ',', [])-      "1,000.1"    `is` (1000.1, 1, '.', ',', [3])-      "1.00.000,1" `is` (100000.1, 1, ',', '.', [3,2])-      "1,000,000"  `is` (1000000, 0, '.', ',', [3,3])-      "1."         `is` (1,   0, '.', ',', [])-      "1,"         `is` (1,   0, ',', '.', [])-      ".1"         `is` (0.1, 1, '.', ',', [])-      ",1"         `is` (0.1, 1, ',', '.', [])-      assertFails "1,000.000,1"-      assertFails "1.000,000.1"-      assertFails "1,000.000.1"-      assertFails "1,,1"-      assertFails "1..1"-      assertFails ".1,"-      assertFails ",1."-#endif+-- 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, '.', ',', [])+--       "1.1"        `is` (1.1, 1, '.', ',', [])+--       "1,000.1"    `is` (1000.1, 1, '.', ',', [3])+--       "1.00.000,1" `is` (100000.1, 1, ',', '.', [3,2])+--       "1,000,000"  `is` (1000000, 0, '.', ',', [3,3])+--       "1."         `is` (1,   0, '.', ',', [])+--       "1,"         `is` (1,   0, ',', '.', [])+--       ".1"         `is` (0.1, 1, '.', ',', [])+--       ",1"         `is` (0.1, 1, ',', '.', [])+--       assertFails "1,000.000,1"+--       assertFails "1.000,000.1"+--       assertFails "1,000.000.1"+--       assertFails "1,,1"+--       assertFails "1..1"+--       assertFails ".1,"+--       assertFails ",1."  -- comment parsers  multilinecommentp :: Stream [Char] m Char => ParsecT [Char] JournalContext m () multilinecommentp = do-  string "comment" >> newline+  string "comment" >> many spacenonewline >> newline   go   where     go = try (string "end comment" >> newline >> return ())@@ -983,9 +1026,13 @@ date2ValueFromTags ts = maybe Nothing (Just . snd) $ find ((=="date2") . fst) ts  +tests_Hledger_Read_JournalReader = TestList $ concat [+    -- test_numberp+ ]+ {- old hunit tests -test_Hledger_Read_JournalReader = TestList $ concat [+tests_Hledger_Read_JournalReader = TestList $ concat [     test_numberp,     test_amountp,     test_spaceandamountormissing,

@@ -62,19 +62,19 @@ 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+      -- dbg1 = const id -- exclude from debug output+      dbg1 s = let p = "balanceReport" in Hledger.Utils.dbg1 (p++" "++s)  -- add prefix in debug output        accts = ledgerRootAccount $ ledgerFromJournal q $ journalSelectingAmountFromOpts opts j       accts' :: [Account]           | queryDepth q == 0 =-                         dbg "accts" $+                         dbg1 "accts" $                          take 1 $ clipAccountsAndAggregate (queryDepth q) $ flattenAccounts accts-          | flat_ opts = dbg "accts" $+          | flat_ opts = dbg1 "accts" $                          filterzeros $                          filterempty $                          drop 1 $ clipAccountsAndAggregate (queryDepth q) $ flattenAccounts accts-          | otherwise  = dbg "accts" $+          | otherwise  = dbg1 "accts" $                          filter (not.aboring) $                          drop 1 $ flattenAccounts $                          markboring $@@ -86,9 +86,9 @@             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" $+      items = dbg1 "items" $ map (balanceReportItem opts q) accts'+      total | not (flat_ opts) = dbg1 "total" $ sum [amt | ((_,_,indent),amt) <- items, indent == 0]+            | otherwise        = dbg1 "total" $                                  if flatShowsExclusiveBalance                                  then sum $ map snd items                                  else sum $ map aebalance $ clipAccountsAndAggregate 1 accts'@@ -332,7 +332,7 @@              tsourcepos=nullsourcepos,              tdate=parsedate "2008/01/01",              tdate2=Just $ parsedate "2009/01/01",-             tstatus=False,+             tstatus=Uncleared,              tcode="",              tdescription="income",              tcomment="",

@@ -73,41 +73,41 @@ multiBalanceReport :: ReportOpts -> Query -> Journal -> MultiBalanceReport multiBalanceReport opts q j = MultiBalanceReport (displayspans, items, totalsrow)     where-      symq       = dbg "symq"   $ filterQuery queryIsSym $ dbg "requested q" q-      depthq     = dbg "depthq" $ filterQuery queryIsDepth q+      symq       = dbg1 "symq"   $ filterQuery queryIsSym $ dbg1 "requested q" q+      depthq     = dbg1 "depthq" $ filterQuery queryIsDepth q       depth      = queryDepth depthq-      depthless  = dbg "depthless" . filterQuery (not . queryIsDepth)-      datelessq  = dbg "datelessq"  $ filterQuery (not . queryIsDateOrDate2) q+      depthless  = dbg1 "depthless" . filterQuery (not . queryIsDepth)+      datelessq  = dbg1 "datelessq"  $ filterQuery (not . queryIsDateOrDate2) 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+      precedingq = dbg1 "precedingq" $ And [datelessq, dateqcons $ DateSpan Nothing (spanStart reportspan)]+      requestedspan  = dbg1 "requestedspan"  $ queryDateSpan (date2_ opts) q                              -- span specified by -b/-e/-p options and query args+      requestedspan' = dbg1 "requestedspan'" $ requestedspan `spanDefaultsFrom` journalDateSpan (date2_ opts) j  -- if open-ended, close it using the journal's end dates+      intervalspans  = dbg1 "intervalspans"  $ splitSpan (intervalFromOpts opts) requestedspan'           -- interval spans enclosing it+      reportspan     = dbg1 "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+      newdatesq = dbg1 "newdateq" $ dateqcons reportspan+      reportq  = dbg1 "reportq" $ depthless $ And [datelessq, newdatesq] -- user's query enlarged to whole intervals and with no depth limit        ps :: [Posting] =-          dbg "ps" $+          dbg1 "ps" $           journalPostings $           filterJournalAmounts 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+      displayspans = dbg1 "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+            | empty_ opts = dbg1 "displayspan (-E)" $ reportspan                                -- all the requested intervals+            | otherwise   = dbg1 "displayspan"      $ requestedspan `spanIntersect` matchedspan -- exclude leading/trailing empty intervals+          matchedspan = dbg1 "matchedspan" $ postingsDateSpan' (whichDateFromOpts opts) ps        psPerSpan :: [[Posting]] =-          dbg "psPerSpan" $+          dbg1 "psPerSpan" $           [filter (isPostingInDateSpan' (whichDateFromOpts opts) s) ps | s <- displayspans]        postedAcctBalChangesPerSpan :: [[(ClippedAccountName, MixedAmount)]] =-          dbg "postedAcctBalChangesPerSpan" $+          dbg1 "postedAcctBalChangesPerSpan" $           map postingAcctBals psPerSpan           where             postingAcctBals :: [Posting] -> [(ClippedAccountName, MixedAmount)]@@ -120,36 +120,36 @@                       | 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+      postedAccts :: [AccountName] = dbg1 "postedAccts" $ sort $ accountNamesFromPostings ps        -- starting balances and accounts from transactions before the report start date-      startacctbals = dbg "startacctbals" $ map (\((a,_,_),b) -> (a,b)) startbalanceitems+      startacctbals = dbg1 "startacctbals" $ map (\((a,_,_),b) -> (a,b)) startbalanceitems           where-            (startbalanceitems,_) = dbg "starting balance report" $ balanceReport opts' precedingq j+            (startbalanceitems,_) = dbg1 "starting balance report" $ balanceReport opts' precedingq j                                     where                                       opts' | tree_ opts = opts{no_elide_=True}                                             | otherwise  = opts{accountlistmode_=ALFlat}       startingBalanceFor a = fromMaybe nullmixedamt $ lookup a startacctbals-      startAccts = dbg "startAccts" $ map fst startacctbals+      startAccts = dbg1 "startAccts" $ map fst startacctbals        displayedAccts :: [ClippedAccountName] =-          dbg "displayedAccts" $+          dbg1 "displayedAccts" $           (if tree_ opts then expandAccountNames else id) $           nub $ map (clipOrEllipsifyAccountName depth) $           if empty_ opts then nub $ sort $ startAccts ++ postedAccts else postedAccts        acctBalChangesPerSpan :: [[(ClippedAccountName, MixedAmount)]] =-          dbg "acctBalChangesPerSpan" $+          dbg1 "acctBalChangesPerSpan" $           [sortBy (comparing fst) $ unionBy (\(a,_) (a',_) -> a == a') postedacctbals zeroes            | postedacctbals <- postedAcctBalChangesPerSpan]           where zeroes = [(a, nullmixedamt) | a <- displayedAccts]        acctBalChanges :: [(ClippedAccountName, [MixedAmount])] =-          dbg "acctBalChanges" $+          dbg1 "acctBalChanges" $           [(a, map snd abs) | abs@((a,_):_) <- transpose acctBalChangesPerSpan] -- never null, or used when null...        items :: [MultiBalanceReportRow] =-          dbg "items" $+          dbg1 "items" $           [((a, accountLeafName a, accountNameLevel a), displayedBals, rowtot, rowavg)            | (a,changes) <- acctBalChanges            , let displayedBals = case balancetype_ opts of@@ -162,18 +162,18 @@            ]        totals :: [MixedAmount] =-          -- dbg "totals" $+          -- dbg1 "totals" $           map sum balsbycol           where             balsbycol = transpose [bs | ((a,_,_),bs,_,_) <- items, not (tree_ opts) || a `elem` highestlevelaccts]             highestlevelaccts     =-                dbg "highestlevelaccts" $+                dbg1 "highestlevelaccts" $                 [a | a <- displayedAccts, not $ any (`elem` displayedAccts) $ init $ expandAccountName a]        totalsrow :: MultiBalanceTotalsRow =-          dbg "totalsrow" $+          dbg1 "totalsrow" $           (totals, sum totals, averageMixedAmounts totals) -      dbg s = let p = "multiBalanceReport" in Hledger.Utils.dbg (p++" "++s)  -- add prefix in this function's debug output-      -- dbg = const id  -- exclude this function from debug output+      dbg1 s = let p = "multiBalanceReport" in Hledger.Utils.dbg1 (p++" "++s)  -- add prefix in this function's debug output+      -- dbg1 = const id  -- exclude this function from debug output 

@@ -54,7 +54,7 @@ postingsReport opts q j = (totallabel, items)     where       -- figure out adjusted queries & spans like multiBalanceReport-      symq = dbg "symq"   $ filterQuery queryIsSym $ dbg "requested q" q+      symq = dbg1 "symq"   $ filterQuery queryIsSym $ dbg1 "requested q" q       depth = queryDepth q       depthless = filterQuery (not . queryIsDepth)       datelessq = filterQuery (not . queryIsDateOrDate2) q@@ -62,39 +62,39 @@       dateq = filterQuery queryIsDateOrDate2 q       (dateqcons,pdate) | queryIsDate2 dateq || (queryIsDate dateq && date2_ opts) = (Date2, postingDate2)                         | otherwise = (Date, postingDate)-      requestedspan  = dbg "requestedspan"  $ queryDateSpan' q   -- span specified by -b/-e/-p options and query args-      requestedspan' = dbg "requestedspan'" $ requestedspan `spanDefaultsFrom` journalDateSpan ({-date2_ opts-} False) 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+      requestedspan  = dbg1 "requestedspan"  $ queryDateSpan' q   -- span specified by -b/-e/-p options and query args+      requestedspan' = dbg1 "requestedspan'" $ requestedspan `spanDefaultsFrom` journalDateSpan ({-date2_ opts-} False) j  -- if open-ended, close it using the journal's end dates+      intervalspans  = dbg1 "intervalspans"  $ splitSpan (intervalFromOpts opts) requestedspan' -- interval spans enclosing it+      reportstart    = dbg1 "reportstart"    $ maybe Nothing spanStart $ headMay intervalspans+      reportend      = dbg1 "reportend"      $ maybe Nothing spanEnd   $ lastMay intervalspans+      reportspan     = dbg1 "reportspan"     $ DateSpan reportstart reportend  -- the requested span enlarged to a whole number of intervals+      beforestartq   = dbg1 "beforestartq"   $ dateqcons $ DateSpan Nothing reportstart+      beforeendq     = dbg1 "beforeendq"     $ dateqcons $ DateSpan Nothing reportend+      reportq        = dbg1 "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" $ sortBy (comparing pdate) $                                  -- sort postings by date (or date2)-          dbg "ps3" $ map (filterPostingAmount symq) $                            -- remove amount parts which the query's cur: terms would exclude-          dbg "ps2" $ (if related_ opts then concatMap relatedPostings else id) $ -- with -r, replace each with its sibling postings-          dbg "ps1" $ filter (reportq `matchesPosting`) $                         -- filter postings by the query, including before the report start date, ignoring depth+          dbg1 "ps4" $ sortBy (comparing pdate) $                                  -- sort postings by date (or date2)+          dbg1 "ps3" $ map (filterPostingAmount symq) $                            -- remove amount parts which the query's cur: terms would exclude+          dbg1 "ps2" $ (if related_ opts then concatMap relatedPostings else id) $ -- with -r, replace each with its sibling postings+          dbg1 "ps1" $ filter (reportq `matchesPosting`) $                         -- filter postings by the query, including before the report start date, ignoring depth                       journalPostings $ journalSelectingAmountFromOpts opts j-      (precedingps, reportps) = dbg "precedingps, reportps" $ span (beforestartq `matchesPosting`) pstoend+      (precedingps, reportps) = dbg1 "precedingps, reportps" $ span (beforestartq `matchesPosting`) pstoend -      showempty = queryEmpty q || average_ opts+      showempty = empty_ opts || average_ opts       -- displayexpr = display_ opts  -- XXX       interval = intervalFromOpts opts -- XXX        whichdate = whichDateFromOpts opts       itemps | interval == NoInterval = map (,Nothing) reportps              | otherwise              = summarisePostingsByInterval interval whichdate depth showempty reportspan reportps-      items = dbg "items" $ postingsReportItems itemps (nullposting,Nothing) whichdate depth startbal runningcalc 1+      items = dbg1 "items" $ postingsReportItems itemps (nullposting,Nothing) 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+      dbg1 s = let p = "postingsReport" in Hledger.Utils.dbg1 (p++" "++s)  -- add prefix in debug output+      -- dbg1 = const id  -- exclude from debug output  totallabel = "Total" @@ -228,13 +228,13 @@    (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+   (And [Depth 1, Status Cleared, Acct "expenses"], samplejournal) `gives` 2+   (And [And [Depth 1, Status Cleared], 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 "" 19 (length $ snd $ postingsReport defreportopts{monthly_=True, empty_=True} Any samplejournal)    assertEqual ""  4 (length $ snd $ postingsReport defreportopts (Acct "assets:bank:checking") samplejournal)     -- (defreportopts, And [Acct "a a", Acct "'b"], samplejournal2) `gives` 0

@@ -63,6 +63,7 @@     ,end_            :: Maybe Day     ,period_         :: Maybe (Interval,DateSpan)     ,cleared_        :: Bool+    ,pending_        :: Bool     ,uncleared_      :: Bool     ,cost_           :: Bool     ,depth_          :: Maybe Int@@ -119,6 +120,7 @@     def     def     def+    def  rawOptsToReportOpts :: RawOpts -> IO ReportOpts rawOptsToReportOpts rawopts = do@@ -128,6 +130,7 @@     ,end_         = maybesmartdateopt d "end" rawopts     ,period_      = maybeperiodopt d rawopts     ,cleared_     = boolopt "cleared" rawopts+    ,pending_     = boolopt "pending" rawopts     ,uncleared_   = boolopt "uncleared" rawopts     ,cost_        = boolopt "cost" rawopts     ,depth_       = maybeintopt "depth" rawopts@@ -226,9 +229,10 @@                   | 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+clearedValueFromOpts :: ReportOpts -> Maybe ClearedStatus+clearedValueFromOpts ReportOpts{..} | cleared_   = Just Cleared+                                    | pending_   = Just Pending+                                    | uncleared_ = Just Uncleared                                     | otherwise  = Nothing  -- depthFromOpts :: ReportOpts -> Int

@@ -86,66 +86,94 @@     where       args = unsafePerformIO getArgs --- | Print a message and a showable value to the console if the global--- debug level is non-zero.  Uses unsafePerformIO.+-- | Convenience aliases for tracePrettyAt.+-- Pretty-print a message and the showable value to the console, then return it. dbg :: Show a => String -> a -> a-dbg = dbg1---- always prints-dbg0 :: Show a => String -> a -> a-dbg0 = dbgAt 0+dbg = tracePrettyAt 0 +-- | Pretty-print a message and the showable value to the console when the debug level is >= 1, then return it. Uses unsafePerformIO. dbg1 :: Show a => String -> a -> a-dbg1 = dbgAt 1+dbg1 = tracePrettyAt 1  dbg2 :: Show a => String -> a -> a-dbg2 = dbgAt 2+dbg2 = tracePrettyAt 2  dbg3 :: Show a => String -> a -> a-dbg3 = dbgAt 3+dbg3 = tracePrettyAt 3  dbg4 :: Show a => String -> a -> a-dbg4 = dbgAt 4+dbg4 = tracePrettyAt 4  dbg5 :: Show a => String -> a -> a-dbg5 = dbgAt 5+dbg5 = tracePrettyAt 5  dbg6 :: Show a => String -> a -> a-dbg6 = dbgAt 6+dbg6 = tracePrettyAt 6  dbg7 :: Show a => String -> a -> a-dbg7 = dbgAt 7+dbg7 = tracePrettyAt 7  dbg8 :: Show a => String -> a -> a-dbg8 = dbgAt 8+dbg8 = tracePrettyAt 8  dbg9 :: Show a => String -> a -> a-dbg9 = dbgAt 9+dbg9 = tracePrettyAt 9 --- | 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+-- | Convenience aliases for tracePrettyAtIO.+-- Like dbg, but convenient to insert in an IO monad.+dbgIO :: Show a => String -> a -> IO ()+dbgIO = tracePrettyAtIO 0 -    -- Could not deduce (a ~ ())-    -- from the context (Show a)-    --   bound by the type signature for-    --              dbgM :: Show a => String -> a -> IO ()-    --   at hledger/Hledger/Cli/Main.hs:200:13-42-    --   ‘a’ is a rigid type variable bound by-    --       the type signature for dbgM :: Show a => String -> a -> IO ()-    --       at hledger/Hledger/Cli/Main.hs:200:13-    -- Expected type: String -> a -> IO ()-    --   Actual type: String -> a -> IO a--- dbgAtM :: (Monad m, Show a) => Int -> String -> a -> m a--- dbgAtM lvl lbl x = dbgAt lvl lbl x `seq` return x--- XXX temporary:-dbgAtM :: Show a => Int -> String -> a -> IO ()-dbgAtM = dbgAtIO+dbg1IO :: Show a => String -> a -> IO ()+dbg1IO = tracePrettyAtIO 1 -dbgAtIO :: Show a => Int -> String -> a -> IO ()-dbgAtIO lvl lbl x = dbgAt lvl lbl x `seq` return ()+dbg2IO :: Show a => String -> a -> IO ()+dbg2IO = tracePrettyAtIO 2 +dbg3IO :: Show a => String -> a -> IO ()+dbg3IO = tracePrettyAtIO 3++dbg4IO :: Show a => String -> a -> IO ()+dbg4IO = tracePrettyAtIO 4++dbg5IO :: Show a => String -> a -> IO ()+dbg5IO = tracePrettyAtIO 5++dbg6IO :: Show a => String -> a -> IO ()+dbg6IO = tracePrettyAtIO 6++dbg7IO :: Show a => String -> a -> IO ()+dbg7IO = tracePrettyAtIO 7++dbg8IO :: Show a => String -> a -> IO ()+dbg8IO = tracePrettyAtIO 8++dbg9IO :: Show a => String -> a -> IO ()+dbg9IO = tracePrettyAtIO 9++-- | Pretty-print a message and a showable value to the console if the debug level is at or above the specified level.+-- dbtAt 0 always prints. Otherwise, uses unsafePerformIO.+tracePrettyAt :: Show a => Int -> String -> a -> a+tracePrettyAt lvl = dbgppshow lvl++tracePrettyAtIO :: Show a => Int -> String -> a -> IO ()+tracePrettyAtIO lvl lbl x = tracePrettyAt lvl lbl x `seq` return ()++-- XXX+-- Could not deduce (a ~ ())+-- from the context (Show a)+--   bound by the type signature for+--              dbgM :: Show a => String -> a -> IO ()+--   at hledger/Hledger/Cli/Main.hs:200:13-42+--   ‘a’ is a rigid type variable bound by+--       the type signature for dbgM :: Show a => String -> a -> IO ()+--       at hledger/Hledger/Cli/Main.hs:200:13+-- Expected type: String -> a -> IO ()+--   Actual type: String -> a -> IO a+--+-- tracePrettyAtM :: (Monad m, Show a) => Int -> String -> a -> m a+-- tracePrettyAtM lvl lbl x = tracePrettyAt lvl lbl x `seq` return x+ -- | print this string to the console before evaluating the expression, -- if the global debug level is non-zero.  Uses unsafePerformIO. dbgtrace :: String -> a -> a@@ -168,7 +196,7 @@ -- Values are displayed with ppShow, each field/constructor on its own line. dbgppshow :: Show a => Int -> String -> a -> a dbgppshow level-    | debugLevel < level = flip const+    | level > 0 && debugLevel < level = flip const     | otherwise = \s a -> let p = ppShow a                               ls = lines p                               nlorspace | length ls > 1 = "\n"

@@ -1,8 +1,7 @@ {-# LANGUAGE ScopedTypeVariables #-} {-| -Easy regular expression helpers, based on regex-tdfa and (a little) on-regexpr. These should:+Easy regular expression helpers, currently based on regex-tdfa. These should:  - be cross-platform, not requiring C libraries @@ -30,22 +29,19 @@    -- * type aliases    Regexp   ,Replacement-   -- * based on regex-tdfa+   -- * standard regex operations   ,regexMatches   ,regexMatchesCI   ,regexReplace   ,regexReplaceCI   ,regexReplaceBy   ,regexReplaceByCI-   -- * based on regexpr-  ,regexSplit   ) where  import Data.Array import Data.Char import Data.List (foldl')-import Text.RegexPR (splitRegexPR) import Text.Regex.TDFA (   Regex, CompOption(..), ExecOption(..), defaultCompOpt, defaultExecOpt,   makeRegexOpts, AllMatches(getAllMatches), match, (=~), MatchText@@ -131,9 +127,4 @@       let (skip, start) = splitAt (off - ind) read           (matched, remaining) = splitAt len start       in (off + len, remaining, write . (skip++) . (f matched ++))---- uses regexpr, may be slow:--regexSplit :: Regexp -> String -> [Regexp]-regexSplit = splitRegexPR 

@@ -1,5 +1,5 @@ name:           hledger-lib-version: 0.25.1+version: 0.26 stability:      stable category:       Finance, Console synopsis:       Core data types, parsers and utilities for the hledger accounting tool.@@ -105,7 +105,6 @@                  ,old-time                  ,parsec >= 3                  ,regex-tdfa-                 ,regexpr >= 0.5.1                  ,safe >= 0.2                  ,split >= 0.1 && < 0.3                  ,transformers >= 0.2 && < 0.5@@ -144,7 +143,6 @@                , old-time                , parsec >= 3                , regex-tdfa-               , regexpr                , safe                , split                , test-framework