penny-lib 0.20.0.0 → 0.21.0.0

raw patch · 43 files changed

+1484/−930 lines, 43 filesdep +randomdep ~multiargPVP ok

version bump matches the API change (PVP)

Dependencies added: random

Dependency ranges changed: multiarg

API changes (from Hackage documentation)

Files

• lib/Penny.hs +142/−29
• lib/Penny/Brenner.hs +42/−54
• lib/Penny/Brenner/Clear.hs +12/−12
• lib/Penny/Brenner/Database.hs +11/−12
• lib/Penny/Brenner/Import.hs +13/−13
• lib/Penny/Brenner/Info.hs +30/−34
• lib/Penny/Brenner/Merge.hs +33/−23
• lib/Penny/Brenner/Print.hs +11/−13
• lib/Penny/Brenner/Types.hs +10/−10
• lib/Penny/Brenner/Util.hs +4/−4
• lib/Penny/Cabin/Balance/Convert.hs +24/−23
• lib/Penny/Cabin/Balance/Convert/Options.hs +0/−4
• lib/Penny/Cabin/Balance/MultiCommodity.hs +20/−29
• lib/Penny/Cabin/Balance/MultiCommodity/Chunker.hs +4/−4
• lib/Penny/Cabin/Balance/Util.hs +5/−2
• lib/Penny/Cabin/Interface.hs +16/−9
• lib/Penny/Cabin/Posts.hs +20/−44
• lib/Penny/Cabin/Posts/Chunk.hs +1/−3
• lib/Penny/Cabin/Posts/Growers.hs +13/−6
• lib/Penny/Cabin/Posts/Meta.hs +2/−1
• lib/Penny/Cabin/Scheme.hs +4/−3
• lib/Penny/Copper.hs +0/−2
• lib/Penny/Copper/Interface.hs +2/−15
• lib/Penny/Copper/Parsec.hs +158/−32
• lib/Penny/Copper/Render.hs +92/−110
• lib/Penny/Liberty.hs +27/−28
• lib/Penny/Lincoln.hs +8/−3
• lib/Penny/Lincoln/Balance.hs +5/−7
• lib/Penny/Lincoln/Bits.hs +7/−23
• lib/Penny/Lincoln/Bits/DateTime.hs +4/−24
• lib/Penny/Lincoln/Bits/Open.hs +34/−86
• lib/Penny/Lincoln/Bits/Price.hs +7/−18
• lib/Penny/Lincoln/Bits/Qty.hs +507/−73
• lib/Penny/Lincoln/Ents.hs +37/−41
• lib/Penny/Lincoln/Equivalent.hs +29/−0
• lib/Penny/Lincoln/PriceDb.hs +5/−4
• lib/Penny/Lincoln/Queries.hs +11/−7
• lib/Penny/Lincoln/Queries/Siblings.hs +7/−7
• lib/Penny/Wheat.hs +21/−19
• lib/Penny/Zinc.hs +48/−48
• penny-lib.cabal +53/−21
• tests/penny-gibberish.hs +3/−28
• tests/penny-test.hs +2/−2

@@ -23,9 +23,6 @@   -- ** Expression type   , Exp.ExprDesc(..) -  -- ** Formatting quantities-  , defaultQtyFormat-   -- ** Convert report options   , Target(..)   , CP.SortBy(..)@@ -35,9 +32,15 @@   , Spacers(..)   , widthFromRuntime   , Ps.yearMonthDay-  , Ps.qtyAsIs-  , Ps.balanceAsIs +  -- ** Formatting quantities+  , S3(..)+  , qtyFormatter+  , getQtyFormat+  , L.Radix(..)+  , L.PeriodGrp(..)+  , L.CommaGrp(..)+   -- ** Runtime   , S.Runtime   , S.environment@@ -84,7 +87,11 @@     -- bin/doc/dependencies.dot in the Penny git repository.   ) where +import Data.Ord (comparing)+import Data.List (sortBy, groupBy)+import Data.Maybe (mapMaybe, fromMaybe) import qualified Data.Text as X+import qualified Data.Map as Map import Data.Version (Version(..)) import qualified Penny.Cabin.Balance.Convert as Conv import qualified Penny.Cabin.Balance.Convert.Parser as CP@@ -100,12 +107,23 @@ 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.Copper as Cop+import Penny.Steel.Sums+import qualified Penny.Steel.Sums as Su 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 +-- | A function used to format quantities.+type FormatQty+  = [Cop.LedgerItem]+  -- ^ All parsed items++  -> L.Amount L.Qty+  -> X.Text+ -- | 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.@@ -142,9 +160,10 @@     -- 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.+  , formatQty :: FormatQty+    -- ^ How to format quantities. This affects only quantities that+    -- are not parsed from the ledger.  Examples include calculated+    -- totals and inferred quantities.  Affects all reports.    , balanceShowZeroBalances :: Bool     -- ^ Show zero balances in the balance report? If True, show them;@@ -168,10 +187,6 @@   , 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. @@ -186,16 +201,6 @@   , postingsDateFormat :: (M.PostMeta, L.Posting) -> X.Text     -- ^ How to format dates in the postings report. -  , postingsQtyFormat :: (M.PostMeta, L.Posting) -> 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@@ -230,6 +235,119 @@     -- the absolute value of the field is taken.)   } +-- | Provides a function to use in the 'formatQty' field. This formats+-- quantities that were not parsed in the ledger.  It first consults a+-- list of all items that were parsed from the ledger.  It examines+-- these items to determine if another item with the same commodity+-- already exists in the ledger.+--+-- If other items with the same commodity exist in the ledger, the+-- radix point most frequently occurring amongst those items is+-- used. If at least one of these items (with this radix point) also+-- has grouped digits, then the quantity will be formatted with+-- grouped digits; otherwise, no digit grouping is performed. If digit+-- grouping is performed, it is done according to the following rules:+--+-- * only digits to the left of the radix point are grouped+--+-- * grouping is performed only if the number has at least five+-- digits. Therefore, 1234 is not grouped, but 1,234.5 is grouped, as+-- is 12,345+--+-- * the character most frequently appearing as a grouping character+-- (for this particular commodity and radix point) is used to perform+-- grouping+--+-- * digits are grouped into groups of 3 digits+--+-- If a radix point cannot be determined from the quantities for a+-- given commodity, then the radix point appearing most frequently for+-- all commodities is used.  If it's impossible to determine a radix+-- point from all commodities, then the given default radix point and+-- digit grouping (if desired) is used.+--+-- This function builds a map internally which holds all the+-- formatting information; it might be expensive to build, so the+-- function is written to be partially applied.++qtyFormatter+  :: Su.S3 L.Radix L.PeriodGrp L.CommaGrp+  -- ^ What to do if no radix or grouping information can be+  -- determined from the ledger.  Pass Radix if you want to use a+  -- radix point but no grouping; a PeriodGrp if you want to use a+  -- period for a radix point and the given grouping character, or a+  -- CommaGrp if you want to use a comma for a radix point and the+  -- given grouping character.++  -> FormatQty+qtyFormatter df ls =+  let getFmt = getQtyFormat df ls+  in \a -> L.showQtyRep . L.qtyToRep (getFmt a) . L.qty $ a++-- | Obtains radix and grouping information for a particular commodity+-- and quantity, but does not actually perform the formatting.+getQtyFormat+  :: Su.S3 L.Radix L.PeriodGrp L.CommaGrp+  -- ^ What to do if no radix or grouping information can be+  -- determined from the ledger.  Pass Radix if you want to use a+  -- radix point but no grouping; a PeriodGrp if you want to use a+  -- period for a radix point and the given grouping character, or a+  -- CommaGrp if you want to use a comma for a radix point and the+  -- given grouping character.++  -> [Cop.LedgerItem]+  -> L.Amount L.Qty+  -> Su.S3 L.Radix L.PeriodGrp L.CommaGrp+getQtyFormat df ls =+  let m = formattingMap ls+  in \a -> fromMaybe df (Map.lookup (L.commodity a) m)+++-- | Returns a map of each commodity in the ledger and the grouping to+-- use for it.+formattingMap+  :: [Cop.LedgerItem]+  -> Map.Map L.Commodity (Su.S3 L.Radix L.PeriodGrp L.CommaGrp)+formattingMap+  = Map.fromList+  . mapMaybe formatCmdty+  . groupBy (\x y -> fst x == fst y)+  . sortBy (comparing fst)+  . allQtyRep++-- | Given a list of (Commodity, QtyRep) pairs, get a single pair of+-- the commodity and the grouping that should be used for this+-- commodity. The input list must not be empty. Returns Nothing if no+-- group data can be ascertained.+formatCmdty+  :: [(L.Commodity, L.QtyRep)]+  -> Maybe (L.Commodity, Su.S3 L.Radix L.PeriodGrp L.CommaGrp)+formatCmdty ls = case L.bestRadGroup . map snd $ ls of+  Nothing -> Nothing+  Just r -> Just (fst . head $ ls, r)++-- | Given a list of LedgerItem, create a list of pairs of commodities+-- and QtyRep.+allQtyRep :: [Cop.LedgerItem] -> [(L.Commodity, L.QtyRep)]+allQtyRep = concatMap toPairs+  where+    toPairs i = case i of+      Su.S4a t ->+        mapMaybe toEntPair+        . L.unEnts+        . snd+        . L.unTransaction+        $ t+      Su.S4b p ->+        [( L.unTo . L.to . L.price $ p+        , L.unCountPerUnit . L.countPerUnit . L.price $ p)]+      _ -> []++toEntPair :: L.Ent m -> Maybe (L.Commodity, L.QtyRep)+toEntPair e = case L.entry e of+  Left en -> Just (L.commodity . L.amount $ en, L.qty . L.amount $ en)+  Right _ -> Nothing+ -- | Creates an IO action that you can use for the main function. runPenny   :: Version@@ -278,7 +396,7 @@       cd = toConvertDefaults df       pd = toPostingsDefaults df   in [ Ps.zincReport pd-     , MC.parseReport (balanceFormat df) bd+     , MC.parseReport bd      , Conv.cmdLineReport cd      ] @@ -292,6 +410,7 @@   , Z.moreSchemes = additionalSchemes d   , Z.sorter = sorter d   , Z.exprDesc = expressionType d+  , Z.formatQty = formatQty d   }  toBalanceDefaults :: Defaults -> MP.ParseOpts@@ -308,7 +427,6 @@   , ConvOpts.target = convTarget . convertTarget $ d   , ConvOpts.sortOrder = convertOrder d   , ConvOpts.sortBy = convertSortBy d-  , ConvOpts.format = convertFormat d   }  toPostingsDefaults :: Defaults -> Ps.ZincOpts@@ -318,8 +436,6 @@   , 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 =@@ -328,9 +444,6 @@       Ps.alloc . postingsAccountAllocation $ d   , Ps.spacers = convSpacers . postingsSpacers $ d   }--defaultQtyFormat :: L.Qty -> X.Text-defaultQtyFormat = X.pack . L.prettyShowQty  data Spacers a = Spacers   { sGlobalTransaction :: a

@@ -8,8 +8,10 @@ module Penny.Brenner   ( FitAcct(..)   , Config(..)-  , R.GroupSpecs(..)-  , R.GroupSpec(..)+  , Su.S3(..)+  , L.Radix(..)+  , L.PeriodGrp(..)+  , L.CommaGrp(..)   , Y.Translator(..)   , L.Side(..)   , L.SpaceBetween(..)@@ -19,14 +21,11 @@   ) 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@@ -34,8 +33,10 @@ import qualified Penny.Brenner.Merge as M import qualified Penny.Brenner.OFX as O import qualified Penny.Brenner.Print as P-import qualified Penny.Brenner.Util as U+import qualified Penny.Steel.Sums as Su import qualified System.Console.MultiArg as MA+import System.Environment (getProgName)+import qualified System.Exit as Exit import qualified Control.Monad.Exception.Synchronous as Ex  -- | Brenner, with a pre-compiled configuration.@@ -46,44 +47,37 @@   -> IO () brennerMain v cf = do   let cf' = convertConfig cf-  join $ MA.modesWithHelp (help False) (globalOpts v)-                          (preProcessor cf')+  pn <- getProgName+  ei <- MA.modesIO (globalOpts v) (preProcessor cf')+  case ei of+    Left showHelp -> putStr (showHelp pn) >> Exit.exitSuccess+    Right g -> g +type GetHelp = MA.ProgName -> String+ -- | Parses global options for a pre-compiled configuration. globalOpts   :: V.Version   -- ^ Binary version-  -> [MA.OptSpec (Either (IO ()) Y.FitAcctName)]-globalOpts v =+  -> MA.Opts GetHelp Y.FitAcctName+globalOpts v = MA.optsHelpVersion help (Ly.version v)   [ MA.OptSpec ["fit-account"] "f"-  (MA.OneArg (Right . Y.FitAcctName . X.pack))-  , fmap Left (Ly.version v)+               (MA.OneArg (Y.FitAcctName . X.pack))   ]  -- | Pre-processes global options for a pre-compiled configuration. preProcessor   :: Y.Config-  -> [Either (IO ()) Y.FitAcctName]-  -> Either (a -> IO ()) [MA.Mode (IO ())]-preProcessor cf args =-  let (vers, as) = partitionEithers args-  in case vers of-      [] -> makeModes Nothing cf as-      x:_ -> Left (const x)---- | Makes modes for a pre-compiled configuration.-makeModes-  :: Maybe Y.ConfigLocation-  -> Y.Config   -> [Y.FitAcctName]-  -- ^ Names of financial institutions given on command line-  -> Either (a -> IO ()) [MA.Mode (IO ())]-makeModes cl cf as = Ex.toEither . Ex.mapException (const . U.errExit) $ do-  mayFi <- case as of+  -> Ex.Exceptional String+      (Either (IO ())+              [MA.Mode (MA.ProgName -> String) (IO ())])+preProcessor cf args = do+  mayFi <- case args of     [] -> return $ Y.defaultFitAcct cf     _ ->       let pdct a = Y.fitAcctName a == s-          s = last as+          s = last args           toFilter = case Y.defaultFitAcct cf of             Nothing -> Y.moreFitAccts cf             Just d -> d : Y.moreFitAccts cf@@ -96,34 +90,33 @@               "more than one financial institution account "               ++ "named " ++ (X.unpack . Y.unFitAcctName $ s)               ++ " configured."-  return . map (fmap (\f -> f cl cf mayFi)) $ allModes+  return . Right $ allModes cf mayFi  -- | Each mode takes a Maybe FitAcct. Even if every mode needs a -- FitAcct to function, they take a Maybe FitAcct because otherwise -- the user will not even get online help if a FitAcct is not -- supplied. Each mode must fail on its own if it actually needs a -- FitAcct.-type ModeFunc-  = Maybe Y.ConfigLocation-  -> Y.Config-  -> Maybe Y.FitAcct-  -> IO () -allModes :: [MA.Mode ModeFunc]-allModes =-  fmap (\f cl cf _ -> f cl cf) Info.mode-  : map (fmap (const . const))-        [C.mode, I.mode, M.mode, P.mode, D.mode]+allModes+  :: Y.Config+  -> Maybe Y.FitAcct+  -> [MA.Mode (MA.ProgName -> String) (IO ())]+allModes c a =+  [ C.mode a+  , I.mode a+  , Info.mode c+  , M.mode a+  , P.mode a+  , D.mode a ]  -- | Help for a pre-compiled configuration. help-  :: Bool-  -- ^ True if running under a dynamic configuration-  -> String+  :: String   -- ^ Program name    -> String-help dyn n = unlines ls+help n = unlines ls   where     ls = [ "usage: " ++ n ++ " [global-options]"             ++ " COMMAND [local-options]"@@ -142,11 +135,7 @@          , "  (use the \"info\" command to see which are available)."          , "  If this option does not appear,"          , "  the default account is used if there is one."-         ] ++ if not dyn then [] else-                  [ ""-                  , "-c, --config-file FILENAME"-                  , "  Specify configuration file location"-                  ]+         ]  -- | Information to configure a single financial institution account. data FitAcct = FitAcct@@ -177,10 +166,9 @@   , 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.+  , qtySpec :: Su.S3 L.Radix L.PeriodGrp L.CommaGrp+    -- ^ How to group digits when printing the resulting ledger.+    -- This affects only the postings created from the statement.    , translator :: Y.Translator     -- ^ See the documentation under the 'Translator' type for@@ -232,7 +220,7 @@   , 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.qtySpec = gs   , Y.translator = tl   , Y.side = sd   , Y.spaceBetween = sb

@@ -60,18 +60,18 @@   } deriving Show  -mode :: MA.Mode (Maybe Y.FitAcct -> IO ())-mode = MA.Mode-  { MA.mName = "clear"-  , MA.mIntersperse = MA.Intersperse-  , MA.mOpts = [fmap AOutput Ly.output]-  , MA.mPosArgs = return . APosArg-  , MA.mProcess = process-  , MA.mHelp = help-  }+mode :: Y.Mode+mode mayFa = MA.modeHelp+  "clear"                  -- Mode name+  help                     -- Help function+  (process mayFa)          -- Processor+  [fmap AOutput Ly.output] -- Options+  MA.Intersperse           -- interspersion+  (return . APosArg)       -- Posarg processor -process :: [Arg] -> Maybe Y.FitAcct -> IO ()-process as mayFa = do++process :: Maybe Y.FitAcct -> [Arg] -> IO ()+process mayFa as = do   fa <- U.getFitAcct mayFa   (csv, ls) <- case mapMaybe toPosArg as of     [] -> fail "clear: you must provide a postings file."@@ -96,7 +96,7 @@   when (not (Set.null left))     (fail $ "some postings were not cleared. "       ++ "Those not cleared:\n" ++ ppShow left)-  case mapM (R.item (Y.groupSpecs c)) led'' of+  case mapM (R.item Nothing) led'' of     Nothing ->       fail "could not render resulting ledger."     Just txts ->

@@ -16,21 +16,20 @@  data Arg = ArgPos String -mode :: MA.Mode (Maybe Y.FitAcct -> IO ())-mode = MA.Mode-  { MA.mName = "database"-  , MA.mIntersperse = MA.Intersperse-  , MA.mOpts = []-  , MA.mPosArgs = return . ArgPos-  , MA.mProcess = processor-  , MA.mHelp = help-  }+mode :: Y.Mode+mode mayFa = MA.modeHelp+  "database"        -- Mode name+  help              -- Help function+  (processor mayFa) -- Processing function+  []                -- Options+  MA.Intersperse    -- Interspersion+  (return . ArgPos) -- Posarg processor  processor-  :: [Arg]-  -> Maybe Y.FitAcct+  :: Maybe Y.FitAcct+  -> [Arg]   -> IO ()-processor ls mayFa+processor mayFa ls   | not . null $ ls = fail $         "penny-fit database: error: this command does"         ++ " not accept non-option arguments."

@@ -32,27 +32,27 @@   , newUNumber :: Maybe Integer   } -mode-  :: MA.Mode (Maybe Y.FitAcct -> IO ())-mode = MA.Mode-  { MA.mName = "import"-  , MA.mIntersperse = MA.Intersperse-  , MA.mOpts =+mode :: Y.Mode+mode mayFa = MA.modeHelp+  "import"            -- Mode name+  help                -- Help function+  (processor mayFa)   -- Processing function+  opts                -- Options+  MA.Intersperse      -- Interspersion+  (return . AFitFile) -- Posarg processor+  where+    opts =       [ MA.OptSpec ["new"] "n" (MA.NoArg AAllowNew)       , MA.OptSpec ["unumber"] "u" . MA.OneArgE $ \s -> do           i <- MA.reader s           return $ AUNumber i       ]-  , MA.mPosArgs = return . AFitFile-  , MA.mProcess = processor-  , MA.mHelp = help-  }  processor-  :: [Arg]-  -> Maybe Y.FitAcct+  :: Maybe Y.FitAcct+  -> [Arg]   -> IO ()-processor as mayFa = do+processor mayFa as = do   fa <- U.getFitAcct mayFa   let (dbLoc, prsr) = (Y.dbLocation fa, snd . Y.parser $ fa)   loc <- case mapMaybe toFitFile as of

@@ -7,7 +7,7 @@ import qualified Data.Text.IO as TIO import Data.Monoid ((<>)) import qualified Penny.Lincoln as L-import qualified Penny.Copper.Render as R+import qualified Penny.Steel.Sums as S import qualified System.Console.MultiArg as MA  help :: String -> String@@ -20,26 +20,25 @@   , "  -h, --help - show help and exit"   ] -mode :: MA.Mode (Maybe Y.ConfigLocation -> Y.Config -> IO ())-mode = MA.Mode-  { MA.mName = "info"-  , MA.mIntersperse = MA.Intersperse-  , MA.mOpts = []-  , MA.mPosArgs = const . Ex.throw . MA.ErrorMsg-    $ "this mode does not accept positional arguments"-  , MA.mProcess = const process-  , MA.mHelp = help-  }+mode :: Y.Config -> MA.Mode (MA.ProgName -> String) (IO ())+mode cf = MA.modeHelp+  "info"               -- Mode name+  help                 -- Help function+  (const (process cf)) -- Processing function+  []                   -- Options+  MA.Intersperse       -- Interspersion+  processPa            -- Posarg processor+  where+    processPa = const . Ex.throw . MA.ErrorMsg+      $ "this mode does not accept positional arguments" -process :: Maybe Y.ConfigLocation -> Y.Config -> IO ()-process cf cn = TIO.putStr $ showInfo cf cn+process :: Y.Config -> IO ()+process cf = TIO.putStr $ showInfo cf -showInfo :: Maybe Y.ConfigLocation -> Y.Config -> X.Text-showInfo cf cn =-  maybe "These settings are compiled into your program.\n\n"-        (\l -> label "From configuration file at" (L.text l) <> "\n\n")-        cf-  <> showConfig cn+showInfo :: Y.Config -> X.Text+showInfo cf =+  "These settings are compiled into your program.\n\n"+  <> showConfig cf  showConfig :: Y.Config -> X.Text showConfig (Y.Config dflt more) =@@ -73,11 +72,8 @@   , label "Penny account" (L.text . L.Delimited ":" . Y.pennyAcct $ c)   , label "Default account" (L.text . L.Delimited ":" . Y.defaultAcct $ c)   , label "Currency" (L.text . Y.currency $ c)-  , label "Group amounts to left of decimal point"-    (showGroupLeft . R.left . Y.groupSpecs $ c)--  , label "Group amounts to right of decimal point"-    (showGroupRight . R.right . Y.groupSpecs $ c)+  , label "Radix point and digit grouping"+    (showQtySpec . Y.qtySpec $ c)    , label "Financial institution increases are"     (showTranslator . Y.translator $ c)@@ -91,17 +87,17 @@   <> "Parser description:\n"   <> (L.text . fst . Y.parser $ c) -showGroupLeft :: R.GroupSpec -> X.Text-showGroupLeft s = case s of-  R.NoGrouping -> "never"-  R.GroupLarge -> "when greater than 9,999"-  R.GroupAll -> "always"+showQtySpec :: S.S3 L.Radix L.PeriodGrp L.CommaGrp -> X.Text+showQtySpec s = case s of+  S.S3a r -> "no digit grouping, use radix point: '"+             <> (L.showRadix r) <> "'"+  S.S3b p -> "group digits using: '"+             <> (X.singleton . L.groupChar $ p)+             <> "', radix point: '.'"+  S.S3c c -> "group digits using: '"+             <> (X.singleton . L.groupChar $ c)+             <> "', radix point: ','" -showGroupRight :: R.GroupSpec -> X.Text-showGroupRight s = case s of-  R.NoGrouping -> "never"-  R.GroupLarge -> "when mor than four decimal places"-  R.GroupAll -> "always"  showTranslator :: Y.Translator -> X.Text showTranslator y = case y of

@@ -36,20 +36,21 @@ toOutput :: Arg -> Maybe (X.Text -> IO ()) toOutput a = case a of { AOutput x -> Just x; _ -> Nothing } -mode :: MA.Mode (Maybe Y.FitAcct -> IO ())-mode = MA.Mode-  { MA.mName = "merge"-  , MA.mIntersperse = MA.Intersperse-  , MA.mOpts = [ MA.OptSpec ["no-auto"] "n" (MA.NoArg ANoAuto)-               , fmap AOutput Ly.output-               ]-  , MA.mPosArgs = return . APos-  , MA.mProcess = processor-  , MA.mHelp = help-  }+mode :: Y.Mode+mode mayFa = MA.modeHelp+  "merge"+  help+  (processor mayFa)+  opts+  MA.Intersperse+  (return . APos)+  where+    opts = [ MA.OptSpec ["no-auto"] "n" (MA.NoArg ANoAuto)+           , fmap AOutput Ly.output+           ] -processor :: [Arg] -> Maybe Y.FitAcct -> IO ()-processor as mayFa = do+processor :: Maybe Y.FitAcct -> [Arg] -> IO ()+processor mayFa as = do   fa <- U.getFitAcct mayFa   doMerge fa           (ANoAuto `elem` as)@@ -72,7 +73,7 @@                   l (filterDb (Y.pennyAcct acct) dbWithEntry l)       newTxns = createTransactions noAuto acct l dbLs db'       final = l' ++ newTxns-  case mapM (R.item (Y.groupSpecs acct)) (map C.stripMeta final) of+  case mapM (R.item Nothing) (map C.stripMeta final) of     Nothing -> fail "Could not render final ledger."     Just txts ->       let txt = X.concat txts@@ -206,7 +207,7 @@  -- | 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 :: Y.FitAcct -> Y.Posting -> (Y.Posting, L.Entry L.Qty) pairWithEntry acct p = (p, en)   where     en = L.Entry dc (L.Amount qty cty)@@ -214,7 +215,7 @@     qty = U.parseQty (Y.amount p)     cty = Y.unCurrency . Y.currency $ acct -type DbWithEntry = M.Map Y.UNumber (Y.Posting, L.Entry)+type DbWithEntry = M.Map Y.UNumber (Y.Posting, L.Entry L.Qty)  -- | Does the given Penny transaction match this posting? Makes sure -- that the account, quantity, date, commodity, and DrCr match, and@@ -224,22 +225,29 @@   :: Y.FitAcct   -> L.TopLineData   -> L.Ent L.PostingData-  -> (a, (Y.Posting, L.Entry))+  -> (a, (Y.Posting, L.Entry L.Qty))   -> Bool pennyTxnMatches acct tl pstg (_, (a, e)) =   mA && noFlag && mQ && mDC && mDate && mCmdty   where     p = L.pdCore . L.meta $ pstg     mA = L.pAccount p == (Y.unPennyAcct . Y.pennyAcct $ acct)-    mQ = L.equivalent (L.qty . L.amount . L.entry $ pstg)+    mQ = L.equivalent (eitherToQty . L.entry $ pstg)                       (L.qty . L.amount $ e)-    mDC = (L.drCr e) == (L.drCr . L.entry $ pstg)+    mDC = (L.drCr e) == (either L.drCr L.drCr . L.entry $ pstg)     mDate = (L.day . L.tDateTime . L.tlCore $ tl) == (Y.unDate . Y.date $ a)     noFlag = isNothing . L.pNumber $ p-    mCmdty = (L.commodity . L.amount . L.entry $ pstg)+    mCmdty = (eitherToCmdty . L.entry $ pstg)              == (Y.unCurrency . Y.currency $ acct)  +eitherToCmdty :: Either (L.Entry a) (L.Entry b) -> L.Commodity+eitherToCmdty = either (L.commodity . L.amount) (L.commodity . L.amount)++eitherToQty :: Either (L.Entry L.QtyRep) (L.Entry L.Qty) -> L.Qty+eitherToQty = either (L.toQty . L.qty . L.amount)+                     (L.toQty . L.qty . L.amount)+ -- | 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.@@ -248,9 +256,10 @@   -> Y.FitAcct   -> UNumberLookupMap   -> PyeLookupMap-  -> (Y.UNumber, (Y.Posting, L.Entry))+  -> (Y.UNumber, (Y.Posting, L.Entry L.Qty))   -> L.Transaction-newTransaction noAuto acct mu mp (u, (a, e)) = L.Transaction (tld, ents) where+newTransaction noAuto acct mu mp (u, (a, e))+  = L.Transaction (tld, ents) where   tld = L.TopLineData tlc Nothing Nothing   tlc = (L.emptyTopLineCore (L.dateTimeMidnightUTC . Y.unDate . Y.date $ a))         { L.tPayee = Just pa }@@ -271,8 +280,9 @@            }   p2core = L.emptyPostingCore ac   ents = L.rEnts (Y.unCurrency . Y.currency $ acct) (L.drCr e)-                 (L.qty . L.amount $ e, p1data)+                 (Left . L.qtyToRep gs . L.qty . L.amount $ e, p1data)                  [] p2data+  gs = Y.qtySpec acct  -- | Creates new transactions for all the items remaining in the -- DbMap. Appends a blank line after each one.

@@ -23,22 +23,20 @@ data Arg   = ArgFile String -mode-  :: MA.Mode (Maybe Y.FitAcct -> IO ())-mode = MA.Mode-  { MA.mName = "print"-  , MA.mIntersperse = MA.Intersperse-  , MA.mOpts = []-  , MA.mPosArgs = return . ArgFile-  , MA.mProcess = processor-  , MA.mHelp = help-  }+mode :: Y.Mode+mode mayFa = MA.modeHelp+  "print"+  help+  (processor mayFa)+  []+  MA.Intersperse+  (return . ArgFile)  processor-  :: [Arg]-  -> Maybe Y.FitAcct+  :: Maybe Y.FitAcct+  -> [Arg]   -> IO ()-processor ls mayFa = do+processor mayFa ls = do   fa <- U.getFitAcct mayFa   doPrint (snd . Y.parser $ fa) ls 

@@ -11,7 +11,6 @@   , DbMap   , DbList   , Posting(..)-  , ConfigLocation(..)   , DbLocation(..)   , FitAcctName(..)   , FitAcctDesc(..)@@ -25,18 +24,23 @@   , FitFileLocation(..)   , AllowNew(..)   , ParserFn+  , Mode   ) 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+import qualified Penny.Steel.Sums as Su+import qualified System.Console.MultiArg as MA +-- | The type of all Brenner MultiArg modes.+type Mode = Maybe FitAcct -> MA.Mode (MA.ProgName -> String) (IO ())+ -- | The date reported by the financial institution. newtype Date = Date { unDate :: Time.Day }   deriving (Eq, Show, Ord, Read)@@ -196,13 +200,6 @@         <*> S.get         <*> S.get --- | Where is a configuration file-newtype ConfigLocation = ConfigLocation-  { unConfigLocation :: Text }-  deriving (Eq, Show)--instance L.HasText ConfigLocation where text = unConfigLocation- -- | Where is the database of postings? newtype DbLocation = DbLocation { unDbLocation :: Text }   deriving (Eq, Show)@@ -277,7 +274,10 @@   , pennyAcct :: PennyAcct   , defaultAcct :: DefaultAcct   , currency :: Currency-  , groupSpecs :: R.GroupSpecs++  , qtySpec :: Su.S3 L.Radix L.PeriodGrp L.CommaGrp+  -- ^ How to turn Qty into QtyRep.+   , translator :: Translator    , side :: L.Side

@@ -10,13 +10,13 @@ import qualified Text.Parsec as P import qualified Penny.Lincoln as L import qualified System.Exit as Exit-import qualified System.Console.MultiArg as MA import qualified System.IO as IO+import System.Environment (getProgName)  -- | Print an error message and exit. errExit :: String -> IO a errExit s = do-  pn <- MA.getProgName+  pn <- getProgName   IO.hPutStrLn IO.stderr $ pn ++ ": error: " ++ s   Exit.exitFailure @@ -79,10 +79,10 @@ -- 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+parseQty a = case P.parse CP.unquotedQtyRep "" (Y.unAmount a) of   Left e -> error $ "could not parse quantity from string: "             ++ (X.unpack . Y.unAmount $ a) ++ ": " ++ show e-  Right g -> g+  Right g -> L.toQty g  label :: String -> X.Text -> String label s x = s ++ ": " ++ X.unpack x ++ "\n"

@@ -36,7 +36,7 @@ -- 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+  { balanceFormat :: L.Amount L.Qty -> X.Text   , showZeroBalances :: CO.ShowZeroBalances   , sorter :: Sorter   , target :: L.To@@ -48,16 +48,16 @@ -- 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)+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+convertBalance+  :: L.PriceDb   -> L.DateTime   -> L.To   -> L.Balance@@ -68,8 +68,8 @@  -- | Converts a single BottomLine to a new commodity. Fails with an -- error message if no conversion data is available.-convertOne ::-  L.PriceDb+convertOne+  :: L.PriceDb   -> L.DateTime   -> L.To   -> (L.Commodity, L.BottomLine)@@ -85,8 +85,8 @@         g r = L.NonZero (L.Column dc r)  -- | Creates an error message for conversion errors.-convertError ::-  L.To+convertError+  :: L.To   -> L.From   -> L.PriceDbError   -> X.Text@@ -154,7 +154,7 @@ report os@(Opts getFmt _ _ _ _ txtFormats) ps bs = do   fstBl <- sumConvertSort os ps bs   let (rs, L.To cy) = rows fstBl-      fmt = getFmt cy+      fmt q = getFmt (L.Amount q cy)   return $ K.rowsToChunks txtFormats fmt rs  @@ -165,15 +165,15 @@   -> 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 = return . Left-      , MA.mProcess = process rt chgrs o fsf-      , MA.mHelp = const (help o)-      }+    mkMode _ _ chgrs _ fsf = MA.modeHelp+      "convert"+      (const (help o))+      (process rt chgrs o fsf)+      (map (fmap Right) P.allOptSpecs)+      MA.Intersperse+      (return . Left) + process   :: S.Runtime   -> Scheme.Changers@@ -189,9 +189,9 @@       Ex.Success g -> return $         let noDefault = X.pack "no default price found"             f = fromParsedOpts chgrs g-            pr ts pps = do+            pr fmt ts pps = do               rptOpts <- Ex.fromMaybe noDefault $-                f pps (O.format defaultOpts)+                f pps fmt               let boxes = fsf ts               report rptOpts pps boxes         in (posArgs, pr)@@ -223,9 +223,10 @@ mostFrequent = U.lastMode . map (L.to . L.price)  -type DoReport = [L.PricePoint]-               -> (L.Commodity -> L.Qty -> X.Text)-               -> (Maybe Opts)+type DoReport+  = [L.PricePoint]+  -> (L.Amount 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

@@ -5,9 +5,7 @@ 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@@ -19,7 +17,6 @@   , target :: P.Target   , sortOrder :: CP.SortOrder   , sortBy :: P.SortBy-  , format :: L.Commodity -> L.Qty -> X.Text   }  toParserOpts :: DefaultOpts -> S.Runtime -> P.Opts@@ -37,7 +34,6 @@   , target = P.AutoTarget   , sortOrder = CP.Ascending   , sortBy = P.SortByName-  , format = \_ q -> X.pack . L.prettyShowQty $ q   }  

@@ -5,7 +5,6 @@   Opts(..),   defaultOpts,   defaultParseOpts,-  defaultFormat,   parseReport,   defaultReport,   report@@ -34,15 +33,15 @@ -- 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+  { balanceFormat :: L.Amount L.Qty -> X.Text   , showZeroBalances :: CO.ShowZeroBalances   , order :: L.SubAccount -> L.SubAccount -> Ordering   , textFormats :: E.Changers   } -defaultOpts :: Opts-defaultOpts = Opts-  { balanceFormat = defaultFormat+defaultOpts :: (L.Amount L.Qty -> X.Text) -> Opts+defaultOpts fmt = Opts+  { balanceFormat = fmt   , showZeroBalances = CO.ShowZeroBalances True   , order = compare   , textFormats = Schemes.darkLabels@@ -56,7 +55,7 @@  fromParseOpts   :: E.Changers-  -> (L.Commodity -> L.Qty -> X.Text)+  -> (L.Amount L.Qty -> X.Text)   -> P.ParseOpts   -> Opts fromParseOpts chgrs fmt (P.ParseOpts szb o) = Opts fmt szb o' chgrs@@ -65,9 +64,6 @@        CP.Ascending -> compare        CP.Descending -> CO.descending compare -defaultFormat :: a -> L.Qty -> X.Text-defaultFormat _ = X.pack . L.prettyShowQty- summedSortedBalTree ::   CO.ShowZeroBalances   -> (L.SubAccount -> L.SubAccount -> Ordering)@@ -100,48 +96,43 @@  -- | 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+parseReport+  :: P.ParseOpts   -- ^ Default options for the report. These can be overriden on the   -- command line.    -> I.Report-parseReport fmt o rt = (help o, makeMode)+parseReport 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 = return . Left-      , MA.mProcess = process chgrs fmt o rt fsf-      , MA.mHelp = const (help o)-      }+    makeMode _ _ chgrs _ fsf = MA.modeHelp+      "balance"+      (const (help o))+      (process chgrs o rt fsf)+      (map (fmap Right) P.allSpecs)+      MA.Intersperse+      (return . Left)  process   :: Applicative f   => E.Changers-  -> (L.Commodity -> L.Qty -> X.Text)   -> P.ParseOpts   -> a   -> ([L.Transaction] -> [(Ly.LibertyMeta, L.Posting)])   -> [Either String (P.ParseOpts -> P.ParseOpts)]   -> f I.ArgsAndReport-process chgrs fmt o _ fsf ls =+process chgrs 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)+      pr fmt txns _ = return $ report mcOpts (fsf txns)+        where+          mcOpts = fromParseOpts chgrs fmt os'   in pure (posArgs, pr)   -- | The MultiCommodity report, with default options. defaultReport :: I.Report-defaultReport = parseReport defaultFormat defaultParseOpts+defaultReport = parseReport defaultParseOpts  ------------------------------------------------------------ -- ## Help

@@ -149,7 +149,7 @@  rowsToChunks   :: E.Changers-  -> (L.Commodity -> L.Qty -> X.Text)+  -> (L.Amount L.Qty -> X.Text)   -- ^ How to format a balance to allow for digit grouping   -> [Row]   -> [Rb.Chunk]@@ -159,7 +159,7 @@  rowsToColumns   :: E.Changers-  -> (L.Commodity -> L.Qty -> X.Text)+  -> (L.Amount L.Qty -> X.Text)   -- ^ How to format a balance to allow for digit grouping    -> [Row]@@ -171,7 +171,7 @@  mkColumn   :: E.Changers-  -> (L.Commodity -> L.Qty -> X.Text)+  -> (L.Amount L.Qty -> X.Text)   -> (Meta.VisibleNum, Row)   -> Columns PreSpec mkColumn chgrs fmt (vn, (Row i acctTxt bs)) = Columns ca cd cc cq@@ -208,7 +208,7 @@  balanceChunks   :: E.Changers-  -> (L.Commodity -> L.Qty -> X.Text)+  -> (L.Amount L.Qty -> X.Text)   -> E.EvenOdd   -> (L.Commodity, L.BottomLine)   -> (Rb.Chunk, Rb.Chunk, Rb.Chunk)

@@ -162,8 +162,11 @@   boxesBalance :: [(a, L.Posting)] -> L.Balance-boxesBalance = mconcat . map L.entryToBalance . map Q.entry-               . map snd+boxesBalance+  = mconcat+  . map (either L.entryToBalance L.entryToBalance)+  . map Q.entry+  . map snd  mapSnd :: (a -> b) -> (f, a) -> (f, b) mapSnd f (x, a) = (x, f a)

@@ -34,21 +34,28 @@ type ParseResult = Exceptional X.Text ArgsAndReport  type PrintReport-  = [L.Transaction]-  -- ^ All transactions; the report must sort and filter them+  = (L.Amount L.Qty -> X.Text)+  -- ^ Function that gives a rendering for quantities that are not+  -- already formatted.  This function is passed as part of+  -- PrintReport because it allows the function to be built after the+  -- ledger has already been parsed. +  -> [L.Transaction]+  -- ^ All transactions to be included in the report. 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.+  -- 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)@@ -74,4 +81,4 @@   -- ^ Result from previous parsers that will sort and filter incoming   -- transactions -  -> MA.Mode ParseResult+  -> MA.Mode (MA.ProgName -> String) ParseResult

@@ -44,8 +44,6 @@   , A.SubAccountLength(..)   , A.alloc   , yearMonthDay-  , qtyAsIs-  , balanceAsIs   , defaultWidth   , columnsVarToWidth   , widthFromRuntime@@ -113,14 +111,13 @@ 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 = return . Left-      , MA.mProcess = process opts cs fty ch expr fsf-      , MA.mHelp = const (helpStr opts)-      }+    md cs fty ch expr fsf = MA.modeHelp+      "postings"+      (const (helpStr opts))+      (process opts cs fty ch expr fsf)+      (specs rt)+      MA.Intersperse+      (return . Left)  specs   :: Sh.Runtime@@ -152,13 +149,14 @@   -> I.ArgsAndReport mkPrintReport posArgs zo ch fsf st = (posArgs, f)   where-    f txns _ = do+    f fmt 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+                    (P.postFilter st) (chunkOpts fmt st zo) boxes           expChks = showExpression (P.showExpression st) pdct-          verbChks = showVerboseFilter (P.verboseFilter st) pdct boxes+          verbChks = showVerboseFilter fmt (P.verboseFilter st)+                                       pdct boxes           chks = expChks                  ++ verbChks                  ++ rptChks@@ -181,16 +179,17 @@     chks = Pe.showPdct indentAmt 0 pdct  showVerboseFilter-  :: P.VerboseFilter+  :: (L.Amount L.Qty -> X.Text)+  -> P.VerboseFilter   -> Pe.Pdct (Ly.LibertyMeta, L.Posting)   -> [(Ly.LibertyMeta, L.Posting)]   -> [Rb.Chunk]-showVerboseFilter (P.VerboseFilter b) pdct bs =+showVerboseFilter fmt (P.VerboseFilter b) pdct bs =   if not b then [] else info : blankLine : (chks ++ [blankLine])   where     chks =       fst-      $ Pe.verboseFilter (L.display . snd) indentAmt False pdct bs+      $ Pe.verboseFilter ((L.display fmt) . snd) indentAmt False pdct bs     info = "Postings report filter:\n"  defaultOptions@@ -201,8 +200,6 @@   , 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@@ -243,17 +240,6 @@     -- a PostingInfo so it has lots of information, but it     -- should return a date for use in the Date field. -  , qtyFormat :: (M.PostMeta, L.Posting) -> 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.@@ -276,14 +262,14 @@    } -chunkOpts ::-  P.State+chunkOpts+  :: (L.Amount L.Qty -> X.Text)+  -> P.State   -> ZincOpts   -> C.ChunkOpts-chunkOpts s z = C.ChunkOpts+chunkOpts fmt s z = C.ChunkOpts   { C.dateFormat = dateFormat z-  , C.qtyFormat = qtyFormat z-  , C.balanceFormat = balanceFormat z+  , C.qtyFormat = fmt   , C.fields = P.fields s   , C.subAccountLength = subAccountLength z   , C.payeeAllocation = payeeAllocation z@@ -321,16 +307,6 @@         . snd         $ p     fmt = "%Y-%m-%d"---- | Shows the quantity of a posting. Does no rounding or--- prettification; simply uses show on the underlying Decimal.-qtyAsIs :: (M.PostMeta, L.Posting) -> X.Text-qtyAsIs p = X.pack . L.prettyShowQty . Q.qty . snd $ p---- | Shows the quantity of a balance. If there is no quantity, shows--- two dashes.-balanceAsIs :: a -> L.Qty -> X.Text-balanceAsIs _ = X.pack . L.prettyShowQty  -- | The default width for the report. defaultWidth :: T.ReportWidth

@@ -18,8 +18,7 @@  data ChunkOpts = ChunkOpts   { dateFormat :: (M.PostMeta, L.Posting) -> X.Text-  , qtyFormat :: (M.PostMeta, L.Posting) -> X.Text-  , balanceFormat :: L.Commodity -> L.Qty -> X.Text+  , qtyFormat :: L.Amount L.Qty -> X.Text   , fields :: F.Fields Bool   , subAccountLength :: A.SubAccountLength   , payeeAllocation :: A.Alloc@@ -32,7 +31,6 @@ growOpts c = G.GrowOpts   { G.dateFormat = dateFormat c   , G.qtyFormat = qtyFormat c-  , G.balanceFormat = balanceFormat c   , G.fields = fields c   } 

@@ -29,8 +29,7 @@ -- | All the options needed to grow the cells. data GrowOpts = GrowOpts   { dateFormat :: (M.PostMeta, L.Posting) -> X.Text-  , qtyFormat :: (M.PostMeta, L.Posting) -> X.Text-  , balanceFormat :: L.Commodity -> L.Qty -> X.Text+  , qtyFormat :: L.Amount L.Qty -> X.Text   , fields :: F.Fields Bool   } @@ -115,7 +114,7 @@   , postingQty           = \o ch -> getPostingQty ch (qtyFormat o)   , totalDrCr            = const getTotalDrCr   , totalCmdty           = const getTotalCmdty-  , totalQty             = \o ch -> getTotalQty ch (balanceFormat o)+  , totalQty             = \o ch -> getTotalQty ch (qtyFormat o)   }  -- | Make a left justified cell one line long that shows a serial.@@ -246,8 +245,16 @@ getPostingCmdty ch i = coloredPostingCell ch t i where   t = L.unCommodity . Q.commodity . snd $ i -getPostingQty :: E.Changers -> ((M.PostMeta, L.Posting) -> X.Text) -> (M.PostMeta, L.Posting) -> PreSpec-getPostingQty ch qf i = coloredPostingCell ch (qf i) i+getPostingQty+  :: E.Changers+  -> (L.Amount L.Qty -> X.Text) -- ((M.PostMeta, L.Posting) -> X.Text)+  -> (M.PostMeta, L.Posting)+  -> PreSpec+getPostingQty ch qf i = coloredPostingCell ch qtyStr i+  where+    qtyStr = case (L.entry . L.headEnt . snd . L.unPosting . snd $ i) of+      Left qr -> L.showQtyRep . L.qty . L.amount $ qr+      Right q -> qf . L.amount $ q  getTotalDrCr :: E.Changers -> (M.PostMeta, L.Posting) -> PreSpec getTotalDrCr ch i =@@ -280,7 +287,7 @@  getTotalQty   :: E.Changers-  -> (L.Commodity -> L.Qty -> X.Text)+  -> (L.Amount L.Qty -> X.Text)   -> (M.PostMeta, L.Posting)   -> PreSpec getTotalQty ch balFmt i =

@@ -73,7 +73,8 @@   -> (a, L.Posting)   -> (L.Balance, (L.Balance, (a, L.Posting))) balanceAccum (CO.ShowZeroBalances szb) balOld (x, po) =-  let balThis = L.entryToBalance . Q.entry $ po+  let balThis = either L.entryToBalance L.entryToBalance+                . Q.entry $ po       balNew = mappend balOld balThis       balNoZeroes = L.removeZeroCommodities balNew       bal' = if szb then balNew else balNoZeroes

@@ -115,7 +115,7 @@  balanceToQtys   :: Changers-  -> (L.Commodity -> L.Qty -> X.Text)+  -> (L.Amount L.Qty -> X.Text)   -> EvenOdd   -> [(L.Commodity, L.BottomLine)]   -> [R.Chunk]@@ -128,7 +128,7 @@  bottomLineToQty   :: Changers-  -> (L.Commodity -> L.Qty -> X.Text)+  -> (L.Amount L.Qty -> X.Text)   -> EvenOdd   -> (L.Commodity, L.BottomLine)   -> R.Chunk@@ -136,6 +136,7 @@   where     (lbl, t) = case bl of       L.Zero -> (Zero, X.pack "--")-      L.NonZero (L.Column clmDrCr qt) -> (dcToLbl clmDrCr, getTxt cy qt)+      L.NonZero (L.Column clmDrCr qt) ->+        (dcToLbl clmDrCr, getTxt (L.Amount qt cy))     md = getEvenOddLabelValue lbl eo chgrs 

@@ -82,8 +82,6 @@   , module Penny.Copper.Interface    -- * Rendering-  , R.GroupSpec(..)-  , R.GroupSpecs(..)   , R.item  

@@ -1,12 +1,7 @@-{-# LANGUAGE DeriveGeneric #-}- module Penny.Copper.Interface where  import qualified Penny.Lincoln as L import qualified Data.Text as X-import qualified Data.Text.Encoding as XE-import GHC.Generics (Generic)-import qualified Data.Binary as B import qualified Penny.Steel.Sums as S  data ParsedTopLine = ParsedTopLine@@ -16,27 +11,19 @@   , ptlPayee :: Maybe L.Payee   , ptlMemo :: Maybe (L.Memo, L.TopMemoLine)   , ptlTopLineLine :: L.TopLineLine-  } deriving (Show, Generic)+  } deriving (Show)  toTopLineCore :: ParsedTopLine -> L.TopLineCore toTopLineCore (ParsedTopLine dt nu fl pa me _)   = L.TopLineCore dt nu fl pa (fmap fst me) -instance B.Binary ParsedTopLine- type ParsedTxn = (ParsedTopLine , L.Ents (L.PostingCore, L.PostingLine))  data BlankLine = BlankLine-  deriving (Eq, Show, Generic)--instance B.Binary BlankLine+  deriving (Eq, Show)  newtype Comment = Comment { unComment :: X.Text }   deriving (Eq, Show)--instance B.Binary Comment where-  get = fmap (Comment . XE.decodeUtf8) B.get-  put = B.put . XE.encodeUtf8 . unComment  type ParsedItem =   S.S4 ParsedTxn L.PricePoint Comment BlankLine

@@ -2,10 +2,12 @@ -- documented in EBNF in the file @doc\/ledger-grammar.org@. module Penny.Copper.Parsec where +-- # Imports+ import qualified Penny.Copper.Interface as I import qualified Penny.Copper.Terminals as T import Text.Parsec.Text (Parser)-import Text.Parsec (many, many1, satisfy)+import Text.Parsec (many, many1, satisfy, (<?>)) import qualified Text.Parsec as P import qualified Text.Parsec.Pos as Pos import Control.Applicative.Permutation (runPerms, maybeAtom)@@ -13,6 +15,7 @@                             (<|>), optional) import Control.Monad (replicateM, when) import qualified Control.Monad.Exception.Synchronous as Ex+import Data.List.NonEmpty (NonEmpty((:|))) import qualified Penny.Lincoln as L import qualified Penny.Steel.Sums as S import Data.Maybe (fromMaybe)@@ -24,6 +27,13 @@ import qualified System.IO as IO import qualified Data.Text.IO as TIO +-- # Helpers++nonEmpty :: Parser a -> Parser (NonEmpty a)+nonEmpty p = (:|) <$> p <*> many p++-- # Accounts+ lvl1SubAcct :: Parser L.SubAccount lvl1SubAcct =   (L.SubAccount . pack) <$> many1 (satisfy T.lvl1AcctChar)@@ -64,6 +74,8 @@ ledgerAcct :: Parser L.Account ledgerAcct = quotedLvl1Acct <|> lvl2Acct +-- # Commodities+ lvl1Cmdty :: Parser L.Commodity lvl1Cmdty = (L.Commodity . pack) <$> many1 (satisfy T.lvl1CmdtyChar) @@ -80,61 +92,141 @@ lvl3Cmdty :: Parser L.Commodity lvl3Cmdty = (L.Commodity . pack) <$> many1 (satisfy T.lvl3CmdtyChar) -digitGroup :: Parser [Char]-digitGroup = satisfy T.thinSpace *> many1 (satisfy T.digit)+-- # Quantities -digitSequence :: Parser [Char]-digitSequence =-  (++) <$> many1 (satisfy T.digit)-  <*> (concat <$> (many digitGroup))+digit :: Parser L.Digit+digit = (P.choice . map f $ zip ['0'..'9'] [minBound..maxBound])+  <?> "digit"+  where+    f (s, d) = d <$ P.char s -digitPostSequence :: Parser (Maybe [Char])-digitPostSequence = satisfy T.period *> optional digitSequence+digitList :: Parser L.DigitList+digitList = L.DigitList <$> nonEmpty digit -quantity :: Parser L.Qty-quantity = p >>= failOnErr-  where-    p = (L.RadFrac <$> (satisfy T.period *> digitSequence))-        <|> (f <$> digitSequence <*> optional digitPostSequence)-    f digSeq maybePostSeq = case maybePostSeq of-      Nothing -> L.Whole digSeq-      Just ps ->-        maybe (L.WholeRad digSeq) (L.WholeRadFrac digSeq) ps-    failOnErr = maybe (fail msg) return . L.toQty-    msg = "could not read quantity; zero quantities not allowed"+groupPart :: Parser a -> Parser (a, L.DigitList)+groupPart p = (,) <$> p <*> digitList +groupedDigits :: Parser a -> Parser (L.GroupedDigits a)+groupedDigits p+  = L.GroupedDigits <$> digitList <*> many (groupPart p)++-- | Parses a sequence of grouped digits, followed by an optional+-- radix point, followed by an optional additional sequence of grouped+-- digits.  Numbers such as .25 are not allowed; instead,+-- the user must enter 0.25. Also not allowed is something like+-- "25.". Intsead, if the user enters a radix, there must be a+-- character after it.+digitsRadDigits+  :: Parser a+  -- ^ Parses a single grouping character+  -> Parser void+  -- ^ Parses a radix point+  -> Parser (L.GroupedDigits a, Maybe (L.GroupedDigits a))+digitsRadDigits gc r = do+  g1 <- groupedDigits gc+  maybeRad <- optional r+  case maybeRad of+    Nothing -> return (g1, Nothing)+    Just _ -> do+      g2 <- groupedDigits gc+      return (g1, Just g2)++-- | Parses an unquoted QtyRep.+unquotedQtyRep :: Parser L.QtyRep+unquotedQtyRep = do+  let gc = P.choice [ L.PGThinSpace <$ P.char '\x2009'+                    , L.PGComma <$ P.char ',' ]+      r = P.char '.'+  (g1, mayg2) <- digitsRadDigits gc r+  case L.wholeOrFrac g1 mayg2 of+    Nothing -> fail "failed to parse quantity"+    Just ei -> return . L.wholeOrFracToQtyRep . Left $ ei++-- | Parses an unquoted QtyRep that also has spaces. Use only when+-- parsing command line items.+unquotedQtyRepWithSpaces :: Parser L.QtyRep+unquotedQtyRepWithSpaces = do+  let gc = P.choice [ L.PGThinSpace <$ P.char '\x2009'+                    , L.PGComma <$ P.char ','+                    , L.PGSpace <$ P.char ' ' ]+      r = P.char '.'+  (g1, mayg2) <- digitsRadDigits gc r+  case L.wholeOrFrac g1 mayg2 of+    Nothing -> fail "failed to parse quantity"+    Just ei -> return . L.wholeOrFracToQtyRep . Left $ ei++-- | Parses a QtyRep that is quoted with square braces. This is a+-- QtyRep that uses a comma as the radix point.+quotedCommaQtyRep :: Parser L.QtyRep+quotedCommaQtyRep = do+  let gc = P.choice [ L.CGThinSpace <$ P.char '\x2009'+                    , L.CGSpace <$ P.char ' '+                    , L.CGPeriod <$ P.char '.' ]+      r = P.char ','+  _ <- P.char '['+  (g1, mayg2) <- digitsRadDigits gc r+  _ <- P.char ']'+  case L.wholeOrFrac g1 mayg2 of+    Nothing -> fail "failed to parse quantity"+    Just ei -> return . L.wholeOrFracToQtyRep . Right $ ei++-- | Parses a QtyRep that is quoted with curly braces. This is a+-- QtyRep that uses a period as the radix point. Unlike an unquoted+-- QtyRep this can include spaces.+quotedPeriodQtyRep :: Parser L.QtyRep+quotedPeriodQtyRep = do+  let gc = P.choice [ L.PGThinSpace <$ P.char '\x2009'+                    , L.PGComma <$ P.char ','+                    , L.PGSpace <$ P.char ' '+                    ]+      r = P.char '.'+  _ <- P.char '{'+  (g1, mayg2) <- digitsRadDigits gc r+  _ <- P.char '}'+  case L.wholeOrFrac g1 mayg2 of+    Nothing -> fail "failed to parse quantity"+    Just ei -> return . L.wholeOrFracToQtyRep . Left $ ei++qtyRep :: Parser L.QtyRep+qtyRep = unquotedQtyRep <|> quotedPeriodQtyRep <|> quotedCommaQtyRep+         <?> "quantity"++-- # Amounts+ spaceBetween :: Parser L.SpaceBetween spaceBetween = f <$> optional (many1 (satisfy T.white))   where     f = maybe L.NoSpaceBetween (const L.SpaceBetween) -leftCmdtyLvl1Amt :: Parser (L.Amount, L.Side, L.SpaceBetween)+leftCmdtyLvl1Amt :: Parser (L.Amount L.QtyRep, L.Side, L.SpaceBetween) leftCmdtyLvl1Amt =-  f <$> quotedLvl1Cmdty <*> spaceBetween <*> quantity+  f <$> quotedLvl1Cmdty <*> spaceBetween <*> qtyRep   where     f c s q = (L.Amount q c , L.CommodityOnLeft, s) -leftCmdtyLvl3Amt :: Parser (L.Amount, L.Side, L.SpaceBetween)-leftCmdtyLvl3Amt = f <$> lvl3Cmdty <*> spaceBetween <*> quantity+leftCmdtyLvl3Amt :: Parser (L.Amount L.QtyRep, L.Side, L.SpaceBetween)+leftCmdtyLvl3Amt = f <$> lvl3Cmdty <*> spaceBetween <*> qtyRep   where     f c s q = (L.Amount q c, L.CommodityOnLeft, s) -leftSideCmdtyAmt :: Parser (L.Amount, L.Side, L.SpaceBetween)+leftSideCmdtyAmt :: Parser (L.Amount L.QtyRep, L.Side, L.SpaceBetween) leftSideCmdtyAmt = leftCmdtyLvl1Amt <|> leftCmdtyLvl3Amt  rightSideCmdty :: Parser L.Commodity rightSideCmdty = quotedLvl1Cmdty <|> lvl2Cmdty -rightSideCmdtyAmt :: Parser (L.Amount, L.Side, L.SpaceBetween)+rightSideCmdtyAmt :: Parser (L.Amount L.QtyRep, L.Side, L.SpaceBetween) rightSideCmdtyAmt =-  f <$> quantity <*> spaceBetween <*> rightSideCmdty+  f <$> qtyRep <*> spaceBetween <*> rightSideCmdty   where-    f q s c = (L.Amount q c ,L.CommodityOnRight, s)+    f q s c = (L.Amount q c, L.CommodityOnRight, s)  -amount :: Parser (L.Amount, L.Side, L.SpaceBetween)+amount :: Parser (L.Amount L.QtyRep, L.Side, L.SpaceBetween) amount = leftSideCmdtyAmt <|> rightSideCmdtyAmt +-- # Comments+ comment :: Parser I.Comment comment =   (I.Comment . pack)@@ -143,6 +235,8 @@   <* satisfy T.newline   <* many (satisfy T.white) +-- # Dates and times+ year :: Parser Integer year = read <$> replicateM 4 P.digit @@ -216,6 +310,8 @@                 z = fromMaybe L.noOffset mayTz             in ((hr, mn, sec), z) +-- # Debit and credit+ debit :: Parser L.DrCr debit = L.Debit <$ satisfy T.lessThan @@ -225,15 +321,23 @@ drCr :: Parser L.DrCr drCr = debit <|> credit -entry :: Parser (L.Entry, L.Side, L.SpaceBetween)+-- # Entries++entry :: Parser (L.Entry L.QtyRep, L.Side, L.SpaceBetween) entry = f <$> drCr <* (many (satisfy T.white)) <*> amount   where     f dc (am, sd, sb) = (L.Entry dc am, sd, sb) +-- # Flag+ flag :: Parser L.Flag flag = (L.Flag . pack) <$ satisfy T.openSquare   <*> many (satisfy T.flagChar) <* satisfy (T.closeSquare) +-- # Memos++-- ## Posting memo+ postingMemoLine :: Parser Text postingMemoLine =   pack@@ -244,6 +348,8 @@ postingMemo :: Parser L.Memo postingMemo = L.Memo <$> many1 postingMemoLine +-- ## Transaction memo+ transactionMemoLine :: Parser Text transactionMemoLine =   pack@@ -257,11 +363,15 @@                , L.Memo ls)  +-- # Number+ number :: Parser L.Number number =   L.Number . pack <$ satisfy T.openParen   <*> many (satisfy T.numberChar) <* satisfy T.closeParen +-- # Payees+ lvl1Payee :: Parser L.Payee lvl1Payee = L.Payee . pack <$> many (satisfy T.quotedPayeeChar) @@ -272,6 +382,8 @@ lvl2Payee = (\c cs -> L.Payee (pack (c:cs))) <$> satisfy T.letter             <*> many (satisfy T.nonNewline) +-- # Prices+ fromCmdty :: Parser L.From fromCmdty = L.From <$> (quotedLvl1Cmdty <|> lvl2Cmdty) @@ -294,6 +406,8 @@     msg = "could not parse price, make sure the from and to commodities "           ++ "are different" +-- # Tags+ tag :: Parser L.Tag tag = L.Tag . pack <$ satisfy T.asterisk <*> many (satisfy T.tagChar)       <* many (satisfy T.white)@@ -301,6 +415,8 @@ tags :: Parser L.Tags tags = (\t ts -> L.Tags (t:ts)) <$> tag <*> many tag +-- # TopLine+ topLinePayee :: Parser L.Payee topLinePayee = quotedLvl1Payee <|> lvl2Payee @@ -333,6 +449,8 @@       where         me = fmap (\(a, b) -> (b, a)) mayMe +-- # Postings+ flagNumPayee :: Parser (Maybe L.Flag, Maybe L.Number, Maybe L.Payee) flagNumPayee = runPerms   ( (,,) <$> maybeAtom (flag <* skipWhite)@@ -342,7 +460,7 @@ postingAcct :: Parser L.Account postingAcct = quotedLvl1Acct <|> lvl2Acct -posting :: Parser (L.PostingCore, L.PostingLine, Maybe L.Entry)+posting :: Parser (L.PostingCore, L.PostingLine, Maybe (L.Entry L.QtyRep)) posting = f <$> lineNum                <* skipWhite             <*> optional flagNumPayee  <* skipWhite             <*> postingAcct            <* skipWhite@@ -360,18 +478,24 @@         (en, sd, sb) = maybe (Nothing, Nothing, Nothing)           (\(a, b, c) -> (Just a, Just b, Just c)) mayEn +-- # Transaction+ transaction :: Parser I.ParsedTxn transaction = do   ptl <- topLine-  let getEntPair (core, lin, mayEn) = (mayEn, (core, lin))+  let getEntPair (core, lin, mayEn) = (fmap Left mayEn, (core, lin))   ts <- fmap (map getEntPair) $ many posting   ents <- maybe (fail "unbalanced transaction") return $ L.ents ts   return (ptl, ents)  +-- # Blank line+ blankLine :: Parser () blankLine = () <$ satisfy T.newline <* skipWhite +-- # Item+ item :: Parser I.ParsedItem item   = fmap S.S4a transaction@@ -379,6 +503,8 @@   <|> fmap S.S4c comment   <|> (S.S4d I.BlankLine) <$ blankLine ++-- # Parsing  parse   :: Text

@@ -1,3 +1,5 @@+{-# LANGUAGE OverloadedStrings #-}+ -- | Renders Penny data in a format that can be parsed by -- "Penny.Copper.Parsec". These functions render text that is -- compliant with the EBNF grammar which is at@@ -6,8 +8,8 @@  import Control.Monad (guard) import Control.Applicative ((<$>), (<|>), (<*>), pure)-import Data.List (intersperse, intercalate)-import Data.List.Split (chunksOf, splitOn)+import Data.List (intersperse)+import Data.Monoid ((<>)) import qualified Data.Text as X import Data.Text (Text, cons, snoc) import qualified Penny.Copper.Terminals as T@@ -115,98 +117,63 @@  -- * Quantities --- | Specifies how to perform digit grouping when rendering a--- quantity. All grouping groups into groups of 3 digits.-data GroupSpec =-  NoGrouping-  -- ^ Do not perform any digit grouping-  | GroupLarge-    -- ^ Group digits, but only if the number to be grouped is greater-    -- than 9,999 (if grouping the whole part) or if there are more-    -- than 4 decimal places (if grouping the fractional part).-  | GroupAll-    -- ^ Group digits whenever there are at least four decimal places.-  deriving (Eq, Show)+-- | Gets the characters necessary to quote a qtyRep.+quoteQtyRep :: L.QtyRep -> (Text, Text)+quoteQtyRep q = case q of+  L.QNoGrouping _ r -> case r of+    L.Period -> ("", "")+    L.Comma -> ("[", "]")+  L.QGrouped ei -> case ei of+    Left wf -> if hasSpace wf then ("{", "}") else ("", "")+    Right _ -> ("[", "]") +qtyRep :: L.QtyRep -> Text+qtyRep q = b <> L.showQtyRep q <> e+  where+    (b, e) = quoteQtyRep q -data GroupSpecs = GroupSpecs-  { left :: GroupSpec-  , right :: GroupSpec-  } deriving Show+hasSpace :: L.WholeOrFrac (L.GroupedDigits L.PeriodGrp) -> Bool+hasSpace (L.WholeOrFrac ei) = case ei of+  Left w -> grpHasSpace . L.unWholeOnly $ w+  Right wf -> grpHasSpace (L.whole wf) || grpHasSpace (L.frac wf)+  where+    grpHasSpace grp = L.PGSpace `elem` (map fst . L.dsNextParts $ grp)  -grouper :: String-grouper = "\x2009"--radix :: String-radix = "."---- | Performs grouping for amounts to the left of the radix point.-groupWhole :: GroupSpec -> String -> String-groupWhole gs o = let-  grouped = intercalate grouper-            . reverse-            . map reverse-            . chunksOf 3-            . reverse-            $ o-  in case gs of-    NoGrouping -> o-    GroupLarge -> if length o > 4 then grouped else o-    GroupAll -> grouped---- | Performs grouping for amounts to the right of the radix point.-groupDecimal :: GroupSpec -> String -> String-groupDecimal gs o = let-  grouped = intercalate grouper-            . chunksOf 3-            $ o-  in case gs of-    NoGrouping -> o-    GroupLarge -> if length o > 4 then grouped else o-    GroupAll -> grouped---- | Renders an unquoted Qty. Performs digit grouping as requested.-quantity-  :: GroupSpecs-  -- ^ Group for the portion to the left and right of the radix point?--  -> L.Qty-  -> X.Text-quantity gs q =-  let qs = L.prettyShowQty q-  in X.pack $ case splitOn "." qs of-    w:[] -> groupWhole (left gs) w-    w:d:[] ->-      groupWhole (left gs) w ++ radix ++ groupDecimal (right gs) d-    _ -> error "Qty.hs: rendering error"- -- * Amounts  -- | Render an Amount. The Format is required so that the commodity -- can be displayed in the right place. amount-  :: GroupSpecs+  :: Maybe (L.Amount L.Qty -> S.S3 L.Radix L.PeriodGrp L.CommaGrp)+  -- ^ If Just, render entries that are NOT inferred and that do not+  -- have a QtyRep.  If Nothing, fail if an entry is NOT inferred and+  -- does not have a QtyRep.  (Inferred entries are always rendered+  -- without an entry.)   -> Maybe L.Side   -> Maybe L.SpaceBetween-  -> L.Amount+  -> Either (L.Amount L.QtyRep) (L.Amount L.Qty)   -> Maybe X.Text-amount gs maySd maySb (L.Amount qt c) =-  let q = quantity gs qt-  in do-    sd <- maySd-    sb <- maySb-    let ws = case sb of-          L.SpaceBetween -> X.singleton ' '-          L.NoSpaceBetween -> X.empty-    (l, r) <- case sd of-          L.CommodityOnLeft -> do-            cx <- lvl3Cmdty c <|> quotedLvl1Cmdty c-            return (cx, q)-          L.CommodityOnRight -> do-            cx <- lvl2Cmdty c <|> quotedLvl1Cmdty c-            return (q, cx)-    return $ X.concat [l, ws, r]+amount mayFmt maySd maySb ei = do+  (q, c) <- case ei of+    Left a -> return (qtyRep . L.qty $ a, L.commodity a)+    Right a -> case mayFmt of+      Nothing -> Nothing+      Just f -> return ( qtyRep . L.qtyToRep (f a) . L.qty $ a,+                         L.commodity a)+  sd <- maySd+  sb <- maySb+  let ws = case sb of+        L.SpaceBetween -> X.singleton ' '+        L.NoSpaceBetween -> X.empty+  (l, r) <- case sd of+        L.CommodityOnLeft -> do+          cx <- lvl3Cmdty c <|> quotedLvl1Cmdty c+          return (cx, q)+        L.CommodityOnRight -> do+          cx <- lvl2Cmdty c <|> quotedLvl1Cmdty c+          return (q, cx)+  return $ X.concat [l, ws, r]  -- * Comments @@ -266,14 +233,20 @@ -- * Entries  entry-  :: GroupSpecs+  :: Maybe (L.Amount L.Qty -> S.S3 L.Radix L.PeriodGrp L.CommaGrp)+  -- ^ If Just, render entries that are NOT inferred and that do not+  -- have a QtyRep.  If Nothing, fail if an entry is NOT inferred and+  -- does not have a QtyRep.  (Inferred entries are always rendered+  -- without an entry.)   -> Maybe L.Side   -> Maybe L.SpaceBetween-  -> L.Entry+  -> Either (L.Entry L.QtyRep) (L.Entry L.Qty)   -> Maybe X.Text-entry gs sd sb (L.Entry dc a) = do-  amt <- amount gs sd sb a-  let dcTxt = X.pack $ case dc of+entry mayFmt sd sb ei = do+  amt <- amount mayFmt sd sb+                (either (Left . L.amount) (Right . L.amount) ei)+  let dc = either L.drCr L.drCr ei+      dcTxt = X.pack $ case dc of         L.Debit -> "<"         L.Credit -> ">"   return $ X.append (X.snoc dcTxt ' ') amt@@ -360,19 +333,18 @@  -- * Prices -price ::-  GroupSpecs-  -> L.PricePoint+price+  :: L.PricePoint   -> Maybe X.Text-price gs pp = let+price pp = let   dateTxt = dateTime (L.dateTime pp)   (L.From from) = L.from . L.price $ pp   (L.To to) = L.to . L.price $ pp   (L.CountPerUnit q) = L.countPerUnit . L.price $ pp   mayFromTxt = lvl3Cmdty from <|> quotedLvl1Cmdty from   in do-    amtTxt <- amount gs (L.ppSide pp) (L.ppSpaceBetween pp)-              (L.Amount q to)+    amtTxt <- amount Nothing (L.ppSide pp) (L.ppSpaceBetween pp)+              (Left (L.Amount q to))     fromTxt <- mayFromTxt     return $        (X.intercalate (X.singleton ' ')@@ -448,12 +420,16 @@ -- which case eight spaces will be emitted. (This allows the next -- posting to be indented properly.) posting-  :: GroupSpecs+  :: Maybe (L.Amount L.Qty -> S.S3 L.Radix L.PeriodGrp L.CommaGrp)+  -- ^ If Just, render entries that are NOT inferred and that do not+  -- have a QtyRep.  If Nothing, fail if an entry is NOT inferred and+  -- does not have a QtyRep.  (Inferred entries are always rendered+  -- without an entry.)   -> Bool   -- ^ If True, emit four spaces after the trailing newline.   -> L.Ent L.PostingCore   -> Maybe X.Text-posting gs pad ent = do+posting maySpec pad ent = do   let p = L.meta ent   fl <- renMaybe (L.pFlag p) flag   nu <- renMaybe (L.pNumber p) number@@ -461,14 +437,12 @@   ac <- ledgerAcct (L.pAccount p)   ta <- tags (L.pTags p)   me <- renMaybe (L.pMemo p) (postingMemo pad)-  let mayEn = case L.inferred ent of-        L.Inferred -> Nothing-        L.NotInferred -> (Just . L.entry $ ent)-  en <- renMaybe mayEn (entry gs (L.pSide p) (L.pSpaceBetween p))+  let mayEn = if L.inferred ent then Nothing else Just $ L.entry ent+  en <- renMaybe mayEn (entry maySpec (L.pSide p) (L.pSpaceBetween p))   return $ formatter pad fl nu pa ac ta en me -formatter ::-  Bool      -- ^ If True, emit four trailing spaces if no memo or+formatter+  :: Bool   -- ^ If True, emit four trailing spaces if no memo or             -- eight trailing spaces if there is a memo.   -> X.Text -- ^ Flag   -> X.Text -- ^ Number@@ -498,33 +472,41 @@ -- * Transaction  transaction-  :: GroupSpecs+  :: Maybe (L.Amount L.Qty -> S.S3 L.Radix L.PeriodGrp L.CommaGrp)+  -- ^ If Just, render entries that are NOT inferred and that do not+  -- have a QtyRep.  If Nothing, fail if an entry is NOT inferred and+  -- does not have a QtyRep.  (Inferred entries are always rendered+  -- without an entry.)   -> (L.TopLineCore, L.Ents L.PostingCore)   -> Maybe X.Text-transaction gs txn = do+transaction mayFmt txn = do   tlX <- topLine . fst $ txn   let (p1, p2, ps) = L.tupleEnts . snd $ txn-  p1X <- posting gs True p1-  p2X <- posting gs (not . null $ ps) p2+  p1X <- posting mayFmt True p1+  p2X <- posting mayFmt (not . null $ ps) p2   psX <- if null ps          then return X.empty          else let bs = replicate (length ps - 1) True ++ [False]               in fmap X.concat . sequence-                 $ zipWith (posting gs) bs ps+                 $ zipWith (posting mayFmt) bs ps   return $ X.concat [tlX, p1X, p2X, psX]  -- * Item  item-  :: GroupSpecs+  :: Maybe (L.Amount L.Qty -> S.S3 L.Radix L.PeriodGrp L.CommaGrp)+  -- ^ If Just, render entries that are NOT inferred and that do not+  -- have a QtyRep.  If Nothing, fail if an entry is NOT inferred and+  -- does not have a QtyRep.  (Inferred entries are always rendered+  -- without an entry.)   -> S.S4 (L.TopLineCore, L.Ents L.PostingCore)           L.PricePoint           I.Comment           I.BlankLine   -> Maybe X.Text-item gs =-  S.caseS4 (transaction gs)-           (price gs)+item mayFmt =+  S.caseS4 (transaction mayFmt)+           price            comment            (const (Just (X.pack "\n"))) 

@@ -82,7 +82,6 @@ import qualified Paths_penny_lib as PPL #endif import qualified Data.Version as V-import qualified System.Exit as Exit  -- | A multiline Text that holds an error message. type Error = Text@@ -134,7 +133,8 @@   -> [L.Transaction]   -- ^ The transactions to work on (probably parsed in from Copper) -  -> ([C.Chunk], [(LibertyMeta, L.Posting)])+  -> ( (L.Amount L.Qty -> X.Text) -> [C.Chunk]+     , [(LibertyMeta, L.Posting)])   -- ^ Sorted, filtered postings  xactionsToFiltered pdct postFilts srtr@@ -154,8 +154,15 @@   . processPostFilters postFilters   . addFilteredNum -mainFilter :: P.LPdct -> [L.Posting] -> ([C.Chunk], [L.Posting])-mainFilter pdct = E.verboseFilter L.display indentAmt False pdct+mainFilter+  :: P.LPdct+  -> [L.Posting]+  -> ((L.Amount L.Qty -> X.Text) -> [C.Chunk], [L.Posting])+mainFilter pdct pstgs = (getChks, ps')+  where+    ps' = E.filter pdct pstgs+    getChks fmt = fst $ E.verboseFilter (L.display fmt) indentAmt+                        False pdct pstgs   addFilteredNum :: [a] -> [(FilteredNum, a)]@@ -365,11 +372,9 @@     f a1 a2 = do       qt <- parseQty a2       parseComparer a1 (flip P.qty qt)-    parseQty a = case parse Pc.quantity "" (pack a) of-      Left e -> Ex.throw $ "could not parse quantity: "-        <> pack a <> " - "-        <> (pack . show $ e)-      Right g -> pure g+    parseQty a = case parse Pc.unquotedQtyRepWithSpaces "" (pack a) of+      Left _ -> Ex.throw $ "failed to parse quantity"+      Right g -> pure . L.toQty $ g   -- | Creates two options suitable for comparison of serial numbers,@@ -726,36 +731,30 @@     f a1 a2 = do       qt <- parseQty a2       parseComparer a1 (flip PS.qty qt)-    parseQty a = case parse Pc.quantity "" (pack a) of-      Left e -> Ex.throw $ "could not parse quantity: "-        <> pack a <> " - "-        <> (pack . show $ e)-      Right g -> pure g+    parseQty a = case parse Pc.unquotedQtyRepWithSpaces "" (pack a) of+      Left _ -> Ex.throw "could not parse quantity"+      Right g -> pure . L.toQty $ g  -- -- Versions -- --- | Parses the @--version@ option and returns an IO action that--- prints it and exits successfully. You supply the version of the--- executable, as there is no easy way to get that automatically.+-- | Prints the binary's version and the version of the library, and exits successfully.  version   :: V.Version-  -- ^ Version of binary-  -> OptSpec (IO a)-version v = C.OptSpec ["version"] [] (C.NoArg f)-  where-    f = do-      pn <- MA.getProgName-      putStrLn $ pn ++ " version " ++ V.showVersion v+  -> String+  -- ^ Program name+  -> String+version v pn = unlines+  [ pn ++ " version " ++ V.showVersion v #ifdef incabal-      putStrLn $ "using version " ++ V.showVersion PPL.version+  , "using version " ++ V.showVersion PPL.version #else-      putStrLn $ "using testing version"+  , "using testing version" #endif-                 ++ " of penny-lib"-      Exit.exitSuccess+    ++ " of penny-lib"+  ]  -- | An option for where the user would like to send output. output :: MA.OptSpec (X.Text -> IO ())

@@ -45,8 +45,12 @@ -- Format: -- -- File LineNo Date Payee Acct DrCr Cmdty Qty-display :: Posting -> Text-display p = X.pack $ concat (intersperse " " ls)+display+  :: (Amount Qty -> X.Text)+  -- ^ How to format Qty that do not have a QtyRep+  -> Posting+  -> Text+display fmt p = X.pack $ concat (intersperse " " ls)   where     ls = [file, lineNo, dt, pye, acct, dc, cmdty, qt]     file = maybe (labelNo "filename") (X.unpack . unFilename)@@ -68,5 +72,6 @@       Debit -> "Dr"       Credit -> "Cr"     cmdty = X.unpack . unCommodity . Q.commodity $ p-    qt = prettyShowQty . Q.qty $ p+    getFmt q = fmt $ Amount q (Q.commodity p)+    qt = X.unpack . either showQtyRep getFmt . Q.eiQty $ p     labelNo s = "(no " ++ s ++ ")"

@@ -32,7 +32,7 @@  -- | Returned by 'balanced'. data Balanced = Balanced-              | Inferable B.Entry+              | Inferable (B.Entry B.Qty)               | NotInferable               deriving (Show, Eq) @@ -45,13 +45,11 @@     Zero -> b     (NonZero col) -> case b of       Balanced -> let-        e = B.Entry dc a         dc = case colDrCr col of           B.Debit -> B.Credit           B.Credit -> B.Debit         q = colQty col-        a = B.Amount q c-        in Inferable e+        in Inferable (B.Entry dc (B.Amount q c))       _ -> NotInferable  isInferable :: Balanced -> Bool@@ -59,13 +57,13 @@ isInferable _ = False  -- | Converts an Entry to a Balance.-entryToBalance :: B.Entry -> Balance+entryToBalance :: B.HasQty q => B.Entry q -> Balance entryToBalance (B.Entry dc am) = Balance $ M.singleton c no where   c = B.commodity am-  no = NonZero (Column dc (B.qty am))+  no = NonZero (Column dc (B.toQty . B.qty $ am))  -- | Converts multiple Entries to a Balanced.-entriesToBalanced :: [B.Entry] -> Balanced+entriesToBalanced :: B.HasQty q => [B.Entry q] -> Balanced entriesToBalanced   = balanced   . mconcat

@@ -1,5 +1,3 @@-{-# LANGUAGE DeriveGeneric #-}- -- | Essential data types used to make Transactions and Postings. module Penny.Lincoln.Bits   ( module Penny.Lincoln.Bits.Open@@ -33,17 +31,14 @@ import qualified Penny.Lincoln.Bits.Price as Pr import qualified Penny.Lincoln.Equivalent as Ev import Penny.Lincoln.Equivalent ((==~))-import qualified Data.Binary as B-import GHC.Generics (Generic)  data PricePoint = PricePoint { dateTime :: DT.DateTime                              , price :: Pr.Price                              , ppSide :: Maybe O.Side                              , ppSpaceBetween :: Maybe O.SpaceBetween                              , priceLine :: Maybe O.PriceLine }-                  deriving (Eq, Show, Generic)+                  deriving (Eq, Show) -instance B.Binary PricePoint  -- | PricePoint are equivalent if the dateTime and the Price are -- equivalent. Other elements of the PricePoint are ignored.@@ -59,13 +54,11 @@   { tlCore :: TopLineCore   , tlFileMeta :: Maybe TopLineFileMeta   , tlGlobal :: Maybe O.GlobalTransaction-  } deriving (Eq, Show, Generic)+  } deriving (Eq, Show)  emptyTopLineData :: DT.DateTime -> TopLineData emptyTopLineData dt = TopLineData (emptyTopLineCore dt) Nothing Nothing -instance B.Binary TopLineData- -- | Every TopLine has this data. data TopLineCore = TopLineCore   { tDateTime :: DT.DateTime@@ -73,7 +66,7 @@   , tFlag :: Maybe O.Flag   , tPayee :: Maybe O.Payee   , tMemo :: Maybe O.Memo-  } deriving (Eq, Show, Generic)+  } deriving (Eq, Show)  -- | TopLineCore are equivalent if their dates are equivalent and if -- everything else is equal.@@ -96,17 +89,13 @@ emptyTopLineCore :: DT.DateTime -> TopLineCore emptyTopLineCore dt = TopLineCore dt Nothing Nothing Nothing Nothing -instance B.Binary TopLineCore- -- | TopLines from files have this metadata. data TopLineFileMeta = TopLineFileMeta   { tFilename :: O.Filename   , tTopLineLine :: O.TopLineLine   , tTopMemoLine :: Maybe O.TopMemoLine   , tFileTransaction :: O.FileTransaction-  } deriving (Eq, Show, Generic)--instance B.Binary TopLineFileMeta+  } deriving (Eq, Show)   -- | All Postings have this data.@@ -119,7 +108,7 @@   , pMemo :: Maybe O.Memo   , pSide :: Maybe O.Side   , pSpaceBetween :: Maybe O.SpaceBetween-  } deriving (Eq, Show, Generic)+  } deriving (Eq, Show)  -- | Two PostingCore are equivalent if the Tags are equivalent and the -- other data is equal, exlucing the Side and the SpaceBetween, which are not considered at all.@@ -152,22 +141,19 @@   , pSpaceBetween = Nothing   } -instance B.Binary PostingCore- -- | Postings from files have this additional data. data PostingFileMeta = PostingFileMeta   { pPostingLine :: O.PostingLine   , pFilePosting :: O.FilePosting-  } deriving (Eq, Show, Generic)+  } deriving (Eq, Show) -instance B.Binary PostingFileMeta  -- | All the data that a Posting might have. data PostingData = PostingData   { pdCore :: PostingCore   , pdFileMeta :: Maybe PostingFileMeta   , pdGlobal :: Maybe O.GlobalPosting-  } deriving (Eq, Show, Generic)+  } deriving (Eq, Show)  emptyPostingData :: O.Account -> PostingData emptyPostingData ac = PostingData@@ -175,6 +161,4 @@   , pdFileMeta = Nothing   , pdGlobal = Nothing   }--instance B.Binary PostingData 

@@ -1,5 +1,3 @@-{-# LANGUAGE DeriveGeneric #-}- module Penny.Lincoln.Bits.DateTime   ( TimeZoneOffset ( offsetToMins )   , minsToOffset@@ -23,19 +21,13 @@   , showDateTime   ) where -import qualified Control.Monad as M import qualified Data.Time as T-import qualified Data.Binary as B-import Data.Binary (get, put)-import GHC.Generics (Generic) import qualified Penny.Lincoln.Equivalent as Ev  -- | The number of minutes that this timezone is offset from UTC. Can -- be positive, negative, or zero. newtype TimeZoneOffset = TimeZoneOffset { offsetToMins :: Int }-                         deriving (Eq, Ord, Show, Generic)--instance B.Binary TimeZoneOffset+                         deriving (Eq, Ord, Show)  -- | Convert minutes to a time zone offset. I'm having a hard time -- deciding whether to be liberal or strict in what to accept@@ -52,19 +44,13 @@ noOffset = TimeZoneOffset 0  newtype Hours = Hours { unHours :: Int }-                deriving (Eq, Ord, Show, Generic)--instance B.Binary Hours+                deriving (Eq, Ord, Show)  newtype Minutes = Minutes { unMinutes :: Int }-                  deriving (Eq, Ord, Show, Generic)--instance B.Binary Minutes+                  deriving (Eq, Ord, Show)  newtype Seconds = Seconds { unSeconds :: Int }-                  deriving (Eq, Ord, Show, Generic)--instance B.Binary Seconds+                  deriving (Eq, Ord, Show)  -- | succeeds if 0 <= x < 24 intToHours :: Int -> Maybe Hours@@ -109,12 +95,6 @@   , seconds :: Seconds   , timeZone :: TimeZoneOffset   } deriving (Eq, Ord, Show)--instance B.Binary DateTime where-  get = M.liftM5 DateTime (fmap T.ModifiedJulianDay B.get)-                 get get get get-  put (DateTime d h m s t) =-    put (T.toModifiedJulianDay d) >> put h >> put m >> put s >> put t  dateTimeMidnightUTC :: T.Day -> DateTime dateTimeMidnightUTC d = DateTime d h m s z

@@ -1,5 +1,3 @@-{-# LANGUAGE DeriveGeneric #-}- -- | These are the bits that are "open"; that is, their constructors -- are exported. This includes most bits. Some bits that have open -- constructors are not in this module because they include other bits@@ -11,34 +9,26 @@ import Data.Monoid ((<>)) import Data.Text (Text) import qualified Data.Text as X-import qualified Data.Text.Encoding as XE-import GHC.Generics (Generic) import qualified Penny.Lincoln.Equivalent as Ev import Penny.Lincoln.Equivalent ((==~)) import qualified Penny.Lincoln.Serial as S-import qualified Penny.Lincoln.Bits.Qty as Q-import qualified Data.Binary as B  newtype SubAccount =   SubAccount { unSubAccount :: Text }   deriving (Eq, Ord, Show) -instance B.Binary SubAccount where-  put = B.put . XE.encodeUtf8 . unSubAccount-  get = fmap (SubAccount . XE.decodeUtf8) B.get- newtype Account = Account { unAccount :: [SubAccount] }-                  deriving (Eq, Show, Ord, Generic)--instance B.Binary Account+                  deriving (Eq, Show, Ord) -data Amount = Amount { qty :: Q.Qty-                     , commodity :: Commodity }-              deriving (Eq, Show, Ord, Generic)+data Amount q = Amount+  { qty :: q+  , commodity :: Commodity }+  deriving (Eq, Show, Ord) -instance B.Binary Amount+instance Functor Amount where+  fmap f (Amount q c) = Amount (f q) c -instance Ev.Equivalent Amount where+instance Ev.Equivalent q => Ev.Equivalent (Amount q) where   equivalent (Amount q1 c1) (Amount q2 c2) =     q1 ==~ q2 && c1 == c2   compareEv (Amount q1 c1) (Amount q2 c2) =@@ -48,27 +38,24 @@   Commodity { unCommodity :: Text }   deriving (Eq, Ord, Show) -instance B.Binary Commodity where-  get = fmap (Commodity . XE.decodeUtf8) B.get-  put = B.put . XE.encodeUtf8 . unCommodity+data DrCr = Debit | Credit deriving (Eq, Show, Ord) -data DrCr = Debit | Credit deriving (Eq, Show, Ord, Generic) -instance B.Binary DrCr- -- | Debit returns Credit; Credit returns Debit opposite :: DrCr -> DrCr opposite d = case d of   Debit -> Credit   Credit -> Debit -data Entry = Entry { drCr :: DrCr-                   , amount :: Amount }-             deriving (Eq, Show, Ord, Generic)+data Entry q = Entry+  { drCr :: DrCr+  , amount :: Amount q }+  deriving (Eq, Show, Ord) -instance B.Binary Entry+instance Functor Entry where+  fmap f (Entry d a) = Entry d (fmap f a) -instance Ev.Equivalent Entry where+instance Ev.Equivalent q => Ev.Equivalent (Entry q) where   equivalent (Entry d1 a1) (Entry d2 a2) =     d1 == d2 && a1 ==~ a2   compareEv (Entry d1 a1) (Entry d2 a2) =@@ -77,44 +64,23 @@ newtype Flag = Flag { unFlag :: Text }              deriving (Eq, Show, Ord) -instance B.Binary Flag where-  get = fmap (Flag . XE.decodeUtf8) B.get-  put = B.put . XE.encodeUtf8 . unFlag- -- | There is one item in the list for each line of the memo. Do not -- include newlines in the texts themselves. However there is nothing -- to enforce this convention. newtype Memo = Memo { unMemo :: [Text] }              deriving (Eq, Show, Ord) -instance B.Binary Memo where-  get = fmap (Memo . map XE.decodeUtf8) B.get-  put = B.put . map XE.encodeUtf8 . unMemo- newtype Number = Number { unNumber :: Text }                  deriving (Eq, Show, Ord) -instance B.Binary Number where-  get = fmap (Number . XE.decodeUtf8) B.get-  put = B.put . XE.encodeUtf8 . unNumber-- newtype Payee = Payee { unPayee :: Text }               deriving (Eq, Show, Ord) -instance B.Binary Payee where-  get = fmap (Payee . XE.decodeUtf8) B.get-  put = B.put . XE.encodeUtf8 . unPayee- newtype Tag = Tag { unTag :: Text }                   deriving (Eq, Show, Ord) -instance B.Binary Tag where-  get = fmap (Tag . XE.decodeUtf8) B.get-  put = B.put . XE.encodeUtf8 . unTag- newtype Tags = Tags { unTags :: [Tag] }-               deriving (Eq, Show, Ord, Generic)+               deriving (Eq, Show, Ord)  -- | Tags are equivalent if they have the same tags (even if in a -- different order).@@ -123,22 +89,16 @@   compareEv (Tags t1) (Tags t2) =     compare (sort t1) (sort t2) -instance B.Binary Tags- -- Metadata  -- | The line number that the TopLine starts on (excluding the memo -- accompanying the TopLine). newtype TopLineLine = TopLineLine { unTopLineLine :: Int }-                      deriving (Eq, Show, Generic)--instance B.Binary TopLineLine+                      deriving (Eq, Show)  -- | The line number that the memo accompanying the TopLine starts on. newtype TopMemoLine = TopMemoLine { unTopMemoLine :: Int }-                      deriving (Eq, Show, Generic)--instance B.Binary TopMemoLine+                      deriving (Eq, Show)  -- | The commodity and and the quantity may appear with the commodity -- on the left (e.g. USD 2.14) or with the commodity on the right@@ -146,69 +106,57 @@ data Side   = CommodityOnLeft   | CommodityOnRight-  deriving (Eq, Show, Ord, Generic)+  deriving (Eq, Show, Ord) -instance B.Binary Side+instance Ev.Equivalent Side where+  equivalent = (==)+  compareEv = compare  -- | There may or may not be a space in between the commodity and the -- quantity. data SpaceBetween   = SpaceBetween   | NoSpaceBetween-  deriving (Eq, Show, Ord, Generic)+  deriving (Eq, Show, Ord) -instance B.Binary SpaceBetween +instance Ev.Equivalent SpaceBetween where+  equivalent = (==)+  compareEv = compare+ -- | The name of the file in which a transaction appears. newtype Filename = Filename { unFilename :: X.Text }                    deriving (Eq, Show) -instance B.Binary Filename where-  get = fmap (Filename . XE.decodeUtf8) B.get-  put = B.put . XE.encodeUtf8 . unFilename-- -- | The line number on which a price appears. newtype PriceLine = PriceLine { unPriceLine :: Int }-                    deriving (Eq, Show, Generic)--instance B.Binary PriceLine+                    deriving (Eq, Show)  -- | The line number on which a posting appears. newtype PostingLine = PostingLine { unPostingLine :: Int }-                      deriving (Eq, Show, Generic)--instance B.Binary PostingLine+                      deriving (Eq, Show)  -- | All postings are numbered in order, beginning with the first -- posting in the first file and ending with the last posting -- in the last file. newtype GlobalPosting =   GlobalPosting { unGlobalPosting :: S.Serial }-  deriving (Eq, Show, Generic)--instance B.Binary GlobalPosting+  deriving (Eq, Show)  -- | The postings in each file are numbered in order. newtype FilePosting =   FilePosting { unFilePosting :: S.Serial }-  deriving (Eq, Show, Generic)--instance B.Binary FilePosting+  deriving (Eq, Show)  -- | All transactions are numbered in order, beginning with the first -- transaction in the first file and ending with the last transaction -- in the last file. newtype GlobalTransaction =   GlobalTransaction { unGlobalTransaction :: S.Serial }-  deriving (Eq, Show, Generic)--instance B.Binary GlobalTransaction+  deriving (Eq, Show)  -- | The transactions in each file are numbered in order. newtype FileTransaction =   FileTransaction { unFileTransaction :: S.Serial }-  deriving (Eq, Show, Generic)--instance B.Binary FileTransaction+  deriving (Eq, Show) 

@@ -1,5 +1,3 @@-{-# LANGUAGE DeriveGeneric, GeneralizedNewtypeDeriving #-}- module Penny.Lincoln.Bits.Price (     From ( From, unFrom )   , To ( To, unTo )@@ -12,35 +10,26 @@ import qualified Penny.Lincoln.Equivalent as Ev import Penny.Lincoln.Equivalent ((==~)) import qualified Penny.Lincoln.Bits.Open as O-import Penny.Lincoln.Bits.Qty (Qty)-import GHC.Generics (Generic)-import qualified Data.Binary as B+import Penny.Lincoln.Bits.Qty (QtyRep) -newtype From = From { unFrom :: O.Commodity }-  deriving (Eq, Ord, Show, Generic) -instance B.Binary From+newtype From = From { unFrom :: O.Commodity }+  deriving (Eq, Ord, Show)  newtype To = To { unTo :: O.Commodity }-  deriving (Eq, Ord, Show, Generic)--instance B.Binary To+  deriving (Eq, Ord, Show) -newtype CountPerUnit = CountPerUnit { unCountPerUnit :: Qty }-  deriving (Eq, Ord, Show, Generic)+newtype CountPerUnit = CountPerUnit { unCountPerUnit :: QtyRep }+  deriving (Eq, Ord, Show)  instance Ev.Equivalent CountPerUnit where   equivalent (CountPerUnit x) (CountPerUnit y) = x ==~ y   compareEv (CountPerUnit x) (CountPerUnit y) = Ev.compareEv x y -instance B.Binary CountPerUnit- data Price = Price { from :: From                    , to :: To                    , countPerUnit :: CountPerUnit }-             deriving (Eq, Ord, Show, Generic)--instance B.Binary Price+             deriving (Eq, Ord, Show)  -- | Two Price are equivalent if the From and To are equal and the -- CountPerUnit is equivalent.

@@ -1,17 +1,53 @@-{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE OverloadedStrings #-} -- | Penny quantities. A quantity is simply a count (possibly -- fractional) of something. It does not have a commodity or a -- Debit/Credit. module Penny.Lincoln.Bits.Qty-  ( Qty-  , NumberStr(..)-  , toQty-  , mantissa+  (+  -- * Quantity representations+  -- ** Components of quantity representations+    Digit(..)+  , DigitList(..)+  , Digits(..)+  , Grouper(..)+  , PeriodGrp(..)+  , CommaGrp(..)+  , GroupedDigits(..)++  , WholeFrac+  , whole+  , frac+  , wholeFrac+  , wholeOrFrac+  , WholeOrFracResult+  , wholeOrFracToQtyRep++  , WholeOnly+  , unWholeOnly+  , wholeOnly++  , WholeOrFrac(..)+  , Radix(..)+  , showRadix+  , QtyRep(..)++  -- ** Converting between quantity representations and quantities+  , qtyToRep+  , qtyToRepNoGrouping+  , qtyToRepGrouped++  -- ** Rendering quantity representations+  , showQtyRep+  , bestRadGroup++  -- * Other stuff+  , Qty+  , HasQty(..)+  , signif   , places-  , prettyShowQty   , compareQty   , newQty-  , Mantissa+  , Signif   , Places   , add   , mult@@ -25,46 +61,466 @@   , qtyOne   ) where +-- # Imports++import Control.Applicative ((<|>)) import qualified Control.Monad.Exception.Synchronous as Ex-import qualified Data.Binary as B-import GHC.Generics (Generic)-import Data.List (genericLength, genericReplicate, genericSplitAt, sortBy)-import Data.Ord (comparing)+import Data.Text (Text)+import qualified Data.Text as X+import Data.Ord(Down(..), comparing)+import Data.List ( genericLength, genericReplicate, sortBy, group, sort,+                   genericSplitAt )+import Data.List.Split (chunksOf)+import Data.List.NonEmpty (NonEmpty((:|)), toList, nonEmpty)+import qualified Data.List.NonEmpty as NE+import Data.Maybe (fromMaybe, listToMaybe, mapMaybe)+import qualified Data.Semigroup(Semigroup(..))+import Data.Semigroup(sconcat)+import Data.Monoid ((<>)) import qualified Penny.Lincoln.Equivalent as Ev+import Penny.Lincoln.Equivalent (Equivalent(..))+import qualified Penny.Steel.Sums as S -data NumberStr =-  Whole String-  -- ^ A whole number only. No radix point.-  | WholeRad String-    -- ^ A whole number and a radix point, but nothing after the radix-    -- point.-  | WholeRadFrac String String-    -- ^ A whole number and something after the radix point.-  | RadFrac String-    -- ^ A radix point and a fractional value after it, but nothing-    -- before the radix point.-  deriving Show+data Digit = D0 | D1 | D2 | D3 | D4 | D5 | D6 | D7 | D8 | D9+  deriving (Eq, Ord, Show, Enum, Bounded) +-- | The digit grouping character when the radix is a period.+data PeriodGrp+  = PGSpace+  -- ^ ASCII space+  | PGThinSpace+  -- ^ Unicode code point 0x2009+  | PGComma+  -- ^ Comma+  deriving (Eq, Show, Ord, Enum, Bounded) --- | Converts strings to Qty. Fails if any of the strings have--- non-digits, or if any are negative, or if the result is not greater--- than zero, or if the strings are empty.-toQty :: NumberStr -> Maybe Qty-toQty ns = case ns of-  Whole s -> fmap (\m -> Qty m 0) (readInteger s)-  WholeRad s -> fmap (\m -> Qty m 0) (readInteger s)-  WholeRadFrac w f -> fromWholeRadFrac w f-  RadFrac f -> fromWholeRadFrac "0" f+-- | The digit grouping character when the radix is a comma.+data CommaGrp+  = CGSpace+  -- ^ ASCII space+  | CGThinSpace+  -- ^ Unicode code point 0x2009+  | CGPeriod+  -- ^ Period+  deriving (Eq, Show, Ord, Enum, Bounded)++class Grouper a where+  groupChar :: a -> Char++instance Grouper PeriodGrp where+  groupChar c = case c of+    PGSpace -> ' '+    PGThinSpace -> '\x2009'+    PGComma -> ','++instance Grouper CommaGrp where+  groupChar c = case c of+    CGSpace -> ' '+    CGThinSpace -> '\x2009'+    CGPeriod -> '.'++newtype DigitList = DigitList { unDigitList :: NonEmpty Digit }+  deriving (Eq, Show, Ord)++instance Data.Semigroup.Semigroup DigitList where+  (<>) (DigitList l1) (DigitList l2) =+    DigitList $ l1 Data.Semigroup.<> l2++class Digits a where+  digits :: a -> DigitList++instance Digits DigitList where+  digits = id++instance Digits (GroupedDigits a) where+  digits (GroupedDigits d1 dr) = sconcat (d1 :| map snd dr)++-- | All of the digits on a single side of a radix point. Typically+-- this is parameterized on a type that represents the grouping+-- character.+data GroupedDigits a = GroupedDigits+  { dsFirstPart :: DigitList+  -- ^ The first chunk of digits+  , dsNextParts :: [(a, DigitList)]+  -- ^ Optional subsequent chunks of digits. Each is a grouping+  -- character followed by additional digits.+  } deriving (Eq, Show, Ord)+++-- | A quantity representation that has both a whole number and a+-- fractional part. Abstract because there must be a non-zero digit in+-- here somewhere, which 'wholeFrac' checks for.  Typically this is+-- parameterized on an instance of the Digits class, such as DigitList+-- or GroupedDigits.  This allows separate types for values that+-- cannot be grouped as well as those that can.+data WholeFrac a = WholeFrac+  { whole :: a+  , frac :: a+  } deriving (Eq, Show, Ord)++wholeFrac+  :: Digits a+  => a+  -- ^ Whole part+  -> a+  -- ^ Fractional part+  -> Maybe (WholeFrac a)+  -- ^ If there is no non-zero digit present, Nothing. Otherwise,+  -- returns the appropriate WholeFrac.+wholeFrac w f = if digitsHasNonZero w || digitsHasNonZero f+  then (Just (WholeFrac w f)) else Nothing++digitsHasNonZero :: Digits a => a -> Bool+digitsHasNonZero = any (/= D0) . toList . unDigitList . digits++-- | A quantity representation that has a whole part only. Abstract+-- because there must be a non-zero digit in here somewhere, which+-- 'wholeOnly' checks for.  Typically this is parameterized on an+-- instance of the Digits class, such as DigitList or GroupedDigits.+newtype WholeOnly a = WholeOnly { unWholeOnly :: a }+  deriving (Eq, Show, Ord)++wholeOnly :: Digits a => a -> Maybe (WholeOnly a)+wholeOnly d = if digitsHasNonZero d then Just (WholeOnly d) else Nothing++-- | Typically this is parameterized on an instance of the Digits+-- class, such as DigitList or GroupedDigits.+newtype WholeOrFrac a = WholeOrFrac+  { unWholeOrFrac :: Either (WholeOnly a) (WholeFrac a) }+  deriving (Eq, Show, Ord)++wholeOrFrac+  :: GroupedDigits a+  -- ^ What's before the radix point++  -> Maybe (GroupedDigits a)+  -- ^ What's after the radix point (if anything)++  -> Maybe (Either (WholeOrFrac DigitList)+                   (WholeOrFrac (GroupedDigits a)))+wholeOrFrac g@(GroupedDigits l1 lr) mayAft = case mayAft of+  Nothing -> case lr of+    [] -> fmap (Left . WholeOrFrac . Left) $ wholeOnly l1+    _ -> fmap (Right . WholeOrFrac . Left) $ wholeOnly g+  Just aft@(GroupedDigits r1 rr) -> case (lr, rr) of+    ([], []) -> fmap (Left . WholeOrFrac . Right) $ wholeFrac l1 r1+    _ -> fmap (Right . WholeOrFrac . Right) $ wholeFrac g aft+++data Radix = Period | Comma+  deriving (Eq, Show, Ord, Enum, Bounded)++type WholeOrFracResult a = Either (WholeOrFrac DigitList)+                                  (WholeOrFrac (GroupedDigits a))++wholeOrFracToQtyRep+  :: Either (WholeOrFracResult PeriodGrp) (WholeOrFracResult CommaGrp)+  -> QtyRep+wholeOrFracToQtyRep e = case e of+  Left p -> case p of+    Left dl -> QNoGrouping dl Period+    Right gd -> QGrouped (Left gd)+  Right c -> case c of+    Left dl -> QNoGrouping dl Comma+    Right gd -> QGrouped (Right gd)++data QtyRep+  = QNoGrouping (WholeOrFrac DigitList) Radix+  | QGrouped (Either (WholeOrFrac (GroupedDigits PeriodGrp))+                     (WholeOrFrac (GroupedDigits CommaGrp)))+  deriving (Eq, Show, Ord)++instance Equivalent QtyRep where+  equivalent x y = showQtyRep x == showQtyRep y+  compareEv x y = Ev.compareEv (toQty x) (toQty y)++-- | Converts an Integer to a list of digits.+intToDigits :: Integer -> NonEmpty Digit+intToDigits+  = fmap intToDigit+  . fromMaybe (error "intToDigits: show made empty list")+  . nonEmpty+  . show   where-    fromWholeRadFrac w f =-      fmap (\m -> Qty m (genericLength f)) (readInteger (w ++ f))+    intToDigit c = case c of+      { '0' -> D0; '1' -> D1; '2' -> D2; '3' -> D3; '4' -> D4;+        '5' -> D5; '6' -> D6; '7' -> D7; '8' -> D8; '9' -> D9;+        _ -> error "intToDigits: show made non-digit character" } --- | Reads non-negative integers only.-readInteger :: String -> Maybe Integer-readInteger s = case reads s of-  (i, ""):[] -> if i < 0 then Nothing else Just i-  _ -> Nothing+prependNonEmpty :: [a] -> NonEmpty a -> NonEmpty a+prependNonEmpty [] x = x+prependNonEmpty (x:xs) (y1 :| ys) = x :| (xs ++ (y1 : ys)) +qtyToRepNoGrouping :: Qty -> WholeOrFrac DigitList+qtyToRepNoGrouping q =+  let sig = intToDigits . signif $ q+      e = places q+      len = genericLength . toList $ sig+  in WholeOrFrac $ if e == 0+     then Left (WholeOnly (DigitList sig))+     else if e < len+          then let prefixLen = len - e+                   (pfx, sfx) = genericSplitAt prefixLen . toList $ sig+                   ne = fromMaybe+                        (error "qtyToRepNoGrouping: nonEmpty failed")+                        . NE.nonEmpty+                   (pfxNE, sfxNE) = (ne pfx, ne sfx)+                   (w, f) = (DigitList pfxNE, DigitList sfxNE)+               in Right (WholeFrac w f)+          else let leadZeroes = genericReplicate (e - len) D0+                   w = DigitList $ D0 :| []+                   f = DigitList $ prependNonEmpty leadZeroes sig+          in Right (WholeFrac w f)++++-- | Given a list of QtyRep, determine the most common radix and+-- grouping that are used.  If a single QtyRep is grouped, then the+-- result is also grouped.  The most common grouping character+-- determines which grouping character is used.+--+-- If no QtyRep are grouped, then the most common radix point is used+-- and the result is not grouped.+--+-- If there is no radix point found, returns Nothing.+bestRadGroup+  :: [QtyRep]+  -> Maybe (S.S3 Radix PeriodGrp CommaGrp)+bestRadGroup ls = fromGrouping <|> fromRadix+  where+    grpToRadix q = case q of+      QNoGrouping _ _ -> Nothing+      QGrouped e -> Just $ either (const Period) (const Comma) e+    mostCommonGrpRad = mode . mapMaybe grpToRadix $ ls+    fromGrouping = do+      rad <- mostCommonGrpRad+      case rad of+        Period -> fmap S.S3b . mostCommonPeriodGrp $ ls+        Comma -> fmap S.S3c . mostCommonCommaGrp $ ls+    fromRadix = fmap S.S3a . mode . mapMaybe noGrpToRadix $ ls+    noGrpToRadix q = case q of+      QNoGrouping _ r -> Just r+      _ -> Nothing++mostCommonPeriodGrp :: [QtyRep] -> Maybe PeriodGrp+mostCommonPeriodGrp+  = mode+  . concatMap f+  where+    f q = case q of+      QNoGrouping _ _ -> []+      QGrouped e -> case e of+        Left (WholeOrFrac ei) -> case ei of+          Left _ -> []+          Right (WholeFrac g1 g2) -> getSeps g1 ++ getSeps g2+        Right _ -> []++mostCommonCommaGrp :: [QtyRep] -> Maybe CommaGrp+mostCommonCommaGrp+  = mode+  . concatMap f+  where+    f q = case q of+      QNoGrouping _ _ -> []+      QGrouped e -> case e of+        Left _ -> []+        Right (WholeOrFrac ei) -> case ei of+          Left _ -> []+          Right (WholeFrac g1 g2) -> getSeps g1 ++ getSeps g2++getSeps :: GroupedDigits a -> [a]+getSeps (GroupedDigits _ ls) = map fst ls+++mode :: Ord a => [a] -> Maybe a+mode = listToMaybe . modes++modes :: Ord a => [a] -> [a]+modes+  = map (head . snd)+  . sortBy (comparing (Down . fst))+  . map (\ls -> (length ls, ls))+  . group+  . sort++-- | Groups digits, using the given split character.+groupDigits+  :: NonEmpty a+  -> (NonEmpty a, [NonEmpty a])+  -- ^ The first group of digits, and any subsequent groups.+groupDigits+  = toPair+  . reverse+  . map reverse+  . chunksOf 3+  . reverse+  . toList+  where+    toPair [] = error "groupDigits: chunksOf produced empty list"+    toPair (x:xs) = (ne x, map ne xs)+    ne = fromMaybe (error $ "groupDigits: chunksOf produced"+                            ++ " empty inner list") . nonEmpty++-- Digit grouping.  Here are the rules.+--+-- No digits to the right of the decimal point are ever grouped.  For+-- now I will consider this a rare enough case that I will not bother+-- with it.+--+-- Digits to the left of the decimal point are grouped as follows:+--+-- No grouping is performed unless the entire number (including the+-- fractional portion) is at least five digits long.  That means that+-- 1234.5 is grouped into 1,234.5 but 1234 is not grouped.+--+-- Grouping is performed on the whole part only, and digits are+-- grouped every third place.++qtyToRepGrouped :: g -> Qty -> WholeOrFrac (GroupedDigits g)+qtyToRepGrouped g q = WholeOrFrac+  $ case unWholeOrFrac $ qtyToRepNoGrouping q of+    Left (WholeOnly (DigitList ds)) ->+      Left $ WholeOnly (mkWholeGroups ds)+    Right (WholeFrac w f) ->+      Right $ mkWholeFracGroups (unDigitList w) (unDigitList f)+    where+      mkGroups ds =+        let (g1, gs) = groupDigits ds+            mkGrp dl = (g, DigitList dl)+        in GroupedDigits (DigitList g1) (map mkGrp gs)+      mkWholeGroups ds = if (length . toList $ ds) > maxUngrouped+                         then mkGroups ds+                         else GroupedDigits (DigitList ds) []+      mkWholeFracGroups w f = WholeFrac w' f'+        where+          f' = GroupedDigits (DigitList f) []+          w' = if (length . toList $ w) + (length . toList $ f)+                    > maxUngrouped+               then mkGroups w+               else GroupedDigits (DigitList w) []+      maxUngrouped = 4++qtyToRep+  :: S.S3 Radix PeriodGrp CommaGrp+  -> Qty+  -> QtyRep+qtyToRep x q = case x of+  S.S3a r -> QNoGrouping (qtyToRepNoGrouping q) r+  S.S3b g -> QGrouped . Left $ qtyToRepGrouped g q+  S.S3c g -> QGrouped . Right $ qtyToRepGrouped g q++class HasQty a where+  toQty :: a -> Qty++++digitToInt :: Digit -> Integer+digitToInt d = case d of+  { D0 -> 0; D1 -> 1; D2 -> 2; D3 -> 3; D4 -> 4; D5 -> 5;+    D6 -> 6; D7 -> 7; D8 -> 8; D9 -> 9 }++digitsToInt :: DigitList -> Integer+digitsToInt+  = sum+  . map (\(e, s) -> s * 10 ^ e)+  . zip ([0..] :: [Integer])+  . map digitToInt+  . reverse+  . toList+  . unDigitList++instance HasQty QtyRep where+  toQty q = case q of+    QNoGrouping (WholeOrFrac ei) _ -> case ei of+      Left (WholeOnly ds) -> Qty (digitsToInt ds) 0+      Right (WholeFrac w f) -> Qty sig ex+        where+          sig = digitsToInt ((Data.Semigroup.<>) w f)+          ex = genericLength . toList . unDigitList $ f+    QGrouped ei -> either groupedToQty groupedToQty ei++groupedToQty :: WholeOrFrac (GroupedDigits a) -> Qty+groupedToQty (WholeOrFrac ei) = case ei of+  Left (WholeOnly g) -> Qty (digitsToInt . digits $ g) 0+  Right (WholeFrac w f) -> Qty sig ex+    where+      sig = digitsToInt ((Data.Semigroup.<>) (digits w) (digits f))+      ex = genericLength . toList . unDigitList . digits $ f++instance HasQty Qty where+  toQty = id++showDigit :: Digit -> Text+showDigit d = case d of+  { D0 -> "0"; D1 -> "1"; D2 -> "2"; D3 -> "3"; D4 -> "4";+    D5 -> "5"; D6 -> "6"; D7 -> "7"; D8 -> "8"; D9 -> "9" }++showRadix :: Radix -> Text+showRadix r = case r of { Comma -> ","; Period -> "." }++showDigitList :: DigitList -> X.Text+showDigitList = X.concat . toList . fmap showDigit . unDigitList++showGroupedDigits+  :: Grouper a+  => GroupedDigits a+  -> Text+showGroupedDigits (GroupedDigits d ds)+  = showDigitList d <> (X.concat . map f $ ds)+  where+    f (c, cs) = (X.singleton $ groupChar c) <> showDigitList cs++showWholeOnlyDigitList :: WholeOnly DigitList -> Text+showWholeOnlyDigitList = showDigitList . unWholeOnly++showWholeOnlyGroupedDigits+  :: Grouper a+  => WholeOnly (GroupedDigits a)+  -> Text+showWholeOnlyGroupedDigits = showGroupedDigits . unWholeOnly++showWholeFracDigitList+  :: Radix+  -> WholeFrac DigitList+  -> Text+showWholeFracDigitList r wf+  = showDigitList (whole wf) <> showRadix r <> showDigitList (frac wf)++showWholeFracGroupedDigits+  :: Grouper a+  => Radix+  -> WholeFrac (GroupedDigits a)+  -> Text+showWholeFracGroupedDigits r wf+  = showGroupedDigits (whole wf) <> showRadix r+  <> showGroupedDigits (frac wf)++wholeOrFracGrouped+  :: Grouper a+  => Radix+  -> WholeOrFrac (GroupedDigits a)+  -> Text+wholeOrFracGrouped r+  = either showWholeOnlyGroupedDigits (showWholeFracGroupedDigits r)+  . unWholeOrFrac++wholeOrFracDigitList+  :: Radix+  -> WholeOrFrac DigitList+  -> Text+wholeOrFracDigitList r+  = either showWholeOnlyDigitList (showWholeFracDigitList r)+  . unWholeOrFrac+++showQtyRep :: QtyRep -> Text+showQtyRep q = case q of+  QNoGrouping wf r -> wholeOrFracDigitList r wf+  QGrouped ei ->+    either (wholeOrFracGrouped Period)+           (wholeOrFracGrouped Comma) ei++ -- | A quantity is always greater than zero. Various odd questions -- happen if quantities can be zero. For instance, what if you have a -- debit whose quantity is zero? Does it require a balancing credit@@ -82,31 +538,14 @@ -- /WARNING/ - before doing comparisons or equality tests -- -- The Eq instance is derived. Therefore q1 == q2 only if q1 and q2--- have both the same mantissa and the same exponent. You may instead+-- have both the same significand and the same exponent. You may instead -- want 'equivalent'. Similarly, the Ord instance is derived. It--- compares based on the integral value of the mantissa and of the+-- compares based on the integral value of the significand and of the -- exponent. You may instead want 'compareQty', which compares after -- equalizing the exponents.-data Qty = Qty { mantissa :: !Integer+data Qty = Qty { signif :: !Integer                , places :: !Integer-               } deriving (Eq, Generic, Show, Ord)---- | Shows a quantity, nicely formatted after accounting for both the--- mantissa and decimal places, e.g. @0.232@ or @232.12@ or whatever.-prettyShowQty :: Qty -> String-prettyShowQty q =-  let man = show . mantissa $ q-      e = places q-      len = genericLength man-      small = "0." ++ ((genericReplicate (e - len) '0') ++ man)-  in case compare e len of-      GT -> small-      EQ -> small-      LT ->-        let (b, end) = genericSplitAt (len - e) man-        in if e == 0-           then man-           else b ++ ['.'] ++ end+               } deriving (Eq, Show, Ord)  instance Ev.Equivalent Qty where   equivalent x y = x' == y'@@ -116,30 +555,25 @@     where       (x', y') = equalizeExponents x y -instance B.Binary Qty--type Mantissa = Integer+type Signif = Integer type Places = Integer --- | Mantissa 1, exponent 0+-- | Significand 1, exponent 0 qtyOne :: Qty qtyOne = Qty 1 0  ---newQty :: Mantissa -> Places -> Maybe Qty+newQty :: Signif -> Places -> Maybe Qty newQty m p   | m > 0  && p >= 0 = Just $ Qty m p   | otherwise = Nothing  - -- | Compares Qty after equalizing their exponents. -- -- > compareQty (newQty 15 1) (newQty 1500 3) == EQ compareQty :: Qty -> Qty -> Ordering-compareQty q1 q2 = compare (mantissa q1') (mantissa q2')+compareQty q1 q2 = compare (signif q1') (signif q2')   where     (q1', q2') = equalizeExponents q1 q2 @@ -183,7 +617,7 @@ difference :: Qty -> Qty -> Difference difference x y =   let (x', y') = equalizeExponents x y-      (mx, my) = (mantissa x', mantissa y')+      (mx, my) = (signif x', signif y')   in case compare mx my of     GT -> LeftBiggerBy (Qty (mx - my) (places x'))     LT -> RightBiggerBy (Qty (my - mx) (places x'))@@ -208,7 +642,7 @@ -- Adjust all exponents, both on the amount to be allocated and on all -- the votes, so that the exponents are all equal. ----- Allocate the mantissas.+-- Allocate the significands. -- -- Return the quantities with the original exponents. @@ -236,8 +670,8 @@ allocate' tot ls =   let ((tot':ls'), e) = sameExponent (tot:ls)       (moreE, (_, ss)) =-        multRemainderAllResultsAtLeast1 (mantissa tot')-        (map mantissa ls')+        multRemainderAllResultsAtLeast1 (signif tot')+        (map signif ls')       totE = e + moreE   in map (\m -> Qty m totE) ss 

@@ -1,4 +1,4 @@-{-# LANGUAGE DeriveGeneric, DeriveFunctor #-}+{-# LANGUAGE DeriveFunctor #-}  -- | Containers for entries. --@@ -29,11 +29,10 @@  module Penny.Lincoln.Ents   ( -- * Ent-    Inferred(..)-  , Ent+    Ent   , entry-  , inferred   , meta+  , inferred    -- * Ents   , Ents@@ -56,8 +55,6 @@  import Control.Applicative import Control.Arrow (second)-import Data.Binary (Binary)-import GHC.Generics (Generic) import qualified Penny.Lincoln.Bits as B import qualified Penny.Lincoln.Balance as Bal import Control.Monad (guard)@@ -69,41 +66,36 @@ import qualified Data.Traversable as Tr import qualified Data.Foldable as Fdbl --- | An Ent is inferred if the user did not supply an entry for it and--- Penny was able to infer the correct entry. Otherwise it is not--- inferred.-data Inferred = Inferred | NotInferred-  deriving (Eq, Ord, Show, Generic) -instance Binary Inferred- -- | Information about an entry, along with whether it is inferred and -- its metadata. data Ent m = Ent-  { entry :: B.Entry-  -- ^ The entry from an Ent-  , inferred :: Inferred-  -- ^ Whether the entry was inferred+  { entry :: Either (B.Entry B.QtyRep) (B.Entry B.Qty)+  -- ^ The entry from an Ent.  If the Ent is inferred--that is, if the+  -- user did not supply an entry for it and Penny was able to infer+  -- the entry--this will be a Right with the inferred Entry.+   , meta :: m   -- ^ The metadata accompanying an Ent-  } deriving (Eq, Ord, Show, Generic) +  , inferred :: Bool+  -- ^ True if the entry was inferred.+  } deriving (Eq, Ord, Show)+ -- | Two Ents are equivalent if the entries are equivalent and the -- metadata is equivalent (whether the Ent is inferred or not is -- ignored.) instance Ev.Equivalent m => Ev.Equivalent (Ent m) where-  equivalent (Ent e1 _ m1) (Ent e2 _ m2) =-    e1 ==~ e2 && m1 ==~ m2-  compareEv (Ent e1 _ m1) (Ent e2 _ m2) =+  equivalent (Ent e1 m1 _) (Ent e2 m2 _) = e1 ==~ e2 && m1 ==~ m2++  compareEv (Ent e1 m1 _) (Ent e2 m2 _) =     Ev.compareEv e1 e2 <> Ev.compareEv m1 m2  instance Functor Ent where-  fmap f (Ent e i m) = Ent e i (f m)--instance Binary m => Binary (Ent m)+  fmap f (Ent e m i) = Ent e (f m) i  newtype Ents m = Ents { unEnts :: [Ent m] }-  deriving (Eq, Ord, Show, Generic, Functor)+  deriving (Eq, Ord, Show, Functor)  -- | Ents are equivalent if the content Ents of each are -- equivalent. The order of the ents is insignificant.@@ -139,10 +131,10 @@ -- instance. traverseEnts :: Applicative f => (Ent a -> f b) -> Ents a -> f (Ents b) traverseEnts f = fmap Ents . Tr.traverse f' . unEnts where-  f' en@(Ent e i _) = Ent <$> pure e <*> pure i <*> f en+  f' en@(Ent e _ i) = Ent <$> pure e <*> f en <*> pure i  seqEnt :: Applicative f => Ent (f a) -> f (Ent a)-seqEnt (Ent e i m) = Ent <$> pure e <*> pure i <*> m+seqEnt (Ent e m i) = Ent <$> pure e <*> m <*> pure i  -- | Every Ents alwas contains at least two ents, and possibly -- additional ones.@@ -151,8 +143,6 @@   t1:t2:ts -> (t1, t2, ts)   _ -> error "tupleEnts: ents does not have two ents" -instance Binary m => Binary (Ents m)- -- | In a Posting, the Ent at the front of the list of Ents is the -- main posting. There are additional postings. This function -- rearranges the Ents multiple times so that each posting is at the@@ -216,23 +206,27 @@ -- and this function will infer the remaining Entry. This function -- fails if it cannot create a balanced Ents. ents-  :: [(Maybe B.Entry, m)]+  :: [(Maybe (Either (B.Entry B.QtyRep) (B.Entry B.Qty)), m)]   -> Maybe (Ents m) ents ls = do   guard . not . null $ ls   let nNoEntries = length . filter (== Nothing) . map fst $ ls-  case Bal.entriesToBalanced . catMaybes . map fst $ ls of+  case Bal.entriesToBalanced+       . map (either (fmap B.toQty) id)+       . catMaybes+       . map fst+       $ ls of     Bal.NotInferable -> Nothing     Bal.Inferable e -> do       guard $ nNoEntries == 1       let makeEnt (mayEn, mt) = case mayEn of-            Nothing -> Ent e Inferred mt-            Just en -> Ent en NotInferred mt+            Nothing -> Ent (Right e) mt True+            Just en -> Ent en mt False       return . Ents $ map makeEnt ls     Bal.Balanced ->       let makeEnt (mayEn, mt) = case mayEn of             Nothing -> Nothing-            Just en -> Just $ Ent en NotInferred mt+            Just en -> Just $ Ent en mt False       in fmap Ents $ mapM makeEnt ls  @@ -245,21 +239,23 @@   -- ^ Commodity for all postings   -> B.DrCr   -- ^ DrCr for all non-inferred postings-  -> (B.Qty, m)+  -> (Either B.QtyRep B.Qty, m)   -- ^ Non-inferred posting 1-  -> [(B.Qty, m)]+  -> [(Either B.QtyRep B.Qty, m)]   -- ^ Remaining non-inferred postings   -> m   -- ^ Metadata for inferred posting   -> Ents m rEnts com dc (q1, m1) nonInfs lastMeta =-  let tot = foldl' B.add q1 . map fst $ nonInfs+  let tot = foldl' B.add (either B.toQty id q1)+            . map (either B.toQty id . fst) $ nonInfs       p1 = makePstg (q1, m1)       ps = map makePstg nonInfs-      makePstg (q, m) = Ent (B.Entry dc (B.Amount q com))-                                NotInferred m-      lastPstg = Ent (B.Entry (B.opposite dc) (B.Amount tot com))-                         Inferred lastMeta+      makeEntry = either (\q -> Left (B.Entry dc (B.Amount q com)))+                         (\q -> Right (B.Entry dc (B.Amount q com)))+      makePstg (q, m) = Ent (makeEntry q) m False+      lastPstg = Ent (Right (B.Entry (B.opposite dc)+                                     (B.Amount tot com))) lastMeta True   in Ents $ p1:ps ++ [lastPstg]  

@@ -15,7 +15,36 @@ (==~) = equivalent infix 4 ==~ +instance Equivalent a => Equivalent (Maybe a) where+  equivalent a b = case (a, b) of+    (Just x, Just y) -> x ==~ y+    (Nothing, Nothing) -> True+    _ -> False+  compareEv a b = case (a, b) of+    (Just x, Just y) -> compareEv x y+    (Nothing, Nothing) -> EQ+    (Just _, Nothing) -> GT+    (Nothing, Just _) -> LT+ instance (Equivalent a, Equivalent b) => Equivalent (a, b) where   equivalent (a1, b1) (a2, b2) = a1 ==~ a2 && b1 ==~ b2   compareEv (a1, b1) (a2, b2) =     compareEv a1 a2 <> compareEv b1 b2++instance (Equivalent a, Equivalent b, Equivalent c) =>+  Equivalent (a, b, c) where+    equivalent (a1, b1, c1) (a2, b2, c2) = a1 ==~ a2+      && b1 ==~ b2 && c1 ==~ c2+    compareEv (a1, b1, c1) (a2, b2, c2) =+      compareEv a1 a2 <> compareEv b1 b2 <> compareEv c1 c2++instance (Equivalent a, Equivalent b) => Equivalent (Either a b) where+  equivalent e1 e2 = case (e1, e2) of+    (Left l1, Left l2) -> l1 ==~ l2+    (Right r1, Right r2) -> r1 ==~ r2+    _ -> False+  compareEv e1 e2 = case (e1, e2) of+    (Left l1, Left l2) -> compareEv l1 l2+    (Right l1, Right l2) -> compareEv l1 l2+    (Left _, Right _) -> LT+    (Right _, Left _) -> GT

@@ -85,14 +85,15 @@ -- fail and throw PriceDbError. Internally uses 'getPrice', so read its -- documentation for details on how price lookup works. convertAsOf ::-  PriceDb+  B.HasQty q+  => PriceDb   -> B.DateTime   -> B.To-  -> B.Amount+  -> B.Amount q   -> Ex.Exceptional PriceDbError B.Qty convertAsOf db dt to (B.Amount qt fr)-  | fr == B.unTo to = return qt+  | fr == B.unTo to = return . B.toQty $ qt   | otherwise = do     cpu <- fmap B.unCountPerUnit (getPrice db (B.From fr) to dt)-    let qt' = B.mult cpu qt+    let qt' = B.mult (B.toQty cpu) (B.toQty qt)     return qt'

@@ -52,23 +52,27 @@ tags :: E.Posting -> B.Tags tags = B.pTags . B.pdCore . E.meta . E.headEnt . snd . E.unPosting -entry :: E.Posting -> B.Entry+entry :: E.Posting -> Either (B.Entry B.QtyRep) (B.Entry B.Qty) entry = E.entry . E.headEnt . snd . E.unPosting  balance :: E.Posting -> Balance-balance = entryToBalance . entry+balance = either entryToBalance entryToBalance . entry  drCr :: E.Posting -> B.DrCr-drCr = B.drCr . entry+drCr = either B.drCr B.drCr . entry -amount :: E.Posting -> B.Amount-amount = B.amount . entry+amount :: E.Posting -> Either (B.Amount B.QtyRep) (B.Amount B.Qty)+amount = either (Left . B.amount) (Right . B.amount) . entry +eiQty :: E.Posting -> Either B.QtyRep B.Qty+eiQty = either (Left . B.qty) (Right . B.qty) . amount++-- | Every Posting either has a Qty or it can be computed from its QtyRep. qty :: E.Posting -> B.Qty-qty = B.qty . amount+qty = either B.toQty B.toQty . eiQty  commodity :: E.Posting -> B.Commodity-commodity = B.commodity . amount+commodity = either B.commodity B.commodity . amount  topMemoLine :: E.Posting -> Maybe B.TopMemoLine topMemoLine p = (B.tlFileMeta . fst . E.unPosting $ p) >>= B.tTopMemoLine

@@ -59,23 +59,23 @@ tags :: E.Posting -> [B.Tags] tags = sibs (B.pTags . B.pdCore . E.meta) -entry :: E.Posting -> [B.Entry]+entry :: E.Posting -> [Either (B.Entry B.QtyRep) (B.Entry B.Qty)] entry = sibs E.entry  balance :: E.Posting -> [Balance]-balance = map entryToBalance . entry+balance = map (either entryToBalance entryToBalance) . entry  drCr :: E.Posting -> [B.DrCr]-drCr = map B.drCr . entry+drCr = map (either B.drCr B.drCr) . entry -amount :: E.Posting -> [B.Amount]-amount = map B.amount . entry+amount :: E.Posting -> [Either (B.Amount B.QtyRep) (B.Amount B.Qty)]+amount = map (either (Left . B.amount) (Right . B.amount)) . entry  qty :: E.Posting -> [B.Qty]-qty = map B.qty . amount+qty = map (either (B.toQty . B.qty) (B.toQty . B.qty)) . amount  commodity :: E.Posting -> [B.Commodity]-commodity = map B.commodity . amount+commodity = map (either B.commodity B.commodity) . amount  postingLine :: E.Posting -> [Maybe B.PostingLine] postingLine = sibs (fmap B.pPostingLine . B.pdFileMeta . E.meta)

@@ -105,6 +105,9 @@     -- ^ Tests may use this date and time as they wish; see     -- 'tests'. Typically you will set this to the current instant. +  , formatQty :: [Cop.LedgerItem] -> L.Amount L.Qty -> X.Text+  -- ^ How to format quantities+   }  parseBaseTime :: String -> Ex.Exceptional MA.InputError Time.UTCTime@@ -143,14 +146,10 @@ -- corresponding to the ledger files provided on the command line. parseArgs :: V.Version -> WheatConf -> IO (WheatConf, [String]) parseArgs ver c = do-  parsed <- MA.simpleWithHelp (help c) MA.Intersperse-         (fmap Left (Ly.version ver) : (map (fmap (Right . Left)) allOpts))-         (return . Right . Right)-  let (showVers, optsAndArgs) = partitionEithers parsed-  case showVers of-    [] -> return ()-    x:_ -> x-  let (opts, args) = partitionEithers optsAndArgs+  parsed <- MA.simpleHelpVersion (help c) (Ly.version ver)+            (map (fmap Right) allOpts) MA.Intersperse+            (return . Left)+  let (args, opts) = partitionEithers parsed       fn = foldl (flip (.)) id opts       c' = fn c   return (c', args)@@ -169,12 +168,14 @@   rt <- S.runtime   (conf, args) <- parseArgs ver (getWc rt)   term <- Rb.smartTermFromEnv (colorToFile conf) IO.stdout-  pstgs <- getItems args+  items <- Cop.open args+  let pstgs = getItems items+      formatter = formatQty conf items   let tsts = filter ((testPred conf) . TT.testName)              . map ($ (L.toUTC . S.currentTime $ rt))              . tests              $ conf-  bs <- mapM (runTest conf pstgs term) tsts+  bs <- mapM (runTest formatter conf pstgs term) tsts   if and bs     then Exit.exitSuccess     else Exit.exitFailure@@ -183,25 +184,26 @@ -- set and if the test failed. Otherwise, returns whether the test -- succeeded or failed. runTest-  :: WheatConf+  :: (L.Amount L.Qty -> X.Text)+  -> WheatConf   -> [L.Posting]   -> Rb.Term   -> TT.Test L.Posting   -> IO Bool-runTest c ps term test = do+runTest fmt c ps term test = do   let rslt = TT.evalTest test ps-      cks = TT.showResult (indentAmt c) L.display (verbosity c) rslt+      cks = TT.showResult (indentAmt c) (L.display fmt)+                          (verbosity c) rslt   Rb.putChunks term cks   if stopOnFail c && not (TT.resultPass rslt)     then Exit.exitFailure     else return (TT.resultPass rslt) -getItems :: [String] -> IO [L.Posting]-getItems ss = fmap f $ Cop.open ss-  where-    f = concatMap L.transactionToPostings-        . mapMaybe ( let cn = const Nothing-                     in Su.caseS4 Just cn cn cn)+getItems :: [Cop.LedgerItem] -> [L.Posting]+getItems+  = concatMap L.transactionToPostings+  . mapMaybe ( let cn = const Nothing+               in Su.caseS4 Just cn cn cn)  -- -- Tests

@@ -23,7 +23,6 @@ import qualified Penny.Steel.Sums as Su  import Control.Applicative ((<*>), pure, (<$))-import Control.Monad (join) import qualified Control.Monad.Trans.State as St import qualified Control.Monad.Exception.Synchronous as Ex import Data.Char (toUpper, toLower)@@ -32,7 +31,7 @@ import Data.Maybe (mapMaybe, catMaybes, fromMaybe) import Data.Monoid (mappend, mconcat, (<>)) import Data.Ord (comparing)-import Data.Text (Text, pack)+import Data.Text (Text, pack, unpack) import Data.Version (Version) import qualified Data.Text.IO as TIO import qualified System.Console.MultiArg as MA@@ -51,8 +50,15 @@ runZinc ver df rt rs = do   let ord = sortPairsToFn . sorter $ df       hlp = helpText df rt rs-  join $ MA.modesWithHelp hlp (allOpts ver (S.currentTime rt) df)-    (processGlobal rt ord df rs)+      globals = MA.optsHelpVersion hlp (Ly.version ver)+                (allOpts (S.currentTime rt) df)+  ei <- MA.modesIO globals (processGlobal rt ord df rs)+  case ei of+    Left h -> do+      pn <- MA.getProgName+      putStr (h pn)+      Exit.exitSuccess+    Right act -> act   -- | Whether to use color when standard output is not a terminal.@@ -94,6 +100,7 @@     -- > [(Date, Ascending), (Payee, Ascending)]    , exprDesc :: X.ExprDesc+  , formatQty :: [C.LedgerItem] -> L.Amount L.Qty -> Text   }  sortPairToFn :: (SortField, P.SortOrder) -> Orderer@@ -164,7 +171,6 @@   | RExprDesc X.ExprDesc   | RShowExpression   | RVerboseFilter-  | RShowVersion (IO ())  getPostFilters   :: [OptResult]@@ -201,13 +207,6 @@      then return i      else fmap mconcat . sequence $ exSpecs -getShowVersion :: [OptResult] -> Maybe (IO ())-getShowVersion ls = case mapMaybe f ls of-  [] -> Nothing-  xs -> Just $ last xs-  where-    f o = case o of { RShowVersion i -> Just i; _ -> Nothing }- type Factory = M.CaseSensitive              -> Text -> Ex.Exceptional Text M.Matcher @@ -249,8 +248,8 @@   in fmap (\xs -> (xs, st')) . sequence . catMaybes $ ls  -allOpts :: Version -> L.DateTime -> Defaults -> [MA.OptSpec OptResult]-allOpts ver dt df =+allOpts :: L.DateTime -> Defaults -> [MA.OptSpec OptResult]+allOpts dt df =   map (fmap ROperand) (Ly.operandSpecs dt)   ++ [fmap RPostFilter . fst $ Ly.postFilterSpecs]   ++ [fmap RPostFilter . snd $ Ly.postFilterSpecs]@@ -264,7 +263,6 @@   ++ map (fmap RExprDesc) Ly.exprDesc   ++ [ RShowExpression <$ Ly.showExpression      , RVerboseFilter <$ Ly.verboseFilter-     , fmap RShowVersion (Ly.version ver)      ]  optColorToFile :: MA.OptSpec OptResult@@ -324,9 +322,12 @@     -- subsequent parses of the command line.    , foSorterFilterer :: [L.Transaction]-                    -> ([R.Chunk], [(Ly.LibertyMeta, L.Posting)])-    -- ^ Applied to a list of Transaction, will sort and filter-    -- the transactions and assign them LibertyMeta.+                     -> ( (L.Amount L.Qty -> Text) -> [R.Chunk]+                          , [(Ly.LibertyMeta, L.Posting)])+    -- ^ Applied to a list of Transaction, will sort and filter the+    -- transactions and assign them LibertyMeta. Also, returns a+    -- function that, when applied to a function that will format+    -- quantities, returns a verbose description of what was filtered.    , foTextSpecs :: Maybe E.Changers @@ -343,43 +344,40 @@   -> Defaults   -> [I.Report]   -> [OptResult]-  -> Either (a -> IO ()) [MA.Mode (IO ())]+  -> Ex.Exceptional String+      (Either a [MA.Mode (MA.ProgName -> String) (IO ())]) processGlobal rt srt df rpts os   = case processFiltOpts srt df os of-      Ex.Exception s -> Left $ (const $ handleTextError s)-      Ex.Success mayFo -> case mayFo of-        Left i -> Left . const $ i-        Right fo -> Right $ map (makeMode rt fo) rpts+      Ex.Exception s -> Ex.throw s+      Ex.Success fo ->+        return . Right $ map (makeMode (formatQty df) rt fo) rpts  processFiltOpts   :: Orderer   -> Defaults   -> [OptResult]-  -> Ex.Exceptional Error (Either (IO ()) FilterOpts)-  -- ^ Left if the user asked to see the version; Right with the-  -- FilterOpts otherwise.-processFiltOpts ord df os = case getShowVersion os of-  Just i -> return $ Left i-  Nothing -> do-    postFilts <- getPostFilters os-    sortSpec <- getSortSpec ord os-    (toks, (rs, rf)) <- makeTokens df os-    let ctf = getColorToFile df os-        sch = getScheme df os-        expDsc = getExprDesc df os-        showExpr = getShowExpression os-        verbFilt = getVerboseFilter os-    pdct <- Ly.parsePredicate expDsc toks-    let sf = Ly.xactionsToFiltered pdct postFilts sortSpec-    return . Right $ FilterOpts rf rs sf sch-                                ctf expDsc pdct showExpr verbFilt+  -> Ex.Exceptional String FilterOpts+processFiltOpts ord df os = Ex.mapException unpack $ do+  postFilts <- getPostFilters os+  sortSpec <- getSortSpec ord os+  (toks, (rs, rf)) <- makeTokens df os+  let ctf = getColorToFile df os+      sch = getScheme df os+      expDsc = getExprDesc df os+      showExpr = getShowExpression os+      verbFilt = getVerboseFilter os+  pdct <- Ly.parsePredicate expDsc toks+  let sf ls = Ly.xactionsToFiltered pdct postFilts sortSpec ls+  return $ FilterOpts rf rs sf sch+                      ctf expDsc pdct showExpr verbFilt  makeMode-  :: S.Runtime+  :: ([C.LedgerItem] -> L.Amount L.Qty -> Text)+  -> S.Runtime   -> FilterOpts   -> I.Report-  -> MA.Mode (IO ())-makeMode rt fo r = fmap makeIO mode+  -> MA.Mode (MA.ProgName -> String) (IO ())+makeMode mkFmt rt fo r = fmap makeIO mode   where     mode = snd (r rt) (foResultSensitive fo) (foResultFactory fo)            (fromMaybe Schemes.plainLabels . foTextSpecs $ fo)@@ -387,16 +385,18 @@     makeIO parseResult = do       (posArgs, printRpt) <-         Ex.switch handleTextError return parseResult-      (txns, pps) <- fmap splitLedger $ C.open posArgs-      let term = if unColorToFile (foColorToFile fo)+      items <- C.open posArgs+      let fmt = mkFmt items+          (txns, pps) = splitLedger items+          term = if unColorToFile (foColorToFile fo)                  then S.termFromEnv rt                  else S.autoTerm rt           printer = R.putChunks term-          verbFiltChunks = fst . foSorterFilterer fo $ txns+          verbFiltChunks = (fst . foSorterFilterer fo $ txns) fmt       showFilterExpression printer (foShowExpression fo) (foPredicate fo)       showVerboseFilter printer (foVerboseFilter fo) verbFiltChunks       Ex.switch handleTextError (R.putChunks term)-        $ printRpt txns pps+        $ printRpt fmt txns pps   handleTextError :: Text -> IO a

@@ -1,5 +1,5 @@ Name: penny-lib-Version: 0.20.0.0+Version: 0.21.0.0 Cabal-version: >=1.8 Build-Type: Simple License: BSD3@@ -12,25 +12,10 @@ Category: Console, Finance License-File: LICENSE -synopsis: Extensible double-entry accounting system - library--description: Penny is a double-entry accounting system. It is inspired-  by, but incompatible with, John Wiegley's Ledger, which is available-  at <http://ledger-cli.org/>.--  .--  This package is a library. To start using Penny you will want to-  install the penny-bin package, which has the executable programs.-  More about the penny-bin package, along with a full sales pitch-  for Penny and how to get started, is at-  <http://hackage.haskell.org/package/penny-bin>. It may be installed-  with "cabal install penny-bin".--  .+synopsis: Deprecated - use penny package instead -  The Penny library is a full system to work with double-entry-  accounting transactions and postings and to make reports with them.+description:+  This package is now deprecated.  Use the penny package instead.  source-repository head   type: git@@ -46,7 +31,7 @@     , containers ==0.5.*     , explicit-exception ==0.1.*     , matchers ==0.6.*-    , multiarg ==0.16.*+    , multiarg ==0.18.*     , ofx ==0.2.*     , old-locale ==1.0.*     , parsec >= 3.1.2 && < 3.2@@ -157,7 +142,10 @@    -- Be sure the build-depends are listed within the if block;   -- otherwise, cabal install will always include these-  -- build-dependencies in any build, even non-test builds.+  -- build-dependencies in any build, even non-test builds. However,+  -- you still have to list all the build-depends--the library+  -- build-depends are included for dependency resolving purposes but+  -- not for building purposes.    -- Test dependencies. test-framework has issues with newer versions,   -- see@@ -167,6 +155,27 @@         QuickCheck ==2.5.*       , random-shuffle ==0.0.4 +      , base ==4.*+      , action-permutations ==0.0.0.0+      , binary ==0.7.*+      , bytestring ==0.10.*+      , cereal ==0.3.*+      , containers ==0.5.*+      , explicit-exception ==0.1.*+      , matchers ==0.6.*+      , multiarg ==0.18.*+      , ofx ==0.2.*+      , old-locale ==1.0.*+      , parsec >= 3.1.2 && < 3.2+      , prednote == 0.14.*+      , pretty-show ==1.5.*+      , rainbow ==0.4.*+      , semigroups ==0.9.*+      , split ==0.2.*+      , text ==0.11.*+      , time ==1.4.*+      , transformers == 0.3.*+   else     buildable: False @@ -180,6 +189,29 @@     build-depends:         QuickCheck ==2.5.*       , random-shuffle ==0.0.4+      , random ==1.0.*++      , base ==4.*+      , action-permutations ==0.0.0.0+      , binary ==0.7.*+      , bytestring ==0.10.*+      , cereal ==0.3.*+      , containers ==0.5.*+      , explicit-exception ==0.1.*+      , matchers ==0.6.*+      , multiarg ==0.18.*+      , ofx ==0.2.*+      , old-locale ==1.0.*+      , parsec >= 3.1.2 && < 3.2+      , prednote == 0.14.*+      , pretty-show ==1.5.*+      , rainbow ==0.4.*+      , semigroups ==0.9.*+      , split ==0.2.*+      , text ==0.11.*+      , time ==1.4.*+      , transformers == 0.3.*+   else     buildable: False 

@@ -23,26 +23,15 @@   , "  -c, --count INT"   , "      Number of items (transactions, comments, prices, and"   , "      blank lines, total) to output. (default: 100)"-  , "  -l, --left GROUP_SPEC"-  , "      Group left of the decimal point (default: none)"-  , "  -r, --right GROUP_SPEC"-  , "      Group right of the decimal point (default: none)"-  , "      where GROUP_SPEC is:"-  , "        none - no digit grouping"-  , "        large - group if greater than 9,999 left of decimal,"-  , "                or more than 4 decimal places right of decimal"-  , "        all - group whenever there are at least 4 places"   ]  data Opts = Opts   { optSize :: Int   , optCount :: Int-  , optLeft :: R.GroupSpec-  , optRight :: R.GroupSpec   } deriving Show  defaultOpts :: Opts-defaultOpts = Opts 5 100 R.NoGrouping R.NoGrouping+defaultOpts = Opts 5 100  options :: [MA.OptSpec (Opts -> Opts)] options =@@ -57,21 +46,8 @@       if i < 1         then Ex.throw (MA.ErrorMsg "non-positive count parameter")         else return (\os -> os { optCount = i })--  , MA.OptSpec ["left"] "l" . MA.ChoiceArg-    . map (\(str, spec) -> (str, \os -> os { optLeft = spec }))-    $ groupSpecs--  , MA.OptSpec ["right"] "r" . MA.ChoiceArg-    . map (\(str, spec) -> (str, \os -> os { optRight = spec }))-    $ groupSpecs   ] -groupSpecs :: [(String, R.GroupSpec)]-groupSpecs = [ ("none",  R.NoGrouping)-             , ("large", R.GroupLarge)-             , ("all",   R.GroupAll  ) ]- posArg :: a -> Ex.Exceptional MA.InputError b posArg _ = Ex.throw (MA.ErrorMsg "no non-option arguments accepted") @@ -81,15 +57,14 @@ main :: IO () main = do   pn <- MA.getProgName-  os <- fmap parse $ MA.simpleWithHelp help MA.Intersperse options+  os <- fmap parse $ MA.simpleHelp help options MA.Intersperse                      posArg   gen <- Rand.getStdGen   let is = (\g -> G.unGen g gen (optSize os))            . fmap (map fst)            . replicateM (optCount os)            $ P.item-      gs = R.GroupSpecs (optLeft os) (optRight os)-      x = mapM (R.item gs) is+      x = mapM (R.item Nothing) is   case x of     Nothing -> do       IO.hPutStrLn IO.stderr $ pn ++ ": error: could not render ledger."

@@ -34,8 +34,8 @@  main :: IO () main = do-  opts <- MA.simpleWithHelp help MA.Intersperse-          options+  opts <- MA.simpleHelp help options+          MA.Intersperse           ( const . Ex.Exception . MA.ErrorMsg             $ "this command does not accept positional arguments")   let args = foldl (flip (.)) id opts Q.stdArgs