penny-lib 0.14.0.0 → 0.16.0.0

raw patch · 17 files changed

+232/−129 lines, 17 filesdep ~prednotedep ~rainbowPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: prednote, rainbow

API changes (from Hackage documentation)

Files

• lib/Penny/Brenner/OFX.hs +4/−0
• lib/Penny/Cabin/Balance/Convert/Chunker.hs +6/−5
• lib/Penny/Cabin/Balance/MultiCommodity/Chunker.hs +5/−3
• lib/Penny/Cabin/Posts.hs +3/−3
• lib/Penny/Cabin/Posts/Allocated.hs +3/−2
• lib/Penny/Cabin/Posts/BottomRows.hs +4/−3
• lib/Penny/Cabin/Posts/Growers.hs +6/−5
• lib/Penny/Cabin/Row.hs +7/−5
• lib/Penny/Cabin/Scheme.hs +8/−7
• lib/Penny/Cabin/Scheme/Schemes.hs +9/−9
• lib/Penny/Copper.hs +72/−1
• lib/Penny/Copper/Parsec.hs +51/−24
• lib/Penny/Lincoln/Balance.hs +25/−16
• lib/Penny/Lincoln/Ents.hs +16/−29
• lib/Penny/Wheat.hs +1/−1
• lib/Penny/Zinc.hs +5/−5
• penny-lib.cabal +7/−11

@@ -1,6 +1,10 @@ {-# LANGUAGE OverloadedStrings #-} -- | Parses any OFX 1.0-series file. Uses the parser from the ofx -- package.+--+-- The Postings that this module returns /always/ have an empty+-- Description field. Information from the OFX Payee field is placed+-- into the Payee field of the Posting record.  module Penny.Brenner.OFX (parser) where 

@@ -11,6 +11,7 @@  import Control.Applicative   (Applicative (pure), (<$>), (<*>))+import Data.Monoid (mempty) import qualified Penny.Cabin.Scheme as E import qualified Penny.Cabin.Meta as Meta import qualified Penny.Cabin.Row as R@@ -59,7 +60,7 @@   -> Columns PreSpec   -> Columns R.Width maxWidthPerColumn w p = f <$> w <*> p where-  f old new = max old (R.Width . X.length . Rb.chunkText . bits $ new)+  f old new = max old (R.Width . X.length . Rb._text . bits $ new)  -- | Changes a single set of Columns to a set of ColumnSpec of the -- given width.@@ -192,9 +193,9 @@     eo = E.fromVisibleNum vn     lbl = E.Other     ca = PreSpec R.LeftJustify (lbl, eo)-         (E.getEvenOddLabelValue lbl eo chgrs $ Rb.plain txt)+         (E.getEvenOddLabelValue lbl eo chgrs . Rb.Chunk mempty $ txt)     cd = PreSpec R.LeftJustify (lbl, eo)-         (E.getEvenOddLabelValue lbl eo chgrs $ Rb.plain X.empty)+         (E.getEvenOddLabelValue lbl eo chgrs mempty)     cq = cd  mkMainRow@@ -207,7 +208,7 @@     applyFmt = E.getEvenOddLabelValue lbl eo chgrs     eo = E.fromVisibleNum vn     lbl = E.Other-    ca = PreSpec R.LeftJustify (lbl, eo) (applyFmt (Rb.plain txt))+    ca = PreSpec R.LeftJustify (lbl, eo) (applyFmt (Rb.Chunk mempty txt))       where         txt = X.append indents acctTxt         indents = X.replicate (indentAmount * max 0 i)@@ -228,7 +229,7 @@     eo = E.fromVisibleNum vn     chkDc = E.bottomLineToDrCr bl eo chgrs     qtFmt = E.getEvenOddLabelValue lbl eo chgrs-    chkQt = qtFmt $ Rb.plain t+    chkQt = qtFmt $ Rb.Chunk mempty t     (lbl, t) = case bl of       L.Zero -> (E.Zero, X.pack "--")       L.NonZero (L.Column dc qt) -> (E.dcToLbl dc, fmt qt)

@@ -1,3 +1,4 @@+{-# LANGUAGE OverloadedStrings #-} -- | Creates the output Chunks for the Balance report for both -- multi-commodity reports. @@ -13,6 +14,7 @@ import qualified Penny.Cabin.Row as R import qualified Penny.Cabin.Scheme as E import qualified Penny.Lincoln as L+import Data.Monoid (mempty) import qualified Data.Foldable as Fdbl import qualified Data.Text as X import qualified System.Console.Rainbow as Rb@@ -61,7 +63,7 @@   -> Columns R.Width maxWidthPerColumn w p = f <$> w <*> p where   f old new = max old ( safeMaximum (R.Width 0)-                        . map (R.Width . X.length . Rb.chunkText)+                        . map (R.Width . X.length . Rb._text)                         . bits $ new)   safeMaximum d ls = if null ls then d else maximum ls @@ -177,7 +179,7 @@     lbl = E.Other     eo = E.fromVisibleNum vn     applyFmt = E.getEvenOddLabelValue lbl eo chgrs-    ca = PreSpec R.LeftJustify (lbl, eo) [applyFmt $ Rb.plain txt]+    ca = PreSpec R.LeftJustify (lbl, eo) [applyFmt $ Rb.Chunk mempty txt]       where         txt = X.append indents acctTxt         indents = X.replicate (indentAmount * max 0 i)@@ -202,7 +204,7 @@   -> ([Rb.Chunk], [Rb.Chunk], [Rb.Chunk]) balanceChunksEmpty chgrs eo = (dash, dash, dash)   where-    dash = [E.getEvenOddLabelValue E.Other eo chgrs $ Rb.plain (X.pack "--")]+    dash = [E.getEvenOddLabelValue E.Other eo chgrs $ "--"]  balanceChunks   :: E.Changers

@@ -169,7 +169,7 @@ indentAmt = 4  blankLine :: Rb.Chunk-blankLine = Rb.plain (X.singleton '\n')+blankLine = "\n"  showExpression   :: P.ShowExpression@@ -178,7 +178,7 @@ showExpression (P.ShowExpression b) pdct =   if not b then [] else info : blankLine : (chks ++ [blankLine])   where-    info = Rb.plain (X.pack "Postings filter expression:\n")+    info = "Postings filter expression:\n"     chks = Pe.showPdct indentAmt 0 pdct  showVerboseFilter@@ -192,7 +192,7 @@     pdcts = map (makeLabeledPdct pdct) bs     chks = concat . map snd $ zipWith doEval bs pdcts     doEval subj pd = Pe.evaluate indentAmt False subj 0 pd-    info = Rb.plain (X.pack "Postings report filter:\n")+    info = "Postings report filter:\n"  -- | Creates a Pdct and prepends a one-line description of the PostFam -- to the Pdct's label so it can be easily identified in the output.

@@ -58,6 +58,7 @@ import Control.Applicative(Applicative((<*>), pure), (<$>)) import Control.Arrow (second) import Data.Maybe (catMaybes, isJust)+import Data.Monoid (mempty) import Data.List (intersperse) import qualified Data.Foldable as Fdbl import qualified Data.Sequence as Seq@@ -340,7 +341,7 @@                   $ pye                 toBit (TF.Words seqTxts) =                   md-                  . Rb.plain+                  . Rb.Chunk mempty                   . X.unwords                   . Fdbl.toList                   $ seqTxts@@ -374,7 +375,7 @@         ws = TF.Words . Seq.fromList . map L.unSubAccount $ aList         (TF.Words shortened) = TF.shorten shortest target ws         sq = [ md-               . Rb.plain+               . Rb.Chunk mempty                . X.concat                . intersperse (X.singleton ':')                . Fdbl.toList

@@ -329,7 +329,7 @@     . snd     $ info   md = E.getEvenOddLabelValue E.Other eo ch-  toBit (TF.Words ws) = md . Rb.plain $ t where+  toBit (TF.Words ws) = md . Rb.Chunk mempty $ t where     t = X.concat . intersperse (X.singleton ' ') . Fdbl.toList $ ws  @@ -347,7 +347,8 @@        . L.unMemo        $ m   md = E.getEvenOddLabelValue lbl eo ch-  toBit (TF.Words ws) = md . Rb.plain $ (X.unwords . Fdbl.toList $ ws)+  toBit (TF.Words ws) = md . Rb.Chunk mempty+                        $ (X.unwords . Fdbl.toList $ ws)   memoCell@@ -376,7 +377,7 @@   ts = (E.Other, eo)   cell = R.ColumnSpec R.LeftJustify w ts cs   md = E.getEvenOddLabelValue E.Other eo ch-  toBit n = md . Rb.plain+  toBit n = md . Rb.Chunk mempty             . X.drop (max 0 (X.length n - width)) $ n   cs = case Q.filename . snd $ info of     Nothing -> []

@@ -1,3 +1,4 @@+{-# LANGUAGE OverloadedStrings #-} -- | Calculates cells that "grow to fit." These cells grow to fit the -- widest cell in the column. No information is ever truncated from -- these cells (what use is a truncated dollar amount?)@@ -11,7 +12,7 @@ import Data.Map (elems) import qualified Data.Map as Map import qualified Data.Semigroup as Semi-import Data.Semigroup ((<>))+import Data.Semigroup ((<>), mempty) import Data.Text (Text, pack, empty) import qualified Data.Text as X import qualified Penny.Cabin.Posts.Fields as F@@ -63,7 +64,7 @@ widestLine (PreSpec _ _ bs) =   case bs of     [] -> 0-    xs -> maximum . map (X.length . Rb.chunkText) $ xs+    xs -> maximum . map (X.length . Rb._text) $ xs  data PreSpec = PreSpec {   _justification :: R.Justification@@ -83,7 +84,7 @@   let eo = E.fromVisibleNum . M.visibleNum . fst $ b       j = R.LeftJustify       md = E.getEvenOddLabelValue lbl eo chgrs-      ck = [md $ Rb.plain t]+      ck = [md $ Rb.Chunk mempty t]   in PreSpec j (lbl, eo) ck  @@ -234,7 +235,7 @@     L.Credit -> E.Credit   eo = E.fromVisibleNum . M.visibleNum . fst $ i   md = E.getEvenOddLabelValue lbl eo chgrs-  bit = md $ Rb.plain t+  bit = md $ Rb.Chunk mempty t   getPostingDrCr :: E.Changers -> (M.PostMeta, L.Posting) -> PreSpec@@ -259,7 +260,7 @@       md = E.getEvenOddLabelValue lbl eo ch       bits =         if Map.null bal-        then [md . Rb.plain $ pack "--"]+        then [md "--"]         else let mkChk e = E.bottomLineToDrCr e eo ch              in fmap mkChk . elems $ bal       j = R.LeftJustify

@@ -1,3 +1,4 @@+{-# LANGUAGE OverloadedStrings #-} -- | Displays a single on-screen row. A row may contain multiple -- screen lines and multiple columns. --@@ -29,6 +30,7 @@   row ) where  import Data.List (transpose)+import Data.Monoid (mempty) import qualified Data.Text as X import qualified Penny.Cabin.Scheme as E import qualified System.Console.Rainbow as R@@ -75,8 +77,8 @@   -> JustifiedCell justify (Width w) j l eo chgrs pc = JustifiedCell (left, right)   where-    origWidth = X.length . R.chunkText $ pc-    pad = E.getEvenOddLabelValue l eo chgrs $ R.plain t+    origWidth = X.length . R._text $ pc+    pad = E.getEvenOddLabelValue l eo chgrs . R.Chunk mempty $ t     t = X.replicate (max 0 (w - origWidth)) (X.singleton ' ')     (left, right) = case j of       LeftJustify -> (pc, pad)@@ -114,9 +116,9 @@   toPaddedColumn (JustifiedColumn cs (Width w) (lbl, eo)) =     let l = length cs         nPads = max 0 $ h - l-        pad = E.getEvenOddLabelValue lbl eo chgrs $ R.plain t+        pad = E.getEvenOddLabelValue lbl eo chgrs . R.Chunk mempty $ t         t = X.replicate w (X.singleton ' ')-        pads = replicate nPads $ JustifiedCell (R.plain X.empty, pad)+        pads = replicate nPads $ JustifiedCell (mempty, pad)     in cs ++ pads  @@ -128,7 +130,7 @@ toCellRowsWithNewlines (CellsByRow bs) =   CellRowsWithNewlines bs' where     bs' = foldr f [] bs-    newline = JustifiedCell (R.plain X.empty, R.plain (X.singleton '\n'))+    newline = JustifiedCell (mempty, "\n")     f cells acc = (cells ++ [newline]) : acc  

@@ -9,6 +9,7 @@  module Penny.Cabin.Scheme where +import Data.Monoid (mempty) import qualified Penny.Cabin.Meta as M import qualified Penny.Lincoln as L import qualified Data.Text as X@@ -83,10 +84,10 @@ bottomLineToDrCr bl eo chgrs = md c   where     (c, md) = case bl of-      L.Zero -> (R.plain "--", getEvenOddLabelValue Zero eo chgrs)+      L.Zero -> ("--", getEvenOddLabelValue Zero eo chgrs)       L.NonZero (L.Column clmDrCr _) -> case clmDrCr of-        L.Debit -> (R.plain "<", getEvenOddLabelValue Debit eo chgrs)-        L.Credit -> (R.plain ">", getEvenOddLabelValue Credit eo chgrs)+        L.Debit -> ("<", getEvenOddLabelValue Debit eo chgrs)+        L.Credit -> (">", getEvenOddLabelValue Credit eo chgrs)   balancesToCmdtys@@ -96,7 +97,7 @@   -> [R.Chunk] balancesToCmdtys chgrs eo ls =   if null ls-  then [getEvenOddLabelValue Zero eo chgrs $ R.plain "--"]+  then [getEvenOddLabelValue Zero eo chgrs $ "--"]   else map (bottomLineToCmdty chgrs eo) ls  bottomLineToCmdty@@ -106,7 +107,7 @@   -> R.Chunk bottomLineToCmdty chgrs eo (cy, bl) = md c   where-    c = R.plain . L.unCommodity $ cy+    c = R.Chunk mempty . L.unCommodity $ cy     lbl = case bl of       L.Zero -> Zero       L.NonZero (L.Column clmDrCr _) -> dcToLbl clmDrCr@@ -121,7 +122,7 @@ balanceToQtys chgrs getTxt eo ls =   if null ls   then let md = getEvenOddLabelValue Zero eo chgrs-       in [md (R.plain "--")]+       in [md "--"]   else map (bottomLineToQty chgrs getTxt eo) ls  @@ -131,7 +132,7 @@   -> EvenOdd   -> (L.Commodity, L.BottomLine)   -> R.Chunk-bottomLineToQty chgrs getTxt eo (cy, bl) = md (R.plain t)+bottomLineToQty chgrs getTxt eo (cy, bl) = md (R.Chunk mempty t)   where     (lbl, t) = case bl of       L.Zero -> (Zero, X.pack "--")

@@ -2,9 +2,9 @@  module Penny.Cabin.Scheme.Schemes where +import Data.Monoid ( (<>) ) import qualified Penny.Cabin.Scheme as E import qualified System.Console.Rainbow as R-import System.Console.Rainbow ((.+.))  -- | The light color scheme. You can change various values below to -- affect the color scheme.@@ -28,16 +28,16 @@ lightEvenTextSpec = id  lightOddTextSpec :: R.Chunk -> R.Chunk-lightOddTextSpec = id .+. R.color8_b_default .+. R.color256_b_255+lightOddTextSpec = (<> (R.c8_b_default <> R.c256_b_255))  lightDebit :: (R.Chunk -> R.Chunk) -> R.Chunk -> R.Chunk-lightDebit f = f .+. R.color8_f_magenta .+. R.color256_f_52+lightDebit f c = f c <> R.c8_f_magenta <> R.c256_f_52  lightCredit :: (R.Chunk -> R.Chunk) -> R.Chunk -> R.Chunk-lightCredit f = f .+. R.color8_f_cyan .+. R.color256_f_21+lightCredit f c = f c <> R.c8_f_cyan <> R.c256_f_21  lightZero :: (R.Chunk -> R.Chunk) -> R.Chunk -> R.Chunk-lightZero f = f .+. R.color8_f_black .+. R.color256_f_0+lightZero f c = f c <> R.c8_f_black <> R.c256_f_0  -- | The dark color scheme. You can change various values below to -- affect the color scheme.@@ -61,16 +61,16 @@ darkEvenTextSpec = id  darkOddTextSpec :: R.Chunk -> R.Chunk-darkOddTextSpec = id .+. R.color8_b_default .+. R.color256_b_235+darkOddTextSpec = (<> (R.c8_b_default <> R.c256_b_235))  darkDebit :: (R.Chunk -> R.Chunk) -> R.Chunk -> R.Chunk-darkDebit f = f .+. R.color8_f_magenta .+. R.color256_f_208+darkDebit f c = f c <> R.c8_f_magenta <> R.c256_f_208  darkCredit :: (R.Chunk -> R.Chunk) -> R.Chunk -> R.Chunk-darkCredit f = f .+. R.color8_f_cyan .+. R.color256_f_45+darkCredit f c = f c <> R.c8_f_cyan <> R.c256_f_45  darkZero :: (R.Chunk -> R.Chunk) -> R.Chunk -> R.Chunk-darkZero f = f .+. R.color8_f_white .+. R.color256_f_15+darkZero f c = f c <> R.c8_f_white <> R.c256_f_15  -- | Plain scheme has no colors at all. plain :: E.Scheme

@@ -4,6 +4,75 @@ -- rather than individual files because in order to correctly assign -- the global serials a single function must be able to see all the -- transactions, not just the transactions in a single file.+--+-- Some notes about Copper and performance:+--+-- Running Penny on the datasets I typically use takes about two+-- seconds. This does not seem very long on paper, and indeed it isn't+-- very long, but it would be nice if this were+-- instantaneous. Profiles consistently show that the most+-- time-consuming part of running Penny is the Parsec parse of the+-- incoming data. After eliminating the Parsec phase, the profile is+-- not showing any parts of the program whose runtime could be+-- shortened easily--the time is spent scattered amongst many+-- functions.+--+-- So the clear place to hunt for performance improvements is in the+-- Parsec phase. And, indeed, I have tried many things to improve this+-- phase. I tried using a parser based on Happy and Alex rather than+-- Parsec; this code is tagged in the Git repository, though it is so+-- old that many of the other data structures in Penny have since+-- changed. Happy and Alex did not yield any significant performance+-- improvement. As I recall, between Parsec and Happy/Alex, one was a+-- little faster but used more memory, though I can't remember which+-- was which.+--+-- The problem with using Happy and Alex is that it is a bit harder to+-- test and to maintain. Each Parsec parser is freestanding and can be+-- tested on its own; doing this with Happy would be harder. Happy+-- parsers also are not written in Haskell, though I'm not sure this+-- is a disadvantage. And, of course an advantage to Happy is that it+-- warns you if your grammar is ambiguous; Parsec will only reveal+-- this through usage or through meticulous testing.+--+-- It isn't worth using Happy/Alex in Penny because of the negligible+-- performance difference. Parsec has much better error messages than+-- Happy/Alex, which turns out to be critically important.+--+-- Another thing I tried was using Attoparsec, which bills itself as+-- being faster. The speed improvements were negligible, and+-- Parsec error messages are much better than those in Attoparsec. I+-- would have been willing to maintain a Parsec and an Attoparsec+-- parser if the latter were faster. Penny could parse with Attoparsec+-- first and, if that fails, use Parsec and use its error message. But+-- Attoparsec was so negligibly faster that I did not think this+-- worthwhile.+--+-- Another thing I tried was using the @binary@ package to serialize+-- the data in binary form. This shaved off a fair amont of run+-- time. But Penny still did not feel instantaneous--run time probably+-- dropped by about 40 percent, which is significant. The big+-- disadvantage to using binary is that you then need to get+-- plain-text ledger files into binary form, save them, and then use+-- the binary form if it is up to date. Doing this manually imposes a+-- big burden on the user to convert plain text to binary. Doing it+-- automatically could work but would be a lot of code. And then, you+-- would need to factor converstion time into the performance+-- comparison. Again, not worth it for the performance improvement+-- involved.+--+-- Probably the best performance improvement would come from putting+-- the whole ledger into SQLite. This would, however, run into the+-- same problems that exist with using a binary format: you need to+-- convert from plain text, or perhaps write an editor to change the+-- binary natively.  I'm not eager to write an editor (we already have+-- Emacs).  Furthermore, using SQLite would likely require a+-- significant re-engineering of Penny.+--+-- So, Penny continues to use the simplest, most obvious solution--a+-- Parsec parser--not from inertia or because Parsec is the default+-- choice; rather, Parsec so far has proven to be the best solution to+-- this problem. module Penny.Copper   (   -- * Convenience functions to read and parse files@@ -35,7 +104,9 @@ -- input. IO errors are not caught. Parse errors are printed to -- standard error and the program will exit with a failure. open :: [String] -> IO [I.LedgerItem]-open ss = fmap parsedToWrapped $ mapM CP.parse ss+open ss+  | null ss = fmap (parsedToWrapped . (:[])) CP.parseStdinOnly+  | otherwise = fmap parsedToWrapped $ mapM CP.parseFromFilename ss  addFilePosting   :: Tr.Traversable f

@@ -12,6 +12,7 @@ import Control.Applicative ((<$>), (<$), (<*>), (*>), (<*),                             (<|>), optional) import Control.Monad (replicateM, when)+import qualified Control.Monad.Exception.Synchronous as Ex import qualified Penny.Lincoln as L import qualified Penny.Steel.Sums as S import Data.Maybe (fromMaybe)@@ -378,38 +379,64 @@   <|> fmap S.S4c comment   <|> (S.S4d I.BlankLine) <$ blankLine + parse-  :: String-  -- ^ Name of the file to be parsed-  -> IO (L.Filename, [I.ParsedItem])-  -- ^ Returns items if successfully parsed. Quits and exits if the-  -- parse fails.+  :: Text+  -- ^ Contents of file to be parsed -parse s = do-  (fn, txt) <- getFileContentsStdin s+  -> Ex.Exceptional String [I.ParsedItem]+  -- ^ Returns items if successfully parsed; otherwise, returns an+  -- error message.++parse s =   let parser = P.spaces *> P.many item <* P.spaces <* P.eof-      filename = X.unpack . L.unFilename $ fn-  case P.parse parser filename txt of-    Left err -> do-      pn <- getProgName-      let msg = pn ++ ": error: could not parse file "-                ++ filename ++ "\n" ++ show err-      IO.hPutStr IO.stderr msg-      Exit.exitFailure-    Right g -> return (fn, g)+  in Ex.mapException show . Ex.fromEither+     $ P.parse parser "" s  +getStdin :: IO Text+getStdin = do+  pn <- getProgName+  isTerm <- IO.hIsTerminalDevice IO.stdin+  when isTerm+       (IO.hPutStrLn IO.stderr $+        pn ++ ": warning: reading from standard input, which"+           ++ " is a terminal.")+  TIO.hGetContents IO.stdin++ getFileContentsStdin :: String -> IO (L.Filename, Text) getFileContentsStdin s = do-  pn <- getProgName   txt <- if s == "-"-    then do-          isTerm <- IO.hIsTerminalDevice IO.stdin-          when isTerm-            (IO.hPutStrLn IO.stderr $-               pn ++ ": warning: reading from standard input, which"-               ++ "is a terminal.")-          TIO.hGetContents IO.stdin+    then getStdin     else TIO.readFile s   let fn = L.Filename . X.pack $ if s == "-" then "<stdin>" else s   return (fn, txt)+++parseStdinOnly :: IO (L.Filename, [I.ParsedItem])+parseStdinOnly = do+  txt <- getStdin+  case parse txt of+    Ex.Exception err -> handleParseError "standard input" err+    Ex.Success g -> return (L.Filename . X.pack $ "<stdin>", g)++parseFromFilename :: String -> IO (L.Filename, [I.ParsedItem])+parseFromFilename s = do+  (fn, txt) <- getFileContentsStdin s+  case parse txt of+    Ex.Exception err ->+      handleParseError (X.unpack . L.unFilename $ fn) err+    Ex.Success g -> return (fn, g)++handleParseError+  :: String+  -- ^ Filename+  -> String+  -> IO a+handleParseError fn e = do+  pn <- getProgName+  IO.hPutStrLn IO.stderr $ pn+        ++ ": error: could not parse " ++ fn ++ ":"+  IO.hPutStrLn IO.stderr e+  Exit.exitFailure

@@ -2,9 +2,10 @@     Balance   , unBalance   , Balanced(Balanced, Inferable, NotInferable)-  , isBalanced+  , balanced+  , isInferable   , entryToBalance-  , addBalances+  , entriesToBalanced   , removeZeroCommodities   , BottomLine(Zero, NonZero)   , Column(Column, colDrCr, colQty)@@ -12,8 +13,7 @@  import Data.Map ( Map ) import qualified Data.Map as M-import Data.Monoid ( Monoid, mempty, mappend )-import qualified Data.Semigroup as Semi+import Data.Monoid ( Monoid, mempty, mappend, mconcat )  import Penny.Lincoln.Bits (   add, difference, Difference(LeftBiggerBy, RightBiggerBy, Equal))@@ -30,15 +30,17 @@ unBalance :: Balance -> Map B.Commodity BottomLine unBalance (Balance m) = m --- | Returned by 'isBalanced'.+-- | Returned by 'balanced'. data Balanced = Balanced               | Inferable B.Entry               | NotInferable               deriving (Show, Eq) --- | Is this balance balanced?-isBalanced :: Balance -> Balanced-isBalanced (Balance m) = M.foldrWithKey f Balanced m where+-- | Computes whether a Balance map is Balanced.+--+-- > balanced mempty == Balanced+balanced :: Balance -> Balanced+balanced (Balance m) = M.foldrWithKey f Balanced m where   f c n b = case n of     Zero -> b     (NonZero col) -> case b of@@ -52,12 +54,23 @@         in Inferable e       _ -> NotInferable +isInferable :: Balanced -> Bool+isInferable (Inferable _) = True+isInferable _ = False+ -- | Converts an Entry to a Balance. entryToBalance :: B.Entry -> Balance entryToBalance (B.Entry dc am) = Balance $ M.singleton c no where   c = B.commodity am   no = NonZero (Column dc (B.qty am)) +-- | Converts multiple Entries to a Balanced.+entriesToBalanced :: [B.Entry] -> Balanced+entriesToBalanced+  = balanced+  . mconcat+  . map entryToBalance+ data BottomLine = Zero             | NonZero Column             deriving (Show, Eq)@@ -84,20 +97,16 @@                      , colQty :: B.Qty }               deriving (Show, Eq) + -- | Add two Balances together. Commodities are never removed from the -- balance, even if their balance is zero. Instead, they are left in -- the balance. Sometimes you want to know that a commodity was in the -- account but its balance is now zero.-addBalances :: Balance -> Balance -> Balance-addBalances (Balance t1) (Balance t2) =-    Balance $ M.unionWith mappend t1 t2--instance Semi.Semigroup Balance where-  (<>) = addBalances- instance Monoid Balance where   mempty = Balance M.empty-  mappend = addBalances+  mappend (Balance t1) (Balance t2) =+    Balance $ M.unionWith mappend t1 t2+  -- | Removes zero balances from a Balance. removeZeroCommodities :: Balance -> Balance

@@ -65,7 +65,7 @@ import Penny.Lincoln.Equivalent ((==~)) import Data.Monoid (mconcat, (<>)) import Data.List (foldl', unfoldr, sortBy)-import Data.Maybe (isNothing, catMaybes)+import Data.Maybe (catMaybes) import qualified Data.Traversable as Tr import qualified Data.Foldable as Fdbl @@ -220,9 +220,22 @@   -> Maybe (Ents m) ents ls = do   guard . not . null $ ls-  let makePstg = makeEnt (inferredVal . map fst $ ls)-  fmap Ents $ mapM makePstg ls+  let nNoEntries = length . filter (== Nothing) . map fst $ ls+  case Bal.entriesToBalanced . catMaybes . map fst $ ls of+    Bal.NotInferable -> Nothing+    Bal.Inferable e -> do+      guard $ nNoEntries == 1+      let makeEnt (mayEn, mt) = case mayEn of+            Nothing -> Ent e Inferred mt+            Just en -> Ent en NotInferred mt+      return . Ents $ map makeEnt ls+    Bal.Balanced ->+      let makeEnt (mayEn, mt) = case mayEn of+            Nothing -> Nothing+            Just en -> Just $ Ent en NotInferred mt+      in fmap Ents $ mapM makeEnt ls + -- | Creates 'Ents'. Unlike 'ents' this function never fails because -- you are restricted in the inputs that you can give it. It will -- always infer the last Entry. All Entries except one will have the@@ -250,29 +263,3 @@   in Ents $ p1:ps ++ [lastPstg]  --- | Changes Maybe Entries into Postings. Uses the inferred value if--- the Maybe Entry is Nothing. If there is no inferred value, returns--- Nothing.-makeEnt-  :: Maybe B.Entry-  -- ^ Inferred value-  -> (Maybe B.Entry, m)-  -> Maybe (Ent m)-makeEnt mayInf (mayEn, m) = case mayEn of-  Nothing -> case mayInf of-    Nothing -> Nothing-    Just inf -> return $ Ent inf Inferred m-  Just en -> return $ Ent en NotInferred m----- | Gets a single inferred entry from a balance, if possible.-inferredVal :: [Maybe B.Entry] -> Maybe B.Entry-inferredVal ls = do-  guard ((length . filter id . map isNothing $ ls) == 1)-  let bal = mconcat-            . map Bal.entryToBalance-            . catMaybes-            $ ls-  case Bal.isBalanced bal of-    Bal.Inferable e -> Just e-    _ -> Nothing

@@ -238,7 +238,7 @@   let ttOpts = getTTOpts pfs psd       tts = zipWith ($) (tests wc) (repeat (p_baseTime psd))       (cks, _, nFail) = TT.runTests ttOpts 0 tts-  Rb.printChunks term cks+  Rb.putChunks term cks   when (nFail > 0) Exit.exitFailure  getParsedFromWheatConf :: WheatConf -> Parsed

@@ -391,11 +391,11 @@       let term = if unColorToFile (foColorToFile fo)                  then S.termFromEnv rt                  else S.autoTerm rt-          printer = R.printChunks term+          printer = R.putChunks term           verbFiltChunks = fst . foSorterFilterer fo $ txns       showFilterExpression printer (foShowExpression fo) (foPredicate fo)       showVerboseFilter printer (foVerboseFilter fo) verbFiltChunks-      Ex.switch handleTextError (R.printChunks term)+      Ex.switch handleTextError (R.putChunks term)         $ printRpt txns pps  @@ -409,7 +409,7 @@ indentAmt = 4  blankLine :: R.Chunk-blankLine = R.plain "\n"+blankLine = "\n"  showFilterExpression   :: ([R.Chunk] -> IO ())@@ -422,7 +422,7 @@   else ptr $ info : blankLine :              (Pe.showPdct indentAmt 0 pdct ++ [blankLine])   where-    info = R.plain "Posting filter expression:\n"+    info = "Posting filter expression:\n"  showVerboseFilter   :: ([R.Chunk] -> IO ())@@ -434,7 +434,7 @@   then return ()   else ptr $ info : blankLine : (cks ++ [blankLine])   where-    info = R.plain "Filtering information:\n"+    info = "Filtering information:\n"  -- | Splits a Ledger into its Transactions and PricePoints. splitLedger :: [C.LedgerItem] -> ([L.Transaction], [L.PricePoint])

@@ -1,5 +1,5 @@ Name: penny-lib-Version: 0.14.0.0+Version: 0.16.0.0 Cabal-version: >=1.8 Build-Type: Simple License: BSD3@@ -46,19 +46,15 @@     , containers ==0.5.*     , explicit-exception ==0.1.*     , matchers ==0.6.*-    , monad-loops ==0.3.*     , multiarg ==0.16.*     , ofx ==0.2.*     , old-locale ==1.0.*     , parsec >= 3.1.2 && < 3.2-    , pcre-light ==0.4.*-    , prednote == 0.8.*+    , prednote == 0.10.*     , pretty-show ==1.5.*-    , rainbow ==0.2.*+    , rainbow ==0.4.*     , semigroups ==0.9.*     , split ==0.2.*-    , strict ==0.3.*-    , terminfo == 0.3.*     , text ==0.11.*     , time ==1.4.*     , transformers == 0.3.*@@ -173,9 +169,9 @@     , old-locale ==1.0.*     , parsec >= 3.1.2 && < 3.2     , pcre-light ==0.4.*-    , prednote == 0.8.*+    , prednote == 0.10.*     , pretty-show ==1.5.*-    , rainbow ==0.2.*+    , rainbow ==0.4.*     , semigroups ==0.9.*     , split ==0.2.*     , strict ==0.3.*@@ -214,9 +210,9 @@     , old-locale ==1.0.*     , parsec >= 3.1.2 && < 3.2     , pcre-light ==0.4.*-    , prednote == 0.8.*+    , prednote == 0.10.*     , pretty-show ==1.5.*-    , rainbow ==0.2.*+    , rainbow ==0.4.*     , semigroups ==0.9.*     , split ==0.2.*     , strict ==0.3.*