penny-lib 0.2.0.0 → 0.4.0.0

raw patch · 19 files changed

+1245/−1036 lines, 19 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• Penny/Cabin.hs +2/−2
• Penny/Cabin/Balance.hs +99/−13
• Penny/Cabin/Balance/Options.hs +0/−37
• Penny/Cabin/Balance/Parser.hs +66/−58
• Penny/Cabin/Balance/Tree.hs +67/−47
• Penny/Cabin/Posts.hs +337/−87
• Penny/Cabin/Posts/Allocated.hs +119/−86
• Penny/Cabin/Posts/BottomRows.hs +39/−34
• Penny/Cabin/Posts/Chunk.hs +74/−17
• Penny/Cabin/Posts/Fields.hs +7/−7
• Penny/Cabin/Posts/Growers.hs +210/−174
• Penny/Cabin/Posts/Meta.hs +34/−25
• Penny/Cabin/Posts/Options.hs +0/−247
• Penny/Cabin/Posts/Parser.hs +155/−123
• Penny/Cabin/Posts/Spacers.hs +1/−76
• Penny/Cabin/Posts/Types.hs +4/−0
• Penny/Lincoln.hs +5/−0
• Penny/Lincoln/Matchers.hs +23/−0
• penny-lib.cabal +3/−3

@@ -11,5 +11,5 @@   -> C.RadGroup   -> [I.Report] allReportsWithDefaults dtz rg =-  [B.defaultBalanceReport, P.defaultPostsReport dtz rg]-  +  [ B.balanceReport (B.defaultOptions dtz)+  , P.makeReport (P.defaultOptions dtz rg) ]

@@ -1,21 +1,107 @@ -- | The Penny balance report-module Penny.Cabin.Balance (balanceReport, O.defaultOptions,-                            O.Options(..),-                            defaultBalanceReport) where+module Penny.Cabin.Balance (+  -- * Making reports+  +  -- | Use these functions if you are building a report from your own+  -- code and you are not using the Zinc parser.+  T.report+  , T.nullConvert+  , T.converter+    +    -- * Parsing reports+    -- | For use with the Zinc command line parser.+  , BalanceOpts(..)+  , balanceReport+  , defaultOptions+  , balanceAsIs +  ) where++import qualified Penny.Cabin.Balance.Tree as T import qualified Penny.Cabin.Balance.Parser as P-import qualified Penny.Cabin.Balance.Options as O import qualified Penny.Cabin.Balance.Help as H+import qualified Penny.Cabin.Chunk as Chunk+import qualified Penny.Cabin.Colors as C+import qualified Penny.Cabin.Colors.DarkBackground as Dark import qualified Penny.Cabin.Interface as I+import qualified Penny.Cabin.Options as CO+import qualified Penny.Copper as Cop+import qualified Penny.Lincoln as L+import qualified Penny.Lincoln.Balance as Bal import qualified Penny.Shield as S -balanceReport :: (S.Runtime -> O.Options) -> I.Report-balanceReport getOpts = I.Report H.help "balance" pr-  where-    pr = do-      fn <- P.parser-      let f rt _ _ bs ps = fn rt (getOpts rt) bs ps-      return f+import qualified Control.Monad.Exception.Synchronous as Ex+import qualified Data.Text as X+import System.Console.MultiArg.Prim (Parser) -defaultBalanceReport :: I.Report-defaultBalanceReport = balanceReport O.defaultOptions+data BalanceOpts = BalanceOpts {+  drCrColors :: C.DrCrColors+  , baseColors :: C.BaseColors+  , balanceFormat :: L.BottomLine -> X.Text+  , colorPref :: Chunk.Colors+  , showZeroBalances :: CO.ShowZeroBalances+  , defaultTimeZone :: Cop.DefaultTimeZone+  , convert :: Maybe (L.Commodity, L.DateTime)+  }++toParseOpts :: BalanceOpts -> P.ParseOpts+toParseOpts b = P.ParseOpts {+  P.drCrColors = drCrColors b+  , P.baseColors = baseColors b+  , P.colorPref = colorPref b+  , P.showZeroBalances = showZeroBalances b+  , P.convert = convert b+  }++toTreeOpts :: P.ParseOpts -> BalanceOpts -> T.TreeOpts+toTreeOpts p b = T.TreeOpts {+  T.drCrColors = P.drCrColors p+  , T.baseColors = P.baseColors p+  , T.balanceFormat = balanceFormat b+  , T.showZeroBalances = P.showZeroBalances p+  }++parser :: (S.Runtime -> BalanceOpts) -> Parser I.ReportFunc+parser frt = do+  parsed <- P.parseOptions+  let rf rt _ _ ps pps = do+        let bo = frt rt+            po = toParseOpts bo+        po' <- Ex.mapException showParseErr $+               parsed rt (defaultTimeZone bo) po+        let to = toTreeOpts po' bo+        conv <- case P.convert po' of+          Nothing -> return $ T.nullConvert ps+          Just co -> T.converter co pps ps+        return+          . Chunk.chunksToText (P.colorPref po')+          . concat+          . T.report to+          $ conv+  return rf+        ++showParseErr :: P.Error -> X.Text+showParseErr = X.pack . show+++balanceReport :: (S.Runtime -> BalanceOpts) -> I.Report+balanceReport f = I.Report H.help "balance" (parser f)+++defaultOptions :: Cop.DefaultTimeZone -> S.Runtime -> BalanceOpts+defaultOptions dtz rt = BalanceOpts {+  drCrColors = Dark.drCrColors+  , baseColors = Dark.baseColors+  , balanceFormat = balanceAsIs+  , colorPref = CO.maxCapableColors rt+  , showZeroBalances = CO.ShowZeroBalances False+  , defaultTimeZone = dtz+  , convert = Nothing+  }++balanceAsIs :: L.BottomLine -> X.Text+balanceAsIs n = case n of+  L.Zero -> X.pack "--"+  L.NonZero c -> X.pack . show . L.unQty . Bal.qty $ c+

@@ -1,37 +0,0 @@--- | Options for the Balance report.-module Penny.Cabin.Balance.Options where--import qualified Data.Text as X-import qualified Penny.Lincoln as L-import qualified Penny.Cabin.Chunk as Chunk-import qualified Penny.Cabin.Colors as C-import qualified Penny.Cabin.Options as O-import qualified Penny.Shield as S-import qualified Penny.Cabin.Colors.DarkBackground as DB-import qualified Penny.Copper.DateTime as DT-import qualified Penny.Lincoln.Balance as Bal--data Options = Options {-  drCrColors :: C.DrCrColors-  , baseColors :: C.BaseColors-  , balanceFormat :: L.BottomLine -> X.Text-  , colorPref :: Chunk.Colors-  , showZeroBalances :: O.ShowZeroBalances-  , convert :: Maybe (L.Commodity, L.DateTime)-  , defaultTimeZone :: DT.DefaultTimeZone-  }--balanceAsIs :: L.BottomLine -> X.Text-balanceAsIs n = case n of-  L.Zero -> X.pack "--"-  L.NonZero c -> X.pack . show . L.unQty . Bal.qty $ c--defaultOptions :: S.Runtime -> Options-defaultOptions rt = Options {-  drCrColors = DB.drCrColors-  , baseColors = DB.baseColors-  , balanceFormat = balanceAsIs-  , colorPref = O.maxCapableColors rt-  , showZeroBalances = O.ShowZeroBalances False-  , convert = Nothing-  , defaultTimeZone = DT.utcDefault }

@@ -1,52 +1,41 @@-module Penny.Cabin.Balance.Parser (parser) where+module Penny.Cabin.Balance.Parser (+  Error(..)+  , ParseOpts(..)+  , parseOptions+  ) where  import qualified Data.Text as X-import qualified Data.Text.Lazy as XL-import Control.Applicative ((<|>), many)+import Control.Applicative ((<|>), many, Applicative, pure) import Control.Monad ((>=>)) import qualified Control.Monad.Exception.Synchronous as Ex import qualified Penny.Cabin.Colors as Col import qualified Penny.Cabin.Colors.DarkBackground as DB import qualified Penny.Cabin.Colors.LightBackground as LB import qualified Penny.Cabin.Chunk as Chk-import qualified Penny.Cabin.Balance.Options as O-import qualified Penny.Cabin.Balance.Tree as Tree import qualified Penny.Cabin.Options as CO import qualified Penny.Copper.Commodity as CC import qualified Penny.Copper.DateTime as CD-import qualified Penny.Liberty as Ly import qualified Penny.Lincoln as L import qualified Penny.Shield as S import System.Console.MultiArg.Prim (Parser) import qualified System.Console.MultiArg.Combinator as C import qualified Text.Parsec as Parsec +data ParseOpts = ParseOpts {+  drCrColors :: Col.DrCrColors+  , baseColors :: Col.BaseColors+  , colorPref :: Chk.Colors+  , showZeroBalances :: CO.ShowZeroBalances+  , convert :: Maybe (L.Commodity, L.DateTime)+  }++ data Error = BadColorName String            | BadBackground String            | BadCommodity String            | BadDate String              deriving Show -parser ::-  Parser (S.Runtime-          -> O.Options-          -> [L.Box Ly.LibertyMeta]-          -> [L.PricePoint]-          -> Ex.Exceptional X.Text XL.Text)-parser = do-  ls <- many opts-  let f rt opInit bs ps = do-        let ls' = map (\fn -> fn rt) ls-            errOpParsed = (foldl (>=>) return ls') opInit-        opParsed <- case errOpParsed of-          Ex.Exception e -> Ex.throw . X.pack . show $ e-          Ex.Success g -> return g-        bits <- Tree.report opParsed bs ps-        return-          . Chk.chunksToText (O.colorPref opParsed)-          . concat-          $ bits-  return f  processColorArg ::   S.Runtime@@ -63,13 +52,13 @@ parseOpt ss cs a = C.parseOption [C.OptSpec ss cs a]  color :: Parser (S.Runtime-                 -> O.Options-                 -> Ex.Exceptional Error O.Options)+                 -> ParseOpts+                 -> Ex.Exceptional Error ParseOpts) color = parseOpt ["color"] "" (C.OneArg f)   where     f a1 rt op = case processColorArg rt a1 of       Nothing -> Ex.throw . BadColorName $ a1-      Just c -> return (op { O.colorPref = c })+      Just c -> return (op { colorPref = c })  processBackgroundArg ::   String@@ -80,47 +69,48 @@   | otherwise = Nothing  -background :: Parser (O.Options -> Ex.Exceptional Error O.Options)+background :: Parser (ParseOpts -> Ex.Exceptional Error ParseOpts) background = parseOpt ["background"] "" (C.OneArg f)   where     f a1 op = case processBackgroundArg a1 of       Nothing -> Ex.throw . BadBackground $ a1       Just (dc, base) ->-        return op { O.drCrColors = dc-                  , O.baseColors = base }+        return op { drCrColors = dc+                  , baseColors = base } -showZeroBalances ::-  Parser (O.Options -> Ex.Exceptional a O.Options)-showZeroBalances = parseOpt ["show-zero-balances"] "" (C.NoArg f)+parseShowZeroBalances :: Parser (ParseOpts -> ParseOpts)+parseShowZeroBalances = parseOpt opt "" (C.NoArg f)   where+    opt = ["show-zero-balances"]      f op =-      return (op {O.showZeroBalances = CO.ShowZeroBalances True })+      op {showZeroBalances = CO.ShowZeroBalances True } -hideZeroBalances ::-  Parser (O.Options -> Ex.Exceptional a O.Options)+hideZeroBalances :: Parser (ParseOpts -> ParseOpts) hideZeroBalances = parseOpt ["hide-zero-balances"] "" (C.NoArg f)   where     f op =-      return (op {O.showZeroBalances = CO.ShowZeroBalances False })+      op {showZeroBalances = CO.ShowZeroBalances False }  convertLong ::-  Parser (O.Options -> Ex.Exceptional Error O.Options)+  Parser (CD.DefaultTimeZone+          -> ParseOpts+          -> Ex.Exceptional Error ParseOpts) convertLong = parseOpt ["convert"] "" (C.TwoArg f)   where-    f a1 a2 op = do+    f a1 a2 dtz op = do       cty <- case Parsec.parse CC.lvl1Cmdty "" (X.pack a1) of         Left _ -> Ex.throw . BadCommodity $ a1         Right g -> return g-      let parseDate = CD.dateTime (O.defaultTimeZone op)+      let parseDate = CD.dateTime dtz       dt <- case Parsec.parse parseDate "" (X.pack a2) of         Left _ -> Ex.throw . BadDate $ a2         Right g -> return g-      let op' = op { O.convert = Just (cty, dt) }+      let op' = op { convert = Just (cty, dt) }       return op'  convertShort :: Parser (S.Runtime-                        -> O.Options-                        -> Ex.Exceptional Error O.Options)+                        -> ParseOpts+                        -> Ex.Exceptional Error ParseOpts) convertShort = parseOpt [] ['c'] (C.OneArg f)   where     f a1 rt op = do@@ -128,21 +118,39 @@         Left _ -> Ex.throw . BadCommodity $ a1         Right g -> return g       let dt = S.currentTime rt-          op' = op { O.convert = Just (cty, dt) }+          op' = op { convert = Just (cty, dt) }       return op'          -opts :: Parser (S.Runtime-                -> O.Options-                -> Ex.Exceptional Error O.Options)-opts =-  color-  <|> mkTwoArg background-  <|> mkTwoArg showZeroBalances-  <|> mkTwoArg hideZeroBalances-  <|> mkTwoArg convertLong-  <|> convertShort+parseOptions :: Parser (S.Runtime+                        -> CD.DefaultTimeZone+                        -> ParseOpts+                        -> Ex.Exceptional Error ParseOpts)+parseOptions = do+  fns <- many parseOption+  let f rt dtz o1 =+        let fns' = map (\fn -> fn rt dtz) fns+        in foldl (>=>) return fns' o1+  return f++parseOption :: Parser (S.Runtime+                       -> CD.DefaultTimeZone+                       -> ParseOpts+                       -> Ex.Exceptional Error ParseOpts)+parseOption =+  (do { f <- color; return (\rt _ o -> f rt o )})+  <|> wrap background+  <|> wrap (impurify parseShowZeroBalances)+  <|> wrap (impurify hideZeroBalances)+  <|> (do { f <- convertLong; return (\_ dtz o -> f dtz o )})+  <|> (do { f <- convertShort; return (\rt _ o -> f rt o )})   where-    mkTwoArg p = do+    wrap p = do       f <- p-      return (\_ op -> f op)+      return (\_ _ op -> f op)++impurify ::+  (Applicative m, Functor f)+  => f (a -> a)+  -> f (a -> m a)+impurify = fmap (\f -> pure . f)

@@ -20,7 +20,13 @@ -- * 8. [Columns PreSpec] -> [Columns R.ColumnSpec] (strict) -- -- * 9. [Columns R.ColumnSpec] -> [[Chunk.Bit]] (lazy)-module Penny.Cabin.Balance.Tree (report) where+module Penny.Cabin.Balance.Tree (+  report+  , TreeOpts(..)+  , PriceConverteds+  , nullConvert+  , converter+  ) where  import Control.Applicative(Applicative(pure, (<*>)), (<$>)) import qualified Control.Monad.Exception.Synchronous as Ex@@ -34,7 +40,6 @@ import qualified Data.Text as X import qualified Data.Traversable as Tr import qualified Penny.Cabin.Options as CO-import qualified Penny.Cabin.Balance.Options as O import qualified Penny.Cabin.Chunk as Chunk import qualified Penny.Cabin.Colors as C import qualified Penny.Liberty as Ly@@ -44,10 +49,14 @@ import qualified Data.Semigroup as S  -- Step 1. Convert prices.+ data PriceConverted = PriceConverted {   pcEntry :: L.Entry   , pcAccount :: L.Account } +newtype PriceConverteds =+  PriceConverteds { unPriceConverteds :: [PriceConverted] }+ convertOne ::   L.PriceDb   -> (L.Commodity, L.DateTime)@@ -92,27 +101,33 @@ buildDb = foldl f L.emptyDb where   f db pb = L.addPrice db pb -converter ::-  O.Options-  -> [L.PricePoint]-  -> [L.Box Ly.LibertyMeta]-  -> Ex.Exceptional X.Text [PriceConverted]-converter os pbs bs = case O.convert os of-  Nothing ->-    let f b = PriceConverted en ac where+-- | Makes PriceConverteds where there is no target commodity.+nullConvert :: [L.Box Ly.LibertyMeta] -> PriceConverteds+nullConvert =+  let f b = PriceConverted en ac+        where           p = L.boxPostFam b           en = Q.entry p           ac = Q.account p-    in return . map f $ bs-  Just pair ->+    in PriceConverteds . map f++-- | Makes PriceConverteds where commodities will have to be changed+-- to a target commodity. This will fail if necessary price data is+-- lacking.+converter ::+  (L.Commodity, L.DateTime)+  -> [L.PricePoint]+  -> [L.Box Ly.LibertyMeta]+  -> Ex.Exceptional X.Text PriceConverteds+converter conv pbs bs =     let f b = let p = L.boxPostFam b                   en = Q.entry p                   ac = Q.account p                  in do-                   en' <- convertOne db pair en+                   en' <- convertOne db conv en                    return (PriceConverted en' ac)         db = buildDb pbs-    in mapM f bs+    in fmap PriceConverteds $ mapM f bs   -- Step 2. This puts all the PriceConverteds into a flat map, where@@ -120,9 +135,9 @@ -- the user desired, zero balances are eliminated from the flat map. newtype FlatMap = FlatMap { _unFlatMap :: M.Map L.Account Bal.Balance } -toFlatMap :: O.Options -> [PriceConverted] -> FlatMap-toFlatMap o = FlatMap . foldr f M.empty where-  remove = not . CO.unShowZeroBalances . O.showZeroBalances $ o+toFlatMap :: TreeOpts -> PriceConverteds -> FlatMap+toFlatMap o = FlatMap . foldr f M.empty . unPriceConverteds where+  remove = not . CO.unShowZeroBalances . showZeroBalances $ o   f pc m =     let a = pcAccount pc         bal = Bal.entryToBalance . pcEntry $ pc@@ -236,7 +251,7 @@ -- | Returns a triple (x, y, z), where x is the DrCr chunk, y is the -- commodity chunk, and z is the qty chunk. bottomLineBalChunks ::-  O.Options+  TreeOpts   -> IsEven   -> (L.Commodity, Bal.BottomLine)   -> (Chunk.Chunk, Chunk.Chunk, Chunk.Chunk)@@ -250,7 +265,7 @@       getTs = if isEven then C.evenZero else C.oddZero       dcT = X.pack "--"       qtyT = dcT-      in (getTs . O.drCrColors $ os, dcT, qtyT)+      in (getTs . drCrColors $ os, dcT, qtyT)     Bal.NonZero clm -> let       (getTs, dcT) = case Bal.drCr clm of         L.Debit ->@@ -259,29 +274,29 @@         L.Credit ->           (if isEven then C.evenCredit else C.oddCredit,            X.pack "Cr")-      qTxt = (O.balanceFormat os) bl-      in (getTs . O.drCrColors $ os, dcT, qTxt)+      qTxt = (balanceFormat os) bl+      in (getTs . drCrColors $ os, dcT, qTxt)   fillTextSpec ::-  O.Options+  TreeOpts   -> IsEven   -> Chunk.TextSpec fillTextSpec os isEven = let   getTs = if isEven then C.evenColors else C.oddColors-  in getTs . O.baseColors $ os+  in getTs . baseColors $ os     bottomLineCells ::-  O.Options+  TreeOpts   -> IsEven   -> SummedBal   -> (PreSpec, PreSpec, PreSpec) bottomLineCells os isEven mayBal = let   fill = fillTextSpec os isEven   tsZero = if isEven-           then C.evenZero . O.drCrColors $ os-           else C.oddZero . O.drCrColors $ os+           then C.evenZero . drCrColors $ os+           else C.oddZero . drCrColors $ os   zeroSpec =     PreSpec R.LeftJustify     tsZero [Chunk.chunk tsZero (X.pack "--")]@@ -298,7 +313,7 @@ padding = 2  accountPreSpec ::-  O.Options+  TreeOpts   -> IsEven   -> Int   -> L.SubAccountName@@ -306,15 +321,15 @@ accountPreSpec os isEven lvl acct = PreSpec j ts [bit] where   j = R.LeftJustify   ts = if isEven-       then C.evenColors . O.baseColors $ os-       else C.oddColors . O.baseColors $ os+       then C.evenColors . baseColors $ os+       else C.oddColors . baseColors $ os   bit = Chunk.chunk ts txt where     txt = pad `X.append` (L.text acct)     pad = X.replicate (padding * lvl) (X.singleton ' ')   makePreSpec ::-  O.Options+  TreeOpts   -> [(L.SubAccountName, (SummedBal, Bool))]   -> L.SubAccountName   -> (SummedBal, Bool)@@ -325,7 +340,7 @@   (dc, com, qt) = bottomLineCells os isEven mayBal  traverser ::-  O.Options+  TreeOpts   -> [(L.SubAccountName, (SummedBal, Bool))]   -> L.SubAccountName   -> (SummedBal, Bool)@@ -335,7 +350,7 @@   return (Just $ makePreSpec os hist a mayBal)  makePreSpecMap ::-  O.Options+  TreeOpts   -> (SummedWithIsEven, TotalBal)   -> (PreSpecMap, TotalBal) makePreSpecMap os (sb, tb) = (cim, tb) where@@ -343,7 +358,7 @@  -- Step 7 makeTotalCells ::-  O.Options+  TreeOpts   -> SummedBal   -> Columns PreSpec makeTotalCells os mayBal = Columns act dc com qt where@@ -351,7 +366,7 @@   tot = L.SubAccountName $ L.TextNonEmpty 'T' (X.pack "otal")   (dc, com, qt) = bottomLineCells os True mayBal -makeColumnList :: O.Options -> (PreSpecMap, TotalBal) -> [Columns PreSpec]+makeColumnList :: TreeOpts -> (PreSpecMap, TotalBal) -> [Columns PreSpec] makeColumnList os (cim, tb) = totCols : restCols where   totCols = makeTotalCells os tb   restCols = Fdbl.toList cim@@ -398,14 +413,14 @@ widthSpacerCommodity = 1  colsToBits ::-  O.Options+  TreeOpts   -> IsEven   -> Columns R.ColumnSpec   -> [Chunk.Chunk] colsToBits os isEven (Columns a dc c q) = let   fillSpec = if isEven-             then C.evenColors . O.baseColors $ os-             else C.oddColors . O.baseColors $ os+             then C.evenColors . baseColors $ os+             else C.oddColors . baseColors $ os   spacer w = R.ColumnSpec j (Chunk.Width w) fillSpec []   j = R.LeftJustify   cs = a@@ -419,7 +434,7 @@   in R.row cs  colsListToBits ::-  O.Options+  TreeOpts   -> [Columns R.ColumnSpec]   -> [[Chunk.Chunk]] colsListToBits os = zipWith f bools where@@ -427,17 +442,22 @@   bools = iterate not True  +-- Options+data TreeOpts = TreeOpts {+  drCrColors :: C.DrCrColors+  , baseColors :: C.BaseColors+  , balanceFormat :: L.BottomLine -> X.Text+  , showZeroBalances :: CO.ShowZeroBalances+  }+ -- Tie it all together  report ::-  O.Options-  -> [L.Box Ly.LibertyMeta]-  -> [L.PricePoint]-  -> Ex.Exceptional X.Text [[Chunk.Chunk]]-report os ps rs = do-  pcs <- converter os rs ps-  return-    . colsListToBits os+  TreeOpts+  -> PriceConverteds+  -> [[Chunk.Chunk]]+report os  =+    colsListToBits os     . resizeColumnsInList     . makeColumnList os     . makePreSpecMap os@@ -445,4 +465,4 @@     . sumBalances     . rawBalances     . toFlatMap os-    $ pcs+

@@ -34,113 +34,363 @@ -- configurable without editing the source code (sorry).  module Penny.Cabin.Posts (-  -- * Defaults-  defaultPostsReport-  -  -- * Custom report-  , customPostsReport--  -- * Options-  , O.T(..)-  , O.ReportWidth(..)-  , O.ymd, O.qtyAsIs, O.balanceAsIs, O.defaultWidth-  , O.columnsVarToWidth, O.defaultOptions, O.widthFromRuntime-  , O.defaultFields+  postsReport+  , parseReport+  , makeReport+  , defaultOptions+  , ZincOpts(..)+  , ymd+  , qtyAsIs+  , balanceAsIs+  , defaultWidth+  , columnsVarToWidth+  , widthFromRuntime+  , defaultFields+  , defaultSpacerWidth   ) where -import Control.Applicative ((<$>)) import qualified Control.Monad.Exception.Synchronous as Ex import qualified Data.Text as X import qualified Data.Text.Lazy as XL-import qualified Penny.Cabin.Chunk as Chk+import qualified Penny.Cabin.Chunk as CC+import qualified Penny.Cabin.Colors as PC+import qualified Penny.Cabin.Colors.DarkBackground as Dark import qualified Penny.Cabin.Interface as I-import qualified Penny.Cabin.Posts.Options as O+import qualified Penny.Cabin.Options as CO+import qualified Penny.Cabin.Posts.Allocated as A+import qualified Penny.Cabin.Posts.Allocate as Alc+import qualified Penny.Cabin.Posts.Chunk as C+import qualified Penny.Cabin.Posts.Fields as F+import qualified Penny.Cabin.Posts.Help as H import qualified Penny.Cabin.Posts.Meta as M-import Penny.Cabin.Posts.Chunk (makeChunk)-import Penny.Cabin.Posts.Parser (parseOptions)-import Penny.Cabin.Posts.Help (help)-import qualified Penny.Copper as C+import Penny.Cabin.Posts.Meta (Box)+import qualified Penny.Cabin.Posts.Parser as P+import qualified Penny.Cabin.Posts.Spacers as S+import qualified Penny.Cabin.Posts.Types as T++import qualified Penny.Copper as Cop import qualified Penny.Lincoln as L+import qualified Penny.Lincoln.Balance as Bal+import qualified Penny.Lincoln.Queries as Q import qualified Penny.Liberty as Ly-import qualified Penny.Shield as S+import qualified Penny.Shield as Sh++import Data.Time as Time import System.Console.MultiArg.Prim (Parser)+import System.Locale (defaultTimeLocale) import Text.Matchers.Text (CaseSensitive) --- | When applied to a DefaultTimeZone and a RadGroup, returns a--- report with the default options.-defaultPostsReport ::-  C.DefaultTimeZone-  -> C.RadGroup-  -> I.Report-defaultPostsReport dtz rg = makeReport f where-  f = parseReportOpts (\rt -> O.defaultOptions dtz rg rt)+-- | All information needed to make a Posts report. This function+-- never fails.+postsReport ::+  CC.Colors+  -- ^ How many colors to show.+  -> CO.ShowZeroBalances+  -> (L.Box Ly.LibertyMeta -> Bool)+  -- ^ Removes posts from the report if applying this function to the+  -- post returns False. Posts removed still affect the running+  -- balance.+  +  -> [Ly.PostFilterFn]+  -- ^ Applies these post-filters to the list of posts that results+  -- from applying the predicate above. Might remove more+  -- postings. Postings removed still affect the running balance.+    +  -> C.ChunkOpts+  -> [L.Box Ly.LibertyMeta]+  -> XL.Text --- | Generate a custom Posts report.-customPostsReport ::-  (S.Runtime -> O.T)-  -- ^ Function that, when applied to a Runtime, returns the default-  -- options for the posts report. The options will be overridden by-  -- any options on the command line.+postsReport col szb pdct pff co =+  CC.chunksToText col+  . C.makeChunk co+  . M.toBoxList szb pdct pff -  -> I.Report-customPostsReport = makeReport . parseReportOpts --- | When passed a ParseReportOpts, makes a Report.+parseReport ::+  (Sh.Runtime -> ZincOpts)+  -> Parser I.ReportFunc+parseReport frt = do+  getState <- P.parseOptions+  let rf rt cs fty ps _ = do+        let zo = frt rt+            maySt' = getState rt dtz rg st+              where+                dtz = defaultTimeZone zo+                rg = radGroup zo+                st = newParseState cs fty zo+        st' <- Ex.mapException showParserError maySt'+        pdct <- getPredicate . P.tokens $ st'+        return $ postsReport (P.colorPref st')+          (P.showZeroBalances st') pdct+          (P.postFilter st') (chunkOpts st' zo) ps+  return rf+                 +             makeReport ::-  Parser I.ReportFunc+  (Sh.Runtime -> ZincOpts)   -> I.Report-makeReport f =-  I.Report { I.help = help-           , I.name = "posts"-           , I.parseReport = f }+makeReport frt = I.Report {+  I.help = H.help+  , I.name = "postings"+  , I.parseReport = parseReport frt } -type Factory = CaseSensitive -> X.Text-                 -> Ex.Exceptional X.Text (X.Text -> Bool) -parseReportOpts ::-  (S.Runtime -> O.T)-  -> Parser (S.Runtime-             -> CaseSensitive-             -> Factory-             -> [L.Box Ly.LibertyMeta]-             -> a-             -> Ex.Exceptional X.Text XL.Text)-parseReportOpts frt = do-  getOpts <- parseOptions-  let f rt cs fty bs _ = do-        let optsDefault = frt rt-            optsInit = optsDefault { O.sensitive = cs-                                   , O.factory = fty }-        optsParsed <- case getOpts rt optsInit of-          Ex.Exception e -> Ex.throw . X.pack . show $ e-          Ex.Success g -> return g-        makeReportTxt optsParsed bs-  return f-            +defaultOptions ::+  Cop.DefaultTimeZone+  -> Cop.RadGroup+  -> Sh.Runtime+  -> ZincOpts+defaultOptions dtz rg rt = ZincOpts {+  defaultTimeZone = dtz+  , radGroup = rg+  , fields = defaultFields+  , colorPref = CO.maxCapableColors rt+  , drCrColors = Dark.drCrColors+  , baseColors = Dark.baseColors+  , width = widthFromRuntime rt+  , showZeroBalances = CO.ShowZeroBalances False+  , dateFormat = ymd+  , qtyFormat = qtyAsIs+  , balanceFormat = balanceAsIs+  , subAccountLength = A.SubAccountLength 2+  , payeeAllocation = Alc.allocation 60+  , accountAllocation = Alc.allocation 40+  , spacers = defaultSpacerWidth } --- | Using the options parsed from the command line, print out the--- report.-makeReportTxt ::-  O.T-  -> [L.Box Ly.LibertyMeta]-  -> Ex.Exceptional X.Text XL.Text-makeReportTxt op bs = fmap mkText postMetaBoxes-  where-    e = X.pack "posts report: filter expression parse failure"-    postMetaBoxes = Ex.fromMaybe e (filterAndAssignMeta op bs)-    mkText = Chk.chunksToText (O.colorPref op) . makeChunk op-     --- | Takes a list of Box with LibertyMeta and options as processed--- from the command line.  Filters the list of Box and processes the--- post filter, then assigns the post metadata. Fails if the--- expression fails to produce a result.-filterAndAssignMeta ::-  O.T-  -> [L.Box Ly.LibertyMeta]-  -> Maybe [L.Box M.PostMeta]-filterAndAssignMeta op bs =-  M.addMetadata (O.showZeroBalances op)-  <$> M.filterBoxes (O.tokens op) (O.postFilter op) bs+showParserError :: P.Error -> X.Text+showParserError = X.pack . show +getPredicate ::+  [Ly.Token (L.Box Ly.LibertyMeta -> Bool)]+  -> Ex.Exceptional X.Text (L.Box Ly.LibertyMeta -> Bool)+getPredicate ts =+  case ts of+    [] -> return $ const True+    ls ->+      Ex.fromMaybe+        (X.pack "posts report: bad posting filter expression")+        (Ly.parseTokenList ls) ++-- | All the information to configure the postings report if the+-- options will be parsed in from the command line.+data ZincOpts = ZincOpts {+  defaultTimeZone :: Cop.DefaultTimeZone+  -- ^ The postings report takes options to determine which posts will+  -- be visible. This determines the time zone to use when parsing+  -- these options. Does not affect how the resulting report is+  -- formatted. For that, see the dateFormat field.+  +  , radGroup :: Cop.RadGroup+    -- ^ The postings report takes options to determine which posts+    -- will be visible. This determines the radix point and grouping+    -- character to use when parsing these options. Does not affect+    -- how the resulting report is formatted. For that, see the+    -- qtyFormat field.++  , fields :: F.Fields Bool+    -- ^ Default fields to show in the report.+      +  , colorPref :: CC.Colors+    -- ^ How many colors you want to see, or do it+    -- automatically.++  , drCrColors :: PC.DrCrColors+    -- ^ Colors to use when displaying debits, credits, and+    -- when displaying balance totals++  , baseColors :: PC.BaseColors+    -- ^ Colors to use when displaying everything else++  , width :: T.ReportWidth+    -- ^ Gives the default report width. This can be+    -- overridden on the command line. You can use the+    -- information from the Runtime to make this as wide as+    -- the current terminal.++  , showZeroBalances :: CO.ShowZeroBalances+    -- ^ Are commodities that have no balance shown in the Total fields+    -- of the report?++  , dateFormat :: Box -> X.Text+    -- ^ How to display dates. This function is applied to the+    -- a PostingInfo so it has lots of information, but it+    -- should return a date for use in the Date field.++  , qtyFormat :: Box -> X.Text+    -- ^ How to display the quantity of the posting. This+    -- function is applied to a Box so it has lots of+    -- information, but it should return a formatted string of+    -- the quantity. Allows you to format digit grouping,+    -- radix points, perform rounding, etc.++  , balanceFormat :: L.Commodity -> L.BottomLine -> X.Text+    -- ^ How to display balance totals. Similar to+    -- balanceFormat.++  , subAccountLength :: A.SubAccountLength+    -- ^ When shortening the names of sub accounts to make+    -- them fit, they will be this long.++  , payeeAllocation :: Alc.Allocation+    -- ^ This and accountAllocation determine how much space+    -- payees and accounts receive. They divide up the+    -- remaining space after everything else is displayed. For+    -- instance if payeeAllocation is 60 and accountAllocation+    -- is 40, the payee takes about 60 percent of the+    -- remaining space and the account takes about 40 percent.++  , accountAllocation :: Alc.Allocation+    -- ^ See payeeAllocation above++  , spacers :: S.Spacers Int+    -- ^ Default width for spacer fields. If any of these Ints are+    -- less than or equal to zero, there will be no spacer. There is+    -- never a spacer for fields that do not appear in the report.+      +  }++chunkOpts ::+  P.State +  -> ZincOpts+  -> C.ChunkOpts+chunkOpts s z = C.ChunkOpts {+  C.baseColors = P.baseColors s+  , C.drCrColors = P.drCrColors s+  , C.dateFormat = dateFormat z+  , C.qtyFormat = qtyFormat z+  , C.balanceFormat = balanceFormat z+  , C.fields = P.fields s+  , C.subAccountLength = subAccountLength z+  , C.payeeAllocation = payeeAllocation z+  , C.accountAllocation = accountAllocation z+  , C.spacers = spacers z+  , C.reportWidth = P.width s+  }+++newParseState ::+  CaseSensitive+  -> L.Factory+  -> ZincOpts+  -> P.State+newParseState cs fty o = P.State {+  P.sensitive = cs+  , P.factory = fty+  , P.tokens = []+  , P.postFilter = []+  , P.fields = fields o+  , P.colorPref = colorPref o+  , P.drCrColors = drCrColors o+  , P.baseColors = baseColors o+  , P.width = width o+  , P.showZeroBalances = showZeroBalances o+  }++-- | Shows the date of a posting in YYYY-MM-DD format.+ymd :: Box -> X.Text+ymd p = X.pack (Time.formatTime defaultTimeLocale fmt d) where+  d = Time.localDay+      . L.localTime+      . Q.dateTime+      . L.boxPostFam+      $ p+  fmt = "%Y-%m-%d"++-- | Shows the quantity of a posting. Does no rounding or+-- prettification; simply uses show on the underlying Decimal.+qtyAsIs :: Box -> X.Text+qtyAsIs p = X.pack . show . L.unQty . Q.qty . L.boxPostFam $ p++-- | Shows the quantity of a balance. If there is no quantity, shows+-- two dashes.+balanceAsIs :: a -> L.BottomLine -> X.Text+balanceAsIs _ n = case n of+  L.Zero -> X.pack "--"+  L.NonZero c -> X.pack . show . L.unQty . Bal.qty $ c++-- | The default width for the report.+defaultWidth :: T.ReportWidth+defaultWidth = T.ReportWidth 80++-- | Applied to the value of the COLUMNS environment variable, returns+-- an appropriate ReportWidth.+columnsVarToWidth :: Maybe String -> T.ReportWidth+columnsVarToWidth ms = case ms of+  Nothing -> defaultWidth+  Just str -> case reads str of+    [] -> defaultWidth+    (i, []):[] -> if i > 0 then T.ReportWidth i else defaultWidth+    _ -> defaultWidth++-- | Given the Runtime, use the defaultWidth given above to calculate+-- the report's width if COLUMNS does not yield a value. Otherwise,+-- use what is in COLUMNS.+widthFromRuntime :: Sh.Runtime -> T.ReportWidth+widthFromRuntime rt = case Sh.screenWidth rt of+  Nothing -> defaultWidth+  Just w -> T.ReportWidth . Sh.unScreenWidth $ w++-- | Default fields to show in the Postings report.+defaultFields :: F.Fields Bool+defaultFields =+  F.Fields { F.globalTransaction    = False+           , F.revGlobalTransaction = False+           , F.globalPosting        = False+           , F.revGlobalPosting     = False+           , F.fileTransaction      = False+           , F.revFileTransaction   = False+           , F.filePosting          = False+           , F.revFilePosting       = False+           , F.filtered             = False+           , F.revFiltered          = False+           , F.sorted               = False+           , F.revSorted            = False+           , F.visible              = False+           , F.revVisible           = False+           , F.lineNum              = False+           , F.date                 = True+           , F.flag                 = False+           , F.number               = False+           , F.payee                = True+           , F.account              = True+           , F.postingDrCr          = True+           , F.postingCmdty         = True+           , F.postingQty           = True+           , F.totalDrCr            = True+           , F.totalCmdty           = True+           , F.totalQty             = True+           , F.tags                 = False+           , F.memo                 = False+           , F.filename             = False }++-- | Default width of spacers; most are one character wide, but the+-- spacer after payee is 4 characters wide.+defaultSpacerWidth :: S.Spacers Int+defaultSpacerWidth =+  S.Spacers { S.globalTransaction    = 1+            , S.revGlobalTransaction = 1+            , S.globalPosting        = 1+            , S.revGlobalPosting     = 1+            , S.fileTransaction      = 1+            , S.revFileTransaction   = 1+            , S.filePosting          = 1+            , S.revFilePosting       = 1+            , S.filtered             = 1+            , S.revFiltered          = 1+            , S.sorted               = 1+            , S.revSorted            = 1+            , S.visible              = 1+            , S.revVisible           = 1+            , S.lineNum              = 1+            , S.date                 = 1+            , S.flag                 = 1+            , S.number               = 1+            , S.payee                = 4+            , S.account              = 1+            , S.postingDrCr          = 1+            , S.postingCmdty         = 1+            , S.postingQty           = 1+            , S.totalDrCr            = 1+            , S.totalCmdty           = 1 }

@@ -29,7 +29,12 @@ -- arrangements are made if either field gets an allocation of 0. -- -- 5. Fill cell contents. Return filled cells.-module Penny.Cabin.Posts.Allocated (payeeAndAcct, Fields(..)) where+module Penny.Cabin.Posts.Allocated (+  payeeAndAcct+  , AllocatedOpts(..)+  , Fields(..)+  , SubAccountLength(..)+  ) where  import Control.Applicative(Applicative((<*>), pure), (<$>)) import Data.Maybe (catMaybes, isJust)@@ -42,25 +47,37 @@ import qualified Penny.Cabin.Row as R import qualified Penny.Cabin.Posts.Allocate as A import qualified Penny.Cabin.Colors as PC-import qualified Penny.Cabin.Posts.Fields as F import qualified Penny.Cabin.Posts.Growers as G import qualified Penny.Cabin.Posts.Meta as M-import qualified Penny.Cabin.Posts.Options as Options-import qualified Penny.Cabin.Posts.Options as O+import Penny.Cabin.Posts.Meta (Box) import qualified Penny.Cabin.Posts.Spacers as S-import qualified Penny.Cabin.Posts.Spacers as Spacers+import qualified Penny.Cabin.Posts.Types as Ty import qualified Penny.Cabin.TextFormat as TF import qualified Penny.Lincoln as L import qualified Penny.Lincoln.Queries as Q import qualified Penny.Lincoln.HasText as HT -type Box = L.Box M.PostMeta - data Fields a = Fields {   payee :: a   , account :: a   } deriving (Eq, Show) +newtype SubAccountLength =+  SubAccountLength { unSubAccountLength :: Int }+  deriving Show++-- | All the information needed for allocated cells.+data AllocatedOpts = AllocatedOpts {+  fields :: Fields Bool+  , subAccountLength :: SubAccountLength+  , baseColors :: PC.BaseColors+  , payeeAllocation :: A.Allocation+  , accountAllocation :: A.Allocation+  , spacers :: S.Spacers Int+  , growerWidths :: G.Fields (Maybe Int)+  , reportWidth :: Ty.ReportWidth+  }+ -- | Creates Payee and Account cells. The user must have requested the -- cells. In addition, no cells are created if there is not enough -- space for them in the report. Returns a Fields; each element of the@@ -69,31 +86,36 @@ -- where cs is a list of all the cells, and i is the width of all the -- cells. payeeAndAcct ::-  G.Fields (Maybe Int)-  -> Options.T+  AllocatedOpts   -> [Box]   -> Fields (Maybe ([R.ColumnSpec], Int))-payeeAndAcct fs os = allocateCells os ws where-  ws = fieldWidth os ss fs rw-  ss = O.spacers os-  rw = O.width os+payeeAndAcct as = allocateCells sl bc ws+  where+    sl = subAccountLength as+    bc = baseColors as+    ws = fieldWidth (fields as) (payeeAllocation as)+         (accountAllocation as) (spacers as)+         (growerWidths as) (reportWidth as)   -- | Allocates cells. Returns a pair, with the first element being the -- list of allocated cells, and the second indicating the width of the -- cells, which will be greater than zero. allocateCells ::-  Options.T-  -> Fields Int+  SubAccountLength+  -> PC.BaseColors+  -> Fields UnShrunkWidth   -> [Box]   -> Fields (Maybe ([R.ColumnSpec], Int))-allocateCells os fs is = let-  cellMakers = Fields allocPayee allocAcct-  mkCells width maker =-    if width > 0-    then Just (map (maker width os) is)-    else Nothing-  unShrunkCells = mkCells <$> fs <*> cellMakers+allocateCells sl bc fs bs =+  let mkPayees i b = allocPayee i bc b+      mkAccts i b = allocAcct i sl bc b+      cellMakers = Fields mkPayees mkAccts+      mkCells (UnShrunkWidth width) maker =+        if width > 0+        then Just (map (maker width) bs)+        else Nothing+      unShrunkCells = mkCells <$> fs <*> cellMakers   in fmap (fmap removeExtraSpace) unShrunkCells  @@ -109,32 +131,32 @@   trimmed = map f cs where     f c = c { R.width = C.Width len } +-- | The width of an on-screen field, after accounting for the width+-- of the entire report and the allocations but before shrinking.+newtype UnShrunkWidth = UnShrunkWidth Int+                      deriving Show+ -- | Gets the width of the two allocated fields. fieldWidth ::-  Options.T-  -> Spacers.T Int+  Fields Bool+  -> A.Allocation -- ^ Payee allocation+  -> A.Allocation -- ^ Accout allocation+  -> S.Spacers Int   -> G.Fields (Maybe Int)-  -> O.ReportWidth-  -> Fields Int-fieldWidth os ss fs (O.ReportWidth rw) = let-  flds = optionsToFields os-  grownWidth = sumGrowersAndSpacers fs ss-  widthForCells = rw - grownWidth - allocSpacerWidth-  payeeSpacerWidth = if payee flds then abs (S.payee ss) else 0-  acctSpacerWidth = if account flds then abs (S.account ss) else 0-  allocSpacerWidth = payeeSpacerWidth + acctSpacerWidth-  allocs = (\bool alloc -> if bool then alloc else A.allocation 0)-           <$> flds-           <*> Fields (O.payeeAllocation os) (O.accountAllocation os)+  -> Ty.ReportWidth+  -> Fields UnShrunkWidth+fieldWidth flds pa aa ss fs (Ty.ReportWidth rw) =+  let grownWidth = sumGrowersAndSpacers fs ss+      widthForCells = rw - grownWidth - allocSpacerWidth+      payeeSpacerWidth = if payee flds then abs (S.payee ss) else 0+      acctSpacerWidth = if account flds then abs (S.account ss) else 0+      allocSpacerWidth = payeeSpacerWidth + acctSpacerWidth+      allocs = (\bool alloc -> if bool then alloc else A.allocation 0)+               <$> flds+               <*> Fields pa aa   in if widthForCells < 1-     then pure 0-     else A.allocate allocs widthForCells---optionsToFields :: Options.T -> Fields Bool-optionsToFields os = let f = O.fields os in Fields {-  payee = F.payee f-  , account = F.account f }+     then pure (UnShrunkWidth 0)+     else fmap UnShrunkWidth $ A.allocate allocs widthForCells   -- | Sums spacers for growing cells. This function is intended for use@@ -147,7 +169,7 @@ -- Spacers. sumSpacers ::   G.Fields (Maybe a)-  -> Spacers.T Int+  -> S.Spacers Int   -> Int sumSpacers fs =   sum@@ -201,7 +223,7 @@ -- the GFields, which indicates each particular field. pairedWithSpacers ::   G.Fields a-  -> Spacers.T b+  -> S.Spacers b   -> G.Fields (a, Maybe b, G.EFields) pairedWithSpacers f s =   (\(a, b) c -> (a, b, c))@@ -212,56 +234,67 @@ -- spacers; makes the adjustments described in sumSpacers. sumGrowersAndSpacers ::   G.Fields (Maybe Int)-  -> Spacers.T Int+  -> S.Spacers Int   -> Int-sumGrowersAndSpacers fs ss = spacers + flds where-  spacers = sumSpacers fs ss+sumGrowersAndSpacers fs ss = spcrs + flds where+  spcrs = sumSpacers fs ss   flds = Fdbl.foldr f 0 fs where     f maybeI acc = case maybeI of       Nothing -> acc       Just i -> acc + i  -allocPayee :: Int -> Options.T -> Box -> R.ColumnSpec-allocPayee w os i = let-  pb = L.boxPostFam i-  ts = PC.colors (M.visibleNum . L.boxMeta $ i) (O.baseColors os)-  c = R.ColumnSpec j (C.Width w) ts sq-  j = R.LeftJustify-  sq = case Q.payee pb of-    Nothing -> []-    Just pye -> let-      wrapped =-        Fdbl.toList-        . TF.unLines -        . TF.wordWrap w-        . TF.txtWords-        . HT.text-        $ pye-      toBit (TF.Words seqTxts) =-        C.chunk ts-        . X.unwords-        . Fdbl.toList-        $ seqTxts-      in fmap toBit wrapped+allocPayee ::+  Int+  -- ^ Width that is permitted for this column+  -> PC.BaseColors+  -> Box+  -> R.ColumnSpec+allocPayee w bc i =+  let pb = L.boxPostFam i+      ts = PC.colors (M.visibleNum . L.boxMeta $ i) bc+      c = R.ColumnSpec j (C.Width w) ts sq+      j = R.LeftJustify+      sq = case Q.payee pb of+        Nothing -> []+        Just pye ->+          let wrapped =+                Fdbl.toList+                . TF.unLines +                . TF.wordWrap w+                . TF.txtWords+                . HT.text+                $ pye+              toBit (TF.Words seqTxts) =+                C.chunk ts+                . X.unwords+                . Fdbl.toList+                $ seqTxts+          in fmap toBit wrapped   in c  -allocAcct :: Int -> Options.T -> Box -> R.ColumnSpec-allocAcct aw os i = let-  pb = L.boxPostFam i-  ts = PC.colors (M.visibleNum . L.boxMeta $ i) (O.baseColors os) in-  R.ColumnSpec R.LeftJustify (C.Width aw) ts $ let-    target = TF.Target aw-    shortest = TF.Shortest . O.subAccountLength $ os-    a = Q.account pb-    ws = TF.Words . Seq.fromList . HT.textList $ a-    (TF.Words shortened) = TF.shorten shortest target ws-    in [C.chunk ts-       . X.concat-       . intersperse (X.singleton ':')-       . Fdbl.toList-       $ shortened]+allocAcct ::+  Int+  -- ^ Width that is permitted for this column+  -> SubAccountLength+  -> PC.BaseColors+  -> Box+  -> R.ColumnSpec+allocAcct aw sl bc i =+  let pb = L.boxPostFam i+      ts = PC.colors (M.visibleNum . L.boxMeta $ i) bc+  in R.ColumnSpec R.LeftJustify (C.Width aw) ts $+     let target = TF.Target aw+         shortest = TF.Shortest . unSubAccountLength $ sl+         a = Q.account pb+         ws = TF.Words . Seq.fromList . HT.textList $ a+         (TF.Words shortened) = TF.shorten shortest target ws+     in [C.chunk ts+         . X.concat+         . intersperse (X.singleton ':')+         . Fdbl.toList+         $ shortened]  instance Functor Fields where   fmap f i = Fields {

@@ -17,6 +17,7 @@ -- combined. Each bottom row will have one cell.  module Penny.Cabin.Posts.BottomRows (+  BottomOpts(..),   bottomRows, Fields(..), TopRowCells(..), mergeWithSpacers,   topRowCells) where @@ -35,31 +36,34 @@ import qualified Penny.Cabin.TextFormat as TF import qualified Penny.Cabin.Posts.Allocated as A import qualified Penny.Cabin.Colors as PC-import qualified Penny.Cabin.Posts.Fields as Fields import qualified Penny.Cabin.Posts.Fields as F import qualified Penny.Cabin.Posts.Growers as G import qualified Penny.Cabin.Posts.Meta as M-import qualified Penny.Cabin.Posts.Options as Options-import qualified Penny.Cabin.Posts.Options as O-import qualified Penny.Cabin.Posts.Spacers as Spacers+import Penny.Cabin.Posts.Meta (Box) import qualified Penny.Cabin.Posts.Spacers as S+import qualified Penny.Cabin.Posts.Types as Ty import qualified Penny.Lincoln as L import qualified Penny.Lincoln.HasText as HT import qualified Penny.Lincoln.Queries as Q -type Box = L.Box M.PostMeta +data BottomOpts = BottomOpts {+  growingWidths :: G.Fields (Maybe Int)+  , allocatedWidths :: A.Fields (Maybe Int)+  , fields :: F.Fields Bool+  , baseColors :: PC.BaseColors+  , reportWidth :: Ty.ReportWidth+  , spacers :: S.Spacers Int+  }  bottomRows ::-  G.Fields (Maybe Int)-  -> A.Fields (Maybe Int)-  -> Options.T+  BottomOpts   -> [Box]   -> Fields (Maybe [[C.Chunk]])-bottomRows gf af os is = makeRows is pcs where-  pcs = infoProcessors topSpecs rw wanted-  wanted = requestedMakers os-  topSpecs = topCellSpecs gf af (O.spacers os)-  rw = O.width os+bottomRows os bs = makeRows bs pcs where+  pcs = infoProcessors topSpecs (reportWidth os) wanted+  wanted = requestedMakers (fields os) (baseColors os)+  topSpecs = topCellSpecs (growingWidths os) (allocatedWidths os)+             (spacers os)   data Fields a = Fields {@@ -86,7 +90,7 @@     , filename = (filename ff) (filename fa)     } -bottomRowsFields :: Fields.T a -> Fields a+bottomRowsFields :: F.Fields a -> Fields a bottomRowsFields f = Fields {   tags = F.tags f   , memo = F.memo f@@ -137,16 +141,16 @@   widthOfReport ::-  O.ReportWidth+  Ty.ReportWidth   -> (Box -> Int -> (C.TextSpec, R.ColumnSpec))   -> Box   -> [C.Chunk]-widthOfReport (O.ReportWidth rw) fn info =+widthOfReport (Ty.ReportWidth rw) fn info =   makeSpecificWidth rw fn info  chooseProcessor ::   [TopCellSpec]-  -> O.ReportWidth+  -> Ty.ReportWidth   -> (Box -> Int -> (C.TextSpec, R.ColumnSpec))   -> Box   -> [C.Chunk]@@ -159,7 +163,7 @@  infoProcessors ::   [TopCellSpec]-  -> O.ReportWidth+  -> Ty.ReportWidth   -> Fields (Maybe (Box -> Int -> (C.TextSpec, R.ColumnSpec)))   -> Fields (Maybe (Box -> [C.Chunk])) infoProcessors specs rw flds = let@@ -218,7 +222,7 @@  topCellSpecs :: G.Fields (Maybe Int)                 -> A.Fields (Maybe Int)-                -> Spacers.T Int+                -> S.Spacers Int                 -> [TopCellSpec] topCellSpecs gFlds aFlds spcs = let   allFlds = topRowCells gFlds aFlds@@ -236,7 +240,7 @@ -- totalQty has no spacer. mergeWithSpacers ::   TopRowCells a-  -> Spacers.T b+  -> S.Spacers b   -> TopRowCells (a, Maybe b) mergeWithSpacers t s = TopRowCells {   globalTransaction = (globalTransaction t, Just (S.globalTransaction s))@@ -275,7 +279,7 @@   (_, c) = f i w  -type Maker = Options.T -> Box -> Int -> (C.TextSpec, R.ColumnSpec)+type Maker = PC.BaseColors -> Box -> Int -> (C.TextSpec, R.ColumnSpec)  makers :: Fields Maker makers = Fields tagsCell memoCell filenameCell@@ -284,18 +288,19 @@ -- returns a Fields (Maybe Maker) with a Maker in each respective -- field that the user wants to see. requestedMakers ::-  Options.T+  F.Fields Bool+  -> PC.BaseColors   -> Fields (Maybe (Box -> Int -> (C.TextSpec, R.ColumnSpec)))-requestedMakers os = let-  flds = bottomRowsFields (O.fields os)-  filler b mkr = if b then Just $ mkr os else Nothing+requestedMakers allFlds bc =+  let flds = bottomRowsFields allFlds+      filler b mkr = if b then Just $ mkr bc else Nothing   in filler <$> flds <*> makers -tagsCell :: Options.T -> Box -> Int -> (C.TextSpec, R.ColumnSpec)-tagsCell os info w = (ts, cell) where+tagsCell :: PC.BaseColors -> Box -> Int -> (C.TextSpec, R.ColumnSpec)+tagsCell bc info w = (ts, cell) where   vn = M.visibleNum . L.boxMeta $ info   cell = R.ColumnSpec R.LeftJustify (C.Width w) ts cs-  ts = PC.colors vn (O.baseColors os)+  ts = PC.colors vn bc   cs =     Fdbl.toList     . fmap toBit@@ -328,12 +333,12 @@   toBit (TF.Words ws) = C.chunk ts (X.unwords . Fdbl.toList $ ws)  -memoCell :: Options.T -> Box -> Int -> (C.TextSpec, R.ColumnSpec)-memoCell os info width = (ts, cell) where+memoCell :: PC.BaseColors -> Box -> Int -> (C.TextSpec, R.ColumnSpec)+memoCell bc info width = (ts, cell) where   w = C.Width width   vn = M.visibleNum . L.boxMeta $ info   cell = R.ColumnSpec R.LeftJustify w ts cs-  ts = PC.colors vn (O.baseColors os)+  ts = PC.colors vn bc   pm = Q.postingMemo . L.boxPostFam $ info   tm = Q.transactionMemo . L.boxPostFam $ info   nullMemo (L.Memo m) = null m@@ -344,8 +349,8 @@     (False, False) -> memoBits ts pm w `mappend` memoBits ts tm w    -filenameCell :: Options.T -> Box -> Int -> (C.TextSpec, R.ColumnSpec)-filenameCell os info width = (ts, cell) where+filenameCell :: PC.BaseColors -> Box -> Int -> (C.TextSpec, R.ColumnSpec)+filenameCell bc info width = (ts, cell) where   w = C.Width width   vn = M.visibleNum . L.boxMeta $ info   cell = R.ColumnSpec R.LeftJustify w ts cs@@ -354,7 +359,7 @@   cs = case Q.filename . L.boxPostFam $ info of     Nothing -> []     Just fn -> [toBit . L.unFilename $ fn]-  ts = PC.colors vn (O.baseColors os)+  ts = PC.colors vn bc   

@@ -1,33 +1,90 @@-module Penny.Cabin.Posts.Chunk (makeChunk) where+module Penny.Cabin.Posts.Chunk (ChunkOpts(..), makeChunk) where  import qualified Data.Foldable as Fdbl import Data.List (transpose) import Data.Maybe (isNothing, catMaybes)+import qualified Penny.Cabin.Posts.Fields as F import qualified Penny.Cabin.Posts.Growers as G import qualified Penny.Cabin.Posts.Allocated as A+import qualified Penny.Cabin.Posts.Allocate as Alc import qualified Penny.Cabin.Posts.BottomRows as B-import qualified Penny.Cabin.Posts.Options as Options+import qualified Penny.Cabin.Posts.Spacers as S import qualified Penny.Cabin.Row as R import qualified Penny.Cabin.Chunk as C import qualified Penny.Cabin.Colors as PC+import Penny.Cabin.Posts.Meta (Box) import qualified Penny.Lincoln as L-import qualified Penny.Cabin.Posts.Meta as M+import qualified Data.Text as X+import qualified Penny.Cabin.Posts.Types as Ty -type Box = L.Box M.PostMeta +data ChunkOpts = ChunkOpts {+  baseColors :: PC.BaseColors+  , drCrColors :: PC.DrCrColors+  , dateFormat :: Box -> X.Text+  , qtyFormat :: Box -> X.Text+  , balanceFormat :: L.Commodity -> L.BottomLine -> X.Text+  , fields :: F.Fields Bool+  , subAccountLength :: A.SubAccountLength+  , payeeAllocation :: Alc.Allocation+  , accountAllocation :: Alc.Allocation+  , spacers :: S.Spacers Int+  , reportWidth :: Ty.ReportWidth+  } -makeChunk :: Options.T -> [Box] -> [C.Chunk]-makeChunk os is = let-  fmapSnd flds = fmap (fmap snd) flds-  fmapFst flds = fmap (fmap fst) flds-  gFldW = fmapSnd gFlds-  aFldW = fmapSnd aFlds-  gFlds = G.growCells os is-  aFlds = A.payeeAndAcct gFldW os is-  bFlds = B.bottomRows gFldW aFldW os is-  topCells = B.topRowCells (fmapFst gFlds) (fmapFst aFlds)-  withSpacers = B.mergeWithSpacers topCells (Options.spacers os)-  topRows = makeTopRows (Options.baseColors os) withSpacers-  bottomRows = makeBottomRows bFlds+growOpts :: ChunkOpts -> G.GrowOpts+growOpts c = G.GrowOpts {+  G.baseColors = baseColors c+  , G.drCrColors = drCrColors c+  , G.dateFormat = dateFormat c+  , G.qtyFormat = qtyFormat c+  , G.balanceFormat = balanceFormat c+  , G.fields = fields c+  }++allocatedOpts :: ChunkOpts -> G.Fields (Maybe Int) -> A.AllocatedOpts+allocatedOpts c g = A.AllocatedOpts {+  A.fields = let f = fields c+             in A.Fields { A.payee = F.payee f+                         , A.account = F.account f }+  , A.subAccountLength = subAccountLength c+  , A.baseColors = baseColors c+  , A.payeeAllocation = payeeAllocation c+  , A.accountAllocation = accountAllocation c+  , A.spacers = spacers c+  , A.growerWidths = g+  , A.reportWidth = reportWidth c+  }++bottomOpts ::+  ChunkOpts+  -> G.Fields (Maybe Int)+  -> A.Fields (Maybe Int)+  -> B.BottomOpts+bottomOpts c g a = B.BottomOpts {+  B.growingWidths = g+  , B.allocatedWidths = a+  , B.fields = fields c+  , B.baseColors = baseColors c+  , B.reportWidth = reportWidth c+  , B.spacers = spacers c+  }++makeChunk ::+  ChunkOpts+  -> [Box]+  -> [C.Chunk]+makeChunk c bs =+  let fmapSnd = fmap (fmap snd)+      fmapFst = fmap (fmap fst)+      gFldW = fmap (fmap snd) gFlds+      aFldW = fmapSnd aFlds+      gFlds = G.growCells (growOpts c) bs+      aFlds = A.payeeAndAcct (allocatedOpts c gFldW) bs+      bFlds = B.bottomRows (bottomOpts c gFldW aFldW) bs+      topCells = B.topRowCells (fmapFst gFlds) (fmap (fmap fst) aFlds)+      withSpacers = B.mergeWithSpacers topCells (spacers c)+      topRows = makeTopRows (baseColors c) withSpacers+      bottomRows = makeBottomRows bFlds   in makeAllRows topRows bottomRows  

@@ -4,7 +4,7 @@ import Control.Applicative(Applicative(pure, (<*>))) import qualified Data.Foldable as F -data T a = T {+data Fields a = Fields {   globalTransaction :: a   , revGlobalTransaction :: a   , globalPosting :: a@@ -37,8 +37,8 @@   , filename :: a }   deriving (Show, Eq) -instance Functor T where-  fmap f fa = T {+instance Functor Fields where+  fmap f fa = Fields {     globalTransaction = f (globalTransaction fa)     , revGlobalTransaction = f (revGlobalTransaction fa)     , globalPosting = f (globalPosting fa)@@ -69,8 +69,8 @@     , memo = f (memo fa)     , filename = f (filename fa) } -instance Applicative T where-  pure a = T {+instance Applicative Fields where+  pure a = Fields {     globalTransaction = a     , revGlobalTransaction = a     , globalPosting = a@@ -101,7 +101,7 @@     , memo = a     , filename = a } -  ff <*> fa = T {+  ff <*> fa = Fields {     globalTransaction = globalTransaction ff (globalTransaction fa)     , revGlobalTransaction = revGlobalTransaction ff                              (revGlobalTransaction fa)@@ -133,7 +133,7 @@     , memo = memo ff (memo fa)     , filename = filename ff (filename fa) } -instance F.Foldable T where+instance F.Foldable Fields where   foldr f z t =     f (globalTransaction t)     (f (revGlobalTransaction t)

@@ -2,6 +2,7 @@ -- widest cell in the column. No information is ever truncated from -- these cells (what use is a truncated dollar amount?) module Penny.Cabin.Posts.Growers (+  GrowOpts(..),   growCells, Fields(..), grownWidth,   eFields, EFields(..), pairWithSpacer) where @@ -13,20 +14,26 @@ import Data.Text (Text, pack, empty) import qualified Data.Text as X import qualified Penny.Cabin.Chunk as C-import qualified Penny.Cabin.Colors as PC-import qualified Penny.Cabin.Posts.Options as O-import qualified Penny.Cabin.Posts.Options as Options+import qualified Penny.Cabin.Colors as CC import qualified Penny.Cabin.Posts.Fields as F import qualified Penny.Cabin.Posts.Meta as M+import Penny.Cabin.Posts.Meta (Box) import qualified Penny.Cabin.Posts.Spacers as S-import qualified Penny.Cabin.Posts.Spacers as Spacers import qualified Penny.Cabin.Row as R import qualified Penny.Liberty as Ly import qualified Penny.Lincoln as L import qualified Penny.Lincoln.Queries as Q  -type Box = L.Box M.PostMeta +-- | All the options needed to grow the cells.+data GrowOpts = GrowOpts {+  baseColors :: CC.BaseColors+  , drCrColors :: CC.DrCrColors+  , dateFormat :: Box -> X.Text+  , qtyFormat :: Box -> X.Text+  , balanceFormat :: L.Commodity -> L.BottomLine -> X.Text+  , fields :: F.Fields Bool+  }  -- | Grows the cells that will be GrowToFit cells in the report. First -- this function fills in all visible cells with text, but leaves the@@ -39,19 +46,19 @@ -- the report but that ended up having no width are changed to -- Nothing. growCells ::-  Options.T+  GrowOpts   -> [Box]   -> Fields (Maybe ([R.ColumnSpec], Int)) growCells o infos = toPair <$> wanted <*> growers where   toPair b gwr-    | b = let-      cs = map (gwr o) infos-      w = Fdbl.foldl' f 0 cs where-        f acc c = max acc (widestLine c)-      cs' = map (sizer (R.Width w)) cs+    | b =+      let cs = map (gwr o) infos+          w = Fdbl.foldl' f 0 cs where+            f acc c = max acc (widestLine c)+          cs' = map (sizer (R.Width w)) cs       in if w > 0 then Just (cs', w) else Nothing     | otherwise = Nothing-  wanted = growingFields o+  wanted = growingFields . fields $ o  widestLine :: PreSpec -> Int widestLine (PreSpec _ _ bs) =@@ -70,49 +77,74 @@  -- | Makes a left justified cell that is only one line long. The width -- is unset.-oneLine :: Text -> Options.T -> Box -> PreSpec-oneLine t os b =-  let bc = Options.baseColors os-      ts = PC.colors (M.visibleNum . L.boxMeta $ b) bc+oneLine :: Text -> CC.BaseColors -> Box -> PreSpec+oneLine t bc b =+  let ts = CC.colors (M.visibleNum . L.boxMeta $ b) bc       j = R.LeftJustify       bit = C.chunk ts t   in PreSpec j ts [bit] -growers :: Fields (Options.T -> Box -> PreSpec)+-- | Converts a function that accepts a BaseColors to one that accepts+-- a GrowOpts.+bcToGrowOpts ::+  (CC.BaseColors -> Box -> PreSpec)+  -> GrowOpts -> Box -> PreSpec+bcToGrowOpts f g = f (baseColors g)++-- | Converts a function that accepts a DrCrColors to one that accepts+-- a GrowOpts.+dcToGrowOpts ::+  (CC.DrCrColors -> Box -> PreSpec)+  -> GrowOpts -> Box -> PreSpec+dcToGrowOpts f g = f (drCrColors g)+++-- | Gets a Fields with each field filled with the function that fills+-- the cells for that field.+growers :: Fields (GrowOpts -> Box -> PreSpec) growers = Fields {-  globalTransaction      = getGlobalTransaction-  , revGlobalTransaction = getRevGlobalTransaction-  , globalPosting        = getGlobalPosting-  , revGlobalPosting     = getRevGlobalPosting-  , fileTransaction      = getFileTransaction-  , revFileTransaction   = getRevFileTransaction-  , filePosting          = getFilePosting-  , revFilePosting       = getRevFilePosting-  , filtered             = getFiltered-  , revFiltered          = getRevFiltered-  , sorted               = getSorted-  , revSorted            = getRevSorted-  , visible              = getVisible-  , revVisible           = getRevVisible-  , lineNum              = getLineNum-  , date                 = getDate-  , flag                 = getFlag-  , number               = getNumber-  , postingDrCr          = getPostingDrCr-  , postingCmdty         = getPostingCmdty-  , postingQty           = getPostingQty-  , totalDrCr            = getTotalDrCr-  , totalCmdty           = getTotalCmdty-  , totalQty             = getTotalQty }+  globalTransaction      = bcToGrowOpts getGlobalTransaction+  , revGlobalTransaction = bcToGrowOpts getRevGlobalTransaction+  , globalPosting        = bcToGrowOpts getGlobalPosting+  , revGlobalPosting     = bcToGrowOpts getRevGlobalPosting+  , fileTransaction      = bcToGrowOpts getFileTransaction+  , revFileTransaction   = bcToGrowOpts getRevFileTransaction+  , filePosting          = bcToGrowOpts getFilePosting+  , revFilePosting       = bcToGrowOpts getRevFilePosting+  , filtered             = bcToGrowOpts getFiltered+  , revFiltered          = bcToGrowOpts getRevFiltered+  , sorted               = bcToGrowOpts getSorted+  , revSorted            = bcToGrowOpts getRevSorted+  , visible              = bcToGrowOpts getVisible+  , revVisible           = bcToGrowOpts getRevVisible+  , lineNum              = bcToGrowOpts getLineNum+  , date                 = \o -> getDate (baseColors o) (dateFormat o)+  , flag                 = bcToGrowOpts getFlag+  , number               = bcToGrowOpts getNumber+  , postingDrCr          = dcToGrowOpts getPostingDrCr+  , postingCmdty         = dcToGrowOpts getPostingCmdty+  , postingQty           = let fn o =+                                 let fmt = qtyFormat o+                                     dc = drCrColors o+                                 in getPostingQty fmt dc+                           in fn+  , totalDrCr            = dcToGrowOpts getTotalDrCr+  , totalCmdty           = dcToGrowOpts getTotalCmdty+  , totalQty             = let fn o =+                                 let fmt = balanceFormat o+                                     dc = drCrColors o+                                 in getTotalQty fmt dc+                           in fn } + -- | Make a left justified cell one line long that shows a serial. serialCellMaybe ::   (L.PostFam -> Maybe Int)   -- ^ When applied to a Box, this function returns Just Int if the   -- box has a serial, or Nothing if not.   -  -> Options.T -> Box -> PreSpec-serialCellMaybe f os b = oneLine t os b+  -> CC.BaseColors -> Box -> PreSpec+serialCellMaybe f bc b = oneLine t bc b   where     t = case f (L.boxPostFam b) of       Nothing -> X.empty@@ -120,91 +152,90 @@  serialCell ::   (M.PostMeta -> Int)-  -> Options.T -> Box -> PreSpec-serialCell f os b = oneLine t os b+  -> CC.BaseColors -> Box -> PreSpec+serialCell f bc b = oneLine t bc b   where     t = pack . show . f . L.boxMeta $ b -getGlobalTransaction :: Options.T -> Box -> PreSpec+getGlobalTransaction :: CC.BaseColors -> Box -> PreSpec getGlobalTransaction =   serialCellMaybe (fmap (L.forward . L.unGlobalTransaction)                    . Q.globalTransaction) -getRevGlobalTransaction :: Options.T -> Box -> PreSpec+getRevGlobalTransaction :: CC.BaseColors -> Box -> PreSpec getRevGlobalTransaction =   serialCellMaybe (fmap (L.backward . L.unGlobalTransaction)                    . Q.globalTransaction) -getGlobalPosting :: Options.T -> Box -> PreSpec+getGlobalPosting :: CC.BaseColors -> Box -> PreSpec getGlobalPosting =   serialCellMaybe (fmap (L.forward . L.unGlobalPosting)                    . Q.globalPosting) -getRevGlobalPosting :: Options.T -> Box -> PreSpec+getRevGlobalPosting :: CC.BaseColors -> Box -> PreSpec getRevGlobalPosting =   serialCellMaybe (fmap (L.backward . L.unGlobalPosting)                    . Q.globalPosting) -getFileTransaction :: Options.T -> Box -> PreSpec+getFileTransaction :: CC.BaseColors -> Box -> PreSpec getFileTransaction =   serialCellMaybe (fmap (L.forward . L.unFileTransaction)                    . Q.fileTransaction) -getRevFileTransaction :: Options.T -> Box -> PreSpec+getRevFileTransaction :: CC.BaseColors -> Box -> PreSpec getRevFileTransaction =   serialCellMaybe (fmap (L.backward . L.unFileTransaction)                    . Q.fileTransaction) -getFilePosting :: Options.T -> Box -> PreSpec+getFilePosting :: CC.BaseColors -> Box -> PreSpec getFilePosting =   serialCellMaybe (fmap (L.forward . L.unFilePosting)                    . Q.filePosting) -getRevFilePosting :: Options.T -> Box -> PreSpec+getRevFilePosting :: CC.BaseColors -> Box -> PreSpec getRevFilePosting =   serialCellMaybe (fmap (L.backward . L.unFilePosting)                    . Q.filePosting) -getSorted :: Options.T -> Box -> PreSpec+getSorted :: CC.BaseColors -> Box -> PreSpec getSorted =   serialCell (L.forward . Ly.unSortedNum . M.sortedNum) -getRevSorted :: Options.T -> Box -> PreSpec+getRevSorted :: CC.BaseColors -> Box -> PreSpec getRevSorted =   serialCell (L.backward . Ly.unSortedNum . M.sortedNum) -getFiltered :: Options.T -> Box -> PreSpec+getFiltered :: CC.BaseColors -> Box -> PreSpec getFiltered =   serialCell (L.forward . Ly.unFilteredNum . M.filteredNum) -getRevFiltered :: Options.T -> Box -> PreSpec+getRevFiltered :: CC.BaseColors -> Box -> PreSpec getRevFiltered =   serialCell (L.backward . Ly.unFilteredNum . M.filteredNum) -getVisible :: Options.T -> Box -> PreSpec+getVisible :: CC.BaseColors -> Box -> PreSpec getVisible =   serialCell (L.forward . M.unVisibleNum . M.visibleNum) -getRevVisible :: Options.T -> Box -> PreSpec+getRevVisible :: CC.BaseColors -> Box -> PreSpec getRevVisible =   serialCell (L.backward . M.unVisibleNum . M.visibleNum)  -getLineNum :: Options.T -> Box -> PreSpec-getLineNum os b = oneLine t os b where+getLineNum :: CC.BaseColors -> Box -> PreSpec+getLineNum bc b = oneLine t bc b where   lineTxt = pack . show . L.unPostingLine   t = maybe empty lineTxt (Q.postingLine . L.boxPostFam $ b) -getDate :: Options.T -> Box -> PreSpec-getDate os i = oneLine t os i where-  t = O.dateFormat os i+getDate :: CC.BaseColors -> (Box -> X.Text) -> Box -> PreSpec+getDate bc gd b = oneLine (gd b) bc b -getFlag :: Options.T -> Box -> PreSpec-getFlag os i = oneLine t os i where+getFlag :: CC.BaseColors -> Box -> PreSpec+getFlag bc i = oneLine t bc i where   t = maybe empty L.text (Q.flag . L.boxPostFam $ i) -getNumber :: Options.T -> Box -> PreSpec-getNumber os i = oneLine t os i where+getNumber :: CC.BaseColors -> Box -> PreSpec+getNumber bc i = oneLine t bc i where   t = maybe empty L.text (Q.number . L.boxPostFam $ i)  dcTxt :: L.DrCr -> Text@@ -213,126 +244,131 @@  -- | Gives a one-line cell that is colored according to whether the -- posting is a debit or credit.-coloredPostingCell :: Text -> Options.T -> Box -> PreSpec-coloredPostingCell t os i = PreSpec j ts [bit] where+coloredPostingCell :: Text -> CC.DrCrColors -> Box -> PreSpec+coloredPostingCell t dccol i = PreSpec j ts [bit] where   j = R.LeftJustify   bit = C.chunk ts t   dc = Q.drCr . L.boxPostFam $ i-  ts = PC.colors (M.visibleNum . L.boxMeta $ i)-       . PC.drCrToBaseColors dc-       . O.drCrColors-       $ os+  ts = CC.colors (M.visibleNum . L.boxMeta $ i)+       . CC.drCrToBaseColors dc+       $ dccol -getPostingDrCr :: Options.T -> Box -> PreSpec-getPostingDrCr os i = coloredPostingCell t os i where++getPostingDrCr :: CC.DrCrColors -> Box -> PreSpec+getPostingDrCr dc i = coloredPostingCell t dc i where   t = dcTxt . Q.drCr . L.boxPostFam $ i -getPostingCmdty :: Options.T -> Box -> PreSpec-getPostingCmdty os i = coloredPostingCell t os i where+getPostingCmdty :: CC.DrCrColors -> Box -> PreSpec+getPostingCmdty dc i = coloredPostingCell t dc i where   t = L.text . L.Delimited (X.singleton ':')        . L.textList . Q.commodity . L.boxPostFam $ i -getPostingQty :: Options.T -> Box -> PreSpec-getPostingQty os i = coloredPostingCell t os i where-  t = O.qtyFormat os i+getPostingQty :: (Box -> X.Text) -> CC.DrCrColors -> Box -> PreSpec+getPostingQty qf dc i = coloredPostingCell (qf i) dc i -getTotalDrCr :: Options.T -> Box -> PreSpec-getTotalDrCr os i = let-  vn = M.visibleNum . L.boxMeta $ i-  ts = PC.colors vn bc-  bc = PC.drCrToBaseColors dc (O.drCrColors os)-  dc = Q.drCr . L.boxPostFam $ i-  bits = case M.balance . L.boxMeta $ i of-    Nothing -> let-      spec = PC.noBalanceColors vn (O.drCrColors os)-      in [C.chunk spec (pack "--")]-    Just bal -> let-      toBit bl = let-        spec = -          PC.colors vn-          . PC.bottomLineToBaseColors (O.drCrColors os)-          $ bl-        txt = case bl of-          L.Zero -> pack "--"-          L.NonZero (L.Column clmDrCr _) -> dcTxt clmDrCr-        in C.chunk spec txt-      in fmap toBit . elems . L.unBalance $ bal-  j = R.LeftJustify+getTotalDrCr :: CC.DrCrColors -> Box -> PreSpec+getTotalDrCr dccol i =+  let vn = M.visibleNum . L.boxMeta $ i+      ts = CC.colors vn bc+      bc = CC.drCrToBaseColors dc dccol+      dc = Q.drCr . L.boxPostFam $ i+      bits = case M.balance . L.boxMeta $ i of+        Nothing ->+          let spec = CC.noBalanceColors vn dccol+          in [C.chunk spec (pack "--")]+        Just bal ->+          let toBit bl =+                let spec = +                      CC.colors vn+                      . CC.bottomLineToBaseColors dccol+                      $ bl+                    txt = case bl of+                      L.Zero -> pack "--"+                      L.NonZero (L.Column clmDrCr _) ->+                        dcTxt clmDrCr+                in C.chunk spec txt+          in fmap toBit . elems . L.unBalance $ bal+      j = R.LeftJustify   in PreSpec j ts bits -getTotalCmdty :: Options.T -> Box -> PreSpec-getTotalCmdty os i = let-  vn = M.visibleNum . L.boxMeta $ i-  j = R.RightJustify-  ts = PC.colors vn bc-  bc = PC.drCrToBaseColors dc (O.drCrColors os)-  dc = Q.drCr . L.boxPostFam $ i-  bits = case M.balance . L.boxMeta $ i of-    Nothing -> let-      spec = PC.noBalanceColors vn (O.drCrColors os)-      in [C.chunk spec (pack "--")]-    Just bal -> let-      toBit (com, nou) = let-        spec =-          PC.colors vn-          . PC.bottomLineToBaseColors (O.drCrColors os)-          $ nou-        txt = L.text-              . L.Delimited (X.singleton ':')-              . L.textList-              $ com-        in C.chunk spec txt-      in fmap toBit . assocs . L.unBalance $ bal+getTotalCmdty :: CC.DrCrColors -> Box -> PreSpec+getTotalCmdty dccol i =+  let vn = M.visibleNum . L.boxMeta $ i+      j = R.RightJustify+      ts = CC.colors vn bc+      bc = CC.drCrToBaseColors dc dccol+      dc = Q.drCr . L.boxPostFam $ i+      bits = case M.balance . L.boxMeta $ i of+        Nothing ->+          let spec = CC.noBalanceColors vn dccol+          in [C.chunk spec (pack "--")]+        Just bal ->+          let toBit (com, nou) =+                let spec =+                      CC.colors vn+                      . CC.bottomLineToBaseColors dccol+                      $ nou+                    txt = L.text+                          . L.Delimited (X.singleton ':')+                          . L.textList+                          $ com+                in C.chunk spec txt+          in fmap toBit . assocs . L.unBalance $ bal   in PreSpec j ts bits -getTotalQty :: Options.T -> Box -> PreSpec-getTotalQty os i = let-  vn = M.visibleNum . L.boxMeta $ i-  j = R.LeftJustify-  ts = PC.colors vn bc-  bc = PC.drCrToBaseColors dc (O.drCrColors os)-  dc = Q.drCr . L.boxPostFam $ i-  bits = case M.balance . L.boxMeta $ i of-    Nothing -> let-      spec = PC.noBalanceColors vn (O.drCrColors os)-      in [C.chunk spec (pack "--")]-    Just bal -> fmap toChunk . assocs . L.unBalance $ bal where-      toChunk (com, nou) = let-        spec = -          PC.colors vn-          . PC.bottomLineToBaseColors (O.drCrColors os)-          $ nou-        txt = O.balanceFormat os com nou-        in C.chunk spec txt+getTotalQty ::+  (L.Commodity -> L.BottomLine -> X.Text)+  -> CC.DrCrColors+  -> Box+  -> PreSpec+getTotalQty balFmt dccol i =+  let vn = M.visibleNum . L.boxMeta $ i+      j = R.LeftJustify+      ts = CC.colors vn bc+      bc = CC.drCrToBaseColors dc dccol+      dc = Q.drCr . L.boxPostFam $ i+      bits = case M.balance . L.boxMeta $ i of+        Nothing ->+          let spec = CC.noBalanceColors vn dccol+          in [C.chunk spec (pack "--")]+        Just bal ->+          fmap toChunk . assocs . L.unBalance $ bal+            where+              toChunk (com, nou) =+                let spec = +                      CC.colors vn+                      . CC.bottomLineToBaseColors dccol+                      $ nou+                    txt = balFmt com nou+                in C.chunk spec txt   in PreSpec j ts bits -growingFields :: Options.T -> Fields Bool-growingFields o = let-  f = O.fields o in Fields {-    globalTransaction      = F.globalTransaction  f-    , revGlobalTransaction = F.revGlobalTransaction  f-    , globalPosting        = F.globalPosting      f-    , revGlobalPosting     = F.revGlobalPosting   f-    , fileTransaction      = F.fileTransaction    f-    , revFileTransaction   = F.revFileTransaction f-    , filePosting          = F.filePosting        f-    , revFilePosting       = F.revFilePosting     f-    , filtered             = F.filtered           f-    , revFiltered          = F.revFiltered        f-    , sorted               = F.sorted             f-    , revSorted            = F.revSorted          f-    , visible              = F.visible            f-    , revVisible           = F.revVisible         f-    , lineNum              = F.lineNum            f-    , date                 = F.date               f-    , flag                 = F.flag               f-    , number               = F.number             f-    , postingDrCr          = F.postingDrCr        f-    , postingCmdty         = F.postingCmdty       f-    , postingQty           = F.postingQty         f-    , totalDrCr            = F.totalDrCr          f-    , totalCmdty           = F.totalCmdty         f-    , totalQty             = F.totalQty           f }+growingFields :: F.Fields Bool -> Fields Bool+growingFields f = Fields {+  globalTransaction      = F.globalTransaction    f+  , revGlobalTransaction = F.revGlobalTransaction f+  , globalPosting        = F.globalPosting        f+  , revGlobalPosting     = F.revGlobalPosting     f+  , fileTransaction      = F.fileTransaction      f+  , revFileTransaction   = F.revFileTransaction   f+  , filePosting          = F.filePosting          f+  , revFilePosting       = F.revFilePosting       f+  , filtered             = F.filtered             f+  , revFiltered          = F.revFiltered          f+  , sorted               = F.sorted               f+  , revSorted            = F.revSorted            f+  , visible              = F.visible              f+  , revVisible           = F.revVisible           f+  , lineNum              = F.lineNum              f+  , date                 = F.date                 f+  , flag                 = F.flag                 f+  , number               = F.number               f+  , postingDrCr          = F.postingDrCr          f+  , postingCmdty         = F.postingCmdty         f+  , postingQty           = F.postingQty           f+  , totalDrCr            = F.totalDrCr            f+  , totalCmdty           = F.totalCmdty           f+  , totalQty             = F.totalQty             f }  -- | All growing fields, as an ADT. data EFields =@@ -529,7 +565,7 @@ -- | Pairs data from a Fields with its matching spacer field. The -- spacer field is returned in a Maybe because the TotalQty field does -- not have a spacer.-pairWithSpacer :: Fields a -> Spacers.T b -> Fields (a, Maybe b)+pairWithSpacer :: Fields a -> S.Spacers b -> Fields (a, Maybe b) pairWithSpacer f s = Fields {   globalTransaction      = (globalTransaction    f, Just (S.globalTransaction    s))   , revGlobalTransaction = (revGlobalTransaction f, Just (S.revGlobalTransaction s))@@ -588,7 +624,7 @@ -- spacer cells. grownWidth ::   Fields (Maybe Int)-  -> Spacers.T Int+  -> S.Spacers Int   -> Int grownWidth fs ss =   Semi.getSum

@@ -1,18 +1,20 @@ module Penny.Cabin.Posts.Meta (   M.VisibleNum(M.unVisibleNum)   , PostMeta(filteredNum, sortedNum, visibleNum, balance)-  , filterBoxes-  , addMetadata+  , Box+  , toBoxList   ) where  import Data.List (mapAccumL) import qualified Penny.Lincoln as L import qualified Penny.Lincoln.Queries as Q import qualified Penny.Liberty as Ly-import qualified Penny.Liberty.Expressions as Exp import qualified Penny.Cabin.Meta as M import qualified Penny.Cabin.Options as CO +-- | The Box type that is used throughout the Posts modules.+type Box = L.Box PostMeta+ data PostMeta =   PostMeta { filteredNum :: Ly.FilteredNum             , sortedNum :: Ly.SortedNum@@ -21,31 +23,38 @@   deriving Show  --- | Takes a list of Box with LibertyMeta, and a list of tokens from--- the command line, and a list of post filters. Filters the list of--- Box and processes the post filter. Fails if the expression fails to--- produce a result.-filterBoxes ::-  [Exp.Token (L.Box Ly.LibertyMeta -> Bool)]-  -> [Ly.PostFilterFn]-  -> [L.Box Ly.LibertyMeta]-  -> Maybe [L.Box Ly.LibertyMeta]-filterBoxes tks pfs bs = fmap fltr (Ly.parsePredicate tks)-  where-    fltr p =-      Ly.processPostFilters pfs . filter p $ bs------ | Applied to a list of Box that have already been filtered, returns--- a list of Box with posting metadata. addMetadata ::-  CO.ShowZeroBalances-  -> [L.Box Ly.LibertyMeta]-  -> [L.Box PostMeta]-addMetadata szb = M.visibleNums f . addBalances szb where+  [(L.Box (Ly.LibertyMeta, Maybe L.Balance))]+  -> [Box]+addMetadata = M.visibleNums f where   f vn (lm, mb) =     PostMeta (Ly.filteredNum lm) (Ly.sortedNum lm) vn mb++-- | Adds appropriate metadata, including the running balance, to a+-- list of Box. Because all posts are incorporated into the running+-- balance, first calculates the running balance for all posts. Then,+-- removes posts we're not interested in by applying the predicate and+-- the post-filter. Finally, adds on the metadata, which will include+-- the VisibleNum.+toBoxList ::+  CO.ShowZeroBalances+  -> (L.Box Ly.LibertyMeta -> Bool)+  -- ^ Removes posts from the report if applying this function to the+  -- post returns False. Posts removed still affect the running+  -- balance.+  +  -> [Ly.PostFilterFn]+  -- ^ Applies these post-filters to the list of posts that results+  -- from applying the predicate above. Might remove more+  -- postings. Postings removed still affect the running balance.++  -> [L.Box Ly.LibertyMeta]+  -> [Box]+toBoxList szb pdct pff =+  addMetadata+  . Ly.processPostFilters pff+  . filter (pdct . fmap fst)+  . addBalances szb  addBalances ::   CO.ShowZeroBalances

@@ -1,247 +0,0 @@--- | Options for the Posts report.-module Penny.Cabin.Posts.Options where---import Control.Monad.Exception.Synchronous (Exceptional)-import Data.Text (Text)-import qualified Data.Text as X-import Data.Time (formatTime)-import System.Locale (defaultTimeLocale)-import qualified Data.Time as Time-import qualified Text.Matchers.Text as M--import qualified Penny.Liberty as Ly-import qualified Penny.Liberty.Expressions as Ex-import qualified Penny.Lincoln as L-import qualified Penny.Lincoln.Balance as Bal-import qualified Penny.Lincoln.Bits as Bits-import qualified Penny.Lincoln.Queries as Q-import qualified Penny.Cabin.Posts.Allocate as A-import qualified Penny.Cabin.Chunk as CC-import qualified Penny.Cabin.Colors as C-import qualified Penny.Cabin.Options as O-import qualified Penny.Cabin.Posts.Fields as Fields-import qualified Penny.Cabin.Posts.Fields as F-import qualified Penny.Cabin.Posts.Meta as Meta-import qualified Penny.Cabin.Posts.Spacers as S-import qualified Penny.Cabin.Posts.Spacers as Spacers-import qualified Penny.Cabin.Colors.DarkBackground as Dark-import Penny.Copper.DateTime (DefaultTimeZone)-import Penny.Copper.Qty (RadGroup)-import qualified Penny.Shield as S---type Box = L.Box Meta.PostMeta--data T =-  T { drCrColors :: C.DrCrColors-      -- ^ Colors to use when displaying debits, credits, and-      -- when displaying balance totals--    , baseColors :: C.BaseColors -      -- ^ Colors to use when displaying everything else--    , dateFormat :: Box -> X.Text-      -- ^ How to display dates. This function is applied to the-      -- a PostingInfo so it has lots of information, but it-      -- should return a date for use in the Date field.-      -    , qtyFormat :: Box -> X.Text-      -- ^ How to display the quantity of the posting. This-      -- function is applied to a PostingInfo so it has lots of-      -- information, but it should return a formatted string of-      -- the quantity. Allows you to format digit grouping,-      -- radix points, perform rounding, etc.-      -    , balanceFormat :: Bits.Commodity -> Bal.BottomLine -> X.Text-      -- ^ How to display balance totals. Similar to-      -- balanceFormat.-      -    , payeeAllocation :: A.Allocation-      -- ^ This and accountAllocation determine how much space-      -- payees and accounts receive. They divide up the-      -- remaining space after everything else is displayed. For-      -- instance if payeeAllocation is 60 and accountAllocation-      -- is 40, the payee takes about 60 percent of the-      -- remaining space and the account takes about 40 percent.-      -    , accountAllocation :: A.Allocation -      -- ^ See payeeAllocation above--    , width :: ReportWidth-      -- ^ Gives the default report width. This can be-      -- overridden on the command line. You can use the-      -- information from the Runtime to make this as wide as-      -- the as the current terminal.--    , subAccountLength :: Int-      -- ^ When shortening the names of sub accounts to make-      -- them fit, they will be this long.--    , colorPref :: CC.Colors-      -- ^ How many colors you want to see, or do it-      -- automatically.--    , timeZone :: DefaultTimeZone-      -- ^ When dates and times are given on the command line-      -- and they have no time zone, they are assumed to be in-      -- this time zone. This has no bearing on how dates are-      -- formatted in the output; for that, see dateFormat-      -- above.--    , radGroup :: RadGroup-      -- ^ The characters used for the radix point for numbers-      -- given on the command line (e.g. a full stop, or a-      -- comma) and for the digit group separator for-      -- numbers parsed from the command line (e.g. a full stop,-      -- or a comma). Affects how inputs are parsed. Has no bearing-      -- on how output is formatted; for that, see qtyFormat and-      -- balanceFormat above.-      -    , sensitive :: M.CaseSensitive-      -- ^ Whether pattern matches are case sensitive by default.-      -    , factory :: M.CaseSensitive-                 -> Text -> Exceptional Text (Text -> Bool)-      -- ^ Default factory for pattern matching-      -    , tokens :: [Ex.Token (L.Box Ly.LibertyMeta -> Bool)]-      -- ^ Default list of tokens used to filter postings.-      -    , postFilter :: [Ly.PostFilterFn]-      -- ^ The entire posting list is transformed by this-      -- function after it is filtered according to the tokens.-      -    , fields :: Fields.T Bool-      -- ^ Default fields to show in the report.-      -    , spacers :: Spacers.T Int-      -- ^ Default width for spacer fields. If any of these Ints are-      -- less than or equal to zero, there will be no spacer. There is-      -- never a spacer for fields that do not appear in the report.-      -    , showZeroBalances :: O.ShowZeroBalances-    }--newtype ReportWidth = ReportWidth { unReportWidth :: Int }-                      deriving (Eq, Show, Ord)--ymd :: Box -> X.Text-ymd p = X.pack (formatTime defaultTimeLocale fmt d) where-  d = Time.localDay-      . Bits.localTime-      . Q.dateTime-      . L.boxPostFam-      $ p-  fmt = "%Y-%m-%d"--qtyAsIs :: Box -> X.Text-qtyAsIs p = X.pack . show . Bits.unQty . Q.qty . L.boxPostFam $ p--balanceAsIs :: Bits.Commodity -> Bal.BottomLine -> X.Text-balanceAsIs _ n = case n of-  Bal.Zero -> X.pack "--"-  Bal.NonZero c -> X.pack . show . Bits.unQty . Bal.qty $ c--defaultWidth :: ReportWidth-defaultWidth = ReportWidth 80--columnsVarToWidth :: Maybe String -> ReportWidth-columnsVarToWidth ms = case ms of-  Nothing -> defaultWidth-  Just str -> case reads str of-    [] -> defaultWidth-    (i, []):[] -> if i > 0 then ReportWidth i else defaultWidth-    _ -> defaultWidth--defaultOptions ::-  DefaultTimeZone-  -> RadGroup-  -> S.Runtime-  -> T-defaultOptions dtz rg rt =-  T { drCrColors = Dark.drCrColors-    , baseColors = Dark.baseColors-    , dateFormat = ymd-    , qtyFormat = qtyAsIs-    , balanceFormat = balanceAsIs-    , payeeAllocation = A.allocation 40-    , accountAllocation = A.allocation 60-    , width = widthFromRuntime rt-    , subAccountLength = 2-    , colorPref = O.autoColors O.PrefAuto rt-    , timeZone = dtz-    , radGroup = rg-    , sensitive = M.Insensitive-    , factory = \s t -> (return (M.within s t))-    , tokens = []-    , postFilter = []-    , fields = defaultFields-    , spacers = defaultSpacerWidth-    , showZeroBalances = O.ShowZeroBalances False }--widthFromRuntime :: S.Runtime -> ReportWidth-widthFromRuntime rt = case S.screenWidth rt of-  Nothing -> defaultWidth-  Just w -> ReportWidth . S.unScreenWidth $ w--defaultFields :: Fields.T Bool-defaultFields =-  Fields.T { F.globalTransaction    = False-           , F.revGlobalTransaction = False-           , F.globalPosting        = False-           , F.revGlobalPosting     = False-           , F.fileTransaction      = False-           , F.revFileTransaction   = False-           , F.filePosting          = False-           , F.revFilePosting       = False-           , F.filtered             = False-           , F.revFiltered          = False-           , F.sorted               = False-           , F.revSorted            = False-           , F.visible              = False-           , F.revVisible           = False-           , F.lineNum              = False-           , F.date                 = True-           , F.flag                 = False-           , F.number               = False-           , F.payee                = True-           , F.account              = True-           , F.postingDrCr          = True-           , F.postingCmdty         = True-           , F.postingQty           = True-           , F.totalDrCr            = True-           , F.totalCmdty           = True-           , F.totalQty             = True-           , F.tags                 = False-           , F.memo                 = False-           , F.filename             = False }--defaultSpacerWidth :: Spacers.T Int-defaultSpacerWidth =-  Spacers.T { S.globalTransaction    = 1-            , S.revGlobalTransaction = 1-            , S.globalPosting        = 1-            , S.revGlobalPosting     = 1-            , S.fileTransaction      = 1-            , S.revFileTransaction   = 1-            , S.filePosting          = 1-            , S.revFilePosting       = 1-            , S.filtered             = 1-            , S.revFiltered          = 1-            , S.sorted               = 1-            , S.revSorted            = 1-            , S.visible              = 1-            , S.revVisible           = 1-            , S.lineNum              = 1-            , S.date                 = 1-            , S.flag                 = 1-            , S.number               = 1-            , S.payee                = 4-            , S.account              = 1-            , S.postingDrCr          = 1-            , S.postingCmdty         = 1-            , S.postingQty           = 1-            , S.totalDrCr            = 1-            , S.totalCmdty           = 1 }-

@@ -1,24 +1,28 @@-module Penny.Cabin.Posts.Parser (parseOptions) where+module Penny.Cabin.Posts.Parser (State(..), parseOptions,+                                 Error(..)) where -import Control.Applicative ((<|>), (<$>), pure, many, (<*>))+import Control.Applicative ((<|>), (<$>), pure, many, (<*>),+                            Applicative) import Control.Monad ((>=>)) import qualified Control.Monad.Exception.Synchronous as Ex import Data.Char (toLower)-import qualified Data.Foldable as F+import qualified Data.Foldable as Fdbl import qualified System.Console.MultiArg.Combinator as C import System.Console.MultiArg.Prim (Parser)  import qualified Penny.Cabin.Chunk as CC import qualified Penny.Cabin.Colors as PC-import qualified Penny.Cabin.Posts.Fields as Fl-import qualified Penny.Cabin.Posts.Options as Op+import qualified Penny.Cabin.Posts.Fields as F+import qualified Penny.Cabin.Posts.Types as Ty import qualified Penny.Cabin.Colors.DarkBackground as DB import qualified Penny.Cabin.Colors.LightBackground as LB import qualified Penny.Cabin.Options as CO+import qualified Penny.Copper as Cop import qualified Penny.Liberty as Ly import qualified Penny.Liberty.Expressions as Exp import qualified Penny.Lincoln as L import qualified Penny.Shield as S+import qualified Text.Matchers.Text as M  data Error = BadColorName String              | BadBackgroundArg String@@ -30,56 +34,85 @@              | BadComparator String              deriving Show +data State = State {+  sensitive :: M.CaseSensitive+  , factory :: L.Factory+  , tokens :: [Ly.Token (L.Box Ly.LibertyMeta -> Bool)]+  , postFilter :: [Ly.PostFilterFn]+  , fields :: F.Fields Bool+  , colorPref :: CC.Colors+  , drCrColors :: PC.DrCrColors+  , baseColors :: PC.BaseColors+  , width :: Ty.ReportWidth+  , showZeroBalances :: CO.ShowZeroBalances+  }+ -- | Parses the command line from the first word remaining up until, -- but not including, the first non-option argment. parseOptions ::-  Parser (S.Runtime -> Op.T -> Ex.Exceptional Error Op.T)+  Parser (S.Runtime+          -> Cop.DefaultTimeZone+          -> Cop.RadGroup+          -> State+          -> Ex.Exceptional Error State) parseOptions = f <$> many parseOption where   f ls =-    let g rt op =-          let ls' = map (\fn -> fn rt) ls-          in (foldl (>=>) return ls') op+    let g rt dtz rg st =+          let ls' = map (\fn -> fn rt dtz rg) ls+          in (foldl (>=>) return ls') st     in g   parseOption ::-  Parser (S.Runtime -> Op.T -> Ex.Exceptional Error Op.T)+  Parser (S.Runtime+          -> Cop.DefaultTimeZone+          -> Cop.RadGroup+          -> State+          -> Ex.Exceptional Error State) parseOption =   operand-  <|> mkTwoArg boxFilters-  <|> mkTwoArg postFilter-  <|> mkTwoArg matcherSelect-  <|> mkTwoArg caseSelect-  <|> mkTwoArg operator-  <|> color-  <|> mkTwoArg background-  <|> mkTwoArg width-  <|> mkTwoArg showField-  <|> mkTwoArg hideField-  <|> mkTwoArg showAllFields-  <|> mkTwoArg hideAllFields-  <|> mkTwoArg showZeroBalances-  <|> mkTwoArg hideZeroBalances+  <|> wrap boxFilters+  <|> wrap parsePostFilter+  <|> wrap (impurify matcherSelect)+  <|> wrap (impurify caseSelect)+  <|> wrap (impurify operator)+  <|> (do { f <- color; return (\rt _ _ st -> f rt st)})+  <|> wrap background+  <|> wrap parseWidth+  <|> wrap showField+  <|> wrap hideField+  <|> wrap (impurify showAllFields)+  <|> wrap (impurify hideAllFields)+  <|> wrap (impurify parseShowZeroBalances)+  <|> wrap (impurify hideZeroBalances)   where-    mkTwoArg p = do+    wrap p = do       f <- p-      return (\_ o -> f o)+      return (\_ _ _ st -> f st) -operand :: Parser (S.Runtime -> Op.T -> Ex.Exceptional Error Op.T)+impurify ::+  (Functor f, Applicative m)+  => f (a -> b)+  -> f (a -> m b)+impurify = fmap (\g -> pure . g)++operand :: Parser (S.Runtime+                   -> Cop.DefaultTimeZone+                   -> Cop.RadGroup+                   -> State+                   -> Ex.Exceptional Error State) operand = f <$> Ly.parseOperand   where-    f lyFn rt op =-      let dtz = Op.timeZone op-          rg = Op.radGroup op-          dt = S.currentTime rt-          cs = Op.sensitive op-          fty = Op.factory op+    f lyFn rt dtz rg st =+      let dt = S.currentTime rt+          cs = sensitive st+          fty = factory st       in case lyFn dt dtz rg cs fty of         Ex.Exception e -> Ex.throw . LibertyError $ e         Ex.Success (Exp.Operand g) ->           let g' = g . L.boxPostFam-              ts' = Op.tokens op ++ [Exp.TokOperand g']-          in return op { Op.tokens = ts' }+              ts' = tokens st ++ [Exp.TokOperand g']+          in return st { tokens = ts' }  -- | Processes a option for box-level serials. optBoxSerial ::@@ -92,35 +125,35 @@   -> (Ly.LibertyMeta -> Int)   -- ^ Pulls the serial from the PostMeta   -  -> Parser (Op.T -> Ex.Exceptional Error Op.T)+  -> Parser (State -> Ex.Exceptional Error State)  optBoxSerial ls ss f = parseOpt ls ss (C.TwoArg g)   where-    g a1 a2 op = do+    g a1 a2 st = do       cmp <- Ex.fromMaybe (BadComparator a1) (Ly.parseComparer a1)       i <- parseInt a2       let h box =             let ser = f . L.boxMeta $ box             in ser `cmp` i           tok = Exp.TokOperand h-      return op { Op.tokens = Op.tokens op ++ [tok] }+      return st { tokens = tokens st ++ [tok] } -optFilteredNum :: Parser (Op.T -> Ex.Exceptional Error Op.T)+optFilteredNum :: Parser (State -> Ex.Exceptional Error State) optFilteredNum = optBoxSerial ["filtered"] "" f   where     f = L.forward . Ly.unFilteredNum . Ly.filteredNum -optRevFilteredNum :: Parser (Op.T -> Ex.Exceptional Error Op.T)+optRevFilteredNum :: Parser (State -> Ex.Exceptional Error State) optRevFilteredNum = optBoxSerial ["revFiltered"] "" f   where     f = L.backward . Ly.unFilteredNum . Ly.filteredNum -optSortedNum :: Parser (Op.T -> Ex.Exceptional Error Op.T)+optSortedNum :: Parser (State -> Ex.Exceptional Error State) optSortedNum = optBoxSerial ["sorted"] "" f   where     f = L.forward . Ly.unSortedNum . Ly.sortedNum -optRevSortedNum :: Parser (Op.T -> Ex.Exceptional Error Op.T)+optRevSortedNum :: Parser (State -> Ex.Exceptional Error State) optRevSortedNum = optBoxSerial ["revSorted"] "" f   where     f = L.backward . Ly.unSortedNum . Ly.sortedNum@@ -130,7 +163,7 @@   (i, ""):[] -> return i   _ -> Ex.throw . BadNumber $ s -boxFilters :: Parser (Op.T -> Ex.Exceptional Error Op.T)+boxFilters :: Parser (State -> Ex.Exceptional Error State) boxFilters =   optFilteredNum   <|> optRevFilteredNum@@ -138,39 +171,39 @@   <|> optRevSortedNum  -postFilter :: Parser (Op.T -> Ex.Exceptional Error Op.T)-postFilter = f <$> Ly.parsePostFilter+parsePostFilter :: Parser (State -> Ex.Exceptional Error State)+parsePostFilter = f <$> Ly.parsePostFilter   where-    f ex op =+    f ex st =       case ex of         Ex.Exception e -> Ex.throw . LibertyError $ e         Ex.Success pf ->-          return op { Op.postFilter = Op.postFilter op ++ [pf] }+          return st { postFilter = postFilter st ++ [pf] } -matcherSelect :: Parser (Op.T -> Ex.Exceptional Error Op.T)+matcherSelect :: Parser (State -> State) matcherSelect = f <$> Ly.parseMatcherSelect   where-    f mf op = return op { Op.factory = mf }+    f mf st = st { factory = mf } -caseSelect :: Parser (Op.T -> Ex.Exceptional Error Op.T)+caseSelect :: Parser (State -> State) caseSelect = f <$> Ly.parseCaseSelect   where-    f cs op = return op { Op.sensitive = cs }+    f cs st = st { sensitive = cs } -operator :: Parser (Op.T -> Ex.Exceptional Error Op.T)+operator :: Parser (State -> State) operator = f <$> Ly.parseOperator   where-    f oo op = return op { Op.tokens = Op.tokens op ++ [oo] }+    f oo st = st { tokens = tokens st ++ [oo] }  parseOpt :: [String] -> [Char] -> C.ArgSpec a -> Parser a parseOpt ss cs a = C.parseOption [C.OptSpec ss cs a] -color :: Parser (S.Runtime -> Op.T -> Ex.Exceptional Error Op.T)+color :: Parser (S.Runtime -> State -> Ex.Exceptional Error State) color = parseOpt ["color"] "" (C.OneArg f)   where-    f a1 rt op = case pickColorArg rt a1 of+    f a1 rt st = case pickColorArg rt a1 of       Nothing -> Ex.throw . BadColorName $ a1-      Just c -> return (op { Op.colorPref = c })+      Just c -> return (st { colorPref = c })  pickColorArg :: S.Runtime -> String -> Maybe CC.Colors pickColorArg rt t@@ -187,84 +220,83 @@   | otherwise = Nothing  -background :: Parser (Op.T -> Ex.Exceptional Error Op.T)+background :: Parser (State -> Ex.Exceptional Error State) background = parseOpt ["background"] "" (C.OneArg f)   where-    f a1 op = case pickBackgroundArg a1 of+    f a1 st = case pickBackgroundArg a1 of       Nothing -> Ex.throw . BadBackgroundArg $ a1-      Just (dc, bc) -> return (op { Op.drCrColors = dc-                                  , Op.baseColors = bc } )+      Just (dc, bc) -> return (st { drCrColors = dc+                                  , baseColors = bc } )  -width :: Parser (Op.T -> Ex.Exceptional Error Op.T)-width = parseOpt ["width"] "" (C.OneArg f)+parseWidth :: Parser (State -> Ex.Exceptional Error State)+parseWidth = parseOpt ["width"] "" (C.OneArg f)   where-    f a1 op = case reads a1 of-      (i, ""):[] -> return (op { Op.width = Op.ReportWidth i })+    f a1 st = case reads a1 of+      (i, ""):[] -> return (st { width = Ty.ReportWidth i })       _ -> Ex.throw . BadWidthArg $ a1 -showField :: Parser (Op.T -> Ex.Exceptional Error Op.T)+showField :: Parser (State -> Ex.Exceptional Error State) showField = parseOpt ["show"] "" (C.OneArg f)   where-    f a1 op = do+    f a1 st = do       fl <- parseField a1-      let newFl = fieldOn (Op.fields op) fl-      return op { Op.fields = newFl }+      let newFl = fieldOn (fields st) fl+      return st { fields = newFl } -hideField :: Parser (Op.T -> Ex.Exceptional Error Op.T)+hideField :: Parser (State -> Ex.Exceptional Error State) hideField = parseOpt ["hide"] "" (C.OneArg f)   where-    f a1 op = do+    f a1 st = do       fl <- parseField a1-      let newFl = fieldOff (Op.fields op) fl-      return op { Op.fields = newFl }+      let newFl = fieldOff (fields st) fl+      return st { fields = newFl } -showAllFields :: Parser (Op.T -> Ex.Exceptional a Op.T)+showAllFields :: Parser (State -> State) showAllFields = parseOpt ["show-all"] "" (C.NoArg f)   where-    f op = return (op {Op.fields = pure True})+    f st = st {fields = pure True} -hideAllFields :: Parser (Op.T -> Ex.Exceptional a Op.T)+hideAllFields :: Parser (State -> State) hideAllFields = parseOpt ["hide-all"] "" (C.NoArg f)   where-    f op = return (op {Op.fields = pure False})+    f st = st {fields = pure False} -showZeroBalances :: Parser (Op.T -> Ex.Exceptional a Op.T)-showZeroBalances = parseOpt ["show-zero-balances"] "" (C.NoArg f)+parseShowZeroBalances :: Parser (State -> State)+parseShowZeroBalances = parseOpt opt "" (C.NoArg f)   where-    f op =-      return (op {Op.showZeroBalances = CO.ShowZeroBalances True })+    opt = ["show-zero-balances"]+    f st = st {showZeroBalances = CO.ShowZeroBalances True } -hideZeroBalances :: Parser (Op.T -> Ex.Exceptional a Op.T)+hideZeroBalances :: Parser (State -> State) hideZeroBalances = parseOpt ["hide-zero-balances"] "" (C.NoArg f)   where-    f op =-      return (op {Op.showZeroBalances = CO.ShowZeroBalances False })+    f st = st {showZeroBalances = CO.ShowZeroBalances False }  -- | Turns a field on if it is True. fieldOn ::-  Fl.T Bool+  F.Fields Bool   -- ^ Fields as seen so far -  -> Fl.T Bool+  -> F.Fields Bool   -- ^ Record that should have one True element indicating a field   -- name seen on the command line; other elements should be False   -  -> Fl.T Bool+  -> F.Fields Bool   -- ^ Fields as seen so far, with new field added  fieldOn old new = (||) <$> old <*> new  -- | Turns off a field if it is True. fieldOff ::-  Fl.T Bool+  F.Fields Bool   -- ^ Fields seen so far   -  -> Fl.T Bool+  -> F.Fields Bool   -- ^ Record that should have one True element indicating a field   -- name seen on the command line; other elements should be False   -  -> Fl.T Bool+  -> F.Fields Bool   -- ^ Fields as seen so far, with new field added  fieldOff old new = f <$> old <*> new@@ -272,7 +304,7 @@     f o False = o     f _ True = False -parseField :: String -> Ex.Exceptional Error (Fl.T Bool)+parseField :: String -> Ex.Exceptional Error (F.Fields Bool) parseField str =   let lower = map toLower str       checkField s =@@ -283,44 +315,44 @@   in checkFields flds  -- | Checks the fields with the True value to ensure there is only one.-checkFields :: Fl.T (String, Bool) -> Ex.Exceptional Error (Fl.T Bool)+checkFields :: F.Fields (String, Bool) -> Ex.Exceptional Error (F.Fields Bool) checkFields fs =   let f (s, b) ls = if b then s:ls else ls-  in case F.foldr f [] fs of+  in case Fdbl.foldr f [] fs of     [] -> Ex.throw NoMatchingFieldName     _:[] -> return (snd <$> fs)     ls -> Ex.throw . MultipleMatchingFieldNames $ ls   -fieldNames :: Fl.T String-fieldNames = Fl.T {-  Fl.globalTransaction = "globalTransaction"-  , Fl.revGlobalTransaction = "revGlobalTransaction"-  , Fl.globalPosting = "globalPosting"-  , Fl.revGlobalPosting = "revGlobalPosting"-  , Fl.fileTransaction = "fileTransaction"-  , Fl.revFileTransaction = "revFileTransaction"-  , Fl.filePosting = "filePosting"-  , Fl.revFilePosting = "revFilePosting"-  , Fl.filtered = "filtered"-  , Fl.revFiltered = "revFiltered"-  , Fl.sorted = "sorted"-  , Fl.revSorted = "revSorted"-  , Fl.visible = "visible"-  , Fl.revVisible = "revVisible"-  , Fl.lineNum = "lineNum"-  , Fl.date = "date"-  , Fl.flag = "flag"-  , Fl.number = "number"-  , Fl.payee = "payee"-  , Fl.account = "account"-  , Fl.postingDrCr = "postingDrCr"-  , Fl.postingCmdty = "postingCmdty"-  , Fl.postingQty = "postingQty"-  , Fl.totalDrCr = "totalDrCr"-  , Fl.totalCmdty = "totalCmdty"-  , Fl.totalQty = "totalQty"-  , Fl.tags = "tags"-  , Fl.memo = "memo"-  , Fl.filename = "filename" }+fieldNames :: F.Fields String+fieldNames = F.Fields {+  F.globalTransaction = "globalTransaction"+  , F.revGlobalTransaction = "revGlobalTransaction"+  , F.globalPosting = "globalPosting"+  , F.revGlobalPosting = "revGlobalPosting"+  , F.fileTransaction = "fileTransaction"+  , F.revFileTransaction = "revFileTransaction"+  , F.filePosting = "filePosting"+  , F.revFilePosting = "revFilePosting"+  , F.filtered = "filtered"+  , F.revFiltered = "revFiltered"+  , F.sorted = "sorted"+  , F.revSorted = "revSorted"+  , F.visible = "visible"+  , F.revVisible = "revVisible"+  , F.lineNum = "lineNum"+  , F.date = "date"+  , F.flag = "flag"+  , F.number = "number"+  , F.payee = "payee"+  , F.account = "account"+  , F.postingDrCr = "postingDrCr"+  , F.postingCmdty = "postingCmdty"+  , F.postingQty = "postingQty"+  , F.totalDrCr = "totalDrCr"+  , F.totalCmdty = "totalCmdty"+  , F.totalQty = "totalQty"+  , F.tags = "tags"+  , F.memo = "memo"+  , F.filename = "filename" }

@@ -3,7 +3,7 @@ -- field. module Penny.Cabin.Posts.Spacers where -data T a = T {+data Spacers a = Spacers {   globalTransaction :: a   , revGlobalTransaction :: a   , globalPosting :: a@@ -31,78 +31,3 @@   , totalDrCr :: a   , totalCmdty :: a }   deriving (Show, Eq)--t_globalTransaction :: a -> T a -> T a-t_globalTransaction a f = f { globalTransaction = a }--t_revGlobalTransaction :: a -> T a -> T a-t_revGlobalTransaction a f = f { revGlobalTransaction = a }--t_globalPosting :: a -> T a -> T a-t_globalPosting a f = f { globalPosting = a }--t_revGlobalPosting :: a -> T a -> T a-t_revGlobalPosting a f = f { revGlobalPosting = a }--t_fileTransaction :: a -> T a -> T a-t_fileTransaction a f = f { fileTransaction = a }--t_revFileTransaction :: a -> T a -> T a-t_revFileTransaction a f = f { revFileTransaction = a }--t_filePosting :: a -> T a -> T a-t_filePosting a f = f { filePosting = a }--t_revFilePosting :: a -> T a -> T a-t_revFilePosting a f = f { revFilePosting = a }--t_filtered :: a -> T a -> T a-t_filtered a f = f { filtered = a }--t_revFiltered :: a -> T a -> T a-t_revFiltered a f = f { revFiltered = a }--t_sorted :: a -> T a -> T a-t_sorted a f = f { sorted = a }--t_revSorted :: a -> T a -> T a-t_revSorted a f = f { revSorted = a }--t_visible :: a -> T a -> T a-t_visible a f = f { visible = a }--t_revVisible :: a -> T a -> T a-t_revVisible a f = f { revVisible = a }--t_lineNum :: a -> T a -> T a-t_lineNum a f = f { lineNum = a }--t_date :: a -> T a -> T a-t_date a f = f { date = a }--t_flag :: a -> T a -> T a-t_flag a f = f { flag = a }--t_number :: a -> T a -> T a-t_number a f = f { number = a }--t_payee :: a -> T a -> T a-t_payee a f = f { payee = a }--t_account :: a -> T a -> T a-t_account a f = f { account = a }--t_postingDrCr :: a -> T a -> T a-t_postingDrCr a f = f { postingDrCr = a }--t_postingCmdty :: a -> T a -> T a-t_postingCmdty a f = f { postingCmdty = a }--t_postingQty :: a -> T a -> T a-t_postingQty a f = f { postingQty = a }--t_totalDrCr :: a -> T a -> T a-t_totalDrCr a f = f { totalDrCr = a }--t_totalCmdty :: a -> T a -> T a-t_totalCmdty a f = f { totalCmdty = a }

@@ -0,0 +1,4 @@+module Penny.Cabin.Posts.Types where++newtype ReportWidth = ReportWidth { unReportWidth :: Int }+                      deriving (Eq, Show, Ord)

@@ -195,6 +195,10 @@   , S.backward   , S.serials   , S.serialItems+    +    -- * Matchers+  , Matchers.Matcher+  , Matchers.Factory    ) where @@ -203,6 +207,7 @@ import qualified Penny.Lincoln.Builders as Bd import qualified Penny.Lincoln.Family as F import qualified Penny.Lincoln.HasText as HT+import qualified Penny.Lincoln.Matchers as Matchers import qualified Penny.Lincoln.Meta as M import qualified Penny.Lincoln.PriceDb as DB import qualified Penny.Lincoln.Serial as S

@@ -0,0 +1,23 @@+-- | Type synonyms for functions dealing with text matching.++module Penny.Lincoln.Matchers where++import qualified Data.Text as X+import qualified Control.Monad.Exception.Synchronous as Ex+import qualified Text.Matchers.Text as MT++type Matcher = X.Text -> Bool++-- | A function that makes Matchers.+type Factory =+  MT.CaseSensitive+  -- ^ Will this matcher be case sensitive?+  +  -> X.Text+  -- ^ The pattern to use when testing for a match. For example, this+  -- might be a regular expression, or simply the text to be matched.++  -> Ex.Exceptional X.Text Matcher+  -- ^ Sometimes producing a matcher might fail; for example, the user+  -- might have supplied a bad pattern. If so, an exception is+  -- returned. On success, a Matcher is returned.

@@ -1,5 +1,5 @@ Name: penny-lib-Version: 0.2.0.0+Version: 0.4.0.0 Cabal-version: >=1.8 Build-Type: Simple License: MIT@@ -191,7 +191,6 @@         Penny.Cabin.Balance,         Penny.Cabin.Balance.Parser,         Penny.Cabin.Balance.Help,-        Penny.Cabin.Balance.Options,         Penny.Cabin.Balance.Tree,         Penny.Cabin.Chunk,         Penny.Cabin.Chunk.Switch,@@ -210,9 +209,9 @@         Penny.Cabin.Posts.Chunk,         Penny.Cabin.Posts.Help,         Penny.Cabin.Posts.Meta,-        Penny.Cabin.Posts.Options,         Penny.Cabin.Posts.Parser,         Penny.Cabin.Posts.Spacers,+        Penny.Cabin.Posts.Types,         Penny.Cabin.Row,         Penny.Cabin.TextFormat,         Penny.Copper,@@ -262,6 +261,7 @@         Penny.Lincoln.Family.Family,         Penny.Lincoln.Family.Siblings,         Penny.Lincoln.HasText,+        Penny.Lincoln.Matchers,         Penny.Lincoln.Meta,         Penny.Lincoln.NestedMap,         Penny.Lincoln.Predicates,