penny-lib 0.8.0.0 → 0.10.0.0

raw patch · 33 files changed

+913/−3884 lines, 33 filesdep +prednotedep +rainbowdep −optparse-applicativedep ~multiargPVP ok

version bump matches the API change (PVP)

Dependencies added: prednote, rainbow

Dependencies removed: optparse-applicative

Dependency ranges changed: multiarg

API changes (from Hackage documentation)

Files

• Penny.hs +4/−7
• Penny/Brenner.hs +21/−1
• Penny/Brenner/BofA.hs +15/−1
• Penny/Brenner/Merge.hs +21/−29
• Penny/Brenner/Types.hs +11/−0
• Penny/Cabin/Balance/Convert.hs +19/−15
• Penny/Cabin/Balance/Convert/Chunker.hs +65/−53
• Penny/Cabin/Balance/MultiCommodity.hs +18/−12
• Penny/Cabin/Balance/MultiCommodity/Chunker.hs +52/−42
• Penny/Cabin/Interface.hs +7/−3
• Penny/Cabin/Posts.hs +26/−23
• Penny/Cabin/Posts/Allocated.hs +23/−15
• Penny/Cabin/Posts/BottomRows.hs +84/−67
• Penny/Cabin/Posts/Chunk.hs +21/−19
• Penny/Cabin/Posts/Growers.hs +102/−93
• Penny/Cabin/Posts/Meta.hs +1/−1
• Penny/Cabin/Posts/Parser.hs +2/−2
• Penny/Cabin/Row.hs +45/−49
• Penny/Cabin/Scheme.hs +35/−40
• Penny/Cabin/Scheme/Schemes.hs +29/−31
• Penny/Liberty.hs +3/−3
• Penny/Lincoln/Predicates.hs +1/−1
• Penny/Shield.hs +1/−1
• Penny/Steel/Chunk.hs +0/−2452
• Penny/Steel/Chunk/Switch.hs +0/−26
• Penny/Steel/Expressions.hs +0/−70
• Penny/Steel/Expressions/Infix.hs +0/−126
• Penny/Steel/Expressions/RPN.hs +0/−74
• Penny/Steel/Pdct.hs +0/−292
• Penny/Steel/TestTree.hs +0/−198
• Penny/Wheat.hs +282/−93
• Penny/Zinc.hs +21/−35
• penny-lib.cabal +4/−10

@@ -10,12 +10,10 @@    -- ** Color schemes   , E.Scheme(..)-  , E.TextSpecs+  , E.Changers   , E.Labels(..)   , E.EvenAndOdd(..)-  , Sw.switchForeground-  , Sw.switchBackground-  , module Penny.Steel.Chunk+  , module System.Console.Rainbow    -- ** Sorting   , Z.SortField(..)@@ -92,8 +90,7 @@ import qualified Penny.Cabin.Balance.Convert.Options as ConvOpts import qualified Penny.Cabin.Balance.MultiCommodity as MC import qualified Penny.Cabin.Balance.MultiCommodity.Parser as MP-import Penny.Steel.Chunk-import qualified Penny.Steel.Chunk.Switch as Sw+import System.Console.Rainbow import qualified Penny.Cabin.Interface as I import qualified Penny.Cabin.Options as CO import qualified Penny.Cabin.Parsers as CabP@@ -103,7 +100,7 @@ import qualified Penny.Cabin.Posts.Meta as M import qualified Penny.Cabin.Scheme as E import qualified Penny.Lincoln as L-import qualified Penny.Steel.Expressions as Exp+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

@@ -13,6 +13,7 @@   , Y.Translator(..)   , L.Side(..)   , L.SpaceBetween(..)+  , usePayeeOrDesc   , brennerMain   ) where @@ -193,11 +194,22 @@   -- The first element of the pair is a help string which should   -- indicate how to download the data, as a helpful reminder. +  , toLincolnPayee :: Y.Desc -> Y.Payee -> L.Payee+  -- ^ Sometimes the financial institution provides Payee information,+  -- sometimes it does not. Sometimes the Desc might have additional+  -- information that you might want to remove. This function can be+  -- used to do that. The resulting Lincoln Payee is used for any+  -- transactions that are created by the merge command. The resulting+  -- payee is also used when comparing new financial institution+  -- postings to already existing ledger transactions in order to+  -- guess at which payee and accounts to create in the transactions+  -- created by the merge command. +   } deriving Show  convertFitAcct :: FitAcct -> Y.FitAcct-convertFitAcct (FitAcct db ax df cy gs tl sd sb ps) = Y.FitAcct+convertFitAcct (FitAcct db ax df cy gs tl sd sb ps tlp) = Y.FitAcct   { Y.dbLocation = Y.DbLocation . X.pack $ db   , Y.pennyAcct = Y.PennyAcct . Bd.account . X.pack $ ax   , Y.defaultAcct = Y.DefaultAcct . Bd.account . X.pack $ df@@ -207,6 +219,7 @@   , Y.side = sd   , Y.spaceBetween = sb   , Y.parser = ps+  , Y.toLincolnPayee = tlp   }  data Config = Config@@ -221,3 +234,10 @@       let f (n, c) = (Y.Name (X.pack n), convertFitAcct c)       in map f m   }++-- | A simple function to use for 'toLincolnPayee'. Uses the financial+-- institution payee if it is available; otherwise, uses the financial+-- institution description.+usePayeeOrDesc :: Y.Desc -> Y.Payee -> L.Payee+usePayeeOrDesc (Y.Desc d) (Y.Payee p) = L.Payee $+  if X.null p then d else p

@@ -1,7 +1,7 @@ -- | Parses statements for Bank of America deposit accounts. See the -- help text in the 'help' function for more details. Also, the file -- format is documented in the file @doc\/bofa-file-format.org@.-module Penny.Brenner.BofA (parser) where+module Penny.Brenner.BofA (parser, getPayee) where  import Control.Applicative ((<$>), (<*), (<$), (<*>)) import qualified Control.Monad.Exception.Synchronous as Ex@@ -14,6 +14,7 @@ import qualified Data.Tree as T import Data.Tree (Tree(Node)) import qualified Penny.Brenner.Types as Y+import qualified Penny.Lincoln as L import qualified Data.Text as X  newtype TagName = TagName { unTagName :: String }@@ -210,3 +211,16 @@                   $ "could not parse Bank of America transactions: "                     ++ show e         Right (_, t) -> postings t++-- | For check card transactions, Bank of America changes the+-- description so that it begins with @CHECKCARD MMDD@, where MM is+-- the two-digit month of the transaction date, and DD is the+-- two-digit day of the transaction date. (The posting date is used as+-- the main date, and it is typically two days later than the+-- transaction date.) This function strips off the @CHECKCARD MMDD@+-- portion.+getPayee :: Y.Desc -> L.Payee+getPayee (Y.Desc d) = L.Payee $+  if X.isPrefixOf (X.pack "CHECKCARD") d+  then X.drop (length "CHECKCARD XXXX ") d+  else d

@@ -1,6 +1,6 @@ module Penny.Brenner.Merge (mode) where -import Control.Applicative (pure, (<|>))+import Control.Applicative (pure) import Control.Monad (guard) import qualified Control.Monad.Trans.State as St import Data.List (find, sortBy, foldl')@@ -248,10 +248,9 @@     tl = (U.emptyTopLine ( L.dateTimeMidnightUTC . Y.unDate                            . Y.date $ a))          { U.tPayee = Just pa }-    (guessedPye, guessedAcct) = guessInfo mu mp a-    dfltPye = L.Payee $ if X.null . Y.unPayee . Y.payee $ a-              then Y.unDesc . Y.desc $ a-              else Y.unPayee . Y.payee $ a+    getPye = Y.toLincolnPayee acct+    (guessedPye, guessedAcct) = guessInfo getPye mu mp a+    dfltPye = getPye (Y.desc a) (Y.payee a)     dfltAcct = Y.unDefaultAcct . Y.defaultAcct $ acct     (pa, ac) =       if noAuto@@ -279,25 +278,28 @@   . M.assocs   $ db   where-    mu = makeUNumberLookup dbLs+    mu = makeUNumberLookup (Y.toLincolnPayee acct) dbLs     mp = makePyeLookupMap (Y.pennyAcct acct) led  -- | Maps financial institution postings to UNumbers. The key is the--- Payee of the financial institution posting, if it has one;--- otherwise, it is the description if it has one. The UNumbers are in--- a list, with UNumbers from most recent financial institution--- postings first.-type UNumberLookupMap = M.Map X.Text [Y.UNumber]+-- Lincoln Payee of the financial institution posting, which is+-- computed using the toLincolnPayee function in the FitAcct.  The+-- UNumbers are in a list, with UNumbers from most recent financial+-- institution postings first.+type UNumberLookupMap = M.Map L.Payee [Y.UNumber]  -- | Create a UNumberLookupMap from a DbWithEntry. Financial -- institution postings with higher U-numbers will come first.-makeUNumberLookup :: Y.DbList -> UNumberLookupMap-makeUNumberLookup = foldl' ins M.empty . mapMaybe f . sortBy g+makeUNumberLookup+  :: (Y.Desc -> Y.Payee -> L.Payee)+  -> Y.DbList+  -> UNumberLookupMap+makeUNumberLookup toPye = foldl' ins M.empty . map f . sortBy g   where     ins m (k, v) = M.alter alterer k m       where alterer Nothing = Just [v]             alterer (Just ls) = Just $ v:ls-    f (u, p) = fmap (\k -> (k, u)) $ getBestPayee p+    f (u, p) = (toPye (Y.desc p) (Y.payee p), u)     g (_, p1) (_, p2) = compare (Y.date p1) (Y.date p2)  -- | Given a list of keys, find the first key that is in the@@ -308,17 +310,6 @@   Nothing -> findFirstKey m ks   Just v -> Just v --- | Given a Posting, gets the Text that will work best as a payee--- name. Uses the Payee field if there is one, or the Desc field if--- there is one; otherwise Nothing.-getBestPayee :: Y.Posting -> Maybe X.Text-getBestPayee p = fromPayee <|> fromDesc-  where-    fromPayee = let pye = Y.unPayee . Y.payee $ p-                in if X.null pye then Nothing else Just pye-    fromDesc = let dsc = Y.unDesc . Y.desc $ p-               in if X.null dsc then Nothing else Just dsc- -- | Maps UNumbers to payees and accounts from the ledger. type PyeLookupMap = M.Map Y.UNumber (Maybe L.Payee, Maybe L.Account) @@ -345,11 +336,12 @@ -- information from previous transactions if this information is -- available. guessInfo-  :: UNumberLookupMap+  :: (Y.Desc -> Y.Payee -> L.Payee)+  -> UNumberLookupMap   -> PyeLookupMap   -> Y.Posting   -> (Maybe L.Payee, Maybe L.Account)-guessInfo mu mp p = fromMaybe (Nothing, Nothing) $ do-  pye <- getBestPayee p-  unums <- M.lookup pye mu+guessInfo getPye mu mp p = fromMaybe (Nothing, Nothing) $ do+  let pstgPayee = getPye (Y.desc p) (Y.payee p)+  unums <- M.lookup pstgPayee mu   findFirstKey mp unums

@@ -267,6 +267,17 @@   -- The first element of the pair is a help string which should   -- indicate how to download the data, as a helpful reminder. +  , toLincolnPayee :: Desc -> Payee -> L.Payee+  -- ^ Sometimes the financial institution provides Payee information,+  -- sometimes it does not. Sometimes the Desc might have additional+  -- information that you might want to remove. This function can be+  -- used to do that. The resulting Lincoln Payee is used for any+  -- transactions that are created by the merge command. The resulting+  -- payee is also used when comparing new financial institution+  -- postings to already existing ledger transactions in order to+  -- guess at which payee and accounts to create in the transactions+  -- created by the merge command.+   }  -- | Configuration for the Brenner program. You can optionally have

@@ -30,6 +30,7 @@ import qualified Data.Text as X import Data.Monoid (mempty, mappend, mconcat) import qualified System.Console.MultiArg as MA+import qualified System.Console.Rainbow as Rb  -- | Options for the Convert report. These are the only options you -- need to use if you are supplying options programatically (as@@ -40,6 +41,7 @@   , sorter :: Sorter   , target :: L.To   , dateTime :: L.DateTime+  , textFormats :: Scheme.Changers   }  -- | How to sort each line of the report. Each subaccount has only one@@ -144,16 +146,16 @@ -- | The function for the Convert report. Use this function if you are -- setting the options from a program (as opposed to parsing them in -- from the command line.) Will fail if the balance conversions fail.-report ::-  Opts+report+  :: Opts   -> [L.PricePoint]   -> [L.Box a]-  -> Ex.Exceptional X.Text [Scheme.PreChunk]-report os@(Opts getFmt _ _ _ _) ps bs = do+  -> Ex.Exceptional X.Text [Rb.Chunk]+report os@(Opts getFmt _ _ _ _ txtFormats) ps bs = do   fstBl <- sumConvertSort os ps bs   let (rs, L.To cy) = rows fstBl       fmt = getFmt cy-  return $ K.rowsToChunks fmt rs+  return $ K.rowsToChunks txtFormats fmt rs   -- | Creates a report respecting the standard interface for reports@@ -163,34 +165,35 @@   -> I.Report cmdLineReport o rt = (help o, mkMode)   where-    mkMode _ _ _ fsf = MA.Mode+    mkMode _ _ chgrs _ fsf = MA.Mode       { MA.mName = "convert"       , MA.mIntersperse = MA.Intersperse       , MA.mOpts = map (fmap Right) P.allOptSpecs       , MA.mPosArgs = Left-      , MA.mProcess = process rt o fsf+      , MA.mProcess = process rt chgrs o fsf       , MA.mHelp = const (help o)       }  process   :: S.Runtime+  -> Scheme.Changers   -> O.DefaultOpts   -> ([L.Transaction] -> [L.Box Ly.LibertyMeta])   -> [Either String (P.Opts -> Ex.Exceptional String P.Opts)]   -> Ex.Exceptional X.Text I.ArgsAndReport-process rt defaultOpts fsf ls = do+process rt chgrs defaultOpts fsf ls = do   let (posArgs, parsed) = Ei.partitionEithers ls       op' = foldl (>>=) (return (O.toParserOpts defaultOpts rt)) parsed   case op' of       Ex.Exception s -> Ex.throw . X.pack $ s       Ex.Success g -> return $         let noDefault = X.pack "no default price found"-            f = fromParsedOpts g+            f = fromParsedOpts chgrs g             pr ts pps = do               rptOpts <- Ex.fromMaybe noDefault $                 f pps (O.format defaultOpts)               let boxes = fsf ts-              fmap (map Right) $ report rptOpts pps boxes+              report rptOpts pps boxes         in (posArgs, pr)  @@ -205,7 +208,7 @@   -> Ex.Exceptional X.Text ForestAndBL sumConvertSort os ps bs = mkResult <$> convertedFrst <*> convertedTot   where-    (Opts _ szb str tgt dt) = os+    (Opts _ szb str tgt dt _) = os     bals = U.balances szb bs     (frst, tot) = U.sumForest mempty mappend bals     convertBal (a, bal) =@@ -228,17 +231,18 @@ -- from the command line. Fails if the user did not specify a -- commodity and mostFrequent fails. fromParsedOpts-  :: P.Opts+  :: Scheme.Changers+  -> P.Opts   -> DoReport-fromParsedOpts (P.Opts szb tgt dt so sb) =+fromParsedOpts chgrs (P.Opts szb tgt dt so sb) =   \pps fmt -> case tgt of     P.ManualTarget to ->-      Just $ Opts fmt szb (getSorter so sb) to dt+      Just $ Opts fmt szb (getSorter so sb) to dt chgrs     P.AutoTarget ->       case mostFrequent pps of         Nothing -> Nothing         Just to ->-          Just $ Opts fmt szb (getSorter so sb) to dt+          Just $ Opts fmt szb (getSorter so sb) to dt chgrs  -- | Returns a function usable to sort pairs of SubAccount and -- BottomLine depending on how you want them sorted.

@@ -12,12 +12,12 @@ import Control.Applicative   (Applicative (pure), (<$>), (<*>)) import qualified Penny.Cabin.Scheme as E-import qualified Penny.Steel.Chunk as Chunk import qualified Penny.Cabin.Meta as Meta import qualified Penny.Cabin.Row as R import qualified Penny.Lincoln as L import qualified Data.Foldable as Fdbl import qualified Data.Text as X+import qualified System.Console.Rainbow as Rb  type IsEven = Bool @@ -45,7 +45,7 @@ data PreSpec = PreSpec {   _justification :: R.Justification   , _padSpec :: (E.Label, E.EvenOdd)-  , bits :: E.PreChunk }+  , bits :: Rb.Chunk }  -- | When given a list of columns, determine the widest row in each -- column.@@ -59,7 +59,7 @@   -> Columns PreSpec   -> Columns R.Width maxWidthPerColumn w p = f <$> w <*> p where-  f old new = max old (E.width . bits $ new)+  f old new = max old (R.Width . X.length . Rb.chunkText . bits $ new)  -- | Changes a single set of Columns to a set of ColumnSpec of the -- given width.@@ -81,15 +81,16 @@ widthSpacerDrCr :: Int widthSpacerDrCr = 1 -colsToBits ::-  IsEven+colsToBits+  :: E.Changers+  -> IsEven   -> Columns R.ColumnSpec-  -> [E.PreChunk]-colsToBits isEven (Columns a dc q) = let+  -> [Rb.Chunk]+colsToBits chgrs isEven (Columns a dc q) = let   fillSpec = if isEven              then (E.Other, E.Even)              else (E.Other, E.Odd)-  spacer w = R.ColumnSpec j (Chunk.Width w) fillSpec []+  spacer w = R.ColumnSpec j (R.Width w) fillSpec []   j = R.LeftJustify   cs = a        : spacer widthSpacerAcct@@ -97,21 +98,23 @@        : spacer widthSpacerDrCr        : q        : []-  in R.row cs+  in R.row chgrs cs  colsListToBits-  :: [Columns R.ColumnSpec]-  -> [[E.PreChunk]]-colsListToBits = zipWith f bools where-  f b c = colsToBits b c+  :: E.Changers+  -> [Columns R.ColumnSpec]+  -> [[Rb.Chunk]]+colsListToBits chgrs = zipWith f bools where+  f b c = colsToBits chgrs b c   bools = iterate not True  preSpecsToBits-  :: [Columns PreSpec]-  -> [E.PreChunk]-preSpecsToBits =+  :: E.Changers+  -> [Columns PreSpec]+  -> [Rb.Chunk]+preSpecsToBits chgrs =   concat-  . colsListToBits+  . colsListToBits chgrs   . resizeColumnsInList  data Row = RMain MainRow | ROneCol OneColRow@@ -146,80 +149,89 @@   }  -rowsToChunks ::-  (L.Qty -> X.Text)+rowsToChunks+  :: E.Changers+  -> (L.Qty -> X.Text)   -- ^ How to format a balance to allow for digit grouping   -> [Row]-  -> [E.PreChunk]-rowsToChunks fmt =-  preSpecsToBits-  . rowsToColumns fmt+  -> [Rb.Chunk]+rowsToChunks chgrs fmt =+  preSpecsToBits chgrs+  . rowsToColumns chgrs fmt -rowsToColumns ::-  (L.Qty -> X.Text)+rowsToColumns+  :: E.Changers+  -> (L.Qty -> X.Text)   -- ^ How to format a balance to allow for digit grouping    -> [Row]   -> [Columns PreSpec]-rowsToColumns fmt rs = map (mkRow fmt) pairs+rowsToColumns chgrs fmt rs = map (mkRow chgrs fmt) pairs   where     pairs = Meta.visibleNums (,) rs  -mkRow ::-  (L.Qty -> X.Text)+mkRow+  :: E.Changers+  -> (L.Qty -> X.Text)   -> (Meta.VisibleNum, Row)   -> Columns PreSpec-mkRow fmt (vn, r) = case r of-  RMain m -> mkMainRow fmt (vn, m)-  ROneCol c -> mkOneColRow (vn, c)+mkRow chgrs fmt (vn, r) = case r of+  RMain m -> mkMainRow chgrs fmt (vn, m)+  ROneCol c -> mkOneColRow chgrs (vn, c) -mkOneColRow ::-  (Meta.VisibleNum, OneColRow)+mkOneColRow+  :: E.Changers+  -> (Meta.VisibleNum, OneColRow)   -> Columns PreSpec-mkOneColRow (vn, (OneColRow i t)) = Columns ca cd cq+mkOneColRow chgrs (vn, (OneColRow i t)) = Columns ca cd cq   where     txt = X.append indents t     indents = X.replicate (indentAmount * max 0 i)               (X.singleton ' ')     eo = E.fromVisibleNum vn     lbl = E.Other-    ca = PreSpec R.LeftJustify (lbl, eo) (E.PreChunk lbl eo txt)-    cd = PreSpec R.LeftJustify (lbl, eo) (E.PreChunk lbl eo X.empty)+    ca = PreSpec R.LeftJustify (lbl, eo)+         (E.getEvenOddLabelValue lbl eo chgrs $ Rb.plain txt)+    cd = PreSpec R.LeftJustify (lbl, eo)+         (E.getEvenOddLabelValue lbl eo chgrs $ Rb.plain X.empty)     cq = cd -mkMainRow ::-  (L.Qty -> X.Text)+mkMainRow+  :: E.Changers+  -> (L.Qty -> X.Text)   -> (Meta.VisibleNum, MainRow)   -> Columns PreSpec-mkMainRow fmt (vn, (MainRow i acctTxt b)) = Columns ca cd cq+mkMainRow chgrs fmt (vn, (MainRow i acctTxt b)) = Columns ca cd cq   where+    applyFmt = E.getEvenOddLabelValue lbl eo chgrs     eo = E.fromVisibleNum vn     lbl = E.Other-    ca = PreSpec R.LeftJustify (lbl, eo) (E.PreChunk lbl eo txt)+    ca = PreSpec R.LeftJustify (lbl, eo) (applyFmt (Rb.plain txt))       where         txt = X.append indents acctTxt         indents = X.replicate (indentAmount * max 0 i)                   (X.singleton ' ')-    cd = PreSpec R.LeftJustify (lbl, eo) cksDrCr-    cq = PreSpec R.LeftJustify (lbl, eo) cksQty-    (cksDrCr, cksQty) = balanceChunks fmt vn b+    cd = PreSpec R.LeftJustify (lbl, eo) (applyFmt cksDrCr)+    cq = PreSpec R.LeftJustify (lbl, eo) (applyFmt cksQty)+    (cksDrCr, cksQty) = balanceChunks chgrs fmt vn b  -balanceChunks ::-  (L.Qty -> X.Text)+balanceChunks+  :: E.Changers+  -> (L.Qty -> X.Text)   -> Meta.VisibleNum   -> L.BottomLine-  -> (E.PreChunk, E.PreChunk)-balanceChunks fmt vn bl = (chkDc, chkQt)+  -> (Rb.Chunk, Rb.Chunk)+balanceChunks chgrs fmt vn bl = (chkDc, chkQt)   where     eo = E.fromVisibleNum vn-    chkDc = E.bottomLineToDrCr bl eo-    chkQt = E.PreChunk lbl eo t-      where-        (lbl, t) = case bl of-          L.Zero -> (E.Zero, X.pack "--")-          L.NonZero (L.Column dc qt) -> (E.dcToLbl dc, fmt qt)+    chkDc = E.bottomLineToDrCr bl eo chgrs+    qtFmt = E.getEvenOddLabelValue lbl eo chgrs+    chkQt = qtFmt $ Rb.plain t+    (lbl, t) = case bl of+      L.Zero -> (E.Zero, X.pack "--")+      L.NonZero (L.Column dc qt) -> (E.dcToLbl dc, fmt qt)   indentAmount :: Int

@@ -14,6 +14,7 @@ import Control.Applicative (Applicative, pure) import qualified Penny.Cabin.Balance.Util as U import qualified Penny.Cabin.Scheme as E+import qualified Penny.Cabin.Scheme.Schemes as Schemes import qualified Penny.Lincoln as L import qualified Penny.Liberty as Ly import qualified Data.Either as Ei@@ -27,6 +28,7 @@ import qualified Penny.Cabin.Interface as I import qualified Penny.Cabin.Parsers as CP import qualified System.Console.MultiArg as MA+import qualified System.Console.Rainbow as R  -- | Options for making the balance report. These are the only options -- needed to make the report if the options are not being parsed in@@ -35,6 +37,7 @@   { balanceFormat :: L.Commodity -> L.Qty -> X.Text   , showZeroBalances :: CO.ShowZeroBalances   , order :: L.SubAccount -> L.SubAccount -> Ordering+  , textFormats :: E.Changers   }  defaultOpts :: Opts@@ -42,6 +45,7 @@   { balanceFormat = defaultFormat   , showZeroBalances = CO.ShowZeroBalances True   , order = compare+  , textFormats = Schemes.darkLabels   }  defaultParseOpts :: P.ParseOpts@@ -50,11 +54,12 @@   , P.order = CP.Ascending   } -fromParseOpts ::-  (L.Commodity -> L.Qty -> X.Text)+fromParseOpts+  :: E.Changers+  -> (L.Commodity -> L.Qty -> X.Text)   -> P.ParseOpts   -> Opts-fromParseOpts fmt (P.ParseOpts szb o) = Opts fmt szb o'+fromParseOpts chgrs fmt (P.ParseOpts szb o) = Opts fmt szb o' chgrs   where     o' = case o of        CP.Ascending -> compare@@ -87,9 +92,9 @@  -- | This report is what to use if you already have your options (that -- is, you are not parsing them in from the command line.)-report :: Opts -> [L.Box a] -> [E.PreChunk]-report (Opts bf szb o) =-  K.rowsToChunks bf+report :: Opts -> [L.Box a] -> [R.Chunk]+report (Opts bf szb o chgrs) =+  K.rowsToChunks chgrs bf   . rows   . summedSortedBalTree szb o @@ -107,29 +112,30 @@   -> I.Report parseReport fmt o rt = (help o, makeMode)   where-    makeMode _ _ _ fsf = MA.Mode+    makeMode _ _ chgrs _ fsf = MA.Mode       { MA.mName = "balance"       , MA.mIntersperse = MA.Intersperse       , MA.mOpts = map (fmap Right) P.allSpecs       , MA.mPosArgs = Left-      , MA.mProcess = process fmt o rt fsf+      , MA.mProcess = process chgrs fmt o rt fsf       , MA.mHelp = const (help o)       }  process   :: Applicative f-  => (L.Commodity -> L.Qty -> X.Text)+  => E.Changers+  -> (L.Commodity -> L.Qty -> X.Text)   -> P.ParseOpts   -> a   -> ([L.Transaction] -> [L.Box Ly.LibertyMeta])   -> [Either String (P.ParseOpts -> P.ParseOpts)]   -> f I.ArgsAndReport-process fmt o _ fsf ls =+process chgrs fmt o _ fsf ls =   let (posArgs, fns) = Ei.partitionEithers ls       mkParsedOpts = foldl (flip (.)) id fns       os' = mkParsedOpts o-      mcOpts = fromParseOpts fmt os'-      pr txns _ = return . map Right $ report mcOpts (fsf txns)+      mcOpts = fromParseOpts chgrs fmt os'+      pr txns _ = return $ report mcOpts (fsf txns)   in pure (posArgs, pr)  

@@ -9,13 +9,13 @@  import Control.Applicative   (Applicative (pure), (<$>), (<*>))-import qualified Penny.Steel.Chunk as Chunk import qualified Penny.Cabin.Meta as Meta import qualified Penny.Cabin.Row as R import qualified Penny.Cabin.Scheme as E import qualified Penny.Lincoln as L import qualified Data.Foldable as Fdbl import qualified Data.Text as X+import qualified System.Console.Rainbow as Rb  type IsEven = Bool @@ -46,7 +46,7 @@ data PreSpec = PreSpec {   _justification :: R.Justification   , _padSpec :: (E.Label, E.EvenOdd)-  , bits :: [E.PreChunk] }+  , bits :: [Rb.Chunk] }  -- | When given a list of columns, determine the widest row in each -- column.@@ -61,7 +61,8 @@   -> Columns R.Width maxWidthPerColumn w p = f <$> w <*> p where   f old new = max old ( safeMaximum (R.Width 0)-                        . map E.width . bits $ new)+                        . map (R.Width . X.length . Rb.chunkText)+                        . bits $ new)   safeMaximum d ls = if null ls then d else maximum ls  -- | Changes a single set of Columns to a set of ColumnSpec of the@@ -88,15 +89,16 @@ widthSpacerCommodity :: Int widthSpacerCommodity = 1 -colsToBits ::-  IsEven+colsToBits+  :: E.Changers+  -> IsEven   -> Columns R.ColumnSpec-  -> [E.PreChunk]-colsToBits isEven (Columns a dc c q) = let+  -> [Rb.Chunk]+colsToBits chgrs isEven (Columns a dc c q) = let   fillSpec = if isEven              then (E.Other, E.Even)              else (E.Other, E.Odd)-  spacer w = R.ColumnSpec j (Chunk.Width w) fillSpec []+  spacer w = R.ColumnSpec j (R.Width w) fillSpec []   j = R.LeftJustify   cs = a        : spacer widthSpacerAcct@@ -106,21 +108,23 @@        : spacer widthSpacerCommodity        : q        : []-  in R.row cs+  in R.row chgrs cs  colsListToBits-  :: [Columns R.ColumnSpec]-  -> [[E.PreChunk]]-colsListToBits = zipWith f bools where-  f b c = colsToBits b c+  :: E.Changers+  -> [Columns R.ColumnSpec]+  -> [[Rb.Chunk]]+colsListToBits chgrs = zipWith f bools where+  f b c = colsToBits chgrs b c   bools = iterate not True  preSpecsToBits-  :: [Columns PreSpec]-  -> [E.PreChunk]-preSpecsToBits =+  :: E.Changers+  -> [Columns PreSpec]+  -> [Rb.Chunk]+preSpecsToBits chgrs =   concat-  . colsListToBits+  . colsListToBits chgrs   . resizeColumnsInList  -- | Displays a single account in a Balance report. In a@@ -141,35 +145,39 @@     -- displayed for the DrCr, Commodity, and Qty.   } -rowsToChunks ::-  (L.Commodity -> L.Qty -> X.Text)+rowsToChunks+  :: E.Changers+  -> (L.Commodity -> L.Qty -> X.Text)   -- ^ How to format a balance to allow for digit grouping   -> [Row]-  -> [E.PreChunk]-rowsToChunks fmt =-  preSpecsToBits-  . rowsToColumns fmt+  -> [Rb.Chunk]+rowsToChunks chgrs fmt =+  preSpecsToBits chgrs+  . rowsToColumns chgrs fmt -rowsToColumns ::-  (L.Commodity -> L.Qty -> X.Text)+rowsToColumns+  :: E.Changers+  -> (L.Commodity -> L.Qty -> X.Text)   -- ^ How to format a balance to allow for digit grouping    -> [Row]   -> [Columns PreSpec]-rowsToColumns fmt rs = map (mkColumn fmt) pairs+rowsToColumns chgrs fmt rs = map (mkColumn chgrs fmt) pairs   where     pairs = Meta.visibleNums (,) rs  -mkColumn ::-  (L.Commodity -> L.Qty -> X.Text)+mkColumn+  :: E.Changers+  -> (L.Commodity -> L.Qty -> X.Text)   -> (Meta.VisibleNum, Row)   -> Columns PreSpec-mkColumn fmt (vn, (Row i acctTxt bs)) = Columns ca cd cc cq+mkColumn chgrs fmt (vn, (Row i acctTxt bs)) = Columns ca cd cc cq   where     lbl = E.Other     eo = E.fromVisibleNum vn-    ca = PreSpec R.LeftJustify (lbl, eo) [E.PreChunk lbl eo txt]+    applyFmt = E.getEvenOddLabelValue lbl eo chgrs+    ca = PreSpec R.LeftJustify (lbl, eo) [applyFmt $ Rb.plain txt]       where         txt = X.append indents acctTxt         indents = X.replicate (indentAmount * max 0 i)@@ -179,9 +187,9 @@     cq = PreSpec R.LeftJustify (lbl, eo) cksQty     (cksDrCr, cksCmdty, cksQty) =       if null bs-      then balanceChunksEmpty eo+      then balanceChunksEmpty chgrs eo       else-        let balChks = map (balanceChunks fmt eo) bs+        let balChks = map (balanceChunks chgrs fmt eo) bs             cDrCr = map (\(a, _, _) -> a) balChks             cCmdty = map (\(_, a, _) -> a) balChks             cQty = map (\(_, _, a) -> a) balChks@@ -189,22 +197,24 @@   balanceChunksEmpty-  :: E.EvenOdd-  -> ([E.PreChunk], [E.PreChunk], [E.PreChunk])-balanceChunksEmpty eo = (dash, dash, dash)+  :: E.Changers+  -> E.EvenOdd+  -> ([Rb.Chunk], [Rb.Chunk], [Rb.Chunk])+balanceChunksEmpty chgrs eo = (dash, dash, dash)   where-    dash = [E.PreChunk E.Zero eo (X.pack "--")]+    dash = [E.getEvenOddLabelValue E.Other eo chgrs $ Rb.plain (X.pack "--")]  balanceChunks-  :: (L.Commodity -> L.Qty -> X.Text)+  :: E.Changers+  -> (L.Commodity -> L.Qty -> X.Text)   -> E.EvenOdd   -> (L.Commodity, L.BottomLine)-  -> (E.PreChunk, E.PreChunk, E.PreChunk)-balanceChunks fmt eo (cty, bl) = (chkDc, chkCt, chkQt)+  -> (Rb.Chunk, Rb.Chunk, Rb.Chunk)+balanceChunks chgrs fmt eo (cty, bl) = (chkDc, chkCt, chkQt)   where-    chkDc = E.bottomLineToDrCr bl eo-    chkCt = E.bottomLineToCmdty eo (cty, bl)-    chkQt = E.bottomLineToQty fmt eo (cty, bl)+    chkDc = E.bottomLineToDrCr bl eo chgrs+    chkCt = E.bottomLineToCmdty chgrs eo (cty, bl)+    chkQt = E.bottomLineToQty chgrs fmt eo (cty, bl)   indentAmount :: Int

@@ -2,14 +2,14 @@ -- anything that is a 'Report'. module Penny.Cabin.Interface where -import qualified Penny.Steel.Chunk as C-import qualified Penny.Steel.Expressions as Exp+import qualified Data.Prednote.Expressions as Exp import qualified Penny.Cabin.Scheme as S import Control.Monad.Exception.Synchronous (Exceptional) import qualified Data.Text as X import Text.Matchers (CaseSensitive) import qualified Text.Matchers as TM import qualified System.Console.MultiArg as MA+import qualified System.Console.Rainbow as R  import qualified Penny.Lincoln as L import qualified Penny.Liberty as Ly@@ -41,7 +41,7 @@   -- ^ PricePoints to be included in the report  -  -> Exceptional X.Text [Either C.Chunk S.PreChunk]+  -> 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@@ -61,6 +61,10 @@   -> (CaseSensitive -> X.Text -> Exceptional X.Text TM.Matcher)   -- ^ Result from previous parsers indicating the matcher factory the   -- user wishes to use++  -> S.Changers+  -- ^ Result from previous parsers indicating which color scheme to+  -- use.    -> Exp.ExprDesc   -- ^ Result from previous parsers indicating whether the user wants

@@ -76,9 +76,9 @@ import qualified Penny.Lincoln.Queries as Q import qualified Penny.Liberty as Ly import qualified Penny.Shield as Sh-import qualified Penny.Steel.Expressions as Exp-import qualified Penny.Steel.Pdct as Pe-import qualified Penny.Steel.Chunk as Chk+import qualified Data.Prednote.Expressions as Exp+import qualified Data.Prednote.Pdct as Pe+import qualified System.Console.Rainbow as Rb  import Data.List (intersperse) import Data.Maybe (catMaybes)@@ -90,8 +90,9 @@  -- | All information needed to make a Posts report. This function -- never fails.-postsReport ::-  CO.ShowZeroBalances+postsReport+  :: E.Changers+  -> CO.ShowZeroBalances   -> (Pe.Pdct (L.Box Ly.LibertyMeta))   -- ^ Removes posts from the report if applying this function to the   -- post returns False. Posts removed still affect the running@@ -104,22 +105,22 @@    -> C.ChunkOpts   -> [L.Box Ly.LibertyMeta]-  -> [E.PreChunk]+  -> [Rb.Chunk] -postsReport szb pdct pff co =-  C.makeChunk co+postsReport ch szb pdct pff co =+  C.makeChunk ch co   . M.toBoxList szb pdct pff   zincReport :: ZincOpts -> I.Report zincReport opts rt = (helpStr opts, md)   where-    md cs fty expr fsf = MA.Mode+    md cs fty ch expr fsf = MA.Mode       { MA.mName = "postings"       , MA.mIntersperse = MA.Intersperse       , MA.mOpts = specs rt       , MA.mPosArgs = Left-      , MA.mProcess = process opts cs fty expr fsf+      , MA.mProcess = process opts cs fty ch expr fsf       , MA.mHelp = const (helpStr opts)       } @@ -133,64 +134,66 @@   :: ZincOpts   -> CaseSensitive   -> L.Factory+  -> E.Changers   -> Exp.ExprDesc   -> ([L.Transaction] -> [L.Box Ly.LibertyMeta])   -> [Either String (P.State -> Ex.Exceptional X.Text P.State)]   -> Ex.Exceptional X.Text I.ArgsAndReport-process os cs fty expr fsf ls =+process os cs fty ch expr fsf ls =   let (posArgs, clOpts) = Ei.partitionEithers ls       pState = newParseState cs fty expr os       exState' = foldl (>>=) (return pState) clOpts-  in fmap (mkPrintReport posArgs os fsf) exState'+  in fmap (mkPrintReport posArgs os ch fsf) exState'  mkPrintReport   :: [String]   -> ZincOpts+  -> E.Changers   -> ([L.Transaction] -> [L.Box Ly.LibertyMeta])   -> P.State   -> I.ArgsAndReport-mkPrintReport posArgs zo fsf st = (posArgs, f)+mkPrintReport posArgs zo ch fsf st = (posArgs, f)   where     f txns _ = do       pdct <- getPredicate (P.exprDesc st) (P.tokens st)       let boxes = fsf txns-          rptChks = postsReport (P.showZeroBalances st) pdct+          rptChks = postsReport ch (P.showZeroBalances st) pdct                     (P.postFilter st) (chunkOpts st zo) boxes           expChks = showExpression (P.showExpression st) pdct           verbChks = showVerboseFilter (P.verboseFilter st) pdct boxes-          chks = map Left expChks-                 ++ map Left verbChks-                 ++ map Right rptChks+          chks = expChks+                 ++ verbChks+                 ++ rptChks       return chks  indentAmt :: Pe.IndentAmt indentAmt = 4 -blankLine :: Chk.Chunk-blankLine = Chk.chunk Chk.defaultTextSpec "\n"+blankLine :: Rb.Chunk+blankLine = Rb.plain (X.singleton '\n')  showExpression   :: P.ShowExpression   -> Pe.Pdct (L.Box Ly.LibertyMeta)-  -> [Chk.Chunk]+  -> [Rb.Chunk] showExpression (P.ShowExpression b) pdct =   if not b then [] else info : blankLine : (chks ++ [blankLine])   where-    info = Chk.chunk Chk.defaultTextSpec "Postings filter expression:\n"+    info = Rb.plain (X.pack "Postings filter expression:\n")     chks = Pe.showPdct indentAmt 0 pdct  showVerboseFilter   :: P.VerboseFilter   -> Pe.Pdct (L.Box Ly.LibertyMeta)   -> [L.Box Ly.LibertyMeta]-  -> [Chk.Chunk]+  -> [Rb.Chunk] showVerboseFilter (P.VerboseFilter b) pdct bs =   if not b then [] else info : blankLine : (chks ++ [blankLine])   where     pdcts = map (makeLabeledPdct pdct) bs     chks = concat . map snd $ zipWith doEval bs pdcts     doEval subj pd = Pe.evaluate indentAmt False subj 0 pd-    info = Chk.chunk Chk.defaultTextSpec "Postings report filter:\n"+    info = Rb.plain (X.pack "Postings report filter:\n")  -- | Creates a Pdct and prepends a one-line description of the PostFam -- to the Pdct's label so it can be easily identified in the output.

@@ -63,7 +63,7 @@ import qualified Data.Sequence as Seq import qualified Data.Traversable as T import qualified Data.Text as X-import qualified Penny.Steel.Chunk as C+import qualified System.Console.Rainbow as Rb import qualified Penny.Cabin.Row as R import qualified Penny.Cabin.Posts.Growers as G import qualified Penny.Cabin.Posts.Meta as M@@ -115,12 +115,13 @@ -- where cs is a list of all the cells, and i is the width of all the -- cells. payeeAndAcct-  :: AllocatedOpts+  :: E.Changers+  -> AllocatedOpts   -> [Box]   -> Fields (Maybe ([R.ColumnSpec], Int))-payeeAndAcct ao bs =+payeeAndAcct ch ao bs =   let allBuilders =-        T.traverse (builders (subAccountLength ao)) bs+        T.traverse (builders ch (subAccountLength ao)) bs       availWidth = availableWidthForAllocs (growerWidths ao)                    (spacers ao) (fields ao) (reportWidth ao)       finals = divideAvailableWidth availWidth (fields ao)@@ -302,28 +303,31 @@   builders-  :: SubAccountLength+  :: E.Changers+  -> SubAccountLength   -> Box   -> Fields (Request, Final -> R.ColumnSpec)-builders sl b = Fields (buildPayee b) (buildAcct sl b)+builders ch sl b = Fields (buildPayee ch b) (buildAcct ch sl b)  buildPayee-  :: Box+  :: E.Changers+  -> Box   -> (Request, Final -> R.ColumnSpec)   -- ^ Returns a tuple. The first element is the maximum width that   -- this cell needs to display its value perfectly. The second   -- element is a function that, when applied to an actual width,   -- returns a ColumnSpec. -buildPayee i = (maxW, mkSpec)+buildPayee ch i = (maxW, mkSpec)   where     pb = L.boxPostFam i     eo = E.fromVisibleNum . M.visibleNum . L.boxMeta $ i     j = R.LeftJustify     ps = (E.Other, eo)+    md = E.getEvenOddLabelValue E.Other eo ch     mayPye = Q.payee pb     maxW = Request $ maybe 0 (X.length . HT.text) mayPye-    mkSpec (Final w) = R.ColumnSpec j (C.Width w) ps sq+    mkSpec (Final w) = R.ColumnSpec j (R.Width w) ps sq       where         sq = case mayPye of           Nothing -> []@@ -336,15 +340,17 @@                   . HT.text                   $ pye                 toBit (TF.Words seqTxts) =-                  E.PreChunk E.Other eo+                  md+                  . Rb.plain                   . X.unwords                   . Fdbl.toList                   $ seqTxts             in fmap toBit wrapped  -buildAcct ::-  SubAccountLength+buildAcct+  :: E.Changers+  -> SubAccountLength   -> Box   -> (Request, Final -> R.ColumnSpec)   -- ^ Returns a tuple. The first element is the maximum width that@@ -352,7 +358,7 @@   -- element is a function that, when applied to an actual width,   -- returns a ColumnSpec. -buildAcct sl i = (maxW, mkSpec)+buildAcct ch sl i = (maxW, mkSpec)   where     pb = L.boxPostFam i     eo = E.fromVisibleNum . M.visibleNum . L.boxMeta $ i@@ -361,13 +367,15 @@     maxW = Request            $ (sum . map (X.length . L.unSubAccount) $ aList)            + max 0 (length aList - 1)-    mkSpec (Final aw) = R.ColumnSpec R.LeftJustify (C.Width aw) ps sq+    md = E.getEvenOddLabelValue E.Other eo ch+    mkSpec (Final aw) = R.ColumnSpec R.LeftJustify (R.Width aw) ps sq       where         target = TF.Target aw         shortest = TF.Shortest . unSubAccountLength $ sl         ws = TF.Words . Seq.fromList . map L.unSubAccount $ aList         (TF.Words shortened) = TF.shorten shortest target ws-        sq = [ E.PreChunk E.Other eo+        sq = [ md+               . Rb.plain                . X.concat                . intersperse (X.singleton ':')                . Fdbl.toList

@@ -31,7 +31,7 @@ import qualified Data.Sequence as Seq import qualified Data.Text as X import qualified Data.Traversable as T-import qualified Penny.Steel.Chunk as C+import qualified System.Console.Rainbow as Rb import qualified Penny.Cabin.Scheme as E import qualified Penny.Cabin.Row as R import qualified Penny.Cabin.TextFormat as TF@@ -54,13 +54,14 @@   , spacers :: S.Spacers Int   } -bottomRows ::-  BottomOpts+bottomRows+  :: E.Changers+  -> BottomOpts   -> [Box]-  -> Fields (Maybe [[E.PreChunk]])-bottomRows os bs = makeRows bs pcs where-  pcs = infoProcessors topSpecs (reportWidth os) wanted-  wanted = requestedMakers (fields os)+  -> Fields (Maybe [[Rb.Chunk]])+bottomRows ch os bs = makeRows bs pcs where+  pcs = infoProcessors ch topSpecs (reportWidth os) wanted+  wanted = requestedMakers ch (fields os)   topSpecs = topCellSpecs (growingWidths os) (allocatedWidths os)              (spacers os) @@ -107,66 +108,72 @@ newtype ContentWidth = ContentWidth Int deriving (Show, Eq)  -hanging ::-  [TopCellSpec]+hanging+  :: E.Changers+  -> [TopCellSpec]   -> Maybe ((Box -> Int -> ((E.Label, E.EvenOdd), R.ColumnSpec))-            -> Box -> [E.PreChunk])-hanging specs = hangingWidths specs-                >>= return . hangingInfoProcessor+            -> Box -> [Rb.Chunk])+hanging ch specs = hangingWidths specs+                >>= return . hangingInfoProcessor ch -hangingInfoProcessor ::-  Hanging Int+hangingInfoProcessor+  :: E.Changers+  -> Hanging Int   -> (Box -> Int -> ((E.Label, E.EvenOdd), R.ColumnSpec))   -> Box-  -> [E.PreChunk]-hangingInfoProcessor widths mkr info = row where-  row = R.row [left, mid, right]+  -> [Rb.Chunk]+hangingInfoProcessor ch widths mkr info = row where+  row = R.row ch [left, mid, right]   (ts, mid) = mkr info (mainCell widths)-  mkPad w = R.ColumnSpec R.LeftJustify (C.Width w) ts []+  mkPad w = R.ColumnSpec R.LeftJustify (R.Width w) ts []   left = mkPad (leftPad widths)   right = mkPad (rightPad widths) -widthOfTopColumns ::-  [TopCellSpec]+widthOfTopColumns+  :: E.Changers+  -> [TopCellSpec]   -> Maybe ((Box -> Int -> ((E.Label, E.EvenOdd), R.ColumnSpec))-            -> Box -> [E.PreChunk])-widthOfTopColumns ts =+            -> Box -> [Rb.Chunk])+widthOfTopColumns ch ts =   if null ts   then Nothing-  else Just $ makeSpecificWidth w where+  else Just $ makeSpecificWidth ch w where     w = Fdbl.foldl' f 0 ts     f acc (_, maySpcWidth, (ContentWidth cw)) =       acc + cw + maybe 0 (\(SpacerWidth sw) -> sw) maySpcWidth  -widthOfReport ::-  Ty.ReportWidth+widthOfReport+  :: E.Changers+  -> Ty.ReportWidth   -> (Box -> Int -> ((E.Label, E.EvenOdd), R.ColumnSpec))   -> Box-  -> [E.PreChunk]-widthOfReport (Ty.ReportWidth rw) fn info =-  makeSpecificWidth rw fn info+  -> [Rb.Chunk]+widthOfReport ch (Ty.ReportWidth rw) fn info =+  makeSpecificWidth ch rw fn info -chooseProcessor ::-  [TopCellSpec]+chooseProcessor+  :: E.Changers+  -> [TopCellSpec]   -> Ty.ReportWidth   -> (Box -> Int -> ((E.Label, E.EvenOdd), R.ColumnSpec))   -> Box-  -> [E.PreChunk]-chooseProcessor specs rw fn = let-  firstTwo = First (hanging specs)-             `mappend` First (widthOfTopColumns specs)+  -> [Rb.Chunk]+chooseProcessor ch specs rw fn = let+  firstTwo = First (hanging ch specs)+             `mappend` First (widthOfTopColumns ch specs)   in case getFirst firstTwo of-    Nothing -> widthOfReport rw fn+    Nothing -> widthOfReport ch rw fn     Just r -> r fn -infoProcessors ::-  [TopCellSpec]+infoProcessors+  :: E.Changers+  -> [TopCellSpec]   -> Ty.ReportWidth   -> Fields (Maybe (Box -> Int -> ((E.Label, E.EvenOdd), R.ColumnSpec)))-  -> Fields (Maybe (Box -> [E.PreChunk]))-infoProcessors specs rw flds = let-  chooser = chooseProcessor specs rw+  -> Fields (Maybe (Box -> [Rb.Chunk]))+infoProcessors ch specs rw flds = let+  chooser = chooseProcessor ch specs rw   mkProcessor mayFn = case mayFn of     Nothing -> Nothing     Just fn -> Just $ chooser fn@@ -175,8 +182,8 @@  makeRows ::   [Box]-  -> Fields (Maybe (Box -> [E.PreChunk]))-  -> Fields (Maybe [[E.PreChunk]])+  -> Fields (Maybe (Box -> [Rb.Chunk]))+  -> Fields (Maybe [[Rb.Chunk]]) makeRows is flds = let   mkRow fn = map fn is   in fmap (fmap mkRow) flds@@ -272,14 +279,16 @@  -- | Applied to a function that, when applied to the width of a cell, -- returns a cell filled with data, returns a Row with that cell.-makeSpecificWidth :: Int -> (Box -> Int -> (a, R.ColumnSpec))-                     -> Box -> [E.PreChunk]-makeSpecificWidth w f i = R.row [c] where+makeSpecificWidth+  :: E.Changers -> Int -> (Box -> Int -> (a, R.ColumnSpec))+  -> Box -> [Rb.Chunk]+makeSpecificWidth ch w f i = R.row ch [c] where   (_, c) = f i w   type Maker-  = Box+  = E.Changers+  -> Box   -> Int   -> ((E.Label, E.EvenOdd), R.ColumnSpec) @@ -289,21 +298,23 @@ -- | Applied to an Options, indicating which reports the user wants, -- returns a Fields (Maybe Maker) with a Maker in each respective -- field that the user wants to see.-requestedMakers ::-  F.Fields Bool+requestedMakers+  :: E.Changers+  -> F.Fields Bool   -> Fields (Maybe (Box -> Int -> ((E.Label, E.EvenOdd), R.ColumnSpec)))-requestedMakers allFlds =+requestedMakers ch allFlds =   let flds = bottomRowsFields allFlds-      filler b mkr = if b then Just $ mkr else Nothing+      filler b mkr = if b then Just $ mkr ch else Nothing   in filler <$> flds <*> makers  tagsCell-  :: Box+  :: E.Changers+  -> Box   -> Int   -> ((E.Label, E.EvenOdd), R.ColumnSpec)-tagsCell info w = (ts, cell) where+tagsCell ch info w = (ts, cell) where   vn = M.visibleNum . L.boxMeta $ info-  cell = R.ColumnSpec R.LeftJustify (C.Width w) ts cs+  cell = R.ColumnSpec R.LeftJustify (R.Width w) ts cs   eo = E.fromVisibleNum vn   ts = (E.Other, eo)   cs =@@ -318,12 +329,14 @@     . Q.tags     . L.boxPostFam     $ info-  toBit (TF.Words ws) = E.PreChunk E.Other eo t where+  md = E.getEvenOddLabelValue E.Other eo ch+  toBit (TF.Words ws) = md . Rb.plain $ t where     t = X.concat . intersperse (X.singleton ' ') . Fdbl.toList $ ws  -memoBits :: (E.Label, E.EvenOdd) -> L.Memo -> C.Width -> [E.PreChunk]-memoBits (lbl, eo) m (C.Width w) = cs where+memoBits+  :: E.Changers -> (E.Label, E.EvenOdd) -> L.Memo -> R.Width -> [Rb.Chunk]+memoBits ch (lbl, eo) m (R.Width w) = cs where   cs = Fdbl.toList        . fmap toBit        . TF.unLines@@ -334,12 +347,14 @@        . X.intercalate (X.singleton ' ')        . L.unMemo        $ m-  toBit (TF.Words ws) = E.PreChunk lbl eo (X.unwords . Fdbl.toList $ ws)+  md = E.getEvenOddLabelValue lbl eo ch+  toBit (TF.Words ws) = md . Rb.plain $ (X.unwords . Fdbl.toList $ ws)  -memoCell :: Box -> Int -> ((E.Label, E.EvenOdd), R.ColumnSpec)-memoCell info width = (ts, cell) where-  w = C.Width width+memoCell+  :: E.Changers -> Box -> Int -> ((E.Label, E.EvenOdd), R.ColumnSpec)+memoCell ch info width = (ts, cell) where+  w = R.Width width   vn = M.visibleNum . L.boxMeta $ info   eo = E.fromVisibleNum vn   ts = (E.Other, eo)@@ -348,19 +363,21 @@   mayTm = Q.transactionMemo . L.boxPostFam $ info   cs = case (mayPm, mayTm) of     (Nothing, Nothing) -> mempty-    (Nothing, Just tm) -> memoBits ts tm w-    (Just pm, Nothing) -> memoBits ts pm w-    (Just pm, Just tm) -> memoBits ts pm w `mappend` memoBits ts tm w+    (Nothing, Just tm) -> memoBits ch ts tm w+    (Just pm, Nothing) -> memoBits ch ts pm w+    (Just pm, Just tm) -> memoBits ch ts pm w `mappend` memoBits ch ts tm w  -filenameCell :: Box -> Int -> ((E.Label, E.EvenOdd), R.ColumnSpec)-filenameCell info width = (ts, cell) where-  w = C.Width width+filenameCell+  :: E.Changers -> Box -> Int -> ((E.Label, E.EvenOdd), R.ColumnSpec)+filenameCell ch info width = (ts, cell) where+  w = R.Width width   vn = M.visibleNum . L.boxMeta $ info   eo = E.fromVisibleNum vn   ts = (E.Other, eo)   cell = R.ColumnSpec R.LeftJustify w ts cs-  toBit n = (E.PreChunk E.Other eo)+  md = E.getEvenOddLabelValue E.Other eo ch+  toBit n = md . Rb.plain             . X.drop (max 0 (X.length n - width)) $ n   cs = case Q.filename . L.boxPostFam $ info of     Nothing -> []

@@ -10,7 +10,7 @@ import qualified Penny.Cabin.Posts.Spacers as S import qualified Penny.Cabin.Row as R import qualified Penny.Cabin.Scheme as E-import qualified Penny.Steel.Chunk as C+import qualified System.Console.Rainbow as Rb import Penny.Cabin.Posts.Meta (Box) import qualified Penny.Lincoln as L import qualified Data.Text as X@@ -62,21 +62,22 @@   , B.spacers = spacers c   } -makeChunk ::-  ChunkOpts+makeChunk+  :: E.Changers+  -> ChunkOpts   -> [Box]-  -> [E.PreChunk]-makeChunk c bs =+  -> [Rb.Chunk]+makeChunk ch c bs =   let fmapSnd = fmap (fmap snd)       fmapFst = fmap (fmap fst)       gFldW = fmap (fmap snd) gFlds       aFldW = fmapSnd aFlds-      gFlds = G.growCells (growOpts c) bs-      aFlds = A.payeeAndAcct (allocatedOpts c gFldW) bs-      bFlds = B.bottomRows (bottomOpts c gFldW aFldW) bs+      gFlds = G.growCells ch (growOpts c) bs+      aFlds = A.payeeAndAcct ch (allocatedOpts c gFldW) bs+      bFlds = B.bottomRows ch (bottomOpts c gFldW aFldW) bs       topCells = B.topRowCells (fmapFst gFlds) (fmap (fmap fst) aFlds)       withSpacers = B.mergeWithSpacers topCells (spacers c)-      topRows = makeTopRows withSpacers+      topRows = makeTopRows ch withSpacers       bottomRows = makeBottomRows bFlds   in makeAllRows topRows bottomRows @@ -93,8 +94,8 @@     (Just pairList) -> pairList : acc   in transpose $ Fdbl.foldr f [] (fmap toWithSpc t) -makeRow :: [(R.ColumnSpec, Maybe R.ColumnSpec)] -> [E.PreChunk]-makeRow = R.row . foldr f [] where+makeRow :: E.Changers -> [(R.ColumnSpec, Maybe R.ColumnSpec)] -> [Rb.Chunk]+makeRow ch = R.row ch . foldr f [] where   f (c, mayC) acc = case mayC of     Nothing -> c:acc     Just spcr -> c:spcr:acc@@ -117,29 +118,30 @@   then map (\c -> (c, Nothing)) cs   else let     spcrs = cycle [Just $ mkSpcr evenTs, Just $ mkSpcr oddTs]-    mkSpcr ts = R.ColumnSpec R.LeftJustify (C.Width absI) ts []+    mkSpcr ts = R.ColumnSpec R.LeftJustify (R.Width absI) ts []     evenTs = (E.Other, E.Even)     oddTs = (E.Other, E.Odd)     in zip cs spcrs  makeTopRows-  :: B.TopRowCells (Maybe [R.ColumnSpec], Maybe Int)-  -> Maybe [[E.PreChunk]]-makeTopRows trc =+  :: E.Changers+  -> B.TopRowCells (Maybe [R.ColumnSpec], Maybe Int)+  -> Maybe [[Rb.Chunk]]+makeTopRows ch trc =   if Fdbl.all (isNothing . fst) trc   then Nothing-  else Just $ map makeRow . topRowsCells $ trc+  else Just $ map (makeRow ch) . topRowsCells $ trc   makeBottomRows ::-  B.Fields (Maybe [[E.PreChunk]])-  -> Maybe [[[E.PreChunk]]]+  B.Fields (Maybe [[Rb.Chunk]])+  -> Maybe [[[Rb.Chunk]]] makeBottomRows flds =   if Fdbl.all isNothing flds   then Nothing   else Just . transpose . catMaybes . Fdbl.toList $ flds -makeAllRows :: Maybe [[E.PreChunk]] -> Maybe [[[E.PreChunk]]] -> [E.PreChunk]+makeAllRows :: Maybe [[Rb.Chunk]] -> Maybe [[[Rb.Chunk]]] -> [Rb.Chunk] makeAllRows mayrs mayrrs = case (mayrs, mayrrs) of   (Nothing, Nothing) -> []   (Just rs, Nothing) -> concat rs

@@ -23,6 +23,7 @@ import qualified Penny.Liberty as Ly import qualified Penny.Lincoln as L import qualified Penny.Lincoln.Queries as Q+import qualified System.Console.Rainbow as Rb   -- | All the options needed to grow the cells.@@ -43,14 +44,15 @@ -- cell. Each of these widths will be at least 1; fields that were in -- the report but that ended up having no width are changed to -- Nothing.-growCells ::-  GrowOpts+growCells+  :: E.Changers+  -> GrowOpts   -> [Box]   -> Fields (Maybe ([R.ColumnSpec], Int))-growCells o infos = toPair <$> wanted <*> growers where+growCells ch o infos = toPair <$> wanted <*> growers where   toPair b gwr     | b =-      let cs = map (gwr o) infos+      let cs = map (gwr o ch) infos           w = Fdbl.foldl' f 0 cs where             f acc c = max acc (widestLine c)           cs' = map (sizer (R.Width w)) cs@@ -62,12 +64,12 @@ widestLine (PreSpec _ _ bs) =   case bs of     [] -> 0-    xs -> maximum . map (R.unWidth . E.width) $ xs+    xs -> maximum . map (X.length . Rb.chunkText) $ xs  data PreSpec = PreSpec {   _justification :: R.Justification   , _padSpec :: (E.Label, E.EvenOdd)-  , _bits :: [E.PreChunk] }+  , _bits :: [Rb.Chunk] }   -- | Given a PreSpec and a width, create a ColumnSpec of the right@@ -77,17 +79,18 @@  -- | Makes a left justified cell that is only one line long. The width -- is unset.-oneLine :: Text -> E.Label -> Box -> PreSpec-oneLine t lbl b =+oneLine :: E.Changers -> Text -> E.Label -> Box -> PreSpec+oneLine chgrs t lbl b =   let eo = E.fromVisibleNum . M.visibleNum . L.boxMeta $ b       j = R.LeftJustify-      pcs = E.PreChunk lbl eo t-  in PreSpec j (lbl, eo) [pcs]+      md = E.getEvenOddLabelValue lbl eo chgrs+      ck = [md $ Rb.plain t]+  in PreSpec j (lbl, eo) ck   -- | Gets a Fields with each field filled with the function that fills -- the cells for that field.-growers :: Fields (GrowOpts -> Box -> PreSpec)+growers :: Fields (GrowOpts -> E.Changers -> Box -> PreSpec) growers = Fields   { globalTransaction    = const getGlobalTransaction   , revGlobalTransaction = const getRevGlobalTransaction@@ -104,116 +107,118 @@   , visible              = const getVisible   , revVisible           = const getRevVisible   , lineNum              = const getLineNum-  , date                 = \o -> getDate (dateFormat o)+  , date                 = \o ch -> getDate ch (dateFormat o)   , flag                 = const getFlag   , number               = const getNumber   , postingDrCr          = const getPostingDrCr   , postingCmdty         = const getPostingCmdty-  , postingQty           = \o -> getPostingQty (qtyFormat o)+  , postingQty           = \o ch -> getPostingQty ch (qtyFormat o)   , totalDrCr            = const getTotalDrCr   , totalCmdty           = const getTotalCmdty-  , totalQty             = \o -> getTotalQty (balanceFormat o)+  , totalQty             = \o ch -> getTotalQty ch (balanceFormat o)   }  -- | Make a left justified cell one line long that shows a serial.-serialCellMaybe ::-  (L.PostFam -> Maybe Int)+serialCellMaybe+  :: E.Changers+  -> (L.PostFam -> Maybe Int)   -- ^ When applied to a Box, this function returns Just Int if the   -- box has a serial, or Nothing if not.    -> Box -> PreSpec-serialCellMaybe f b = oneLine t E.Other b+serialCellMaybe chgrs f b = oneLine chgrs t E.Other b   where     t = case f (L.boxPostFam b) of       Nothing -> X.empty       Just i -> X.pack . show $ i -serialCell ::-  (M.PostMeta -> Int)+serialCell+  :: E.Changers+  -> (M.PostMeta -> Int)   -> Box -> PreSpec-serialCell f b = oneLine t E.Other b+serialCell chgrs f b = oneLine chgrs t E.Other b   where     t = pack . show . f . L.boxMeta $ b -getGlobalTransaction :: Box -> PreSpec-getGlobalTransaction =-  serialCellMaybe (fmap (L.forward . L.unGlobalTransaction)-                   . Q.globalTransaction)+getGlobalTransaction :: E.Changers -> Box -> PreSpec+getGlobalTransaction chgrs =+  serialCellMaybe chgrs (fmap (L.forward . L.unGlobalTransaction)+                        . Q.globalTransaction) -getRevGlobalTransaction :: Box -> PreSpec-getRevGlobalTransaction =-  serialCellMaybe (fmap (L.backward . L.unGlobalTransaction)-                   . Q.globalTransaction)+getRevGlobalTransaction :: E.Changers -> Box -> PreSpec+getRevGlobalTransaction chgrs =+  serialCellMaybe chgrs (fmap (L.backward . L.unGlobalTransaction)+                        . Q.globalTransaction) -getGlobalPosting :: Box -> PreSpec-getGlobalPosting =-  serialCellMaybe (fmap (L.forward . L.unGlobalPosting)-                   . Q.globalPosting)+getGlobalPosting :: E.Changers -> Box -> PreSpec+getGlobalPosting chgrs =+  serialCellMaybe chgrs (fmap (L.forward . L.unGlobalPosting)+                        . Q.globalPosting) -getRevGlobalPosting :: Box -> PreSpec-getRevGlobalPosting =-  serialCellMaybe (fmap (L.backward . L.unGlobalPosting)+getRevGlobalPosting :: E.Changers -> Box -> PreSpec+getRevGlobalPosting chgrs =+  serialCellMaybe chgrs (fmap (L.backward . L.unGlobalPosting)                    . Q.globalPosting) -getFileTransaction :: Box -> PreSpec-getFileTransaction =-  serialCellMaybe (fmap (L.forward . L.unFileTransaction)+getFileTransaction :: E.Changers -> Box -> PreSpec+getFileTransaction chgrs =+  serialCellMaybe chgrs (fmap (L.forward . L.unFileTransaction)                    . Q.fileTransaction) -getRevFileTransaction :: Box -> PreSpec-getRevFileTransaction =-  serialCellMaybe (fmap (L.backward . L.unFileTransaction)+getRevFileTransaction :: E.Changers -> Box -> PreSpec+getRevFileTransaction chgrs =+  serialCellMaybe chgrs (fmap (L.backward . L.unFileTransaction)                    . Q.fileTransaction) -getFilePosting :: Box -> PreSpec-getFilePosting =-  serialCellMaybe (fmap (L.forward . L.unFilePosting)+getFilePosting :: E.Changers -> Box -> PreSpec+getFilePosting chgrs =+  serialCellMaybe chgrs (fmap (L.forward . L.unFilePosting)                    . Q.filePosting) -getRevFilePosting :: Box -> PreSpec-getRevFilePosting =-  serialCellMaybe (fmap (L.backward . L.unFilePosting)+getRevFilePosting :: E.Changers -> Box -> PreSpec+getRevFilePosting chgrs =+  serialCellMaybe chgrs (fmap (L.backward . L.unFilePosting)                    . Q.filePosting) -getSorted :: Box -> PreSpec-getSorted =-  serialCell (L.forward . Ly.unSortedNum . M.sortedNum)+getSorted :: E.Changers -> Box -> PreSpec+getSorted chgrs =+  serialCell chgrs (L.forward . Ly.unSortedNum . M.sortedNum) -getRevSorted :: Box -> PreSpec-getRevSorted =-  serialCell (L.backward . Ly.unSortedNum . M.sortedNum)+getRevSorted :: E.Changers -> Box -> PreSpec+getRevSorted chgrs =+  serialCell chgrs (L.backward . Ly.unSortedNum . M.sortedNum) -getFiltered :: Box -> PreSpec-getFiltered =-  serialCell (L.forward . Ly.unFilteredNum . M.filteredNum)+getFiltered :: E.Changers -> Box -> PreSpec+getFiltered chgrs =+  serialCell chgrs (L.forward . Ly.unFilteredNum . M.filteredNum) -getRevFiltered :: Box -> PreSpec-getRevFiltered =-  serialCell (L.backward . Ly.unFilteredNum . M.filteredNum)+getRevFiltered :: E.Changers -> Box -> PreSpec+getRevFiltered chgrs =+  serialCell chgrs (L.backward . Ly.unFilteredNum . M.filteredNum) -getVisible :: Box -> PreSpec-getVisible =-  serialCell (L.forward . M.unVisibleNum . M.visibleNum)+getVisible :: E.Changers -> Box -> PreSpec+getVisible chgrs =+  serialCell chgrs (L.forward . M.unVisibleNum . M.visibleNum) -getRevVisible :: Box -> PreSpec-getRevVisible =-  serialCell (L.backward . M.unVisibleNum . M.visibleNum)+getRevVisible :: E.Changers -> Box -> PreSpec+getRevVisible chgrs =+  serialCell chgrs (L.backward . M.unVisibleNum . M.visibleNum)  -getLineNum :: Box -> PreSpec-getLineNum b = oneLine t E.Other b where+getLineNum :: E.Changers -> Box -> PreSpec+getLineNum chgrs b = oneLine chgrs t E.Other b where   lineTxt = pack . show . L.unPostingLine   t = maybe empty lineTxt (Q.postingLine . L.boxPostFam $ b) -getDate :: (Box -> X.Text) -> Box -> PreSpec-getDate gd b = oneLine (gd b) E.Other b+getDate :: E.Changers -> (Box -> X.Text) -> Box -> PreSpec+getDate chgrs gd b = oneLine chgrs (gd b) E.Other b -getFlag :: Box -> PreSpec-getFlag i = oneLine t E.Other i where+getFlag :: E.Changers -> Box -> PreSpec+getFlag chgrs i = oneLine chgrs t E.Other i where   t = maybe empty L.text (Q.flag . L.boxPostFam $ i) -getNumber :: Box -> PreSpec-getNumber i = oneLine t E.Other i where+getNumber :: E.Changers -> Box -> PreSpec+getNumber chgrs i = oneLine chgrs t E.Other i where   t = maybe empty L.text (Q.number . L.boxPostFam $ i)  dcTxt :: L.DrCr -> Text@@ -222,44 +227,47 @@  -- | Gives a one-line cell that is colored according to whether the -- posting is a debit or credit.-coloredPostingCell :: Text -> Box -> PreSpec-coloredPostingCell t i = PreSpec j (lbl, eo) [bit] where+coloredPostingCell :: E.Changers -> Text -> Box -> PreSpec+coloredPostingCell chgrs t i = PreSpec j (lbl, eo) [bit] where   j = R.LeftJustify   lbl = case Q.drCr . L.boxPostFam $ i of     L.Debit -> E.Debit     L.Credit -> E.Credit   eo = E.fromVisibleNum . M.visibleNum . L.boxMeta $ i-  bit = E.PreChunk lbl eo t+  md = E.getEvenOddLabelValue lbl eo chgrs+  bit = md $ Rb.plain t  -getPostingDrCr :: Box -> PreSpec-getPostingDrCr i = coloredPostingCell t i where+getPostingDrCr :: E.Changers -> Box -> PreSpec+getPostingDrCr ch i = coloredPostingCell ch t i where   t = dcTxt . Q.drCr . L.boxPostFam $ i -getPostingCmdty :: Box -> PreSpec-getPostingCmdty i = coloredPostingCell t i where+getPostingCmdty :: E.Changers -> Box -> PreSpec+getPostingCmdty ch i = coloredPostingCell ch t i where   t = L.unCommodity . Q.commodity . L.boxPostFam $ i -getPostingQty :: (Box -> X.Text) -> Box -> PreSpec-getPostingQty qf i = coloredPostingCell (qf i) i+getPostingQty :: E.Changers -> (Box -> X.Text) -> Box -> PreSpec+getPostingQty ch qf i = coloredPostingCell ch (qf i) i -getTotalDrCr :: Box -> PreSpec-getTotalDrCr i =+getTotalDrCr :: E.Changers -> Box -> PreSpec+getTotalDrCr ch i =   let vn = M.visibleNum . L.boxMeta $ i       ps = (lbl, eo)       dc = Q.drCr . L.boxPostFam $ i       lbl = E.dcToLbl dc       eo = E.fromVisibleNum vn       bal = L.unBalance . M.balance . L.boxMeta $ i+      md = E.getEvenOddLabelValue lbl eo ch       bits =         if Map.null bal-        then [E.PreChunk E.Zero eo (pack "--")]-        else fmap (flip E.bottomLineToDrCr eo) . elems $ bal+        then [md . Rb.plain $ pack "--"]+        else let mkChk e = E.bottomLineToDrCr e eo ch+             in fmap mkChk . elems $ bal       j = R.LeftJustify   in PreSpec j ps bits -getTotalCmdty :: Box -> PreSpec-getTotalCmdty i =+getTotalCmdty :: E.Changers -> Box -> PreSpec+getTotalCmdty ch i =   let vn = M.visibleNum . L.boxMeta $ i       j = R.RightJustify       ps = (lbl, eo)@@ -267,21 +275,22 @@       eo = E.fromVisibleNum vn       lbl = E.dcToLbl dc       bal = Map.toList . L.unBalance . M.balance . L.boxMeta $ i-      preChunks = E.balancesToCmdtys eo bal+      preChunks = E.balancesToCmdtys ch eo bal   in PreSpec j ps preChunks -getTotalQty ::-  (L.Commodity -> L.Qty -> X.Text)+getTotalQty+  :: E.Changers+  -> (L.Commodity -> L.Qty -> X.Text)   -> Box   -> PreSpec-getTotalQty balFmt i =+getTotalQty ch balFmt i =   let vn = M.visibleNum . L.boxMeta $ i       j = R.LeftJustify       dc = Q.drCr . L.boxPostFam $ i       ps = (E.dcToLbl dc, eo)       eo = E.fromVisibleNum vn       bal = Map.toList . L.unBalance . M.balance . L.boxMeta $ i-      preChunks = E.balanceToQtys balFmt eo bal+      preChunks = E.balanceToQtys ch balFmt eo bal   in PreSpec j ps preChunks  growingFields :: F.Fields Bool -> Fields Bool

@@ -11,7 +11,7 @@ import qualified Penny.Liberty as Ly import qualified Penny.Cabin.Meta as M import qualified Penny.Cabin.Options as CO-import qualified Penny.Steel.Pdct as Pe+import qualified Data.Prednote.Pdct as Pe import Data.Monoid (mempty, mappend)  -- | The Box type that is used throughout the Posts modules.

@@ -23,8 +23,8 @@ import qualified Penny.Cabin.Posts.Types as Ty import qualified Penny.Cabin.Options as CO import qualified Penny.Liberty as Ly-import qualified Penny.Steel.Expressions as Exp-import qualified Penny.Steel.Pdct as Pt+import qualified Data.Prednote.Expressions as Exp+import qualified Data.Prednote.Pdct as Pt import qualified Penny.Lincoln as L import qualified Penny.Lincoln.Predicates as Pd import qualified Penny.Shield as S

@@ -25,13 +25,13 @@ module Penny.Cabin.Row (   Justification(LeftJustify, RightJustify),   ColumnSpec(ColumnSpec, justification, width, padSpec, bits),-  C.Width(Width, unWidth),+  Width(Width, unWidth),   row ) where  import Data.List (transpose) import qualified Data.Text as X-import qualified Penny.Steel.Chunk as C import qualified Penny.Cabin.Scheme as E+import qualified System.Console.Rainbow as R  -- | How to justify cells. LeftJustify leaves the right side -- ragged. RightJustify leaves the left side ragged.@@ -48,77 +48,76 @@ -- cells into a Row. data ColumnSpec =   ColumnSpec { justification :: Justification-             , width :: C.Width+             , width :: Width              , padSpec :: (E.Label, E.EvenOdd)-             , bits :: [E.PreChunk] }+             , bits :: [R.Chunk] } -newtype JustifiedCell = JustifiedCell (Either (E.PreChunk, E.PreChunk)-                                              E.PreChunk)+newtype JustifiedCell = JustifiedCell (R.Chunk, R.Chunk)+ data JustifiedColumn = JustifiedColumn {   justifiedCells :: [JustifiedCell]-  , _justifiedWidth :: C.Width+  , _justifiedWidth :: Width   , _justifiedPadSpec :: (E.Label, E.EvenOdd) }  newtype PaddedColumns = PaddedColumns [[JustifiedCell]] newtype CellsByRow = CellsByRow [[JustifiedCell]] newtype CellRowsWithNewlines = CellRowsWithNewlines [[JustifiedCell]]-+newtype Width = Width { unWidth :: Int }+  deriving (Eq, Ord, Show)  justify-  :: C.Width+  :: Width   -> Justification-  -> E.PreChunk+  -> E.Label+  -> E.EvenOdd+  -> E.Changers+  -> R.Chunk   -> JustifiedCell-justify (C.Width w) j pc-  | origWidth < w = JustifiedCell . Left $ pair-  | otherwise = JustifiedCell . Right $ pc-    where-      origWidth = C.unWidth . E.width $ pc-      lbl = E.label pc-      eo = E.evenOdd pc-      pad = E.PreChunk lbl eo t-      t = X.replicate (w - origWidth) (X.singleton ' ')-      pair = case j of-        LeftJustify -> (pc, pad)-        RightJustify -> (pad, pc)+justify (Width w) j l eo chgrs pc = JustifiedCell (left, right)+  where+    origWidth = X.length . R.chunkText $ pc+    pad = E.getEvenOddLabelValue l eo chgrs $ R.plain t+    t = X.replicate (max 0 (w - origWidth)) (X.singleton ' ')+    (left, right) = case j of+      LeftJustify -> (pc, pad)+      RightJustify -> (pad, pc) -newtype Height = Height { _unHeight :: Int }-                 deriving (Show, Eq, Ord)+newtype Height = Height Int+  deriving (Show, Eq, Ord)  height :: [[a]] -> Height height xs = case xs of   [] -> Height 0   ls -> Height . maximum . map length $ ls -row :: [ColumnSpec] -> [E.PreChunk]-row =+row :: E.Changers -> [ColumnSpec] -> [R.Chunk]+row chgrs =   concat   . concat   . toBits   . toCellRowsWithNewlines   . toCellsByRow-  . bottomPad-  . map justifiedColumn+  . bottomPad chgrs+  . map (justifiedColumn chgrs) -justifiedColumn :: ColumnSpec -> JustifiedColumn-justifiedColumn (ColumnSpec j w ts bs) = JustifiedColumn cs w ts where-  cs = map (justify w j) $ bs+justifiedColumn :: E.Changers -> ColumnSpec -> JustifiedColumn+justifiedColumn chgrs (ColumnSpec j w (l, eo) bs)+  = JustifiedColumn cs w (l, eo)+  where+    cs = map (justify w j l eo chgrs) bs -bottomPad :: [JustifiedColumn] -> PaddedColumns-bottomPad jcs = PaddedColumns pcs where+bottomPad :: E.Changers -> [JustifiedColumn] -> PaddedColumns+bottomPad chgrs jcs = PaddedColumns pcs where   justCells = map justifiedCells jcs   (Height h) = height justCells   pcs = map toPaddedColumn jcs-  toPaddedColumn (JustifiedColumn cs (C.Width w) (lbl, eo)) = let-    l = length cs-    nPads = h - l-    pad = E.PreChunk lbl eo t-    t = X.replicate w (X.singleton ' ')-    pads = replicate nPads . JustifiedCell . Right $ pad-    cs'-      | l < h = cs ++ pads-      | otherwise = cs-    in cs'+  toPaddedColumn (JustifiedColumn cs (Width w) (lbl, eo)) =+    let l = length cs+        nPads = max 0 $ h - l+        pad = E.getEvenOddLabelValue lbl eo chgrs $ R.plain t+        t = X.replicate w (X.singleton ' ')+        pads = replicate nPads $ JustifiedCell (R.plain X.empty, pad)+    in cs ++ pads   toCellsByRow :: PaddedColumns -> CellsByRow@@ -129,14 +128,11 @@ toCellRowsWithNewlines (CellsByRow bs) =   CellRowsWithNewlines bs' where     bs' = foldr f [] bs-    newline = JustifiedCell . Right-              $ E.PreChunk E.Other E.Even (X.singleton '\n')+    newline = JustifiedCell (R.plain X.empty, R.plain (X.singleton '\n'))     f cells acc = (cells ++ [newline]) : acc  -toBits :: CellRowsWithNewlines -> [[[E.PreChunk]]]+toBits :: CellRowsWithNewlines -> [[[R.Chunk]]] toBits (CellRowsWithNewlines cs) = map (map toB) cs where-  toB (JustifiedCell c) = case c of-    Left (lb, rb) -> [lb, rb]-    Right b -> [b]+  toB (JustifiedCell (c1, c2)) = [c1, c2] 

@@ -1,3 +1,4 @@+{-# LANGUAGE OverloadedStrings #-} -- | Cabin color schemes -- -- Each element of a Cabin report identifies what it is--a debit on an@@ -8,10 +9,10 @@  module Penny.Cabin.Scheme where -import qualified Penny.Steel.Chunk as C import qualified Penny.Cabin.Meta as M import qualified Penny.Lincoln as L import qualified Data.Text as X+import qualified System.Console.Rainbow as R  data Label   = Debit@@ -41,7 +42,7 @@   , eoOdd :: a   } deriving Show -type TextSpecs = Labels (EvenAndOdd C.TextSpec)+type Changers = Labels (EvenAndOdd (R.Chunk -> R.Chunk))  data Scheme = Scheme   { name :: String@@ -52,7 +53,7 @@     -- ^ A brief (one-line) description of what this scheme is, such     -- as @for dark background terminals@ -  , textSpecs :: TextSpecs+  , changers :: Changers   } deriving Show  @@ -69,20 +70,6 @@ getEvenOddLabelValue l eo ls =   getEvenOdd eo (getLabelValue l ls) -data PreChunk = PreChunk-  { label :: Label-  , evenOdd :: EvenOdd-  , text :: X.Text-  } deriving (Eq, Show)--width :: PreChunk -> C.Width-width = C.Width . X.length . text--makeChunk :: TextSpecs -> PreChunk -> C.Chunk-makeChunk s p =-  C.chunk (getEvenOddLabelValue (label p) (evenOdd p) s)-          (text p)- fromVisibleNum :: M.VisibleNum -> EvenOdd fromVisibleNum vn =   let s = M.unVisibleNum vn in@@ -92,54 +79,62 @@ dcToLbl L.Debit = Debit dcToLbl L.Credit = Credit -bottomLineToDrCr :: L.BottomLine -> EvenOdd -> PreChunk-bottomLineToDrCr bl eo = PreChunk lbl eo t+bottomLineToDrCr :: L.BottomLine -> EvenOdd -> Changers -> R.Chunk+bottomLineToDrCr bl eo chgrs = md c   where-    (lbl, t) = case bl of-      L.Zero -> (Zero, X.pack "--")+    (c, md) = case bl of+      L.Zero -> (R.plain "--", getEvenOddLabelValue Zero eo chgrs)       L.NonZero (L.Column clmDrCr _) -> case clmDrCr of-        L.Debit -> (Debit, X.singleton '<')-        L.Credit -> (Credit, X.singleton '>')+        L.Debit -> (R.plain "<", getEvenOddLabelValue Debit eo chgrs)+        L.Credit -> (R.plain ">", getEvenOddLabelValue Credit eo chgrs) + balancesToCmdtys-  :: EvenOdd+  :: Changers+  -> EvenOdd   -> [(L.Commodity, L.BottomLine)]-  -> [PreChunk]-balancesToCmdtys eo ls =+  -> [R.Chunk]+balancesToCmdtys chgrs eo ls =   if null ls-  then [PreChunk Zero eo (X.pack "--")]-  else map (bottomLineToCmdty eo) ls+  then [getEvenOddLabelValue Zero eo chgrs $ R.plain "--"]+  else map (bottomLineToCmdty chgrs eo) ls  bottomLineToCmdty-  :: EvenOdd+  :: Changers+  -> EvenOdd   -> (L.Commodity, L.BottomLine)-  -> PreChunk-bottomLineToCmdty eo (cy, bl) = PreChunk lbl eo t+  -> R.Chunk+bottomLineToCmdty chgrs eo (cy, bl) = md c   where-    t = L.unCommodity cy+    c = R.plain . L.unCommodity $ cy     lbl = case bl of       L.Zero -> Zero       L.NonZero (L.Column clmDrCr _) -> dcToLbl clmDrCr+    md = getEvenOddLabelValue lbl eo chgrs  balanceToQtys-  :: (L.Commodity -> L.Qty -> X.Text)+  :: Changers+  -> (L.Commodity -> L.Qty -> X.Text)   -> EvenOdd   -> [(L.Commodity, L.BottomLine)]-  -> [PreChunk]-balanceToQtys getTxt eo ls =+  -> [R.Chunk]+balanceToQtys chgrs getTxt eo ls =   if null ls-  then [PreChunk Zero eo (X.pack "--")]-  else map (bottomLineToQty getTxt eo) ls+  then let md = getEvenOddLabelValue Zero eo chgrs+       in [md (R.plain "--")]+  else map (bottomLineToQty chgrs getTxt eo) ls   bottomLineToQty-  :: (L.Commodity -> L.Qty -> X.Text)+  :: Changers+  -> (L.Commodity -> L.Qty -> X.Text)   -> EvenOdd   -> (L.Commodity, L.BottomLine)-  -> PreChunk-bottomLineToQty getTxt eo (cy, bl) = PreChunk lbl eo t+  -> R.Chunk+bottomLineToQty chgrs getTxt eo (cy, bl) = md (R.plain t)   where     (lbl, t) = case bl of       L.Zero -> (Zero, X.pack "--")       L.NonZero (L.Column clmDrCr qt) -> (dcToLbl clmDrCr, getTxt cy qt)+    md = getEvenOddLabelValue lbl eo chgrs 

@@ -3,8 +3,8 @@ module Penny.Cabin.Scheme.Schemes where  import qualified Penny.Cabin.Scheme as E-import qualified Penny.Steel.Chunk as C-import qualified Penny.Steel.Chunk.Switch as Sw+import qualified System.Console.Rainbow as R+import System.Console.Rainbow ((.+.))  -- | The light color scheme. You can change various values below to -- affect the color scheme.@@ -12,7 +12,7 @@ light = E.Scheme "light" "for light background terminals"               lightLabels -lightLabels :: E.Labels (E.EvenAndOdd C.TextSpec)+lightLabels :: E.Labels (E.EvenAndOdd (R.Chunk -> R.Chunk)) lightLabels = E.Labels   { E.debit = E.EvenAndOdd { E.eoEven = lightDebit lightEvenTextSpec                            , E.eoOdd = lightDebit lightOddTextSpec }@@ -24,21 +24,20 @@                            , E.eoOdd = lightOddTextSpec }   } -lightEvenTextSpec :: C.TextSpec-lightEvenTextSpec = C.defaultTextSpec+lightEvenTextSpec :: R.Chunk -> R.Chunk+lightEvenTextSpec = id -lightOddTextSpec :: C.TextSpec-lightOddTextSpec = Sw.switchBackground C.color8_b_default-                   C.color256_b_255 lightEvenTextSpec+lightOddTextSpec :: R.Chunk -> R.Chunk+lightOddTextSpec = id .+. R.color8_b_default .+. R.color256_b_255 -lightDebit :: C.TextSpec -> C.TextSpec-lightDebit = Sw.switchForeground C.color8_f_magenta C.color256_f_52+lightDebit :: (R.Chunk -> R.Chunk) -> R.Chunk -> R.Chunk+lightDebit f = f .+. R.color8_f_magenta .+. R.color256_f_52 -lightCredit :: C.TextSpec -> C.TextSpec-lightCredit = Sw.switchForeground C.color8_f_cyan C.color256_f_21+lightCredit :: (R.Chunk -> R.Chunk) -> R.Chunk -> R.Chunk+lightCredit f = f .+. R.color8_f_cyan .+. R.color256_f_21 -lightZero :: C.TextSpec -> C.TextSpec-lightZero = Sw.switchForeground C.color8_f_black C.color256_f_0+lightZero :: (R.Chunk -> R.Chunk) -> R.Chunk -> R.Chunk+lightZero f = f .+. R.color8_f_black .+. R.color256_f_0  -- | The dark color scheme. You can change various values below to -- affect the color scheme.@@ -46,7 +45,7 @@ dark = E.Scheme "dark" "for dark background terminals"               darkLabels -darkLabels :: E.Labels (E.EvenAndOdd C.TextSpec)+darkLabels :: E.Labels (E.EvenAndOdd (R.Chunk -> R.Chunk)) darkLabels = E.Labels   { E.debit = E.EvenAndOdd { E.eoEven = darkDebit darkEvenTextSpec                            , E.eoOdd = darkDebit darkOddTextSpec }@@ -58,32 +57,31 @@                            , E.eoOdd = darkOddTextSpec }   } -darkEvenTextSpec :: C.TextSpec-darkEvenTextSpec = C.defaultTextSpec+darkEvenTextSpec :: R.Chunk -> R.Chunk+darkEvenTextSpec = id -darkOddTextSpec :: C.TextSpec-darkOddTextSpec = Sw.switchBackground C.color8_b_default-                   C.color256_b_235 darkEvenTextSpec+darkOddTextSpec :: R.Chunk -> R.Chunk+darkOddTextSpec = id .+. R.color8_b_default .+. R.color256_b_235 -darkDebit :: C.TextSpec -> C.TextSpec-darkDebit = Sw.switchForeground C.color8_f_magenta C.color256_f_208+darkDebit :: (R.Chunk -> R.Chunk) -> R.Chunk -> R.Chunk+darkDebit f = f .+. R.color8_f_magenta .+. R.color256_f_208 -darkCredit :: C.TextSpec -> C.TextSpec-darkCredit = Sw.switchForeground C.color8_f_cyan C.color256_f_45+darkCredit :: (R.Chunk -> R.Chunk) -> R.Chunk -> R.Chunk+darkCredit f = f .+. R.color8_f_cyan .+. R.color256_f_45 -darkZero :: C.TextSpec -> C.TextSpec-darkZero = Sw.switchForeground C.color8_f_white C.color256_f_15+darkZero :: (R.Chunk -> R.Chunk) -> R.Chunk -> R.Chunk+darkZero f = f .+. R.color8_f_white .+. R.color256_f_15  -- | Plain scheme has no colors at all. plain :: E.Scheme plain = E.Scheme "plain" "uses default terminal colors"               plainLabels -plainLabels :: E.Labels (E.EvenAndOdd C.TextSpec)+plainLabels :: E.Labels (E.EvenAndOdd (R.Chunk -> R.Chunk)) plainLabels = E.Labels-  { E.debit = E.EvenAndOdd C.defaultTextSpec C.defaultTextSpec-  , E.credit = E.EvenAndOdd C.defaultTextSpec C.defaultTextSpec-  , E.zero = E.EvenAndOdd C.defaultTextSpec C.defaultTextSpec-  , E.other = E.EvenAndOdd C.defaultTextSpec C.defaultTextSpec+  { E.debit = E.EvenAndOdd id id+  , E.credit = E.EvenAndOdd id id+  , E.zero = E.EvenAndOdd id id+  , E.other = E.EvenAndOdd id id   } 

@@ -57,10 +57,10 @@  import Penny.Lincoln.Family.Child (child, parent) import qualified Penny.Lincoln.Predicates as P-import qualified Penny.Steel.Pdct as E+import qualified Data.Prednote.Pdct as E import qualified Penny.Lincoln as L-import qualified Penny.Steel.Chunk as C-import qualified Penny.Steel.Expressions as X+import qualified System.Console.Rainbow as C+import qualified Data.Prednote.Expressions as X  import Text.Matchers (   CaseSensitive(Sensitive, Insensitive))

@@ -42,7 +42,7 @@ import Penny.Lincoln.Transaction (PostFam) import qualified Penny.Lincoln.Transaction as T import qualified Text.Matchers as M-import qualified Penny.Steel.Pdct as P+import qualified Data.Prednote.Pdct as P  type LPdct = P.Pdct PostFam 

@@ -30,7 +30,7 @@ import qualified Data.Time as T import System.Environment (getEnvironment) import System.IO (hIsTerminalDevice, stdout)-import qualified Penny.Steel.Chunk as C+import qualified System.Console.Rainbow as C  import qualified Penny.Lincoln.Bits as B 

@@ -1,2452 +0,0 @@--- | Handles colors and special effects for text. Internally this--- module uses the Haskell terminfo library, which links against the--- UNIX library of the same name, so it should work with a wide--- variety of UNIX terminals. This module is a layer between terminfo--- and the rest of Penny, allowing the Chunk internals to be swapped--- out and replaced. (I know this because this module previously used--- a home-grown implementation written based on the Xterm--- configuration; that implementation was swapped out and replaced--- with terminfo with minimal disruption.)------ However, terminfo is a UNIX thing, so at this time Penny probably--- would not work on a Windows based system.------ There is an ansi-terminal library on Hackage, which does support--- Windows. One problem with that though is that ansi-terminal does--- not appear to support more than 8 colors; Chunk supports 256--- colors, which is very helpful for Penny.-module Penny.Steel.Chunk (-  -- * Colors-  Term(..),-  Background8,-  Background256,-  Foreground8,-  Foreground256,--  -- * Chunks-  Chunk (chunkTextSpec, chunkText),-  chunk,-  Width(Width, unWidth),-  chunkWidth,-  printChunks,--  -- * Effects-  Bold(Bold, unBold),-  Underline(Underline, unUnderline),-  Flash(Flash, unFlash),-  Inverse(Inverse, unInverse),--  -- * Style and TextSpec--  -- | A style is a bundle of attributes that describes text-  -- attributes, such as its color and whether it is bold.-  StyleCommon (StyleCommon, bold, underline, flash, inverse),-  Style8 (Style8, foreground8, background8, common8),-  Style256 (Style256, foreground256, background256, common256),-  defaultStyleCommon,-  defaultStyle8,-  defaultStyle256,--  TextSpec (TextSpec, style8, style256),-  defaultTextSpec,--  -- * Specific colors-  -- * 8 color foreground colors-  color8_f_default,-  color8_f_black,-  color8_f_red,-  color8_f_green,-  color8_f_yellow,-  color8_f_blue,-  color8_f_magenta,-  color8_f_cyan,-  color8_f_white,--  -- ** 8 color background colors-  color8_b_default,-  color8_b_black,-  color8_b_red,-  color8_b_green,-  color8_b_yellow,-  color8_b_blue,-  color8_b_magenta,-  color8_b_cyan,-  color8_b_white,--  -- * 256 color foreground colors-  color256_f_default,-  color256_f_0,-  color256_f_1,-  color256_f_2,-  color256_f_3,-  color256_f_4,-  color256_f_5,-  color256_f_6,-  color256_f_7,-  color256_f_8,-  color256_f_9,-  color256_f_10,-  color256_f_11,-  color256_f_12,-  color256_f_13,-  color256_f_14,-  color256_f_15,-  color256_f_16,-  color256_f_17,-  color256_f_18,-  color256_f_19,-  color256_f_20,-  color256_f_21,-  color256_f_22,-  color256_f_23,-  color256_f_24,-  color256_f_25,-  color256_f_26,-  color256_f_27,-  color256_f_28,-  color256_f_29,-  color256_f_30,-  color256_f_31,-  color256_f_32,-  color256_f_33,-  color256_f_34,-  color256_f_35,-  color256_f_36,-  color256_f_37,-  color256_f_38,-  color256_f_39,-  color256_f_40,-  color256_f_41,-  color256_f_42,-  color256_f_43,-  color256_f_44,-  color256_f_45,-  color256_f_46,-  color256_f_47,-  color256_f_48,-  color256_f_49,-  color256_f_50,-  color256_f_51,-  color256_f_52,-  color256_f_53,-  color256_f_54,-  color256_f_55,-  color256_f_56,-  color256_f_57,-  color256_f_58,-  color256_f_59,-  color256_f_60,-  color256_f_61,-  color256_f_62,-  color256_f_63,-  color256_f_64,-  color256_f_65,-  color256_f_66,-  color256_f_67,-  color256_f_68,-  color256_f_69,-  color256_f_70,-  color256_f_71,-  color256_f_72,-  color256_f_73,-  color256_f_74,-  color256_f_75,-  color256_f_76,-  color256_f_77,-  color256_f_78,-  color256_f_79,-  color256_f_80,-  color256_f_81,-  color256_f_82,-  color256_f_83,-  color256_f_84,-  color256_f_85,-  color256_f_86,-  color256_f_87,-  color256_f_88,-  color256_f_89,-  color256_f_90,-  color256_f_91,-  color256_f_92,-  color256_f_93,-  color256_f_94,-  color256_f_95,-  color256_f_96,-  color256_f_97,-  color256_f_98,-  color256_f_99,-  color256_f_100,-  color256_f_101,-  color256_f_102,-  color256_f_103,-  color256_f_104,-  color256_f_105,-  color256_f_106,-  color256_f_107,-  color256_f_108,-  color256_f_109,-  color256_f_110,-  color256_f_111,-  color256_f_112,-  color256_f_113,-  color256_f_114,-  color256_f_115,-  color256_f_116,-  color256_f_117,-  color256_f_118,-  color256_f_119,-  color256_f_120,-  color256_f_121,-  color256_f_122,-  color256_f_123,-  color256_f_124,-  color256_f_125,-  color256_f_126,-  color256_f_127,-  color256_f_128,-  color256_f_129,-  color256_f_130,-  color256_f_131,-  color256_f_132,-  color256_f_133,-  color256_f_134,-  color256_f_135,-  color256_f_136,-  color256_f_137,-  color256_f_138,-  color256_f_139,-  color256_f_140,-  color256_f_141,-  color256_f_142,-  color256_f_143,-  color256_f_144,-  color256_f_145,-  color256_f_146,-  color256_f_147,-  color256_f_148,-  color256_f_149,-  color256_f_150,-  color256_f_151,-  color256_f_152,-  color256_f_153,-  color256_f_154,-  color256_f_155,-  color256_f_156,-  color256_f_157,-  color256_f_158,-  color256_f_159,-  color256_f_160,-  color256_f_161,-  color256_f_162,-  color256_f_163,-  color256_f_164,-  color256_f_165,-  color256_f_166,-  color256_f_167,-  color256_f_168,-  color256_f_169,-  color256_f_170,-  color256_f_171,-  color256_f_172,-  color256_f_173,-  color256_f_174,-  color256_f_175,-  color256_f_176,-  color256_f_177,-  color256_f_178,-  color256_f_179,-  color256_f_180,-  color256_f_181,-  color256_f_182,-  color256_f_183,-  color256_f_184,-  color256_f_185,-  color256_f_186,-  color256_f_187,-  color256_f_188,-  color256_f_189,-  color256_f_190,-  color256_f_191,-  color256_f_192,-  color256_f_193,-  color256_f_194,-  color256_f_195,-  color256_f_196,-  color256_f_197,-  color256_f_198,-  color256_f_199,-  color256_f_200,-  color256_f_201,-  color256_f_202,-  color256_f_203,-  color256_f_204,-  color256_f_205,-  color256_f_206,-  color256_f_207,-  color256_f_208,-  color256_f_209,-  color256_f_210,-  color256_f_211,-  color256_f_212,-  color256_f_213,-  color256_f_214,-  color256_f_215,-  color256_f_216,-  color256_f_217,-  color256_f_218,-  color256_f_219,-  color256_f_220,-  color256_f_221,-  color256_f_222,-  color256_f_223,-  color256_f_224,-  color256_f_225,-  color256_f_226,-  color256_f_227,-  color256_f_228,-  color256_f_229,-  color256_f_230,-  color256_f_231,-  color256_f_232,-  color256_f_233,-  color256_f_234,-  color256_f_235,-  color256_f_236,-  color256_f_237,-  color256_f_238,-  color256_f_239,-  color256_f_240,-  color256_f_241,-  color256_f_242,-  color256_f_243,-  color256_f_244,-  color256_f_245,-  color256_f_246,-  color256_f_247,-  color256_f_248,-  color256_f_249,-  color256_f_250,-  color256_f_251,-  color256_f_252,-  color256_f_253,-  color256_f_254,-  color256_f_255,--  -- ** 256 color background colors-  color256_b_default,-  color256_b_0,-  color256_b_1,-  color256_b_2,-  color256_b_3,-  color256_b_4,-  color256_b_5,-  color256_b_6,-  color256_b_7,-  color256_b_8,-  color256_b_9,-  color256_b_10,-  color256_b_11,-  color256_b_12,-  color256_b_13,-  color256_b_14,-  color256_b_15,-  color256_b_16,-  color256_b_17,-  color256_b_18,-  color256_b_19,-  color256_b_20,-  color256_b_21,-  color256_b_22,-  color256_b_23,-  color256_b_24,-  color256_b_25,-  color256_b_26,-  color256_b_27,-  color256_b_28,-  color256_b_29,-  color256_b_30,-  color256_b_31,-  color256_b_32,-  color256_b_33,-  color256_b_34,-  color256_b_35,-  color256_b_36,-  color256_b_37,-  color256_b_38,-  color256_b_39,-  color256_b_40,-  color256_b_41,-  color256_b_42,-  color256_b_43,-  color256_b_44,-  color256_b_45,-  color256_b_46,-  color256_b_47,-  color256_b_48,-  color256_b_49,-  color256_b_50,-  color256_b_51,-  color256_b_52,-  color256_b_53,-  color256_b_54,-  color256_b_55,-  color256_b_56,-  color256_b_57,-  color256_b_58,-  color256_b_59,-  color256_b_60,-  color256_b_61,-  color256_b_62,-  color256_b_63,-  color256_b_64,-  color256_b_65,-  color256_b_66,-  color256_b_67,-  color256_b_68,-  color256_b_69,-  color256_b_70,-  color256_b_71,-  color256_b_72,-  color256_b_73,-  color256_b_74,-  color256_b_75,-  color256_b_76,-  color256_b_77,-  color256_b_78,-  color256_b_79,-  color256_b_80,-  color256_b_81,-  color256_b_82,-  color256_b_83,-  color256_b_84,-  color256_b_85,-  color256_b_86,-  color256_b_87,-  color256_b_88,-  color256_b_89,-  color256_b_90,-  color256_b_91,-  color256_b_92,-  color256_b_93,-  color256_b_94,-  color256_b_95,-  color256_b_96,-  color256_b_97,-  color256_b_98,-  color256_b_99,-  color256_b_100,-  color256_b_101,-  color256_b_102,-  color256_b_103,-  color256_b_104,-  color256_b_105,-  color256_b_106,-  color256_b_107,-  color256_b_108,-  color256_b_109,-  color256_b_110,-  color256_b_111,-  color256_b_112,-  color256_b_113,-  color256_b_114,-  color256_b_115,-  color256_b_116,-  color256_b_117,-  color256_b_118,-  color256_b_119,-  color256_b_120,-  color256_b_121,-  color256_b_122,-  color256_b_123,-  color256_b_124,-  color256_b_125,-  color256_b_126,-  color256_b_127,-  color256_b_128,-  color256_b_129,-  color256_b_130,-  color256_b_131,-  color256_b_132,-  color256_b_133,-  color256_b_134,-  color256_b_135,-  color256_b_136,-  color256_b_137,-  color256_b_138,-  color256_b_139,-  color256_b_140,-  color256_b_141,-  color256_b_142,-  color256_b_143,-  color256_b_144,-  color256_b_145,-  color256_b_146,-  color256_b_147,-  color256_b_148,-  color256_b_149,-  color256_b_150,-  color256_b_151,-  color256_b_152,-  color256_b_153,-  color256_b_154,-  color256_b_155,-  color256_b_156,-  color256_b_157,-  color256_b_158,-  color256_b_159,-  color256_b_160,-  color256_b_161,-  color256_b_162,-  color256_b_163,-  color256_b_164,-  color256_b_165,-  color256_b_166,-  color256_b_167,-  color256_b_168,-  color256_b_169,-  color256_b_170,-  color256_b_171,-  color256_b_172,-  color256_b_173,-  color256_b_174,-  color256_b_175,-  color256_b_176,-  color256_b_177,-  color256_b_178,-  color256_b_179,-  color256_b_180,-  color256_b_181,-  color256_b_182,-  color256_b_183,-  color256_b_184,-  color256_b_185,-  color256_b_186,-  color256_b_187,-  color256_b_188,-  color256_b_189,-  color256_b_190,-  color256_b_191,-  color256_b_192,-  color256_b_193,-  color256_b_194,-  color256_b_195,-  color256_b_196,-  color256_b_197,-  color256_b_198,-  color256_b_199,-  color256_b_200,-  color256_b_201,-  color256_b_202,-  color256_b_203,-  color256_b_204,-  color256_b_205,-  color256_b_206,-  color256_b_207,-  color256_b_208,-  color256_b_209,-  color256_b_210,-  color256_b_211,-  color256_b_212,-  color256_b_213,-  color256_b_214,-  color256_b_215,-  color256_b_216,-  color256_b_217,-  color256_b_218,-  color256_b_219,-  color256_b_220,-  color256_b_221,-  color256_b_222,-  color256_b_223,-  color256_b_224,-  color256_b_225,-  color256_b_226,-  color256_b_227,-  color256_b_228,-  color256_b_229,-  color256_b_230,-  color256_b_231,-  color256_b_232,-  color256_b_233,-  color256_b_234,-  color256_b_235,-  color256_b_236,-  color256_b_237,-  color256_b_238,-  color256_b_239,-  color256_b_240,-  color256_b_241,-  color256_b_242,-  color256_b_243,-  color256_b_244,-  color256_b_245,-  color256_b_246,-  color256_b_247,-  color256_b_248,-  color256_b_249,-  color256_b_250,-  color256_b_251,-  color256_b_252,-  color256_b_253,-  color256_b_254,-  color256_b_255--  ) where---import Data.Monoid (Monoid, mempty, mappend, mconcat)-import Data.Text (Text)-import Data.Maybe (fromMaybe)-import qualified Data.Text as X-import qualified System.Console.Terminfo as T------- Colors------- | Which terminal definition to use.-data Term-  = Dumb-  -- ^ Using this terminal should always succeed. This suppresses all-  -- colors. Uesful if output is not going to a TTY, or if you just do-  -- not like colors.--  | TermName String-  -- ^ Use the terminal with this given name. You might get this from-  -- the TERM environment variable, or set it explicitly. A runtime-  -- error will result if the terminfo database does not have a-  -- definition for this terminal. If this terminal supports 256-  -- colors, then 256 colors are used. If this terminal supports less-  -- than 256 colors, but at least 8 colors, then 8 colors are-  -- used. Otherwise, no colors are used.-  deriving (Eq, Show)----- For Background8, Background256, Foreground8, Foreground256: the--- newtype wraps a Terminfo Color. If Nothing, use the default color.---- | Background color in an 8 color setting.-newtype Background8 = Background8 { unBackground8 :: Maybe T.Color }-  deriving (Eq, Show, Ord)---- | Background color in a 256 color setting.-newtype Background256 = Background256 { unBackground256 :: Maybe T.Color }-  deriving (Eq, Show, Ord)---- | Foreground color in an 8 color setting.-newtype Foreground8 = Foreground8 { unForeground8 :: Maybe T.Color }-  deriving (Eq, Show, Ord)---- | Foreground color in a 256 color setting.-newtype Foreground256 = Foreground256 { unForeground256 :: Maybe T.Color }-  deriving (Eq, Show, Ord)-------- Chunks------- | A chunk is some textual data coupled with a description of what--- color the text is, attributes like whether it is bold or--- underlined, etc. The chunk knows what foreground and background--- colors and what attributes to use for both an 8 color terminal and--- a 256 color terminal. To change these attributes and colors, you--- must make a new chunk.------ There is no way to combine chunks. To print large numbers of--- chunks, lazily build a list of them and then print them using--- 'printChunks'.--data Chunk = Chunk-  { chunkTextSpec :: TextSpec-  , chunkText :: Text-  } deriving (Eq, Show, Ord)---- | Makes new Chunks.-chunk :: TextSpec -> Text -> Chunk-chunk = Chunk---- | How wide the text of a chunk is.-newtype Width = Width { unWidth :: Int }-                deriving (Show, Eq, Ord)--instance Monoid Width where-  mempty = Width 0-  mappend (Width w1) (Width w2) = Width $ w1 + w2--chunkWidth :: Chunk -> Width-chunkWidth (Chunk _ t) = Width . X.length $ t---- | Sends a list of chunks to standard output for printing. Sets up--- the terminal (this only needs to be done once.) Lazily processes--- the list of Chunk.-printChunks :: Term -> [Chunk] -> IO ()-printChunks t cs = do-  let setup = case t of-        Dumb -> T.setupTerm "dumb"-        TermName s -> T.setupTerm s-  term <- setup-  mapM_ (printChunk term) cs-  T.runTermOutput term (defaultColors term)-  T.runTermOutput term-    $ case T.getCapability term T.allAttributesOff of-        Nothing -> error $ "Penny.Steel.Chunk.printChunks: error: "-                   ++ "allAttributesOff failed"-        Just s -> s--printChunk :: T.Terminal -> Chunk -> IO ()-printChunk t (Chunk ts x) =-  T.runTermOutput t-  . mconcat-  $ [defaultColors t, codes, txt]-  where-    codes = getTermCodes t ts-    txt = T.termText . X.unpack $ x--defaultColors :: T.Terminal -> T.TermOutput-defaultColors term =-  fromMaybe mempty (T.getCapability term T.restoreDefaultColors)------- Effects----newtype Bold = Bold { unBold :: Bool }-  deriving (Show, Eq, Ord)--newtype Underline = Underline { unUnderline :: Bool }-  deriving (Show, Eq, Ord)--newtype Flash = Flash { unFlash :: Bool }-  deriving (Show, Eq, Ord)--newtype Inverse = Inverse { unInverse :: Bool }-  deriving (Show, Eq, Ord)------- Styles------- | Style elements that apply in both 8 and 256 color--- terminals. However, the elements are described separately for 8 and--- 256 color terminals, so that the text appearance can change--- depending on how many colors a terminal has.-data StyleCommon = StyleCommon-  { bold :: Bold-  , underline :: Underline-  , flash :: Flash-  , inverse :: Inverse-  } deriving (Show, Eq, Ord)---- | Describes text appearance (foreground and background colors, as--- well as other attributes such as bold) for an 8 color terminal.-data Style8 = Style8-  { foreground8 :: Foreground8-  , background8 :: Background8-  , common8 :: StyleCommon-  } deriving (Show, Eq, Ord)---- | Describes text appearance (foreground and background colors, as--- well as other attributes such as bold) for a 256 color terminal.-data Style256 = Style256-  { foreground256 :: Foreground256-  , background256 :: Background256-  , common256 :: StyleCommon-  } deriving (Show, Eq, Ord)---- | Has all bold, flash, underline, and inverse turned off.-defaultStyleCommon :: StyleCommon-defaultStyleCommon = StyleCommon-  { bold = Bold False-  , underline = Underline False-  , flash = Flash False-  , inverse = Inverse False-  }---- | Uses the default terminal colors (which will vary depending on--- the terminal).-defaultStyle8 :: Style8-defaultStyle8 = Style8-  { foreground8 = color8_f_default-  , background8 = color8_b_default-  , common8 = defaultStyleCommon-  }---- | Uses the default terminal colors (which will vary depending on--- the terminal).-defaultStyle256 :: Style256-defaultStyle256 = Style256-  { foreground256 = color256_f_default-  , background256 = color256_b_default-  , common256 = defaultStyleCommon-  }------- TextSpec------- | The TextSpec bundles together the styles for the 8 and 256 color--- terminals, so that the text can be portrayed on any terminal.-data TextSpec = TextSpec-  { style8 :: Style8-  , style256 :: Style256-  } deriving (Show, Eq, Ord)---- | A TextSpec with the default colors on 8 and 256 color terminals,--- with all attributes turned off.-defaultTextSpec :: TextSpec-defaultTextSpec = TextSpec-  { style8 = defaultStyle8-  , style256 = defaultStyle256-  }------- Internal-----commonAttrs :: T.Terminal -> StyleCommon -> T.TermOutput-commonAttrs t s =-  let a = T.Attributes-        { T.standoutAttr = False-        , T.underlineAttr = unUnderline . underline $ s-        , T.reverseAttr = unInverse . inverse $ s-        , T.blinkAttr = unFlash . flash $ s-        , T.dimAttr = False-        , T.boldAttr = unBold . bold $ s-        , T.invisibleAttr = False-        , T.protectedAttr = False-        }-  in case T.getCapability t (T.setAttributes) of-      Nothing -> error $ "Penny.Steel.Chunk: commonAttrs: "-                 ++ "capability failed; should never happen"-      Just f -> f a----- | Gets the right set of terminal codes to apply the desired--- highlighting, bold, underlining, etc. Be sure to apply the--- attributes first (bold, underlining, etc) and then the--- colors. Setting the colors first and then the attributes seems to--- reset the colors, giving blank output.-getTermCodes-  :: T.Terminal-  -> TextSpec-  -> T.TermOutput-getTermCodes t ts = fromMaybe mempty $ do-  cols <- T.getCapability t T.termColors-  let TextSpec s8 s256 = ts-      Style8 f8 b8 c8 = s8-      Style256 f256 b256 c256 = s256-  setFg <- T.getCapability t T.setForegroundColor-  setBg <- T.getCapability t T.setBackgroundColor-  (fg, bg, cm) <- case () of-    _ | cols >= 256 -> Just $ ( unForeground256 f256-                              , unBackground256 b256-                              , c256 )-      | cols >= 8 -> Just ( unForeground8 f8-                         , unBackground8 b8-                         , c8)-      | otherwise -> Nothing-  let oFg = maybe mempty setFg fg-      oBg = maybe mempty setBg bg-      oCm = commonAttrs t cm-  return $ mconcat [oCm, oFg, oBg]-------- Color basement----color8_f_default :: Foreground8-color8_f_default = Foreground8 Nothing--color8_f_black :: Foreground8-color8_f_black = Foreground8 $ Just T.Black--color8_f_red :: Foreground8-color8_f_red = Foreground8 $ Just T.Red--color8_f_green :: Foreground8-color8_f_green = Foreground8 $ Just T.Green--color8_f_yellow :: Foreground8-color8_f_yellow = Foreground8 $ Just T.Yellow--color8_f_blue :: Foreground8-color8_f_blue = Foreground8 $ Just T.Blue--color8_f_magenta :: Foreground8-color8_f_magenta = Foreground8 $ Just T.Magenta--color8_f_cyan :: Foreground8-color8_f_cyan = Foreground8 $ Just T.Cyan--color8_f_white :: Foreground8-color8_f_white = Foreground8 $ Just T.White--color8_b_default :: Background8-color8_b_default = Background8 Nothing--color8_b_black :: Background8-color8_b_black = Background8 $ Just T.Black--color8_b_red :: Background8-color8_b_red = Background8 $ Just T.Red--color8_b_green :: Background8-color8_b_green = Background8 $ Just T.Green--color8_b_yellow :: Background8-color8_b_yellow = Background8 $ Just T.Yellow--color8_b_blue :: Background8-color8_b_blue = Background8 $ Just T.Blue--color8_b_magenta :: Background8-color8_b_magenta = Background8 $ Just T.Magenta--color8_b_cyan :: Background8-color8_b_cyan = Background8 $ Just T.Cyan--color8_b_white :: Background8-color8_b_white = Background8 $ Just T.White--color256_f_default :: Foreground256-color256_f_default = Foreground256 Nothing--color256_f_0 :: Foreground256-color256_f_0 = Foreground256 (Just (T.ColorNumber 0))--color256_f_1 :: Foreground256-color256_f_1 = Foreground256 (Just (T.ColorNumber 1))--color256_f_2 :: Foreground256-color256_f_2 = Foreground256 (Just (T.ColorNumber 2))--color256_f_3 :: Foreground256-color256_f_3 = Foreground256 (Just (T.ColorNumber 3))--color256_f_4 :: Foreground256-color256_f_4 = Foreground256 (Just (T.ColorNumber 4))--color256_f_5 :: Foreground256-color256_f_5 = Foreground256 (Just (T.ColorNumber 5))--color256_f_6 :: Foreground256-color256_f_6 = Foreground256 (Just (T.ColorNumber 6))--color256_f_7 :: Foreground256-color256_f_7 = Foreground256 (Just (T.ColorNumber 7))--color256_f_8 :: Foreground256-color256_f_8 = Foreground256 (Just (T.ColorNumber 8))--color256_f_9 :: Foreground256-color256_f_9 = Foreground256 (Just (T.ColorNumber 9))--color256_f_10 :: Foreground256-color256_f_10 = Foreground256 (Just (T.ColorNumber 10))--color256_f_11 :: Foreground256-color256_f_11 = Foreground256 (Just (T.ColorNumber 11))--color256_f_12 :: Foreground256-color256_f_12 = Foreground256 (Just (T.ColorNumber 12))--color256_f_13 :: Foreground256-color256_f_13 = Foreground256 (Just (T.ColorNumber 13))--color256_f_14 :: Foreground256-color256_f_14 = Foreground256 (Just (T.ColorNumber 14))--color256_f_15 :: Foreground256-color256_f_15 = Foreground256 (Just (T.ColorNumber 15))--color256_f_16 :: Foreground256-color256_f_16 = Foreground256 (Just (T.ColorNumber 16))--color256_f_17 :: Foreground256-color256_f_17 = Foreground256 (Just (T.ColorNumber 17))--color256_f_18 :: Foreground256-color256_f_18 = Foreground256 (Just (T.ColorNumber 18))--color256_f_19 :: Foreground256-color256_f_19 = Foreground256 (Just (T.ColorNumber 19))--color256_f_20 :: Foreground256-color256_f_20 = Foreground256 (Just (T.ColorNumber 20))--color256_f_21 :: Foreground256-color256_f_21 = Foreground256 (Just (T.ColorNumber 21))--color256_f_22 :: Foreground256-color256_f_22 = Foreground256 (Just (T.ColorNumber 22))--color256_f_23 :: Foreground256-color256_f_23 = Foreground256 (Just (T.ColorNumber 23))--color256_f_24 :: Foreground256-color256_f_24 = Foreground256 (Just (T.ColorNumber 24))--color256_f_25 :: Foreground256-color256_f_25 = Foreground256 (Just (T.ColorNumber 25))--color256_f_26 :: Foreground256-color256_f_26 = Foreground256 (Just (T.ColorNumber 26))--color256_f_27 :: Foreground256-color256_f_27 = Foreground256 (Just (T.ColorNumber 27))--color256_f_28 :: Foreground256-color256_f_28 = Foreground256 (Just (T.ColorNumber 28))--color256_f_29 :: Foreground256-color256_f_29 = Foreground256 (Just (T.ColorNumber 29))--color256_f_30 :: Foreground256-color256_f_30 = Foreground256 (Just (T.ColorNumber 30))--color256_f_31 :: Foreground256-color256_f_31 = Foreground256 (Just (T.ColorNumber 31))--color256_f_32 :: Foreground256-color256_f_32 = Foreground256 (Just (T.ColorNumber 32))--color256_f_33 :: Foreground256-color256_f_33 = Foreground256 (Just (T.ColorNumber 33))--color256_f_34 :: Foreground256-color256_f_34 = Foreground256 (Just (T.ColorNumber 34))--color256_f_35 :: Foreground256-color256_f_35 = Foreground256 (Just (T.ColorNumber 35))--color256_f_36 :: Foreground256-color256_f_36 = Foreground256 (Just (T.ColorNumber 36))--color256_f_37 :: Foreground256-color256_f_37 = Foreground256 (Just (T.ColorNumber 37))--color256_f_38 :: Foreground256-color256_f_38 = Foreground256 (Just (T.ColorNumber 38))--color256_f_39 :: Foreground256-color256_f_39 = Foreground256 (Just (T.ColorNumber 39))--color256_f_40 :: Foreground256-color256_f_40 = Foreground256 (Just (T.ColorNumber 40))--color256_f_41 :: Foreground256-color256_f_41 = Foreground256 (Just (T.ColorNumber 41))--color256_f_42 :: Foreground256-color256_f_42 = Foreground256 (Just (T.ColorNumber 42))--color256_f_43 :: Foreground256-color256_f_43 = Foreground256 (Just (T.ColorNumber 43))--color256_f_44 :: Foreground256-color256_f_44 = Foreground256 (Just (T.ColorNumber 44))--color256_f_45 :: Foreground256-color256_f_45 = Foreground256 (Just (T.ColorNumber 45))--color256_f_46 :: Foreground256-color256_f_46 = Foreground256 (Just (T.ColorNumber 46))--color256_f_47 :: Foreground256-color256_f_47 = Foreground256 (Just (T.ColorNumber 47))--color256_f_48 :: Foreground256-color256_f_48 = Foreground256 (Just (T.ColorNumber 48))--color256_f_49 :: Foreground256-color256_f_49 = Foreground256 (Just (T.ColorNumber 49))--color256_f_50 :: Foreground256-color256_f_50 = Foreground256 (Just (T.ColorNumber 50))--color256_f_51 :: Foreground256-color256_f_51 = Foreground256 (Just (T.ColorNumber 51))--color256_f_52 :: Foreground256-color256_f_52 = Foreground256 (Just (T.ColorNumber 52))--color256_f_53 :: Foreground256-color256_f_53 = Foreground256 (Just (T.ColorNumber 53))--color256_f_54 :: Foreground256-color256_f_54 = Foreground256 (Just (T.ColorNumber 54))--color256_f_55 :: Foreground256-color256_f_55 = Foreground256 (Just (T.ColorNumber 55))--color256_f_56 :: Foreground256-color256_f_56 = Foreground256 (Just (T.ColorNumber 56))--color256_f_57 :: Foreground256-color256_f_57 = Foreground256 (Just (T.ColorNumber 57))--color256_f_58 :: Foreground256-color256_f_58 = Foreground256 (Just (T.ColorNumber 58))--color256_f_59 :: Foreground256-color256_f_59 = Foreground256 (Just (T.ColorNumber 59))--color256_f_60 :: Foreground256-color256_f_60 = Foreground256 (Just (T.ColorNumber 60))--color256_f_61 :: Foreground256-color256_f_61 = Foreground256 (Just (T.ColorNumber 61))--color256_f_62 :: Foreground256-color256_f_62 = Foreground256 (Just (T.ColorNumber 62))--color256_f_63 :: Foreground256-color256_f_63 = Foreground256 (Just (T.ColorNumber 63))--color256_f_64 :: Foreground256-color256_f_64 = Foreground256 (Just (T.ColorNumber 64))--color256_f_65 :: Foreground256-color256_f_65 = Foreground256 (Just (T.ColorNumber 65))--color256_f_66 :: Foreground256-color256_f_66 = Foreground256 (Just (T.ColorNumber 66))--color256_f_67 :: Foreground256-color256_f_67 = Foreground256 (Just (T.ColorNumber 67))--color256_f_68 :: Foreground256-color256_f_68 = Foreground256 (Just (T.ColorNumber 68))--color256_f_69 :: Foreground256-color256_f_69 = Foreground256 (Just (T.ColorNumber 69))--color256_f_70 :: Foreground256-color256_f_70 = Foreground256 (Just (T.ColorNumber 70))--color256_f_71 :: Foreground256-color256_f_71 = Foreground256 (Just (T.ColorNumber 71))--color256_f_72 :: Foreground256-color256_f_72 = Foreground256 (Just (T.ColorNumber 72))--color256_f_73 :: Foreground256-color256_f_73 = Foreground256 (Just (T.ColorNumber 73))--color256_f_74 :: Foreground256-color256_f_74 = Foreground256 (Just (T.ColorNumber 74))--color256_f_75 :: Foreground256-color256_f_75 = Foreground256 (Just (T.ColorNumber 75))--color256_f_76 :: Foreground256-color256_f_76 = Foreground256 (Just (T.ColorNumber 76))--color256_f_77 :: Foreground256-color256_f_77 = Foreground256 (Just (T.ColorNumber 77))--color256_f_78 :: Foreground256-color256_f_78 = Foreground256 (Just (T.ColorNumber 78))--color256_f_79 :: Foreground256-color256_f_79 = Foreground256 (Just (T.ColorNumber 79))--color256_f_80 :: Foreground256-color256_f_80 = Foreground256 (Just (T.ColorNumber 80))--color256_f_81 :: Foreground256-color256_f_81 = Foreground256 (Just (T.ColorNumber 81))--color256_f_82 :: Foreground256-color256_f_82 = Foreground256 (Just (T.ColorNumber 82))--color256_f_83 :: Foreground256-color256_f_83 = Foreground256 (Just (T.ColorNumber 83))--color256_f_84 :: Foreground256-color256_f_84 = Foreground256 (Just (T.ColorNumber 84))--color256_f_85 :: Foreground256-color256_f_85 = Foreground256 (Just (T.ColorNumber 85))--color256_f_86 :: Foreground256-color256_f_86 = Foreground256 (Just (T.ColorNumber 86))--color256_f_87 :: Foreground256-color256_f_87 = Foreground256 (Just (T.ColorNumber 87))--color256_f_88 :: Foreground256-color256_f_88 = Foreground256 (Just (T.ColorNumber 88))--color256_f_89 :: Foreground256-color256_f_89 = Foreground256 (Just (T.ColorNumber 89))--color256_f_90 :: Foreground256-color256_f_90 = Foreground256 (Just (T.ColorNumber 90))--color256_f_91 :: Foreground256-color256_f_91 = Foreground256 (Just (T.ColorNumber 91))--color256_f_92 :: Foreground256-color256_f_92 = Foreground256 (Just (T.ColorNumber 92))--color256_f_93 :: Foreground256-color256_f_93 = Foreground256 (Just (T.ColorNumber 93))--color256_f_94 :: Foreground256-color256_f_94 = Foreground256 (Just (T.ColorNumber 94))--color256_f_95 :: Foreground256-color256_f_95 = Foreground256 (Just (T.ColorNumber 95))--color256_f_96 :: Foreground256-color256_f_96 = Foreground256 (Just (T.ColorNumber 96))--color256_f_97 :: Foreground256-color256_f_97 = Foreground256 (Just (T.ColorNumber 97))--color256_f_98 :: Foreground256-color256_f_98 = Foreground256 (Just (T.ColorNumber 98))--color256_f_99 :: Foreground256-color256_f_99 = Foreground256 (Just (T.ColorNumber 99))--color256_f_100 :: Foreground256-color256_f_100 = Foreground256 (Just (T.ColorNumber 100))--color256_f_101 :: Foreground256-color256_f_101 = Foreground256 (Just (T.ColorNumber 101))--color256_f_102 :: Foreground256-color256_f_102 = Foreground256 (Just (T.ColorNumber 102))--color256_f_103 :: Foreground256-color256_f_103 = Foreground256 (Just (T.ColorNumber 103))--color256_f_104 :: Foreground256-color256_f_104 = Foreground256 (Just (T.ColorNumber 104))--color256_f_105 :: Foreground256-color256_f_105 = Foreground256 (Just (T.ColorNumber 105))--color256_f_106 :: Foreground256-color256_f_106 = Foreground256 (Just (T.ColorNumber 106))--color256_f_107 :: Foreground256-color256_f_107 = Foreground256 (Just (T.ColorNumber 107))--color256_f_108 :: Foreground256-color256_f_108 = Foreground256 (Just (T.ColorNumber 108))--color256_f_109 :: Foreground256-color256_f_109 = Foreground256 (Just (T.ColorNumber 109))--color256_f_110 :: Foreground256-color256_f_110 = Foreground256 (Just (T.ColorNumber 110))--color256_f_111 :: Foreground256-color256_f_111 = Foreground256 (Just (T.ColorNumber 111))--color256_f_112 :: Foreground256-color256_f_112 = Foreground256 (Just (T.ColorNumber 112))--color256_f_113 :: Foreground256-color256_f_113 = Foreground256 (Just (T.ColorNumber 113))--color256_f_114 :: Foreground256-color256_f_114 = Foreground256 (Just (T.ColorNumber 114))--color256_f_115 :: Foreground256-color256_f_115 = Foreground256 (Just (T.ColorNumber 115))--color256_f_116 :: Foreground256-color256_f_116 = Foreground256 (Just (T.ColorNumber 116))--color256_f_117 :: Foreground256-color256_f_117 = Foreground256 (Just (T.ColorNumber 117))--color256_f_118 :: Foreground256-color256_f_118 = Foreground256 (Just (T.ColorNumber 118))--color256_f_119 :: Foreground256-color256_f_119 = Foreground256 (Just (T.ColorNumber 119))--color256_f_120 :: Foreground256-color256_f_120 = Foreground256 (Just (T.ColorNumber 120))--color256_f_121 :: Foreground256-color256_f_121 = Foreground256 (Just (T.ColorNumber 121))--color256_f_122 :: Foreground256-color256_f_122 = Foreground256 (Just (T.ColorNumber 122))--color256_f_123 :: Foreground256-color256_f_123 = Foreground256 (Just (T.ColorNumber 123))--color256_f_124 :: Foreground256-color256_f_124 = Foreground256 (Just (T.ColorNumber 124))--color256_f_125 :: Foreground256-color256_f_125 = Foreground256 (Just (T.ColorNumber 125))--color256_f_126 :: Foreground256-color256_f_126 = Foreground256 (Just (T.ColorNumber 126))--color256_f_127 :: Foreground256-color256_f_127 = Foreground256 (Just (T.ColorNumber 127))--color256_f_128 :: Foreground256-color256_f_128 = Foreground256 (Just (T.ColorNumber 128))--color256_f_129 :: Foreground256-color256_f_129 = Foreground256 (Just (T.ColorNumber 129))--color256_f_130 :: Foreground256-color256_f_130 = Foreground256 (Just (T.ColorNumber 130))--color256_f_131 :: Foreground256-color256_f_131 = Foreground256 (Just (T.ColorNumber 131))--color256_f_132 :: Foreground256-color256_f_132 = Foreground256 (Just (T.ColorNumber 132))--color256_f_133 :: Foreground256-color256_f_133 = Foreground256 (Just (T.ColorNumber 133))--color256_f_134 :: Foreground256-color256_f_134 = Foreground256 (Just (T.ColorNumber 134))--color256_f_135 :: Foreground256-color256_f_135 = Foreground256 (Just (T.ColorNumber 135))--color256_f_136 :: Foreground256-color256_f_136 = Foreground256 (Just (T.ColorNumber 136))--color256_f_137 :: Foreground256-color256_f_137 = Foreground256 (Just (T.ColorNumber 137))--color256_f_138 :: Foreground256-color256_f_138 = Foreground256 (Just (T.ColorNumber 138))--color256_f_139 :: Foreground256-color256_f_139 = Foreground256 (Just (T.ColorNumber 139))--color256_f_140 :: Foreground256-color256_f_140 = Foreground256 (Just (T.ColorNumber 140))--color256_f_141 :: Foreground256-color256_f_141 = Foreground256 (Just (T.ColorNumber 141))--color256_f_142 :: Foreground256-color256_f_142 = Foreground256 (Just (T.ColorNumber 142))--color256_f_143 :: Foreground256-color256_f_143 = Foreground256 (Just (T.ColorNumber 143))--color256_f_144 :: Foreground256-color256_f_144 = Foreground256 (Just (T.ColorNumber 144))--color256_f_145 :: Foreground256-color256_f_145 = Foreground256 (Just (T.ColorNumber 145))--color256_f_146 :: Foreground256-color256_f_146 = Foreground256 (Just (T.ColorNumber 146))--color256_f_147 :: Foreground256-color256_f_147 = Foreground256 (Just (T.ColorNumber 147))--color256_f_148 :: Foreground256-color256_f_148 = Foreground256 (Just (T.ColorNumber 148))--color256_f_149 :: Foreground256-color256_f_149 = Foreground256 (Just (T.ColorNumber 149))--color256_f_150 :: Foreground256-color256_f_150 = Foreground256 (Just (T.ColorNumber 150))--color256_f_151 :: Foreground256-color256_f_151 = Foreground256 (Just (T.ColorNumber 151))--color256_f_152 :: Foreground256-color256_f_152 = Foreground256 (Just (T.ColorNumber 152))--color256_f_153 :: Foreground256-color256_f_153 = Foreground256 (Just (T.ColorNumber 153))--color256_f_154 :: Foreground256-color256_f_154 = Foreground256 (Just (T.ColorNumber 154))--color256_f_155 :: Foreground256-color256_f_155 = Foreground256 (Just (T.ColorNumber 155))--color256_f_156 :: Foreground256-color256_f_156 = Foreground256 (Just (T.ColorNumber 156))--color256_f_157 :: Foreground256-color256_f_157 = Foreground256 (Just (T.ColorNumber 157))--color256_f_158 :: Foreground256-color256_f_158 = Foreground256 (Just (T.ColorNumber 158))--color256_f_159 :: Foreground256-color256_f_159 = Foreground256 (Just (T.ColorNumber 159))--color256_f_160 :: Foreground256-color256_f_160 = Foreground256 (Just (T.ColorNumber 160))--color256_f_161 :: Foreground256-color256_f_161 = Foreground256 (Just (T.ColorNumber 161))--color256_f_162 :: Foreground256-color256_f_162 = Foreground256 (Just (T.ColorNumber 162))--color256_f_163 :: Foreground256-color256_f_163 = Foreground256 (Just (T.ColorNumber 163))--color256_f_164 :: Foreground256-color256_f_164 = Foreground256 (Just (T.ColorNumber 164))--color256_f_165 :: Foreground256-color256_f_165 = Foreground256 (Just (T.ColorNumber 165))--color256_f_166 :: Foreground256-color256_f_166 = Foreground256 (Just (T.ColorNumber 166))--color256_f_167 :: Foreground256-color256_f_167 = Foreground256 (Just (T.ColorNumber 167))--color256_f_168 :: Foreground256-color256_f_168 = Foreground256 (Just (T.ColorNumber 168))--color256_f_169 :: Foreground256-color256_f_169 = Foreground256 (Just (T.ColorNumber 169))--color256_f_170 :: Foreground256-color256_f_170 = Foreground256 (Just (T.ColorNumber 170))--color256_f_171 :: Foreground256-color256_f_171 = Foreground256 (Just (T.ColorNumber 171))--color256_f_172 :: Foreground256-color256_f_172 = Foreground256 (Just (T.ColorNumber 172))--color256_f_173 :: Foreground256-color256_f_173 = Foreground256 (Just (T.ColorNumber 173))--color256_f_174 :: Foreground256-color256_f_174 = Foreground256 (Just (T.ColorNumber 174))--color256_f_175 :: Foreground256-color256_f_175 = Foreground256 (Just (T.ColorNumber 175))--color256_f_176 :: Foreground256-color256_f_176 = Foreground256 (Just (T.ColorNumber 176))--color256_f_177 :: Foreground256-color256_f_177 = Foreground256 (Just (T.ColorNumber 177))--color256_f_178 :: Foreground256-color256_f_178 = Foreground256 (Just (T.ColorNumber 178))--color256_f_179 :: Foreground256-color256_f_179 = Foreground256 (Just (T.ColorNumber 179))--color256_f_180 :: Foreground256-color256_f_180 = Foreground256 (Just (T.ColorNumber 180))--color256_f_181 :: Foreground256-color256_f_181 = Foreground256 (Just (T.ColorNumber 181))--color256_f_182 :: Foreground256-color256_f_182 = Foreground256 (Just (T.ColorNumber 182))--color256_f_183 :: Foreground256-color256_f_183 = Foreground256 (Just (T.ColorNumber 183))--color256_f_184 :: Foreground256-color256_f_184 = Foreground256 (Just (T.ColorNumber 184))--color256_f_185 :: Foreground256-color256_f_185 = Foreground256 (Just (T.ColorNumber 185))--color256_f_186 :: Foreground256-color256_f_186 = Foreground256 (Just (T.ColorNumber 186))--color256_f_187 :: Foreground256-color256_f_187 = Foreground256 (Just (T.ColorNumber 187))--color256_f_188 :: Foreground256-color256_f_188 = Foreground256 (Just (T.ColorNumber 188))--color256_f_189 :: Foreground256-color256_f_189 = Foreground256 (Just (T.ColorNumber 189))--color256_f_190 :: Foreground256-color256_f_190 = Foreground256 (Just (T.ColorNumber 190))--color256_f_191 :: Foreground256-color256_f_191 = Foreground256 (Just (T.ColorNumber 191))--color256_f_192 :: Foreground256-color256_f_192 = Foreground256 (Just (T.ColorNumber 192))--color256_f_193 :: Foreground256-color256_f_193 = Foreground256 (Just (T.ColorNumber 193))--color256_f_194 :: Foreground256-color256_f_194 = Foreground256 (Just (T.ColorNumber 194))--color256_f_195 :: Foreground256-color256_f_195 = Foreground256 (Just (T.ColorNumber 195))--color256_f_196 :: Foreground256-color256_f_196 = Foreground256 (Just (T.ColorNumber 196))--color256_f_197 :: Foreground256-color256_f_197 = Foreground256 (Just (T.ColorNumber 197))--color256_f_198 :: Foreground256-color256_f_198 = Foreground256 (Just (T.ColorNumber 198))--color256_f_199 :: Foreground256-color256_f_199 = Foreground256 (Just (T.ColorNumber 199))--color256_f_200 :: Foreground256-color256_f_200 = Foreground256 (Just (T.ColorNumber 200))--color256_f_201 :: Foreground256-color256_f_201 = Foreground256 (Just (T.ColorNumber 201))--color256_f_202 :: Foreground256-color256_f_202 = Foreground256 (Just (T.ColorNumber 202))--color256_f_203 :: Foreground256-color256_f_203 = Foreground256 (Just (T.ColorNumber 203))--color256_f_204 :: Foreground256-color256_f_204 = Foreground256 (Just (T.ColorNumber 204))--color256_f_205 :: Foreground256-color256_f_205 = Foreground256 (Just (T.ColorNumber 205))--color256_f_206 :: Foreground256-color256_f_206 = Foreground256 (Just (T.ColorNumber 206))--color256_f_207 :: Foreground256-color256_f_207 = Foreground256 (Just (T.ColorNumber 207))--color256_f_208 :: Foreground256-color256_f_208 = Foreground256 (Just (T.ColorNumber 208))--color256_f_209 :: Foreground256-color256_f_209 = Foreground256 (Just (T.ColorNumber 209))--color256_f_210 :: Foreground256-color256_f_210 = Foreground256 (Just (T.ColorNumber 210))--color256_f_211 :: Foreground256-color256_f_211 = Foreground256 (Just (T.ColorNumber 211))--color256_f_212 :: Foreground256-color256_f_212 = Foreground256 (Just (T.ColorNumber 212))--color256_f_213 :: Foreground256-color256_f_213 = Foreground256 (Just (T.ColorNumber 213))--color256_f_214 :: Foreground256-color256_f_214 = Foreground256 (Just (T.ColorNumber 214))--color256_f_215 :: Foreground256-color256_f_215 = Foreground256 (Just (T.ColorNumber 215))--color256_f_216 :: Foreground256-color256_f_216 = Foreground256 (Just (T.ColorNumber 216))--color256_f_217 :: Foreground256-color256_f_217 = Foreground256 (Just (T.ColorNumber 217))--color256_f_218 :: Foreground256-color256_f_218 = Foreground256 (Just (T.ColorNumber 218))--color256_f_219 :: Foreground256-color256_f_219 = Foreground256 (Just (T.ColorNumber 219))--color256_f_220 :: Foreground256-color256_f_220 = Foreground256 (Just (T.ColorNumber 220))--color256_f_221 :: Foreground256-color256_f_221 = Foreground256 (Just (T.ColorNumber 221))--color256_f_222 :: Foreground256-color256_f_222 = Foreground256 (Just (T.ColorNumber 222))--color256_f_223 :: Foreground256-color256_f_223 = Foreground256 (Just (T.ColorNumber 223))--color256_f_224 :: Foreground256-color256_f_224 = Foreground256 (Just (T.ColorNumber 224))--color256_f_225 :: Foreground256-color256_f_225 = Foreground256 (Just (T.ColorNumber 225))--color256_f_226 :: Foreground256-color256_f_226 = Foreground256 (Just (T.ColorNumber 226))--color256_f_227 :: Foreground256-color256_f_227 = Foreground256 (Just (T.ColorNumber 227))--color256_f_228 :: Foreground256-color256_f_228 = Foreground256 (Just (T.ColorNumber 228))--color256_f_229 :: Foreground256-color256_f_229 = Foreground256 (Just (T.ColorNumber 229))--color256_f_230 :: Foreground256-color256_f_230 = Foreground256 (Just (T.ColorNumber 230))--color256_f_231 :: Foreground256-color256_f_231 = Foreground256 (Just (T.ColorNumber 231))--color256_f_232 :: Foreground256-color256_f_232 = Foreground256 (Just (T.ColorNumber 232))--color256_f_233 :: Foreground256-color256_f_233 = Foreground256 (Just (T.ColorNumber 233))--color256_f_234 :: Foreground256-color256_f_234 = Foreground256 (Just (T.ColorNumber 234))--color256_f_235 :: Foreground256-color256_f_235 = Foreground256 (Just (T.ColorNumber 235))--color256_f_236 :: Foreground256-color256_f_236 = Foreground256 (Just (T.ColorNumber 236))--color256_f_237 :: Foreground256-color256_f_237 = Foreground256 (Just (T.ColorNumber 237))--color256_f_238 :: Foreground256-color256_f_238 = Foreground256 (Just (T.ColorNumber 238))--color256_f_239 :: Foreground256-color256_f_239 = Foreground256 (Just (T.ColorNumber 239))--color256_f_240 :: Foreground256-color256_f_240 = Foreground256 (Just (T.ColorNumber 240))--color256_f_241 :: Foreground256-color256_f_241 = Foreground256 (Just (T.ColorNumber 241))--color256_f_242 :: Foreground256-color256_f_242 = Foreground256 (Just (T.ColorNumber 242))--color256_f_243 :: Foreground256-color256_f_243 = Foreground256 (Just (T.ColorNumber 243))--color256_f_244 :: Foreground256-color256_f_244 = Foreground256 (Just (T.ColorNumber 244))--color256_f_245 :: Foreground256-color256_f_245 = Foreground256 (Just (T.ColorNumber 245))--color256_f_246 :: Foreground256-color256_f_246 = Foreground256 (Just (T.ColorNumber 246))--color256_f_247 :: Foreground256-color256_f_247 = Foreground256 (Just (T.ColorNumber 247))--color256_f_248 :: Foreground256-color256_f_248 = Foreground256 (Just (T.ColorNumber 248))--color256_f_249 :: Foreground256-color256_f_249 = Foreground256 (Just (T.ColorNumber 249))--color256_f_250 :: Foreground256-color256_f_250 = Foreground256 (Just (T.ColorNumber 250))--color256_f_251 :: Foreground256-color256_f_251 = Foreground256 (Just (T.ColorNumber 251))--color256_f_252 :: Foreground256-color256_f_252 = Foreground256 (Just (T.ColorNumber 252))--color256_f_253 :: Foreground256-color256_f_253 = Foreground256 (Just (T.ColorNumber 253))--color256_f_254 :: Foreground256-color256_f_254 = Foreground256 (Just (T.ColorNumber 254))--color256_f_255 :: Foreground256-color256_f_255 = Foreground256 (Just (T.ColorNumber 255))--color256_b_default :: Background256-color256_b_default = Background256 Nothing--color256_b_0 :: Background256-color256_b_0 = Background256 (Just (T.ColorNumber 0))--color256_b_1 :: Background256-color256_b_1 = Background256 (Just (T.ColorNumber 1))--color256_b_2 :: Background256-color256_b_2 = Background256 (Just (T.ColorNumber 2))--color256_b_3 :: Background256-color256_b_3 = Background256 (Just (T.ColorNumber 3))--color256_b_4 :: Background256-color256_b_4 = Background256 (Just (T.ColorNumber 4))--color256_b_5 :: Background256-color256_b_5 = Background256 (Just (T.ColorNumber 5))--color256_b_6 :: Background256-color256_b_6 = Background256 (Just (T.ColorNumber 6))--color256_b_7 :: Background256-color256_b_7 = Background256 (Just (T.ColorNumber 7))--color256_b_8 :: Background256-color256_b_8 = Background256 (Just (T.ColorNumber 8))--color256_b_9 :: Background256-color256_b_9 = Background256 (Just (T.ColorNumber 9))--color256_b_10 :: Background256-color256_b_10 = Background256 (Just (T.ColorNumber 10))--color256_b_11 :: Background256-color256_b_11 = Background256 (Just (T.ColorNumber 11))--color256_b_12 :: Background256-color256_b_12 = Background256 (Just (T.ColorNumber 12))--color256_b_13 :: Background256-color256_b_13 = Background256 (Just (T.ColorNumber 13))--color256_b_14 :: Background256-color256_b_14 = Background256 (Just (T.ColorNumber 14))--color256_b_15 :: Background256-color256_b_15 = Background256 (Just (T.ColorNumber 15))--color256_b_16 :: Background256-color256_b_16 = Background256 (Just (T.ColorNumber 16))--color256_b_17 :: Background256-color256_b_17 = Background256 (Just (T.ColorNumber 17))--color256_b_18 :: Background256-color256_b_18 = Background256 (Just (T.ColorNumber 18))--color256_b_19 :: Background256-color256_b_19 = Background256 (Just (T.ColorNumber 19))--color256_b_20 :: Background256-color256_b_20 = Background256 (Just (T.ColorNumber 20))--color256_b_21 :: Background256-color256_b_21 = Background256 (Just (T.ColorNumber 21))--color256_b_22 :: Background256-color256_b_22 = Background256 (Just (T.ColorNumber 22))--color256_b_23 :: Background256-color256_b_23 = Background256 (Just (T.ColorNumber 23))--color256_b_24 :: Background256-color256_b_24 = Background256 (Just (T.ColorNumber 24))--color256_b_25 :: Background256-color256_b_25 = Background256 (Just (T.ColorNumber 25))--color256_b_26 :: Background256-color256_b_26 = Background256 (Just (T.ColorNumber 26))--color256_b_27 :: Background256-color256_b_27 = Background256 (Just (T.ColorNumber 27))--color256_b_28 :: Background256-color256_b_28 = Background256 (Just (T.ColorNumber 28))--color256_b_29 :: Background256-color256_b_29 = Background256 (Just (T.ColorNumber 29))--color256_b_30 :: Background256-color256_b_30 = Background256 (Just (T.ColorNumber 30))--color256_b_31 :: Background256-color256_b_31 = Background256 (Just (T.ColorNumber 31))--color256_b_32 :: Background256-color256_b_32 = Background256 (Just (T.ColorNumber 32))--color256_b_33 :: Background256-color256_b_33 = Background256 (Just (T.ColorNumber 33))--color256_b_34 :: Background256-color256_b_34 = Background256 (Just (T.ColorNumber 34))--color256_b_35 :: Background256-color256_b_35 = Background256 (Just (T.ColorNumber 35))--color256_b_36 :: Background256-color256_b_36 = Background256 (Just (T.ColorNumber 36))--color256_b_37 :: Background256-color256_b_37 = Background256 (Just (T.ColorNumber 37))--color256_b_38 :: Background256-color256_b_38 = Background256 (Just (T.ColorNumber 38))--color256_b_39 :: Background256-color256_b_39 = Background256 (Just (T.ColorNumber 39))--color256_b_40 :: Background256-color256_b_40 = Background256 (Just (T.ColorNumber 40))--color256_b_41 :: Background256-color256_b_41 = Background256 (Just (T.ColorNumber 41))--color256_b_42 :: Background256-color256_b_42 = Background256 (Just (T.ColorNumber 42))--color256_b_43 :: Background256-color256_b_43 = Background256 (Just (T.ColorNumber 43))--color256_b_44 :: Background256-color256_b_44 = Background256 (Just (T.ColorNumber 44))--color256_b_45 :: Background256-color256_b_45 = Background256 (Just (T.ColorNumber 45))--color256_b_46 :: Background256-color256_b_46 = Background256 (Just (T.ColorNumber 46))--color256_b_47 :: Background256-color256_b_47 = Background256 (Just (T.ColorNumber 47))--color256_b_48 :: Background256-color256_b_48 = Background256 (Just (T.ColorNumber 48))--color256_b_49 :: Background256-color256_b_49 = Background256 (Just (T.ColorNumber 49))--color256_b_50 :: Background256-color256_b_50 = Background256 (Just (T.ColorNumber 50))--color256_b_51 :: Background256-color256_b_51 = Background256 (Just (T.ColorNumber 51))--color256_b_52 :: Background256-color256_b_52 = Background256 (Just (T.ColorNumber 52))--color256_b_53 :: Background256-color256_b_53 = Background256 (Just (T.ColorNumber 53))--color256_b_54 :: Background256-color256_b_54 = Background256 (Just (T.ColorNumber 54))--color256_b_55 :: Background256-color256_b_55 = Background256 (Just (T.ColorNumber 55))--color256_b_56 :: Background256-color256_b_56 = Background256 (Just (T.ColorNumber 56))--color256_b_57 :: Background256-color256_b_57 = Background256 (Just (T.ColorNumber 57))--color256_b_58 :: Background256-color256_b_58 = Background256 (Just (T.ColorNumber 58))--color256_b_59 :: Background256-color256_b_59 = Background256 (Just (T.ColorNumber 59))--color256_b_60 :: Background256-color256_b_60 = Background256 (Just (T.ColorNumber 60))--color256_b_61 :: Background256-color256_b_61 = Background256 (Just (T.ColorNumber 61))--color256_b_62 :: Background256-color256_b_62 = Background256 (Just (T.ColorNumber 62))--color256_b_63 :: Background256-color256_b_63 = Background256 (Just (T.ColorNumber 63))--color256_b_64 :: Background256-color256_b_64 = Background256 (Just (T.ColorNumber 64))--color256_b_65 :: Background256-color256_b_65 = Background256 (Just (T.ColorNumber 65))--color256_b_66 :: Background256-color256_b_66 = Background256 (Just (T.ColorNumber 66))--color256_b_67 :: Background256-color256_b_67 = Background256 (Just (T.ColorNumber 67))--color256_b_68 :: Background256-color256_b_68 = Background256 (Just (T.ColorNumber 68))--color256_b_69 :: Background256-color256_b_69 = Background256 (Just (T.ColorNumber 69))--color256_b_70 :: Background256-color256_b_70 = Background256 (Just (T.ColorNumber 70))--color256_b_71 :: Background256-color256_b_71 = Background256 (Just (T.ColorNumber 71))--color256_b_72 :: Background256-color256_b_72 = Background256 (Just (T.ColorNumber 72))--color256_b_73 :: Background256-color256_b_73 = Background256 (Just (T.ColorNumber 73))--color256_b_74 :: Background256-color256_b_74 = Background256 (Just (T.ColorNumber 74))--color256_b_75 :: Background256-color256_b_75 = Background256 (Just (T.ColorNumber 75))--color256_b_76 :: Background256-color256_b_76 = Background256 (Just (T.ColorNumber 76))--color256_b_77 :: Background256-color256_b_77 = Background256 (Just (T.ColorNumber 77))--color256_b_78 :: Background256-color256_b_78 = Background256 (Just (T.ColorNumber 78))--color256_b_79 :: Background256-color256_b_79 = Background256 (Just (T.ColorNumber 79))--color256_b_80 :: Background256-color256_b_80 = Background256 (Just (T.ColorNumber 80))--color256_b_81 :: Background256-color256_b_81 = Background256 (Just (T.ColorNumber 81))--color256_b_82 :: Background256-color256_b_82 = Background256 (Just (T.ColorNumber 82))--color256_b_83 :: Background256-color256_b_83 = Background256 (Just (T.ColorNumber 83))--color256_b_84 :: Background256-color256_b_84 = Background256 (Just (T.ColorNumber 84))--color256_b_85 :: Background256-color256_b_85 = Background256 (Just (T.ColorNumber 85))--color256_b_86 :: Background256-color256_b_86 = Background256 (Just (T.ColorNumber 86))--color256_b_87 :: Background256-color256_b_87 = Background256 (Just (T.ColorNumber 87))--color256_b_88 :: Background256-color256_b_88 = Background256 (Just (T.ColorNumber 88))--color256_b_89 :: Background256-color256_b_89 = Background256 (Just (T.ColorNumber 89))--color256_b_90 :: Background256-color256_b_90 = Background256 (Just (T.ColorNumber 90))--color256_b_91 :: Background256-color256_b_91 = Background256 (Just (T.ColorNumber 91))--color256_b_92 :: Background256-color256_b_92 = Background256 (Just (T.ColorNumber 92))--color256_b_93 :: Background256-color256_b_93 = Background256 (Just (T.ColorNumber 93))--color256_b_94 :: Background256-color256_b_94 = Background256 (Just (T.ColorNumber 94))--color256_b_95 :: Background256-color256_b_95 = Background256 (Just (T.ColorNumber 95))--color256_b_96 :: Background256-color256_b_96 = Background256 (Just (T.ColorNumber 96))--color256_b_97 :: Background256-color256_b_97 = Background256 (Just (T.ColorNumber 97))--color256_b_98 :: Background256-color256_b_98 = Background256 (Just (T.ColorNumber 98))--color256_b_99 :: Background256-color256_b_99 = Background256 (Just (T.ColorNumber 99))--color256_b_100 :: Background256-color256_b_100 = Background256 (Just (T.ColorNumber 100))--color256_b_101 :: Background256-color256_b_101 = Background256 (Just (T.ColorNumber 101))--color256_b_102 :: Background256-color256_b_102 = Background256 (Just (T.ColorNumber 102))--color256_b_103 :: Background256-color256_b_103 = Background256 (Just (T.ColorNumber 103))--color256_b_104 :: Background256-color256_b_104 = Background256 (Just (T.ColorNumber 104))--color256_b_105 :: Background256-color256_b_105 = Background256 (Just (T.ColorNumber 105))--color256_b_106 :: Background256-color256_b_106 = Background256 (Just (T.ColorNumber 106))--color256_b_107 :: Background256-color256_b_107 = Background256 (Just (T.ColorNumber 107))--color256_b_108 :: Background256-color256_b_108 = Background256 (Just (T.ColorNumber 108))--color256_b_109 :: Background256-color256_b_109 = Background256 (Just (T.ColorNumber 109))--color256_b_110 :: Background256-color256_b_110 = Background256 (Just (T.ColorNumber 110))--color256_b_111 :: Background256-color256_b_111 = Background256 (Just (T.ColorNumber 111))--color256_b_112 :: Background256-color256_b_112 = Background256 (Just (T.ColorNumber 112))--color256_b_113 :: Background256-color256_b_113 = Background256 (Just (T.ColorNumber 113))--color256_b_114 :: Background256-color256_b_114 = Background256 (Just (T.ColorNumber 114))--color256_b_115 :: Background256-color256_b_115 = Background256 (Just (T.ColorNumber 115))--color256_b_116 :: Background256-color256_b_116 = Background256 (Just (T.ColorNumber 116))--color256_b_117 :: Background256-color256_b_117 = Background256 (Just (T.ColorNumber 117))--color256_b_118 :: Background256-color256_b_118 = Background256 (Just (T.ColorNumber 118))--color256_b_119 :: Background256-color256_b_119 = Background256 (Just (T.ColorNumber 119))--color256_b_120 :: Background256-color256_b_120 = Background256 (Just (T.ColorNumber 120))--color256_b_121 :: Background256-color256_b_121 = Background256 (Just (T.ColorNumber 121))--color256_b_122 :: Background256-color256_b_122 = Background256 (Just (T.ColorNumber 122))--color256_b_123 :: Background256-color256_b_123 = Background256 (Just (T.ColorNumber 123))--color256_b_124 :: Background256-color256_b_124 = Background256 (Just (T.ColorNumber 124))--color256_b_125 :: Background256-color256_b_125 = Background256 (Just (T.ColorNumber 125))--color256_b_126 :: Background256-color256_b_126 = Background256 (Just (T.ColorNumber 126))--color256_b_127 :: Background256-color256_b_127 = Background256 (Just (T.ColorNumber 127))--color256_b_128 :: Background256-color256_b_128 = Background256 (Just (T.ColorNumber 128))--color256_b_129 :: Background256-color256_b_129 = Background256 (Just (T.ColorNumber 129))--color256_b_130 :: Background256-color256_b_130 = Background256 (Just (T.ColorNumber 130))--color256_b_131 :: Background256-color256_b_131 = Background256 (Just (T.ColorNumber 131))--color256_b_132 :: Background256-color256_b_132 = Background256 (Just (T.ColorNumber 132))--color256_b_133 :: Background256-color256_b_133 = Background256 (Just (T.ColorNumber 133))--color256_b_134 :: Background256-color256_b_134 = Background256 (Just (T.ColorNumber 134))--color256_b_135 :: Background256-color256_b_135 = Background256 (Just (T.ColorNumber 135))--color256_b_136 :: Background256-color256_b_136 = Background256 (Just (T.ColorNumber 136))--color256_b_137 :: Background256-color256_b_137 = Background256 (Just (T.ColorNumber 137))--color256_b_138 :: Background256-color256_b_138 = Background256 (Just (T.ColorNumber 138))--color256_b_139 :: Background256-color256_b_139 = Background256 (Just (T.ColorNumber 139))--color256_b_140 :: Background256-color256_b_140 = Background256 (Just (T.ColorNumber 140))--color256_b_141 :: Background256-color256_b_141 = Background256 (Just (T.ColorNumber 141))--color256_b_142 :: Background256-color256_b_142 = Background256 (Just (T.ColorNumber 142))--color256_b_143 :: Background256-color256_b_143 = Background256 (Just (T.ColorNumber 143))--color256_b_144 :: Background256-color256_b_144 = Background256 (Just (T.ColorNumber 144))--color256_b_145 :: Background256-color256_b_145 = Background256 (Just (T.ColorNumber 145))--color256_b_146 :: Background256-color256_b_146 = Background256 (Just (T.ColorNumber 146))--color256_b_147 :: Background256-color256_b_147 = Background256 (Just (T.ColorNumber 147))--color256_b_148 :: Background256-color256_b_148 = Background256 (Just (T.ColorNumber 148))--color256_b_149 :: Background256-color256_b_149 = Background256 (Just (T.ColorNumber 149))--color256_b_150 :: Background256-color256_b_150 = Background256 (Just (T.ColorNumber 150))--color256_b_151 :: Background256-color256_b_151 = Background256 (Just (T.ColorNumber 151))--color256_b_152 :: Background256-color256_b_152 = Background256 (Just (T.ColorNumber 152))--color256_b_153 :: Background256-color256_b_153 = Background256 (Just (T.ColorNumber 153))--color256_b_154 :: Background256-color256_b_154 = Background256 (Just (T.ColorNumber 154))--color256_b_155 :: Background256-color256_b_155 = Background256 (Just (T.ColorNumber 155))--color256_b_156 :: Background256-color256_b_156 = Background256 (Just (T.ColorNumber 156))--color256_b_157 :: Background256-color256_b_157 = Background256 (Just (T.ColorNumber 157))--color256_b_158 :: Background256-color256_b_158 = Background256 (Just (T.ColorNumber 158))--color256_b_159 :: Background256-color256_b_159 = Background256 (Just (T.ColorNumber 159))--color256_b_160 :: Background256-color256_b_160 = Background256 (Just (T.ColorNumber 160))--color256_b_161 :: Background256-color256_b_161 = Background256 (Just (T.ColorNumber 161))--color256_b_162 :: Background256-color256_b_162 = Background256 (Just (T.ColorNumber 162))--color256_b_163 :: Background256-color256_b_163 = Background256 (Just (T.ColorNumber 163))--color256_b_164 :: Background256-color256_b_164 = Background256 (Just (T.ColorNumber 164))--color256_b_165 :: Background256-color256_b_165 = Background256 (Just (T.ColorNumber 165))--color256_b_166 :: Background256-color256_b_166 = Background256 (Just (T.ColorNumber 166))--color256_b_167 :: Background256-color256_b_167 = Background256 (Just (T.ColorNumber 167))--color256_b_168 :: Background256-color256_b_168 = Background256 (Just (T.ColorNumber 168))--color256_b_169 :: Background256-color256_b_169 = Background256 (Just (T.ColorNumber 169))--color256_b_170 :: Background256-color256_b_170 = Background256 (Just (T.ColorNumber 170))--color256_b_171 :: Background256-color256_b_171 = Background256 (Just (T.ColorNumber 171))--color256_b_172 :: Background256-color256_b_172 = Background256 (Just (T.ColorNumber 172))--color256_b_173 :: Background256-color256_b_173 = Background256 (Just (T.ColorNumber 173))--color256_b_174 :: Background256-color256_b_174 = Background256 (Just (T.ColorNumber 174))--color256_b_175 :: Background256-color256_b_175 = Background256 (Just (T.ColorNumber 175))--color256_b_176 :: Background256-color256_b_176 = Background256 (Just (T.ColorNumber 176))--color256_b_177 :: Background256-color256_b_177 = Background256 (Just (T.ColorNumber 177))--color256_b_178 :: Background256-color256_b_178 = Background256 (Just (T.ColorNumber 178))--color256_b_179 :: Background256-color256_b_179 = Background256 (Just (T.ColorNumber 179))--color256_b_180 :: Background256-color256_b_180 = Background256 (Just (T.ColorNumber 180))--color256_b_181 :: Background256-color256_b_181 = Background256 (Just (T.ColorNumber 181))--color256_b_182 :: Background256-color256_b_182 = Background256 (Just (T.ColorNumber 182))--color256_b_183 :: Background256-color256_b_183 = Background256 (Just (T.ColorNumber 183))--color256_b_184 :: Background256-color256_b_184 = Background256 (Just (T.ColorNumber 184))--color256_b_185 :: Background256-color256_b_185 = Background256 (Just (T.ColorNumber 185))--color256_b_186 :: Background256-color256_b_186 = Background256 (Just (T.ColorNumber 186))--color256_b_187 :: Background256-color256_b_187 = Background256 (Just (T.ColorNumber 187))--color256_b_188 :: Background256-color256_b_188 = Background256 (Just (T.ColorNumber 188))--color256_b_189 :: Background256-color256_b_189 = Background256 (Just (T.ColorNumber 189))--color256_b_190 :: Background256-color256_b_190 = Background256 (Just (T.ColorNumber 190))--color256_b_191 :: Background256-color256_b_191 = Background256 (Just (T.ColorNumber 191))--color256_b_192 :: Background256-color256_b_192 = Background256 (Just (T.ColorNumber 192))--color256_b_193 :: Background256-color256_b_193 = Background256 (Just (T.ColorNumber 193))--color256_b_194 :: Background256-color256_b_194 = Background256 (Just (T.ColorNumber 194))--color256_b_195 :: Background256-color256_b_195 = Background256 (Just (T.ColorNumber 195))--color256_b_196 :: Background256-color256_b_196 = Background256 (Just (T.ColorNumber 196))--color256_b_197 :: Background256-color256_b_197 = Background256 (Just (T.ColorNumber 197))--color256_b_198 :: Background256-color256_b_198 = Background256 (Just (T.ColorNumber 198))--color256_b_199 :: Background256-color256_b_199 = Background256 (Just (T.ColorNumber 199))--color256_b_200 :: Background256-color256_b_200 = Background256 (Just (T.ColorNumber 200))--color256_b_201 :: Background256-color256_b_201 = Background256 (Just (T.ColorNumber 201))--color256_b_202 :: Background256-color256_b_202 = Background256 (Just (T.ColorNumber 202))--color256_b_203 :: Background256-color256_b_203 = Background256 (Just (T.ColorNumber 203))--color256_b_204 :: Background256-color256_b_204 = Background256 (Just (T.ColorNumber 204))--color256_b_205 :: Background256-color256_b_205 = Background256 (Just (T.ColorNumber 205))--color256_b_206 :: Background256-color256_b_206 = Background256 (Just (T.ColorNumber 206))--color256_b_207 :: Background256-color256_b_207 = Background256 (Just (T.ColorNumber 207))--color256_b_208 :: Background256-color256_b_208 = Background256 (Just (T.ColorNumber 208))--color256_b_209 :: Background256-color256_b_209 = Background256 (Just (T.ColorNumber 209))--color256_b_210 :: Background256-color256_b_210 = Background256 (Just (T.ColorNumber 210))--color256_b_211 :: Background256-color256_b_211 = Background256 (Just (T.ColorNumber 211))--color256_b_212 :: Background256-color256_b_212 = Background256 (Just (T.ColorNumber 212))--color256_b_213 :: Background256-color256_b_213 = Background256 (Just (T.ColorNumber 213))--color256_b_214 :: Background256-color256_b_214 = Background256 (Just (T.ColorNumber 214))--color256_b_215 :: Background256-color256_b_215 = Background256 (Just (T.ColorNumber 215))--color256_b_216 :: Background256-color256_b_216 = Background256 (Just (T.ColorNumber 216))--color256_b_217 :: Background256-color256_b_217 = Background256 (Just (T.ColorNumber 217))--color256_b_218 :: Background256-color256_b_218 = Background256 (Just (T.ColorNumber 218))--color256_b_219 :: Background256-color256_b_219 = Background256 (Just (T.ColorNumber 219))--color256_b_220 :: Background256-color256_b_220 = Background256 (Just (T.ColorNumber 220))--color256_b_221 :: Background256-color256_b_221 = Background256 (Just (T.ColorNumber 221))--color256_b_222 :: Background256-color256_b_222 = Background256 (Just (T.ColorNumber 222))--color256_b_223 :: Background256-color256_b_223 = Background256 (Just (T.ColorNumber 223))--color256_b_224 :: Background256-color256_b_224 = Background256 (Just (T.ColorNumber 224))--color256_b_225 :: Background256-color256_b_225 = Background256 (Just (T.ColorNumber 225))--color256_b_226 :: Background256-color256_b_226 = Background256 (Just (T.ColorNumber 226))--color256_b_227 :: Background256-color256_b_227 = Background256 (Just (T.ColorNumber 227))--color256_b_228 :: Background256-color256_b_228 = Background256 (Just (T.ColorNumber 228))--color256_b_229 :: Background256-color256_b_229 = Background256 (Just (T.ColorNumber 229))--color256_b_230 :: Background256-color256_b_230 = Background256 (Just (T.ColorNumber 230))--color256_b_231 :: Background256-color256_b_231 = Background256 (Just (T.ColorNumber 231))--color256_b_232 :: Background256-color256_b_232 = Background256 (Just (T.ColorNumber 232))--color256_b_233 :: Background256-color256_b_233 = Background256 (Just (T.ColorNumber 233))--color256_b_234 :: Background256-color256_b_234 = Background256 (Just (T.ColorNumber 234))--color256_b_235 :: Background256-color256_b_235 = Background256 (Just (T.ColorNumber 235))--color256_b_236 :: Background256-color256_b_236 = Background256 (Just (T.ColorNumber 236))--color256_b_237 :: Background256-color256_b_237 = Background256 (Just (T.ColorNumber 237))--color256_b_238 :: Background256-color256_b_238 = Background256 (Just (T.ColorNumber 238))--color256_b_239 :: Background256-color256_b_239 = Background256 (Just (T.ColorNumber 239))--color256_b_240 :: Background256-color256_b_240 = Background256 (Just (T.ColorNumber 240))--color256_b_241 :: Background256-color256_b_241 = Background256 (Just (T.ColorNumber 241))--color256_b_242 :: Background256-color256_b_242 = Background256 (Just (T.ColorNumber 242))--color256_b_243 :: Background256-color256_b_243 = Background256 (Just (T.ColorNumber 243))--color256_b_244 :: Background256-color256_b_244 = Background256 (Just (T.ColorNumber 244))--color256_b_245 :: Background256-color256_b_245 = Background256 (Just (T.ColorNumber 245))--color256_b_246 :: Background256-color256_b_246 = Background256 (Just (T.ColorNumber 246))--color256_b_247 :: Background256-color256_b_247 = Background256 (Just (T.ColorNumber 247))--color256_b_248 :: Background256-color256_b_248 = Background256 (Just (T.ColorNumber 248))--color256_b_249 :: Background256-color256_b_249 = Background256 (Just (T.ColorNumber 249))--color256_b_250 :: Background256-color256_b_250 = Background256 (Just (T.ColorNumber 250))--color256_b_251 :: Background256-color256_b_251 = Background256 (Just (T.ColorNumber 251))--color256_b_252 :: Background256-color256_b_252 = Background256 (Just (T.ColorNumber 252))--color256_b_253 :: Background256-color256_b_253 = Background256 (Just (T.ColorNumber 253))--color256_b_254 :: Background256-color256_b_254 = Background256 (Just (T.ColorNumber 254))--color256_b_255 :: Background256-color256_b_255 = Background256 (Just (T.ColorNumber 255))-

@@ -1,26 +0,0 @@-module Penny.Steel.Chunk.Switch where--import qualified Penny.Steel.Chunk as C---- | Switch the foreground colors for new ones.-switchForeground ::-  C.Foreground8-  -> C.Foreground256-  -> C.TextSpec-  -> C.TextSpec-switchForeground c8 c256 ts = ts' where-  ts' = C.TextSpec s8' s256'-  s8' = (C.style8 ts) { C.foreground8 = c8 }-  s256' = (C.style256 ts) { C.foreground256 = c256 }---- | Switch the background colors for new ones.-switchBackground ::-  C.Background8-  -> C.Background256-  -> C.TextSpec-  -> C.TextSpec-switchBackground c8 c256 ts = ts' where-  ts' = C.TextSpec s8' s256'-  s8' = (C.style8 ts) { C.background8 = c8 }-  s256' = (C.style256 ts) { C.background256 = c256 }-

@@ -1,70 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-module Penny.Steel.Expressions-  ( ExprDesc(..)-  , Error-  , Token-  , operand-  , opAnd-  , opOr-  , opNot-  , openParen-  , closeParen-  , parseExpression-  ) where--import Data.Either (partitionEithers)-import qualified Data.Text as X-import qualified Penny.Steel.Expressions.Infix as I-import qualified Penny.Steel.Expressions.RPN as R-import qualified Penny.Steel.Pdct as P-import qualified Control.Monad.Exception.Synchronous as Ex---- | A single type for both RPN tokens and infix tokens.-newtype Token a = Token { unToken :: I.InfixToken a }-type Error = X.Text--operand :: P.Pdct a -> Token a-operand p = Token (I.TokRPN (R.TokOperand p))--opAnd :: Token a-opAnd = Token (I.TokRPN (R.TokOperator R.OpAnd))--opOr :: Token a-opOr = Token (I.TokRPN (R.TokOperator R.OpOr))--opNot :: Token a-opNot = Token (I.TokRPN (R.TokOperator R.OpNot))--openParen :: Token a-openParen = Token (I.TokParen I.Open)--closeParen :: Token a-closeParen = Token (I.TokParen I.Close)--data ExprDesc-  = Infix-  | RPN-  deriving (Eq, Show)--toksToRPN :: [Token a] -> Maybe [R.RPNToken a]-toksToRPN toks-  = let toEither t = case unToken t of-          I.TokRPN tok -> Right tok-          _ -> Left ()-    in case partitionEithers . map toEither $ toks of-        ([], xs) -> return xs-        _ -> Nothing--parseExpression-  :: ExprDesc-  -> [Token a]-  -> Ex.Exceptional Error (P.Pdct a)-parseExpression e toks = do-  rpnToks <- case e of-    Infix -> Ex.fromMaybe "unbalanced parentheses\n"-             . I.createRPN-             . map unToken-             $ toks-    RPN -> Ex.fromMaybe "parentheses in an RPN expression\n"-           $ toksToRPN toks-  R.pushTokens rpnToks

@@ -1,126 +0,0 @@-module Penny.Steel.Expressions.Infix-  ( InfixToken (..)-  , Paren(..)-  , createRPN-  ) where--import qualified Penny.Steel.Expressions.RPN as R-import qualified Data.Foldable as Fdbl--data InfixToken a-  = TokRPN (R.RPNToken a)-  | TokParen Paren--data Paren = Open | Close---- | Values on the operator stack.-data OpStackVal-  = StkOp R.Operator-  | StkOpenParen---- In the shunting yard algorithm, the output sequence is a queue. The--- first values to go into the output sequence are the first to be--- processed by the RPN parser. In this module, the output sequence is--- implemented as a list stack, which means it must be reversed upon--- output (this is done in the createRPN function.)--processInfixToken-  :: ([OpStackVal], [R.RPNToken a])-  -> InfixToken a-  -> Maybe ([OpStackVal], [R.RPNToken a])-processInfixToken (os, ts) t = case t of-  TokRPN tok -> return $ processRPNToken (os, ts) tok-  TokParen p -> processParen (os, ts) p----- | If the token is a binary operator A, then:------ If A is left associative, while there is an operator B of higher or--- equal precedence than A at the top of the stack, pop B off the--- stack and append it to the output.------ If A is right associative, while there is an operator B of higher--- precedence than A at the top of the stack, pop B off the stack and--- append it to the output.------ Push A onto the stack.------ If a token is an operand, append it to the postfix output.------ And has higher precedence than Or.-processRPNToken-  :: ([OpStackVal], [R.RPNToken a])-  -> R.RPNToken a-  -> ([OpStackVal], [R.RPNToken a])-processRPNToken (os, ts) t = case t of-  p@(R.TokOperand _) -> (os, p:ts)-  R.TokOperator d -> case d of-    R.OpNot -> (StkOp R.OpNot : os, ts)-    R.OpAnd -> (StkOp R.OpAnd : os, ts)-    R.OpOr ->-      let (os', ts') = popper os ts-      in (StkOp R.OpOr : os', ts')---- | Pops operators from the operator stack and places then in the--- output queue, as long as there is an And operator on the top of the--- operator stack.-popper :: [OpStackVal] -> [R.RPNToken a] -> ([OpStackVal], [R.RPNToken a])-popper os ts = case os of-  [] -> (os, ts)-  x:xs -> case x of-    StkOp R.OpAnd ->-      let os' = xs-          ts' = R.TokOperator R.OpAnd : ts-      in popper os' ts'-    _ -> (os, ts)---- | Pops operators off the operator stack and onto the output stack--- as long as the top of the operator stack is not an open--- parenthesis. When an open parenthesis is encountered, pop that too,--- but not onto the output stack. Fails if the stack has no open--- parentheses.-popThroughOpen-  :: ([OpStackVal], [R.RPNToken a])-  -> Maybe ([OpStackVal], [R.RPNToken a])-popThroughOpen (os, ts) = case os of-  [] -> Nothing-  v:vs -> case v of-    StkOp op -> popThroughOpen (vs, R.TokOperator op : ts)-    StkOpenParen -> return (vs, ts)---- | Places an open parenthesis on the top of the operator stack. For--- Close parenthesis, pops operators off the operator stack through--- the next open parenthesis on the operator stack.-processParen-  :: ([OpStackVal], [R.RPNToken a])-  -> Paren-  -> Maybe ([OpStackVal], [R.RPNToken a])-processParen (os, ts) p = case p of-  Open -> Just (StkOpenParen : os, ts)-  Close -> popThroughOpen (os, ts)---- | Creates an RPN expression from an infix one. Fails only if there--- are mismatched parentheses. It is possible to create a nonsensical--- RPN expression; the RPN parser must catch this.-createRPN-  :: Fdbl.Foldable f-  => f (InfixToken a)-  -- ^ The input tokens, with the beginning of the expression on the-  -- left side of the sequence.--  -> Maybe [R.RPNToken a]-  -- ^ The output sequence of tokens, with the beginning of the-  -- expression on the left side of the list.-createRPN ts = do-  (stack, toks) <- Fdbl.foldlM processInfixToken ([], []) ts-  fmap reverse $ popRemainingOperators stack toks---- | Pops remaining items off operator stack. Fails if there is an--- open paren left on the stack, as this indicates mismatched--- parenthesis.-popRemainingOperators :: [OpStackVal] -> [R.RPNToken a] -> Maybe [R.RPNToken a]-popRemainingOperators os ts = case os of-  [] -> return ts-  x:xs -> case x of-    StkOp op -> popRemainingOperators xs (R.TokOperator op : ts)-    StkOpenParen -> Nothing

@@ -1,74 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}--- | Postfix, or RPN, expression parsing.------ This module parses RPN expressions where the operands are--- predicates and the operators are one of @and@, @or@, or @not@,--- where @and@ and @or@ are binary and @not@ is unary.-module Penny.Steel.Expressions.RPN where--import qualified Control.Monad.Exception.Synchronous as Ex-import qualified Data.Foldable as Fdbl-import qualified Penny.Steel.Pdct as P-import Penny.Steel.Pdct ((&&&), (|||))-import Data.Monoid ((<>))-import Data.Text (Text)-import qualified Data.Text as X-import qualified Penny.Steel.Chunk as C--type Error = Text--data RPNToken a-  = TokOperand (P.Pdct a)-  | TokOperator Operator--data Operator-  = OpAnd-  | OpOr-  | OpNot-  deriving Show--pushOperand :: P.Pdct a -> [P.Pdct a] -> [P.Pdct a]-pushOperand p ts = p : ts--pushOperator-  :: Operator-  -> [P.Pdct a]-  -> Ex.Exceptional Error [P.Pdct a]-pushOperator o ts = case o of-  OpAnd -> case ts of-    x:y:zs -> return $ (y &&& x) : zs-    _ -> Ex.throw $ err "and"-  OpOr -> case ts of-    x:y:zs -> return $ (y ||| x) : zs-    _ -> Ex.throw $ err "or"-  OpNot -> case ts of-    x:zs -> return $ P.not x : zs-    _ -> Ex.throw $ err "not"-  where-    err x = "insufficient operands to apply \"" <> x-            <> "\" operator\n"--pushToken-  :: [P.Pdct a]-  -> RPNToken a-  -> Ex.Exceptional Error [P.Pdct a]-pushToken ts t = case t of-  TokOperand p -> return $ pushOperand p ts-  TokOperator o -> pushOperator o ts--pushTokens-  :: Fdbl.Foldable f-  => f (RPNToken a)-  -> Ex.Exceptional Error (P.Pdct a)-pushTokens ts = do-  trees <- Fdbl.foldlM pushToken [] ts-  case trees of-    [] -> Ex.throw $ "bad expression: no operands left on the stack\n"-    x:[] -> return x-    xs -> Ex.throw-      $ "bad expression: multiple operands left on the stack:\n"-      <> ( X.concat-           . map C.chunkText-           . concatMap (P.showPdct 4 0)-           $ xs )-

@@ -1,292 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}---- | Trees of predicates.------ Exports names which conflict with Prelude names, so you probably--- want to import this module qualified.--module Penny.Steel.Pdct-  ( Pdct(..)-  , always-  , never-  , and-  , or-  , not-  , operand-  , neverFalse-  , neverTrue-  , (&&&)-  , (|||)-  , Level-  , IndentAmt-  , ShowDiscards-  , showPdct-  , rename-  , eval-  , evaluate-  , boxPdct-  , boxNode-  ) where--import Control.Applicative ((<*>))-import Data.Maybe (fromMaybe, isJust, catMaybes)-import Data.Text (Text)-import qualified Data.Text as X-import Data.Monoid ((<>), mconcat, mempty)-import qualified Penny.Steel.Chunk as C-import qualified Penny.Steel.Chunk.Switch as Sw-import Prelude hiding (not, and, or)-import qualified Prelude--type Label = Text---- | A tree of predicates.-data Pdct a = Pdct Label (Node a)--instance Show (Pdct a) where-  show _ = "predicate"---- | Renames the top level of the Pdct. The function you pass will be--- applied to the old name.-rename :: (Text -> Text) -> Pdct a -> Pdct a-rename f (Pdct l n) = Pdct (f l) n--data Node a-  = And [Pdct a]-  -- ^ None of the Pdct in list may be Just False. An empty list or-  -- list with only Nothing is Just True.--  | Or [Pdct a]-  -- ^ At least one of the Pdct in the list must be Just True. An-  -- empty list or list with only Nothing is Just False.--  | Not (Pdct a)-  -- ^ Just True is Just False and vice versa; Nothing remains Nothing.--  | NeverFalse (Pdct a)-  -- ^ Just True if the child is Just True; Nothing otherwise.--  | NeverTrue (Pdct a)-  -- ^ Just False if the child is Just False; Nothing otherwise.--  | Operand (a -> Maybe Bool)---- | Given a function that un-boxes values of type b, changes a Node--- from type a to type b.-boxNode-  :: (b -> a)-  -> Node a-  -> Node b-boxNode f n = case n of-  And ls -> And $ map (boxPdct f) ls-  Or ls -> Or $ map (boxPdct f) ls-  Not o -> Not $ boxPdct f o-  NeverFalse o -> NeverFalse $ boxPdct f o-  NeverTrue o -> NeverTrue $ boxPdct f o-  Operand g -> Operand $ \b -> g (f b)----- | Given a function that un-boxes values of type b, changes a Pdct--- from type a to type b.-boxPdct-  :: (b -> a)-  -> Pdct a-  -> Pdct b-boxPdct f (Pdct l n) = Pdct l $ boxNode f n--and :: [Pdct a] -> Pdct a-and = Pdct "and" . And--or :: [Pdct a] -> Pdct a-or = Pdct "or" . Or--not :: Pdct a -> Pdct a-not = Pdct "not" . Not---- | Creates a new operand. The Pdct is Just True or Just False, never--- Nothing.-operand :: Text -> (a -> Bool) -> Pdct a-operand t = Pdct t . Operand . fmap Just---- | Turns an existing Pdct to one that never says False. If the--- underlying predicate returns Just True, the new Pdct also returns--- Just True. Otherwise, the Pdct returns Nothing.  Has no effect on--- non-Operand Pdct.-neverFalse :: Pdct a -> Pdct a-neverFalse = Pdct "never False" . NeverFalse---- | Turns an existing Pdct to one that never says True. If the--- underlying predicate returns Just False, the new Pdct also returns--- Just False. Otherwise, the Pdct returns Nothing.  Has no effect on--- non-Operand Pdct.-neverTrue :: Pdct a -> Pdct a-neverTrue = Pdct "never True" . NeverTrue----- | Returns a tree that is always True.-always :: Pdct a-always = Pdct "always True" (Operand (const (Just True)))---- | Returns a tree that is always False.-never :: Pdct a-never = Pdct "always False" (Operand (const (Just False)))--(&&&) :: Pdct a -> Pdct a -> Pdct a-(&&&) x y = Pdct "and" (And [x, y])-infixr 3 &&&--(|||) :: Pdct a -> Pdct a -> Pdct a-(|||) x y = Pdct "or" (Or [x, y])-infixr 2 |||--type Level = Int-type IndentAmt = Int---- | Indents text, and adds a newline to the end.-indent :: IndentAmt -> Level -> [C.Chunk] -> [C.Chunk]-indent amt lvl cs = idt : (cs ++ [nl])-  where-    idt = C.chunk C.defaultTextSpec-                  (X.replicate (lvl * amt) " ")-    nl = C.chunk C.defaultTextSpec (X.singleton '\n')--defaultChunk :: Text -> C.Chunk-defaultChunk = C.chunk C.defaultTextSpec--showPdct :: IndentAmt -> Level -> Pdct a -> [C.Chunk]-showPdct amt lvl (Pdct l pd) = case pd of-  And ls -> indent amt lvl [defaultChunk l]-            <> mconcat (map (showPdct amt (lvl + 1)) ls)-  Or ls -> indent amt lvl [defaultChunk l]-           <> mconcat (map (showPdct amt (lvl + 1)) ls)-  Not t -> indent amt lvl [defaultChunk l]-           <> showPdct amt (lvl + 1) t-  NeverFalse t -> indent amt lvl [defaultChunk l]-                  <> showPdct amt (lvl + 1) t-  NeverTrue t -> indent amt lvl [defaultChunk l]-                 <> showPdct amt (lvl + 1) t-  Operand _ -> indent amt lvl [defaultChunk l]---labelBool :: Text -> Maybe Bool -> [C.Chunk]-labelBool t b = [open, trueFalse, close, blank, txt]-  where-    trueFalse = C.chunk ts tf-    (tf, ts) = case b of-      Nothing -> ("discard", Sw.switchForeground C.color8_f_yellow-                             C.color256_f_3 C.defaultTextSpec)-      Just bl -> if bl-        then ("TRUE", Sw.switchForeground C.color8_f_green-                      C.color256_f_2 C.defaultTextSpec)-        else ("FALSE", Sw.switchForeground C.color8_f_red-                       C.color256_f_1 C.defaultTextSpec)-    open = C.chunk C.defaultTextSpec "["-    close = C.chunk C.defaultTextSpec "]"-    blank = C.chunk C.defaultTextSpec (X.replicate blankLen " ")-    blankLen = X.length "discard" - X.length tf + 1-    txt = C.chunk C.defaultTextSpec t--type ShowDiscards = Bool---- | Evaluates a Pdct.-eval :: Pdct a -> a -> Maybe Bool-eval (Pdct _ n) a = case n of-  And ps -> Just . Prelude.and . catMaybes $ [flip eval a] <*> ps-  Or ps -> Just . Prelude.or . catMaybes $ [flip eval a] <*> ps-  Not p -> fmap Prelude.not $ eval p a-  NeverFalse p -> case eval p a of-    Nothing -> Nothing-    Just b -> if Prelude.not b then Nothing else Just b-  NeverTrue p -> case eval p a of-    Nothing -> Nothing-    Just b -> if b then Nothing else Just b-  Operand f -> f a---- | Verbosely evaluates a Pdct.-evaluate-  :: IndentAmt-  -- ^ Indent each level by this many spaces.--  -> ShowDiscards-  -- ^ If True, show discarded test results; otherwise, hide-  -- them.--  -> a-  -- ^ The subject to evaluate--  -> Level-  -- ^ How many levels deep in the tree we are. Start at level 0. This-  -- determines the level of indentation.-  -> Pdct a-  -> (Maybe Bool, [C.Chunk])-evaluate i sd a lvl (Pdct l pd) = case pd of--  And ps -> let (resBool, resTxt) = evalAnd i sd a (lvl + 1) ps-                txt = indent i lvl (labelBool l (Just resBool))-                        <> resTxt-            in (Just resBool, txt)--  Or ps -> let (resBool, resTxt) = evalOr i sd a (lvl + 1) ps-               txt = indent i lvl (labelBool l (Just resBool))-                        <> resTxt-           in (Just resBool, txt)--  Not p -> let (childMayBool, childTxt) = evaluate i sd a (lvl + 1) p-               thisMayBool = fmap Prelude.not childMayBool-               thisTxt = indent i lvl (labelBool l thisMayBool)-               txt = if sd || isJust thisMayBool-                     then thisTxt <> childTxt else mempty-           in (thisMayBool, txt)--  NeverFalse p ->-    let (childMayBool, childTxt) = evaluate i sd a (lvl + 1) p-        thisMayBool = case childMayBool of-          Nothing -> Nothing-          Just b -> if Prelude.not b then Nothing else Just b-        thisTxt = indent i lvl (labelBool l thisMayBool)-        txt = if sd || isJust thisMayBool-              then thisTxt <> childTxt else mempty-    in (thisMayBool, txt)--  NeverTrue p ->-    let (childMayBool, childTxt) = evaluate i sd a (lvl + 1) p-        thisMayBool = case childMayBool of-          Nothing -> Nothing-          Just b -> if b then Nothing else Just b-        thisTxt = indent i lvl (labelBool l thisMayBool)-        txt = if sd || isJust thisMayBool-              then thisTxt <> childTxt else mempty-    in (thisMayBool, txt)--  Operand p -> let res = p a-                   txt = indent i lvl (labelBool l res)-               in (res, if sd || isJust res then txt else mempty)--evalAnd :: IndentAmt -> ShowDiscards -> a-        -> Level -> [Pdct a] -> (Bool, [C.Chunk])-evalAnd i sd a l ts = (Prelude.not foundFalse, txt)-  where-    (foundFalse, txt) = go ts (False, mempty)-    go [] p = p-    go (x:xs) (fndFalse, acc) =-      if fndFalse-      then (fndFalse, acc <> indent i l-                             [defaultChunk "(short circuit)"])-      else let (res, cTxt) = evaluate i sd a l x-               fndFalse' = maybe False Prelude.not res-           in go xs (fndFalse', acc <> cTxt)--evalOr :: IndentAmt -> ShowDiscards -> a-       -> Level -> [Pdct a] -> (Bool, [C.Chunk])-evalOr i sd a l ts = (foundTrue, txt)-  where-    (foundTrue, txt) = go ts (False, mempty)-    go [] p = p-    go (x:xs) (fnd, acc) =-      if fnd-      then (fnd, acc <> indent i l-                        [defaultChunk "(short circuit)"])-      else let (res, cTxt) = evaluate i sd a l x-               fnd' = fromMaybe False res-           in go xs (fnd', acc <> cTxt)-

@@ -1,198 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}--module Penny.Steel.TestTree where--import Data.Maybe (isJust)-import qualified Data.Text as X-import Data.Text (Text)-import qualified Data.List.Split as Sp--import qualified Penny.Steel.Chunk as C-import qualified Penny.Steel.Chunk.Switch as Sw-import qualified Penny.Steel.Pdct as Pt------- Types-----type Pass = Bool-type Name = Text---- | A tree of tests. On evaluation of the tree, the name is not shown--- for tests (it is only shown for groups.) However, the name is used--- when the tree is displayed statically, without evaluation.-data TestTree a = TestTree Name (Payload a)--data Payload a-  = Group [TestTree a]-  | Test (TestFunc a)--type TestFunc a-  = Pt.IndentAmt-  -> PassVerbosity-  -> FailVerbosity-  -> [a]-  -> Pt.Level-  -> (Pass, [C.Chunk])---group :: Name -> [TestTree a] -> TestTree a-group n ts = TestTree n (Group ts)--test :: Name -> TestFunc a -> TestTree a-test n t = TestTree n (Test t)--type PassVerbosity = Verbosity-type FailVerbosity = Verbosity--data Verbosity-  = Silent-  -- ^ Show nothing at all--  | PassFail-  -- ^ Show only whether the test passed or failed--  | FalseSubjects-  -- ^ Show subjects that are False--  | TrueSubjects-  -- ^ Show subjects that are True. (This is cumulative, so False-  -- subjects are shown too.)--  | DiscardedSubjects--  | DiscardedPredicates-  -- ^ Show discarded results-  deriving (Eq, Ord, Show)------- Helper functions-------- | Determines whether to show a subject, and shows it.-showSubject-  :: (a -> X.Text)-  -> Verbosity-  -> Pt.IndentAmt-  -> Pt.Level-  -> Pt.Pdct a-  -> (a, Maybe Bool)-  -> [C.Chunk]-showSubject swr v i l p (s, b) =-  let (showSubj, showDisc) = isSubjectAndDiscardsShown v b-      renamer txt = X.concat [swr s, " - ", txt]-      renamed = Pt.rename renamer p-  in if showSubj-     then snd $ Pt.evaluate i showDisc s l renamed-     else []---- | Given a Verbosity and a Maybe Boolean indicating whether a--- subject is True, False, or a discard, returns whether to show the--- subject and whether to show the discards contained within the--- subject.-isSubjectAndDiscardsShown :: Verbosity -> Maybe Bool -> (Bool, Bool)-isSubjectAndDiscardsShown v b = case v of-  Silent -> (False, False)-  PassFail -> (False, False)-  FalseSubjects -> (not . isTrue $ b, False)-  TrueSubjects -> (isJust b, False)-  DiscardedSubjects -> (True, False)-  DiscardedPredicates -> (True, True)---showTestTitle :: Pt.IndentAmt -> Pt.Level -> Name -> Pass -> [C.Chunk]-showTestTitle i l n p = [idt, open, passFail, close, blank, txt, nl]-  where-    passFail = C.chunk ts tf-    idt = C.chunk C.defaultTextSpec (X.replicate (i * l) " ")-    nl = C.chunk C.defaultTextSpec "\n"-    (tf, ts) =-      if p-      then ("PASS", Sw.switchForeground C.color8_f_green-                    C.color256_f_2 C.defaultTextSpec)-      else ("FAIL", Sw.switchForeground C.color8_f_red-                    C.color256_f_1 C.defaultTextSpec)-    open = C.chunk C.defaultTextSpec "["-    close = C.chunk C.defaultTextSpec "]"-    blank = C.chunk C.defaultTextSpec (X.singleton ' ')-    txt = C.chunk C.defaultTextSpec n--isTrue :: Maybe Bool -> Bool-isTrue = maybe False id------- Tests------- | Passes if every subject is True.-eachSubjectMustBeTrue-  :: Name-  -> (a -> Text)-  -> Pt.Pdct a-  -> TestTree a-eachSubjectMustBeTrue n swr p = TestTree n (Test tf)-  where-    tf i pv fv as lvl = (pass, cks)-      where-        rslts = zip as (map (Pt.eval p) as)-        pass = all (isTrue . snd) rslts-        v = if pass then pv else fv-        cks = tit ++ subjectChunks-        tit = if v == Silent then [] else showTestTitle i lvl n pass-        subjectChunks =-          concatMap (showSubject swr v i (lvl + 1) p) rslts---- | Passes if at least n subjects are True.-seriesAtLeastN-  :: Name-  -> (a -> X.Text)-  -> Int-  -> Pt.Pdct a-  -> TestTree a-seriesAtLeastN n swr count p = TestTree n (Test tf)-  where-    tf idnt pv fv as l = (pass, cks)-      where-        pd (_, res) = isTrue res-        resultList = take count-                     . Sp.split (Sp.keepDelimsR (Sp.whenElt pd))-                     $ zip as (map (Pt.eval p) as)-        pass = length resultList >= count-        v = if pass then pv else fv-        cks = tit ++ subjectChunks-        tit = if v == Silent then [] else showTestTitle idnt l n pass-        subjectChunks =-          concatMap (showSubject swr v idnt (l + 1) p) . concat $ resultList--indent :: Pt.IndentAmt -> Pt.Level -> Text -> C.Chunk-indent amt lvl t = C.chunk ts txt-  where-    ts = C.defaultTextSpec-    txt = X.concat [spaces, t, "\n"]-    spaces = X.replicate (amt * lvl) " "---- | Shows a tree, without evaluating it.-showTestTree-  :: Pt.IndentAmt-  -> Pt.Level-  -> TestTree a-  -> [C.Chunk]-showTestTree amt l (TestTree n p) = indent amt l n : children-  where-    children = case p of-      Group ts -> concatMap (showTestTree amt l) ts-      Test _ -> []--evalTestTree-  :: Pt.IndentAmt-  -> Pt.Level-  -> PassVerbosity-  -> FailVerbosity-  -> [a]-  -> TestTree a-  -> [Either C.Chunk (Pass, [C.Chunk])]-evalTestTree i l pv fv as (TestTree n p) = case p of-  Test f -> [Right $ f i pv fv as l]-  Group ts -> Left (indent i l n)-              : concatMap (evalTestTree i (l + 1) pv fv as) ts

@@ -1,24 +1,48 @@ {-# LANGUAGE OverloadedStrings #-}-module Penny.Wheat where -import Control.Applicative+-- | Wheat - Penny ledger tests+--+-- Wheat helps you build tests to check all the postings in your+-- ledger. Perhaps you want to make sure all the account names are+-- valid, or that your checking account has no unreconciled+-- transactions. With Wheat you can easily build a command line+-- program that will check all the postings in a ledger for you+-- against criteria that you specify.++module Penny.Wheat+  ( -- * Configuration+    WheatConf(..)++    -- * Tests+  , eachPostingMustBeTrue+  , atLeastNPostings++    -- * Convenience functions+  , futureFirstsOfTheMonth++    -- * Running tests+  , main+  ) where+ import Control.Monad (when)-import Data.List (find, isPrefixOf)-import Data.Maybe (mapMaybe, catMaybes)-import Data.Monoid ((<>), mempty)+import qualified Control.Monad.Exception.Synchronous as Ex+import Data.Maybe (mapMaybe) import qualified Penny.Copper as Cop import qualified Penny.Copper.Parsec as CP import qualified Penny.Lincoln as L import qualified Data.Text as X import qualified Data.Time as Time+import qualified Text.Matchers as M import qualified Text.Parsec as Parsec import qualified System.Exit as Exit+import qualified System.IO as IO import qualified Penny.Shield as S -import qualified Penny.Steel.TestTree as TT-import qualified Penny.Steel.Pdct as Pe-import qualified Penny.Steel.Chunk as C-import qualified Options.Applicative as OA+import qualified Data.Prednote.TestTree as TT+import qualified Data.Prednote.Pdct as Pe+import qualified System.Console.Rainbow as Rb+import qualified System.Console.MultiArg as MA+import System.Locale (defaultTimeLocale)  ------------------------------------------------------------ -- Other conveniences@@ -38,113 +62,192 @@ -- CLI ------------------------------------------------------------ -type ColorToFile = Bool-type BaseTime = Time.UTCTime-type ProgName = String-+-- | Record holding all data to configure Wheat. data WheatConf = WheatConf   { briefDescription :: String+    -- ^ This is displayed at the beginning of the online help. It+    -- should be a one-line description of what this program does--for+    -- example, what it checks for.+   , moreHelp :: [String]-  , passVerbosity :: TT.PassVerbosity-  , failVerbosity :: TT.FailVerbosity+    -- ^ Displayed at the end of the online help. It should be a list+    -- of lines, wich each line not terminated by a newline+    -- character. It is displayed at the end of the online help.++  , tests :: [Time.UTCTime -> TT.TestTree L.PostFam]+    -- ^ The actual tests to run. The UTCTime is the @base time@. Each+    -- test may decide what to do with the base time--for example, the+    -- test might say that all postings have to have a date on or+    -- before that date. Or the test might just ignore the base time.+   , indentAmt :: Pe.IndentAmt-  , colorToFile :: ColorToFile-  , tests :: [BaseTime -> TT.TestTree L.PostFam]-  , baseTime :: BaseTime-  }+    -- ^ How many spaces to indent each level in a tree of tests. -parseAbbrev :: [(String, a)] -> String -> Either OA.ParseError a-parseAbbrev ls str = case find (\(s, _) -> s == str) ls of-  Nothing -> lookupAbbrev-  Just (_, a) -> Right a-  where-    lookupAbbrev = case filter ((str `isPrefixOf`) . fst) ls of-      (_, a):[] -> Right a-      _ -> Left (OA.ErrorMsg ("invalid argument: " ++ str))+  , passVerbosity :: TT.Verbosity+    -- ^ Verbosity for tests that pass -parseVerbosity :: String -> Either OA.ParseError TT.Verbosity-parseVerbosity = parseAbbrev-  [ ("silent", TT.Silent)-  , ("minimal", TT.PassFail)-  , ("false", TT.FalseSubjects)-  , ("true", TT.TrueSubjects)-  , ("discarded", TT.DiscardedSubjects)-  , ("all", TT.DiscardedPredicates)-  ]+  , failVerbosity :: TT.Verbosity+    -- ^ Verbosity for tests that fail -parseColorToFile :: String -> Either OA.ParseError ColorToFile-parseColorToFile = parseAbbrev [ ("no", False), ("yes", True) ]+  , groupPred :: TT.Name -> Bool+    -- ^ Group names are filtered with this function; a group is only+    -- run if this function returns True. -parseBaseTime :: String -> Either OA.ParseError BaseTime-parseBaseTime s = case Parsec.parse CP.dateTime  "" (X.pack s) of-  Left e -> Left (OA.ErrorMsg $ "could not parse date: " ++ show e)-  Right g -> Right . L.toUTC $ g+  , testPred :: TT.Name -> Bool+    -- ^ Test names are filtered with this function; a test is only+    -- run if this function returns True. +  , showSkippedTests :: Bool+    -- ^ Some tests might be skipped; see 'testPred'. This controls+    -- whether you want to see a notification of tests that were+    -- skipped. (Does not affect skipped groups; see 'groupVerbosity'+    -- for that.)++  , groupVerbosity :: TT.GroupVerbosity+    -- ^ Show group names? Even if you do not show the names of+    -- groups, tests within the group will still be indented.++  , stopOnFail :: Bool+    -- ^ If True, then tests will stop running immediately after a+    -- single test fails. If False, all tests are always run.++  , colorToFile :: Bool+    -- ^ Use colors even if stdout is not a file?++  , baseTime :: Time.UTCTime+    -- ^ Tests may use this date and time as they wish; see+    -- 'tests'. Typically you will set this to the current instant.++  , ledgers :: [String]+    -- ^ Ledger files to read in from disk.+  }+ data Parsed = Parsed-  { p_passVerbosity :: TT.PassVerbosity-  , p_failVerbosity :: TT.FailVerbosity-  , p_indentAmt :: Pe.IndentAmt-  , p_colorToFile :: ColorToFile-  , p_baseTime :: BaseTime+  { p_indentAmt :: Pe.IndentAmt+  , p_passVerbosity :: TT.Verbosity+  , p_failVerbosity :: TT.Verbosity+  , p_groupPred :: TT.Name -> Bool+  , p_testPred :: TT.Name -> Bool+  , p_showSkippedTests :: Bool+  , p_groupVerbosity :: TT.GroupVerbosity+  , p_stopOnFail :: Bool+  , p_colorToFile :: Bool+  , p_baseTime :: Time.UTCTime+  , p_help :: Bool   , p_ledgers :: [String]   } -parseOpts :: WheatConf -> OA.Parser Parsed-parseOpts wc-  = Parsed-  <$> ( OA.nullOption-        ( OA.long "pass-verbosity"-        <> OA.short 'p'-        <> OA.reader parseVerbosity )-      <|> pure (passVerbosity wc) )+parseBaseTime :: String -> Ex.Exceptional MA.OptArgError Time.UTCTime+parseBaseTime s = case Parsec.parse CP.dateTime  "" (X.pack s) of+  Left e -> Ex.throw (MA.ErrorMsg $ "could not parse date: " ++ show e)+  Right g -> return . L.toUTC $ g -  <*> ( OA.nullOption-        ( OA.long "fail-verbosity"-        <> OA.short 'f'-        <> OA.reader parseVerbosity )-      <|> pure (failVerbosity wc) )+parseRegexp :: String -> Ex.Exceptional MA.OptArgError (TT.Name -> Bool)+parseRegexp s = case M.pcre M.Sensitive (X.pack s) of+  Ex.Exception e -> Ex.throw . MA.ErrorMsg $+    "could not parse regular expression: " ++ X.unpack e+  Ex.Success m -> return . M.match $ m -  <*> ( OA.option-        ( OA.long "indentation"-        <> OA.short 'i' )-      <|> pure (indentAmt wc) )+parseArg :: String -> Parsed -> Parsed+parseArg s p = p { p_ledgers = p_ledgers p ++ [s] } -  <*> ( OA.nullOption-        ( OA.long "color-to-file"-        <> OA.reader parseColorToFile )-      <|> pure (colorToFile wc))+allOpts :: [MA.OptSpec (Parsed -> Parsed)]+allOpts =+  [ MA.OptSpec ["indentation"] "i"+    (fmap (\i p -> p { p_indentAmt = i }) (MA.OneArgE MA.reader)) -  <*> ( OA.nullOption-        ( OA.long "base-date"-        <> OA.reader parseBaseTime )-      <|> pure (baseTime wc) )+  , MA.OptSpec ["pass-verbosity"] "p" $ MA.ChoiceArg+    [ ("silent", \p -> p { p_passVerbosity = TT.Silent })+    , ("minimal", \p -> p { p_passVerbosity = TT.PassFail })+    , ("false", \p -> p { p_passVerbosity = TT.FalseSubjects })+    , ("true", \p -> p { p_passVerbosity = TT.TrueSubjects })+    , ("all", \p -> p { p_passVerbosity = TT.Discards })+    ] -  <*> ( many (OA.argument OA.str mempty))+  , MA.OptSpec ["fail-verbosity"] "f" $ MA.ChoiceArg+    [ ("silent", \p -> p { p_failVerbosity = TT.Silent })+    , ("minimal", \p -> p { p_failVerbosity = TT.PassFail })+    , ("false", \p -> p { p_failVerbosity = TT.FalseSubjects })+    , ("true", \p -> p { p_failVerbosity = TT.TrueSubjects })+    , ("all", \p -> p { p_failVerbosity = TT.Discards })+    ] +  , MA.OptSpec ["group-regexp"] "g"+    (fmap (\f p -> p { p_groupPred = f }) (MA.OneArgE parseRegexp))++  , MA.OptSpec ["test-regexp"] "t"+    (fmap (\f p -> p { p_testPred = f }) (MA.OneArgE parseRegexp))++  , MA.OptSpec ["show-skipped-tests"] ""+    ( MA.NoArg (\p -> p { p_showSkippedTests+                          = not (p_showSkippedTests p) }))++  , MA.OptSpec ["group-verbosity"] "G" $ MA.ChoiceArg+    [ ("silent", \p -> p { p_groupVerbosity = TT.NoGroups })+    , ("active", \p -> p { p_groupVerbosity = TT.ActiveGroups })+    , ("all", \p -> p { p_groupVerbosity = TT.AllGroups })+    ]++  , MA.OptSpec ["stop-on-failure"] ""+    ( MA.NoArg (\p -> p { p_stopOnFail+                          = not (p_stopOnFail p) }))++  , MA.OptSpec ["color-to-file"] ""+    ( MA.NoArg (\p -> p { p_colorToFile+                          = not (p_colorToFile p) }))++  , MA.OptSpec ["base-date"] ""+    (fmap (\d p -> p { p_baseTime = d }) (MA.OneArgE parseBaseTime))+  ]++getTTOpts :: [a] -> Parsed -> TT.TestOpts a+getTTOpts as o = TT.TestOpts+  { TT.tIndentAmt = p_indentAmt o+  , TT.tPassVerbosity = p_passVerbosity o+  , TT.tFailVerbosity = p_failVerbosity o+  , TT.tGroupPred = p_groupPred o+  , TT.tTestPred = p_testPred o+  , TT.tShowSkippedTests = p_showSkippedTests o+  , TT.tGroupVerbosity = p_groupVerbosity o+  , TT.tSubjects = as+  , TT.tStopOnFail = p_stopOnFail o+  }++-- | Runs Wheat tests. Prints the result to standard output. Exits+-- unsuccessfully if the user gave bad command line options or if at+-- least a single test failed; exits successfully if all tests+-- succeeded. main :: (S.Runtime -> WheatConf) -> IO () main getWc = do   rt <- S.runtime-  let inf = OA.fullDesc-      wc = getWc rt-  psd <- OA.execParser (OA.info (parseOpts wc) inf)-  let term = if p_colorToFile psd || (S.output rt == S.IsTTY)-        then S.termFromEnv rt-        else S.autoTerm rt+  let wc = getWc rt+  fns <- MA.simpleWithHelp (help wc) MA.Intersperse allOpts+         parseArg+  let fn = foldl (flip (.)) id fns+      psd = fn (getParsedFromWheatConf wc)+  term <- Rb.smartTermFromEnv (p_colorToFile psd) IO.stdout   pfs <- getItems (p_ledgers psd)-  let tts = zipWith ($) (tests wc) (repeat (p_baseTime psd))-      doEval = TT.evalTestTree (p_indentAmt psd) 0 (p_passVerbosity psd)-                           (p_failVerbosity psd) pfs-      eithers = concatMap doEval tts-  passes <- mapM (showEitherChunk (C.printChunks term)) eithers-  when (not . and . catMaybes $ passes) Exit.exitFailure+  let ttOpts = getTTOpts pfs psd+      tts = zipWith ($) (tests wc) (repeat (p_baseTime psd))+      (cks, _, nFail) = TT.runTests ttOpts 0 tts+  Rb.printChunks term cks+  when (nFail > 0) Exit.exitFailure -showEitherChunk-  :: ([C.Chunk] -> IO ())-  -> Either C.Chunk (TT.Pass, [C.Chunk])-  -> IO (Maybe TT.Pass)-showEitherChunk f ei = case ei of-  Left ck -> f [ck] >> return Nothing-  Right (p, cs) -> f cs >> return (Just p)+getParsedFromWheatConf :: WheatConf -> Parsed+getParsedFromWheatConf w = Parsed+  { p_indentAmt = indentAmt w+  , p_passVerbosity = passVerbosity w+  , p_failVerbosity = failVerbosity w+  , p_groupPred = groupPred w+  , p_testPred = testPred w+  , p_showSkippedTests = showSkippedTests w+  , p_groupVerbosity = groupVerbosity w+  , p_stopOnFail = stopOnFail w+  , p_colorToFile = colorToFile w+  , p_baseTime = baseTime w+  , p_help = False+  , p_ledgers = ledgers w+  }  getItems :: [String] -> IO [L.PostFam] getItems ss = fmap f $ Cop.open ss@@ -155,15 +258,101 @@ -- -- Tests --++-- | Passes only if each posting is True. eachPostingMustBeTrue   :: TT.Name   -> Pe.Pdct L.PostFam   -> TT.TestTree L.PostFam eachPostingMustBeTrue n = TT.eachSubjectMustBeTrue n L.display +-- | Passes if at least a particular number of postings is True. atLeastNPostings   :: Int+  -- ^ The number of postings that must be true for the test to pass   -> TT.Name   -> Pe.Pdct L.PostFam   -> TT.TestTree L.PostFam-atLeastNPostings i n = TT.seriesAtLeastN n L.display i+atLeastNPostings i n = TT.nSubjectsMustBeTrue n L.display i++--+-- Help+--++help+  :: WheatConf+  -> String+  -- ^ Program name+  -> String+help wc pn = unlines+  [ "usage: " ++ pn ++ " [options] [FILE...]"+  , ""+  , briefDescription wc+  , ""+  , "Options:"+  , "  -i, --indentation AMT"+  , "    Indent each level by this many spaces"+  , "    " ++ dflt (show . indentAmt $ wc)+  , "  -p, --pass-verbosity VERBOSITY"+  , "    Verbosity for tests that pass. Argument may be:"+  , "      silent - show nothing at all"+  , "      minimal - show whether the test passed or failed"+  , "      false - show subjects that are false"+  , "      true - show subjects that are true or false"+  , "      all - show all subjects"+  , "      " ++ dflt (showVerbosity . passVerbosity $ wc)+  , "  -f, --fail-verbosity VERBOSITY"+  , "    Verbosity for tests that fail."+  , "    (uses same VERBOSITY options as --pass-verbosity)"+  , "    " ++ dflt (showVerbosity . failVerbosity $ wc)+  , "  -g, --group-regexp REGEXP"+  , "    Run only groups whose name matches the given"+  , "    Perl-compatible regular expression"+  , "    (overrides the compiled-in default)"+  , "  -t, --test-regexp REGEXP"+  , "    Run only tests whose name matches the given"+  , "    Perl-compatible regular expression"+  , "    (overrides the compiled-in default)"+  , "  --show-skipped-tests"+  , "    Toggle whether to show tests that are skipped"+  , "    using the --test-regexp option"+  , "    (does not affect groups that are skipped; see next option)"+  , "    " ++ dflt (show . showSkippedTests $ wc)+  , "  --G, group-verbosity ARG"+  , "    Control which group names are shown. Argument may be:"+  , "      silent - do not show any group names"+  , "      active - show group names that were not skipped"+  , "      all - show all group names, including skipped ones"+  , "      " ++ dflt (showGroupVerbosity . groupVerbosity $ wc)+  , "  --stop-on-failure"+  , "    Stop running tests after a single test fails"+  , "    " ++ dflt (show . stopOnFail $ wc)+  , "  --color-to-file"+  , "    Use color even when standard output is not a terminal"+  , "    " ++ dflt (show . colorToFile $ wc)+  , "  --base-date DATE"+  , "    Use this date as a basis for checks"+  , "    " ++ dflt ( Time.formatTime defaultTimeLocale "%c"+                     . baseTime $ wc)+  , ""+  ]+  ++ unlines (moreHelp wc)++dflt :: String -> String+dflt s = "(default: " ++ s ++ ")"++showVerbosity :: TT.Verbosity -> String+showVerbosity v = case v of+  TT.Silent -> "silent"+  TT.PassFail -> "minimal"+  TT.FalseSubjects -> "false"+  TT.TrueSubjects -> "true"+  TT.Discards -> "all"++showGroupVerbosity :: TT.GroupVerbosity -> String+showGroupVerbosity v = case v of+  TT.NoGroups -> "silent"+  TT.ActiveGroups -> "active"+  TT.AllGroups -> "all"++

@@ -1,4 +1,4 @@-{-# LANGUAGE DeriveDataTypeable, OverloadedStrings #-}+{-# LANGUAGE OverloadedStrings #-}  -- | Zinc - the Penny command-line interface module Penny.Zinc@@ -9,14 +9,14 @@   , runZinc   ) where -import qualified Penny.Steel.Chunk as Chk import qualified Penny.Cabin.Interface as I import qualified Penny.Cabin.Parsers as P import qualified Penny.Cabin.Scheme as E+import qualified Penny.Cabin.Scheme.Schemes as Schemes import qualified Penny.Copper as C import qualified Penny.Liberty as Ly-import qualified Penny.Steel.Expressions as X-import qualified Penny.Steel.Pdct as Pe+import qualified Data.Prednote.Expressions as X+import qualified Data.Prednote.Pdct as Pe import qualified Penny.Lincoln as L import qualified Penny.Lincoln.Queries as Q import qualified Penny.Shield as S@@ -28,7 +28,7 @@ import Data.Char (toUpper, toLower) import Data.Either (partitionEithers) import Data.List (isPrefixOf)-import Data.Maybe (mapMaybe, catMaybes)+import Data.Maybe (mapMaybe, catMaybes, fromMaybe) import Data.Monoid (mappend, mconcat, (<>)) import Data.Ord (comparing) import Data.Text (Text, pack)@@ -37,6 +37,7 @@ import qualified System.Exit as Exit import qualified System.IO as IO import qualified Text.Matchers as M+import qualified System.Console.Rainbow as R  runZinc   :: Defaults@@ -155,7 +156,7 @@   | ROperator (X.Token L.PostFam)   | RSortSpec (Ex.Exceptional Error Orderer)   | RColorToFile ColorToFile-  | RScheme E.TextSpecs+  | RScheme E.Changers   | RExprDesc X.ExprDesc   | RShowExpression   | RVerboseFilter@@ -275,10 +276,10 @@     ls = map f ss     f (E.Scheme n _ s) = (n, RScheme s) -getScheme :: Defaults -> [OptResult] -> Maybe E.TextSpecs+getScheme :: Defaults -> [OptResult] -> Maybe E.Changers getScheme d ls =   case mapMaybe getOpt ls of-    [] -> fmap E.textSpecs $ defaultScheme d+    [] -> fmap E.changers $ defaultScheme d     xs -> Just $ last xs   where     getOpt o = case o of@@ -310,11 +311,11 @@     -- subsequent parses of the command line.    , foSorterFilterer :: [L.Transaction]-                    -> ([Chk.Chunk], [L.Box Ly.LibertyMeta])+                    -> ([R.Chunk], [L.Box Ly.LibertyMeta])     -- ^ Applied to a list of Transaction, will sort and filter     -- the transactions and assign them LibertyMeta. -  , foTextSpecs :: Maybe E.TextSpecs+  , foTextSpecs :: Maybe E.Changers    , foColorToFile :: ColorToFile   , foExprDesc :: X.ExprDesc@@ -361,6 +362,7 @@ makeMode rt fo r = fmap makeIO mode   where     mode = snd (r rt) (foResultSensitive fo) (foResultFactory fo)+           (fromMaybe Schemes.plainLabels . foTextSpecs $ fo)            (foExprDesc fo) (fmap snd (foSorterFilterer fo))     makeIO parseResult = do       (posArgs, printRpt) <-@@ -369,11 +371,11 @@       let term = if unColorToFile (foColorToFile fo)                  then S.termFromEnv rt                  else S.autoTerm rt-          printer = Chk.printChunks term+          printer = R.printChunks term           verbFiltChunks = fst . foSorterFilterer fo $ txns       showFilterExpression printer (foShowExpression fo) (foPredicate fo)       showVerboseFilter printer (foVerboseFilter fo) verbFiltChunks-      Ex.switch handleTextError (printChunks printer (foTextSpecs fo))+      Ex.switch handleTextError (R.printChunks term)         $ printRpt txns pps  @@ -386,11 +388,11 @@ indentAmt :: Pe.IndentAmt indentAmt = 4 -blankLine :: Chk.Chunk-blankLine = Chk.chunk Chk.defaultTextSpec "\n"+blankLine :: R.Chunk+blankLine = R.plain "\n"  showFilterExpression-  :: ([Chk.Chunk] -> IO ())+  :: ([R.Chunk] -> IO ())   -> ShowExpression   -> Pe.Pdct L.PostFam   -> IO ()@@ -400,19 +402,19 @@   else ptr $ info : blankLine :              (Pe.showPdct indentAmt 0 pdct ++ [blankLine])   where-    info = Chk.chunk Chk.defaultTextSpec "Posting filter expression:\n"+    info = R.plain "Posting filter expression:\n"  showVerboseFilter-  :: ([Chk.Chunk] -> IO ())+  :: ([R.Chunk] -> IO ())   -> VerboseFilter-  -> [Chk.Chunk]+  -> [R.Chunk]   -> IO () showVerboseFilter ptr (VerboseFilter vb) cks =   if not vb   then return ()   else ptr $ info : blankLine : (cks ++ [blankLine])   where-    info = Chk.chunk Chk.defaultTextSpec "Filtering information:\n"+    info = R.plain "Filtering information:\n"  -- | Splits a Ledger into its Transactions and PricePoints. splitLedger :: C.Ledger -> ([L.Transaction], [L.PricePoint])@@ -422,22 +424,6 @@       C.Transaction t -> Just $ Left t       C.PricePoint p -> Just $ Right p       _ -> Nothing--printChunks-  :: ([Chk.Chunk] -> IO ())-  -> Maybe E.TextSpecs-  -> [Either Chk.Chunk E.PreChunk]-  -> IO ()-printChunks printer mayS =-  printer-  . map makeChunk-  where-    makeChunk eiChkOrPc =-      case eiChkOrPc of-        Left c -> c-        Right pc -> case mayS of-          Nothing -> Chk.chunk Chk.defaultTextSpec (E.text pc)-          Just s -> E.makeChunk s pc  helpText   :: Defaults

@@ -1,5 +1,5 @@ Name: penny-lib-Version: 0.8.0.0+Version: 0.10.0.0 Cabal-version: >=1.8 Build-Type: Simple License: BSD3@@ -45,12 +45,13 @@     , explicit-exception ==0.1.*     , matchers ==0.6.*     , monad-loops ==0.3.*-    , multiarg ==0.10.*+    , multiarg ==0.12.*     , old-locale ==1.0.*-    , optparse-applicative ==0.5.*     , parsec >= 3.1.2 && < 3.2     , pcre-light ==0.4.*+    , prednote == 0.4.*     , pretty-show ==1.5.*+    , rainbow ==0.2.*     , semigroups ==0.9.*     , split ==0.2.*     , strict ==0.3.*@@ -127,14 +128,7 @@     , Penny.Lincoln.Transaction.Unverified     , Penny.Shield     , Penny.Steel-    , Penny.Steel.Chunk-    , Penny.Steel.Chunk.Switch-    , Penny.Steel.Expressions-    , Penny.Steel.Expressions.Infix-    , Penny.Steel.Expressions.RPN     , Penny.Steel.NestedMap-    , Penny.Steel.Pdct-    , Penny.Steel.TestTree     , Penny.Wheat     , Penny.Zinc