penny-lib 0.12.0.0 → 0.14.0.0

raw patch · 144 files changed

+13828/−13809 lines, 144 filesdep +QuickCheckdep +action-permutationsdep +binarydep ~multiargnew-component:exe:penny-gibberishnew-component:exe:penny-testPVP ok

version bump matches the API change (PVP)

Dependencies added: QuickCheck, action-permutations, binary, ofx, random, random-shuffle

Dependency ranges changed: multiarg

API changes (from Hackage documentation)

Files

• Penny.hs +0/−457
• Penny/Brenner.hs +0/−259
• Penny/Brenner/Amex.hs +0/−121
• Penny/Brenner/BofA.hs +0/−226
• Penny/Brenner/Clear.hs +0/−175
• Penny/Brenner/Database.hs +0/−49
• Penny/Brenner/Import.hs +0/−106
• Penny/Brenner/Merge.hs +0/−347
• Penny/Brenner/Print.hs +0/−65
• Penny/Brenner/Types.hs +0/−298
• Penny/Brenner/Util.hs +0/−87
• Penny/Cabin.hs +0/−7
• Penny/Cabin/Balance.hs +0/−21
• Penny/Cabin/Balance/Convert.hs +0/−334
• Penny/Cabin/Balance/Convert/Chunker.hs +0/−239
• Penny/Cabin/Balance/Convert/Options.hs +0/−43
• Penny/Cabin/Balance/Convert/Parser.hs +0/−87
• Penny/Cabin/Balance/MultiCommodity.hs +0/−177
• Penny/Cabin/Balance/MultiCommodity/Chunker.hs +0/−222
• Penny/Cabin/Balance/MultiCommodity/Parser.hs +0/−29
• Penny/Cabin/Balance/Util.hs +0/−228
• Penny/Cabin/Interface.hs +0/−77
• Penny/Cabin/Meta.hs +0/−38
• Penny/Cabin/Options.hs +0/−16
• Penny/Cabin/Parsers.hs +0/−24
• Penny/Cabin/Posts.hs +0/−622
• Penny/Cabin/Posts/Allocated.hs +0/−402
• Penny/Cabin/Posts/BottomRows.hs +0/−649
• Penny/Cabin/Posts/Chunk.hs +0/−152
• Penny/Cabin/Posts/Fields.hs +0/−199
• Penny/Cabin/Posts/Growers.hs +0/−596
• Penny/Cabin/Posts/Meta.hs +0/−79
• Penny/Cabin/Posts/Parser.hs +0/−285
• Penny/Cabin/Posts/Spacers.hs +0/−32
• Penny/Cabin/Posts/Types.hs +0/−4
• Penny/Cabin/Row.hs +0/−138
• Penny/Cabin/Scheme.hs +0/−140
• Penny/Cabin/Scheme/Schemes.hs +0/−87
• Penny/Cabin/TextFormat.hs +0/−173
• Penny/Copper.hs +0/−211
• Penny/Copper/Parsec.hs +0/−418
• Penny/Copper/Render.hs +0/−523
• Penny/Copper/Terminals.hs +0/−145
• Penny/Copper/Types.hs +0/−59
• Penny/Liberty.hs +0/−788
• Penny/Lincoln.hs +0/−272
• Penny/Lincoln/Balance.hs +0/−109
• Penny/Lincoln/Bits.hs +0/−97
• Penny/Lincoln/Bits/DateTime.hs +0/−152
• Penny/Lincoln/Bits/Open.hs +0/−124
• Penny/Lincoln/Bits/Price.hs +0/−42
• Penny/Lincoln/Bits/Qty.hs +0/−300
• Penny/Lincoln/Builders.hs +0/−28
• Penny/Lincoln/Family.hs +0/−104
• Penny/Lincoln/Family/Child.hs +0/−9
• Penny/Lincoln/Family/Family.hs +0/−76
• Penny/Lincoln/Family/Siblings.hs +0/−54
• Penny/Lincoln/HasText.hs +0/−44
• Penny/Lincoln/Matchers.hs +0/−21
• Penny/Lincoln/Predicates.hs +0/−254
• Penny/Lincoln/Predicates/Siblings.hs +0/−210
• Penny/Lincoln/PriceDb.hs +0/−98
• Penny/Lincoln/Queries.hs +0/−100
• Penny/Lincoln/Queries/Siblings.hs +0/−87
• Penny/Lincoln/Serial.hs +0/−58
• Penny/Lincoln/Transaction.hs +0/−499
• Penny/Lincoln/Transaction/Unverified.hs +0/−131
• Penny/Shield.hs +0/−105
• Penny/Steel.hs +0/−3
• Penny/Steel/NestedMap.hs +0/−275
• Penny/Wheat.hs +0/−365
• Penny/Zinc.hs +0/−747
• lib/Penny.hs +455/−0
• lib/Penny/Brenner.hs +263/−0
• lib/Penny/Brenner/Clear.hs +185/−0
• lib/Penny/Brenner/Database.hs +41/−0
• lib/Penny/Brenner/Import.hs +140/−0
• lib/Penny/Brenner/Info.hs +139/−0
• lib/Penny/Brenner/Merge.hs +360/−0
• lib/Penny/Brenner/OFX.hs +68/−0
• lib/Penny/Brenner/Print.hs +59/−0
• lib/Penny/Brenner/Types.hs +340/−0
• lib/Penny/Brenner/Util.hs +106/−0
• lib/Penny/Cabin.hs +7/−0
• lib/Penny/Cabin/Balance.hs +21/−0
• lib/Penny/Cabin/Balance/Convert.hs +334/−0
• lib/Penny/Cabin/Balance/Convert/Chunker.hs +239/−0
• lib/Penny/Cabin/Balance/Convert/Options.hs +43/−0
• lib/Penny/Cabin/Balance/Convert/Parser.hs +87/−0
• lib/Penny/Cabin/Balance/MultiCommodity.hs +177/−0
• lib/Penny/Cabin/Balance/MultiCommodity/Chunker.hs +222/−0
• lib/Penny/Cabin/Balance/MultiCommodity/Parser.hs +29/−0
• lib/Penny/Cabin/Balance/Util.hs +230/−0
• lib/Penny/Cabin/Interface.hs +77/−0
• lib/Penny/Cabin/Meta.hs +13/−0
• lib/Penny/Cabin/Options.hs +16/−0
• lib/Penny/Cabin/Parsers.hs +24/−0
• lib/Penny/Cabin/Posts.hs +621/−0
• lib/Penny/Cabin/Posts/Allocated.hs +401/−0
• lib/Penny/Cabin/Posts/BottomRows.hs +648/−0
• lib/Penny/Cabin/Posts/Chunk.hs +152/−0
• lib/Penny/Cabin/Posts/Fields.hs +199/−0
• lib/Penny/Cabin/Posts/Growers.hs +595/−0
• lib/Penny/Cabin/Posts/Meta.hs +82/−0
• lib/Penny/Cabin/Posts/Parser.hs +286/−0
• lib/Penny/Cabin/Posts/Spacers.hs +32/−0
• lib/Penny/Cabin/Posts/Types.hs +4/−0
• lib/Penny/Cabin/Row.hs +138/−0
• lib/Penny/Cabin/Scheme.hs +140/−0
• lib/Penny/Cabin/Scheme/Schemes.hs +87/−0
• lib/Penny/Cabin/TextFormat.hs +173/−0
• lib/Penny/Copper.hs +163/−0
• lib/Penny/Copper/Interface.hs +62/−0
• lib/Penny/Copper/Parsec.hs +415/−0
• lib/Penny/Copper/Render.hs +530/−0
• lib/Penny/Copper/Terminals.hs +145/−0
• lib/Penny/Liberty.hs +777/−0
• lib/Penny/Lincoln.hs +72/−0
• lib/Penny/Lincoln/Balance.hs +109/−0
• lib/Penny/Lincoln/Bits.hs +180/−0
• lib/Penny/Lincoln/Bits/DateTime.hs +177/−0
• lib/Penny/Lincoln/Bits/Open.hs +214/−0
• lib/Penny/Lincoln/Bits/Price.hs +63/−0
• lib/Penny/Lincoln/Bits/Qty.hs +360/−0
• lib/Penny/Lincoln/Builders.hs +28/−0
• lib/Penny/Lincoln/Ents.hs +278/−0
• lib/Penny/Lincoln/Equivalent.hs +21/−0
• lib/Penny/Lincoln/HasText.hs +58/−0
• lib/Penny/Lincoln/Matchers.hs +21/−0
• lib/Penny/Lincoln/Predicates.hs +323/−0
• lib/Penny/Lincoln/Predicates/Siblings.hs +328/−0
• lib/Penny/Lincoln/PriceDb.hs +98/−0
• lib/Penny/Lincoln/Queries.hs +104/−0
• lib/Penny/Lincoln/Queries/Siblings.hs +102/−0
• lib/Penny/Lincoln/Serial.hs +126/−0
• lib/Penny/Shield.hs +106/−0
• lib/Penny/Steel.hs +3/−0
• lib/Penny/Steel/NestedMap.hs +275/−0
• lib/Penny/Steel/Sums.hs +78/−0
• lib/Penny/Wheat.hs +367/−0
• lib/Penny/Zinc.hs +746/−0
• penny-lib.cabal +118/−11
• tests/penny-gibberish.hs +98/−0
• tests/penny-test.hs +50/−0

@@ -1,457 +0,0 @@--- | Penny - extensible double-entry accounting system--module Penny-  ( -- * Building a custom Penny binary--    -- | Everything you need to create a custom Penny program is-    -- available by importing only this module.-    Version(..)-  , Defaults(..)-  , Z.Matcher(..)--  -- ** Color schemes-  , E.Scheme(..)-  , E.Changers-  , E.Labels(..)-  , E.EvenAndOdd(..)-  , module System.Console.Rainbow--  -- ** Sorting-  , Z.SortField(..)-  , CabP.SortOrder(..)--  -- ** Expression type-  , Exp.ExprDesc(..)--  -- ** Formatting quantities-  , defaultQtyFormat--  -- ** Convert report options-  , Target(..)-  , CP.SortBy(..)--  -- ** Postings report options-  , M.Box-  , Fields(..)-  , Spacers(..)-  , widthFromRuntime-  , Ps.yearMonthDay-  , Ps.qtyAsIs-  , Ps.balanceAsIs--  -- ** Runtime-  , S.Runtime-  , S.environment--  -- ** Text-  , X.Text-  , X.pack--  -- ** Main function-  , runPenny--    -- * Developer overview--    -- | Penny is organized into a tree of modules, each with a-    -- name. Check out the links for details on each component of-    -- Penny.-    ---    -- "Penny.Brenner" - Penny financial institution transaction-    -- handling. Depends on Lincoln and Copper.-    ---    -- "Penny.Cabin" - Penny reports. Depends on Lincoln and Liberty.-    ---    -- "Penny.Copper" - the Penny parser. Depends on Lincoln.-    ---    -- "Penny.Liberty" - Penny command line parser helpers. Depends on-    -- Lincoln and Copper.-    ---    -- "Penny.Lincoln" - the Penny core. Depends on no other Penny-    -- components.-    ---    -- "Penny.Shield" - the Penny runtime environment. Depends on-    -- Lincoln.-    ---    -- "Penny.Steel" - independent utilities. Depends on no other-    -- Penny components.-    ---    -- "Penny.Wheat" - tools to use with-    -- "Penny.Steel.Prednote". Depends on Steel, Lincoln, and Copper.-    ---    -- "Penny.Zinc" - the Penny command-line interface. Depends on-    -- Cabin, Copper, Liberty, and Lincoln.-    ---    -- The dependencies are represented as a dot file in-    -- bin/doc/dependencies.dot in the Penny git repository.-  ) where--import qualified Data.Text as X-import Data.Version (Version(..))-import qualified Penny.Cabin.Balance.Convert as Conv-import qualified Penny.Cabin.Balance.Convert.Parser as CP-import qualified Penny.Cabin.Balance.Convert.Options as ConvOpts-import qualified Penny.Cabin.Balance.MultiCommodity as MC-import qualified Penny.Cabin.Balance.MultiCommodity.Parser as MP-import System.Console.Rainbow-import qualified Penny.Cabin.Interface as I-import qualified Penny.Cabin.Options as CO-import qualified Penny.Cabin.Parsers as CabP-import qualified Penny.Cabin.Posts as Ps-import qualified Penny.Cabin.Posts.Fields as PF-import qualified Penny.Cabin.Posts.Spacers as PS-import qualified Penny.Cabin.Posts.Meta as M-import qualified Penny.Cabin.Scheme as E-import qualified Penny.Lincoln as L-import qualified Data.Prednote.Expressions as Exp-import qualified Penny.Zinc as Z-import qualified Penny.Shield as S-import qualified Text.Matchers as Mr---- | This type contains settings for all the reports, as well as--- default settings for the global options. Some of these can be--- overridden on the command line.-data Defaults = Defaults-  { caseSensitive :: Bool-    -- ^ Whether the matcher is case sensitive by default--  , matcher :: Z.Matcher-    -- ^ Which matcher to use--  , colorToFile :: Bool-    -- ^ Use colors when standard output is not a terminal?--  , expressionType :: Exp.ExprDesc-    -- ^ Use RPN or infix expressions? This affects both the posting-    -- filter and the filter for the Postings report.--  , defaultScheme :: Maybe E.Scheme-    -- ^ Default color scheme. If Nothing, there is no default color-    -- scheme. If there is no default color scheme and the user does-    -- not pick one on the command line, no colors will be used.--  , additionalSchemes :: [E.Scheme]-    -- ^ Additional color schemes the user can pick from on the-    -- command line.--  , sorter :: [(Z.SortField, CabP.SortOrder)]-    -- ^ Postings are sorted in this order by default. For example, if-    -- the first pair is (Date, Ascending), then postings are first-    -- sorted by date in ascending order. If the second pair is-    -- (Payee, Ascending), then postings with the same date are then-    -- sorted by payee.-    ---    -- If this list is empty, then by default postings are left in the-    -- same order as they appear in the ledger files.--  , balanceFormat :: L.Commodity -> L.Qty -> X.Text-    -- ^ How to format balances in the balance report. Change this-    -- function if, for example, you want to allow for digit grouping.--  , balanceShowZeroBalances :: Bool-    -- ^ Show zero balances in the balance report? If True, show them;-    -- if False, hide them.--  , balanceOrder :: CabP.SortOrder-    -- ^ Whether to sort the accounts in ascending or descending order-    -- by account name in the balance report.--  , convertShowZeroBalances :: Bool-    -- ^ Show zero balances in the convert report? If True, show them;-    -- if False, hide them.--  , convertTarget :: Target-    -- ^ The commodity to which to convert the commodities in the-    -- convert report.--  , convertOrder :: CabP.SortOrder-    -- ^ Sort the convert report in ascending or descending order.--  , convertSortBy :: CP.SortBy-    -- ^ Sort by account or by quantity in the convert report.--  , convertFormat :: L.Commodity -> L.Qty -> X.Text-    -- ^ How to format balances in the convert report. For instance,-    -- this function might perform digit grouping.--  , postingsFields :: Fields Bool-    -- ^ Fields to show by default in the postings report.--  , postingsWidth :: Int-    -- ^ The postings report is roughly this wide by-    -- default. Typically this will be as wide as your terminal.--  , postingsShowZeroBalances :: Bool-    -- ^ Show zero balances in the postings report? If True, show-    -- them; if False, hide them.--  , postingsDateFormat :: M.Box -> X.Text-    -- ^ How to format dates in the postings report.--  , postingsQtyFormat :: M.Box -> X.Text-    -- ^ How to format quantities in the balance report. This function-    -- is used when showing the quantity for the posting itself, and-    -- not the quantity for the totals columns (for that, see-    -- postingsBalanceFormat.) For example this function might perform-    -- digit grouping.--  , postingsBalanceFormat :: L.Commodity -> L.Qty -> X.Text-    -- ^ How to format balance totals in the postings report.--  , postingsSubAccountLength :: Int-    -- ^ Account names in the postings report are shortened if-    -- necessary in order to help the report fit within the allotted-    -- width (see postingsWidth). Account names are only shortened as-    -- much as is necessary for them to fit; however, each sub-account-    -- name will not be shortened any more than the amount given here.--  , postingsPayeeAllocation :: Int-    -- ^ postingsPayeeAllocation and postingsAccountAllocation-    -- determine how much space is allotted to the payee and account-    -- fields in the postings report. These fields are variable-    -- width. After space for most other fields is allotted, space is-    -- allotted for these two fields. The two fields divide the space-    -- proportionally depending on postingsPayeeAllocation and-    -- postingsAccountAllocation. For example, if-    -- postingsPayeeAllocation is 60 and postingsAccountAllocation is-    -- 40, then the payee field gets 60 percent of the leftover space-    -- and the account field gets 40 percent of the leftover space.-    ---    -- Both postingsPayeeAllocation and postingsAccountAllocation-    -- must be positive integers; if either one is less than 1, your-    -- program will crash at runtime.--  , postingsAccountAllocation :: Int-    -- ^ See postingsPayeeAllocation above for an explanation--  , postingsSpacers :: Spacers Int-    -- ^ Determines the number of spaces that appears to the right of-    -- each named field; for example, sPayee indicates how many spaces-    -- will appear to the right of the payee field. Each field of the-    -- Spacers should be a non-negative integer (although currently-    -- the absolute value of the field is taken.)-  }---- | Creates an IO action that you can use for the main function.-runPenny-  :: Version-  -- ^ Version of the executable-  -> (S.Runtime -> Defaults)-     -- ^ runPenny will apply this function to the Runtime. This way-     -- the defaults you use can vary depending on environment-     -- variables, the terminal type, the date, etc.-  -> IO ()-runPenny ver getDefaults = do-  rt <- S.runtime-  let df = getDefaults rt-      rs = allReports df-  Z.runZinc ver (toZincDefaults df) rt rs---- | The commodity to which to convert the commodities in the convert--- report.-data Target-  = AutoTarget-    -- ^ Selects a target commodity automatically, based on which-    -- commodity is the most common target commodity in the prices in-    -- your ledger files. If there is a tie for most common target-    -- commodity, the target that appears later in your ledger files-    -- is used.-  | ManualTarget String-    -- ^ Always uses the commodity named by the string given.-  deriving Show---- | Gets the current screen width from the runtime. If the COLUMNS--- environment variable is not set, uses 80.-widthFromRuntime :: S.Runtime -> Int-widthFromRuntime rt = case S.screenWidth rt of-  Nothing -> 80-  Just sw -> S.unScreenWidth sw--convTarget :: Target -> CP.Target-convTarget t = case t of-  AutoTarget -> CP.AutoTarget-  ManualTarget s -> CP.ManualTarget . L.To . L.Commodity . X.pack $ s--allReports-  :: Defaults-  -> [I.Report]-allReports df =-  let bd = toBalanceDefaults df-      cd = toConvertDefaults df-      pd = toPostingsDefaults df-  in [ Ps.zincReport pd-     , MC.parseReport (balanceFormat df) bd-     , Conv.cmdLineReport cd-     ]--toZincDefaults :: Defaults -> Z.Defaults-toZincDefaults d = Z.Defaults-  { Z.sensitive =-      if caseSensitive d then Mr.Sensitive else Mr.Insensitive-  , Z.matcher = matcher d-  , Z.colorToFile = Z.ColorToFile . colorToFile $ d-  , Z.defaultScheme = defaultScheme d-  , Z.moreSchemes = additionalSchemes d-  , Z.sorter = sorter d-  , Z.exprDesc = expressionType d-  }--toBalanceDefaults :: Defaults -> MP.ParseOpts-toBalanceDefaults d = MP.ParseOpts-  { MP.showZeroBalances =-      CO.ShowZeroBalances . balanceShowZeroBalances $ d-  , MP.order = balanceOrder d-  }--toConvertDefaults :: Defaults -> ConvOpts.DefaultOpts-toConvertDefaults d = ConvOpts.DefaultOpts-  { ConvOpts.showZeroBalances =-      CO.ShowZeroBalances . convertShowZeroBalances $ d-  , ConvOpts.target = convTarget . convertTarget $ d-  , ConvOpts.sortOrder = convertOrder d-  , ConvOpts.sortBy = convertSortBy d-  , ConvOpts.format = convertFormat d-  }--toPostingsDefaults :: Defaults -> Ps.ZincOpts-toPostingsDefaults d = Ps.ZincOpts-  { Ps.fields = convFields . postingsFields $ d-  , Ps.width = Ps.ReportWidth . postingsWidth $ d-  , Ps.showZeroBalances =-      CO.ShowZeroBalances . postingsShowZeroBalances $ d-  , Ps.dateFormat = postingsDateFormat d-  , Ps.qtyFormat = postingsQtyFormat d-  , Ps.balanceFormat = postingsBalanceFormat d-  , Ps.subAccountLength =-      Ps.SubAccountLength . postingsSubAccountLength $ d-  , Ps.payeeAllocation =-      Ps.alloc . postingsPayeeAllocation $ d-  , Ps.accountAllocation =-      Ps.alloc . postingsAccountAllocation $ d-  , Ps.spacers = convSpacers . postingsSpacers $ d-  }--defaultQtyFormat :: L.Qty -> X.Text-defaultQtyFormat = X.pack . show--data Spacers a = Spacers-  { sGlobalTransaction :: a-  , sRevGlobalTransaction :: a-  , sGlobalPosting :: a-  , sRevGlobalPosting :: a-  , sFileTransaction :: a-  , sRevFileTransaction :: a-  , sFilePosting :: a-  , sRevFilePosting :: a-  , sFiltered :: a-  , sRevFiltered :: a-  , sSorted :: a-  , sRevSorted :: a-  , sVisible :: a-  , sRevVisible :: a-  , sLineNum :: a-  , sDate :: a-  , sFlag :: a-  , sNumber :: a-  , sPayee :: a-  , sAccount :: a-  , sPostingDrCr :: a-  , sPostingCmdty :: a-  , sPostingQty :: a-  , sTotalDrCr :: a-  , sTotalCmdty :: a-  } deriving (Show, Eq)--data Fields a = Fields-  { fGlobalTransaction :: a-  , fRevGlobalTransaction :: a-  , fGlobalPosting :: a-  , fRevGlobalPosting :: a-  , fFileTransaction :: a-  , fRevFileTransaction :: a-  , fFilePosting :: a-  , fRevFilePosting :: a-  , fFiltered :: a-  , fRevFiltered :: a-  , fSorted :: a-  , fRevSorted :: a-  , fVisible :: a-  , fRevVisible :: a-  , fLineNum :: a-  , fDate :: a-  , fFlag :: a-  , fNumber :: a-  , fPayee :: a-  , fAccount :: a-  , fPostingDrCr :: a-  , fPostingCmdty :: a-  , fPostingQty :: a-  , fTotalDrCr :: a-  , fTotalCmdty :: a-  , fTotalQty :: a-  , fTags :: a-  , fMemo :: a-  , fFilename :: a-  } deriving (Show, Eq)--convSpacers :: Spacers a -> PS.Spacers a-convSpacers s = PS.Spacers-  { PS.globalTransaction = sGlobalTransaction s-  , PS.revGlobalTransaction = sRevGlobalTransaction s-  , PS.globalPosting = sGlobalPosting s-  , PS.revGlobalPosting = sRevGlobalPosting s-  , PS.fileTransaction = sFileTransaction s-  , PS.revFileTransaction = sRevFileTransaction s-  , PS.filePosting = sFilePosting s-  , PS.revFilePosting = sRevFilePosting s-  , PS.filtered = sFiltered s-  , PS.revFiltered = sRevFiltered s-  , PS.sorted = sSorted s-  , PS.revSorted = sRevSorted s-  , PS.visible = sVisible s-  , PS.revVisible = sRevVisible s-  , PS.lineNum = sLineNum s-  , PS.date = sDate s-  , PS.flag = sFlag s-  , PS.number = sNumber s-  , PS.payee = sPayee s-  , PS.account = sAccount s-  , PS.postingDrCr = sPostingDrCr s-  , PS.postingCmdty = sPostingCmdty s-  , PS.postingQty = sPostingQty s-  , PS.totalDrCr = sTotalDrCr s-  , PS.totalCmdty = sTotalCmdty s-  }--convFields :: Fields a -> PF.Fields a-convFields f = PF.Fields-  { PF.globalTransaction = fGlobalTransaction f-  , PF.revGlobalTransaction = fRevGlobalTransaction f-  , PF.globalPosting = fGlobalPosting f-  , PF.revGlobalPosting = fRevGlobalPosting f-  , PF.fileTransaction = fFileTransaction f-  , PF.revFileTransaction = fRevFileTransaction f-  , PF.filePosting = fFilePosting f-  , PF.revFilePosting = fRevFilePosting f-  , PF.filtered = fFiltered f-  , PF.revFiltered = fRevFiltered f-  , PF.sorted = fSorted f-  , PF.revSorted = fRevSorted f-  , PF.visible = fVisible f-  , PF.revVisible = fRevVisible f-  , PF.lineNum = fLineNum f-  , PF.date = fDate f-  , PF.flag = fFlag f-  , PF.number = fNumber f-  , PF.payee = fPayee f-  , PF.account = fAccount f-  , PF.postingDrCr = fPostingDrCr f-  , PF.postingCmdty = fPostingCmdty f-  , PF.postingQty = fPostingQty f-  , PF.totalDrCr = fTotalDrCr f-  , PF.totalCmdty = fTotalCmdty f-  , PF.totalQty = fTotalQty f-  , PF.tags = fTags f-  , PF.memo = fMemo f-  , PF.filename = fFilename f-  }-

@@ -1,259 +0,0 @@--- | Brenner - Penny financial institution interfaces------ Brenner provides a uniform way to interact with downloaded data--- from financial Given a parser, Brenner will import the transactions--- and store them in a database. From there it is easy to merge the--- transactions (without duplicates) into a ledger file, and then to--- clear transactions from statements in an automated fashion.-module Penny.Brenner-  ( FitAcct(..)-  , Config(..)-  , R.GroupSpecs(..)-  , R.GroupSpec(..)-  , Y.Translator(..)-  , L.Side(..)-  , L.SpaceBetween(..)-  , usePayeeOrDesc-  , brennerMain-  ) where--import qualified Penny.Brenner.Types as Y-import Control.Monad (join)-import Data.Either (partitionEithers)-import qualified Data.Text as X-import qualified Data.Version as V-import qualified Penny.Liberty as Ly-import qualified Penny.Lincoln as L-import qualified Penny.Lincoln.Builders as Bd-import qualified Penny.Copper.Render as R-import qualified Penny.Brenner.Clear as C-import qualified Penny.Brenner.Database as D-import qualified Penny.Brenner.Import as I-import qualified Penny.Brenner.Merge as M-import qualified Penny.Brenner.Print as P-import Control.Applicative ((<*>))-import qualified System.Console.MultiArg as MA-import qualified Control.Monad.Exception.Synchronous as Ex--brennerMain-  :: V.Version-  -- ^ Binary version-  -> Config-  -> IO ()-brennerMain v cf = do-  let cf' = convertConfig cf-  join $ MA.modesWithHelp (help cf') (globalOpts v)-    (preProcessor cf')--globalOpts-  :: V.Version-  -- ^ Binary version-  -> [MA.OptSpec (Either (IO ()) String)]-globalOpts v =-  [ MA.OptSpec ["fit-account"] "f" (MA.OneArg Right)-  , fmap Left (Ly.version v)-  ]--preProcessor-  :: Y.Config-  -> [Either (IO ()) String]-  -> Either (a -> IO ()) [MA.Mode (IO ())]-preProcessor cf args =-  let (vers, as) = partitionEithers args-  in case vers of-      [] -> makeModes cf as-      x:_ -> Left (const x)--makeModes-  :: Y.Config-  -> [String]-  -- ^ Names of financial institutions given on command line-  -> Either (a -> IO ()) [MA.Mode (IO ())]-makeModes cf as = Ex.toEither . Ex.mapException (const . fail) $ do-  fi <- case as of-    [] -> return $ Y.defaultFitAcct cf-    _ ->-      let pdct (Y.Name n, _) = n == X.pack s-          s = last as-      in case filter pdct (Y.moreFitAccts cf) of-           [] -> Ex.throw $-              "financial institution account "-              ++ s ++ " not configured."-           (_, c):[] -> return $ Just c-           _ -> Ex.throw $-              "more than one financial institution account "-              ++ "named " ++ s ++ " configured."-  return $ [C.mode, I.mode, M.mode, P.mode, D.mode] <*> [fi]--help-  :: Y.Config-  -> String-  -- ^ Program name--  -> String-help c n = unlines ls ++ cs-  where-    ls = [ "usage: " ++ n ++ " [global-options]"-            ++ " COMMAND [local-options]"-            ++ " ARGS..."-         , ""-         , "where COMMAND is one of:"-         , "import, merge, clear, database, print"-         , ""-         , "For help on an individual command and its"-           ++ " local options, use "-         , n ++ " COMMAND --help"-         , ""-         , "Global Options:"-         , "-f, --fit-account ACCOUNT"-         , "  Use one of the Additional Financial Institution"-         , "  Accounts shown below. If this option does not appear,"-         , "  the default account is used if there is one."-         , "-h, --help"-         , "  Show help and exit"-         , ""-         ]-    showPair (Y.Name a, cd) = "Additional financial institution "-      ++ "account: " ++ X.unpack a ++ "\n" ++ showFitAcct cd-    cs = showDefaultFitAcct (Y.defaultFitAcct c)-         ++ more-    more = if null (Y.moreFitAccts c)-           then "No additional financial institution accounts\n"-           else concatMap showPair . Y.moreFitAccts $ c--showDefaultFitAcct :: Maybe Y.FitAcct -> String-showDefaultFitAcct mc = case mc of-  Nothing -> "No default financial institution account\n"-  Just c -> "Default financial institution account:\n" ++ showFitAcct c--label :: String -> String -> String-label l o = "  " ++ l ++ ": " ++ o ++ "\n"--showAccount :: L.Account -> String-showAccount =-  X.unpack-  . X.intercalate (X.singleton ':')-  . map L.unSubAccount-  . L.unAccount--showFitAcct :: Y.FitAcct -> String-showFitAcct c =-  label "Database location"-    (X.unpack . Y.unDbLocation . Y.dbLocation $ c)--  ++ label "Penny account"-     (showAccount . Y.unPennyAcct . Y.pennyAcct $ c)--  ++ label "Account for new offsetting postings"-     (showAccount . Y.unDefaultAcct . Y.defaultAcct $ c)--  ++ label "Currency"-     (X.unpack . L.unCommodity . Y.unCurrency . Y.currency $ c)--  ++ "\n"--  ++ "More information about the parser:\n"-  ++ (fst . Y.parser $ c)-  ++ "\n\n"----- | Information to configure a single financial institution account.-data FitAcct = FitAcct-  { dbLocation :: String-    -- ^ Path and filename to where the database is kept. You can use-    -- an absolute or relative path (if it is relative, it will be-    -- resolved relative to the current directory at runtime.)--  , pennyAcct :: String-    -- ^ The account that you use in your Penny file to hold-    -- transactions for this card. Separate each sub-account with-    -- colons (as you do in the Penny file.)--  , defaultAcct :: String-    -- ^ When new transactions are created, one of the postings will-    -- be in the amexAcct given above. The other posting will be in-    -- this account.--  , currency :: String-    -- ^ The commodity for the currency of your card (e.g. @$@).--  , groupSpecs :: R.GroupSpecs-    -- ^ How to group digits when printing the resulting ledger. All-    -- quantities (not just those affected by this program) will be-    -- formatted using this specification.--  , translator :: Y.Translator-    -- ^ See the documentation under the 'Translator' type for-    -- details.--  , side :: L.Side-  -- ^ When creating new transactions, the commodity will be on this-  -- side--  , spaceBetween :: L.SpaceBetween-  -- ^ When creating new transactions, is there a space between the-  -- commodity and the quantity--  , parser :: ( String-              , Y.FitFileLocation -> IO (Ex.Exceptional String [Y.Posting]))-  -- ^ Parses a file of transactions from the financial-  -- institution. The function must open the file and parse it. This-  -- is in the IO monad not only because the function must open the-  -- file itself, but also so the function can perform arbitrary IO-  -- (run pdftotext, maybe?) If there is failure, the function can-  -- return an Exceptional String, which is the error-  -- message. Alternatively the function can raise an exception in the-  -- IO monad (currently Brenner makes no attempt to catch these) so-  -- if any of the IO functions throw you can simply not handle the-  -- exceptions.-  ---  -- The first element of the pair is a help string which should-  -- indicate how to download the data, as a helpful reminder.--  , toLincolnPayee :: Y.Desc -> Y.Payee -> L.Payee-  -- ^ Sometimes the financial institution provides Payee information,-  -- sometimes it does not. Sometimes the Desc might have additional-  -- information that you might want to remove. This function can be-  -- used to do that. The resulting Lincoln Payee is used for any-  -- transactions that are created by the merge command. The resulting-  -- payee is also used when comparing new financial institution-  -- postings to already existing ledger transactions in order to-  -- guess at which payee and accounts to create in the transactions-  -- created by the merge command.---  } deriving Show--convertFitAcct :: FitAcct -> Y.FitAcct-convertFitAcct (FitAcct db ax df cy gs tl sd sb ps tlp) = Y.FitAcct-  { Y.dbLocation = Y.DbLocation . X.pack $ db-  , Y.pennyAcct = Y.PennyAcct . Bd.account . X.pack $ ax-  , Y.defaultAcct = Y.DefaultAcct . Bd.account . X.pack $ df-  , Y.currency = Y.Currency . L.Commodity . X.pack $ cy-  , Y.groupSpecs = gs-  , Y.translator = tl-  , Y.side = sd-  , Y.spaceBetween = sb-  , Y.parser = ps-  , Y.toLincolnPayee = tlp-  }--data Config = Config-  { defaultFitAcct :: Maybe FitAcct-  , moreFitAccts :: [(String, FitAcct)]-  } deriving Show--convertConfig :: Config -> Y.Config-convertConfig (Config d m) = Y.Config-  { Y.defaultFitAcct = fmap convertFitAcct d-  , Y.moreFitAccts =-      let f (n, c) = (Y.Name (X.pack n), convertFitAcct c)-      in map f m-  }---- | A simple function to use for 'toLincolnPayee'. Uses the financial--- institution payee if it is available; otherwise, uses the financial--- institution description.-usePayeeOrDesc :: Y.Desc -> Y.Payee -> L.Payee-usePayeeOrDesc (Y.Desc d) (Y.Payee p) = L.Payee $-  if X.null p then d else p

@@ -1,121 +0,0 @@--- | Parses Amex credit card data. See the help text in the 'help'--- function for more details. Also, the file format is documented in--- the file @doc\/amex-file-format.org@.-module Penny.Brenner.Amex (parser) where--import Control.Applicative ((<$>), (<*>), (<$), (<*), (*>), pure,-                            (<|>), optional)-import qualified Data.Time as Time-import qualified Penny.Brenner.Types as Y-import Text.Parsec.Text (Parser)-import qualified Text.Parsec as P-import Text.Parsec (many1, char, many, satisfy)-import qualified Data.Text as X-import qualified Data.Text.IO as TIO-import qualified Control.Monad.Exception.Synchronous as Ex--parser :: (String, Y.FitFileLocation-                   -> IO (Ex.Exceptional String [Y.Posting]))-parser = (help, loadIncoming)--help :: String-help = unlines-  [ "Parses American Express transaction data in CSV format."-  , "Not tested with American Express deposit accounts."-  , "To download, click the \"Download\" link which is visible"-  , "above and to the right of the transaction list. Under"-  , "\"Download Current View\" Select \"CSV\""-  , "and be sure to click"-  , "\"Include all additional Transaction Details.\""-  ]---- | Loads incoming Amex transactions.-loadIncoming :: Y.FitFileLocation-             -> IO (Ex.Exceptional String [Y.Posting])-loadIncoming (Y.FitFileLocation loc) = do-  txt <- TIO.readFile loc-  let parsed = P.parse (P.many posting <* P.eof) "" txt-      err s = "could not parse incoming postings: " ++ show s-  return (Ex.mapException err . Ex.fromEither $ parsed)--skipThrough :: Char -> Parser ()-skipThrough c = () <$ many (satisfy (/= c)) <* char c--readThrough :: Char -> Parser String-readThrough c = many (satisfy (/= c)) <* char c--date :: Parser Y.Date-date = p >>= failOnErr-  where-    p = (,,)-        <$> fmap read (many1 P.digit)-        <*  char '/'-        <*> fmap read (many1 P.digit)-        <* char '/'-        <*> fmap read (many1 P.digit)-        <*  skipThrough ','-    failOnErr (m, d, y) = maybe (fail "could not parse date")-      (return . Y.Date)-      $ Time.fromGregorianValid y m d--incDecAmount :: Parser (Y.IncDec, Y.Amount)-incDecAmount = do-  incDec <- (Y.Decrease <$ char '-') <|> pure Y.Increase-  amtStr <- readThrough ','-  case Y.mkAmount amtStr of-    Nothing -> fail $ "could not parse amount: " ++ amtStr-    Just a -> return (incDec, a)--doubleQuoted :: Parser String-doubleQuoted = char '"' *> readThrough '"'--desc :: Parser Y.Desc-desc = fmap (Y.Desc . X.pack) $ doubleQuoted <* char ','--payee :: Parser Y.Payee-payee = fmap (Y.Payee . X.pack) $ doubleQuoted <* char ','--amexId :: Parser Y.FitId-amexId = fmap (Y.FitId . X.pack)-         $ char '"' *> char '\'' *> readThrough '\''-           <* char '"' <* char ','----- | Skips a field. Will skip a quoted field or,--- alternatively, skip everything through to the next comma. Do not--- use for the last field, as it looks for a trailing comma.-skipField :: Parser ()-skipField =-  ()-  <$ skipper-  <* char ','-  where-    skipper =     (() <$ optional doubleQuoted)-              <|> (() <$ many (satisfy (/= ',')))----- | Parses last field (currently unknown). Parsers the EOL character.-skipLast :: Parser ()-skipLast = skipThrough '\n'--posting :: Parser Y.Posting-posting =-  f-  <$> date                                        -- 1-  <*  skipField                                   -- 2 Unknown-  <*> desc                                        -- 3 Description-  <*  skipField                                   -- 4 Unknown-  <*  skipField                                   -- 5 Unknown-  <*  skipField                                   -- 6 Unknown-  <*  skipField                                   -- 7 Unknown-  <*> incDecAmount                                -- 8-  <*  skipField                                   -- 9 Unknown-  <*  skipField                                   -- 10 Category-  <*> payee                                       -- 11 D.B.A.-  <*  skipField                                   -- 12 Address-  <*  skipField                                   -- 13 Postcode-  <*> amexId                                      -- 14-  <*  skipField                                   -- 15 Unknown-  <*  skipLast                                    -- 16-  where-    f dt ds (t, a) p i = Y.Posting dt ds t a p i

@@ -1,226 +0,0 @@--- | Parses statements for Bank of America deposit accounts. See the--- help text in the 'help' function for more details. Also, the file--- format is documented in the file @doc\/bofa-file-format.org@.-module Penny.Brenner.BofA (parser, getPayee) where--import Control.Applicative ((<$>), (<*), (<$), (<*>))-import qualified Control.Monad.Exception.Synchronous as Ex-import Data.Char (isUpper)-import qualified Data.Time as T-import qualified Text.Parsec as P-import Text.Parsec (char, string, many, many1, satisfy, manyTill,-                    (<?>), try)-import Text.Parsec.String (Parser)-import qualified Data.Tree as T-import Data.Tree (Tree(Node))-import qualified Penny.Brenner.Types as Y-import qualified Penny.Lincoln as L-import qualified Data.Text as X--newtype TagName = TagName { unTagName :: String }-  deriving (Eq, Show)--newtype TagData = TagData { unTagData :: String }-  deriving (Eq, Show)--data Label-  = Parent TagName-  | Terminal TagName TagData-  deriving (Eq, Show)--type ExS = Ex.Exceptional String--bOfAFile :: Parser ([(TagName, TagData)], Tree Label)-bOfAFile =-  (,)-  <$> many headerLine-  <*  string "\r\n"-  <*> node--notReturn :: Parser Char-notReturn = satisfy (/= '\r')--headerLine :: Parser (TagName, TagData)-headerLine =-  (,)-  <$> (TagName <$> manyTill (satisfy isUpper) (char ':'))-  <*> (TagData <$> manyTill notReturn (char '\r')-               <*  char '\n')--openTag :: Parser String-openTag = do-  { let pc = (satisfy (\c -> c /= '/' && c /= '>'))-  ; c <- try (char '<' >> pc)-  ; cs <- many pc-  ; _ <- char '>'-  ; return (c:cs)-  } <?> "open tag"--closeTag :: String -> Parser ()-closeTag s = () <$ string "</" <* string s <* char '>'-             <?> "close tag named " ++ s---- | Reads in a tag, then examine what's next. If a backslash-r is--- next, then this is the end of the line. That means it a nested--- tag. Parse some more child nodes, then parse a closing node. If--- anything else is next, this is a data node. Parse the data, then--- return that node.-node :: Parser (Tree Label)-node = do-  tagName <- openTag-  next <- P.anyChar-  case next of-    '\r' -> do-      _ <- char '\n'-      kids <- many1 node-      closeTag tagName-      _ <- string "\r\n"-      return $ T.Node (Parent (TagName tagName)) kids-    o -> do-      rs <- manyTill notReturn (char '\r')-      _ <- char '\n'-      return $-        T.Node (Terminal (TagName tagName) (TagData $ o:rs)) []--findNodes :: Eq a => a -> Tree a -> [Tree a]-findNodes a = findNodesBy (== a)---findNodesBy :: (a -> Bool) -> Tree a -> [Tree a]-findNodesBy f t@(Node l cs)-  | f l = [t]-  | otherwise = concatMap (findNodesBy f) cs--safeRead :: (Read r) => String -> Maybe r-safeRead s = case reads s of-  (i,""):[] -> Just i-  _ -> Nothing---- | Parses a B of A date-time. The format is YYYYMMDDHHMMSS. Discards--- the HHMMSS.-parseDateStr :: String -> ExS Y.Date-parseDateStr s =-  let (yr, r1) = splitAt 4 s-      (mo, r2) = splitAt 2 r1-      (da, _) = splitAt 2 r2-  in Ex.fromMaybe ("could not parse date: " ++ s) $ do-      yi <- safeRead yr-      ym <- safeRead mo-      yd <- safeRead da-      Y.Date <$> T.fromGregorianValid yi ym yd--parseAmountStr :: String -> ExS (Y.IncDec, Y.Amount)-parseAmountStr s = do-  (f, rs) <- case s of-    "" -> Ex.throw "empty string for amount"-    x:xs -> return (x, xs)-  let (amtStr, incDec) = case f of-        '-' -> (rs, Y.Decrease)-        _ -> (s, Y.Increase)-  amt <- Ex.fromMaybe ("could not parse amount: " ++ s)-         $ Y.mkAmount amtStr-  return (incDec, amt)--postings :: Tree Label -> ExS [Y.Posting]-postings t =-  let match = Parent (TagName "STMTTRN")-  in mapM posting .findNodes match $ t--posting :: Tree Label -> ExS Y.Posting-posting (Node l cs) = do-  tag <- case l of-    Parent n -> return n-    _ -> Ex.throw "did not find posting tree"-  Ex.assert "did not find STMTTRN tag" $ unTagName tag == "STMTTRN"-  tPosted <- findTerminal "DTPOSTED" cs-  tAmt <- findTerminal "TRNAMT" cs-  tId <- findTerminal "FITID" cs-  tName <- findTerminal "NAME" cs-  pPosted <- parseDateStr (X.unpack tPosted)-  (amtIncDec, pAmt) <- parseAmountStr (X.unpack tAmt)-  let pId = Y.FitId tId-      pName = Y.Desc tName-      pPayee = Y.Payee (X.empty)-  return $ Y.Posting pPosted pName amtIncDec pAmt pPayee pId---- | Removes the TagData from a tree, after ensuring that the TagName--- is correct and that the tree has no children.-terminalData-  :: String-  -- ^ The name of the terminal--  -> Tree Label--  -> ExS X.Text-  -- ^ Returns the data from the tag, or an error if this is not a-  -- terminal or if the terminal has children.-terminalData n (Node l cs) = do-  (tn, td) <- case l of-    Parent _ -> Ex.throw $ "looking for data tag named " ++ n-                           ++ ", but that tag does not have data"-    Terminal x y -> return (x, y)-  let tagErr = "looking for tag named " ++ n-        ++ ", but found tag named " ++ unTagName tn-  Ex.assert tagErr $ tn == TagName n-  let kidsErr = "data tag " ++ n ++ " should have no children,"-                ++ " but does"-  Ex.assert kidsErr $ null cs-  return . X.pack . unTagData $ td---- | Finds a terminal amongst a list of Trees; returns the data. Fails--- if there is no terminal by the given name or of the terminal has--- children (in which case it is not a terminal!)-findTerminal-  :: String-  -- ^ The name of the terminal--  -> [Tree Label]-  -> ExS X.Text-  -- ^ Returns the data from the terminal, or an error if there is no-  -- tag by this name or if it has chlidren.--findTerminal n ts = do-  let pdct lbl = case lbl of-        Terminal (TagName x) _ -> x == n-        _ -> False-  t <- case concatMap (findNodesBy pdct) ts of-    [] -> Ex.throw $ "looking for terminal named "-          ++ n ++ "; none found"-    x:[] -> return x-    _ -> Ex.throw $ "looking for terminal named "-         ++ n ++ "; multiple matches found"-  terminalData n t--help :: String-help = unlines-  [ "Parses Bank of America postings for deposit accounts, like checking"-  , "or savings. This parser is not tested with credit card accounts."-  , "To download the data, from the account activity screen click on"-  , "\"Download\", which is just above all the transaction information."-  , "Then download the \"WEB Connect for Quicken 2010 and above.\""-  ]--parser :: (String, Y.FitFileLocation-                   -> IO (Ex.Exceptional String [Y.Posting]))-parser = (help, psr)-  where-    psr (Y.FitFileLocation path) = do-      str <- readFile path-      return $ case P.parse bOfAFile "" str of-        Left e -> Ex.throw-                  $ "could not parse Bank of America transactions: "-                    ++ show e-        Right (_, t) -> postings t---- | For check card transactions, Bank of America changes the--- description so that it begins with @CHECKCARD MMDD@, where MM is--- the two-digit month of the transaction date, and DD is the--- two-digit day of the transaction date. (The posting date is used as--- the main date, and it is typically two days later than the--- transaction date.) This function strips off the @CHECKCARD MMDD@--- portion.-getPayee :: Y.Desc -> L.Payee-getPayee (Y.Desc d) = L.Payee $-  if X.isPrefixOf (X.pack "CHECKCARD") d-  then X.drop (length "CHECKCARD XXXX ") d-  else d

@@ -1,175 +0,0 @@-module Penny.Brenner.Clear (mode) where--import qualified Control.Monad.Exception.Synchronous as Ex-import Control.Applicative (pure)-import Control.Monad (guard, mzero, when)-import Data.Maybe (mapMaybe, fromMaybe)-import Data.Monoid (mconcat, First(..))-import qualified Data.Set as Set-import qualified Data.Map as M-import qualified Data.Text as X-import qualified Data.Text.IO as TIO-import qualified System.Console.MultiArg as MA-import qualified Penny.Lincoln as L-import qualified Control.Monad.Trans.State as St-import qualified Control.Monad.Trans.Maybe as MT-import Control.Monad.Trans.Class (lift)-import qualified Penny.Copper.Types as Y-import qualified Penny.Copper as C-import qualified Penny.Copper.Render as R-import Text.Show.Pretty (ppShow)-import qualified Penny.Brenner.Types as Y-import qualified Penny.Brenner.Util as U---help :: String -> String-help pn = unlines-  [ "usage: " ++ pn ++ " clear clear [options] FIT_FILE LEDGER_FILE..."-  , "Parses all postings that are in FIT_FILE. Then marks all"-  , "postings that are in the FILEs given that correspond to one"-  , "of the postings in the FIT_FILE as being cleared."-  , "Quits if one of the postings found in FIT_FILE is not found"-  , "in the database, if one of the postings in the database"-  , "is not found in one of the FILEs, or if any of the postings found"-  , "in one of the FILEs already has a flag."-  , ""-  , "Results are printed to standard output. If no FILE, or FILE is \"-\","-  , "read standard input."-  , ""-  , "Options:"-  , "  -h, --help - show help and exit"-  ]--data Arg-  = APosArg String-  deriving (Eq, Show)--toPosArg :: Arg -> Maybe String-toPosArg a = case a of { APosArg s -> Just s }--data Opts = Opts-  { csvLocation :: Y.FitFileLocation-  , ledgerLocations :: [String]-  } deriving Show---mode :: Maybe Y.FitAcct -> MA.Mode (IO ())-mode c = MA.Mode-  { MA.mName = "clear"-  , MA.mIntersperse = MA.Intersperse-  , MA.mOpts = [ ]-  , MA.mPosArgs = APosArg-  , MA.mProcess = process c-  , MA.mHelp = help-  }--process :: Maybe Y.FitAcct -> [Arg] -> IO ()-process mayC as = do-  c <- case mayC of-    Just cd -> return cd-    Nothing -> fail $ "no financial institution account given"-               ++ " on command line, and no default financial"-               ++ " institution configured."-  (csv, ls) <- case mapMaybe toPosArg as of-    [] -> fail "clear: you must provide a postings file."-    x:xs -> return (Y.FitFileLocation x, xs)-  let os = Opts csv ls-  runClear c os--runClear :: Y.FitAcct -> Opts -> IO ()-runClear c os = do-  dbList <- U.loadDb (Y.AllowNew False) (Y.dbLocation c)-  let db = M.fromList dbList-      (_, prsr) = Y.parser c-  txns <- fmap (Ex.switch fail return) $ prsr (csvLocation os)-  leds <- C.open (ledgerLocations os)-  toClear <- case mapM (findUNumber db) (concat txns) of-    Nothing -> fail $ "at least one posting was not found in the"-                       ++ " database. Ensure all postings have "-                       ++ "been imported and merged."-    Just ls -> return $ Set.fromList ls-  let (led', left) = changeLedger (Y.pennyAcct c) toClear leds-  when (not (Set.null left))-    (fail $ "some postings were not cleared. "-      ++ "Those not cleared:\n" ++ ppShow left)-  case R.ledger (Y.groupSpecs c) led' of-    Nothing ->-      fail "could not render resulting ledger."-    Just txt -> TIO.putStr txt----- | Examines an financial institution transaction and the DbMap to--- find a matching UNumber. Fails if the financial institution--- transaction is not in the Db.-findUNumber :: Y.DbMap -> Y.Posting -> Maybe Y.UNumber-findUNumber m pstg =-  let atn = Y.fitId pstg-      p ap = Y.fitId ap == atn-      filteredMap = M.filter p m-      ls = M.toList filteredMap-  in case ls of-      (n, _):[] -> Just n-      _ -> Nothing---clearedFlag :: L.Flag-clearedFlag = L.Flag . X.singleton $ 'C'---- | Changes a ledger to clear postings. Returns postings still not--- cleared.-changeLedger-  :: Y.PennyAcct-  -> Set.Set Y.UNumber-  -> Y.Ledger-  -> (Y.Ledger, Set.Set Y.UNumber)-changeLedger ax s l = St.runState k s-  where-    k = Y.mapLedgerA f l-    f = Y.mapItemA pure pure (changeTxn ax)--changeTxn-  :: Y.PennyAcct-  -> L.Transaction-  -> St.State (Set.Set Y.UNumber) L.Transaction-changeTxn ax t = do-  let fam = L.unTransaction t-      fam' = L.mapParent (const L.emptyTopLineChangeData) fam-  fam'' <- L.mapChildrenA (changePstg ax) fam'-  return $ L.changeTransaction fam'' t----- | Sees if this posting is a posting in the right account and has a--- UNumber that needs to be cleared. If so, clears it. If this posting--- already has a flag, skips it.-changePstg-  :: Y.PennyAcct-  -> L.Posting-  -> St.State (Set.Set Y.UNumber) L.PostingChangeData-changePstg ax p =-  fmap (fromMaybe L.emptyPostingChangeData) . MT.runMaybeT $ do-    guard (L.pAccount p == (Y.unPennyAcct ax))-    let tags = L.pTags p-    un <- maybe mzero return $ parseUNumberFromTags tags-    guard (L.pFlag p == Nothing)-    set <- lift St.get-    guard (Set.member un set)-    lift $ St.put (Set.delete un set)-    return $ L.emptyPostingChangeData-             { L.pcFlag = Just (Just clearedFlag) }--parseUNumberFromTags :: L.Tags -> Maybe Y.UNumber-parseUNumberFromTags =-  getFirst-  . mconcat-  . map First-  . map parseUNumberFromTag-  . L.unTags--parseUNumberFromTag :: L.Tag -> Maybe Y.UNumber-parseUNumberFromTag (L.Tag x) = do-  (f, xs) <- X.uncons x-  guard (f == 'U')-  case reads . X.unpack $ xs of-    (u, ""):[] -> Just (Y.UNumber u)-    _ -> Nothing-

@@ -1,49 +0,0 @@-module Penny.Brenner.Database (mode) where--import qualified Penny.Brenner.Types as Y-import qualified Penny.Brenner.Util as U-import qualified System.Console.MultiArg as MA--help :: String -> String-help pn = unlines-  [ "usage: " ++ pn ++ " [global-options] database [local-options]"-  , "Shows the database of financial institution transactions."-  , "Does not accept any non-option arguments."-  , ""-  , "Local options:"-  , "  --help, -h Show this help and exit."-  ]--data Arg = ArgPos String deriving (Eq, Show)--mode-  :: Maybe Y.FitAcct-  -> MA.Mode (IO ())-mode mayFa = MA.Mode-  { MA.mName = "database"-  , MA.mIntersperse = MA.Intersperse-  , MA.mOpts = [ ]-  , MA.mPosArgs = ArgPos-  , MA.mProcess = processor mayFa-  , MA.mHelp = help-  }--processor-  :: Maybe Y.FitAcct-  -> [Arg]-  -> IO ()-processor mayFa ls-  | any isArgPos ls = fail $-        "penny-fit database: error: this command does"-        ++ " not accept non-option arguments."-  | otherwise = case mayFa of-      Nothing -> fail $ "no financial institution account"-        ++ " selected on command line, and no default"-        ++ " financial instititution account configured."-      Just fa -> do-        let dbLoc = Y.dbLocation fa-        db <- U.loadDb (Y.AllowNew False) dbLoc-        mapM_ putStr . map U.showDbPair $ db--isArgPos :: Arg -> Bool-isArgPos (ArgPos _) = True

@@ -1,106 +0,0 @@-module Penny.Brenner.Import (mode) where--import Control.Monad.Exception.Synchronous as Ex-import Data.Maybe (mapMaybe)-import qualified System.Console.MultiArg as MA-import qualified Penny.Brenner.Types as Y-import qualified Penny.Brenner.Util as U---data Arg-  = AFitFile String-  | AAllowNew-  deriving (Eq, Show)--toFitFile :: Arg -> Maybe String-toFitFile a = case a of-  AFitFile s -> Just s-  _ -> Nothing--data ImportOpts = ImportOpts-  { fitFile :: Y.FitFileLocation-  , allowNew :: Y.AllowNew-  , parser :: Y.FitFileLocation-              -> IO (Ex.Exceptional String [Y.Posting])-  }--mode-  :: Maybe Y.FitAcct-  -> MA.Mode (IO ())-mode mayFa = MA.Mode-  { MA.mName = "import"-  , MA.mIntersperse = MA.Intersperse-  , MA.mOpts =-      [ MA.OptSpec ["new"] "n" (MA.NoArg AAllowNew) ]-  , MA.mPosArgs = AFitFile-  , MA.mProcess = processor mayFa-  , MA.mHelp = help-  }--processor-  :: Maybe Y.FitAcct-  -> [Arg]-  -> IO ()-processor mayFa as = do-  (dbLoc, prsr) <- case mayFa of-    Nothing -> fail $ "no financial institution account provided"-      ++ " on command line, and no default financial institution"-      ++ " account is configured."-    Just fa -> return (Y.dbLocation fa, snd . Y.parser $ fa)-  loc <- case mapMaybe toFitFile as of-    [] -> fail "you must provide a postings file to read"-    x:[] -> return (Y.FitFileLocation x)-    _ -> fail "you cannot provide more than one postings file to read"-  let aNew = Y.AllowNew $ any (== AAllowNew) as-  doImport dbLoc (ImportOpts loc aNew prsr)----- | Appends new Amex transactions to the existing list.-appendNew-  :: [(Y.UNumber, Y.Posting)]-  -- ^ Existing transactions--  -> [Y.Posting]-  -- ^ New transactions--  -> ([(Y.UNumber, Y.Posting)], Int)-  -- ^ New list, and number of transactions added--appendNew db new = (db ++ newWithU, length newWithU)-  where-    nextUNum = if null db-               then 0-               else (Y.unUNumber . maximum . map fst $ db) + 1-    currFitIds = map (Y.fitId . snd) db-    isNew p = not (any (== Y.fitId p) currFitIds)-    newPstgs = filter isNew new-    mkPair i p = (Y.UNumber i, p)-    newWithU = zipWith mkPair [nextUNum..] newPstgs---doImport :: Y.DbLocation -> ImportOpts -> IO ()-doImport dbLoc os = do-  txnsOld <- U.loadDb (allowNew os) dbLoc-  parseResult <- parser os (fitFile os)-  ins <- case parseResult of-    Ex.Exception e -> fail e-    Ex.Success g -> return g-  let (new, len) = appendNew txnsOld ins-  U.saveDb dbLoc new-  putStrLn $ "imported " ++ show len ++ " new transactions."--help :: String -> String-help pn = unlines-  [ "usage: " ++ pn ++ "  [global-options] import [local-options] FIT_FILE"-  , "where FIT_FILE is the file downloaded from the financial"-  , "institution."-  , ""-  , "Local Options:"-  , ""-  , "-n, --new - Allows creation of new database. Without this option,"-  , "if the database file is not found, quits with an error."-  , ""-  , "-h, --help - Show this help."-  , ""-  ]-

@@ -1,347 +0,0 @@-module Penny.Brenner.Merge (mode) where--import Control.Applicative (pure)-import Control.Monad (guard)-import qualified Control.Monad.Trans.State as St-import Data.List (find, sortBy, foldl')-import qualified Data.Map as M-import Data.Maybe (mapMaybe, isNothing, fromMaybe)-import Data.Monoid (First(..), mconcat)-import qualified Data.Text as X-import qualified Data.Text.IO as TIO-import qualified System.Console.MultiArg as MA-import qualified Penny.Copper as C-import qualified Penny.Copper.Render as R-import qualified Penny.Lincoln as L-import qualified Penny.Lincoln.Transaction.Unverified as U-import qualified Penny.Lincoln.Queries as Q-import qualified Penny.Brenner.Types as Y-import qualified Penny.Brenner.Util as U--type NoAuto = Bool--data Arg-  = APos String-  | ANoAuto-  deriving (Eq, Show)--toPosArg :: Arg -> Maybe String-toPosArg a = case a of { APos s -> Just s; _ -> Nothing }--mode :: Maybe Y.FitAcct -> MA.Mode (IO ())-mode maybeC = MA.Mode-  { MA.mName = "merge"-  , MA.mIntersperse = MA.Intersperse-  , MA.mOpts = [MA.OptSpec ["no-auto"] "n" (MA.NoArg ANoAuto)]-  , MA.mPosArgs = APos-  , MA.mProcess = processor maybeC-  , MA.mHelp = help-  }--processor :: Maybe Y.FitAcct -> [Arg] -> IO ()-processor maybeC as =-  doMerge maybeC (ANoAuto `elem` as) (mapMaybe toPosArg as)--doMerge :: Maybe Y.FitAcct -> NoAuto -> [String] -> IO ()-doMerge maybeAcct noAuto ss = do-  acct <- case maybeAcct of-    Nothing -> do-      fail $ "no financial"-        ++ " institution account provided on command line, and"-        ++ " no default account configured."-    Just ac -> return ac-  dbLs <- U.loadDb (Y.AllowNew False) (Y.dbLocation acct)-  l <- C.open ss-  let dbWithEntry = fmap (pairWithEntry acct) . M.fromList $ dbLs-      (l', db') = changeItems acct-                  l (filterDb (Y.pennyAcct acct) dbWithEntry l)-      newTxns = createTransactions noAuto acct l dbLs db'-      final = C.Ledger (C.unLedger l' ++ newTxns)-  case R.ledger (Y.groupSpecs acct) final of-    Nothing -> fail "Could not render final ledger."-    Just x -> TIO.putStr x---help :: String -> String-help pn = unlines-  [ "usage: " ++ pn ++ " merge: merges new transactions from database"-  , "to ledger file."-  , "usage: penny-fit merge [options] FILE..."-  , "Results are printed to standard output. If no FILE, or if FILE is -,"-  , "read standard input."-  , ""-  , "Options:"-  , "  -h, --help - show help and exit"-  , "  -n, --no-auto - do not automatically assign payees and accounts"-  ]---- | Removes all Brenner postings that already have a Penny posting--- with the correct uNumber.-filterDb :: Y.PennyAcct -> DbWithEntry -> C.Ledger -> DbWithEntry-filterDb ax m l = M.difference m ml-  where-    ml = M.fromList-       . flip zip (repeat ())-       . mapMaybe toUNum-       . filter inPennyAcct-       . concatMap L.postFam-       . mapMaybe toTxn-       . C.unLedger-       $ l-    toTxn t = case t of-      C.Transaction x -> Just x-      _ -> Nothing-    inPennyAcct p = Q.account p == (Y.unPennyAcct ax)-    toUNum p = getUNumberFromTags . Q.tags $ p---- | Gets the first UNumber from a list of Tags.-getUNumberFromTags :: L.Tags -> Maybe Y.UNumber-getUNumberFromTags =-  getFirst-  . mconcat-  . map First-  . map getUNumberFromTag-  . L.unTags---- | Examines a tag to see if it is a uNumber. If so, returns the--- UNumber. Otherwise, returns Nothing.-getUNumberFromTag :: L.Tag -> Maybe Y.UNumber-getUNumberFromTag (L.Tag x) = do-  (f, r) <- X.uncons x-  guard (f == 'U')-  case reads . X.unpack $ r of-    (y, ""):[] -> return $ Y.UNumber y-    _ -> Nothing----- | Changes a single Item.-changeItem-  :: Y.FitAcct-  -> C.Item-  -> St.State DbWithEntry C.Item-changeItem acct =-  C.mapItemA pure pure (changeTransaction acct)----- | Changes all postings that match an AmexTxn to assign them the--- proper UNumber. Returns a list of changed items, and the DbMap of--- still-unassigned AmexTxns.-changeItems-  :: Y.FitAcct-  -> C.Ledger-  -> DbWithEntry-  -> (C.Ledger, DbWithEntry)-changeItems acct l =-  St.runState (C.mapLedgerA (changeItem acct) l)---changeTransaction-  :: Y.FitAcct-  -> L.Transaction-  -> St.State DbWithEntry L.Transaction-changeTransaction acct txn = do-  let fam = L.unTransaction txn-      fam' = L.mapParent (const L.emptyTopLineChangeData) fam-  fam'' <- L.mapChildrenA (inspectAndChange acct txn) fam'-  return $ L.changeTransaction fam'' txn---- | Inspects a posting to see if it is an Amex posting and, if so,--- whether it matches one of the remaining AmexTxns. If so, then--- changes the transaction's UNumber, and remove that UNumber from the--- DbMap. If the posting alreay has a Number (UNumber or otherwise)--- skips it.-inspectAndChange-  :: Y.FitAcct-  -> L.Transaction-  -> L.Posting-  -> St.State DbWithEntry L.PostingChangeData-inspectAndChange acct t p = do-  m <- St.get-  case findMatch acct t p m of-    Nothing -> return L.emptyPostingChangeData-    Just (n, m') ->-      let L.Tags oldTags = L.pTags p-          tags' = L.Tags (oldTags ++ [newLincolnUNumber n])-          pcd = L.emptyPostingChangeData-                  { L.pcTags = Just tags' }-      in St.put m' >> return pcd--newLincolnUNumber :: Y.UNumber -> L.Tag-newLincolnUNumber a =-  L.Tag ('U' `X.cons` (X.pack . show . Y.unUNumber $ a))----- | Searches a DbMap for an AmexTxn that matches a given posting. If--- a match is found, returns the matching UNumber and a new DbMap that--- has the match removed.-findMatch-  :: Y.FitAcct-  -> L.Transaction-  -> L.Posting-  -> DbWithEntry-  -> Maybe (Y.UNumber, DbWithEntry)-findMatch acct t p m = fmap toResult findResult-  where-    findResult = find (pennyTxnMatches acct t p)-                 . M.toList $ m-    toResult (u, (_, _)) = (u, M.delete u m)---- | Pairs each association in a DbMap with an Entry representing the--- transaction's entry in the ledger.-pairWithEntry :: Y.FitAcct -> Y.Posting -> (Y.Posting, L.Entry)-pairWithEntry acct p = (p, en)-  where-    en = L.Entry dc (L.Amount qty cty (Just (Y.side acct))-                                      (Just (Y.spaceBetween acct)))-    dc = Y.translate (Y.incDec p) (Y.translator acct)-    qty = U.parseQty (Y.amount p)-    cty = Y.unCurrency . Y.currency $ acct--type DbWithEntry = M.Map Y.UNumber (Y.Posting, L.Entry)---- | Does the given Penny transaction match this posting? Makes sure--- that the account, quantity, date, commodity, and DrCr match, and--- that the posting does not have a number (it's OK if the transaction--- has a number.)-pennyTxnMatches-  :: Y.FitAcct-  -> L.Transaction-  -> L.Posting-  -> (a, (Y.Posting, L.Entry))-  -> Bool-pennyTxnMatches acct t p (_, (a, e)) =-  mA && noFlag && mQ && mDC && mDate && mCmdty-  where-    mA = L.pAccount p == (Y.unPennyAcct . Y.pennyAcct $ acct)-    mQ = L.equivalent (L.qty . L.amount . L.pEntry $ p)-                      (L.qty . L.amount $ e)-    mDC = (L.drCr e) == (L.drCr . L.pEntry $ p)-    (L.Family tl _ _ _) = L.unTransaction t-    mDate = (L.day . L.tDateTime $ tl) == (Y.unDate . Y.date $ a)-    noFlag = isNothing . L.pNumber $ p-    mCmdty = (L.commodity . L.amount $ e)-              == (Y.unCurrency . Y.currency $ acct)----- | Creates a new transaction corresponding to a given AmexTxn. Uses--- the Amex payee if that string is non empty; otherwise, uses the--- Amex description for the payee.-newTransaction-  :: NoAuto-  -> Y.FitAcct-  -> UNumberLookupMap-  -> PyeLookupMap-  -> (Y.UNumber, (Y.Posting, L.Entry))-  -> L.Transaction-newTransaction noAuto acct mu mp (u, (a, e)) = L.rTransaction rt-  where-    rt = L.RTransaction-      { L.rtCommodity = Y.unCurrency . Y.currency $ acct-      , L.rtSide = Just . Y.side $ acct-      , L.rtSpaceBetween = Just . Y.spaceBetween $ acct-      , L.rtDrCr = L.drCr e-      , L.rtTopLine = tl-      , L.rtPosting = p1-      , L.rtMorePostings = []-      , L.rtIPosting = p2-      }-    tl = (U.emptyTopLine ( L.dateTimeMidnightUTC . Y.unDate-                           . Y.date $ a))-         { U.tPayee = Just pa }-    getPye = Y.toLincolnPayee acct-    (guessedPye, guessedAcct) = guessInfo getPye mu mp a-    dfltPye = getPye (Y.desc a) (Y.payee a)-    dfltAcct = Y.unDefaultAcct . Y.defaultAcct $ acct-    (pa, ac) =-      if noAuto-      then (dfltPye, dfltAcct)-      else ( fromMaybe dfltPye guessedPye,-             fromMaybe dfltAcct guessedAcct)-    pennyAcct = Y.unPennyAcct . Y.pennyAcct $ acct-    p1 = (U.emptyRPosting pennyAcct (L.qty . L.amount $ e))-          { U.rTags = L.Tags [newLincolnUNumber u] }-    p2 = U.emptyIPosting ac---- | Creates new transactions for all the items remaining in the--- DbMap. Appends a blank line after each one.-createTransactions-  :: NoAuto-  -> Y.FitAcct-  -> C.Ledger-  -> Y.DbList-  -> DbWithEntry-  -> [C.Item]-createTransactions noAuto acct led dbLs db =-  concatMap (\i -> [i, C.BlankLine])-  . map C.Transaction-  . map (newTransaction noAuto acct mu mp)-  . M.assocs-  $ db-  where-    mu = makeUNumberLookup (Y.toLincolnPayee acct) dbLs-    mp = makePyeLookupMap (Y.pennyAcct acct) led---- | Maps financial institution postings to UNumbers. The key is the--- Lincoln Payee of the financial institution posting, which is--- computed using the toLincolnPayee function in the FitAcct.  The--- UNumbers are in a list, with UNumbers from most recent financial--- institution postings first.-type UNumberLookupMap = M.Map L.Payee [Y.UNumber]---- | Create a UNumberLookupMap from a DbWithEntry. Financial--- institution postings with higher U-numbers will come first.-makeUNumberLookup-  :: (Y.Desc -> Y.Payee -> L.Payee)-  -> Y.DbList-  -> UNumberLookupMap-makeUNumberLookup toPye = foldl' ins M.empty . map f . sortBy g-  where-    ins m (k, v) = M.alter alterer k m-      where alterer Nothing = Just [v]-            alterer (Just ls) = Just $ v:ls-    f (u, p) = (toPye (Y.desc p) (Y.payee p), u)-    g (_, p1) (_, p2) = compare (Y.date p1) (Y.date p2)---- | Given a list of keys, find the first key that is in the--- map. Returns Nothing if no key is in the map.-findFirstKey :: Ord k => M.Map k v -> [k] -> Maybe v-findFirstKey _ [] = Nothing-findFirstKey m (k:ks) = case M.lookup k m of-  Nothing -> findFirstKey m ks-  Just v -> Just v---- | Maps UNumbers to payees and accounts from the ledger.-type PyeLookupMap = M.Map Y.UNumber (Maybe L.Payee, Maybe L.Account)---- | Makes a payee lookup map. Puts those postings which match the--- PennyAcct and have a UNumber into the map. (If two postings match--- the PennyAcct and have the same UNumber, the one that appears later--- in the ledger file will be in the map.)-makePyeLookupMap :: Y.PennyAcct -> C.Ledger -> PyeLookupMap-makePyeLookupMap a l-  = M.fromList . mapMaybe f . concatMap L.postFam . mapMaybe toPstg-    . C.unLedger $ l-  where-    f pstg = do-      guard $ (Q.account pstg) == Y.unPennyAcct a-      u <- getUNumberFromTags . Q.tags $ pstg-      let (L.Child _ sib sibs _) = L.unPostFam pstg-          ac = if null sibs-               then Just (L.pAccount sib)-               else Nothing-      return (u, (Q.payee pstg, ac))-    toPstg i = case i of { C.Transaction t -> Just t; _ -> Nothing }---- | Given a UNumber and the maps, looks up the payee and account--- information from previous transactions if this information is--- available.-guessInfo-  :: (Y.Desc -> Y.Payee -> L.Payee)-  -> UNumberLookupMap-  -> PyeLookupMap-  -> Y.Posting-  -> (Maybe L.Payee, Maybe L.Account)-guessInfo getPye mu mp p = fromMaybe (Nothing, Nothing) $ do-  let pstgPayee = getPye (Y.desc p) (Y.payee p)-  unums <- M.lookup pstgPayee mu-  findFirstKey mp unums

@@ -1,65 +0,0 @@--- | Prints parsed transactions.------ TODO add support to this and other Brenner components for reading--- from stdin.-module Penny.Brenner.Print (mode) where--import qualified Penny.Brenner.Types as Y-import qualified Penny.Brenner.Util as U-import qualified System.Console.MultiArg as MA-import qualified Control.Monad.Exception.Synchronous as Ex-import Data.Maybe (mapMaybe)--help :: String -> String-help pn = unlines-  [ "usage: " ++ pn ++ "  [global-options] print [local-options] FILE..."-  , "Parses the transactions in each FILE using the appropriate parser"-  , "and prints the parse result to standard output."-  , ""-  , "Local options:"-  , "  --help, -h Show this help and exit."-  ]--data Arg-  = ArgFile String-  deriving (Eq, Show)--mode-  :: Maybe Y.FitAcct-  -> MA.Mode (IO ())-mode mayFa = MA.Mode-  { MA.mName = "print"-  , MA.mIntersperse = MA.Intersperse-  , MA.mOpts = []-  , MA.mPosArgs = ArgFile-  , MA.mProcess = processor mayFa-  , MA.mHelp = help-  }--processor-  :: Maybe Y.FitAcct-  -> [Arg]-  -> IO ()-processor mayFa ls =-  case mayFa of-    Nothing -> fail $-      "no financial institution account"-      ++ " provided on command line, and no account"-      ++ " configured by default."-    Just fa -> doPrint (snd . Y.parser $ fa) ls--doPrint-  :: (Y.FitFileLocation -> IO (Ex.Exceptional String [Y.Posting]))-  -> [Arg]-  -> IO ()-doPrint prsr ls = mapM_ f . mapMaybe toFile $ ls-  where-    f file = do-      r <- prsr file-      case r of-        Ex.Exception s -> do-          fail $ "penny-fit print: error: " ++ s-        Ex.Success ps -> mapM putStr . map U.showPosting $ ps-    toFile a = case a of-      ArgFile s -> Just (Y.FitFileLocation s)-

@@ -1,298 +0,0 @@-module Penny.Brenner.Types-  ( Date(..)-  , IncDec(..)-  , UNumber(..)-  , FitId(..)-  , Payee(..)-  , Desc(..)-  , Amount(unAmount)-  , mkAmount-  , translate-  , DbMap-  , DbList-  , Posting(..)-  , DbLocation(..)-  , Name(..)-  , PennyAcct(..)-  , Translator(..)-  , DefaultAcct(..)-  , Currency(..)-  , FitAcct(..)-  , Config(..)-  , FitFileLocation(..)-  , AllowNew(..)-  ) where--import Control.Applicative ((<$>), (<*>))-import qualified Control.Monad.Exception.Synchronous as Ex-import qualified Data.Map as M-import qualified Data.Time as Time-import qualified Penny.Copper.Render as R-import qualified Penny.Lincoln as L-import Data.Text (Text, pack, unpack)-import qualified Data.Text.Encoding as E-import qualified Data.Serialize as S---- | The date reported by the financial institution.-newtype Date = Date { unDate :: Time.Day }-  deriving (Eq, Show, Ord, Read)--instance S.Serialize Date where-  put = S.put . show . unDate-  get = Date <$> (read <$> S.get)---- | Reports changes in account balances. Avoids using /debit/ and--- /credit/ as these terms are used differently by the bank than in--- your ledger (that is, the bank reports it from their perspective,--- not yours) so instead the terms /increase/ and /decrease/ are--- used. IncDec is used to record the bank's transactions so--- /increase/ and /decrease/ are used in the same way you would see--- them on a bank statement, whether it's a credit card, loan,--- checking account, etc.-data IncDec-  = Increase-  -- ^ Increases the account balance. For a checking or savings-  -- account, this is a deposit. For a credit card, this is a purchase.--  | Decrease-  -- ^ Decreases the account balance. On a credit card, this is a-  -- payment. On a checking account, this is a withdrawal.-  deriving (Eq, Show, Read)--instance S.Serialize IncDec where-  put x = case x of-    Increase -> S.putWord8 0-    Decrease -> S.putWord8 1-  get = S.getWord8 >>= f-    where-      f x = case x of-        0 -> return Increase-        1 -> return Decrease-        _ -> fail "read IncDec error"---- | A unique number assigned by Brenner to identify each--- posting. This is unique within a particular financial institution--- account only.-newtype UNumber = UNumber { unUNumber :: Integer }-  deriving (Eq, Show, Ord, Read)--instance S.Serialize UNumber where-  put = S.put . unUNumber-  get = UNumber <$> S.get--putText :: Text -> S.Put-putText = S.put . E.encodeUtf8--getText :: S.Get Text-getText = S.get >>= f-  where-    f bs = case E.decodeUtf8' bs of-      Left _ -> fail "text reading failed"-      Right x -> return x----- | For Brenner to work, the bank has to assign unique identifiers to--- each transaction that it gives you for download. This is the--- easiest reliable way to ensure duplicates are not processed--- multiple times. (There are other ways to accomplish this, but they--- are much harder and less reliable.) If the bank does not do this,--- you can't use Brenner.-newtype FitId = FitId { unFitId :: Text }-  deriving (Eq, Show, Ord, Read)--instance S.Serialize FitId where-  put = putText . unFitId-  get = FitId <$> getText---- | Some financial institutions assign a separate Payee in addition--- to a description. Others just have a single Description field. If--- this institution uses both, put something here. Brenner will prefer--- the Payee if it is not zero length; then it will use the Desc.-newtype Payee = Payee { unPayee :: Text }-  deriving (Eq, Show, Ord, Read)--instance S.Serialize Payee where-  put = putText . unPayee-  get = Payee <$> getText---- | The transaction description. Some institutions assign only a--- description (sometimes muddling a payee with long codes, some--- dates, etc). Brenner prefers the Payee if there is one, and uses a--- Desc otherwise.-newtype Desc =-  Desc { unDesc :: Text }-  deriving (Eq, Show, Ord, Read)--instance S.Serialize Desc where-  put = putText . unDesc-  get = Desc <$> getText---- | The amount of the transaction. Do not include any leading plus or--- minus signs; this should be only digits and a decimal point.-newtype Amount = Amount { unAmount :: Text }-  deriving (Eq, Show, Ord, Read)--instance S.Serialize Amount where-  put = putText . unAmount-  get = getText >>= f-    where-      f x = case mkAmount . unpack $ x of-        Nothing -> fail $ "failed to load amount: " ++ unpack x-        Just a -> return a---- | Ensures that incoming Amounts have only digits and (up to) one--- decimal point.-mkAmount :: String -> Maybe Amount-mkAmount s =-  let isDigit c = c >= '0' && c <= '9'-      (_, rs) = span isDigit s-  in case rs of-      "" -> if not . null $ s-            then return . Amount . pack $ s-            else Nothing-      '.':rest -> if all isDigit rest-                  then return . Amount . pack $ s-                  else Nothing-      _ -> Nothing--translate-  :: IncDec-  -> Translator-  -> L.DrCr-translate Increase IncreaseIsDebit = L.Debit-translate Increase IncreaseIsCredit = L.Credit-translate Decrease IncreaseIsDebit = L.Credit-translate Decrease IncreaseIsCredit = L.Debit--type DbMap = M.Map UNumber Posting-type DbList = [(UNumber, Posting)]--data Posting = Posting-  { date :: Date-  , desc :: Desc-  , incDec :: IncDec-  , amount :: Amount-  , payee :: Payee-  , fitId :: FitId-  } deriving (Read, Show)---instance S.Serialize Posting where-  put x = S.put (date x)-          >> S.put (desc x)-          >> S.put (incDec x)-          >> S.put (amount x)-          >> S.put (payee x)-          >> S.put (fitId x)-  get = Posting-        <$> S.get-        <*> S.get-        <*> S.get-        <*> S.get-        <*> S.get-        <*> S.get---- | Where is the database of postings?-newtype DbLocation = DbLocation { unDbLocation :: Text }-  deriving (Eq, Show)---- | A name used to refer to a batch of settings.-newtype Name = Name { unName :: Text }-  deriving (Eq, Show)---- | The Penny account holding postings for this financial--- institution. For instance it might be @Assets:Checking@ if this is--- your checking account, @Liabilities:Credit Card@, or whatever.-newtype PennyAcct = PennyAcct { unPennyAcct :: L.Account }-  deriving (Eq, Show)---- | What the financial institution shows as an increase or decrease--- has to be recorded as a debit or credit in the PennyAcct.-data Translator-  = IncreaseIsDebit-  -- ^ That is, when the financial institution shows a posting that-  -- increases your account balance, you record a debit. You will-  -- probably use this for deposit accounts, like checking and-  -- savings. These are asset accounts so if the balance goes up you-  -- record a debit in your ledger.--  | IncreaseIsCredit-  -- ^ That is, when the financial institution shows a posting that-  -- increases your account balance, you record a credit. You will-  -- probably use this for liabilities, such as credit cards and other-  -- loans.--  deriving (Eq, Show)---- | The default account to place unclassified postings in. For--- instance @Expenses:Unclassified@.-newtype DefaultAcct = DefaultAcct { unDefaultAcct :: L.Account }-  deriving (Eq, Show)---- | The currency for all transactions, e.g. @$@.-newtype Currency = Currency { unCurrency :: L.Commodity }-  deriving (Eq, Show)---- | A batch of settings representing a single financial institution--- account.-data FitAcct = FitAcct-  { dbLocation :: DbLocation-  , pennyAcct :: PennyAcct-  , defaultAcct :: DefaultAcct-  , currency :: Currency-  , groupSpecs :: R.GroupSpecs-  , translator :: Translator--  , side :: L.Side-  -- ^ When creating new transactions, the commodity will be on this-  -- side--  , spaceBetween :: L.SpaceBetween-  -- ^ When creating new transactions, is there a space between the-  -- commodity and the quantity--  , parser :: ( String-              , FitFileLocation -> IO (Ex.Exceptional String [Posting]))-  -- ^ Parses a file of transactions from the financial-  -- institution. The function must open the file and parse it. This-  -- is in the IO monad not only because the function must open the-  -- file itself, but also so the function can perform arbitrary IO-  -- (run pdftotext, maybe?) If there is failure, the function can-  -- return an Exceptional String, which is the error-  -- message. Alternatively the function can raise an exception in the-  -- IO monad (currently Brenner makes no attempt to catch these) so-  -- if any of the IO functions throw you can simply not handle the-  -- exceptions.-  ---  -- The first element of the pair is a help string which should-  -- indicate how to download the data, as a helpful reminder.--  , toLincolnPayee :: Desc -> Payee -> L.Payee-  -- ^ Sometimes the financial institution provides Payee information,-  -- sometimes it does not. Sometimes the Desc might have additional-  -- information that you might want to remove. This function can be-  -- used to do that. The resulting Lincoln Payee is used for any-  -- transactions that are created by the merge command. The resulting-  -- payee is also used when comparing new financial institution-  -- postings to already existing ledger transactions in order to-  -- guess at which payee and accounts to create in the transactions-  -- created by the merge command.--  }---- | Configuration for the Brenner program. You can optionally have--- a default FitAcct, which is used if you do not specify any FitAcct on the--- command line. You can also name any number of additional FitAccts. If--- you do not specify a default FitAcct, you must specify a FitAcct on the--- command line.--data Config = Config-  { defaultFitAcct :: Maybe FitAcct-  , moreFitAccts :: [(Name, FitAcct)]-  }--newtype FitFileLocation = FitFileLocation { unFitFileLocation :: String }-  deriving (Show, Eq)--newtype AllowNew = AllowNew { unAllowNew :: Bool }-  deriving (Show, Eq)

@@ -1,87 +0,0 @@-module Penny.Brenner.Util where--import Control.Monad.Exception.Synchronous as Ex-import qualified Penny.Brenner.Types as Y-import qualified Data.ByteString as BS-import qualified System.IO.Error as IOE-import qualified Data.Serialize as S-import qualified Data.Text as X-import qualified Penny.Copper.Parsec as CP-import qualified Text.Parsec as P-import qualified Penny.Lincoln as L---- | Loads the database from disk. If allowNew is True, then does not--- fail if the file was not found.-loadDb-  :: Y.AllowNew-  -- ^ Is a new file allowed?--  -> Y.DbLocation-  -- ^ DB location--  -> IO Y.DbList-loadDb (Y.AllowNew allowNew) (Y.DbLocation dbLoc) = do-  eiStr <- IOE.tryIOError (BS.readFile . X.unpack $ dbLoc)-  case eiStr of-    Left e ->-      if allowNew && IOE.isDoesNotExistError e-      then return []-      else IOE.ioError e-    Right g -> case readDbTuple g of-      Ex.Exception e -> fail e-      Ex.Success good -> return good---- | File version. Increment this when anything in the file format--- changes.-version :: Int-version = 0--brenner :: String-brenner = "penny.brenner"--readDbTuple-  :: BS.ByteString-  -> Ex.Exceptional String Y.DbList-readDbTuple bs = do-  (s, v, ls) <- Ex.fromEither $ S.decode bs-  Ex.assert "database file format not recognized." $ s == brenner-  Ex.assert "wrong database version." $ v == version-  return ls--saveDbTuple :: Y.DbList -> BS.ByteString-saveDbTuple ls = S.encode (brenner, version, ls)---- | Writes a new database to disk.-saveDb :: Y.DbLocation -> Y.DbList -> IO ()-saveDb (Y.DbLocation p) = BS.writeFile (X.unpack p) . saveDbTuple---- | Parses quantities from amounts. All amounts should be verified as--- having only digits, optionally followed by a point and then more--- digits. All these values should parse. So if there is a problem it--- is a programmer error. Apply error.-parseQty :: Y.Amount -> L.Qty-parseQty a = case P.parse CP.quantity "" (Y.unAmount a) of-  Left e -> error $ "could not parse quantity from string: "-            ++ (X.unpack . Y.unAmount $ a) ++ ": " ++ show e-  Right g -> g--label :: String -> X.Text -> String-label s x = s ++ ": " ++ X.unpack x ++ "\n"---- | Shows a Posting in human readable format.-showPosting :: Y.Posting -> String-showPosting (Y.Posting dt dc nc am py fd) =-  label "Date" (X.pack . show . Y.unDate $ dt)-  ++ label "Description" (Y.unDesc dc)-  ++ label "Type" (X.pack $ case nc of-                    Y.Increase -> "increase"-                    Y.Decrease -> "decrease")-  ++ label "Amount" (Y.unAmount am)-  ++ label "Payee" (Y.unPayee py)-  ++ label "Financial institution ID" (Y.unFitId fd)-  ++ "\n"--showDbPair :: (Y.UNumber, Y.Posting) -> String-showDbPair (Y.UNumber u, p) =-  label "U number" (X.pack . show $ u)-  ++ showPosting p

@@ -1,7 +0,0 @@--- | Cabin - Penny reports------ Cabin contains reports, or functions that take a list of postings--- and return a formatted Text to display data in a human-readable--- format.-module Penny.Cabin where-

@@ -1,21 +0,0 @@--- | Penny balance reports. Currently there are two balance reports:--- the MultiCommodity report, which cannot convert commodities and--- which therefore might show more than one commodity in a single--- report, and the Convert report, which uses price data in the Penny--- file to convert all commodities to a single commodity. The Convert--- report always displays only one commodity per account and this one--- commodity for the whole report.-module Penny.Cabin.Balance where--import qualified Penny.Cabin.Balance.MultiCommodity as MC-import qualified Penny.Cabin.Interface as I-import qualified Penny.Cabin.Balance.Convert as C-import qualified Penny.Cabin.Balance.Convert.Options as ConvOpts---- | The default multi-commodity balance report.-multiCommodity :: I.Report-multiCommodity = MC.defaultReport---- | The default converting balance report.-convert :: I.Report-convert = C.cmdLineReport ConvOpts.defaultOptions

@@ -1,334 +0,0 @@--- | The Convert report. This report converts all account balances to--- a single commodity, which must be specified.--module Penny.Cabin.Balance.Convert (-  Opts(..)-  , Sorter-  , report-  , cmdLineReport-  , getSorter-  ) where--import Control.Applicative ((<$>), (<*>))-import qualified Control.Monad.Exception.Synchronous as Ex-import qualified Data.Tree as E-import qualified Data.Traversable as Tvbl-import qualified Penny.Cabin.Options as CO-import qualified Penny.Cabin.Parsers as CP-import qualified Penny.Cabin.Scheme as Scheme-import qualified Penny.Cabin.Balance.Util as U-import qualified Penny.Cabin.Balance.Convert.Chunker as K-import qualified Penny.Cabin.Balance.Convert.Options as O-import qualified Penny.Cabin.Balance.Convert.Parser as P-import qualified Penny.Cabin.Interface as I-import qualified Penny.Lincoln as L-import qualified Penny.Lincoln.Balance as Bal-import qualified Penny.Liberty as Ly-import qualified Penny.Shield as S-import qualified Data.Either as Ei-import qualified Data.Map as M-import qualified Data.Text as X-import Data.Monoid (mempty, mappend, mconcat)-import qualified System.Console.MultiArg as MA-import qualified System.Console.Rainbow as Rb---- | Options for the Convert report. These are the only options you--- need to use if you are supplying options programatically (as--- opposed to parsing them in from the command line.)-data Opts = Opts-  { balanceFormat :: L.Commodity -> L.Qty -> X.Text-  , showZeroBalances :: CO.ShowZeroBalances-  , sorter :: Sorter-  , target :: L.To-  , dateTime :: L.DateTime-  , textFormats :: Scheme.Changers-  }---- | How to sort each line of the report. Each subaccount has only one--- BottomLine (unlike in the MultiCommodity report, where each--- subaccount may have more than one BottomLine, one for each--- commodity.)-type Sorter =-  (L.SubAccount, L.BottomLine)-  -> (L.SubAccount, L.BottomLine)-  -> Ordering---- | Converts all commodities in a Balance to a single commodity and--- combines all the BottomLines into one. Fails with an error message--- if no conversion data is available.-convertBalance ::-  L.PriceDb-  -> L.DateTime-  -> L.To-  -> L.Balance-  -> Ex.Exceptional X.Text L.BottomLine-convertBalance db dt to bal = fmap mconcat r-  where-    r = mapM (convertOne db dt to) . M.assocs . L.unBalance $ bal---- | Converts a single BottomLine to a new commodity. Fails with an--- error message if no conversion data is available.-convertOne ::-  L.PriceDb-  -> L.DateTime-  -> L.To-  -> (L.Commodity, L.BottomLine)-  -> Ex.Exceptional X.Text L.BottomLine-convertOne db dt to (cty, bl) =-  case bl of-    L.Zero -> return L.Zero-    L.NonZero (L.Column dc qt) -> Ex.mapExceptional e g ex-      where-        ex = L.convert db dt to am-        am = L.Amount qt cty Nothing Nothing-        e = convertError to (L.From cty)-        g r = L.NonZero (L.Column dc r)---- | Creates an error message for conversion errors.-convertError ::-  L.To-  -> L.From-  -> L.PriceDbError-  -> X.Text-convertError (L.To to) (L.From fr) e =-  let fromErr = L.unCommodity fr-      toErr = L.unCommodity to-  in case e of-    L.FromNotFound ->-      X.pack "no data to convert from commodity "-      `X.append` fromErr-    L.ToNotFound ->-      X.pack "no data to convert to commodity "-      `X.append` toErr-    L.CpuNotFound ->-      X.pack "no data to convert from commodity "-      `X.append` fromErr-      `X.append` (X.pack " to commodity ")-      `X.append` toErr-      `X.append` (X.pack " at given date and time")----- | Create a price database.-buildDb :: [L.PricePoint] -> L.PriceDb-buildDb = foldl f L.emptyDb where-  f db pb = L.addPrice db pb---- | All data for the report after all balances have been converted to--- a single commodity and all the sums of the child accounts have been--- added to the parent accounts.-data ForestAndBL = ForestAndBL {-  _tbForest :: E.Forest (L.SubAccount, L.BottomLine)-  , _tbTotal :: L.BottomLine-  , _tbTo :: L.To-  }---- | Converts the balance data in preparation for screen rendering.-rows :: ForestAndBL -> ([K.Row], L.To)-rows (ForestAndBL f tot to) = (first:second:rest, to)-  where-    first = K.ROneCol $ K.OneColRow 0 desc-    desc = X.pack "All amounts reported in commodity: "-           `X.append` (L.unCommodity-                       . L.unTo-                       $ to)-    second = K.RMain $ K.MainRow 0 (X.pack "Total") tot-    rest = map mainRow-           . concatMap E.flatten-           . map U.labelLevels-           $ f---mainRow :: (Int, (L.SubAccount, L.BottomLine)) -> K.Row-mainRow (l, (a, b)) = K.RMain $ K.MainRow l x b-  where-    x = L.text a---- | The function for the Convert report. Use this function if you are--- setting the options from a program (as opposed to parsing them in--- from the command line.) Will fail if the balance conversions fail.-report-  :: Opts-  -> [L.PricePoint]-  -> [L.Box a]-  -> Ex.Exceptional X.Text [Rb.Chunk]-report os@(Opts getFmt _ _ _ _ txtFormats) ps bs = do-  fstBl <- sumConvertSort os ps bs-  let (rs, L.To cy) = rows fstBl-      fmt = getFmt cy-  return $ K.rowsToChunks txtFormats fmt rs----- | Creates a report respecting the standard interface for reports--- whose options are parsed in from the command line.-cmdLineReport-  :: O.DefaultOpts-  -> I.Report-cmdLineReport o rt = (help o, mkMode)-  where-    mkMode _ _ chgrs _ fsf = MA.Mode-      { MA.mName = "convert"-      , MA.mIntersperse = MA.Intersperse-      , MA.mOpts = map (fmap Right) P.allOptSpecs-      , MA.mPosArgs = Left-      , MA.mProcess = process rt chgrs o fsf-      , MA.mHelp = const (help o)-      }--process-  :: S.Runtime-  -> Scheme.Changers-  -> O.DefaultOpts-  -> ([L.Transaction] -> [L.Box Ly.LibertyMeta])-  -> [Either String (P.Opts -> Ex.Exceptional String P.Opts)]-  -> Ex.Exceptional X.Text I.ArgsAndReport-process rt chgrs defaultOpts fsf ls = do-  let (posArgs, parsed) = Ei.partitionEithers ls-      op' = foldl (>>=) (return (O.toParserOpts defaultOpts rt)) parsed-  case op' of-      Ex.Exception s -> Ex.throw . X.pack $ s-      Ex.Success g -> return $-        let noDefault = X.pack "no default price found"-            f = fromParsedOpts chgrs g-            pr ts pps = do-              rptOpts <- Ex.fromMaybe noDefault $-                f pps (O.format defaultOpts)-              let boxes = fsf ts-              report rptOpts pps boxes-        in (posArgs, pr)----- | Sums the balances from the bottom to the top of the tree (so that--- parent accounts have the sum of the balances of all their--- children.) Then converts the commodities to a single commodity, and--- sorts the accounts as requested. Fails if the conversion fails.-sumConvertSort-  :: Opts-  -> [L.PricePoint]-  -> [L.Box a]-  -> Ex.Exceptional X.Text ForestAndBL-sumConvertSort os ps bs = mkResult <$> convertedFrst <*> convertedTot-  where-    (Opts _ szb str tgt dt _) = os-    bals = U.balances szb bs-    (frst, tot) = U.sumForest mempty mappend bals-    convertBal (a, bal) =-        (\bl -> (a, bl)) <$> convertBalance db dt tgt bal-    db = buildDb ps-    convertedFrst = mapM (Tvbl.mapM convertBal) frst-    convertedTot = convertBalance db dt tgt tot-    mkResult f t = ForestAndBL (U.sortForest str f) t tgt---- | Determine the most frequent To commodity.-mostFrequent :: [L.PricePoint] -> Maybe L.To-mostFrequent = U.lastMode . map (L.to . L.price)---type DoReport = [L.PricePoint]-               -> (L.Commodity -> L.Qty -> X.Text)-               -> (Maybe Opts)---- | Get options for the report, depending on what options were parsed--- from the command line. Fails if the user did not specify a--- commodity and mostFrequent fails.-fromParsedOpts-  :: Scheme.Changers-  -> P.Opts-  -> DoReport-fromParsedOpts chgrs (P.Opts szb tgt dt so sb) =-  \pps fmt -> case tgt of-    P.ManualTarget to ->-      Just $ Opts fmt szb (getSorter so sb) to dt chgrs-    P.AutoTarget ->-      case mostFrequent pps of-        Nothing -> Nothing-        Just to ->-          Just $ Opts fmt szb (getSorter so sb) to dt chgrs---- | Returns a function usable to sort pairs of SubAccount and--- BottomLine depending on how you want them sorted.-getSorter :: CP.SortOrder -> P.SortBy -> Sorter-getSorter o b = flipper f-  where-    flipper = case o of-      CP.Ascending -> id-      CP.Descending ->-        \g p1 p2 -> case g p1 p2 of-            LT -> GT-            GT -> LT-            EQ -> EQ-    f p1@(a1, _) p2@(a2, _) = case b of-      P.SortByName -> compare a1 a2-      P.SortByQty -> cmpBottomLine p1 p2--cmpBottomLine :: Sorter-cmpBottomLine (n1, bl1) (n2, bl2) =-  case (bl1, bl2) of-    (L.Zero, L.Zero) -> EQ-    (L.NonZero _, L.Zero) -> LT-    (L.Zero, L.NonZero _) -> GT-    (L.NonZero c1, L.NonZero c2) ->-      mconcat [dc, qt, na]-      where-        dc = case (Bal.drCr c1, Bal.drCr c2) of-          (L.Debit, L.Debit) -> EQ-          (L.Debit, L.Credit) -> LT-          (L.Credit, L.Debit) -> GT-          (L.Credit, L.Credit) -> EQ-        qt = compare (Bal.qty c1) (Bal.qty c2)-        na = compare n1 n2----------------------------------------------------------------- ## Help--------------------------------------------------------------ifDefault :: Bool -> String-ifDefault b = if b then " (default)" else ""--help :: O.DefaultOpts -> String-help o = unlines $-  [ "convert"-  , "  Show account balances, after converting all amounts"-  , "  to a single commodity. Accepts ONLY the following options:"-  , ""-  , "--show-zero-balances"-  , "  Show balances that are zero"-    ++ ifDefault (CO.unShowZeroBalances . O.showZeroBalances $ o)-  , "--hide-zero-balances"-  , "  Hide balances that are zero"-    ++ ifDefault (not . CO.unShowZeroBalances . O.showZeroBalances $ o)-  , ""-  , "--commodity TARGET-COMMMODITY, -c TARGET-COMMODITY"-  , "  Convert all commodities to TARGET-COMMODITY."-  ] ++ case O.target o of-        P.ManualTarget (L.To cy) ->-          [ "  default: " ++ (X.unpack . L.unCommodity $ cy) ]-        _ -> []-    ++-  [ "--auto-commodity"-  , "  convert all commodities to the commodity that appears most"-  , "  often as the target commodity in your price data. If"-  , "  there is a tie, the price closest to the end of your list"-  , "  of prices is used."-    ++ case O.target o of-        P.AutoTarget -> " (default)"-        _ -> ""-  , ""-  , "--date DATE-TIME, -d DATE-TIME"-  , "  Convert prices as of the date and time given"-  , "  (by default, the current date and time is used.)"-  , ""-  , "--sort qty|name, -s qty|name"-  , "  Sort balances by sub-account name"-    ++ ifDefault (O.sortBy o == P.SortByName)-    ++ " or by quantity"-    ++ ifDefault (O.sortBy o == P.SortByQty)-  , "--ascending"-  , "  Sort in ascending order"-    ++ ifDefault (O.sortOrder o == CP.Ascending)-  , "--descending"-  , "  Sort in descending order"-    ++ ifDefault (O.sortOrder o == CP.Descending)-  , ""-  , "--help, -h"-  , "  Show this help and exit"-  ]-

@@ -1,239 +0,0 @@--- | Creates the output Chunks for the Balance report for--- multi-commodity reports only.--module Penny.Cabin.Balance.Convert.Chunker (-  MainRow(..),-  OneColRow(..),-  Row(..),-  rowsToChunks-  ) where---import Control.Applicative-  (Applicative (pure), (<$>), (<*>))-import qualified Penny.Cabin.Scheme as E-import qualified Penny.Cabin.Meta as Meta-import qualified Penny.Cabin.Row as R-import qualified Penny.Lincoln as L-import qualified Data.Foldable as Fdbl-import qualified Data.Text as X-import qualified System.Console.Rainbow as Rb--type IsEven = Bool--data Columns a = Columns {-  acct :: a-  , drCr :: a-  , quantity :: a-  } deriving Show--instance Functor Columns where-  fmap f c = Columns {-    acct = f (acct c)-    , drCr = f (drCr c)-    , quantity = f (quantity c)-    }--instance Applicative Columns where-  pure a = Columns a a a-  fn <*> fa = Columns {-    acct = (acct fn) (acct fa)-    , drCr = (drCr fn) (drCr fa)-    , quantity = (quantity fn) (quantity fa)-     }--data PreSpec = PreSpec {-  _justification :: R.Justification-  , _padSpec :: (E.Label, E.EvenOdd)-  , bits :: Rb.Chunk }---- | When given a list of columns, determine the widest row in each--- column.-maxWidths :: [Columns PreSpec] -> Columns R.Width-maxWidths = Fdbl.foldl' maxWidthPerColumn (pure (R.Width 0))---- | Applied to a Columns of PreSpec and a Colums of widths, return a--- Columns that has the wider of the two values.-maxWidthPerColumn ::-  Columns R.Width-  -> Columns PreSpec-  -> Columns R.Width-maxWidthPerColumn w p = f <$> w <*> p where-  f old new = max old (R.Width . X.length . Rb.chunkText . bits $ new)---- | Changes a single set of Columns to a set of ColumnSpec of the--- given width.-preSpecToSpec ::-  Columns R.Width-  -> Columns PreSpec-  -> Columns R.ColumnSpec-preSpecToSpec ws p = f <$> ws <*> p where-  f width (PreSpec j ps bs) = R.ColumnSpec j width ps [bs]--resizeColumnsInList :: [Columns PreSpec] -> [Columns R.ColumnSpec]-resizeColumnsInList cs = map (preSpecToSpec w) cs where-  w = maxWidths cs---widthSpacerAcct :: Int-widthSpacerAcct = 4--widthSpacerDrCr :: Int-widthSpacerDrCr = 1--colsToBits-  :: E.Changers-  -> IsEven-  -> Columns R.ColumnSpec-  -> [Rb.Chunk]-colsToBits chgrs isEven (Columns a dc q) = let-  fillSpec = if isEven-             then (E.Other, E.Even)-             else (E.Other, E.Odd)-  spacer w = R.ColumnSpec j (R.Width w) fillSpec []-  j = R.LeftJustify-  cs = a-       : spacer widthSpacerAcct-       : dc-       : spacer widthSpacerDrCr-       : q-       : []-  in R.row chgrs cs--colsListToBits-  :: E.Changers-  -> [Columns R.ColumnSpec]-  -> [[Rb.Chunk]]-colsListToBits chgrs = zipWith f bools where-  f b c = colsToBits chgrs b c-  bools = iterate not True--preSpecsToBits-  :: E.Changers-  -> [Columns PreSpec]-  -> [Rb.Chunk]-preSpecsToBits chgrs =-  concat-  . colsListToBits chgrs-  . resizeColumnsInList--data Row = RMain MainRow | ROneCol OneColRow---- | Displays a one-column row.-data OneColRow = OneColRow {-  ocIndentation :: Int-  -- ^ Indent the text by this many levels (not by this many-  -- spaces; this number is multiplied by another number in the-  -- Chunker source to arrive at the final indentation amount)--  , ocText :: X.Text-  -- ^ Text for the left column-  }---- | Displays a single account in a Balance report. In a--- single-commodity report, this account will only be one screen line--- long. In a multi-commodity report, it might be multiple lines long,--- with one screen line for each commodity.-data MainRow = MainRow {-  mrIndentation :: Int-  -- ^ Indent the account name by this many levels (not by this many-  -- spaces; this number is multiplied by another number in the-  -- Chunker source to arrive at the final indentation amount)--  , mrText :: X.Text-  -- ^ Text for the name of the account--  , mrBottomLine :: L.BottomLine-  -- ^ Commodity balances. If this list is empty, dashes are-  -- displayed for the DrCr and Qty.-  }---rowsToChunks-  :: E.Changers-  -> (L.Qty -> X.Text)-  -- ^ How to format a balance to allow for digit grouping-  -> [Row]-  -> [Rb.Chunk]-rowsToChunks chgrs fmt =-  preSpecsToBits chgrs-  . rowsToColumns chgrs fmt--rowsToColumns-  :: E.Changers-  -> (L.Qty -> X.Text)-  -- ^ How to format a balance to allow for digit grouping--  -> [Row]-  -> [Columns PreSpec]-rowsToColumns chgrs fmt rs = map (mkRow chgrs fmt) pairs-  where-    pairs = Meta.visibleNums (,) rs---mkRow-  :: E.Changers-  -> (L.Qty -> X.Text)-  -> (Meta.VisibleNum, Row)-  -> Columns PreSpec-mkRow chgrs fmt (vn, r) = case r of-  RMain m -> mkMainRow chgrs fmt (vn, m)-  ROneCol c -> mkOneColRow chgrs (vn, c)--mkOneColRow-  :: E.Changers-  -> (Meta.VisibleNum, OneColRow)-  -> Columns PreSpec-mkOneColRow chgrs (vn, (OneColRow i t)) = Columns ca cd cq-  where-    txt = X.append indents t-    indents = X.replicate (indentAmount * max 0 i)-              (X.singleton ' ')-    eo = E.fromVisibleNum vn-    lbl = E.Other-    ca = PreSpec R.LeftJustify (lbl, eo)-         (E.getEvenOddLabelValue lbl eo chgrs $ Rb.plain txt)-    cd = PreSpec R.LeftJustify (lbl, eo)-         (E.getEvenOddLabelValue lbl eo chgrs $ Rb.plain X.empty)-    cq = cd--mkMainRow-  :: E.Changers-  -> (L.Qty -> X.Text)-  -> (Meta.VisibleNum, MainRow)-  -> Columns PreSpec-mkMainRow chgrs fmt (vn, (MainRow i acctTxt b)) = Columns ca cd cq-  where-    applyFmt = E.getEvenOddLabelValue lbl eo chgrs-    eo = E.fromVisibleNum vn-    lbl = E.Other-    ca = PreSpec R.LeftJustify (lbl, eo) (applyFmt (Rb.plain txt))-      where-        txt = X.append indents acctTxt-        indents = X.replicate (indentAmount * max 0 i)-                  (X.singleton ' ')-    cd = PreSpec R.LeftJustify (lbl, eo) (applyFmt cksDrCr)-    cq = PreSpec R.LeftJustify (lbl, eo) (applyFmt cksQty)-    (cksDrCr, cksQty) = balanceChunks chgrs fmt vn b---balanceChunks-  :: E.Changers-  -> (L.Qty -> X.Text)-  -> Meta.VisibleNum-  -> L.BottomLine-  -> (Rb.Chunk, Rb.Chunk)-balanceChunks chgrs fmt vn bl = (chkDc, chkQt)-  where-    eo = E.fromVisibleNum vn-    chkDc = E.bottomLineToDrCr bl eo chgrs-    qtFmt = E.getEvenOddLabelValue lbl eo chgrs-    chkQt = qtFmt $ Rb.plain t-    (lbl, t) = case bl of-      L.Zero -> (E.Zero, X.pack "--")-      L.NonZero (L.Column dc qt) -> (E.dcToLbl dc, fmt qt)---indentAmount :: Int-indentAmount = 2-

@@ -1,43 +0,0 @@--- | Default options for the Convert report when used from the command--- line.-module Penny.Cabin.Balance.Convert.Options where--import qualified Penny.Cabin.Balance.Convert.Parser as P-import qualified Penny.Cabin.Parsers as CP-import qualified Penny.Cabin.Options as CO-import qualified Penny.Lincoln as L-import qualified Penny.Shield as S-import qualified Data.Text as X---- | Default options for the Convert report. This record is used as--- the starting point when parsing in options from the command--- line. You don't need to use it if you are setting the options for--- the Convert report directly from your own code.--data DefaultOpts = DefaultOpts-  { showZeroBalances :: CO.ShowZeroBalances-  , target :: P.Target-  , sortOrder :: CP.SortOrder-  , sortBy :: P.SortBy-  , format :: L.Commodity -> L.Qty -> X.Text-  }--toParserOpts :: DefaultOpts -> S.Runtime -> P.Opts-toParserOpts d rt = P.Opts-  { P.showZeroBalances = showZeroBalances d-  , P.target = target d-  , P.dateTime = S.currentTime rt-  , P.sortOrder = sortOrder d-  , P.sortBy = sortBy d-  }--defaultOptions :: DefaultOpts-defaultOptions = DefaultOpts-  { showZeroBalances = CO.ShowZeroBalances False-  , target = P.AutoTarget-  , sortOrder = CP.Ascending-  , sortBy = P.SortByName-  , format = \_ q -> X.pack . show $ q-  }--

@@ -1,87 +0,0 @@--- | Parsing options for the Convert report from the command line.-module Penny.Cabin.Balance.Convert.Parser (-  Opts(..)-  , Target(..)-  , SortBy(..)-  , allOptSpecs-  ) where---import qualified Control.Monad.Exception.Synchronous as Ex-import qualified Data.Text as X-import qualified Penny.Cabin.Options as CO-import qualified Penny.Cabin.Parsers as P-import qualified Penny.Lincoln as L-import qualified Penny.Copper.Parsec as Pc-import qualified System.Console.MultiArg.Combinator as C-import qualified Text.Parsec as Parsec----- | Is the target commodity determined by the user or automatically?-data Target = AutoTarget | ManualTarget L.To--data SortBy = SortByQty | SortByName deriving (Eq, Show, Ord)---- | Default starting options for the Convert report. After--- considering what is parsed in from the command line and price data,--- a Convert.Opts will be generated.-data Opts = Opts-  { showZeroBalances :: CO.ShowZeroBalances-  , target :: Target-  , dateTime :: L.DateTime-  , sortOrder :: P.SortOrder-  , sortBy :: SortBy-  }---- | Do not be tempted to change the setup in this module so that the--- individual functions such as parseColor and parseBackground return--- parsers rather than OptSpec. Such an arrangement breaks the correct--- parsing of abbreviated long options.-allOptSpecs :: [C.OptSpec (Opts -> Ex.Exceptional String Opts)]-allOptSpecs =-  [ fmap toExc parseZeroBalances-  , parseCommodity-  , fmap toExc parseAuto-  , parseDate-  , fmap toExc parseSort-  , fmap toExc parseOrder ]-  where-    toExc f = return . f--parseZeroBalances :: C.OptSpec (Opts -> Opts)-parseZeroBalances = fmap f P.zeroBalances-  where-    f x o = o { showZeroBalances = x }---parseCommodity :: C.OptSpec (Opts -> Ex.Exceptional String Opts)-parseCommodity = C.OptSpec ["commodity"] "c" (C.OneArg f)-  where-    f a1 os =-      case Parsec.parse Pc.lvl1Cmdty "" (X.pack a1) of-        Left _ -> Ex.throw $ "invalid commodity: " ++ a1-        Right g -> return $ os { target = ManualTarget . L.To $ g }--parseAuto :: C.OptSpec (Opts -> Opts)-parseAuto = C.OptSpec ["auto-commodity"] "" (C.NoArg f)-  where-    f os = os { target = AutoTarget }--parseDate :: C.OptSpec (Opts -> Ex.Exceptional String Opts)-parseDate = C.OptSpec ["date"] "d" (C.OneArg f)-  where-    f a1 os =-      case Parsec.parse Pc.dateTime "" (X.pack a1) of-        Left _ -> Ex.throw $ "invalid date: " ++ a1-        Right g -> return $ os { dateTime = g }--parseSort :: C.OptSpec (Opts -> Opts)-parseSort = C.OptSpec ["sort"] "s" (C.ChoiceArg ls)-  where-    ls = [ ("qty", (\os -> os { sortBy = SortByQty }))-         , ("name", (\os -> os { sortBy = SortByName })) ]--parseOrder :: C.OptSpec (Opts -> Opts)-parseOrder = fmap f P.order-  where-    f x o = o { sortOrder = x }

@@ -1,177 +0,0 @@--- | The multi-commodity Balance report. This is the simpler balance--- report because it does not allow for commodities to be converted.--module Penny.Cabin.Balance.MultiCommodity (-  Opts(..),-  defaultOpts,-  defaultParseOpts,-  defaultFormat,-  parseReport,-  defaultReport,-  report-  ) where--import Control.Applicative (Applicative, pure)-import qualified Penny.Cabin.Balance.Util as U-import qualified Penny.Cabin.Scheme as E-import qualified Penny.Cabin.Scheme.Schemes as Schemes-import qualified Penny.Lincoln as L-import qualified Penny.Liberty as Ly-import qualified Data.Either as Ei-import qualified Data.Map as M-import qualified Penny.Cabin.Options as CO-import Data.Monoid (mappend, mempty)-import qualified Data.Text as X-import qualified Data.Tree as E-import qualified Penny.Cabin.Balance.MultiCommodity.Chunker as K-import qualified Penny.Cabin.Balance.MultiCommodity.Parser as P-import qualified Penny.Cabin.Interface as I-import qualified Penny.Cabin.Parsers as CP-import qualified System.Console.MultiArg as MA-import qualified System.Console.Rainbow as R---- | Options for making the balance report. These are the only options--- needed to make the report if the options are not being parsed in--- from the command line.-data Opts = Opts-  { balanceFormat :: L.Commodity -> L.Qty -> X.Text-  , showZeroBalances :: CO.ShowZeroBalances-  , order :: L.SubAccount -> L.SubAccount -> Ordering-  , textFormats :: E.Changers-  }--defaultOpts :: Opts-defaultOpts = Opts-  { balanceFormat = defaultFormat-  , showZeroBalances = CO.ShowZeroBalances True-  , order = compare-  , textFormats = Schemes.darkLabels-  }--defaultParseOpts :: P.ParseOpts-defaultParseOpts = P.ParseOpts-  { P.showZeroBalances = CO.ShowZeroBalances False-  , P.order = CP.Ascending-  }--fromParseOpts-  :: E.Changers-  -> (L.Commodity -> L.Qty -> X.Text)-  -> P.ParseOpts-  -> Opts-fromParseOpts chgrs fmt (P.ParseOpts szb o) = Opts fmt szb o' chgrs-  where-    o' = case o of-       CP.Ascending -> compare-       CP.Descending -> CO.descending compare--defaultFormat :: a -> L.Qty -> X.Text-defaultFormat _ = X.pack . show--summedSortedBalTree ::-  CO.ShowZeroBalances-  -> (L.SubAccount -> L.SubAccount -> Ordering)-  -> [L.Box a]-  -> (E.Forest (L.SubAccount, L.Balance), L.Balance)-summedSortedBalTree szb o =-  U.sumForest mempty mappend-  . U.sortForest o'-  . U.balances szb-  where-    o' x y = o (fst x) (fst y)--rows ::-  (E.Forest (L.SubAccount, L.Balance), L.Balance)-  -> [K.Row]-rows (o, b) = first:rest-  where-    first = K.Row 0 (X.pack "Total") (M.assocs . L.unBalance $ b)-    rest = map row . concatMap E.flatten . map U.labelLevels $ o-    row (l, (s, ib)) =-      K.Row l (L.text s) (M.assocs . L.unBalance $ ib)---- | This report is what to use if you already have your options (that--- is, you are not parsing them in from the command line.)-report :: Opts -> [L.Box a] -> [R.Chunk]-report (Opts bf szb o chgrs) =-  K.rowsToChunks chgrs bf-  . rows-  . summedSortedBalTree szb o---- | The MultiCommodity report with configurable options that have--- been parsed from the command line.-parseReport ::-  (L.Commodity -> L.Qty -> X.Text)-  -- ^ How to format balances. For instance you can use this to-  -- perform commodity-sensitive digit grouping.--  -> P.ParseOpts-  -- ^ Default options for the report. These can be overriden on the-  -- command line.--  -> I.Report-parseReport fmt o rt = (help o, makeMode)-  where-    makeMode _ _ chgrs _ fsf = MA.Mode-      { MA.mName = "balance"-      , MA.mIntersperse = MA.Intersperse-      , MA.mOpts = map (fmap Right) P.allSpecs-      , MA.mPosArgs = Left-      , MA.mProcess = process chgrs fmt o rt fsf-      , MA.mHelp = const (help o)-      }--process-  :: Applicative f-  => E.Changers-  -> (L.Commodity -> L.Qty -> X.Text)-  -> P.ParseOpts-  -> a-  -> ([L.Transaction] -> [L.Box Ly.LibertyMeta])-  -> [Either String (P.ParseOpts -> P.ParseOpts)]-  -> f I.ArgsAndReport-process chgrs fmt o _ fsf ls =-  let (posArgs, fns) = Ei.partitionEithers ls-      mkParsedOpts = foldl (flip (.)) id fns-      os' = mkParsedOpts o-      mcOpts = fromParseOpts chgrs fmt os'-      pr txns _ = return $ report mcOpts (fsf txns)-  in pure (posArgs, pr)----- | The MultiCommodity report, with default options.-defaultReport :: I.Report-defaultReport = parseReport defaultFormat defaultParseOpts----------------------------------------------------------------- ## Help--------------------------------------------------------------ifDefault :: Bool -> String-ifDefault b = if b then " (default)" else ""--help :: P.ParseOpts -> String-help o = unlines-  [ "balance"-  , "  Show account balances. Accepts ONLY the following options:"-  , ""-  , "--show-zero-balances"-  , "  Show balances that are zero"-    ++ ifDefault (CO.unShowZeroBalances . P.showZeroBalances $ o)-  , "--hide-zero-balances"-  , "  Hide balances that are zero"-    ++ ifDefault ( not . CO.unShowZeroBalances-                 . P.showZeroBalances $ o)-  , ""-  , "--ascending"-  , "  Sort in ascending order by account name"-    ++ ifDefault (P.order o == CP.Ascending)--  , "--descending"-  , "  Sort in descending order by account name"-    ++ ifDefault (P.order o == CP.Descending)--  , ""-  , "--help, -h"-  , "  Show this help and exit"-  ]-

@@ -1,222 +0,0 @@--- | Creates the output Chunks for the Balance report for both--- multi-commodity reports.--module Penny.Cabin.Balance.MultiCommodity.Chunker (-  Row(..),-  rowsToChunks-  ) where---import Control.Applicative-  (Applicative (pure), (<$>), (<*>))-import qualified Penny.Cabin.Meta as Meta-import qualified Penny.Cabin.Row as R-import qualified Penny.Cabin.Scheme as E-import qualified Penny.Lincoln as L-import qualified Data.Foldable as Fdbl-import qualified Data.Text as X-import qualified System.Console.Rainbow as Rb--type IsEven = Bool--data Columns a = Columns {-  acct :: a-  , drCr :: a-  , commodity :: a-  , quantity :: a-  } deriving Show--instance Functor Columns where-  fmap f c = Columns {-    acct = f (acct c)-    , drCr = f (drCr c)-    , commodity = f (commodity c)-    , quantity = f (quantity c)-    }--instance Applicative Columns where-  pure a = Columns a a a a-  fn <*> fa = Columns {-    acct = (acct fn) (acct fa)-    , drCr = (drCr fn) (drCr fa)-    , commodity = (commodity fn) (commodity fa)-    , quantity = (quantity fn) (quantity fa)-     }--data PreSpec = PreSpec {-  _justification :: R.Justification-  , _padSpec :: (E.Label, E.EvenOdd)-  , bits :: [Rb.Chunk] }---- | When given a list of columns, determine the widest row in each--- column.-maxWidths :: [Columns PreSpec] -> Columns R.Width-maxWidths = Fdbl.foldl' maxWidthPerColumn (pure (R.Width 0))---- | Applied to a Columns of PreSpec and a Colums of widths, return a--- Columns that has the wider of the two values.-maxWidthPerColumn ::-  Columns R.Width-  -> Columns PreSpec-  -> Columns R.Width-maxWidthPerColumn w p = f <$> w <*> p where-  f old new = max old ( safeMaximum (R.Width 0)-                        . map (R.Width . X.length . Rb.chunkText)-                        . bits $ new)-  safeMaximum d ls = if null ls then d else maximum ls---- | Changes a single set of Columns to a set of ColumnSpec of the--- given width.-preSpecToSpec ::-  Columns R.Width-  -> Columns PreSpec-  -> Columns R.ColumnSpec-preSpecToSpec ws p = f <$> ws <*> p where-  f width (PreSpec j ps bs) = R.ColumnSpec j width ps bs--resizeColumnsInList :: [Columns PreSpec] -> [Columns R.ColumnSpec]-resizeColumnsInList cs = map (preSpecToSpec w) cs where-  w = maxWidths cs----- Step 9-widthSpacerAcct :: Int-widthSpacerAcct = 4--widthSpacerDrCr :: Int-widthSpacerDrCr = 1--widthSpacerCommodity :: Int-widthSpacerCommodity = 1--colsToBits-  :: E.Changers-  -> IsEven-  -> Columns R.ColumnSpec-  -> [Rb.Chunk]-colsToBits chgrs isEven (Columns a dc c q) = let-  fillSpec = if isEven-             then (E.Other, E.Even)-             else (E.Other, E.Odd)-  spacer w = R.ColumnSpec j (R.Width w) fillSpec []-  j = R.LeftJustify-  cs = a-       : spacer widthSpacerAcct-       : dc-       : spacer widthSpacerDrCr-       : c-       : spacer widthSpacerCommodity-       : q-       : []-  in R.row chgrs cs--colsListToBits-  :: E.Changers-  -> [Columns R.ColumnSpec]-  -> [[Rb.Chunk]]-colsListToBits chgrs = zipWith f bools where-  f b c = colsToBits chgrs b c-  bools = iterate not True--preSpecsToBits-  :: E.Changers-  -> [Columns PreSpec]-  -> [Rb.Chunk]-preSpecsToBits chgrs =-  concat-  . colsListToBits chgrs-  . resizeColumnsInList---- | Displays a single account in a Balance report. In a--- single-commodity report, this account will only be one screen line--- long. In a multi-commodity report, it might be multiple lines long,--- with one screen line for each commodity.-data Row = Row-  { indentation :: Int-  -- ^ Indent the account name by this many levels (not by this many-  -- spaces; this number is multiplied by another number in the-  -- Chunker source to arrive at the final indentation amount)--  , accountTxt :: X.Text-    -- ^ Text for the name of the account--  , balances :: [(L.Commodity, L.BottomLine)]-    -- ^ Commodity balances. If this list is empty, dashes are-    -- displayed for the DrCr, Commodity, and Qty.-  }--rowsToChunks-  :: E.Changers-  -> (L.Commodity -> L.Qty -> X.Text)-  -- ^ How to format a balance to allow for digit grouping-  -> [Row]-  -> [Rb.Chunk]-rowsToChunks chgrs fmt =-  preSpecsToBits chgrs-  . rowsToColumns chgrs fmt--rowsToColumns-  :: E.Changers-  -> (L.Commodity -> L.Qty -> X.Text)-  -- ^ How to format a balance to allow for digit grouping--  -> [Row]-  -> [Columns PreSpec]-rowsToColumns chgrs fmt rs = map (mkColumn chgrs fmt) pairs-  where-    pairs = Meta.visibleNums (,) rs---mkColumn-  :: E.Changers-  -> (L.Commodity -> L.Qty -> X.Text)-  -> (Meta.VisibleNum, Row)-  -> Columns PreSpec-mkColumn chgrs fmt (vn, (Row i acctTxt bs)) = Columns ca cd cc cq-  where-    lbl = E.Other-    eo = E.fromVisibleNum vn-    applyFmt = E.getEvenOddLabelValue lbl eo chgrs-    ca = PreSpec R.LeftJustify (lbl, eo) [applyFmt $ Rb.plain txt]-      where-        txt = X.append indents acctTxt-        indents = X.replicate (indentAmount * max 0 i)-                  (X.singleton ' ')-    cd = PreSpec R.LeftJustify (lbl, eo) cksDrCr-    cc = PreSpec R.RightJustify (lbl, eo) cksCmdty-    cq = PreSpec R.LeftJustify (lbl, eo) cksQty-    (cksDrCr, cksCmdty, cksQty) =-      if null bs-      then balanceChunksEmpty chgrs eo-      else-        let balChks = map (balanceChunks chgrs fmt eo) bs-            cDrCr = map (\(a, _, _) -> a) balChks-            cCmdty = map (\(_, a, _) -> a) balChks-            cQty = map (\(_, _, a) -> a) balChks-        in (cDrCr, cCmdty, cQty)---balanceChunksEmpty-  :: E.Changers-  -> E.EvenOdd-  -> ([Rb.Chunk], [Rb.Chunk], [Rb.Chunk])-balanceChunksEmpty chgrs eo = (dash, dash, dash)-  where-    dash = [E.getEvenOddLabelValue E.Other eo chgrs $ Rb.plain (X.pack "--")]--balanceChunks-  :: E.Changers-  -> (L.Commodity -> L.Qty -> X.Text)-  -> E.EvenOdd-  -> (L.Commodity, L.BottomLine)-  -> (Rb.Chunk, Rb.Chunk, Rb.Chunk)-balanceChunks chgrs fmt eo (cty, bl) = (chkDc, chkCt, chkQt)-  where-    chkDc = E.bottomLineToDrCr bl eo chgrs-    chkCt = E.bottomLineToCmdty chgrs eo (cty, bl)-    chkQt = E.bottomLineToQty chgrs fmt eo (cty, bl)---indentAmount :: Int-indentAmount = 2-

@@ -1,29 +0,0 @@-module Penny.Cabin.Balance.MultiCommodity.Parser (-  ParseOpts(..)-  , allSpecs-  ) where--import qualified Penny.Cabin.Options as CO-import qualified Penny.Cabin.Parsers as P-import qualified System.Console.MultiArg as MA---- | Options for the Balance report that have been parsed from the--- command line.-data ParseOpts = ParseOpts-  { showZeroBalances :: CO.ShowZeroBalances-  , order :: P.SortOrder-  }---zeroBalances :: MA.OptSpec (ParseOpts -> ParseOpts)-zeroBalances = fmap toResult P.zeroBalances-  where-    toResult szb o = o { showZeroBalances = szb }--parseOrder :: MA.OptSpec (ParseOpts -> ParseOpts)-parseOrder = fmap toResult P.order-  where-    toResult x o = o { order = x }--allSpecs :: [MA.OptSpec (ParseOpts -> ParseOpts)]-allSpecs = [zeroBalances, parseOrder]

@@ -1,228 +0,0 @@--- | Grab bag of utility functions.--module Penny.Cabin.Balance.Util-  ( tieredForest-  , tieredPostings-  , filterForest-  , balances-  , flatten-  , treeWithParents-  , forestWithParents-  , sumForest-  , sumTree-  , boxesBalance-  , labelLevels-  , sortForest-  , sortTree-  , lastMode-  ) where--import qualified Penny.Cabin.Options as CO-import qualified Penny.Lincoln as L-import qualified Penny.Steel.NestedMap as NM-import qualified Data.Foldable as Fdbl-import qualified Data.Map as M-import Data.Ord (comparing)-import Data.List (sortBy, maximumBy, groupBy)-import Data.Monoid (mconcat, Monoid)-import Data.Maybe (mapMaybe)-import qualified Data.Tree as T-import qualified Penny.Lincoln.Queries as Q---- | Constructs a forest sorted into tiers based on lists of keys that--- are extracted from the elements.-tieredForest ::-  Ord k-  => (a -> [k])-  -- ^ Extracts a key from the elements we are putting in the tree. If-  -- this function returns an empty list for any element, the element-  -- will not appear in the tiered forest.-  -> [a]-  -> T.Forest (k, [a])-tieredForest getKeys ls = fmap (fmap revSnd) . NM.toForest $ nm-  where-    revSnd (a, xs) = (a, reverse xs)-    nm = foldr f NM.empty ls-    f a m = NM.relabel m ps-      where-        ps = case getKeys a of-          [] -> []-          ks ->-            let mkInitPair k = (k, maybe [] id)-                mkLastPair k = (k, maybe [a] (a:))-            in (map mkInitPair . init $ ks)-               ++ [(mkLastPair (last ks))]---- | Takes a list of postings and puts them into a Forest. Each level--- of each of the trees corresponds to a sub account. The label of the--- node tells you the sub account name and gives you a list of the--- postings at that level.-tieredPostings :: [L.Box a] -> T.Forest (L.SubAccount, [L.Box a])-tieredPostings = tieredForest e-  where-    e = Fdbl.toList . L.unAccount . Q.account . L.boxPostFam---- | Keeps only Trees that match a given condition. First examines--- child trees to determine whether they should be retained. If a--- child tree is retained, does not delete the parent tree.-filterForest :: (a -> Bool) -> T.Forest a -> T.Forest a-filterForest f = mapMaybe pruneTree-  where-    pruneTree (T.Node a fs) =-      case filterForest f fs of-        [] -> if not (f a) then Nothing else Just (T.Node a [])-        cs -> Just (T.Node a cs)----- | Puts all Boxes into a Tree and sums the balances. Removes--- accounts that have empty balances if requested. Does NOT sum--- balances from the bottom up.-balances ::-  CO.ShowZeroBalances-  -> [L.Box a]-  -> T.Forest (L.SubAccount, L.Balance)-balances (CO.ShowZeroBalances szb) =-  remover-  . map (fmap (mapSnd boxesBalance))-  . tieredPostings-  where-    remover =-      if szb-      then id-      else filterForest (not . M.null . L.unBalance . snd)-           . map (fmap (mapSnd L.removeZeroCommodities))----- | Takes a tree of Balances (like what is produced by the 'balances'--- function) and produces a flat list of accounts with the balance of--- each account.-flatten-  :: T.Forest (L.SubAccount, L.Balance)-  -> [(L.Account, L.Balance)]-flatten =-  concatMap T.flatten-  . map (fmap toPair) . forestWithParents-  where-    toPair ((s, b), ls) =-      case reverse . map fst $ ls of-        [] -> (L.Account [s], b)-        s1:sr -> (L.Account (s1 : (sr ++ [s])), b)---- | Takes a Tree and returns a Tree where each node has information--- about its parent Nodes. The list of parent nodes has the most--- immediate parent first and the most distant parent last.-treeWithParents :: T.Tree a -> T.Tree (a, [a])-treeWithParents = treeWithParentsR []---- | Given a list of the parents seen so far, return a Tree where each--- node contains information about its parents.-treeWithParentsR :: [a] -> T.Tree a -> T.Tree (a, [a])-treeWithParentsR ls (T.Node n cs) = T.Node (n, ls) cs'-  where-    cs' = map (treeWithParentsR (n:ls)) cs---- | Takes a Forest and returns a Forest where each node has--- information about its parent Nodes.-forestWithParents :: T.Forest a -> T.Forest (a, [a])-forestWithParents = map (treeWithParentsR [])---- | Sums a forest from the bottom up. Returns a pair, where the first--- element is the forest, but with the second element of each node--- replaced with the sum of that node and all its children. The second--- element is the sum of all the second elements in the forest.-sumForest ::-  s-  -- ^ Zero--  -> (s -> s -> s)-  -- ^ Combiner--  -> T.Forest (a, s)-  -> (T.Forest (a, s), s)-sumForest z f ts = (ts', s)-  where-    ts' = map (sumTree z f) ts-    s = foldr f z . map (snd . T.rootLabel) $ ts'---- | Sums a tree from the bottom up.-sumTree ::-  s-  -- ^ Zero--  -> (s -> s -> s)-  -- ^ Combiner--  ->  T.Tree (a, s)-  -> T.Tree (a, s)-sumTree z f (T.Node (a, s) cs) = T.Node (a, f s cSum) cs'-  where-    (cs', cSum) = sumForest z f cs---boxesBalance :: [L.Box a] -> L.Balance-boxesBalance = mconcat . map L.entryToBalance . map Q.entry-               . map L.boxPostFam--mapSnd :: (a -> b) -> (f, a) -> (f, b)-mapSnd f (x, a) = (x, f a)---- | Label each level of a Tree with an integer indicating how deep it--- is. The top node of the tree is level 0.-labelLevels :: T.Tree a -> T.Tree (Int, a)-labelLevels = go 0-  where-    go l (T.Node x xs) = T.Node (l, x) (map (go (l + 1)) xs)---- | Sorts each level of a Forest.-sortForest ::-  (a -> a -> Ordering)-  -> T.Forest a-  -> T.Forest a-sortForest o f = sortBy o' (map (sortTree o) f)-  where-    o' x y = o (T.rootLabel x) (T.rootLabel y)---- | Sorts each level of a Tree.-sortTree ::-  (a -> a -> Ordering)-  -> T.Tree a-  -> T.Tree a-sortTree o (T.Node l f) = T.Node l (sortForest o f)---- | Like lastModeBy but using Ord.-lastMode :: Ord a => [a] -> Maybe a-lastMode = lastModeBy compare---- | Finds the mode of a list. Takes the mode that is located last in--- the list. Returns Nothing if there is no mode (that is, if the list--- is empty).-lastModeBy ::-  (a -> a -> Ordering)-  -> [a]-  -> Maybe a-lastModeBy o ls =-  case modesBy o' ls' of-    [] -> Nothing-    ms -> Just . fst . maximumBy fx $ ms-    where-      fx = comparing snd-      ls' = zip ls ([0..] :: [Int])-      o' x y = o (fst x) (fst y)---- | Finds the modes of a list.-modesBy :: (a -> a -> Ordering) -> [a] -> [a]-modesBy o =-  concat-  . longestLists-  . groupBy (\x y -> o x y == EQ)-  . sortBy o----- | Returns the longest lists. This function is partial. It is bottom--- if the argument list is empty. Therefore, do not export this--- function.-longestLists :: [[a]] -> [[a]]-longestLists as =-  let lengths = map (\ls -> (ls, length ls)) as-      maxLen = maximum . map snd $ lengths-  in map fst . filter (\(_, len) -> len == maxLen) $ lengths

@@ -1,77 +0,0 @@--- | An interface for other Penny components to use. A report is--- anything that is a 'Report'.-module Penny.Cabin.Interface where--import qualified Data.Prednote.Expressions as Exp-import qualified Penny.Cabin.Scheme as S-import Control.Monad.Exception.Synchronous (Exceptional)-import qualified Data.Text as X-import Text.Matchers (CaseSensitive)-import qualified Text.Matchers as TM-import qualified System.Console.MultiArg as MA-import qualified System.Console.Rainbow as R--import qualified Penny.Lincoln as L-import qualified Penny.Liberty as Ly-import Penny.Shield (Runtime)---- | The function that will print the report, and the positional--- arguments. If there was a problem parsing the command line options,--- return an Exception with an error message.---- | Parsing the filter options can have one of two results: a help--- string, or a list of positional arguments and a function that--- prints a report. Or, the parse might fail.--type PosArg = String-type HelpStr = String-type ArgsAndReport = ([PosArg], PrintReport)---- | The result of parsing the arguments to a report. Failures are--- indicated with a Text. The name of the executable and the word--- @error@ will be prepended to this Text; otherwise, it is printed--- as-is, so be sure to include any trailing newline if needed.-type ParseResult = Exceptional X.Text ArgsAndReport--type PrintReport-  = [L.Transaction]-  -- ^ All transactions; the report must sort and filter them--  -> [L.PricePoint]-  -- ^ PricePoints to be included in the report---  -> Exceptional X.Text [R.Chunk]-  -- ^ The exception type is a strict Text, containing the error--- message. The success type is a list of either a Chunk or a PreChunk--- containing the resulting report. This allows for errors after the--- list of transactions has been seen. The name of the executable and--- the word @error@ will be prepended to this Text; otherwise, it is--- printed as-is, so be sure to include any trailing newline if--- needed.---type Report = Runtime -> (HelpStr, MkReport)-type MkReport-  = CaseSensitive-  -- ^ Result from previous parses indicating whether the user desires-  -- case sensitivity (this may have been changed in the filtering-  -- options)--  -> (CaseSensitive -> X.Text -> Exceptional X.Text TM.Matcher)-  -- ^ Result from previous parsers indicating the matcher factory the-  -- user wishes to use--  -> S.Changers-  -- ^ Result from previous parsers indicating which color scheme to-  -- use.--  -> Exp.ExprDesc-  -- ^ Result from previous parsers indicating whether the user wants-  -- RPN or infix--  -> ([L.Transaction] -> [L.Box Ly.LibertyMeta])-  -- ^ Result from previous parsers that will sort and filter incoming-  -- transactions--  -> MA.Mode ParseResult

@@ -1,38 +0,0 @@--- | Metadata that is specific to Cabin.-module Penny.Cabin.Meta (VisibleNum, unVisibleNum,-                         visibleNumBoxes, visibleNums ) where--import Control.Applicative ((*>))-import qualified Data.Traversable as Tr-import qualified Penny.Lincoln as L---- | Each row that is visible on screen is assigned a VisibleNum. This--- is used to number the rows in the report for the user's benefit. It--- is also used to determine whether the row is even or odd for the--- purpose of assigning the background color (this way the background--- colors can alternate, like a checkbook register.)-newtype VisibleNum = VisibleNum { unVisibleNum :: L.Serial }-                     deriving (Eq, Show)---- | Assigns VisibleNum to a list of boxes.-visibleNumBoxes ::-  (VisibleNum -> a -> b)-  -> [L.Box a]-  -> [L.Box b]-visibleNumBoxes f bs = L.makeSerials k-  where-    k = Tr.sequenceA (replicate (length bs) L.incrementBack)-        *> mapM assign bs-    assign (L.Box m pf) = fmap g L.getSerial-      where-        g ser = L.Box (f (VisibleNum ser) m) pf----- | Assigns VisibleNum to a list.-visibleNums :: (VisibleNum -> a -> b) -> [a] -> [b]-visibleNums f as = L.makeSerials k-  where-    k = Tr.sequenceA (replicate (length as) L.incrementBack)-        *> mapM assign as-    assign a = fmap (\ser -> f (VisibleNum ser) a) L.getSerial-

@@ -1,16 +0,0 @@--- | Options applicable to multiple Cabin reports.--module Penny.Cabin.Options where---- | Whether to show zero balances in reports.-newtype ShowZeroBalances =-  ShowZeroBalances { unShowZeroBalances :: Bool }-  deriving (Show, Eq)---- | Converts an ordering to a descending order.-descending :: (a -> a -> Ordering)-              -> a -> a -> Ordering-descending f x y = case f x y of-  LT -> GT-  GT -> LT-  EQ -> EQ

@@ -1,24 +0,0 @@--- | Command line parsers that are common to various Cabin reports.--module Penny.Cabin.Parsers where--import qualified Penny.Cabin.Options as CO-import qualified System.Console.MultiArg.Combinator as C---zeroBalances :: C.OptSpec CO.ShowZeroBalances-zeroBalances = C.OptSpec ["zero-balances"] "" (C.ChoiceArg ls)-  where-    ls = [ ("show", CO.ShowZeroBalances True)-         , ("hide", CO.ShowZeroBalances False) ]--data SortOrder = Ascending | Descending deriving (Eq, Ord, Show)--order :: C.OptSpec SortOrder-order = C.OptSpec ["order"] "" (C.ChoiceArg ls)-  where-    ls = [ ("ascending", Ascending)-         , ("descending", Descending) ]--help :: C.OptSpec ()-help = C.OptSpec ["help"] "h" (C.NoArg ())

@@ -1,622 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}---- | The Penny Postings report------ The Postings report displays postings in a tabular format designed--- to be read by humans. Some terminology used in the Postings report:------ [@row@] The smallest unit that spans from left to right. A row,--- however, might consist of more than one screen line. For example,--- the running balance is shown on the far right side of the Postings--- report. The running balance might consist of more than one--- commodity. Each commodity is displayed on its own screen--- line. However, all these lines put together are displayed in a--- single row.------ [@column@] The smallest unit that spans from top to bottom.------ [@tranche@] Each posting is displayed in several rows. The group of--- rows that is displayed for a single posting is called a tranche.------ [@tranche row@] Each tranche has a particular number of rows--- (currently four); each of these rows is known as a tranche row.------ [@field@] Corresponds to a particular element of the posting, such--- as whether it is a debit or credit or its payee. The user can--- select which fields to see.------ [@allocation@] The width of the Payee and Account fields is--- variable. Generally their width will adjust to fill the entire--- width of the screen. The allocations of the Payee and Account--- fields determine how much of the remaining space each field will--- receive.------ The Postings report is easily customized from the command line to--- show various fields. However, the order of the fields is not--- configurable without editing the source code (sorry).--module Penny.Cabin.Posts-  ( postsReport-  , zincReport-  , defaultOptions-  , ZincOpts(..)-  , A.Alloc-  , A.SubAccountLength(..)-  , A.alloc-  , yearMonthDay-  , qtyAsIs-  , balanceAsIs-  , defaultWidth-  , columnsVarToWidth-  , widthFromRuntime-  , defaultFields-  , defaultSpacerWidth-  , T.ReportWidth(..)-  ) where--import Control.Applicative ((<$>), (<*>))-import qualified Control.Monad.Exception.Synchronous as Ex-import Data.List.Split (chunksOf)-import qualified Data.Either as Ei-import Data.Monoid ((<>))-import qualified Data.Text as X-import qualified Penny.Cabin.Interface as I-import qualified Penny.Cabin.Options as CO-import qualified Penny.Cabin.Posts.Allocated as A-import qualified Penny.Cabin.Posts.Chunk as C-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.Parser as P-import qualified Penny.Cabin.Posts.Spacers as S-import qualified Penny.Cabin.Posts.Types as T-import qualified Penny.Cabin.Scheme as E--import qualified Penny.Lincoln as L-import qualified Penny.Lincoln.Queries as Q-import qualified Penny.Liberty as Ly-import qualified Penny.Shield as Sh-import qualified Data.Prednote.Expressions as Exp-import qualified Data.Prednote.Pdct as Pe-import qualified System.Console.Rainbow as Rb--import Data.List (intersperse)-import Data.Maybe (catMaybes)-import qualified Data.Foldable as Fdbl-import Data.Time as Time-import qualified System.Console.MultiArg as MA-import System.Locale (defaultTimeLocale)-import Text.Matchers (CaseSensitive)---- | All information needed to make a Posts report. This function--- never fails.-postsReport-  :: E.Changers-  -> CO.ShowZeroBalances-  -> (Pe.Pdct (L.Box Ly.LibertyMeta))-  -- ^ 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]-  -> [Rb.Chunk]--postsReport ch szb pdct pff co =-  C.makeChunk ch co-  . M.toBoxList szb pdct pff---zincReport :: ZincOpts -> I.Report-zincReport opts rt = (helpStr opts, md)-  where-    md cs fty ch expr fsf = MA.Mode-      { MA.mName = "postings"-      , MA.mIntersperse = MA.Intersperse-      , MA.mOpts = specs rt-      , MA.mPosArgs = Left-      , MA.mProcess = process opts cs fty ch expr fsf-      , MA.mHelp = const (helpStr opts)-      }--specs-  :: Sh.Runtime-  -> [MA.OptSpec (Either String (P.State -> Ex.Exceptional X.Text P.State))]-specs = map (fmap Right) . P.allSpecs---process-  :: ZincOpts-  -> CaseSensitive-  -> L.Factory-  -> E.Changers-  -> Exp.ExprDesc-  -> ([L.Transaction] -> [L.Box Ly.LibertyMeta])-  -> [Either String (P.State -> Ex.Exceptional X.Text P.State)]-  -> Ex.Exceptional X.Text I.ArgsAndReport-process os cs fty ch expr fsf ls =-  let (posArgs, clOpts) = Ei.partitionEithers ls-      pState = newParseState cs fty expr os-      exState' = foldl (>>=) (return pState) clOpts-  in fmap (mkPrintReport posArgs os ch fsf) exState'--mkPrintReport-  :: [String]-  -> ZincOpts-  -> E.Changers-  -> ([L.Transaction] -> [L.Box Ly.LibertyMeta])-  -> P.State-  -> I.ArgsAndReport-mkPrintReport posArgs zo ch fsf st = (posArgs, f)-  where-    f txns _ = do-      pdct <- getPredicate (P.exprDesc st) (P.tokens st)-      let boxes = fsf txns-          rptChks = postsReport ch (P.showZeroBalances st) pdct-                    (P.postFilter st) (chunkOpts st zo) boxes-          expChks = showExpression (P.showExpression st) pdct-          verbChks = showVerboseFilter (P.verboseFilter st) pdct boxes-          chks = expChks-                 ++ verbChks-                 ++ rptChks-      return chks--indentAmt :: Pe.IndentAmt-indentAmt = 4--blankLine :: Rb.Chunk-blankLine = Rb.plain (X.singleton '\n')--showExpression-  :: P.ShowExpression-  -> Pe.Pdct (L.Box Ly.LibertyMeta)-  -> [Rb.Chunk]-showExpression (P.ShowExpression b) pdct =-  if not b then [] else info : blankLine : (chks ++ [blankLine])-  where-    info = Rb.plain (X.pack "Postings filter expression:\n")-    chks = Pe.showPdct indentAmt 0 pdct--showVerboseFilter-  :: P.VerboseFilter-  -> Pe.Pdct (L.Box Ly.LibertyMeta)-  -> [L.Box Ly.LibertyMeta]-  -> [Rb.Chunk]-showVerboseFilter (P.VerboseFilter b) pdct bs =-  if not b then [] else info : blankLine : (chks ++ [blankLine])-  where-    pdcts = map (makeLabeledPdct pdct) bs-    chks = concat . map snd $ zipWith doEval bs pdcts-    doEval subj pd = Pe.evaluate indentAmt False subj 0 pd-    info = Rb.plain (X.pack "Postings report filter:\n")---- | Creates a Pdct and prepends a one-line description of the PostFam--- to the Pdct's label so it can be easily identified in the output.-makeLabeledPdct-  :: Pe.Pdct (L.Box Ly.LibertyMeta)-  -> L.Box Ly.LibertyMeta-  -> Pe.Pdct (L.Box Ly.LibertyMeta)-makeLabeledPdct pd box = Pe.rename f pd-  where-    f old = old <> " - " <> L.display pf-    pf = L.boxPostFam box--defaultOptions-  :: Sh.Runtime-  -> ZincOpts-defaultOptions rt = ZincOpts-  { fields = defaultFields-  , width = widthFromRuntime rt-  , showZeroBalances = CO.ShowZeroBalances False-  , dateFormat = yearMonthDay-  , qtyFormat = qtyAsIs-  , balanceFormat = balanceAsIs-  , subAccountLength = A.SubAccountLength 2-  , payeeAllocation = A.alloc 60-  , accountAllocation = A.alloc 40-  , spacers = defaultSpacerWidth-  }---type Error = X.Text--getPredicate-  :: Exp.ExprDesc-  -> [Exp.Token (L.Box Ly.LibertyMeta)]-  -> Ex.Exceptional Error (Pe.Pdct (L.Box Ly.LibertyMeta))-getPredicate d ts =-  case ts of-    [] -> return $ Pe.always-    _ -> Exp.parseExpression d ts----- | All the information to configure the postings report if the--- options will be parsed in from the command line.-data ZincOpts = ZincOpts-  { fields :: F.Fields Bool-    -- ^ Default fields to show in the report.--  , 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.Qty -> 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 :: A.Alloc-    -- ^ 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.Alloc-    -- ^ 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.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-  -> Exp.ExprDesc-  -> ZincOpts-  -> P.State-newParseState cs fty expr o = P.State-  { P.sensitive = cs-  , P.factory = fty-  , P.tokens = []-  , P.postFilter = []-  , P.fields = fields o-  , P.width = width o-  , P.showZeroBalances = showZeroBalances o-  , P.exprDesc = expr-  , P.verboseFilter = P.VerboseFilter False-  , P.showExpression = P.ShowExpression False-  }---- | Shows the date of a posting in YYYY-MM-DD format.-yearMonthDay :: Box -> X.Text-yearMonthDay p = X.pack (Time.formatTime defaultTimeLocale fmt d)-  where-    d = L.day-        . 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 . Q.qty . L.boxPostFam $ p---- | Shows the quantity of a balance. If there is no quantity, shows--- two dashes.-balanceAsIs :: a -> L.Qty -> X.Text-balanceAsIs _ = X.pack . show---- | 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 }----------------------------------------------------------------- ## Help---------------------------------------------------------------ifDefault :: Bool -> String-ifDefault b = if b then " (default)" else ""--helpStr :: ZincOpts -> String-helpStr o = unlines $-  [ "postings"-  , "  Show postings in order with a running balance."-  , "  Accepts the following options:"-  , ""-  , "Posting filters"-  , "==============="-  , "These options affect which postings are shown in the report."-  , "Postings not shown still affect the running balance."-  , ""-  , "Dates"-  , "-----"-  , ""-  , "--date cmp timespec, -d cmp timespec"-  , "  Date must be within the time frame given. timespec"-  , "  is a day or a day and a time. Valid values for cmp:"-  , "     <, >, <=, >=, ==, /=, !="-  , "--current"-  , "  Same as \"--date <= (right now) \""-  , ""-  , "Serials"-  , "-------"-  , "These options take the form --option cmp num; the given"-  , "sequence number must fall within the given range. \"rev\""-  , "in the option name indicates numbering is from end to beginning."-  , ""-  , "--globalTransaction, --revGlobalTransaction"-  , "  All transactions, after reading the ledger files"-  , "--globalPosting, --revGlobalPosting"-  , "  All postings, after reading the leder files"-  , "--fileTransaction, --revFileTransaction"-  , "  Transactions in each ledger file, after reading the files"-  , "  (numbering restarts with each file)"-  , "--filePosting, --revFilePosting"-  , "  Postings in each ledger file, after reading the files"-  , "  (numbering restarts with each file)"-  , "--filtered, --revFiltered"-  , "  All postings, after filters given in the filter"-  , "  specification portion of the command line are"-  , "  applied"-  , "--sorted, --revSorted"-  , "  All postings remaining after filtering and after"-  , "  postings have been sorted"-  , ""-  , "Pattern matching"-  , "----------------"-  , ""-  , "-a pattern, --account pattern"-  , "  Pattern must match colon-separated account name"-  , "--account-level num pat"-  , "  Pattern must match sub account at given level"-  , "--account-any pat"-  , "  Pattern must match sub account at any level"-  , "-p pattern, --payee pattern"-  , "  Payee must match pattern"-  , "-t pattern, --tag pattern"-  , "  Tag must match pattern"-  , "--number pattern"-  , "  Number must match pattern"-  , "--flag pattern"-  , "  Flag must match pattern"-  , "--commodity pattern"-  , "  Pattern must match colon-separated commodity name"-  , "--posting-memo pattern"-  , "  Posting memo must match pattern"-  , "--transaction-memo pattern"-  , "  Transaction memo must match pattern"-  , ""-  , "Other posting characteristics"-  , "-----------------------------"-  , "--debit"-  , "  Entry must be a debit"-  , "--credit"-  , "  Entry must be a credit"-  , "--qty cmp number"-  , "  Entry quantity must fall within given range"-  , ""-  , "Infix or RPN selection"-  , "----------------------"-  , "--infix - use infix notation"-  , "--rpn - use reverse polish notation"-  , "  (default: use what was used in the filtering options)"-  , ""-  , "Infix Operators - from highest to lowest precedence"-  , "(all are left associative)"-  , "--------------------------"-  , "--open expr --close"-  , "  Force precedence (as in \"open\" and \"close\" parentheses)"-  , "--not expr"-  , "  True if expr is false"-  , "expr1 --and expr2 "-  , "  True if expr and expr2 are both true"-  , "expr1 --or expr2"-  , "  True if either expr1 or expr2 is true"-  , ""-  , "RPN Operators"-  , "-------------"-  , "expr --not"-  , "  True if expr is false"-  , "expr1 expr2 --and"-  , "  True if expr and expr2 are both true"-  , "expr1 expr2 --or"-  , "  True if either expr1 or expr2 is true"-  , ""-  , "Options affecting patterns"-  , "=========================="-  , ""-  , "-i, --case-insensitive"-  , "  Be case insensitive"-  , "-I, --case-sensitive"-  , "  Be case sensitive"-  , ""-  , "--within"-  , "  Use \"within\" matcher"-  , "--pcre"-  , "  Use \"pcre\" matcher"-  , "--posix"-  , "  Use \"posix\" matcher"-  , "--exact"-  , "  Use \"exact\" matcher"-  , ""-  , "Removing postings after sorting and filtering"-  , "============================================="-  , "--head n"-  , "  Keep only the first n postings"-  , "--tail n"-  , "  Keep only the last n postings"-  , ""-  , "Other options"-  , "============="-  , "--width num"-  , "  Hint for roughly how wide the report should be in columns"-  , "  (currently: " ++ (show . T.unReportWidth . width $ o) ++ ")"-  , "--show field, --hide field"-  , "  show or hide this field, where field is one of:"-  , "    globalTransaction, revGlobalTransaction,"-  , "    globalPosting, revGlobalPosting,"-  , "    fileTransaction, revFileTransaction,"-  , "    filePosting, revFilePosting,"-  , "    filtered, revFiltered,"-  , "    sorted, revSorted,"-  , "    visible, revVisible,"-  , "    lineNum,"-  , "    date, flag, number, payee, account,"-  , "    postingDrCr, postingCommodity, postingQty,"-  , "    totalDrCr, totalCommodity, totalQty,"-  , "    tags, memo, filename"-  , "--show-all"-  , "  Show all fields"-  , "--hide-all"-  , "  Hide all fields"-  , ""-  ] ++ showDefaultFields (fields o) ++-  [ ""-  , "--show-zero-balances"-  , "  Show balances that are zero"-    ++ ifDefault (CO.unShowZeroBalances . showZeroBalances $ o)-  , "--hide-zero-balances"-  , "  Hide balances that are zero"-    ++ ifDefault (not . CO.unShowZeroBalances . showZeroBalances $ o)-  , ""-  , "--help, -h"-  , "  Show this help and exit"-  ]---- | Shows which fields are on by default.-showDefaultFields :: F.Fields Bool -> [String]-showDefaultFields i = hdr : rest-  where-    hdr = "Fields shown by default:"-      ++ if null rest then " (none)" else ""-    rest =-      map ("  " ++)-      . map concat-      . map (intersperse ", ")-      . chunksOf 3-      . catMaybes-      . Fdbl.toList-      . toMaybes-      $ i-    toMaybes flds = f <$> flds <*> F.fieldNames-    f b n = if b then Just n else Nothing

@@ -1,402 +0,0 @@--- | Calculates the allocated cells -- the Payee cell and the Account--- cell. Here is the logic for this process:------ 1. If neither Payee nor Account appears, do nothing.------ 2. Obtain the width of the growing cells, including the--- spacers. One of the spacers attached to a field might be omitted:------ a. If the rightmost growing field is TotalQty, include all spacers.------ b. If the rightmost growing field is to the left of Payee, include--- all spacers.------ c. If the rightmost growing field is to the right of Account but is--- not TotalQty, omit its spacer.------ 2. Obtain the width of the Payee and Account spacers. Include each--- spacer if its corresponding field appears in the report.------ 3. Subtract from the total report width the width of the the--- growing cells and the width of the Payee and Account spacers. This--- gives the total width available for the Payee and Account--- fields. If there are not at least two columns available, return--- without including the Payee and Account fields.------ 4. Determine the total width that the Payee and Account fields--- would obtain if they had all the space they could ever need. This--- is the "requested width".------ 5. Split up the available width for the Payee and Account fields--- depending on which fields appear:------ a. If only the one field appears, then it shall be as wide as the--- total available width or the its requested width, whichever is--- smaller.------ b. If both fields appear, then calculate the allocated width for--- each field. If either field's requested width is less than its--- allocated width, then that field is only as wide as its requested--- width. The other field is then as wide as (the sum of its allocated--- width and the leftover width from the other field) or its requested--- width, whichever is smaller. If neither field's requested width is--- less than its allocated width, then each field gets ts allocated--- width.------ 6. Fill cell contents; return filled cells.--module Penny.Cabin.Posts.Allocated (-  payeeAndAcct-  , AllocatedOpts(..)-  , Fields(..)-  , SubAccountLength(..)-  , Alloc-  , alloc-  , unAlloc-  ) where--import Control.Applicative(Applicative((<*>), pure), (<$>))-import Control.Arrow (second)-import Data.Maybe (catMaybes, isJust)-import Data.List (intersperse)-import qualified Data.Foldable as Fdbl-import qualified Data.Sequence as Seq-import qualified Data.Traversable as T-import qualified Data.Text as X-import qualified System.Console.Rainbow as Rb-import qualified Penny.Cabin.Row as R-import qualified Penny.Cabin.Posts.Growers as G-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.Types as Ty-import qualified Penny.Cabin.Scheme as E-import qualified Penny.Cabin.TextFormat as TF-import qualified Penny.Lincoln as L-import qualified Penny.Lincoln.Bits.Qty as Qty-import qualified Penny.Lincoln.Queries as Q-import qualified Penny.Lincoln.HasText as HT--data Fields a = Fields {-  payee :: a-  , account :: a-  } deriving (Eq, Show)--newtype SubAccountLength =-  SubAccountLength { unSubAccountLength :: Int }-  deriving Show--newtype Alloc = Alloc { unAlloc :: Int }-  deriving Show--alloc :: Int -> Alloc-alloc i =-  if i < 1-  then error $ "allocations must be greater than zero."-       ++ " supplied allocation: " ++ show i-  else Alloc i----- | All the information needed for allocated cells.-data AllocatedOpts = AllocatedOpts-  { fields :: Fields Bool-  , subAccountLength :: SubAccountLength-  , allocations :: Fields Alloc-  , 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--- Fields is Nothing if no cells were created (either because the user--- did not ask for them, or because there was no room) or Just cs i,--- where cs is a list of all the cells, and i is the width of all the--- cells.-payeeAndAcct-  :: E.Changers-  -> AllocatedOpts-  -> [Box]-  -> Fields (Maybe ([R.ColumnSpec], Int))-payeeAndAcct ch ao bs =-  let allBuilders =-        T.traverse (builders ch (subAccountLength ao)) bs-      availWidth = availableWidthForAllocs (growerWidths ao)-                   (spacers ao) (fields ao) (reportWidth ao)-      finals = divideAvailableWidth availWidth (fields ao)-               (allocations ao)-               ( fmap (safeMaximum (Request 0))-                 . fmap (fmap fst) $ allBuilders)-  in fmap (fmap (second unFinal))-     . buildSpecs finals-     . fmap (fmap snd)-     $ allBuilders---safeMaximum :: Ord a => a -> [a] -> a-safeMaximum d ls = case ls of-  [] -> d-  xs -> maximum xs--payeeAndAccountSpacerWidth-  :: Fields Bool-  -> S.Spacers Int-  -> Int-payeeAndAccountSpacerWidth flds ss = pye + act-  where-    pye = if payee flds then abs (S.payee ss) else 0-    act = if account flds then abs (S.account ss) else 0--newtype AvailableWidth = AvailableWidth Int-        deriving (Eq, Ord, Show)--availableWidthForAllocs-  :: G.Fields (Maybe Int)-  -> S.Spacers Int-  -> Fields Bool-  -> Ty.ReportWidth-  -> AvailableWidth-availableWidthForAllocs growers ss flds (Ty.ReportWidth w) =-  AvailableWidth $ max 0 diff-  where-    tot = sumGrowersAndSpacers growers ss-          + payeeAndAccountSpacerWidth flds ss-    diff = w - tot---- | Sums spacers for growing cells. This function is intended for use--- only by the functions that allocate cells for the report, so it--- assumes that either the Payee or the Account field is showing. Sums--- all spacers, UNLESS the rightmost field is from PostingDrCr to--- TotalCmdty, in which case the rightmost spacer is omitted. Apply to--- the second element of the tuple returned by growCells (which--- reflects which fields actually have width) and to the accompanying--- Spacers.-sumSpacers ::-  G.Fields (Maybe a)-  -> S.Spacers Int-  -> Int-sumSpacers fs =-  sum-  . map fst-  . appearingSpacers-  . catMaybes-  . Fdbl.toList-  . fmap toWidth-  . pairedWithSpacers fs----- | Takes a triple:------ * The first element is Just _ if the field appears in the report;--- Nothing if not------ * The second element is Maybe Int for the width of the spacer--- (TotalQty has no spacer, so it will be Nothing)------ * The third element is the EFields tag------ Returns Nothing if the field does not appear in the report. Returns--- Just a pair if the field does appear in the report, where the first--- element is the width of the spacer, and the second element is the--- EFields tag.-toWidth :: (Maybe a, Maybe Int, t) -> Maybe (Int, t)-toWidth (maybeShowing, maybeWidth, tag) =-  if isJust maybeShowing-  then case maybeWidth of-    Just w -> Just (w, tag)-    Nothing -> Just (0, tag)-  else Nothing----- | Given a list of all spacers that are attached to the fields that--- are present in a report, return a list of the spacers that will--- actually appear in the report. The rightmost spacer does not appear--- if it is to the right of Account (unless there is a TotalQty field,--- in which case, all spacers appear because TotalQty has no spacer.)-appearingSpacers :: [(Int, G.EFields)] -> [(Int, G.EFields)]-appearingSpacers ss = case ss of-  [] -> []-  l -> case snd $ last l of-    G.ETotalQty -> l-    t -> if t > G.ENumber-         then init l-         else l---- | Applied to two arguments: first, a Fields, and second, a--- Spacers. Combines each Field with its corresponding Spacer and with--- the GFields, which indicates each particular field.-pairedWithSpacers ::-  G.Fields a-  -> S.Spacers b-  -> G.Fields (a, Maybe b, G.EFields)-pairedWithSpacers f s =-  (\(a, b) c -> (a, b, c))-  <$> G.pairWithSpacer f s-  <*> G.eFields---- | Sums the widths of growing cells and their accompanying--- spacers; makes the adjustments described in sumSpacers.-sumGrowersAndSpacers ::-  G.Fields (Maybe Int)-  -> S.Spacers Int-  -> Int-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--newtype Request = Request { unRequest :: Int }-        deriving (Eq, Ord, Show)--newtype Final = Final { unFinal :: Int }-        deriving (Eq, Ord, Show)---buildSpecs-  :: Fields (Maybe Final)-  -> Fields ([Final -> R.ColumnSpec])-  -> Fields (Maybe ([R.ColumnSpec], Final))-buildSpecs finals bs = f <$> finals <*> bs-  where-    f mayFinal gs = case mayFinal of-      Nothing -> Nothing-      Just fin -> Just ((gs <*> pure fin), fin)----- | Divide the total available width between the two fields.-divideAvailableWidth-  :: AvailableWidth-  -> Fields Bool-  -> Fields Alloc-  -> Fields Request-  -> Fields (Maybe Final)-divideAvailableWidth (AvailableWidth aw) appear allocs rws = Fields pye act-  where-    minFinal i1 i2 =-      let m = min i1 i2-      in if m > 0 then Just . Final $ m else Nothing-    pairAtLeast i1 i2 = (atLeast i1, atLeast i2)-      where atLeast i = if i > 0 then Just . Final $ i else Nothing-    reqP = unRequest . payee $ rws-    reqA = unRequest . account $ rws-    (pye, act) = case (payee appear, account appear) of-      (False, False) -> (Nothing, Nothing)-      (True, False) -> (minFinal reqP aw, Nothing)-      (False, True) -> (Nothing, minFinal reqA aw)-      (True, True) ->-        let votes = [unAlloc . payee $ allocs, unAlloc . account $ allocs]-            allocRslt = Qty.largestRemainderMethod (fromIntegral aw)-                        (map fromIntegral votes)-            (allocP, allocA) = case allocRslt of-              x:y:[] -> (fromIntegral x, fromIntegral y)-              _ -> error "divideAvailableWidth error"-        in case (allocP > reqP, allocA > reqA) of-            (True, True) -> pairAtLeast reqP reqA-            (True, False) ->-              pairAtLeast reqP $ (min (allocA + (allocP - reqP))) reqA-            (False, True) ->-              pairAtLeast (min reqP (allocP + (allocA - reqA))) reqA-            (False, False) -> pairAtLeast allocP allocA---builders-  :: E.Changers-  -> SubAccountLength-  -> Box-  -> Fields (Request, Final -> R.ColumnSpec)-builders ch sl b = Fields (buildPayee ch b) (buildAcct ch sl b)--buildPayee-  :: E.Changers-  -> Box-  -> (Request, Final -> R.ColumnSpec)-  -- ^ Returns a tuple. The first element is the maximum width that-  -- this cell needs to display its value perfectly. The second-  -- element is a function that, when applied to an actual width,-  -- returns a ColumnSpec.--buildPayee ch i = (maxW, mkSpec)-  where-    pb = L.boxPostFam i-    eo = E.fromVisibleNum . M.visibleNum . L.boxMeta $ i-    j = R.LeftJustify-    ps = (E.Other, eo)-    md = E.getEvenOddLabelValue E.Other eo ch-    mayPye = Q.payee pb-    maxW = Request $ maybe 0 (X.length . HT.text) mayPye-    mkSpec (Final w) = R.ColumnSpec j (R.Width w) ps sq-      where-        sq = case mayPye of-          Nothing -> []-          Just pye ->-            let wrapped =-                  Fdbl.toList-                  . TF.unLines-                  . TF.wordWrap w-                  . TF.txtWords-                  . HT.text-                  $ pye-                toBit (TF.Words seqTxts) =-                  md-                  . Rb.plain-                  . X.unwords-                  . Fdbl.toList-                  $ seqTxts-            in fmap toBit wrapped---buildAcct-  :: E.Changers-  -> SubAccountLength-  -> Box-  -> (Request, Final -> R.ColumnSpec)-  -- ^ Returns a tuple. The first element is the maximum width that-  -- this cell needs to display its value perfectly. The second-  -- element is a function that, when applied to an actual width,-  -- returns a ColumnSpec.--buildAcct ch sl i = (maxW, mkSpec)-  where-    pb = L.boxPostFam i-    eo = E.fromVisibleNum . M.visibleNum . L.boxMeta $ i-    ps = (E.Other, eo)-    aList = L.unAccount . Q.account $ pb-    maxW = Request-           $ (sum . map (X.length . L.unSubAccount) $ aList)-           + max 0 (length aList - 1)-    md = E.getEvenOddLabelValue E.Other eo ch-    mkSpec (Final aw) = R.ColumnSpec R.LeftJustify (R.Width aw) ps sq-      where-        target = TF.Target aw-        shortest = TF.Shortest . unSubAccountLength $ sl-        ws = TF.Words . Seq.fromList . map L.unSubAccount $ aList-        (TF.Words shortened) = TF.shorten shortest target ws-        sq = [ md-               . Rb.plain-               . X.concat-               . intersperse (X.singleton ':')-               . Fdbl.toList-               $ shortened ]--instance Functor Fields where-  fmap f i = Fields {-    payee = f (payee i)-    , account = f (account i) }--instance Applicative Fields where-  pure a = Fields a a-  ff <*> fa = Fields {-    payee = payee ff (payee fa)-    , account = account ff (account fa) }--instance Fdbl.Foldable Fields where-  foldr f z flds =-    f (payee flds) (f (account flds) z)--instance T.Traversable Fields where-  traverse f flds =-    Fields <$> f (payee flds) <*> f (account flds)-

@@ -1,649 +0,0 @@--- | Fills the bottom rows, which contain the tags, memo, and--- filename. These rows are formatted as follows:------ * If the columns for TotalDrCr, TotalCmdty, and TotalQty are all--- present, AND if there are at least TWO other columns present, then--- there will be a hanging indent. The bottom rows will begin at the--- SECOND column and end with the last column to the left of--- TotalDrCr. In this case, each bottom row will have three cells: one--- padding on the left, one main content, and one padding on the--- right.------ * Otherwise, if there are NO columns in the top row, these rows--- will take the entire width of the report. Each bottom row will have--- one cell.------ * Otherwise, the bottom rows are as wide as all the top cells--- combined. Each bottom row will have one cell.--module Penny.Cabin.Posts.BottomRows (-  BottomOpts(..),-  bottomRows, Fields(..), TopRowCells(..), mergeWithSpacers,-  topRowCells) where--import Control.Applicative((<$>), Applicative(pure,  (<*>)))-import qualified Data.Foldable as Fdbl-import Control.Monad (guard)-import Data.List (intersperse, find)-import qualified Data.List.NonEmpty as NE-import Data.Maybe (catMaybes)-import Data.Monoid (mappend, mempty, First(First, getFirst))-import qualified Data.Sequence as Seq-import qualified Data.Text as X-import qualified Data.Traversable as T-import qualified System.Console.Rainbow as Rb-import qualified Penny.Cabin.Scheme as E-import qualified Penny.Cabin.Row as R-import qualified Penny.Cabin.TextFormat as TF-import qualified Penny.Cabin.Posts.Allocated as A-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 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--data BottomOpts = BottomOpts-  { growingWidths :: G.Fields (Maybe Int)-  , allocatedWidths :: A.Fields (Maybe Int)-  , fields :: F.Fields Bool-  , reportWidth :: Ty.ReportWidth-  , spacers :: S.Spacers Int-  }--bottomRows-  :: E.Changers-  -> BottomOpts-  -> [Box]-  -> Fields (Maybe [[Rb.Chunk]])-bottomRows ch os bs = makeRows bs pcs where-  pcs = infoProcessors ch topSpecs (reportWidth os) wanted-  wanted = requestedMakers ch (fields os)-  topSpecs = topCellSpecs (growingWidths os) (allocatedWidths os)-             (spacers os)---data Fields a = Fields {-  tags :: a-  , memo :: a-  , filename :: a-  } deriving (Show, Eq)--instance Fdbl.Foldable Fields where-  foldr f z d =-    f (tags d)-    (f (memo d)-     (f (filename d) z))--instance Functor Fields where-  fmap f (Fields t m fn) =-    Fields (f t) (f m) (f fn)--instance Applicative Fields where-  pure a = Fields a a a-  ff <*> fa = Fields {-    tags = (tags ff) (tags fa)-    , memo = (memo ff) (memo fa)-    , filename = (filename ff) (filename fa)-    }--bottomRowsFields :: F.Fields a -> Fields a-bottomRowsFields f = Fields {-  tags = F.tags f-  , memo = F.memo f-  , filename = F.filename f }---data Hanging a = Hanging {-  leftPad :: a-  , mainCell :: a-  , rightPad :: a-  } deriving (Show, Eq)---newtype SpacerWidth = SpacerWidth Int deriving (Show, Eq)-newtype ContentWidth = ContentWidth Int deriving (Show, Eq)---hanging-  :: E.Changers-  -> [TopCellSpec]-  -> Maybe ((Box -> Int -> ((E.Label, E.EvenOdd), R.ColumnSpec))-            -> Box -> [Rb.Chunk])-hanging ch specs = hangingWidths specs-                >>= return . hangingInfoProcessor ch--hangingInfoProcessor-  :: E.Changers-  -> Hanging Int-  -> (Box -> Int -> ((E.Label, E.EvenOdd), R.ColumnSpec))-  -> Box-  -> [Rb.Chunk]-hangingInfoProcessor ch widths mkr info = row where-  row = R.row ch [left, mid, right]-  (ts, mid) = mkr info (mainCell widths)-  mkPad w = R.ColumnSpec R.LeftJustify (R.Width w) ts []-  left = mkPad (leftPad widths)-  right = mkPad (rightPad widths)--widthOfTopColumns-  :: E.Changers-  -> [TopCellSpec]-  -> Maybe ((Box -> Int -> ((E.Label, E.EvenOdd), R.ColumnSpec))-            -> Box -> [Rb.Chunk])-widthOfTopColumns ch ts =-  if null ts-  then Nothing-  else Just $ makeSpecificWidth ch w where-    w = Fdbl.foldl' f 0 ts-    f acc (_, maySpcWidth, (ContentWidth cw)) =-      acc + cw + maybe 0 (\(SpacerWidth sw) -> sw) maySpcWidth---widthOfReport-  :: E.Changers-  -> Ty.ReportWidth-  -> (Box -> Int -> ((E.Label, E.EvenOdd), R.ColumnSpec))-  -> Box-  -> [Rb.Chunk]-widthOfReport ch (Ty.ReportWidth rw) fn info =-  makeSpecificWidth ch rw fn info--chooseProcessor-  :: E.Changers-  -> [TopCellSpec]-  -> Ty.ReportWidth-  -> (Box -> Int -> ((E.Label, E.EvenOdd), R.ColumnSpec))-  -> Box-  -> [Rb.Chunk]-chooseProcessor ch specs rw fn = let-  firstTwo = First (hanging ch specs)-             `mappend` First (widthOfTopColumns ch specs)-  in case getFirst firstTwo of-    Nothing -> widthOfReport ch rw fn-    Just r -> r fn--infoProcessors-  :: E.Changers-  -> [TopCellSpec]-  -> Ty.ReportWidth-  -> Fields (Maybe (Box -> Int -> ((E.Label, E.EvenOdd), R.ColumnSpec)))-  -> Fields (Maybe (Box -> [Rb.Chunk]))-infoProcessors ch specs rw flds = let-  chooser = chooseProcessor ch specs rw-  mkProcessor mayFn = case mayFn of-    Nothing -> Nothing-    Just fn -> Just $ chooser fn-  in mkProcessor <$> flds---makeRows ::-  [Box]-  -> Fields (Maybe (Box -> [Rb.Chunk]))-  -> Fields (Maybe [[Rb.Chunk]])-makeRows is flds = let-  mkRow fn = map fn is-  in fmap (fmap mkRow) flds----- | Calculates column widths for a Hanging report. If it cannot--- calculate the widths (because these cells do not support hanging),--- returns Nothing.-hangingWidths :: [TopCellSpec]-                 -> Maybe (Hanging Int)-hangingWidths ls = do-  let len = length ls-  guard (len > 4)-  let matchColumn x (c, _, _) = x == c-  totDrCr <- find (matchColumn ETotalDrCr) ls-  totCmdty <- find (matchColumn ETotalCmdty) ls-  totQty <- find (matchColumn ETotalQty) ls-  let (first:middle) = take (len - 3) ls-  mid <- NE.nonEmpty middle-  return $ calcHangingWidths first mid (totDrCr, totCmdty, totQty)--type TopCellSpec = (ETopRowCells, Maybe SpacerWidth, ContentWidth)---- | Given the first column in the top row, at least one middle--- column, and the last three columns, calculate the width of the--- three columns in the hanging report.-calcHangingWidths ::-  TopCellSpec-  -> NE.NonEmpty TopCellSpec-  -> (TopCellSpec, TopCellSpec, TopCellSpec)-  -> Hanging Int-calcHangingWidths l m r = Hanging left middle right where-  calcWidth (_, maybeSp, (ContentWidth c)) =-    c + maybe 0 (\(SpacerWidth w) -> abs w) maybeSp-  left = calcWidth l-  middle = Fdbl.foldl' f 0 m where-    f acc c = acc + calcWidth c-  (totDrCr, totCmdty, totQty) = r-  right = calcWidth totDrCr + calcWidth totCmdty-          + calcWidth totQty---topCellSpecs :: G.Fields (Maybe Int)-                -> A.Fields (Maybe Int)-                -> S.Spacers Int-                -> [TopCellSpec]-topCellSpecs gFlds aFlds spcs = let-  allFlds = topRowCells gFlds aFlds-  cws = fmap (fmap ContentWidth) allFlds-  merged = mergeWithSpacers cws spcs-  tripler e (cw, maybeSpc) = (e, (fmap SpacerWidth maybeSpc), cw)-  list = Fdbl.toList $ tripler <$> eTopRowCells <*> merged-  toMaybe (e, maybeS, maybeC) = case maybeC of-    Nothing -> Nothing-    Just c -> Just (e, maybeS, c)-  in catMaybes (map toMaybe list)----- | Merges a TopRowCells with a Spacers. Returns Maybes because--- totalQty has no spacer.-mergeWithSpacers ::-  TopRowCells a-  -> S.Spacers b-  -> TopRowCells (a, Maybe b)-mergeWithSpacers t s = TopRowCells {-  globalTransaction = (globalTransaction t, Just (S.globalTransaction s))-  , revGlobalTransaction = (revGlobalTransaction t, Just (S.revGlobalTransaction s))-  , globalPosting = (globalPosting t, Just (S.globalPosting s))-  , revGlobalPosting = (revGlobalPosting t, Just (S.revGlobalPosting s))-  , fileTransaction = (fileTransaction t, Just (S.fileTransaction s))-  , revFileTransaction = (revFileTransaction t, Just (S.revFileTransaction s))-  , filePosting = (filePosting t, Just (S.filePosting s))-  , revFilePosting = (revFilePosting t, Just (S.revFilePosting s))-  , filtered = (filtered t, Just (S.filtered s))-  , revFiltered = (revFiltered t, Just (S.revFiltered s))-  , sorted = (sorted t, Just (S.sorted s))-  , revSorted = (revSorted t, Just (S.revSorted s))-  , visible = (visible t, Just (S.visible s))-  , revVisible = (revVisible t, Just (S.revVisible s))-  , lineNum = (lineNum t, Just (S.lineNum s))-  , date = (date t, Just (S.date s))-  , flag = (flag t, Just (S.flag s))-  , number = (number t, Just (S.number s))-  , payee = (payee t, Just (S.payee s))-  , account = (account t, Just (S.account s))-  , postingDrCr = (postingDrCr t, Just (S.postingDrCr s))-  , postingCmdty = (postingCmdty t, Just (S.postingCmdty s))-  , postingQty = (postingQty t, Just (S.postingQty s))-  , totalDrCr = (totalDrCr t, Just (S.totalDrCr s))-  , totalCmdty = (totalCmdty t, Just (S.totalCmdty s))-  , totalQty = (totalQty t, Nothing) }----- | Applied to a function that, when applied to the width of a cell,--- returns a cell filled with data, returns a Row with that cell.-makeSpecificWidth-  :: E.Changers -> Int -> (Box -> Int -> (a, R.ColumnSpec))-  -> Box -> [Rb.Chunk]-makeSpecificWidth ch w f i = R.row ch [c] where-  (_, c) = f i w---type Maker-  = E.Changers-  -> Box-  -> Int-  -> ((E.Label, E.EvenOdd), R.ColumnSpec)--makers :: Fields Maker-makers = Fields tagsCell memoCell filenameCell---- | Applied to an Options, indicating which reports the user wants,--- returns a Fields (Maybe Maker) with a Maker in each respective--- field that the user wants to see.-requestedMakers-  :: E.Changers-  -> F.Fields Bool-  -> Fields (Maybe (Box -> Int -> ((E.Label, E.EvenOdd), R.ColumnSpec)))-requestedMakers ch allFlds =-  let flds = bottomRowsFields allFlds-      filler b mkr = if b then Just $ mkr ch else Nothing-  in filler <$> flds <*> makers--tagsCell-  :: E.Changers-  -> Box-  -> Int-  -> ((E.Label, E.EvenOdd), R.ColumnSpec)-tagsCell ch info w = (ts, cell) where-  vn = M.visibleNum . L.boxMeta $ info-  cell = R.ColumnSpec R.LeftJustify (R.Width w) ts cs-  eo = E.fromVisibleNum vn-  ts = (E.Other, eo)-  cs =-    Fdbl.toList-    . fmap toBit-    . TF.unLines-    . TF.wordWrap w-    . TF.Words-    . Seq.fromList-    . map (X.cons '*')-    . HT.textList-    . Q.tags-    . L.boxPostFam-    $ info-  md = E.getEvenOddLabelValue E.Other eo ch-  toBit (TF.Words ws) = md . Rb.plain $ t where-    t = X.concat . intersperse (X.singleton ' ') . Fdbl.toList $ ws---memoBits-  :: E.Changers -> (E.Label, E.EvenOdd) -> L.Memo -> R.Width -> [Rb.Chunk]-memoBits ch (lbl, eo) m (R.Width w) = cs where-  cs = Fdbl.toList-       . fmap toBit-       . TF.unLines-       . TF.wordWrap w-       . TF.Words-       . Seq.fromList-       . X.words-       . X.intercalate (X.singleton ' ')-       . L.unMemo-       $ m-  md = E.getEvenOddLabelValue lbl eo ch-  toBit (TF.Words ws) = md . Rb.plain $ (X.unwords . Fdbl.toList $ ws)---memoCell-  :: E.Changers -> Box -> Int -> ((E.Label, E.EvenOdd), R.ColumnSpec)-memoCell ch info width = (ts, cell) where-  w = R.Width width-  vn = M.visibleNum . L.boxMeta $ info-  eo = E.fromVisibleNum vn-  ts = (E.Other, eo)-  cell = R.ColumnSpec R.LeftJustify w ts cs-  mayPm = Q.postingMemo . L.boxPostFam $ info-  mayTm = Q.transactionMemo . L.boxPostFam $ info-  cs = case (mayPm, mayTm) of-    (Nothing, Nothing) -> mempty-    (Nothing, Just tm) -> memoBits ch ts tm w-    (Just pm, Nothing) -> memoBits ch ts pm w-    (Just pm, Just tm) -> memoBits ch ts pm w `mappend` memoBits ch ts tm w---filenameCell-  :: E.Changers -> Box -> Int -> ((E.Label, E.EvenOdd), R.ColumnSpec)-filenameCell ch info width = (ts, cell) where-  w = R.Width width-  vn = M.visibleNum . L.boxMeta $ info-  eo = E.fromVisibleNum vn-  ts = (E.Other, eo)-  cell = R.ColumnSpec R.LeftJustify w ts cs-  md = E.getEvenOddLabelValue E.Other eo ch-  toBit n = md . Rb.plain-            . X.drop (max 0 (X.length n - width)) $ n-  cs = case Q.filename . L.boxPostFam $ info of-    Nothing -> []-    Just fn -> [toBit . L.unFilename $ fn]---data TopRowCells a = TopRowCells-  { globalTransaction    :: a-  , revGlobalTransaction :: a-  , globalPosting        :: a-  , revGlobalPosting     :: a-  , fileTransaction      :: a-  , revFileTransaction   :: a-  , filePosting          :: a-  , revFilePosting       :: a-  , filtered             :: a-  , revFiltered          :: a-  , sorted               :: a-  , revSorted            :: a-  , visible              :: a-  , revVisible           :: a-  , lineNum              :: a-    -- ^ The line number from the posting's metadata-  , date                 :: a-  , flag                 :: a-  , number               :: a-  , payee                :: a-  , account              :: a-  , postingDrCr          :: a-  , postingCmdty         :: a-  , postingQty           :: a-  , totalDrCr            :: a-  , totalCmdty           :: a-  , totalQty             :: a }-  deriving (Show, Eq)--topRowCells :: G.Fields a -> A.Fields a -> TopRowCells a-topRowCells g a = TopRowCells-  { globalTransaction    = G.globalTransaction g-  , revGlobalTransaction = G.revGlobalTransaction g-  , globalPosting        = G.globalPosting g-  , revGlobalPosting     = G.revGlobalPosting g-  , fileTransaction      = G.fileTransaction g-  , revFileTransaction   = G.revFileTransaction g-  , filePosting          = G.filePosting g-  , revFilePosting       = G.revFilePosting g-  , filtered             = G.filtered g-  , revFiltered          = G.revFiltered g-  , sorted               = G.sorted g-  , revSorted            = G.revSorted g-  , visible              = G.visible g-  , revVisible           = G.revVisible g-  , lineNum              = G.lineNum g-  , date                 = G.date g-  , flag                 = G.flag g-  , number               = G.number g-  , payee                = A.payee a-  , account              = A.account a-  , postingDrCr          = G.postingDrCr g-  , postingCmdty         = G.postingCmdty g-  , postingQty           = G.postingQty g-  , totalDrCr            = G.totalDrCr g-  , totalCmdty           = G.totalCmdty g-  , totalQty             = G.totalQty g }---data ETopRowCells =-  EGlobalTransaction-  | ERevGlobalTransaction-  | EGlobalPosting-  | ERevGlobalPosting-  | EFileTransaction-  | ERevFileTransaction-  | EFilePosting-  | ERevFilePosting-  | EFiltered-  | ERevFiltered-  | ESorted-  | ERevSorted-  | EVisible-  | ERevVisible-  | ELineNum-  | EDate-  | EFlag-  | ENumber-  | EPayee-  | EAccount-  | EPostingDrCr-  | EPostingCmdty-  | EPostingQty-  | ETotalDrCr-  | ETotalCmdty-  | ETotalQty-  deriving (Show, Eq, Enum)--eTopRowCells :: TopRowCells ETopRowCells-eTopRowCells = TopRowCells-  { globalTransaction    = EGlobalTransaction-  , revGlobalTransaction = ERevGlobalTransaction-  , globalPosting        = EGlobalPosting-  , revGlobalPosting     = ERevGlobalPosting-  , fileTransaction      = EFileTransaction-  , revFileTransaction   = ERevFileTransaction-  , filePosting          = EFilePosting-  , revFilePosting       = ERevFilePosting-  , filtered             = EFiltered-  , revFiltered          = ERevFiltered-  , sorted               = ESorted-  , revSorted            = ERevSorted-  , visible              = EVisible-  , revVisible           = ERevVisible-  , lineNum              = ELineNum-  , date                 = EDate-  , flag                 = EFlag-  , number               = ENumber-  , payee                = EPayee-  , account              = EAccount-  , postingDrCr          = EPostingDrCr-  , postingCmdty         = EPostingCmdty-  , postingQty           = EPostingQty-  , totalDrCr            = ETotalDrCr-  , totalCmdty           = ETotalCmdty-  , totalQty             = ETotalQty }--instance Functor TopRowCells where-  fmap f t = TopRowCells-    { globalTransaction    = f (globalTransaction    t)-    , revGlobalTransaction = f (revGlobalTransaction t)-    , globalPosting        = f (globalPosting        t)-    , revGlobalPosting     = f (revGlobalPosting     t)-    , fileTransaction      = f (fileTransaction      t)-    , revFileTransaction   = f (revFileTransaction   t)-    , filePosting          = f (filePosting          t)-    , revFilePosting       = f (revFilePosting       t)-    , filtered             = f (filtered             t)-    , revFiltered          = f (revFiltered          t)-    , sorted               = f (sorted               t)-    , revSorted            = f (revSorted            t)-    , visible              = f (visible              t)-    , revVisible           = f (revVisible           t)-    , lineNum              = f (lineNum              t)-    , date                 = f (date                 t)-    , flag                 = f (flag                 t)-    , number               = f (number               t)-    , payee                = f (payee                t)-    , account              = f (account              t)-    , postingDrCr          = f (postingDrCr          t)-    , postingCmdty         = f (postingCmdty         t)-    , postingQty           = f (postingQty           t)-    , totalDrCr            = f (totalDrCr            t)-    , totalCmdty           = f (totalCmdty           t)-    , totalQty             = f (totalQty             t) }--instance Applicative TopRowCells where-  pure a = TopRowCells-    { globalTransaction    = a-    , revGlobalTransaction = a-    , globalPosting        = a-    , revGlobalPosting     = a-    , fileTransaction      = a-    , revFileTransaction   = a-    , filePosting          = a-    , revFilePosting       = a-    , filtered             = a-    , revFiltered          = a-    , sorted               = a-    , revSorted            = a-    , visible              = a-    , revVisible           = a-    , lineNum              = a-    , date                 = a-    , flag                 = a-    , number               = a-    , payee                = a-    , account              = a-    , postingDrCr          = a-    , postingCmdty         = a-    , postingQty           = a-    , totalDrCr            = a-    , totalCmdty           = a-    , totalQty             = a }--  ff <*> fa = TopRowCells-    { globalTransaction    = globalTransaction    ff (globalTransaction    fa)-    , revGlobalTransaction = revGlobalTransaction ff (revGlobalTransaction fa)-    , globalPosting        = globalPosting        ff (globalPosting        fa)-    , revGlobalPosting     = revGlobalPosting     ff (revGlobalPosting     fa)-    , fileTransaction      = fileTransaction      ff (fileTransaction      fa)-    , revFileTransaction   = revFileTransaction   ff (revFileTransaction   fa)-    , filePosting          = filePosting          ff (filePosting          fa)-    , revFilePosting       = revFilePosting       ff (revFilePosting       fa)-    , filtered             = filtered             ff (filtered             fa)-    , revFiltered          = revFiltered          ff (revFiltered          fa)-    , sorted               = sorted               ff (sorted               fa)-    , revSorted            = revSorted            ff (revSorted            fa)-    , visible              = visible              ff (visible              fa)-    , revVisible           = revVisible           ff (revVisible           fa)-    , lineNum              = lineNum              ff (lineNum              fa)-    , date                 = date                 ff (date                 fa)-    , flag                 = flag                 ff (flag                 fa)-    , number               = number               ff (number               fa)-    , payee                = payee                ff (payee                fa)-    , account              = account              ff (account              fa)-    , postingDrCr          = postingDrCr          ff (postingDrCr          fa)-    , postingCmdty         = postingCmdty         ff (postingCmdty         fa)-    , postingQty           = postingQty           ff (postingQty           fa)-    , totalDrCr            = totalDrCr            ff (totalDrCr            fa)-    , totalCmdty           = totalCmdty           ff (totalCmdty           fa)-    , totalQty             = totalQty             ff (totalQty             fa) }--instance Fdbl.Foldable TopRowCells where-  foldr f z o =-    f (globalTransaction o)-    (f (revGlobalTransaction o)-     (f (globalPosting o)-      (f (revGlobalPosting o)-       (f (fileTransaction o)-        (f (revFileTransaction o)-         (f (filePosting o)-          (f (revFilePosting o)-           (f (filtered o)-            (f (revFiltered o)-             (f (sorted o)-              (f (revSorted o)-               (f (visible o)-                (f (revVisible o)-                 (f (lineNum o)-                  (f (date o)-                   (f (flag o)-                    (f (number o)-                     (f (payee o)-                      (f (account o)-                       (f (postingDrCr o)-                        (f (postingCmdty o)-                         (f (postingQty o)-                          (f (totalDrCr o)-                           (f (totalCmdty o)-                            (f (totalQty o) z)))))))))))))))))))))))))--instance T.Traversable TopRowCells where-  traverse f t =-    TopRowCells-    <$> f (globalTransaction t)-    <*> f (revGlobalTransaction t)-    <*> f (globalPosting t)-    <*> f (revGlobalPosting t)-    <*> f (fileTransaction t)-    <*> f (revFileTransaction t)-    <*> f (filePosting t)-    <*> f (revFilePosting t)-    <*> f (filtered t)-    <*> f (revFiltered t)-    <*> f (sorted t)-    <*> f (revSorted t)-    <*> f (visible t)-    <*> f (revVisible t)-    <*> f (lineNum t)-    <*> f (date t)-    <*> f (flag t)-    <*> f (number t)-    <*> f (payee t)-    <*> f (account t)-    <*> f (postingDrCr t)-    <*> f (postingCmdty t)-    <*> f (postingQty t)-    <*> f (totalDrCr t)-    <*> f (totalCmdty t)-    <*> f (totalQty t)-

@@ -1,152 +0,0 @@-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.BottomRows as B-import qualified Penny.Cabin.Posts.Spacers as S-import qualified Penny.Cabin.Row as R-import qualified Penny.Cabin.Scheme as E-import qualified System.Console.Rainbow as Rb-import Penny.Cabin.Posts.Meta (Box)-import qualified Penny.Lincoln as L-import qualified Data.Text as X-import qualified Penny.Cabin.Posts.Types as Ty--data ChunkOpts = ChunkOpts-  { dateFormat :: Box -> X.Text-  , qtyFormat :: Box -> X.Text-  , balanceFormat :: L.Commodity -> L.Qty -> X.Text-  , fields :: F.Fields Bool-  , subAccountLength :: A.SubAccountLength-  , payeeAllocation :: A.Alloc-  , accountAllocation :: A.Alloc-  , spacers :: S.Spacers Int-  , reportWidth :: Ty.ReportWidth-  }--growOpts :: ChunkOpts -> G.GrowOpts-growOpts c = G.GrowOpts-  { 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.allocations = A.Fields { A.payee = payeeAllocation c-                             , A.account = 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.reportWidth = reportWidth c-  , B.spacers = spacers c-  }--makeChunk-  :: E.Changers-  -> ChunkOpts-  -> [Box]-  -> [Rb.Chunk]-makeChunk ch c bs =-  let fmapSnd = fmap (fmap snd)-      fmapFst = fmap (fmap fst)-      gFldW = fmap (fmap snd) gFlds-      aFldW = fmapSnd aFlds-      gFlds = G.growCells ch (growOpts c) bs-      aFlds = A.payeeAndAcct ch (allocatedOpts c gFldW) bs-      bFlds = B.bottomRows ch (bottomOpts c gFldW aFldW) bs-      topCells = B.topRowCells (fmapFst gFlds) (fmap (fmap fst) aFlds)-      withSpacers = B.mergeWithSpacers topCells (spacers c)-      topRows = makeTopRows ch withSpacers-      bottomRows = makeBottomRows bFlds-  in makeAllRows topRows bottomRows---topRowsCells-  :: B.TopRowCells (Maybe [R.ColumnSpec], Maybe Int)-  -> [[(R.ColumnSpec, Maybe R.ColumnSpec)]]-topRowsCells t = let-  toWithSpc (mayCs, maySp) = case mayCs of-    Nothing -> Nothing-    Just cs -> Just (makeSpacers cs maySp)-  f mayPairList acc = case mayPairList of-    Nothing -> acc-    (Just pairList) -> pairList : acc-  in transpose $ Fdbl.foldr f [] (fmap toWithSpc t)--makeRow :: E.Changers -> [(R.ColumnSpec, Maybe R.ColumnSpec)] -> [Rb.Chunk]-makeRow ch = R.row ch . foldr f [] where-  f (c, mayC) acc = case mayC of-    Nothing -> c:acc-    Just spcr -> c:spcr:acc---makeSpacers-  :: [R.ColumnSpec]-  -> Maybe Int-  -> [(R.ColumnSpec, Maybe R.ColumnSpec)]-makeSpacers cs mayI = case mayI of-  Nothing -> map (\c -> (c, Nothing)) cs-  Just i -> makeEvenOddSpacers cs i--makeEvenOddSpacers-  :: [R.ColumnSpec]-  -> Int-  -> [(R.ColumnSpec, Maybe R.ColumnSpec)]-makeEvenOddSpacers cs i = let absI = abs i in-  if absI == 0-  then map (\c -> (c, Nothing)) cs-  else let-    spcrs = cycle [Just $ mkSpcr evenTs, Just $ mkSpcr oddTs]-    mkSpcr ts = R.ColumnSpec R.LeftJustify (R.Width absI) ts []-    evenTs = (E.Other, E.Even)-    oddTs = (E.Other, E.Odd)-    in zip cs spcrs--makeTopRows-  :: E.Changers-  -> B.TopRowCells (Maybe [R.ColumnSpec], Maybe Int)-  -> Maybe [[Rb.Chunk]]-makeTopRows ch trc =-  if Fdbl.all (isNothing . fst) trc-  then Nothing-  else Just $ map (makeRow ch) . topRowsCells $ trc---makeBottomRows ::-  B.Fields (Maybe [[Rb.Chunk]])-  -> Maybe [[[Rb.Chunk]]]-makeBottomRows flds =-  if Fdbl.all isNothing flds-  then Nothing-  else Just . transpose . catMaybes . Fdbl.toList $ flds--makeAllRows :: Maybe [[Rb.Chunk]] -> Maybe [[[Rb.Chunk]]] -> [Rb.Chunk]-makeAllRows mayrs mayrrs = case (mayrs, mayrrs) of-  (Nothing, Nothing) -> []-  (Just rs, Nothing) -> concat rs-  (Nothing, Just rrs) -> concat . concat $ rrs-  (Just rs, Just rrs) -> concat $ zipWith f rs rrs where-    f topRow botRows = concat [topRow, concat botRows]--

@@ -1,199 +0,0 @@--- | Fields that can appear in the Posts report.-module Penny.Cabin.Posts.Fields where--import Control.Applicative(Applicative(pure, (<*>)))-import qualified Data.Foldable as F--data Fields a = Fields-  { globalTransaction :: a-  , revGlobalTransaction :: a-  , globalPosting :: a-  , revGlobalPosting :: a-  , fileTransaction :: a-  , revFileTransaction :: a-  , filePosting :: a-  , revFilePosting :: a-  , filtered :: a-  , revFiltered :: a-  , sorted :: a-  , revSorted :: a-  , visible :: a-  , revVisible :: a-  , lineNum :: a-  , date :: a-  , flag :: a-  , number :: a-  , payee :: a-  , account :: a-  , postingDrCr :: a-  , postingCmdty :: a-  , postingQty :: a-  , totalDrCr :: a-  , totalCmdty :: a-  , totalQty :: a-  , tags :: a-  , memo :: a-  , filename :: a-  } deriving (Show, Eq)--instance Functor Fields where-  fmap f fa = Fields {-    globalTransaction = f (globalTransaction fa)-    , revGlobalTransaction = f (revGlobalTransaction fa)-    , globalPosting = f (globalPosting fa)-    , revGlobalPosting = f (revGlobalPosting fa)-    , fileTransaction = f (fileTransaction fa)-    , revFileTransaction = f (revFileTransaction fa)-    , filePosting = f (filePosting fa)-    , revFilePosting = f (revFilePosting fa)-    , filtered = f (filtered fa)-    , revFiltered = f (revFiltered fa)-    , sorted = f (sorted fa)-    , revSorted = f (revSorted fa)-    , visible = f (visible fa)-    , revVisible = f (revVisible fa)-    , lineNum = f (lineNum fa)-    , date = f (date fa)-    , flag = f (flag fa)-    , number = f (number fa)-    , payee = f (payee fa)-    , account = f (account fa)-    , postingDrCr = f (postingDrCr fa)-    , postingCmdty = f (postingCmdty fa)-    , postingQty = f (postingQty fa)-    , totalDrCr = f (totalDrCr fa)-    , totalCmdty = f (totalCmdty fa)-    , totalQty = f (totalQty fa)-    , tags = f (tags fa)-    , memo = f (memo fa)-    , filename = f (filename fa) }--instance Applicative Fields where-  pure a = Fields {-    globalTransaction = a-    , revGlobalTransaction = a-    , globalPosting = a-    , revGlobalPosting = a-    , fileTransaction = a-    , revFileTransaction = a-    , filePosting = a-    , revFilePosting = a-    , filtered = a-    , revFiltered = a-    , sorted = a-    , revSorted = a-    , visible = a-    , revVisible = a-    , lineNum = a-    , date = a-    , flag = a-    , number = a-    , payee = a-    , account = a-    , postingDrCr = a-    , postingCmdty = a-    , postingQty = a-    , totalDrCr = a-    , totalCmdty = a-    , totalQty = a-    , tags = a-    , memo = a-    , filename = a }--  ff <*> fa = Fields {-    globalTransaction = globalTransaction ff (globalTransaction fa)-    , revGlobalTransaction = revGlobalTransaction ff-                             (revGlobalTransaction fa)-    , globalPosting = globalPosting ff (globalPosting fa)-    , revGlobalPosting = revGlobalPosting ff (revGlobalPosting fa)-    , fileTransaction = fileTransaction ff (fileTransaction fa)-    , revFileTransaction = revFileTransaction ff (revFileTransaction fa)-    , filePosting = filePosting ff (filePosting fa)-    , revFilePosting = revFilePosting ff (revFilePosting fa)-    , filtered = filtered ff (filtered fa)-    , revFiltered = revFiltered ff (revFiltered fa)-    , sorted = sorted ff (sorted fa)-    , revSorted = revSorted ff (revSorted fa)-    , visible = visible ff (visible fa)-    , revVisible = revVisible ff (revVisible fa)-    , lineNum = lineNum ff (lineNum fa)-    , date = date ff (date fa)-    , flag = flag ff (flag fa)-    , number = number ff (number fa)-    , payee = payee ff (payee fa)-    , account = account ff (account fa)-    , postingDrCr = postingDrCr ff (postingDrCr fa)-    , postingCmdty = postingCmdty ff (postingCmdty fa)-    , postingQty = postingQty ff (postingQty fa)-    , totalDrCr = totalDrCr ff (totalDrCr fa)-    , totalCmdty = totalCmdty ff (totalCmdty fa)-    , totalQty = totalQty ff (totalQty fa)-    , tags = tags ff (tags fa)-    , memo = memo ff (memo fa)-    , filename = filename ff (filename fa) }--instance F.Foldable Fields where-  foldr f z t =-    f (globalTransaction t)-    (f (revGlobalTransaction t)-     (f (globalPosting t)-      (f (revGlobalPosting t)-       (f (fileTransaction t)-        (f (revFileTransaction t)-         (f (filePosting t)-          (f (revFilePosting t)-           (f (filtered t)-            (f (revFiltered t)-             (f (sorted t)-              (f (revSorted t)-               (f (visible t)-                (f (revVisible t)-                 (f (lineNum t)-                  (f (date t)-                   (f (flag t)-                    (f (number t)-                     (f (payee t)-                      (f (account t)-                       (f (postingDrCr t)-                        (f (postingCmdty t)-                         (f (postingQty t)-                          (f (totalDrCr t)-                           (f (totalCmdty t)-                            (f (totalQty t)-                             (f (tags t)-                              (f (memo t)-                               (f (filename t) z))))))))))))))))))))))))))))---fieldNames :: Fields String-fieldNames = Fields-  { globalTransaction    = "globalTransaction"-  , revGlobalTransaction = "revGlobalTransaction"-  , globalPosting        = "globalPosting"-  , revGlobalPosting     = "revGlobalPosting"-  , fileTransaction      = "fileTransaction"-  , revFileTransaction   = "revFileTransaction"-  , filePosting          = "filePosting"-  , revFilePosting       = "revFilePosting"-  , filtered             = "filtered"-  , revFiltered          = "revFiltered"-  , sorted               = "sorted"-  , revSorted            = "revSorted"-  , visible              = "visible"-  , revVisible           = "revVisible"-  , lineNum              = "lineNum"-  , date                 = "date"-  , flag                 = "flag"-  , number               = "number"-  , payee                = "payee"-  , account              = "account"-  , postingDrCr          = "postingDrCr"-  , postingCmdty         = "postingCmdty"-  , postingQty           = "postingQty"-  , totalDrCr            = "totalDrCr"-  , totalCmdty           = "totalCmdty"-  , totalQty             = "totalQty"-  , tags                 = "tags"-  , memo                 = "memo"-  , filename             = "filename"-  }

@@ -1,596 +0,0 @@--- | Calculates cells that "grow to fit." These cells grow to fit the--- widest cell in the column. No information is ever truncated from--- these cells (what use is a truncated dollar amount?)-module Penny.Cabin.Posts.Growers (-  GrowOpts(..),-  growCells, Fields(..), grownWidth,-  eFields, EFields(..), pairWithSpacer) where--import Control.Applicative((<$>), Applicative(pure, (<*>)))-import qualified Data.Foldable as Fdbl-import Data.Map (elems)-import qualified Data.Map as Map-import qualified Data.Semigroup as Semi-import Data.Semigroup ((<>))-import Data.Text (Text, pack, empty)-import qualified Data.Text as X-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.Row as R-import qualified Penny.Cabin.Scheme as E-import qualified Penny.Liberty as Ly-import qualified Penny.Lincoln as L-import qualified Penny.Lincoln.Queries as Q-import qualified System.Console.Rainbow as Rb----- | All the options needed to grow the cells.-data GrowOpts = GrowOpts-  { dateFormat :: Box -> X.Text-  , qtyFormat :: Box -> X.Text-  , balanceFormat :: L.Commodity -> L.Qty -> 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--- width undetermined. Then it determines the widest line in each--- column. Finally it adjusts each cell in the column so that it is--- that maximum width.------ Returns a list of rows, and a Fields holding the width of each--- cell. Each of these widths will be at least 1; fields that were in--- the report but that ended up having no width are changed to--- Nothing.-growCells-  :: E.Changers-  -> GrowOpts-  -> [Box]-  -> Fields (Maybe ([R.ColumnSpec], Int))-growCells ch o infos = toPair <$> wanted <*> growers where-  toPair b gwr-    | b =-      let cs = map (gwr o ch) 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 . fields $ o--widestLine :: PreSpec -> Int-widestLine (PreSpec _ _ bs) =-  case bs of-    [] -> 0-    xs -> maximum . map (X.length . Rb.chunkText) $ xs--data PreSpec = PreSpec {-  _justification :: R.Justification-  , _padSpec :: (E.Label, E.EvenOdd)-  , _bits :: [Rb.Chunk] }----- | Given a PreSpec and a width, create a ColumnSpec of the right--- size.-sizer :: R.Width -> PreSpec -> R.ColumnSpec-sizer w (PreSpec j ts bs) = R.ColumnSpec j w ts bs---- | Makes a left justified cell that is only one line long. The width--- is unset.-oneLine :: E.Changers -> Text -> E.Label -> Box -> PreSpec-oneLine chgrs t lbl b =-  let eo = E.fromVisibleNum . M.visibleNum . L.boxMeta $ b-      j = R.LeftJustify-      md = E.getEvenOddLabelValue lbl eo chgrs-      ck = [md $ Rb.plain t]-  in PreSpec j (lbl, eo) ck----- | Gets a Fields with each field filled with the function that fills--- the cells for that field.-growers :: Fields (GrowOpts -> E.Changers -> Box -> PreSpec)-growers = Fields-  { globalTransaction    = const getGlobalTransaction-  , revGlobalTransaction = const getRevGlobalTransaction-  , globalPosting        = const getGlobalPosting-  , revGlobalPosting     = const getRevGlobalPosting-  , fileTransaction      = const getFileTransaction-  , revFileTransaction   = const getRevFileTransaction-  , filePosting          = const getFilePosting-  , revFilePosting       = const getRevFilePosting-  , filtered             = const getFiltered-  , revFiltered          = const getRevFiltered-  , sorted               = const getSorted-  , revSorted            = const getRevSorted-  , visible              = const getVisible-  , revVisible           = const getRevVisible-  , lineNum              = const getLineNum-  , date                 = \o ch -> getDate ch (dateFormat o)-  , flag                 = const getFlag-  , number               = const getNumber-  , postingDrCr          = const getPostingDrCr-  , postingCmdty         = const getPostingCmdty-  , postingQty           = \o ch -> getPostingQty ch (qtyFormat o)-  , totalDrCr            = const getTotalDrCr-  , totalCmdty           = const getTotalCmdty-  , totalQty             = \o ch -> getTotalQty ch (balanceFormat o)-  }---- | Make a left justified cell one line long that shows a serial.-serialCellMaybe-  :: E.Changers-  -> (L.PostFam -> Maybe Int)-  -- ^ When applied to a Box, this function returns Just Int if the-  -- box has a serial, or Nothing if not.--  -> Box -> PreSpec-serialCellMaybe chgrs f b = oneLine chgrs t E.Other b-  where-    t = case f (L.boxPostFam b) of-      Nothing -> X.empty-      Just i -> X.pack . show $ i--serialCell-  :: E.Changers-  -> (M.PostMeta -> Int)-  -> Box -> PreSpec-serialCell chgrs f b = oneLine chgrs t E.Other b-  where-    t = pack . show . f . L.boxMeta $ b--getGlobalTransaction :: E.Changers -> Box -> PreSpec-getGlobalTransaction chgrs =-  serialCellMaybe chgrs (fmap (L.forward . L.unGlobalTransaction)-                        . Q.globalTransaction)--getRevGlobalTransaction :: E.Changers -> Box -> PreSpec-getRevGlobalTransaction chgrs =-  serialCellMaybe chgrs (fmap (L.backward . L.unGlobalTransaction)-                        . Q.globalTransaction)--getGlobalPosting :: E.Changers -> Box -> PreSpec-getGlobalPosting chgrs =-  serialCellMaybe chgrs (fmap (L.forward . L.unGlobalPosting)-                        . Q.globalPosting)--getRevGlobalPosting :: E.Changers -> Box -> PreSpec-getRevGlobalPosting chgrs =-  serialCellMaybe chgrs (fmap (L.backward . L.unGlobalPosting)-                   . Q.globalPosting)--getFileTransaction :: E.Changers -> Box -> PreSpec-getFileTransaction chgrs =-  serialCellMaybe chgrs (fmap (L.forward . L.unFileTransaction)-                   . Q.fileTransaction)--getRevFileTransaction :: E.Changers -> Box -> PreSpec-getRevFileTransaction chgrs =-  serialCellMaybe chgrs (fmap (L.backward . L.unFileTransaction)-                   . Q.fileTransaction)--getFilePosting :: E.Changers -> Box -> PreSpec-getFilePosting chgrs =-  serialCellMaybe chgrs (fmap (L.forward . L.unFilePosting)-                   . Q.filePosting)--getRevFilePosting :: E.Changers -> Box -> PreSpec-getRevFilePosting chgrs =-  serialCellMaybe chgrs (fmap (L.backward . L.unFilePosting)-                   . Q.filePosting)--getSorted :: E.Changers -> Box -> PreSpec-getSorted chgrs =-  serialCell chgrs (L.forward . Ly.unSortedNum . M.sortedNum)--getRevSorted :: E.Changers -> Box -> PreSpec-getRevSorted chgrs =-  serialCell chgrs (L.backward . Ly.unSortedNum . M.sortedNum)--getFiltered :: E.Changers -> Box -> PreSpec-getFiltered chgrs =-  serialCell chgrs (L.forward . Ly.unFilteredNum . M.filteredNum)--getRevFiltered :: E.Changers -> Box -> PreSpec-getRevFiltered chgrs =-  serialCell chgrs (L.backward . Ly.unFilteredNum . M.filteredNum)--getVisible :: E.Changers -> Box -> PreSpec-getVisible chgrs =-  serialCell chgrs (L.forward . M.unVisibleNum . M.visibleNum)--getRevVisible :: E.Changers -> Box -> PreSpec-getRevVisible chgrs =-  serialCell chgrs (L.backward . M.unVisibleNum . M.visibleNum)---getLineNum :: E.Changers -> Box -> PreSpec-getLineNum chgrs b = oneLine chgrs t E.Other b where-  lineTxt = pack . show . L.unPostingLine-  t = maybe empty lineTxt (Q.postingLine . L.boxPostFam $ b)--getDate :: E.Changers -> (Box -> X.Text) -> Box -> PreSpec-getDate chgrs gd b = oneLine chgrs (gd b) E.Other b--getFlag :: E.Changers -> Box -> PreSpec-getFlag chgrs i = oneLine chgrs t E.Other i where-  t = maybe empty L.text (Q.flag . L.boxPostFam $ i)--getNumber :: E.Changers -> Box -> PreSpec-getNumber chgrs i = oneLine chgrs t E.Other i where-  t = maybe empty L.text (Q.number . L.boxPostFam $ i)--dcTxt :: L.DrCr -> Text-dcTxt L.Debit = X.singleton '<'-dcTxt L.Credit = X.singleton '>'---- | Gives a one-line cell that is colored according to whether the--- posting is a debit or credit.-coloredPostingCell :: E.Changers -> Text -> Box -> PreSpec-coloredPostingCell chgrs t i = PreSpec j (lbl, eo) [bit] where-  j = R.LeftJustify-  lbl = case Q.drCr . L.boxPostFam $ i of-    L.Debit -> E.Debit-    L.Credit -> E.Credit-  eo = E.fromVisibleNum . M.visibleNum . L.boxMeta $ i-  md = E.getEvenOddLabelValue lbl eo chgrs-  bit = md $ Rb.plain t---getPostingDrCr :: E.Changers -> Box -> PreSpec-getPostingDrCr ch i = coloredPostingCell ch t i where-  t = dcTxt . Q.drCr . L.boxPostFam $ i--getPostingCmdty :: E.Changers -> Box -> PreSpec-getPostingCmdty ch i = coloredPostingCell ch t i where-  t = L.unCommodity . Q.commodity . L.boxPostFam $ i--getPostingQty :: E.Changers -> (Box -> X.Text) -> Box -> PreSpec-getPostingQty ch qf i = coloredPostingCell ch (qf i) i--getTotalDrCr :: E.Changers -> Box -> PreSpec-getTotalDrCr ch i =-  let vn = M.visibleNum . L.boxMeta $ i-      ps = (lbl, eo)-      dc = Q.drCr . L.boxPostFam $ i-      lbl = E.dcToLbl dc-      eo = E.fromVisibleNum vn-      bal = L.unBalance . M.balance . L.boxMeta $ i-      md = E.getEvenOddLabelValue lbl eo ch-      bits =-        if Map.null bal-        then [md . Rb.plain $ pack "--"]-        else let mkChk e = E.bottomLineToDrCr e eo ch-             in fmap mkChk . elems $ bal-      j = R.LeftJustify-  in PreSpec j ps bits--getTotalCmdty :: E.Changers -> Box -> PreSpec-getTotalCmdty ch i =-  let vn = M.visibleNum . L.boxMeta $ i-      j = R.RightJustify-      ps = (lbl, eo)-      dc = Q.drCr . L.boxPostFam $ i-      eo = E.fromVisibleNum vn-      lbl = E.dcToLbl dc-      bal = Map.toList . L.unBalance . M.balance . L.boxMeta $ i-      preChunks = E.balancesToCmdtys ch eo bal-  in PreSpec j ps preChunks--getTotalQty-  :: E.Changers-  -> (L.Commodity -> L.Qty -> X.Text)-  -> Box-  -> PreSpec-getTotalQty ch balFmt i =-  let vn = M.visibleNum . L.boxMeta $ i-      j = R.LeftJustify-      dc = Q.drCr . L.boxPostFam $ i-      ps = (E.dcToLbl dc, eo)-      eo = E.fromVisibleNum vn-      bal = Map.toList . L.unBalance . M.balance . L.boxMeta $ i-      preChunks = E.balanceToQtys ch balFmt eo bal-  in PreSpec j ps preChunks--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 =-  EGlobalTransaction-  | ERevGlobalTransaction-  | EGlobalPosting-  | ERevGlobalPosting-  | EFileTransaction-  | ERevFileTransaction-  | EFilePosting-  | ERevFilePosting-  | EFiltered-  | ERevFiltered-  | ESorted-  | ERevSorted-  | EVisible-  | ERevVisible-  | ELineNum-  | EDate-  | EFlag-  | ENumber-  | EPostingDrCr-  | EPostingCmdty-  | EPostingQty-  | ETotalDrCr-  | ETotalCmdty-  | ETotalQty-  deriving (Show, Eq, Ord, Enum)---- | Returns a Fields where each record has its corresponding EField.-eFields :: Fields EFields-eFields = Fields-  { globalTransaction     = EGlobalTransaction-  , revGlobalTransaction = ERevGlobalTransaction-  , globalPosting        = EGlobalPosting-  , revGlobalPosting     = ERevGlobalPosting-  , fileTransaction      = EFileTransaction-  , revFileTransaction   = ERevFileTransaction-  , filePosting          = EFilePosting-  , revFilePosting       = ERevFilePosting-  , filtered             = EFiltered-  , revFiltered          = ERevFiltered-  , sorted               = ESorted-  , revSorted            = ERevSorted-  , visible              = EVisible-  , revVisible           = ERevVisible-  , lineNum              = ELineNum-  , date                 = EDate-  , flag                 = EFlag-  , number               = ENumber-  , postingDrCr          = EPostingDrCr-  , postingCmdty         = EPostingCmdty-  , postingQty           = EPostingQty-  , totalDrCr            = ETotalDrCr-  , totalCmdty           = ETotalCmdty-  , totalQty             = ETotalQty }---- | All growing fields.-data Fields a = Fields-  { globalTransaction    :: a-  , revGlobalTransaction :: a-  , globalPosting        :: a-  , revGlobalPosting     :: a-  , fileTransaction      :: a-  , revFileTransaction   :: a-  , filePosting          :: a-  , revFilePosting       :: a-  , filtered             :: a-  , revFiltered          :: a-  , sorted               :: a-  , revSorted            :: a-  , visible              :: a-  , revVisible           :: a-  , lineNum              :: a-    -- ^ The line number from the posting's metadata-  , date                 :: a-  , flag                 :: a-  , number               :: a-  , postingDrCr          :: a-  , postingCmdty         :: a-  , postingQty           :: a-  , totalDrCr            :: a-  , totalCmdty           :: a-  , totalQty             :: a }-  deriving (Show, Eq)--instance Fdbl.Foldable Fields where-  foldr f z i =-    f (globalTransaction i)-    (f (revGlobalTransaction i)-     (f (globalPosting i)-      (f (revGlobalPosting i)-       (f (fileTransaction i)-        (f (revFileTransaction i)-         (f (filePosting i)-          (f (revFilePosting i)-           (f (filtered i)-            (f (revFiltered i)-             (f (sorted i)-              (f (revSorted i)-               (f (visible i)-                (f (revVisible i)-                 (f (lineNum i)-                  (f (date i)-                   (f (flag i)-                    (f (number i)-                     (f (postingDrCr i)-                      (f (postingCmdty i)-                       (f (postingQty i)-                        (f (totalDrCr i)-                         (f (totalCmdty i)-                          (f (totalQty i) z)))))))))))))))))))))))--instance Functor Fields where-  fmap f i = Fields-    { globalTransaction    = f (globalTransaction    i)-    , revGlobalTransaction = f (revGlobalTransaction i)-    , globalPosting        = f (globalPosting        i)-    , revGlobalPosting     = f (revGlobalPosting     i)-    , fileTransaction      = f (fileTransaction      i)-    , revFileTransaction   = f (revFileTransaction   i)-    , filePosting          = f (filePosting          i)-    , revFilePosting       = f (revFilePosting       i)-    , filtered             = f (filtered             i)-    , revFiltered          = f (revFiltered          i)-    , sorted               = f (sorted               i)-    , revSorted            = f (revSorted            i)-    , visible              = f (visible              i)-    , revVisible           = f (revVisible           i)-    , lineNum              = f (lineNum              i)-    , date                 = f (date                 i)-    , flag                 = f (flag                 i)-    , number               = f (number               i)-    , postingDrCr          = f (postingDrCr          i)-    , postingCmdty         = f (postingCmdty         i)-    , postingQty           = f (postingQty           i)-    , totalDrCr            = f (totalDrCr            i)-    , totalCmdty           = f (totalCmdty           i)-    , totalQty             = f (totalQty             i) }--instance Applicative Fields where-  pure a = Fields-    { globalTransaction     = a-    , revGlobalTransaction = a-    , globalPosting        = a-    , revGlobalPosting     = a-    , fileTransaction      = a-    , revFileTransaction   = a-    , filePosting          = a-    , revFilePosting       = a-    , filtered             = a-    , revFiltered          = a-    , sorted               = a-    , revSorted            = a-    , visible              = a-    , revVisible           = a-    , lineNum              = a-    , date                 = a-    , flag                 = a-    , number               = a-    , postingDrCr          = a-    , postingCmdty         = a-    , postingQty           = a-    , totalDrCr            = a-    , totalCmdty           = a-    , totalQty             = a }--  fl <*> fa = Fields-    { globalTransaction    = globalTransaction    fl (globalTransaction    fa)-    , revGlobalTransaction = revGlobalTransaction fl (revGlobalTransaction fa)-    , globalPosting        = globalPosting        fl (globalPosting        fa)-    , revGlobalPosting     = revGlobalPosting     fl (revGlobalPosting     fa)-    , fileTransaction      = fileTransaction      fl (fileTransaction      fa)-    , revFileTransaction   = revFileTransaction   fl (revFileTransaction   fa)-    , filePosting          = filePosting          fl (filePosting          fa)-    , revFilePosting       = revFilePosting       fl (revFilePosting       fa)-    , filtered             = filtered             fl (filtered             fa)-    , revFiltered          = revFiltered          fl (revFiltered          fa)-    , sorted               = sorted               fl (sorted               fa)-    , revSorted            = revSorted            fl (revSorted            fa)-    , visible              = visible              fl (visible              fa)-    , revVisible           = revVisible           fl (revVisible           fa)-    , lineNum              = lineNum              fl (lineNum              fa)-    , date                 = date                 fl (date                 fa)-    , flag                 = flag                 fl (flag                 fa)-    , number               = number               fl (number               fa)-    , postingDrCr          = postingDrCr          fl (postingDrCr          fa)-    , postingCmdty         = postingCmdty         fl (postingCmdty         fa)-    , postingQty           = postingQty           fl (postingQty           fa)-    , totalDrCr            = totalDrCr            fl (totalDrCr            fa)-    , totalCmdty           = totalCmdty           fl (totalCmdty           fa)-    , totalQty             = totalQty             fl (totalQty             fa) }---- | 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 -> 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))-  , globalPosting        = (globalPosting        f, Just (S.globalPosting        s))-  , revGlobalPosting     = (revGlobalPosting     f, Just (S.revGlobalPosting     s))-  , fileTransaction      = (fileTransaction      f, Just (S.fileTransaction      s))-  , revFileTransaction   = (revFileTransaction   f, Just (S.revFileTransaction   s))-  , filePosting          = (filePosting          f, Just (S.filePosting          s))-  , revFilePosting       = (revFilePosting       f, Just (S.revFilePosting       s))-  , filtered             = (filtered             f, Just (S.filtered             s))-  , revFiltered          = (revFiltered          f, Just (S.revFiltered          s))-  , sorted               = (sorted               f, Just (S.sorted               s))-  , revSorted            = (revSorted            f, Just (S.revSorted            s))-  , visible              = (visible              f, Just (S.visible              s))-  , revVisible           = (revVisible           f, Just (S.revVisible           s))-  , lineNum              = (lineNum              f, Just (S.lineNum              s))-  , date                 = (date                 f, Just (S.date                 s))-  , flag                 = (flag                 f, Just (S.flag                 s))-  , number               = (number               f, Just (S.number               s))-  , postingDrCr          = (postingDrCr          f, Just (S.postingDrCr          s))-  , postingCmdty         = (postingCmdty         f, Just (S.postingCmdty         s))-  , postingQty           = (postingQty           f, Just (S.postingQty           s))-  , totalDrCr            = (totalDrCr            f, Just (S.totalDrCr            s))-  , totalCmdty           = (totalCmdty           f, Just (S.totalCmdty           s))-  , totalQty             = (totalQty             f, Nothing                        ) }---- | Reduces a set of Fields to a single value.-reduce :: Semi.Semigroup s => Fields s -> s-reduce f =-  globalTransaction       f-  <> revGlobalTransaction f-  <> globalPosting        f-  <> revGlobalPosting     f-  <> fileTransaction      f-  <> revFileTransaction   f-  <> filePosting          f-  <> revFilePosting       f-  <> filtered             f-  <> revFiltered          f-  <> sorted               f-  <> revSorted            f-  <> visible              f-  <> revVisible           f-  <> lineNum              f-  <> date                 f-  <> flag                 f-  <> number               f-  <> postingDrCr          f-  <> postingCmdty         f-  <> postingQty           f-  <> totalDrCr            f-  <> totalCmdty           f-  <> totalQty             f---- | Compute the width of all Grown cells, including any applicable--- spacer cells.-grownWidth ::-  Fields (Maybe Int)-  -> S.Spacers Int-  -> Int-grownWidth fs ss =-  Semi.getSum-  . reduce-  . fmap Semi.Sum-  . fmap fieldWidth-  $ pairWithSpacer fs ss---- | Compute the field width of a single field and its spacer. The--- first element of the tuple is the field width, if present; the--- second element of the tuple is the width of the spacer. If there is--- no field, returns 0.-fieldWidth :: (Maybe Int, Maybe Int) -> Int-fieldWidth (m1, m2) = case m1 of-  Nothing -> 0-  Just i1 -> case m2 of-    Just i2 -> if i2 > 0 then i1 + i2 else i1-    Nothing -> i1-