penny-lib 0.6.0.0 → 0.8.0.0

raw patch · 54 files changed

+5019/−4209 lines, 54 filesdep +optparse-applicativedep +pcre-lightdep ~bytestringdep ~containersdep ~matchersPVP ok

version bump matches the API change (PVP)

Dependencies added: optparse-applicative, pcre-light

Dependency ranges changed: bytestring, containers, matchers, multiarg, pretty-show, semigroups

API changes (from Hackage documentation)

Files

• Penny.hs +20/−6
• Penny/Brenner.hs +32/−85
• Penny/Brenner/Clear.hs +27/−38
• Penny/Brenner/Database.hs +12/−14
• Penny/Brenner/Import.hs +21/−49
• Penny/Brenner/Merge.hs +122/−41
• Penny/Brenner/Print.hs +15/−21
• Penny/Brenner/Util.hs +5/−15
• Penny/Cabin/Balance/Convert.hs +18/−22
• Penny/Cabin/Balance/Convert/Chunker.hs +1/−1
• Penny/Cabin/Balance/Convert/Options.hs +0/−1
• Penny/Cabin/Balance/Convert/Parser.hs +1/−8
• Penny/Cabin/Balance/MultiCommodity.hs +6/−8
• Penny/Cabin/Balance/MultiCommodity/Chunker.hs +1/−1
• Penny/Cabin/Balance/MultiCommodity/Parser.hs +1/−7
• Penny/Cabin/Balance/Util.hs +1/−1
• Penny/Cabin/Chunk.hs +0/−2469
• Penny/Cabin/Chunk/Switch.hs +0/−26
• Penny/Cabin/Interface.hs +22/−7
• Penny/Cabin/Posts.hs +110/−43
• Penny/Cabin/Posts/Allocated.hs +1/−1
• Penny/Cabin/Posts/BottomRows.hs +1/−1
• Penny/Cabin/Posts/Chunk.hs +1/−1
• Penny/Cabin/Posts/Meta.hs +6/−5
• Penny/Cabin/Posts/Parser.hs +115/−69
• Penny/Cabin/Row.hs +1/−1
• Penny/Cabin/Scheme.hs +1/−1
• Penny/Cabin/Scheme/Schemes.hs +2/−2
• Penny/Copper.hs +16/−22
• Penny/Liberty.hs +239/−216
• Penny/Liberty/Expressions.hs +0/−63
• Penny/Liberty/Expressions/Infix.hs +0/−218
• Penny/Liberty/Expressions/RPN.hs +0/−112
• Penny/Lincoln.hs +45/−1
• Penny/Lincoln/Bits.hs +1/−0
• Penny/Lincoln/Bits/DateTime.hs +17/−0
• Penny/Lincoln/Builders.hs +5/−6
• Penny/Lincoln/Matchers.hs +2/−4
• Penny/Lincoln/NestedMap.hs +0/−275
• Penny/Lincoln/Predicates.hs +188/−95
• Penny/Lincoln/Transaction.hs +1/−0
• Penny/Shield.hs +22/−4
• Penny/Steel.hs +3/−0
• Penny/Steel/Chunk.hs +2452/−0
• Penny/Steel/Chunk/Switch.hs +26/−0
• Penny/Steel/Expressions.hs +70/−0
• Penny/Steel/Expressions/Infix.hs +126/−0
• Penny/Steel/Expressions/RPN.hs +74/−0
• Penny/Steel/NestedMap.hs +275/−0
• Penny/Steel/Pdct.hs +292/−0
• Penny/Steel/TestTree.hs +198/−0
• Penny/Wheat.hs +169/−0
• Penny/Zinc.hs +231/−234
• penny-lib.cabal +24/−15

@@ -15,12 +15,15 @@   , E.EvenAndOdd(..)   , Sw.switchForeground   , Sw.switchBackground-  , module Penny.Cabin.Chunk+  , module Penny.Steel.Chunk    -- ** Sorting   , Z.SortField(..)   , CabP.SortOrder(..) +  -- ** Expression type+  , Exp.ExprDesc(..)+   -- ** Formatting quantities   , defaultQtyFormat @@ -67,9 +70,15 @@     -- "Penny.Lincoln" - the Penny core. Depends on no other Penny     -- components.     ---    -- "Penny.Shield" the Penny runtime environment. Depends on+    -- "Penny.Shield" - the Penny runtime environment. Depends on     -- Lincoln.     --+    -- "Penny.Steel" - independent utilities. Depends on no other+    -- Penny components.+    --+    -- "Penny.Wheat" - tools to use with+    -- "Penny.Steel.Prednote". Depends on Steel, Lincoln, and Copper.+    --     -- "Penny.Zinc" - the Penny command-line interface. Depends on     -- Cabin, Copper, Liberty, and Lincoln.     --@@ -83,8 +92,8 @@ 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.Cabin.Chunk-import qualified Penny.Cabin.Chunk.Switch as Sw+import Penny.Steel.Chunk+import qualified Penny.Steel.Chunk.Switch as Sw import qualified Penny.Cabin.Interface as I import qualified Penny.Cabin.Options as CO import qualified Penny.Cabin.Parsers as CabP@@ -94,9 +103,10 @@ 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 Penny.Zinc as Z import qualified Penny.Shield as S-import qualified Text.Matchers.Text as Mr+import qualified Text.Matchers as Mr  -- | This type contains settings for all the reports, as well as -- default settings for the global options. Some of these can be@@ -111,6 +121,10 @@   , colorToFile :: Bool     -- ^ Use colors when standard output is not a terminal? +  , expressionType :: Exp.ExprDesc+    -- ^ Use RPN or infix expressions? This affects both the posting+    -- filter and the filter for the Postings report.+   , defaultScheme :: Maybe E.Scheme     -- ^ Default color scheme. If Nothing, there is no default color     -- scheme. If there is no default color scheme and the user does@@ -277,6 +291,7 @@   , Z.defaultScheme = defaultScheme d   , Z.moreSchemes = additionalSchemes d   , Z.sorter = sorter d+  , Z.exprDesc = expressionType d   }  toBalanceDefaults :: Defaults -> MP.ParseOpts@@ -284,7 +299,6 @@   { MP.showZeroBalances =       CO.ShowZeroBalances . balanceShowZeroBalances $ d   , MP.order = balanceOrder d-  , MP.needsHelp = False   }  toConvertDefaults :: Defaults -> ConvOpts.DefaultOpts

@@ -30,104 +30,51 @@ import Control.Applicative ((<*>)) import qualified System.Console.MultiArg as MA import qualified Control.Monad.Exception.Synchronous as Ex-import System.Exit (exitFailure)-import qualified System.IO as IO  brennerMain :: Config -> IO () brennerMain cf = do-  as <- MA.getArgs-  pr <- MA.getProgName   let cf' = convertConfig cf-      r = MA.modes globalOpts (preProcessor cf') whatMode as-  processParseResult pr cf' r+  ioAction <- MA.modesWithHelp (help cf') globalOpts+    (preProcessor cf')+  ioAction -data Arg-  = AHelp-  | AFitAcct String+data Arg = AFitAcct String   deriving (Eq, Show)  toFitAcctOpt :: Arg -> Maybe String-toFitAcctOpt a = case a of { AFitAcct s -> Just s; _ -> Nothing }+toFitAcctOpt a = case a of { AFitAcct s -> Just s }  globalOpts :: [MA.OptSpec Arg] globalOpts =-  [ MA.OptSpec ["help"] "h" (MA.NoArg AHelp)-  , MA.OptSpec ["fit-account"] "f" (MA.OneArg AFitAcct)-  ]--data PreProc-  = NeedsHelp-  | DoIt (Maybe Y.FitAcct)--preProcessor :: Y.Config -> [Arg] -> Ex.Exceptional String PreProc-preProcessor cf as =-  if any (== AHelp) as-  then return NeedsHelp-  else do-    let cardOpt = case mapMaybe toFitAcctOpt as of-          [] -> Nothing-          xs -> Just . last $ xs-    card <- case cardOpt of-      Nothing -> return $ Y.defaultFitAcct cf-      Just o ->-        let pdct (Y.Name n, _) = n == X.pack o-        in case filter pdct (Y.moreFitAccts cf) of-          [] -> Ex.throw $ "financial institution account "-                           ++ o ++ " not configured."-          (_, c):[] -> return $ Just c-          _ -> Ex.throw $ "more than one financial institution account "-                          ++ "named " ++ o ++ " configured."-    return $ DoIt card--whatMode-  :: PreProc-  -> Either (String -> String)-      [MA.Mode (Ex.Exceptional String (IO ()))]-whatMode pp = case pp of-  NeedsHelp -> Left id-  DoIt mayCd ->-    Right $ [C.mode, I.mode, M.mode, P.mode, D.mode] <*> [mayCd]---processParseResult-  :: String-  -- ^ Program name-  -> Y.Config--  -> Ex.Exceptional MA.Error-      (a, Either b (Ex.Exceptional String (IO ())))-  -> IO ()-processParseResult pr cf ex =-  case ex of-    Ex.Exception err -> do-      IO.hPutStr IO.stderr $ MA.formatError pr err-      exitFailure-    Ex.Success g -> processResult pr cf g---processResult-  :: String-  -- ^ Program name+  [ MA.OptSpec ["fit-account"] "f" (MA.OneArg AFitAcct) ] -  -> Y.Config-  -> (a, Either b (Ex.Exceptional String (IO ())))-  -> IO ()-processResult pr cf (_, ei) =-  case ei of-    Left _ -> putStr (help pr cf)-    Right ex -> case ex of-      Ex.Exception e -> do-        putStrLn $ pr ++ ": error: " ++ e-        exitFailure-      Ex.Success g -> g+preProcessor+  :: Y.Config -> [Arg] -> Either (a -> IO ()) [MA.Mode (IO ())]+preProcessor cf as = Ex.toEither . Ex.mapException (const . fail) $ do+  let mayFiStr = case mapMaybe toFitAcctOpt as of+        [] -> Nothing+        xs -> Just . last $ xs+  fi <- case mayFiStr of+    Nothing -> return $ Y.defaultFitAcct cf+    Just s ->+      let pdct (Y.Name n, _) = n == X.pack s+      in case filter pdct (Y.moreFitAccts cf) of+           [] -> Ex.throw $+              "financial institution account "+              ++ s ++ " not configured."+           (_, c):[] -> return $ Just c+           _ -> Ex.throw $+              "more than one financial institution account "+              ++ "named " ++ s ++ " configured."+  return $ [C.mode, I.mode, M.mode, P.mode, D.mode] <*> [fi] -help ::-  String+help+  :: Y.Config+  -> String   -- ^ Program name -  -> Y.Config   -> String-help n c = unlines ls ++ cs+help c n = unlines ls ++ cs   where     ls = [ "usage: " ++ n ++ " [global-options]"             ++ " COMMAND [local-options]"@@ -193,7 +140,7 @@   ++ "\n\n"  --- | Information to configure a single card account.+-- | Information to configure a single financial institution account. data FitAcct = FitAcct   { dbLocation :: String     -- ^ Path and filename to where the database is kept. You can use@@ -252,8 +199,8 @@ convertFitAcct :: FitAcct -> Y.FitAcct convertFitAcct (FitAcct db ax df cy gs tl sd sb ps) = Y.FitAcct   { Y.dbLocation = Y.DbLocation . X.pack $ db-  , Y.pennyAcct = Y.PennyAcct . Bd.account $ ax-  , Y.defaultAcct = Y.DefaultAcct . Bd.account $ df+  , Y.pennyAcct = Y.PennyAcct . Bd.account . X.pack $ ax+  , Y.defaultAcct = Y.DefaultAcct . Bd.account . X.pack $ df   , Y.currency = Y.Currency . L.Commodity . X.pack $ cy   , Y.groupSpecs = gs   , Y.translator = tl

@@ -17,16 +17,14 @@ import qualified Penny.Copper.Types as Y import qualified Penny.Copper as C import qualified Penny.Copper.Render as R-import System.Exit (exitFailure)-import qualified System.IO as IO import Text.Show.Pretty (ppShow) import qualified Penny.Brenner.Types as Y import qualified Penny.Brenner.Util as U  -help :: String-help = unlines-  [ "usage: penny-fit clear clear [options] FIT_FILE LEDGER_FILE..."+help :: String -> String+help pn = unlines+  [ "usage: " ++ pn ++ " clear clear [options] FIT_FILE LEDGER_FILE..."   , "Parses all postings that are in FIT_FILE. Then marks all"   , "postings that are in the FILEs given that correspond to one"   , "of the postings in the FIT_FILE as being cleared."@@ -43,12 +41,11 @@   ]  data Arg-  = AHelp-  | APosArg String+  = APosArg String   deriving (Eq, Show)  toPosArg :: Arg -> Maybe String-toPosArg a = case a of { APosArg s -> Just s; _ -> Nothing }+toPosArg a = case a of { APosArg s -> Just s }  data Opts = Opts   { csvLocation :: Y.FitFileLocation@@ -56,56 +53,48 @@   } deriving Show  -mode :: Maybe Y.FitAcct -> MA.Mode (Ex.Exceptional String (IO ()))+mode :: Maybe Y.FitAcct -> MA.Mode (IO ()) mode c = MA.Mode   { MA.mName = "clear"   , MA.mIntersperse = MA.Intersperse-  , MA.mOpts = [ MA.OptSpec ["help"] "h" (MA.NoArg AHelp) ]+  , MA.mOpts = [ ]   , MA.mPosArgs = APosArg   , MA.mProcess = process c+  , MA.mHelp = help   } -process :: Maybe Y.FitAcct -> [Arg] -> Ex.Exceptional String (IO ())-process mayC as =-  if any (== AHelp) as-  then return $ putStrLn help-  else do-    c <- case mayC of-      Just cd -> return cd-      Nothing -> Ex.throw $ "no financial institution account given"-                 ++ " on command line, and no default financial"-                 ++ " institution configured."-    (csv, ls) <- case mapMaybe toPosArg as of-      [] -> Ex.throw $ "clear: you must provide a postings file."-      x:xs -> return (Y.FitFileLocation x, xs)-    let os = Opts csv ls-    return $ runClear c os--fatal :: String -> IO a-fatal s = do-  IO.hPutStrLn IO.stderr $ "penny-fit clear: error: " ++ s-  exitFailure+process :: Maybe Y.FitAcct -> [Arg] -> IO ()+process mayC as = do+  c <- case mayC of+    Just cd -> return cd+    Nothing -> fail $ "no financial institution account given"+               ++ " on command line, and no default financial"+               ++ " institution configured."+  (csv, ls) <- case mapMaybe toPosArg as of+    [] -> fail "clear: you must provide a postings file."+    x:xs -> return (Y.FitFileLocation x, xs)+  let os = Opts csv ls+  runClear c os  runClear :: Y.FitAcct -> Opts -> IO () runClear c os = do-  dbList <- U.quitOnError-              $ U.loadDb (Y.AllowNew False) (Y.dbLocation c)+  dbList <- U.loadDb (Y.AllowNew False) (Y.dbLocation c)   let db = M.fromList dbList       (_, prsr) = Y.parser c-  txns <- U.quitOnError $ prsr (csvLocation os)-  leds <- C.openStdin (ledgerLocations os)-  toClear <- case mapM (findUNumber db) txns of-    Nothing -> fatal $ "at least one posting was not found in the"+  txns <- fmap (Ex.switch fail return) $ prsr (csvLocation os)+  leds <- C.open (ledgerLocations os)+  toClear <- case mapM (findUNumber db) (concat txns) of+    Nothing -> fail $ "at least one posting was not found in the"                        ++ " database. Ensure all postings have "                        ++ "been imported and merged."     Just ls -> return $ Set.fromList ls   let (led', left) = changeLedger (Y.pennyAcct c) toClear leds   when (not (Set.null left))-    (fatal $ "some postings were not cleared. "+    (fail $ "some postings were not cleared. "       ++ "Those not cleared:\n" ++ ppShow left)   case R.ledger (Y.groupSpecs c) led' of     Nothing ->-      fatal "could not render resulting ledger."+      fail "could not render resulting ledger."     Just txt -> TIO.putStr txt  

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

@@ -5,13 +5,10 @@ import qualified System.Console.MultiArg as MA import qualified Penny.Brenner.Types as Y import qualified Penny.Brenner.Util as U-import qualified System.IO as IO-import qualified System.Exit as E   data Arg-  = AHelp-  | AFitFile String+  = AFitFile String   | AAllowNew   deriving (Eq, Show) @@ -27,58 +24,35 @@               -> IO (Ex.Exceptional String [Y.Posting])   } -{- mode-  :: Y.DbLocation-  -> ( Y.FitFileLocation-       -> IO (Ex.Exceptional String [Y.Posting]))-  -> MA.Mode (Ex.Exceptional String (IO ()))-mode dbLoc prsr = MA.Mode-  { MA.mName = "import"-  , MA.mIntersperse = MA.Intersperse-  , MA.mOpts =-      [ MA.OptSpec ["help"] "h" (MA.NoArg AHelp)-      , MA.OptSpec ["new"] "n" (MA.NoArg AAllowNew)-      ]-  , MA.mPosArgs = AFitFile-  , MA.mProcess = processor dbLoc prsr-  }--}--mode   :: Maybe Y.FitAcct-  -> MA.Mode (Ex.Exceptional String (IO ()))+  -> MA.Mode (IO ()) mode mayFa = MA.Mode   { MA.mName = "import"   , MA.mIntersperse = MA.Intersperse   , MA.mOpts =-      [ MA.OptSpec ["help"] "h" (MA.NoArg AHelp)-      , MA.OptSpec ["new"] "n" (MA.NoArg AAllowNew)-      ]+      [ MA.OptSpec ["new"] "n" (MA.NoArg AAllowNew) ]   , MA.mPosArgs = AFitFile   , MA.mProcess = processor mayFa+  , MA.mHelp = help   }  processor   :: Maybe Y.FitAcct   -> [Arg]-  -> Ex.Exceptional String (IO ())+  -> IO () processor mayFa as = do-  let err s = Ex.throw $ "import: " ++ s-  if any (== AHelp) as-    then return $ putStrLn help-    else do-      (dbLoc, prsr) <- case mayFa of-        Nothing -> err $ "no financial institution account provided"-          ++ " on command line, and no default financial institution"-          ++ " account is configured."-        Just fa -> return (Y.dbLocation fa, snd . Y.parser $ fa)-      loc <- case mapMaybe toFitFile as of-        [] -> err "you must provide a postings file to read"-        x:[] -> return (Y.FitFileLocation x)-        _ -> err "you cannot provide more than one postings file to read"-      let aNew = Y.AllowNew $ any (== AAllowNew) as-      return $ doImport dbLoc (ImportOpts loc aNew prsr)+  (dbLoc, prsr) <- case mayFa of+    Nothing -> fail $ "no financial institution account provided"+      ++ " on command line, and no default financial institution"+      ++ " account is configured."+    Just fa -> return (Y.dbLocation fa, snd . Y.parser $ fa)+  loc <- case mapMaybe toFitFile as of+    [] -> fail "you must provide a postings file to read"+    x:[] -> return (Y.FitFileLocation x)+    _ -> fail "you cannot provide more than one postings file to read"+  let aNew = Y.AllowNew $ any (== AAllowNew) as+  doImport dbLoc (ImportOpts loc aNew prsr)   -- | Appends new Amex transactions to the existing list.@@ -106,20 +80,18 @@  doImport :: Y.DbLocation -> ImportOpts -> IO () doImport dbLoc os = do-  txnsOld <- U.quitOnError $ U.loadDb (allowNew os) dbLoc+  txnsOld <- U.loadDb (allowNew os) dbLoc   parseResult <- parser os (fitFile os)   ins <- case parseResult of-    Ex.Exception e -> do-      IO.hPutStrLn IO.stderr $ "penny-fit: error: " ++ e-      E.exitFailure+    Ex.Exception e -> fail e     Ex.Success g -> return g   let (new, len) = appendNew txnsOld ins   U.saveDb dbLoc new   putStrLn $ "imported " ++ show len ++ " new transactions." -help :: String-help = unlines-  [ "penny-fit [global-options] import [local-options] FIT_FILE"+help :: String -> String+help pn = unlines+  [ "usage: " ++ pn ++ "  [global-options] import [local-options] FIT_FILE"   , "where FIT_FILE is the file downloaded from the financial"   , "institution."   , ""

@@ -1,78 +1,70 @@ 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)+import Data.List (find, sortBy, foldl') import qualified Data.Map as M-import Data.Maybe (mapMaybe, isNothing)+import Data.Maybe (mapMaybe, isNothing, fromMaybe) import Data.Monoid (First(..), mconcat) import qualified Data.Text as X import qualified Data.Text.IO as TIO import qualified System.Console.MultiArg as MA-import qualified Control.Monad.Exception.Synchronous as Ex-import qualified System.IO as IO import qualified Penny.Copper as C import qualified Penny.Copper.Render as R import qualified Penny.Lincoln as L import qualified Penny.Lincoln.Transaction.Unverified as U import qualified Penny.Lincoln.Queries as Q-import System.Exit (exitFailure) import qualified Penny.Brenner.Types as Y import qualified Penny.Brenner.Util as U +type NoAuto = Bool+ data Arg-  = AHelp-  | APos String+  = APos String+  | ANoAuto   deriving (Eq, Show)  toPosArg :: Arg -> Maybe String toPosArg a = case a of { APos s -> Just s; _ -> Nothing } -mode :: Maybe Y.FitAcct -> MA.Mode (Ex.Exceptional String (IO ()))+mode :: Maybe Y.FitAcct -> MA.Mode (IO ()) mode maybeC = MA.Mode   { MA.mName = "merge"   , MA.mIntersperse = MA.Intersperse-  , MA.mOpts =-    [ MA.OptSpec ["help"] "h" (MA.NoArg AHelp)-    ]+  , MA.mOpts = [MA.OptSpec ["no-auto"] "n" (MA.NoArg ANoAuto)]   , MA.mPosArgs = APos   , MA.mProcess = processor maybeC+  , MA.mHelp = help   } -processor :: Maybe Y.FitAcct -> [Arg] -> Ex.Exceptional a (IO ())-processor maybeC as = return $-  if any (== AHelp) as-  then putStrLn help-  else doMerge maybeC (mapMaybe toPosArg as)+processor :: Maybe Y.FitAcct -> [Arg] -> IO ()+processor maybeC as =+  doMerge maybeC (ANoAuto `elem` as) (mapMaybe toPosArg as) -doMerge :: Maybe Y.FitAcct -> [String] -> IO ()-doMerge maybeAcct ss = do+doMerge :: Maybe Y.FitAcct -> NoAuto -> [String] -> IO ()+doMerge maybeAcct noAuto ss = do   acct <- case maybeAcct of     Nothing -> do-      IO.hPutStrLn IO.stderr $ "merge: error: no financial"+      fail $ "no financial"         ++ " institution account provided on command line, and"         ++ " no default account configured."-      exitFailure     Just ac -> return ac-  dbLs <- U.quitOnError-          $ U.loadDb (Y.AllowNew False) (Y.dbLocation acct)-  l <- C.openStdin ss+  dbLs <- U.loadDb (Y.AllowNew False) (Y.dbLocation acct)+  l <- C.open ss   let dbWithEntry = fmap (pairWithEntry acct) . M.fromList $ dbLs       (l', db') = changeItems acct                   l (filterDb (Y.pennyAcct acct) dbWithEntry l)-      newTxns = createTransactions acct db'+      newTxns = createTransactions noAuto acct l dbLs db'       final = C.Ledger (C.unLedger l' ++ newTxns)   case R.ledger (Y.groupSpecs acct) final of-    Nothing -> do-      IO.hPutStrLn IO.stderr "Could not render final ledger."-      exitFailure+    Nothing -> fail "Could not render final ledger."     Just x -> TIO.putStr x  -help :: String-help = unlines-  [ "penny-fit merge: merges new transactions from database"+help :: String -> String+help pn = unlines+  [ "usage: " ++ pn ++ " merge: merges new transactions from database"   , "to ledger file."   , "usage: penny-fit merge [options] FILE..."   , "Results are printed to standard output. If no FILE, or if FILE is -,"@@ -80,6 +72,7 @@   , ""   , "Options:"   , "  -h, --help - show help and exit"+  , "  -n, --no-auto - do not automatically assign payees and accounts"   ]  -- | Removes all Brenner postings that already have a Penny posting@@ -234,10 +227,13 @@ -- the Amex payee if that string is non empty; otherwise, uses the -- Amex description for the payee. newTransaction-  :: Y.FitAcct+  :: NoAuto+  -> Y.FitAcct+  -> UNumberLookupMap+  -> PyeLookupMap   -> (Y.UNumber, (Y.Posting, L.Entry))   -> L.Transaction-newTransaction acct (u, (a, e)) = L.rTransaction rt+newTransaction noAuto acct mu mp (u, (a, e)) = L.rTransaction rt   where     rt = L.RTransaction       { L.rtCommodity = Y.unCurrency . Y.currency $ acct@@ -251,24 +247,109 @@       }     tl = (U.emptyTopLine ( L.dateTimeMidnightUTC . Y.unDate                            . Y.date $ a))-         { U.tPayee = Just (L.Payee pa) }-    pa = if X.null . Y.unPayee . Y.payee $ a-         then Y.unDesc . Y.desc $ a-         else Y.unPayee . Y.payee $ 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+    dfltAcct = Y.unDefaultAcct . Y.defaultAcct $ acct+    (pa, ac) =+      if noAuto+      then (dfltPye, dfltAcct)+      else ( fromMaybe dfltPye guessedPye,+             fromMaybe dfltAcct guessedAcct)     pennyAcct = Y.unPennyAcct . Y.pennyAcct $ acct     p1 = (U.emptyRPosting pennyAcct (L.qty . L.amount $ e))           { U.rTags = L.Tags [newLincolnUNumber u] }-    p2 = U.emptyIPosting (Y.unDefaultAcct . Y.defaultAcct $ acct)+    p2 = U.emptyIPosting ac  -- | Creates new transactions for all the items remaining in the -- DbMap. Appends a blank line after each one. createTransactions-  :: Y.FitAcct+  :: NoAuto+  -> Y.FitAcct+  -> C.Ledger+  -> Y.DbList   -> DbWithEntry   -> [C.Item]-createTransactions acct =+createTransactions noAuto acct led dbLs db =   concatMap (\i -> [i, C.BlankLine])   . map C.Transaction-  . map (newTransaction acct)+  . map (newTransaction noAuto acct mu mp)   . M.assocs+  $ db+  where+    mu = makeUNumberLookup 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]++-- | 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+  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+    g (_, p1) (_, p2) = compare (Y.date p1) (Y.date p2)++-- | Given a list of keys, find the first key that is in the+-- map. Returns Nothing if no key is in the map.+findFirstKey :: Ord k => M.Map k v -> [k] -> Maybe v+findFirstKey _ [] = Nothing+findFirstKey m (k:ks) = case M.lookup k m of+  Nothing -> findFirstKey m ks+  Just v -> Just v++-- | 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)++-- | Makes a payee lookup map. Puts those postings which match the+-- PennyAcct and have a UNumber into the map. (If two postings match+-- the PennyAcct and have the same UNumber, the one that appears later+-- in the ledger file will be in the map.)+makePyeLookupMap :: Y.PennyAcct -> C.Ledger -> PyeLookupMap+makePyeLookupMap a l+  = M.fromList . mapMaybe f . concatMap L.postFam . mapMaybe toPstg+    . C.unLedger $ l+  where+    f pstg = do+      guard $ (Q.account pstg) == Y.unPennyAcct a+      u <- getUNumberFromTags . Q.tags $ pstg+      let (L.Child _ sib sibs _) = L.unPostFam pstg+          ac = if null sibs+               then Just (L.pAccount sib)+               else Nothing+      return (u, (Q.payee pstg, ac))+    toPstg i = case i of { C.Transaction t -> Just t; _ -> Nothing }++-- | Given a UNumber and the maps, looks up the payee and account+-- information from previous transactions if this information is+-- available.+guessInfo+  :: 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+  findFirstKey mp unums

@@ -7,14 +7,12 @@ import qualified Penny.Brenner.Types as Y import qualified Penny.Brenner.Util as U import qualified System.Console.MultiArg as MA-import qualified System.IO as IO-import qualified System.Exit as E import qualified Control.Monad.Exception.Synchronous as Ex import Data.Maybe (mapMaybe) -help :: String-help = unlines-  [ "penny-fit [global-options] print [local-options] FILE..."+help :: String -> String+help pn = unlines+  [ "usage: " ++ pn ++ "  [global-options] print [local-options] FILE..."   , "Parses the transactions in each FILE using the appropriate parser"   , "and prints the parse result to standard output."   , ""@@ -23,34 +21,32 @@   ]  data Arg-  = ArgHelp-  | ArgFile String+  = ArgFile String   deriving (Eq, Show)  mode   :: Maybe Y.FitAcct-  -> MA.Mode (Ex.Exceptional String (IO ()))+  -> MA.Mode (IO ()) mode mayFa = MA.Mode   { MA.mName = "print"   , MA.mIntersperse = MA.Intersperse-  , MA.mOpts = [MA.OptSpec ["help"] "h" (MA.NoArg ArgHelp)]+  , MA.mOpts = []   , MA.mPosArgs = ArgFile   , MA.mProcess = processor mayFa+  , MA.mHelp = help   }  processor   :: Maybe Y.FitAcct   -> [Arg]-  -> Ex.Exceptional String (IO ())+  -> IO () processor mayFa ls =-  if any (== ArgHelp) ls-  then return (putStrLn help)-  else case mayFa of-          Nothing -> Ex.throw $-            "no financial institution account"-            ++ " provided on command line, and no account"-            ++ " configured by default."-          Just fa -> return $ doPrint (snd . Y.parser $ fa) ls+  case mayFa of+    Nothing -> fail $+      "no financial institution account"+      ++ " provided on command line, and no account"+      ++ " configured by default."+    Just fa -> doPrint (snd . Y.parser $ fa) ls  doPrint   :: (Y.FitFileLocation -> IO (Ex.Exceptional String [Y.Posting]))@@ -62,10 +58,8 @@       r <- prsr file       case r of         Ex.Exception s -> do-          IO.hPutStrLn IO.stderr $ "penny-fit print: error: " ++ s-          E.exitFailure+          fail $ "penny-fit print: error: " ++ s         Ex.Success ps -> mapM putStr . map U.showPosting $ ps     toFile a = case a of       ArgFile s -> Just (Y.FitFileLocation s)-      _ -> Nothing 

@@ -9,9 +9,6 @@ import qualified Penny.Copper.Parsec as CP import qualified Text.Parsec as P import qualified Penny.Lincoln as L-import Control.Monad (join)-import qualified System.IO as IO-import qualified System.Exit as E  -- | Loads the database from disk. If allowNew is True, then does not -- fail if the file was not found.@@ -22,15 +19,17 @@   -> Y.DbLocation   -- ^ DB location -  -> IO (Ex.Exceptional String Y.DbList)+  -> IO Y.DbList loadDb (Y.AllowNew allowNew) (Y.DbLocation dbLoc) = do   eiStr <- IOE.tryIOError (BS.readFile . X.unpack $ dbLoc)   case eiStr of     Left e ->       if allowNew && IOE.isDoesNotExistError e-      then return (return [])+      then return []       else IOE.ioError e-    Right g -> return . readDbTuple $ g+    Right g -> case readDbTuple g of+      Ex.Exception e -> fail e+      Ex.Success good -> return good  -- | File version. Increment this when anything in the file format -- changes.@@ -65,15 +64,6 @@   Left e -> error $ "could not parse quantity from string: "             ++ (X.unpack . Y.unAmount $ a) ++ ": " ++ show e   Right g -> g--quitOnError-  :: IO (Ex.Exceptional String a)-  -> IO a-quitOnError = join . fmap (Ex.switch err return)-  where-    err s = do-      IO.hPutStrLn IO.stderr $ "penny-fit: error: " ++ s-      E.exitFailure  label :: String -> X.Text -> String label s x = s ++ ": " ++ X.unpack x ++ "\n"

@@ -163,35 +163,35 @@   -> I.Report cmdLineReport o rt = (help o, mkMode)   where-    mkMode _ _ fsf = MA.Mode+    mkMode _ _ _ 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 o fsf+      , MA.mHelp = const (help o)+      }  process   :: S.Runtime   -> O.DefaultOpts   -> ([L.Transaction] -> [L.Box Ly.LibertyMeta])   -> [Either String (P.Opts -> Ex.Exceptional String P.Opts)]-  -> Ex.Exceptional String (Either I.HelpStr I.ArgsAndReport)+  -> Ex.Exceptional X.Text I.ArgsAndReport process rt 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 s+      Ex.Exception s -> Ex.throw . X.pack $ s       Ex.Success g -> return $         let noDefault = X.pack "no default price found"-        in case fromParsedOpts g of-            NeedsHelp -> Left $ help defaultOpts-            DoReport f ->-              let pr ts pps = do-                    rptOpts <- Ex.fromMaybe noDefault $-                      f pps (O.format defaultOpts)-                    let boxes = fsf ts-                    report rptOpts pps boxes-              in Right (posArgs, pr)+            f = fromParsedOpts 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+        in (posArgs, pr)   -- | Sums the balances from the bottom to the top of the tree (so that@@ -220,22 +220,18 @@ mostFrequent = U.lastMode . map (L.to . L.price)  -data HelpOrOpts-  = NeedsHelp-  | DoReport ( [L.PricePoint]+type DoReport = [L.PricePoint]                -> (L.Commodity -> L.Qty -> X.Text)-               -> (Maybe Opts))+               -> (Maybe Opts)  -- | Get options for the report, depending on what options were parsed -- from the command line. Fails if the user did not specify a -- commodity and mostFrequent fails. fromParsedOpts   :: P.Opts-  -> HelpOrOpts-fromParsedOpts (P.Opts szb tgt dt so sb hlp) =-  if hlp-  then NeedsHelp-  else DoReport $ \pps fmt -> case tgt of+  -> DoReport+fromParsedOpts (P.Opts szb tgt dt so sb) =+  \pps fmt -> case tgt of     P.ManualTarget to ->       Just $ Opts fmt szb (getSorter so sb) to dt     P.AutoTarget ->

@@ -12,7 +12,7 @@ import Control.Applicative   (Applicative (pure), (<$>), (<*>)) import qualified Penny.Cabin.Scheme as E-import qualified Penny.Cabin.Chunk as Chunk+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

@@ -29,7 +29,6 @@   , P.dateTime = S.currentTime rt   , P.sortOrder = sortOrder d   , P.sortBy = sortBy d-  , P.showHelp = False   }  defaultOptions :: DefaultOpts

@@ -31,7 +31,6 @@   , dateTime :: L.DateTime   , sortOrder :: P.SortOrder   , sortBy :: SortBy-  , showHelp :: Bool   }  -- | Do not be tempted to change the setup in this module so that the@@ -45,8 +44,7 @@   , fmap toExc parseAuto   , parseDate   , fmap toExc parseSort-  , fmap toExc parseOrder-  , fmap toExc parseHelp ]+  , fmap toExc parseOrder ]   where     toExc f = return . f @@ -87,8 +85,3 @@ parseOrder = fmap f P.order   where     f x o = o { sortOrder = x }--parseHelp :: C.OptSpec (Opts -> Opts)-parseHelp = fmap f P.help-  where-    f _ o = o { showHelp = True }

@@ -48,14 +48,13 @@ defaultParseOpts = P.ParseOpts   { P.showZeroBalances = CO.ShowZeroBalances False   , P.order = CP.Ascending-  , P.needsHelp = False   }  fromParseOpts ::   (L.Commodity -> L.Qty -> X.Text)   -> P.ParseOpts   -> Opts-fromParseOpts fmt (P.ParseOpts szb o _) = Opts fmt szb o'+fromParseOpts fmt (P.ParseOpts szb o) = Opts fmt szb o'   where     o' = case o of        CP.Ascending -> compare@@ -108,12 +107,13 @@   -> I.Report parseReport fmt o rt = (help o, makeMode)   where-    makeMode _ _ fsf = MA.Mode+    makeMode _ _ _ 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.mHelp = const (help o)       }  process@@ -123,16 +123,14 @@   -> a   -> ([L.Transaction] -> [L.Box Ly.LibertyMeta])   -> [Either String (P.ParseOpts -> P.ParseOpts)]-  -> f (Either I.HelpStr I.ArgsAndReport)+  -> f I.ArgsAndReport process 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 $ report mcOpts (fsf txns)-  in pure $ if P.needsHelp os'-            then Left $ help o-            else Right (posArgs, pr)+      pr txns _ = return . map Right $ report mcOpts (fsf txns)+  in pure (posArgs, pr)   -- | The MultiCommodity report, with default options.

@@ -9,7 +9,7 @@  import Control.Applicative   (Applicative (pure), (<$>), (<*>))-import qualified Penny.Cabin.Chunk as Chunk+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

@@ -12,15 +12,9 @@ data ParseOpts = ParseOpts   { showZeroBalances :: CO.ShowZeroBalances   , order :: P.SortOrder-  , needsHelp :: Bool   }  -parseHelp :: MA.OptSpec (ParseOpts -> ParseOpts)-parseHelp = fmap f P.help-  where-    f _ o = o { needsHelp = True }- zeroBalances :: MA.OptSpec (ParseOpts -> ParseOpts) zeroBalances = fmap toResult P.zeroBalances   where@@ -32,4 +26,4 @@     toResult x o = o { order = x }  allSpecs :: [MA.OptSpec (ParseOpts -> ParseOpts)]-allSpecs = [parseHelp, zeroBalances, parseOrder]+allSpecs = [zeroBalances, parseOrder]

@@ -19,7 +19,7 @@  import qualified Penny.Cabin.Options as CO import qualified Penny.Lincoln as L-import qualified Penny.Lincoln.NestedMap as NM+import qualified Penny.Steel.NestedMap as NM import qualified Data.Foldable as Fdbl import qualified Data.Map as M import Data.Ord (comparing)

@@ -1,2469 +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.Cabin.Chunk (-  -- * Colors-  Term(..),-  autoTerm,-  termFromEnv,-  Background8,-  Background256,-  Foreground8,-  Foreground256,--  -- * Chunks-  Chunk,-  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-import qualified Penny.Shield as S------- 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)----- | Determines which Term to use based on the TERM environment--- variable, regardless of whether standard output is a--- terminal. Uses Dumb if TERM is not set.-termFromEnv :: S.Runtime -> Term-termFromEnv rt = case S.term rt of-  Just t -> TermName . S.unTerm $ t-  Nothing -> Dumb---- | Determines which Term to use based on whether standard output is--- a terminal. Uses Dumb if standard output is not a terminal;--- otherwise, uses the TERM environment variable.-autoTerm :: S.Runtime -> Term-autoTerm rt = case S.output rt of-  S.IsTTY -> termFromEnv rt-  S.NotTTY -> Dumb---- 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 TextSpec 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.Cabin.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.Cabin.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.Cabin.Chunk.Switch where--import qualified Penny.Cabin.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 }-

@@ -2,10 +2,13 @@ -- 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 Penny.Cabin.Scheme as S import Control.Monad.Exception.Synchronous (Exceptional) import qualified Data.Text as X-import Text.Matchers.Text (CaseSensitive)+import Text.Matchers (CaseSensitive)+import qualified Text.Matchers as TM import qualified System.Console.MultiArg as MA  import qualified Penny.Lincoln as L@@ -23,8 +26,13 @@ type PosArg = String type HelpStr = String type ArgsAndReport = ([PosArg], PrintReport)-type ParseResult = Exceptional String (Either HelpStr ArgsAndReport) +-- | The result of parsing the arguments to a report. Failures are+-- indicated with a Text. The name of the executable and the word+-- @error@ will be prepended to this Text; otherwise, it is printed+-- as-is, so be sure to include any trailing newline if needed.+type ParseResult = Exceptional X.Text ArgsAndReport+ type PrintReport   = [L.Transaction]   -- ^ All transactions; the report must sort and filter them@@ -33,11 +41,14 @@   -- ^ PricePoints to be included in the report  -  -> Exceptional X.Text [S.PreChunk]+  -> Exceptional X.Text [Either C.Chunk S.PreChunk]   -- ^ The exception type is a strict Text, containing the error-  -- message. The success type is a list of PreChunks containing the-  -- resulting report. This allows for errors after the list of-  -- transactions has been seen.+-- message. The success type is a list of either a Chunk or a PreChunk+-- containing the resulting report. This allows for errors after the+-- list of transactions has been seen. The name of the executable and+-- the word @error@ will be prepended to this Text; otherwise, it is+-- printed as-is, so be sure to include any trailing newline if+-- needed.   type Report = Runtime -> (HelpStr, MkReport)@@ -47,9 +58,13 @@   -- case sensitivity (this may have been changed in the filtering   -- options) -  -> (CaseSensitive -> X.Text -> Exceptional X.Text (X.Text -> Bool))+  -> (CaseSensitive -> X.Text -> Exceptional X.Text TM.Matcher)   -- ^ Result from previous parsers indicating the matcher factory the   -- user wishes to use++  -> Exp.ExprDesc+  -- ^ Result from previous parsers indicating whether the user wants+  -- RPN or infix    -> ([L.Transaction] -> [L.Box Ly.LibertyMeta])   -- ^ Result from previous parsers that will sort and filter incoming

@@ -1,3 +1,5 @@+{-# LANGUAGE OverloadedStrings #-}+ -- | The Penny Postings report -- -- The Postings report displays postings in a tabular format designed@@ -54,7 +56,9 @@  import Control.Applicative ((<$>), (<*>)) import qualified Control.Monad.Exception.Synchronous as Ex+import Data.List.Split (chunksOf) import qualified Data.Either as Ei+import Data.Monoid ((<>)) import qualified Data.Text as X import qualified Penny.Cabin.Interface as I import qualified Penny.Cabin.Options as CO@@ -72,6 +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 Data.List (intersperse) import Data.Maybe (catMaybes)@@ -79,13 +86,13 @@ import Data.Time as Time import qualified System.Console.MultiArg as MA import System.Locale (defaultTimeLocale)-import Text.Matchers.Text (CaseSensitive)+import Text.Matchers (CaseSensitive)  -- | All information needed to make a Posts report. This function -- never fails. postsReport ::   CO.ShowZeroBalances-  -> (L.Box Ly.LibertyMeta -> Bool)+  -> (Pe.Pdct (L.Box Ly.LibertyMeta))   -- ^ Removes posts from the report if applying this function to the   -- post returns False. Posts removed still affect the running   -- balance.@@ -107,24 +114,32 @@ zincReport :: ZincOpts -> I.Report zincReport opts rt = (helpStr opts, md)   where-    md cs fty fsf = MA.Mode+    md cs fty expr fsf = MA.Mode       { MA.mName = "postings"       , MA.mIntersperse = MA.Intersperse-      , MA.mOpts = map (fmap Right) (P.allSpecs rt)+      , MA.mOpts = specs rt       , MA.mPosArgs = Left-      , MA.mProcess = process opts cs fty fsf+      , MA.mProcess = process opts cs fty expr fsf+      , MA.mHelp = const (helpStr opts)       } +specs+  :: Sh.Runtime+  -> [MA.OptSpec (Either String (P.State -> Ex.Exceptional X.Text P.State))]+specs = map (fmap Right) . P.allSpecs++ process   :: ZincOpts   -> CaseSensitive   -> L.Factory+  -> Exp.ExprDesc   -> ([L.Transaction] -> [L.Box Ly.LibertyMeta])-  -> [Either String (P.State -> Ex.Exceptional String P.State)]-  -> Ex.Exceptional String (Either I.HelpStr I.ArgsAndReport)-process os cs fty fsf ls =+  -> [Either String (P.State -> Ex.Exceptional X.Text P.State)]+  -> Ex.Exceptional X.Text I.ArgsAndReport+process os cs fty expr fsf ls =   let (posArgs, clOpts) = Ei.partitionEithers ls-      pState = newParseState cs fty os+      pState = newParseState cs fty expr os       exState' = foldl (>>=) (return pState) clOpts   in fmap (mkPrintReport posArgs os fsf) exState' @@ -133,21 +148,61 @@   -> ZincOpts   -> ([L.Transaction] -> [L.Box Ly.LibertyMeta])   -> P.State-  -> Either I.HelpStr I.ArgsAndReport-mkPrintReport posArgs zo fsf st = r+  -> I.ArgsAndReport+mkPrintReport posArgs zo fsf st = (posArgs, f)   where-    r = if P.showHelp st then Left $ helpStr zo else Right pr-    pr = (posArgs, f)-    f txns _ = fmap mkChunks exPdct-      where-        exPdct = getPredicate (P.tokens st)-        mkChunks pdct = chks-          where-            chks = postsReport (P.showZeroBalances st) pdct-                   (P.postFilter st) (chunkOpts st zo) boxes-            boxes = fsf txns+    f txns _ = do+      pdct <- getPredicate (P.exprDesc st) (P.tokens st)+      let boxes = fsf txns+          rptChks = postsReport (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+      return chks +indentAmt :: Pe.IndentAmt+indentAmt = 4 +blankLine :: Chk.Chunk+blankLine = Chk.chunk Chk.defaultTextSpec "\n"++showExpression+  :: P.ShowExpression+  -> Pe.Pdct (L.Box Ly.LibertyMeta)+  -> [Chk.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"+    chks = Pe.showPdct indentAmt 0 pdct++showVerboseFilter+  :: P.VerboseFilter+  -> Pe.Pdct (L.Box Ly.LibertyMeta)+  -> [L.Box Ly.LibertyMeta]+  -> [Chk.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"++-- | Creates a Pdct and prepends a one-line description of the PostFam+-- to the Pdct's label so it can be easily identified in the output.+makeLabeledPdct+  :: Pe.Pdct (L.Box Ly.LibertyMeta)+  -> L.Box Ly.LibertyMeta+  -> Pe.Pdct (L.Box Ly.LibertyMeta)+makeLabeledPdct pd box = Pe.rename f pd+  where+    f old = old <> " - " <> L.display pf+    pf = L.boxPostFam box+ defaultOptions   :: Sh.Runtime   -> ZincOpts@@ -161,19 +216,20 @@   , subAccountLength = A.SubAccountLength 2   , payeeAllocation = A.alloc 60   , accountAllocation = A.alloc 40-  , spacers = defaultSpacerWidth }+  , spacers = defaultSpacerWidth+  }  -getPredicate ::-  [Ly.Token (L.Box Ly.LibertyMeta -> Bool)]-  -> Ex.Exceptional X.Text (L.Box Ly.LibertyMeta -> Bool)-getPredicate ts =+type Error = X.Text++getPredicate+  :: Exp.ExprDesc+  -> [Exp.Token (L.Box Ly.LibertyMeta)]+  -> Ex.Exceptional Error (Pe.Pdct (L.Box Ly.LibertyMeta))+getPredicate d ts =   case ts of-    [] -> return $ const True-    ls ->-      Ex.fromMaybe-        (X.pack "posts report: bad posting filter expression")-        (Ly.parseTokenList ls)+    [] -> return $ Pe.always+    _ -> Exp.parseExpression d ts   -- | All the information to configure the postings report if the@@ -250,9 +306,10 @@ newParseState ::   CaseSensitive   -> L.Factory+  -> Exp.ExprDesc   -> ZincOpts   -> P.State-newParseState cs fty o = P.State+newParseState cs fty expr o = P.State   { P.sensitive = cs   , P.factory = fty   , P.tokens = []@@ -260,7 +317,9 @@   , P.fields = fields o   , P.width = width o   , P.showZeroBalances = showZeroBalances o-  , P.showHelp = False+  , P.exprDesc = expr+  , P.verboseFilter = P.VerboseFilter False+  , P.showExpression = P.ShowExpression False   }  -- | Shows the date of a posting in YYYY-MM-DD format.@@ -375,13 +434,6 @@ ifDefault :: Bool -> String ifDefault b = if b then " (default)" else "" -bundles :: Int -> [a] -> [[a]]-bundles c ls-  | c < 1 = error "bundles: argument must be positive"-  | otherwise = case splitAt c ls of-      (r, []) -> [r]-      (r, rs) -> r : bundles c rs- helpStr :: ZincOpts -> String helpStr o = unlines $   [ "postings"@@ -460,9 +512,15 @@   , "--qty cmp number"   , "  Entry quantity must fall within given range"   , ""-  , "Operators - from highest to lowest precedence"+  , "Infix or RPN selection"+  , "----------------------"+  , "--infix - use infix notation"+  , "--rpn - use reverse polish notation"+  , "  (default: use what was used in the filtering options)"+  , ""+  , "Infix Operators - from highest to lowest precedence"   , "(all are left associative)"-  , "=========================="+  , "--------------------------"   , "--open expr --close"   , "  Force precedence (as in \"open\" and \"close\" parentheses)"   , "--not expr"@@ -472,6 +530,15 @@   , "expr1 --or expr2"   , "  True if either expr1 or expr2 is true"   , ""+  , "RPN Operators"+  , "-------------"+  , "expr --not"+  , "  True if expr is false"+  , "expr1 expr2 --and"+  , "  True if expr and expr2 are both true"+  , "expr1 expr2 --or"+  , "  True if either expr1 or expr2 is true"+  , ""   , "Options affecting patterns"   , "=========================="   , ""@@ -543,7 +610,7 @@       map ("  " ++)       . map concat       . map (intersperse ", ")-      . bundles 3+      . chunksOf 3       . catMaybes       . Fdbl.toList       . toMaybes

@@ -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.Cabin.Chunk as C+import qualified Penny.Steel.Chunk as C import qualified Penny.Cabin.Row as R import qualified Penny.Cabin.Posts.Growers as G import qualified Penny.Cabin.Posts.Meta as M

@@ -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.Cabin.Chunk as C+import qualified Penny.Steel.Chunk as C import qualified Penny.Cabin.Scheme as E import qualified Penny.Cabin.Row as R import qualified Penny.Cabin.TextFormat as TF

@@ -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.Cabin.Chunk as C+import qualified Penny.Steel.Chunk as C import Penny.Cabin.Posts.Meta (Box) import qualified Penny.Lincoln as L import qualified Data.Text as X

@@ -11,6 +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 Data.Monoid (mempty, mappend)  -- | The Box type that is used throughout the Posts modules.@@ -39,11 +40,11 @@ -- the VisibleNum. toBoxList ::   CO.ShowZeroBalances-  -> (L.Box Ly.LibertyMeta -> Bool)+  -> Pe.Pdct (L.Box Ly.LibertyMeta)   -- ^ Removes posts from the report if applying this function to the-  -- post returns False. Posts removed still affect the running-  -- balance.-  +  -- post returns a value other than Just True. Posts removed still+  -- affect the running balance.+   -> [Ly.PostFilterFn]   -- ^ Applies these post-filters to the list of posts that results   -- from applying the predicate above. Might remove more@@ -54,7 +55,7 @@ toBoxList szb pdct pff =   addMetadata   . Ly.processPostFilters pff-  . filter (pdct . fmap fst)+  . filter (maybe False id . Pe.eval pdct . fmap fst)   . addBalances szb  addBalances ::

@@ -1,11 +1,20 @@-module Penny.Cabin.Posts.Parser (State(..),-                                 allSpecs) where+{-# LANGUAGE OverloadedStrings #-} +module Penny.Cabin.Posts.Parser+  ( State(..)+  , allSpecs+  , VerboseFilter(..)+  , ShowExpression(..)+  ) where+ import Control.Applicative ((<$>), pure, (<*>),                             Applicative) import qualified Control.Monad.Exception.Synchronous as Ex import Data.Char (toLower) import qualified Data.Foldable as Fdbl+import Data.Monoid ((<>))+import Data.Text (Text)+import qualified Data.Text as X import qualified System.Console.MultiArg.Combinator as C import qualified System.Console.MultiArg as MA @@ -14,100 +23,113 @@ import qualified Penny.Cabin.Posts.Types as Ty import qualified Penny.Cabin.Options as CO import qualified Penny.Liberty as Ly-import qualified Penny.Liberty.Expressions as Exp+import qualified Penny.Steel.Expressions as Exp+import qualified Penny.Steel.Pdct as Pt import qualified Penny.Lincoln as L+import qualified Penny.Lincoln.Predicates as Pd import qualified Penny.Shield as S-import qualified Text.Matchers.Text as M+import qualified Text.Matchers as M +newtype VerboseFilter = VerboseFilter { unVerboseFilter :: Bool }+  deriving (Eq, Show)++newtype ShowExpression = ShowExpression { unShowExpression :: Bool }+  deriving (Eq, Show)+ data State = State   { sensitive :: M.CaseSensitive   , factory :: L.Factory-  , tokens :: [Ly.Token (L.Box Ly.LibertyMeta -> Bool)]+  , tokens :: [Exp.Token (L.Box Ly.LibertyMeta)]   , postFilter :: [Ly.PostFilterFn]   , fields :: F.Fields Bool   , width :: Ty.ReportWidth   , showZeroBalances :: CO.ShowZeroBalances-  , showHelp :: Bool+  , exprDesc :: Exp.ExprDesc+  , verboseFilter :: VerboseFilter+  , showExpression :: ShowExpression   } +type Error = X.Text+ allSpecs-  :: S.Runtime -> [MA.OptSpec (State -> Ex.Exceptional String State)]+  :: S.Runtime -> [MA.OptSpec (State -> Ex.Exceptional Error State)] allSpecs rt =   operand rt   ++ boxFilters   ++ parsePostFilter-  ++ matcherSelect-  ++ caseSelect-  ++ operator+  ++ (map (fmap (pure .)) matcherSelect)+  ++ (map (fmap (pure .)) caseSelect)+  ++ (map (fmap (pure .)) operator)+  ++ map (fmap (pure .)) parseExprType   ++ [ parseWidth      , showField      , hideField-     , showAllFields-     , hideAllFields-     , parseZeroBalances-     , optHelp+     , fmap (pure .) showAllFields+     , fmap (pure .) hideAllFields+     , fmap (pure .) parseZeroBalances+     , fmap (pure .) parseShowExpression+     , fmap (pure .) parseVerboseFilter      ]   operand   :: S.Runtime-  -> [MA.OptSpec (State -> Ex.Exceptional String State)]+  -> [MA.OptSpec (State -> Ex.Exceptional Error State)] operand rt = map (fmap f) (Ly.operandSpecs (S.currentTime rt))   where     f lyFn st = do       let cs = sensitive st           fty = factory st-      (Exp.Operand g) <- lyFn cs fty-      let g' = g . L.boxPostFam-          ts' = tokens st ++ [Exp.TokOperand g']+      g <- lyFn cs fty+      let g' = Pt.boxPdct L.boxPostFam g+          ts' = tokens st ++ [Exp.operand g']       return $ st { tokens = ts' }   -- | Processes a option for box-level serials.-optBoxSerial ::-  [String]-  -- ^ Long options--  -> [Char]-  -- ^ Short options+optBoxSerial+  :: String+  -- ^ Serial name    -> (Ly.LibertyMeta -> Int)   -- ^ Pulls the serial from the PostMeta -  -> C.OptSpec (State -> Ex.Exceptional String State)+  -> C.OptSpec (State -> Ex.Exceptional Error State) -optBoxSerial ls ss f = C.OptSpec ls ss (C.TwoArg g)+optBoxSerial nm f = C.OptSpec [nm] "" (C.TwoArg g)   where     g a1 a2 st = do       cmp <- Ly.parseComparer a1       i <- Ly.parseInt a2-      let h box =-            let ser = f . L.boxMeta $ box-            in ser `cmp` i-          tok = Exp.TokOperand h+      let (cmpDesc, cmpFn) = Pd.descComp cmp+          desc = "serial " <> X.pack nm <> " is " <> cmpDesc+                 <> " " <> X.pack (show i)+          pdct box = (f . L.boxMeta $ box) `cmpFn` i+          opnd = Pt.operand desc pdct+          tok = Exp.operand opnd       return $ st { tokens = tokens st ++ [tok] } -optFilteredNum :: C.OptSpec (State -> Ex.Exceptional String State)-optFilteredNum = optBoxSerial ["filtered"] "" f+optFilteredNum :: C.OptSpec (State -> Ex.Exceptional Error State)+optFilteredNum = optBoxSerial "filtered" f   where     f = L.forward . Ly.unFilteredNum . Ly.filteredNum -optRevFilteredNum :: C.OptSpec (State -> Ex.Exceptional String State)-optRevFilteredNum = optBoxSerial ["revFiltered"] "" f+optRevFilteredNum :: C.OptSpec (State -> Ex.Exceptional Error State)+optRevFilteredNum = optBoxSerial "revFiltered" f   where     f = L.backward . Ly.unFilteredNum . Ly.filteredNum -optSortedNum :: C.OptSpec (State -> Ex.Exceptional String State)-optSortedNum = optBoxSerial ["sorted"] "" f+optSortedNum :: C.OptSpec (State -> Ex.Exceptional Error State)+optSortedNum = optBoxSerial "sorted" f   where     f = L.forward . Ly.unSortedNum . Ly.sortedNum -optRevSortedNum :: C.OptSpec (State -> Ex.Exceptional String State)-optRevSortedNum = optBoxSerial ["revSorted"] "" f+optRevSortedNum :: C.OptSpec (State -> Ex.Exceptional Error State)+optRevSortedNum = optBoxSerial "revSorted" f   where     f = L.backward . Ly.unSortedNum . Ly.sortedNum -boxFilters :: [C.OptSpec (State -> Ex.Exceptional String State)]+boxFilters :: [C.OptSpec (State -> Ex.Exceptional Error State)] boxFilters =   [ optFilteredNum   , optRevFilteredNum@@ -116,41 +138,39 @@   ]  -parsePostFilter :: [C.OptSpec (State -> Ex.Exceptional String State)]+parsePostFilter :: [C.OptSpec (State -> Ex.Exceptional Error State)] parsePostFilter = [fmap f optH, fmap f optT]   where     (optH, optT) = Ly.postFilterSpecs-    f exc = case exc of-      Ex.Exception s -> const $ Ex.throw s-      Ex.Success pf ->-        let g st = return $ st { postFilter = postFilter st ++ [pf] }-        in g+    f exc st = fmap g exc+      where+        g pff = st { postFilter = postFilter st ++ [pff] }  -matcherSelect :: Applicative f => [C.OptSpec (State -> f State)]+matcherSelect :: [C.OptSpec (State -> State)] matcherSelect = map (fmap f) Ly.matcherSelectSpecs   where-    f mf st = pure $ st { factory = mf }+    f mf st = st { factory = mf }  -caseSelect :: Applicative f => [C.OptSpec (State -> f State)]+caseSelect :: [C.OptSpec (State -> State)] caseSelect = map (fmap f) Ly.caseSelectSpecs   where-    f cs st = pure $ st { sensitive = cs }+    f cs st = st { sensitive = cs } -operator :: Applicative f => [C.OptSpec (State -> f State)]+operator :: [C.OptSpec (State -> State)] operator = map (fmap f) Ly.operatorSpecs   where-    f oo st = pure $ st { tokens = tokens st ++ [oo] }+    f oo st = st { tokens = tokens st ++ [oo] } -parseWidth :: C.OptSpec (State -> Ex.Exceptional String State)+parseWidth :: C.OptSpec (State -> Ex.Exceptional Error State) parseWidth = C.OptSpec ["width"] "" (C.OneArg f)   where     f a1 st = do       i <- Ly.parseInt a1       return $ st { width = Ty.ReportWidth i } -parseField :: String -> Ex.Exceptional String (F.Fields Bool)+parseField :: String -> Ex.Exceptional Error (F.Fields Bool) parseField str =   let lower = map toLower str       checkField s =@@ -158,7 +178,18 @@         then (s, True)         else (s, False)       flds = checkField <$> F.fieldNames-  in checkFields flds+  in case checkFields flds of+      Ex.Exception e -> case e of+        NoMatchingFields -> Ex.throw+          $ "no field matches the name \"" <> X.pack str <> "\"\n"+        MultipleMatchingFields ts -> Ex.throw+          $ "multiple fields match the name \"" <> X.pack str+            <> "\" matches: " <> mtchs <> "\n"+          where+            mtchs = X.intercalate " "+                    . map (\x -> "\"" <> x <> "\"")+                    $ ts+      Ex.Success g -> return g   -- | Turns a field on if it is True.@@ -192,7 +223,7 @@     f o False = o     f _ True = False -showField :: C.OptSpec (State -> Ex.Exceptional String State)+showField :: C.OptSpec (State -> Ex.Exceptional Error State) showField = C.OptSpec ["show"] "" (C.OneArg f)   where     f a1 st = do@@ -200,7 +231,7 @@       let newFl = fieldOn (fields st) fl       return $ st { fields = newFl } -hideField :: C.OptSpec (State -> Ex.Exceptional String State)+hideField :: C.OptSpec (State -> Ex.Exceptional Error State) hideField = C.OptSpec ["hide"] "" (C.OneArg f)   where     f a1 st = do@@ -208,35 +239,50 @@       let newFl = fieldOff (fields st) fl       return $ st { fields = newFl } -showAllFields :: Applicative f => C.OptSpec (State -> f State)+showAllFields :: C.OptSpec (State -> State) showAllFields = C.OptSpec ["show-all"] "" (C.NoArg f)   where-    f st = pure $ st {fields = pure True}+    f st = st {fields = pure True} -hideAllFields :: Applicative f => C.OptSpec (State -> f State)+hideAllFields :: C.OptSpec (State -> State) hideAllFields = C.OptSpec ["hide-all"] "" (C.NoArg f)   where-    f st = pure $ st {fields = pure False}+    f st = st {fields = pure False} -optHelp :: Applicative f => C.OptSpec (State -> f State)-optHelp = fmap f P.help+parseZeroBalances :: C.OptSpec (State -> State)+parseZeroBalances = fmap f P.zeroBalances   where-    f _ st = pure $ st { showHelp = True }+    f szb st = st { showZeroBalances = szb } -parseZeroBalances :: Applicative f => C.OptSpec (State -> f State)-parseZeroBalances = fmap f P.zeroBalances+parseExprType :: [C.OptSpec (State -> State)]+parseExprType = map (fmap f) [Ly.parseInfix, Ly.parseRPN]   where-    f szb st = pure $ st { showZeroBalances = szb }+    f d st = st { exprDesc = d } +parseShowExpression :: C.OptSpec (State -> State)+parseShowExpression = fmap f Ly.showExpression+  where+    f _ st = st { showExpression = ShowExpression True }++parseVerboseFilter :: C.OptSpec (State -> State)+parseVerboseFilter = fmap f Ly.verboseFilter+  where+    f _ st = st { verboseFilter = VerboseFilter True }++data BadFieldError+  = NoMatchingFields+  | MultipleMatchingFields [Text]+  deriving Show+ -- | Checks the fields with the True value to ensure there is only one. checkFields ::   F.Fields (String, Bool)-  -> Ex.Exceptional String (F.Fields Bool)+  -> Ex.Exceptional BadFieldError (F.Fields Bool) checkFields fs =   let f (s, b) ls = if b then s:ls else ls   in case Fdbl.foldr f [] fs of-    [] -> Ex.throw "no matching field names"+    [] -> Ex.throw NoMatchingFields     _:[] -> return (snd <$> fs)-    _ -> Ex.throw "multiple matching field names"+    ms -> Ex.throw . MultipleMatchingFields . map X.pack $ ms  

@@ -30,7 +30,7 @@  import Data.List (transpose) import qualified Data.Text as X-import qualified Penny.Cabin.Chunk as C+import qualified Penny.Steel.Chunk as C import qualified Penny.Cabin.Scheme as E  -- | How to justify cells. LeftJustify leaves the right side

@@ -8,7 +8,7 @@  module Penny.Cabin.Scheme where -import qualified Penny.Cabin.Chunk as C+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

@@ -3,8 +3,8 @@ module Penny.Cabin.Scheme.Schemes where  import qualified Penny.Cabin.Scheme as E-import qualified Penny.Cabin.Chunk as C-import qualified Penny.Cabin.Chunk.Switch as Sw+import qualified Penny.Steel.Chunk as C+import qualified Penny.Steel.Chunk.Switch as Sw  -- | The light color scheme. You can change various values below to -- affect the color scheme.

@@ -9,7 +9,6 @@   -- * Convenience functions to read and parse files     parse   , open-  , openStdin    -- * Types for things found in ledger files   , Y.Item(BlankLine, IComment, PricePoint, Transaction)@@ -44,7 +43,8 @@ import qualified Penny.Lincoln as L import qualified Penny.Copper.Render as R import qualified Penny.Copper.Types as Y-import qualified System.IO.Error as E+import System.Console.MultiArg.GetArgs (getProgName)+import qualified System.Exit as Exit import qualified System.IO as IO  newtype FileContents = FileContents { unFileContents :: X.Text }@@ -170,46 +170,40 @@   -> Ex.Exceptional ErrorMsg Y.Ledger parse ps = fmap addGlobalMetadata $ mapM parseFile ps --- | Reads and parses the given filename. Does not do anything to--- handle @-@ arguments; for that, see openStdin. Errors are indicated--- by throwing an exception.-open :: [String] -> IO Y.Ledger-open = fmap addGlobalMetadata-       . mapM (\s -> getFileContents s >>= parseAndResolve) --getFileContents :: String -> IO (L.Filename, FileContents)-getFileContents s = fmap f (TIO.readFile s)-  where f c = (L.Filename . X.pack $ s, FileContents c)- parseAndResolve :: (L.Filename, FileContents) -> IO Y.Ledger parseAndResolve p@(L.Filename fn, _) =   Ex.switch err return $ parseFile p   where-    err (ErrorMsg x) =-      E.ioError $ E.mkIOError E.userErrorType-        ("could not parse file: " ++ X.unpack x)-        Nothing (Just . X.unpack $ fn)+    err (ErrorMsg x) = do+      pn <- getProgName+      let msg = pn ++ ": error: could not parse file "+                ++ X.unpack fn ++ "\n"+                ++ X.unpack x+      IO.hPutStr IO.stderr msg+      Exit.exitFailure   -- | Reads and parses the given files. If any of the files is @-@, -- reads standard input. If the list of files is empty, reads standard--- input. Errors are indicated by throwing an exception.-openStdin :: [String] -> IO Y.Ledger-openStdin ss =+-- input. IO errors are not caught. Parse errors are printed to+-- standard error and the program will exit with a failure.+open :: [String] -> IO Y.Ledger+open ss =   let ls = if null ss-           then fmap (\x -> [x]) (getFileContentsStdin "-")+           then fmap (:[]) (getFileContentsStdin "-")            else mapM getFileContentsStdin ss   in fmap addGlobalMetadata (ls >>= mapM parseAndResolve)  getFileContentsStdin :: String -> IO (L.Filename, FileContents) getFileContentsStdin s = do+  pn <- getProgName   txt <- if s == "-"           then do                 isTerm <- IO.hIsTerminalDevice IO.stdin                 when isTerm                   (IO.hPutStrLn IO.stderr $-                     "warning: reading from standard input, which"+                     pn ++ ": warning: reading from standard input, which"                      ++ "is a terminal.")                 TIO.hGetContents IO.stdin           else TIO.readFile s

@@ -1,3 +1,5 @@+{-# LANGUAGE OverloadedStrings #-}+ -- | Liberty - Penny command line parsing utilities -- -- Both Cabin and Zinc share various functions that aid in parsing@@ -9,8 +11,6 @@  module Penny.Liberty (   MatcherFactory,-  X.evaluate,-  X.Token(..),   FilteredNum(FilteredNum, unFilteredNum),   SortedNum(SortedNum, unSortedNum),   LibertyMeta(filteredNum, sortedNum),@@ -20,9 +20,13 @@   PostFilterFn,   parseComparer,   processPostFilters,-  parseTokenList,   parsePredicate,   parseInt,+  parseInfix,+  parseRPN,+  exprDesc,+  showExpression,+  verboseFilter,    -- * Parsers   Operand,@@ -30,16 +34,21 @@   postFilterSpecs,   matcherSelectSpecs,   caseSelectSpecs,-  operatorSpecs+  operatorSpecs, +  -- * Errors+  Error+   ) where -import Control.Applicative ((<*>), (<$>))+import Control.Applicative ((<*>), (<$>), pure, Applicative) import qualified Control.Monad.Exception.Synchronous as Ex import Data.Char (toUpper)+import Data.Maybe (mapMaybe)+import Data.Monoid ((<>)) import Data.List (sortBy)-import Data.Text (Text, pack, unpack)-import qualified Data.Text as Text+import Data.Text (Text, pack)+import qualified Data.Time as Time import qualified System.Console.MultiArg.Combinator as C import System.Console.MultiArg.Combinator (OptSpec) import Text.Parsec (parse)@@ -48,13 +57,18 @@  import Penny.Lincoln.Family.Child (child, parent) import qualified Penny.Lincoln.Predicates as P+import qualified Penny.Steel.Pdct as E import qualified Penny.Lincoln as L-import qualified Penny.Liberty.Expressions as X+import qualified Penny.Steel.Chunk as C+import qualified Penny.Steel.Expressions as X -import Text.Matchers.CaseSensitive (+import Text.Matchers (   CaseSensitive(Sensitive, Insensitive))-import qualified Text.Matchers.Text as TM+import qualified Text.Matchers as TM +-- | A multiline Text that holds an error message.+type Error = Text+ -- | A serial indicating how a post relates to all other postings that -- made it through the filtering phase. newtype FilteredNum = FilteredNum { unFilteredNum :: L.Serial }@@ -72,30 +86,24 @@   deriving Show  --- | Parses a list of tokens. Returns Nothing if the token sequence is--- invalid (e.g. if two operators are next to each other) or if the--- resulting RPN expression is bad (there are tokens left on the stack--- after parsing). Otherwise, returns the expression.------ An empty list will fail to parse. The function calling this one--- must deal with empty lists if those are a possibility.-parseTokenList :: [X.Token a] -> Maybe a-parseTokenList = X.evaluate- -- | Parses a list of tokens to obtain a predicate. Deals with an -- empty list of tokens by returning a predicate that is always -- True. Fails if the list of tokens is not empty and the parse fails.-parsePredicate :: [X.Token (a -> Bool)] -> Maybe (a -> Bool)-parsePredicate ls = case ls of-  [] -> return (const True)-  ts -> parseTokenList ts+parsePredicate+  :: X.ExprDesc+  -> [X.Token a]+  -> Ex.Exceptional Error (E.Pdct a)+parsePredicate d ls = case ls of+  [] -> return E.always+  _ -> X.parseExpression d ls  -- | Takes a list of transactions, splits them into PostingChild -- instances, filters them, post-filters them, sorts them, and places--- them in Box instances with Filtered serials.+-- them in Box instances with Filtered serials. Also returns a Text+-- containing a description of the evalutation process. xactionsToFiltered :: -  (L.PostFam -> Bool)+  P.LPdct   -- ^ The predicate to filter the transactions    -> [PostFilterFn]@@ -107,19 +115,40 @@   -> [L.Transaction]   -- ^ The transactions to work on (probably parsed in from Copper) -  -> [L.Box LibertyMeta]+  -> ([C.Chunk], [L.Box LibertyMeta])   -- ^ Sorted, filtered postings -xactionsToFiltered pdct pfs s =-  addSortedNum-  . processPostFilters pfs-  . sortBy (sorter s)-  . addFilteredNum-  . map toBox-  . filter pdct-  . concatMap L.postFam+xactionsToFiltered pdct postFilts s txns =+  let pdcts = map (makeLabeledPdct pdct) pfs+      evaluator subj pd = E.evaluate indentAmt True subj 0 pd+      pairMaybes = zipWith evaluator pfs pdcts+      pairs = mapMaybe rmMaybe pairMaybes+      rmMaybe (mayB, x) = case mayB of+        Nothing -> Nothing+        Just b -> Just (b, x)+      pfs = concatMap L.postFam txns+      txt = concatMap snd pairs+      filtered = map snd . filter fst $ zipWith zipper pairs pfs+      zipper (bool, _) pf = (bool, pf)+      resultLs = addSortedNum+                 . processPostFilters postFilts+                 . sortBy (sorter s)+                 . addFilteredNum+                 . map toBox+                 $ filtered+  in (txt, resultLs)  +-- | Creates a Pdct and prepends a one-line description of the PostFam+-- to the Pdct's label so it can be easily identified in the output.+makeLabeledPdct :: E.Pdct L.PostFam -> L.PostFam -> E.Pdct L.PostFam+makeLabeledPdct pd pf = E.rename f pd+  where+    f old = old <> " - " <> L.display pf++indentAmt :: E.IndentAmt+indentAmt = 4+ -- | Transforms a PostingChild into a Box. toBox :: L.PostFam -> L.Box () toBox = L.Box ()@@ -149,8 +178,7 @@ type MatcherFactory =   CaseSensitive   -> Text-  -> Ex.Exceptional Text (Text -> Bool)-type Operand = X.Operand (L.PostFam -> Bool)+  -> Ex.Exceptional Text TM.Matcher  newtype ListLength = ListLength { unListLength :: Int }                      deriving (Eq, Ord, Show)@@ -177,113 +205,71 @@ ------------------------------------------------------------  -- | Given a String from the command line which represents a pattern,--- and a MatcherFactor, return a Matcher. Fails if the pattern is bad--- (e.g. it is not a valid regular expression).+-- the current case sensitivity, and a MatcherFactory, return a+-- Matcher. Fails if the pattern is bad (e.g. it is not a valid+-- regular expression). getMatcher ::   String   -> CaseSensitive   -> MatcherFactory-  -> Ex.Exceptional String (Text -> Bool)+  -> Ex.Exceptional Error TM.Matcher -getMatcher s cs f = Ex.mapException e (f cs (pack s))+getMatcher s cs f+  = Ex.mapException mkError+  $ f cs (pack s)   where-    e err = "bad pattern: " ++ s ++ " error message: "-            ++ unpack err+    mkError eMsg = "bad pattern: \"" <> pack s <> " - " <> eMsg+      <> "\n" --- | Parses comparers given on command line to a function. Aborts if++-- | Parses comparers given on command line to a function. Fails if -- the string given is invalid.-parseComparer ::-  (Eq a, Ord a)-  => String-  -> Ex.Exceptional String (a -> a -> Bool)+parseComparer :: String -> Ex.Exceptional Error P.Comp parseComparer t-  | t == "<" = return (<)-  | t == "<=" = return (<=)-  | t == "==" = return (==)-  | t == "=" = return (==)-  | t == ">" = return (>)-  | t == ">=" = return (>=)-  | t == "/=" = return (/=)-  | t == "!=" = return (/=)-  | otherwise = Ex.throw $ "invalid comparer: " ++ t+  | t == "<" = return P.DLT+  | t == "<=" = return P.DLTEQ+  | t == "==" = return P.DEQ+  | t == "=" = return P.DEQ+  | t == ">" = return P.DGT+  | t == ">=" = return P.DGTEQ+  | t == "/=" = return P.DNE+  | t == "!=" = return P.DNE+  | otherwise = Ex.throw msg+  where+    msg = "bad comparer: " <> pack t <> "\n" -parseDate :: String -> Ex.Exceptional String L.DateTime-parseDate =-  Ex.mapException f . Ex.fromEither . parse Pc.dateTime "" . pack+-- | Parses a date from the command line. On failure, throws back the+-- error message from the failed parse.+parseDate :: String -> Ex.Exceptional Error Time.UTCTime+parseDate arg =+  Ex.mapExceptional err L.toUTC+  . Ex.fromEither+  . parse Pc.dateTime ""+  . pack+  $ arg   where-    f msg = "invalid date: " ++ show msg+    err msg = "bad date: \"" <> pack arg <> "\" - " <> (pack . show $ msg) -date :: OptSpec (Ex.Exceptional String Operand)+type Operand = E.Pdct L.PostFam++-- | OptSpec for a date.+date :: OptSpec (Ex.Exceptional Error Operand) date = C.OptSpec ["date"] ['d'] (C.TwoArg f)   where-    f a1 a2 = g <$> parseComparer a1 <*> parseDate a2-    g cmp dt = X.Operand (P.date (`cmp` dt))+    f a1 a2 = P.date <$> parseComparer a1 <*> parseDate a2   current :: L.DateTime -> OptSpec Operand current dt = C.OptSpec ["current"] [] (C.NoArg f)   where-    f = X.Operand (P.date (<= dt))----- | Creates options that match against fields that are--- colon-separated. The operand added will return True if the--- posting's colon-separated option matches the pattern given, or--- False if it does not.-sepOption ::-  String-  -- ^ Long option name--  -> Maybe Char-  -- ^ Short option name, if there is one--  -> (Text -> (Text -> Bool) -> L.PostFam -> Bool)-  -- ^ When applied to a text that separates the different segments of-  -- the field, a matcher, and a posting, this function returns True-  -- if the posting matches the matcher or False if it does not.--  -> OptSpec ( CaseSensitive-               -> MatcherFactory-               -> Ex.Exceptional String Operand )-sepOption str mc f = C.OptSpec [str] so (C.OneArg g)-  where-    so = maybe [] return mc-    g a cs fty = h <$> getMatcher a cs fty-      where-        h mtr = X.Operand (f sep mtr)---sep :: Text-sep = Text.singleton ':'+    f = P.date P.DLTEQ (L.toUTC dt)  -- | Parses exactly one integer; fails if it cannot read exactly one.-parseInt :: String -> Ex.Exceptional String Int+parseInt :: String -> Ex.Exceptional Error Int parseInt t =   case reads t of     ((i, ""):[]) -> return i-    _ -> Ex.throw ("invalid number: " ++ t)---- | Creates options that take two arguments, with the first argument--- being the level to match, and the second being the pattern that--- should match against that level.  Adds an operand that returns True--- if the pattern matches.-levelOption ::-  String-  -- ^ Long option name--  -> (Int -> (Text -> Bool) -> L.PostFam -> Bool)-  -- ^ Applied to an integer, a matcher, and a PostingBox, this-  -- function returns True if a particular field in the posting-  -- matches the matcher given at the given level, or False otherwise.--  -> OptSpec ( CaseSensitive-               -> MatcherFactory-               -> Ex.Exceptional String Operand)--levelOption str f = C.OptSpec [str] [] (C.TwoArg g)-  where-    g a1 a2 cs fty = h <$> parseInt a1 <*> getMatcher a2 cs fty-    h i m = X.Operand (f i m)+    _ -> Ex.throw $ "could not parse integer: \"" <> pack t <> "\"\n"   -- | Creates options that add an operand that matches the posting if a@@ -295,96 +281,104 @@   -> Maybe Char   -- ^ Short option, if included -  -> ((Text -> Bool) -> L.PostFam -> Bool)-  -- ^ When applied to a matcher and a PostingBox, this function-  -- returns True if the posting matches, or False if it does not.+  -> (TM.Matcher -> P.LPdct)+  -- ^ When applied to a Matcher, this function returns a predicate.    -> OptSpec ( CaseSensitive                -> MatcherFactory-               -> Ex.Exceptional String Operand )+               -> Ex.Exceptional Error Operand ) patternOption str mc f = C.OptSpec [str] so (C.OneArg g)   where-    so = maybe [] (\c -> [c]) mc-    g a1 cs fty = h <$> getMatcher a1 cs fty-    h m = X.Operand (f m)-+    so = maybe [] (:[]) mc+    g a1 cs fty = f <$> getMatcher a1 cs fty   -- | The account option; matches if the pattern given matches the -- colon-separated account name. account :: OptSpec ( CaseSensitive                    -> MatcherFactory-                   -> Ex.Exceptional String Operand )-account = sepOption "account" (Just 'a') P.account+                   -> Ex.Exceptional Error Operand )+account = C.OptSpec ["account"] "a" (C.OneArg f)+  where+    f a1 cs fty+      = fmap P.account+      $ getMatcher a1 cs fty + -- | The account-level option; matches if the account at the given -- level matches. accountLevel :: OptSpec ( CaseSensitive                         -> MatcherFactory-                        -> Ex.Exceptional String Operand)-accountLevel = levelOption "account-level" P.accountLevel+                        -> Ex.Exceptional Error Operand)+accountLevel = C.OptSpec ["account-level"] "" (C.TwoArg f)+  where+    f a1 a2 cs fty+      = P.accountLevel <$> parseInt a1 <*> getMatcher a2 cs fty + -- | The accountAny option; returns True if the matcher given matches -- a single sub-account name at any level. accountAny :: OptSpec ( CaseSensitive                         -> MatcherFactory-                        -> Ex.Exceptional String Operand )+                        -> Ex.Exceptional Error Operand ) accountAny = patternOption "account-any" Nothing P.accountAny  -- | The payee option; returns True if the matcher matches the payee -- name. payee :: OptSpec ( CaseSensitive                  -> MatcherFactory-                 -> Ex.Exceptional String Operand )+                 -> Ex.Exceptional Error Operand ) payee = patternOption "payee" (Just 'p') P.payee  tag :: OptSpec ( CaseSensitive                  -> MatcherFactory-                 -> Ex.Exceptional String Operand)+                 -> Ex.Exceptional Error Operand) tag = patternOption "tag" (Just 't') P.tag  number :: OptSpec ( CaseSensitive                     -> MatcherFactory-                    -> Ex.Exceptional String Operand )+                    -> Ex.Exceptional Error Operand ) number = patternOption "number" Nothing P.number  flag :: OptSpec ( CaseSensitive                   -> MatcherFactory-                  -> Ex.Exceptional String Operand)+                  -> Ex.Exceptional Error Operand) flag = patternOption "flag" Nothing P.flag  commodity :: OptSpec ( CaseSensitive                        -> MatcherFactory-                       -> Ex.Exceptional String Operand)+                       -> Ex.Exceptional Error Operand) commodity = patternOption "commodity" Nothing P.commodity  postingMemo :: OptSpec ( CaseSensitive                          -> MatcherFactory-                         -> Ex.Exceptional String Operand)+                         -> Ex.Exceptional Error Operand) postingMemo = patternOption "posting-memo" Nothing P.postingMemo  transactionMemo :: OptSpec ( CaseSensitive                              -> MatcherFactory-                             -> Ex.Exceptional String Operand)+                             -> Ex.Exceptional Error Operand) transactionMemo = patternOption "transaction-memo"                   Nothing P.transactionMemo  debit :: OptSpec Operand-debit = C.OptSpec ["debit"] [] (C.NoArg (X.Operand P.debit))+debit = C.OptSpec ["debit"] [] (C.NoArg P.debit)  credit :: OptSpec Operand-credit = C.OptSpec ["credit"] [] (C.NoArg (X.Operand P.credit))+credit = C.OptSpec ["credit"] [] (C.NoArg P.credit) -qtyOption :: OptSpec (Ex.Exceptional String Operand)+qtyOption :: OptSpec (Ex.Exceptional Error Operand) qtyOption = C.OptSpec ["qty"] [] (C.TwoArg f)   where-    f a1 a2 = g <$> parseComparer a1 <*> parseQty a2-    parseQty = Ex.mapException err . Ex.fromEither-               . parse Pc.quantity "" . pack-    err msg = "invalid quantity: " ++ show msg-    g cmp qty = X.Operand (P.qty (`cmp` qty))+    f a1 a2 = P.qty <$> parseComparer a1 <*> parseQty a2+    parseQty a = case parse Pc.quantity "" (pack a) of+      Left e -> Ex.throw $ "could not parse quantity: "+        <> pack a <> " - "+        <> (pack . show $ e)+      Right g -> pure g  + -- | Creates two options suitable for comparison of serial numbers, -- one for ascending, one for descending. serialOption ::@@ -396,8 +390,8 @@   -> String   -- ^ Name of the command line option, such as @global-transaction@ -  -> ( OptSpec (Ex.Exceptional String Operand)-     , OptSpec (Ex.Exceptional String Operand) )+  -> ( OptSpec (Ex.Exceptional Error Operand)+     , OptSpec (Ex.Exceptional Error Operand) )   -- ^ Parses both descending and ascending serial options.  serialOption getSerial n = (osA, osD)@@ -406,13 +400,15 @@           (C.TwoArg (f L.forward))     osD = C.OptSpec [addPrefix "rev" n] []           (C.TwoArg (f L.backward))-    f getInt a1 a2 = g <$> parseComparer a1 <*> parseInt a2-      where-        g cmp i =-          let op pf = case getSerial pf of-                Nothing -> False-                Just ser -> getInt ser `cmp` i-          in X.Operand op+    f getInt a1 a2 = do+      cmp <- parseComparer a1+      num <- parseInt a2+      let op pf = case getSerial pf of+            Nothing -> False+            Just ser -> getInt ser `cmpFn` num+          (cmpDesc, cmpFn) = P.descComp cmp+          desc = pack n <> " is " <> cmpDesc <> " " <> (pack . show $ num)+      return (E.operand desc op)   -- | Takes a string, adds a prefix and capitalizes the first letter of@@ -424,8 +420,8 @@     "" -> ""     x:xs -> toUpper x : xs -globalTransaction :: ( OptSpec (Ex.Exceptional String Operand)-                     , OptSpec (Ex.Exceptional String Operand) )+globalTransaction :: ( OptSpec (Ex.Exceptional Error Operand)+                     , OptSpec (Ex.Exceptional Error Operand) ) globalTransaction =   let f = fmap L.unGlobalTransaction           . L.tGlobalTransaction@@ -433,8 +429,8 @@           . L.unPostFam   in serialOption f "globalTransaction" -globalPosting :: ( OptSpec (Ex.Exceptional String Operand)-                 , OptSpec (Ex.Exceptional String Operand) )+globalPosting :: ( OptSpec (Ex.Exceptional Error Operand)+                 , OptSpec (Ex.Exceptional Error Operand) ) globalPosting =   let f = fmap L.unGlobalPosting           . L.pGlobalPosting@@ -442,8 +438,8 @@           . L.unPostFam   in serialOption f "globalPosting" -filePosting :: ( OptSpec (Ex.Exceptional String Operand)-               , OptSpec (Ex.Exceptional String Operand) )+filePosting :: ( OptSpec (Ex.Exceptional Error Operand)+               , OptSpec (Ex.Exceptional Error Operand) ) filePosting =   let f = fmap L.unFilePosting           . L.pFilePosting@@ -451,8 +447,8 @@           . L.unPostFam   in serialOption f "filePosting" -fileTransaction :: ( OptSpec (Ex.Exceptional String Operand)-                   , OptSpec (Ex.Exceptional String Operand) )+fileTransaction :: ( OptSpec (Ex.Exceptional Error Operand)+                   , OptSpec (Ex.Exceptional Error Operand) ) fileTransaction =   let f = fmap L.unFileTransaction           . L.tFileTransaction@@ -460,68 +456,77 @@           . L.unPostFam   in serialOption f "fileTransaction" -unDouble-  :: ( OptSpec (Ex.Exceptional String Operand)-     , OptSpec (Ex.Exceptional String Operand) )-  -> [ OptSpec (a -> b -> Ex.Exceptional String Operand) ]-unDouble (o1, o2) = [fmap f o1, fmap f o2]-  where-    f = (\g _ _ -> g)-- -- | All operand OptSpec. operandSpecs   :: L.DateTime   -> [OptSpec (CaseSensitive                -> MatcherFactory-               -> Ex.Exceptional String Operand)]+               -> Ex.Exceptional Error Operand)]  operandSpecs dt =-  [ fmap (\f _ _ -> f) date-  , fmap (\o _ _ -> return o) (current dt)-  , wrapFactArg account-  , wrapFactArg accountLevel-  , wrapFactArg accountAny-  , wrapFactArg payee-  , wrapFactArg tag-  , wrapFactArg number-  , wrapFactArg flag-  , wrapFactArg commodity-  , wrapFactArg postingMemo-  , wrapFactArg transactionMemo-  , fmap (\f _ _ -> return f) debit-  , fmap (\f _ _  -> return f) credit-  , fmap (\f _ _ -> f) qtyOption+  [ fmap (const . const) date+  , fmap (const . const . pure) (current dt)+  , account+  , accountLevel+  , accountAny+  , payee+  , tag+  , number+  , flag+  , commodity+  , postingMemo+  , transactionMemo+  , fmap (const . const . pure) debit+  , fmap (const . const . pure) credit+  , fmap (const . const) qtyOption   ]-  ++ unDouble globalTransaction-  ++ unDouble globalPosting-  ++ unDouble filePosting-  ++ unDouble fileTransaction-    where-      wrapFactArg = fmap (\f cs fty -> f cs fty)+  ++ serialSpecs +serialSpecs :: [OptSpec (CaseSensitive+                        -> MatcherFactory+                        -> Ex.Exceptional Error Operand)]+serialSpecs+  = concat+  $ [unDouble]+  <*> [ globalTransaction, globalPosting,+        filePosting, fileTransaction ]++unDouble+  :: Functor f+  => (f (Ex.Exceptional Error a),+      f (Ex.Exceptional Error a ))+  -> [ f (x -> y -> Ex.Exceptional Error a) ]+unDouble (o1, o2) = [fmap (const . const) o1, fmap (const . const) o2]++ ------------------------------------------------------------ -- Post filters ------------------------------------------------------------ -optHead :: OptSpec (Ex.Exceptional String PostFilterFn)+-- | The user passed a bad number for the head or tail option. The+-- argument is the bad number passed.+data BadHeadTailError = BadHeadTailError Text+  deriving Show++optHead :: OptSpec (Ex.Exceptional Error PostFilterFn) optHead = C.OptSpec ["head"] [] (C.OneArg f)   where-    f a = g <$> parseInt a-      where-        g i _ ii = ii < (ItemIndex i)+    f a = do+      num <- parseInt a+      let g _ ii = ii < (ItemIndex num)+      return g -optTail :: OptSpec (Ex.Exceptional String PostFilterFn)+optTail :: OptSpec (Ex.Exceptional Error PostFilterFn) optTail = C.OptSpec ["tail"] [] (C.OneArg f)   where-    f a = g <$> parseInt a-      where-        g i (ListLength len) (ItemIndex ii) = ii >= len - i-+    f a = do+      num <- parseInt a+      let g (ListLength len) (ItemIndex ii) = ii >= len - num+      return g  -postFilterSpecs :: ( OptSpec (Ex.Exceptional String PostFilterFn)-                   , OptSpec (Ex.Exceptional String PostFilterFn) )+postFilterSpecs :: ( OptSpec (Ex.Exceptional Error PostFilterFn)+                   , OptSpec (Ex.Exceptional Error PostFilterFn) ) postFilterSpecs = (optHead, optTail)  ------------------------------------------------------------@@ -565,25 +570,43 @@  -- | Open parentheses open :: OptSpec (X.Token a)-open = noArg X.TokOpenParen "open"+open = noArg X.openParen "open"  -- | Close parentheses close :: OptSpec (X.Token a)-close = noArg X.TokCloseParen "close"+close = noArg X.closeParen "close"  -- | and operator-parseAnd :: OptSpec (X.Token (a -> Bool))-parseAnd = noArg X.tokAnd "and"+parseAnd :: OptSpec (X.Token a)+parseAnd = noArg X.opAnd "and"  -- | or operator-parseOr :: OptSpec (X.Token (a -> Bool))-parseOr = noArg X.tokOr "or"+parseOr :: OptSpec (X.Token a)+parseOr = noArg X.opOr "or"  -- | not operator-parseNot :: OptSpec (X.Token (a -> Bool))-parseNot = noArg X.tokNot "not" where+parseNot :: OptSpec (X.Token a)+parseNot = noArg X.opNot "not" -operatorSpecs :: [OptSpec (X.Token (a -> Bool))]+operatorSpecs :: [OptSpec (X.Token a)] operatorSpecs =   [open, close, parseAnd, parseOr, parseNot]++-- Infix and RPN expression selectors++parseInfix :: OptSpec X.ExprDesc+parseInfix = noArg X.Infix "infix"++parseRPN :: OptSpec X.ExprDesc+parseRPN = noArg X.RPN "rpn"++-- | Both Infix and RPN options.+exprDesc :: [OptSpec X.ExprDesc]+exprDesc = [ parseInfix, parseRPN ]++showExpression :: OptSpec ()+showExpression = noArg () "show-expression"++verboseFilter :: OptSpec ()+verboseFilter = noArg () "verbose-filter" 

@@ -1,63 +0,0 @@-module Penny.Liberty.Expressions (-  I.Precedence(Precedence),--  I.Associativity(ALeft, ARight),--  I.Token(TokOperand,-          TokUnaryPostfix,-          TokUnaryPrefix,-          TokBinary,-          TokOpenParen,-          TokCloseParen),--  R.Operand(..),-  tokAnd,-  tokOr,-  tokNot,-  evaluate) where--import qualified Data.Foldable as Fdbl-import Penny.Liberty.Expressions.Infix as I-import Penny.Liberty.Expressions.RPN as R----- | Tokens should be enqueued from left to right, so that tokens on--- the left side of the sequence are those at the beginning of the--- expression.-evaluate ::-  Fdbl.Foldable l-  => l (I.Token a)-  -> Maybe a-evaluate i = I.infixToRPN i >>= R.process---- | An And token which is left associative with precedence 3.-tokAnd :: I.Token (a -> Bool)-tokAnd = I.TokBinary (I.Precedence 3) I.ALeft f where-  f x y = \a -> x a && y a---- | An Or token which is left associative with precedence 2.-tokOr :: I.Token (a -> Bool)-tokOr = I.TokBinary (I.Precedence 2) I.ALeft f where-  f x y = \a -> x a || y a---- | A unary prefix Not token with precedence 4.-tokNot :: I.Token (a -> Bool)-tokNot = I.TokUnaryPrefix (I.Precedence 4) (not .)------- Testing----_plus :: I.Token Double-_plus = I.TokBinary (I.Precedence 4) I.ALeft (+)--_minus :: I.Token Double-_minus = I.TokBinary (I.Precedence 4) I.ALeft (-)--_times :: I.Token Double-_times = I.TokBinary (I.Precedence 5) I.ALeft (*)--_divide :: I.Token Double-_divide = I.TokBinary (I.Precedence 5) I.ALeft (/)--_neg :: I.Token Double-_neg = I.TokUnaryPrefix (I.Precedence 5) negate

@@ -1,218 +0,0 @@--- | Creates RPN expressions from infix inputs.------ Penny accepts only infix expressions, but RPN expressions are--- easier to process. This module converts infix expressions to RPN--- expressions for further processing.------ Uses the shunting-yard algorithm, best described at--- http://www.chris-j.co.uk/parsing.php (be sure to use the \"click to--- display\" links).-module Penny.Liberty.Expressions.Infix (--  Precedence(Precedence),--  Associativity(ALeft,-                ARight),--  Token(TokOperand,-        TokUnaryPostfix,-        TokUnaryPrefix,-        TokBinary,-        TokOpenParen,-        TokCloseParen),--  infixToRPN-  ) where--import qualified Data.Foldable as Fdbl-import qualified Penny.Liberty.Expressions.RPN as R-import qualified Data.Sequence as Seq-import Data.Sequence((|>), Seq)---- | Precedence can be any integer; the greater the number, the higher--- the precedence.-newtype Precedence = Precedence Int deriving (Show, Eq, Ord)--data Associativity = ALeft | ARight deriving Show--data Token a =-  TokOperand a-  | TokUnaryPostfix (a -> a)-  | TokUnaryPrefix Precedence (a -> a)-  | TokBinary Precedence Associativity (a -> a -> a)-  | TokOpenParen-  | TokCloseParen--instance (Show a) => Show (Token a) where-  show (TokOperand a) = "<operand " ++ show a ++ ">"-  show (TokUnaryPostfix _) = "<unary postfix>"-  show (TokUnaryPrefix (Precedence i) _) =-    "<unary prefix, precedence " ++ (show i) ++ ">"-  show (TokBinary (Precedence i) a _) =-    "<binary, precedence " ++ show i ++ " "-    ++ show a ++ ">"-  show TokOpenParen = "<OpenParen>"-  show TokCloseParen = "<CloseParen>"--data StackVal a =-  StkUnaryPrefix Precedence (a -> a)-  | StkBinary Precedence (a -> a -> a)-  | StkOpenParen--instance Show (StackVal a) where-  show (StkUnaryPrefix p _) =-    "<unary prefix, " ++ show p ++ ">"-  show (StkBinary p _) =-    "<binary, " ++ show p ++ ">"-  show StkOpenParen = "<OpenParen>"---- | Converts an infix expression to an RPN expression.-infixToRPN ::-  Fdbl.Foldable l-  => l (Token a)-  -- ^ Input tokens. These should be in the sequence from left to-  -- right in ordinary infix order. The easiest choice is a list,-  -- though you might want to use Data.Sequence if many appends will-  -- be needed to build the sequence.--  -> Maybe (Seq (R.Token a))-  -- ^ The resulting RPN expression. The token type here is a token-  -- from Penny.Liberty.Expressions.RPN, which is a different type-  -- than the Token in this module. Fails only if there is a close-  -- parenthesis without a matching open parenthesis, or if there is-  -- an open parenthesis without a matching close parenthesis. Other-  -- nonsensical expressions will still parse to an RPN expression-  -- successfully, so the RPN parser has to catch these errors.--infixToRPN ls =-  Fdbl.foldlM processToken ([], Seq.empty) ls-  >>= popRemainingOperators----- | Process a single input token. Fails if the token is a close--- parenthesis and a matching open parenthesis is not--- found. Otherwise, succeeds and adjusts the stack and the output--- queue accordingly.-processToken ::-  ([StackVal a], Seq (R.Token a))-  -> Token a-  -> Maybe ([StackVal a], Seq (R.Token a))-processToken (ss, ts) tok =-  case tok of-    TokOperand a -> Just (ss, processOperand a ts)-    TokUnaryPostfix f ->-      Just (ss, processUnaryPostfix f ts)-    TokUnaryPrefix p f ->-      Just (processUnaryPrefix p f ss, ts)-    TokBinary p a f ->-      Just (processBinary p a f (ss, ts))-    TokOpenParen -> Just (processOpenParen ss, ts)-    TokCloseParen -> processCloseParen (ss, ts)---- | If a token is an operand, append it to the postfix output.-processOperand :: a -> Seq (R.Token a) -> Seq (R.Token a)-processOperand a sq = sq |> (R.TokOperand (R.Operand a))---- | If a token is a unary postfix operator, append it to the postfix--- output.-processUnaryPostfix ::-  (a -> a)-  -> Seq (R.Token a)-  -> Seq (R.Token a)-processUnaryPostfix f sq =-  sq |> (R.TokOperator (R.Unary f))---- | If a token is a unary prefix operator, push it onto the stack.-processUnaryPrefix ::-  Precedence-  -> (a -> a)-  -> [StackVal a]-  -> [StackVal a]-processUnaryPrefix p f s = (StkUnaryPrefix p f):s---- | Pops tokens from the stack and appends them to the ouptut, as--- long as the token at the top of the stack is and operator and its--- precedence meets the given predicate.-popTokens ::-  (Precedence -> Bool)-  -> ([StackVal a], Seq (R.Token a))-  -> ([StackVal a], Seq (R.Token a))-popTokens f (ss, os) =-  case ss of-    [] -> (ss, os)-    x:xs -> case x of-      StkOpenParen -> (ss, os)-      StkUnaryPrefix p g -> popper (R.Unary g) p-      StkBinary p g -> popper (R.Binary g) p-      where-        popper tok pr =-          if f pr-          then-            let output' = os |> (R.TokOperator tok)-            in popTokens f (xs, output')-          else (ss, os)-  ---- | 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.-processBinary ::-  Precedence-  -> Associativity-  -> (a -> a -> a)-  -> ([StackVal a], Seq (R.Token a))-  -> ([StackVal a], Seq (R.Token a))-processBinary p a f pair =-  let pdct = case a of-        ALeft -> (>= p)-        ARight -> (> p)-      (ss, os) = popTokens pdct pair-  in ((StkBinary p f):ss, os)---- | If the token is an opening parenthesis, push it onto the stack.-processOpenParen :: [StackVal a] -> [StackVal a]-processOpenParen = (StkOpenParen :)---- | If the token is a closing parenthesis, pop operators off the top--- of the stack and append them to the output until the operator at--- the top of the stack is an opening bracket. Pop the opening bracket--- off the stack.------ Fails if no open paren is found.-processCloseParen ::-  ([StackVal a], Seq (R.Token a))-  -> Maybe ([StackVal a], Seq (R.Token a))-processCloseParen (ss, os) = case ss of-  [] -> Nothing-  (x:xs) ->-    let popper op = processCloseParen (xs, output')-          where-            output' = os |> (R.TokOperator op)-    in case x of-      StkUnaryPrefix _ f -> popper (R.Unary f)        -      StkBinary _ f -> popper (R.Binary f)-      StkOpenParen -> Just (xs, os)---- | Removes all remaining operators from the stack and puts them on--- the output queue. Fails if the stack has an open parenthesis; as--- this is unmatched.-popRemainingOperators ::-  ([StackVal a], Seq (R.Token a))-  -> Maybe (Seq (R.Token a))-popRemainingOperators (s, os) = case s of-  [] -> Just os-  x:xs -> case x of-    StkOpenParen -> Nothing-    StkUnaryPrefix _ f -> pusher (R.Unary f)-    StkBinary _ f -> pusher (R.Binary f)-    where-      pusher op = popRemainingOperators (xs, output') where-        output' = os |> (R.TokOperator op)

@@ -1,112 +0,0 @@--- | Parses reverse polish notation expressions. This module needs--- much better error messages (right now it has none).------ An RPN expression consists of operands and operators; a token is--- either an operand or an operator. For example, in the expression @5--- 4 +@, the @5@ and the @4@ are operands; the @+@ is an operator;--- each of these three is a token.-module Penny.Liberty.Expressions.RPN (-  Operand(..),-  Operator(Unary, Binary),-  Token(TokOperand, TokOperator),-  process) where--import qualified Data.Foldable as Fdbl---- | An operand; for example, in the expression @5 4 +@, @5@ and @4@--- are operands.-newtype Operand a = Operand { unOperand :: a } deriving Show---- | Operators; for example, in the expression @5 4 +@, @+@ is an--- operator. Because this is RPN, there is no operator precedence.-data Operator a =-  Unary (a -> a)-  -- ^ Unary operators take only one operand (for example, a factorial-  -- operator).--  | Binary (a -> a -> a)-    -- ^ Binary operators take two operands (for example, an addition-    -- operator).--instance Show (Operator a) where-  show (Unary _) = "<unary operator>"-  show (Binary _) = "<binary operator>"---- | A token is either an operator or an operand.-data Token a =-  TokOperand (Operand a)-  | TokOperator (Operator a)-  deriving Show----- | Given an operator, and the stack of operands, process the--- operator. When parsing an RPN expression, encountering an operator--- at the front of the queue of tokens to be processed means that the--- correct number of tokens (one, for a unary operator, or two, for a--- binary operator) must be popped off the stack of operands. The--- operator is then applied to the operands. For a binary operator,--- the binary function is applied first to the operand that was lowest--- on the stack, and then to the operand that was higher up on the--- stack. The result of the operator is then pushed onto the top of--- the stack.------ This function fails if there were insufficient operands on the--- stack to process the operator. If successful, returns the new--- stack, with the processed operands removed and the result of the--- operator pushed onto the top of the stack.-processOperator ::-  Operator a-  -> [Operand a]-  -> Maybe ([Operand a])-processOperator t ds = case t of-  (Unary f) -> case ds of-    [] -> Nothing-    (Operand x):xs -> return $ (Operand (f x)) : xs-  (Binary f) -> case ds of-    [] -> Nothing-    (Operand x):dss -> case dss of-      (Operand y):dsss ->-        return $ (Operand (f y x)) : dsss-      [] -> Nothing---- | Adds an operand to the top of the stack.-processOperand ::-  Operand a-  -> [Operand a]-  -> [Operand a]-processOperand = (:)---- | Processes the next token. Fails if the next token is an operator--- and fails; otherwise, returns the new stack of operands.-processToken ::-  [Operand a]-  -> Token a-  -> Maybe ([Operand a])-processToken s tok = case tok of-  TokOperand d -> return (processOperand d s)-  TokOperator t -> processOperator t s---- | Processes an entire input sequence of RPN tokens.-process ::-  Fdbl.Foldable l-  => l (Token a)-  -- ^ The tokens must be in the sequence from left to right in-  -- postfix order; for example, @5 4 -@ will yield @1@. Typically-  -- many appends will be required in order to build this sequence. If-  -- performance is a concern, you can use a Data.Sequence; if the-  -- list is small (as these lists will typically be) a regular list-  -- will do just fine.--  -> Maybe a-  -- ^ Fails if there is not exactly one operand remaining on the-  -- stack at the end of the parse, or if at any time there are-  -- insufficient operands on the stack to parse an-  -- operator. Otherwise, succeeds and returns the result.-process ls = do-  os <- Fdbl.foldlM processToken [] ls-  (top, rest) <- case os of-    (Operand x) : oss -> return (x, oss)-    _ -> Nothing-  case rest of-    [] -> return top-    _ -> Nothing

@@ -47,6 +47,7 @@   , I.toZonedTime   , I.fromZonedTime   , I.sameInstant+  , I.showDateTime      -- ** Debits and credits   , I.DrCr(Debit, Credit)@@ -212,9 +213,11 @@   , S.nSerials      -- * Matchers-  , Matchers.Matcher   , Matchers.Factory +    -- * Showing postFam in one line+  , display+   ) where  import qualified Penny.Lincoln.Balance as B@@ -226,3 +229,44 @@ import qualified Penny.Lincoln.PriceDb as DB import qualified Penny.Lincoln.Serial as S import qualified Penny.Lincoln.Transaction as T++import Data.List (intersperse)+import Data.Text (Text)+import qualified Data.Text as X+import qualified Penny.Lincoln.Queries as Q+import qualified Data.Time as Time+import System.Locale (defaultTimeLocale)++--+-- Display+--++-- | Displays a PostFam in a one line format.+--+-- Format:+--+-- File LineNo Date Payee Acct DrCr Cmdty Qty+display :: T.PostFam -> Text+display p = X.pack $ concat (intersperse " " ls)+  where+    ls = [file, lineNo, dt, pye, acct, dc, cmdty, qt]+    file = maybe (labelNo "filename") (X.unpack . I.unFilename)+           (Q.filename p)+    lineNo = maybe (labelNo "line number")+             (show . I.unPostingLine) (Q.postingLine p)+    dateFormat = "%Y-%m-%d %T %z"+    dt = Time.formatTime defaultTimeLocale dateFormat+         . Time.utctDay+         . I.toUTC+         . Q.dateTime+         $ p+    pye = maybe (labelNo "payee")+            (X.unpack . HT.text) (Q.payee p)+    acct = X.unpack . X.intercalate (X.singleton ':')+           . map I.unSubAccount . I.unAccount . Q.account $ p+    dc = case Q.drCr p of+      I.Debit -> "Dr"+      I.Credit -> "Cr"+    cmdty = X.unpack . I.unCommodity . Q.commodity $ p+    qt = show . Q.qty $ p+    labelNo s = "(no " ++ s ++ ")"

@@ -30,6 +30,7 @@   DT.toZonedTime,   DT.fromZonedTime,   DT.sameInstant,+  DT.showDateTime,    -- * Debits and Credits   O.DrCr(Debit, Credit),

@@ -18,6 +18,7 @@   , toZonedTime   , fromZonedTime   , sameInstant+  , showDateTime   ) where  import qualified Data.Time as T@@ -132,4 +133,20 @@  sameInstant :: DateTime -> DateTime -> Bool sameInstant t1 t2 = toUTC t1 == toUTC t2++-- | Shows a DateTime in a pretty way.+showDateTime :: DateTime -> String+showDateTime (DateTime d h m s tz) =+  ds ++ " " ++ hmss ++ " " ++ showOffset+  where+    ds = show d+    hmss = hs ++ ":" ++ ms ++ ":" ++ ss+    hs = pad0 . show . unHours $ h+    ms = pad0 . show . unMinutes $ m+    ss = pad0 . show . unSeconds $ s+    pad0 str = if length str < 2 then '0':str else str+    showOffset =+      let (zoneHr, zoneMin) = abs (offsetToMins tz) `divMod` 60+          sign = if offsetToMins tz < 0 then "-" else "+"+      in sign ++ pad0 (show zoneHr) ++ pad0 (show zoneMin) 

@@ -15,15 +15,14 @@   ( account   ) where -import qualified Data.List.Split as S import qualified Penny.Lincoln.Bits as B-import Data.Text (pack)+import qualified Data.Text as X --- | Create an Account. You supply a single String, with colons to+-- | Create an Account. You supply a single Text, with colons to -- separate the different sub-accounts.-account :: String -> B.Account+account :: X.Text -> B.Account account s =-  if null s+  if X.null s   then B.Account []-  else B.Account . map B.SubAccount . map pack . S.splitOn ":" $ s+  else B.Account . map B.SubAccount . X.splitOn (X.singleton ':') $ s 

@@ -4,9 +4,7 @@  import qualified Data.Text as X import qualified Control.Monad.Exception.Synchronous as Ex-import qualified Text.Matchers.Text as MT--type Matcher = X.Text -> Bool+import qualified Text.Matchers as MT  -- | A function that makes Matchers. type Factory@@ -17,7 +15,7 @@   -- ^ The pattern to use when testing for a match. For example, this   -- might be a regular expression, or simply the text to be matched. -  -> Ex.Exceptional X.Text Matcher+  -> Ex.Exceptional X.Text MT.Matcher   -- ^ Sometimes producing a matcher might fail; for example, the user   -- might have supplied a bad pattern. If so, an exception is   -- returned. On success, a Matcher is returned.

@@ -1,275 +0,0 @@--- | A nested map. The values in each NestedMap are tuples, with the--- first element of the tuple being a label that you select and the--- second value being another NestedMap. Functions are provided so you--- may query the map at any level or insert new labels (and,--- therefore, new keys) at any level.-module Penny.Lincoln.NestedMap (-  NestedMap ( NestedMap, unNestedMap ),-  empty,-  relabel,-  descend,-  insert,-  cumulativeTotal,-  traverse,-  traverseWithTrail,-  toForest ) where--import Control.Applicative ((<*>), (<$>))-import Data.Map ( Map )-import qualified Data.Foldable as F-import qualified Data.Traversable as T-import qualified Data.Tree as E-import qualified Data.Map as M-import Data.Monoid ( Monoid, mconcat, mappend, mempty )--newtype NestedMap k l =-  NestedMap { unNestedMap :: Map k (l, NestedMap k l) }-  deriving (Eq, Show, Ord)--instance Functor (NestedMap k) where-  fmap f (NestedMap m) = let-    g (l, s) = (f l, fmap f s)-    in NestedMap $ M.map g m--instance (Ord k) => F.Foldable (NestedMap k) where-  foldMap = T.foldMapDefault--instance (Ord k) => T.Traversable (NestedMap k) where-  -- traverse :: Applicative f-  --          => (a -> f b)-  --          -> NestedMap k a-  --          -> f (NestedMap k b)-  traverse f (NestedMap m) = let-      f' (l, m') = (,) <$> f l <*> T.traverse f m'-      in NestedMap <$> T.traverse f' m---- | An empty NestedMap.-empty :: NestedMap k l-empty = NestedMap (M.empty)---- | Helper function for relabel. For a given key and function--- that modifies the label, return the new submap to insert into the--- given map. Does not actually insert the submap though. That way,--- relabel can then modify the returned submap before--- inserting it into the mother map with the given label.-newSubmap ::-  (Ord k)-  => NestedMap k l-  -> k-  -> (Maybe l -> l)-  -> (l, NestedMap k l)-newSubmap (NestedMap m) k g = (newL, NestedMap newM) where-  (newL, newM) = case M.lookup k m of-    Nothing -> (g Nothing, M.empty)-    (Just (oldL, (NestedMap oldM))) -> (g (Just oldL), oldM)---- | Descends through a NestedMap with successive keys in the list,--- proceeding from left to right. At any given level, if the key--- given does not already exist, then inserts an empty submap and--- applies the given label modification function to Nothing to--- determine the new label. If the given key already does exist, then--- preserves the existing submap and applies the given label--- modification function to (Just oldlabel) to determine the new--- label.-relabel ::-  (Ord k)-  => NestedMap k l-  -> [(k, (Maybe l -> l))]-  -> NestedMap k l-relabel m [] = m-relabel (NestedMap m) ((k, f):vs) = let-  (newL, newM) = newSubmap (NestedMap m) k f-  newM' = relabel newM vs-  in NestedMap $ M.insert k (newL, newM') m---- | Given a list of keys, find the key that is furthest down in the--- map that matches the requested list of keys. Returns [(k, l)],--- where the first item in the list is the topmost key found and its--- matching label, and the last item in the list is the deepest key--- found and its matching label. (Often you will be most interested--- in the deepest key.)-descend ::-  Ord k-  => [k]-  -> NestedMap k l-  -> [(k, l)]-descend keys (NestedMap mi) = descend' keys mi where-  descend' [] _ = []-  descend' (k:ks) m = case M.lookup k m of-    Nothing -> []-    Just (l, (NestedMap im)) -> (k, l) : descend' ks im----- | Descends through the NestedMap one level at a time, proceeding--- key by key from left to right through the list of keys given. At--- the last key, appends the given label to the labels already--- present; if no label is present, uses mempty and mappend to create--- a new label. If the list of keys is empty, does nothing.-insert ::-  (Ord k, Monoid l)-  => NestedMap k l-  -> [k]-  -> l-  -> NestedMap k l-insert m [] _ = m-insert m ks l = relabel m ts where-  ts = firsts ++ [end]-  firsts = map (\k -> (k, keepOld)) (init ks) where-    keepOld mk = case mk of-      (Just old) -> old-      Nothing -> mempty-  end = (key, newL) where-    key = last ks-    newL mk = case mk of-      (Just old) -> old `mappend` l-      Nothing -> mempty `mappend` l--totalMap ::-  (Monoid l)-  => NestedMap k l-  -> l-totalMap (NestedMap m) =-  if M.null m-  then mempty-  else mconcat . map totalTuple . M.elems $ m--totalTuple ::-  (Monoid l)-  => (l, NestedMap k l)-  -> l-totalTuple (l, (NestedMap top)) =-  if M.null top-  then l-  else mappend l (totalMap (NestedMap top))--remapWithTotals ::-  (Monoid l)-  => NestedMap k l-  -> NestedMap k l-remapWithTotals (NestedMap top) =-  if M.null top-  then NestedMap M.empty-  else NestedMap $ M.map f top where-    f a@(_, m) = (totalTuple a, remapWithTotals m)---- | Leaves all keys of the map and submaps the same. Changes each--- label to reflect the total of that label and of all the labels of--- the maps within the NestedMap accompanying the label. Returns the--- total of the entire NestedMap.-cumulativeTotal ::-  (Monoid l)-  => NestedMap k l-  -> (l, NestedMap k l)-cumulativeTotal m = (totalMap m, remapWithTotals m)---- | Supply a function that takes a key, a label, and a--- NestedMap. traverse will traverse the NestedMap. For each (label,--- NestedMap) pair, traverse will first apply the given function to--- the label before descending through the NestedMap. The function is--- applied to the present key and label and the accompanying--- NestedMap. The function you supply must return a Maybe. If the--- result is Nothing, then the pair is deleted as a value from its--- parent NestedMap. If the result is (Just s), then the label of this--- level of the NestedMap is changed to s before descending to the--- next level of the NestedMap.------ All this is done in a monad, so you can carry out arbitrary side--- effects such as inspecting or changing a state or doing IO. If you--- don't need a monad, just use Identity.------ Thus this function can be used to inspect, modify, and prune a--- NestedMap.------ For a simpler traverse that does not provide you with so much--- information, NestedMap is also an instance of Data.Traversable.-traverse ::-  (Monad m, Ord k)-  => (k -> l -> NestedMap k l -> m (Maybe a))-  -> NestedMap k l-  -> m (NestedMap k a)-traverse f m = traverseWithTrail (\_ -> f) m---- | Like traverse, but the supplied function is also applied to a--- list that tells it about the levels of NestedMap that are parents--- to this NestedMap.-traverseWithTrail ::-  (Monad m, Ord k)-  => ( [(k, l)] -> k -> l -> NestedMap k l -> m (Maybe a) )-  -> NestedMap k l-  -> m (NestedMap k a)-traverseWithTrail f = traverseWithTrail' f []--traverseWithTrail' ::-  (Monad m, Ord k)-  => ([(k, l)] -> k -> l -> NestedMap k l -> m (Maybe a))-  -> [(k, l)]-  -> NestedMap k l-  -> m (NestedMap k a)-traverseWithTrail' f ts (NestedMap m) =-  if M.null m-  then return $ NestedMap M.empty-  else do-    let ps = M.assocs m-    mlsMaybes <- mapM (traversePairWithTrail f ts) ps-    let ps' = zip (M.keys m) mlsMaybes-        folder (k, ma) rs = case ma of-          (Just r) -> (k, r):rs-          Nothing -> rs-        ps'' = foldr folder [] ps'-    return (NestedMap (M.fromList ps''))--traversePairWithTrail ::-  (Monad m, Ord k)-  => ( [(k, l)] -> k -> l -> NestedMap k l -> m (Maybe a) )-  -> [(k, l)]-  -> (k, (l, NestedMap k l))-  -> m (Maybe (a, NestedMap k a))-traversePairWithTrail f ls (k, (l, m)) = do-  ma <- f ls k l m-  case ma of-    Nothing -> return Nothing-    (Just a) -> do-      m' <- traverseWithTrail' f ((k, l):ls) m-      return (Just (a, m'))---- | Convert a NestedMap to a Forest.-toForest :: Ord k => NestedMap k l -> E.Forest (k, l)-toForest = map toNode . M.assocs . unNestedMap-  where-    toNode (k, (l, m)) = E.Node (k, l) (toForest m)---- For testing-_new :: (k, l) -> (k, (Maybe l -> l))-_new (k, l) = (k, const l)--_map1, _map2, _map3, _map4 :: NestedMap Int String-_map1 = NestedMap M.empty-_map2 = relabel _map1 [_new (5, "hello"), _new (66, "goodbye"), _new (777, "yeah")]-_map3 = relabel _map2 [_new (6, "what"), _new (77, "zeke"), _new (888, "foo")]-_map4 = relabel _map3-       [ (6, (\m -> case m of Nothing -> "_new"; (Just s) -> s ++ "_new"))-       , (77, (\m -> case m of Nothing -> "_new"; (Just s) -> s ++ "more _new")) ]--_printer :: Int -> String -> a -> IO (Maybe ())-_printer i s _ = do-  putStrLn (show i)-  putStrLn s-  return $ Just ()--_printerWithTrail :: [(Int, String)] -> Int -> String -> a -> IO (Maybe ())-_printerWithTrail ps n str _ = do-  let ptr (i, s) = putStr ("(" ++ show i ++ ", " ++ s ++ ") ")-  mapM_ ptr . reverse $ ps-  ptr (n, str)-  putStrLn ""-  return $ Just ()--_showMap4 :: IO ()-_showMap4 = do-  _ <- traverse _printer _map4-  return ()--_showMapWithTrail :: IO ()-_showMapWithTrail = do-  _ <- traverseWithTrail _printerWithTrail _map4-  return ()

@@ -1,155 +1,247 @@+{-# LANGUAGE OverloadedStrings #-}+ -- | Functions that return a boolean based upon some criterion that -- matches something, often a PostFam. Useful when filtering -- Postings.-module Penny.Lincoln.Predicates where+module Penny.Lincoln.Predicates+  ( LPdct+  , MakePdct+  , payee+  , number+  , flag+  , postingMemo+  , transactionMemo+  , Comp(..)+  , descComp+  , date+  , qty+  , drCr+  , debit+  , credit+  , commodity+  , account+  , accountLevel+  , accountAny+  , tag+  , reconciled+  , clonedTransactions+  , clonedTopLines+  , clonedPostings+  ) where   import Data.List (intersperse)+import Data.Monoid ((<>)) import Data.Text (Text) import qualified Data.Text as X-import Data.Time (Day)+import qualified Data.Time as Time import qualified Penny.Lincoln.Bits as B import Penny.Lincoln.HasText (HasText, text, HasTextList, textList) import qualified Penny.Lincoln.Family.Family as F import qualified Penny.Lincoln.Queries as Q 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 --- * Matching helpers+type LPdct = P.Pdct PostFam -match :: HasText a => (Text -> Bool) -> a -> Bool-match f = f . text+type MakePdct = M.Matcher -> LPdct -matchMaybe :: HasText a => (Text -> Bool) -> Maybe a -> Bool-matchMaybe f = maybe False (match f)+-- * Matching helpers+match+  :: HasText a+  => Text+  -- ^ Description of this field+  -> (PostFam -> a)+  -- ^ Function that returns the field being matched+  -> M.Matcher+  -> LPdct+match t f m = P.operand desc pd+  where+    desc = makeDesc t m+    pd = M.match m . text . f +matchMaybe+  :: HasText a+  => Text+  -- ^ Description of this field+  -> (PostFam -> Maybe a)+  -> M.Matcher+  -> LPdct+matchMaybe t f m = P.operand desc pd+  where+    desc = makeDesc t m+    pd = maybe False (M.match m . text) . f +makeDesc :: Text -> M.Matcher -> Text+makeDesc t m+  = "subject: " <> t+  <> " matcher: " <> M.matchDesc m+ -- | Does the given matcher match any of the elements of the Texts in -- a HasTextList?-matchAny :: HasTextList a => (Text -> Bool) -> a -> Bool-matchAny f = any f . textList--matchAnyMaybe :: HasTextList a => (Text -> Bool) -> Maybe a -> Bool-matchAnyMaybe f = maybe False (matchAny f)-+matchAny+  :: HasTextList a+  => Text+  -> (PostFam -> a)+  -> M.Matcher+  -> LPdct+matchAny t f m = P.operand desc pd+  where+    desc = makeDesc t m+    pd = any (M.match m) . textList . f  -- | Does the given matcher match the text that is at the given -- element of a HasTextList? If the HasTextList does not have a -- sufficent number of elements to perform this test, returns False.-matchLevel :: HasTextList a => Int -> (Text -> Bool) -> a -> Bool-matchLevel i f a = let ts = textList a in-  if i < 0 || i >= length ts-  then False-  else f (ts !! i)+matchLevel+  :: HasTextList a+  => Int+  -> Text+  -> (PostFam -> a)+  -> M.Matcher+  -> LPdct+matchLevel l d f m = P.operand desc pd+  where+    desc = makeDesc ("level " <> X.pack (show l) <> " of " <> d) m+    pd pf = let ts = textList (f pf)+            in if l < 0 || l >= length ts+               then False+               else M.match m (ts !! l)  -- | Does the matcher match the text of the memo? Joins each line of -- the memo with a space.-matchMemo :: (Text -> Bool) -> Maybe B.Memo -> Bool-matchMemo f = maybe False (f . X.intercalate (X.singleton ' ') . B.unMemo)---matchMaybeLevel ::-  HasTextList a-  => Int-  -> (Text -> Bool)-  -> Maybe a-  -> Bool-matchMaybeLevel i f = maybe False (matchLevel i f)+matchMemo+  :: Text+  -> (PostFam -> Maybe B.Memo)+  -> M.Matcher+  -> LPdct+matchMemo t f m = P.operand desc pd+  where+    desc = makeDesc t m+    pd = maybe False doMatch . f+    doMatch = M.match m+              . X.intercalate (X.singleton ' ')+              . B.unMemo +matchDelimited+  :: HasTextList a+  => Text+  -- ^ Separator+  -> Text+  -- ^ Label+  -> (PostFam -> a)+  -> M.Matcher+  -> LPdct+matchDelimited sep lbl f m = match lbl f' m+  where+    f' = X.concat . intersperse sep . textList . f  -- * Pattern matching fields -payee :: (Text -> Bool) -> PostFam -> Bool-payee f = matchMaybe f . Q.payee+payee :: MakePdct+payee = matchMaybe "payee" Q.payee -number :: (Text -> Bool) -> PostFam -> Bool-number f = matchMaybe f . Q.number+number :: MakePdct+number = matchMaybe "number" Q.number -flag :: (Text -> Bool) -> PostFam -> Bool-flag f = matchMaybe f . Q.flag+flag :: MakePdct+flag = matchMaybe "flag" Q.flag -postingMemo :: (Text -> Bool) -> PostFam -> Bool-postingMemo f = matchMemo f . Q.postingMemo+postingMemo :: MakePdct+postingMemo = matchMemo "posting memo" Q.postingMemo -transactionMemo :: (Text -> Bool) -> PostFam -> Bool-transactionMemo f = matchMemo f . Q.transactionMemo+transactionMemo :: MakePdct+transactionMemo = matchMemo "transaction memo" Q.transactionMemo  -- * Date -date ::-  (B.DateTime -> Bool)-  -> PostFam-  -> Bool-date f c = f (Q.dateTime c)---localDay ::-  (Day -> Bool)-  -> PostFam-  -> Bool-localDay f = f . Q.localDay---- * Qty--qty ::-  (B.Qty -> Bool)-  -> PostFam-  -> Bool-qty f c = f (Q.qty c)-+-- | Comparisons.+data Comp+  = DLT+  -- ^ Less than --- * DrCr-drCr :: B.DrCr -> PostFam -> Bool-drCr dc p = dc == Q.drCr p+  | DLTEQ+  -- ^ Less than or equal to -debit :: PostFam -> Bool-debit p = Q.drCr p == B.Debit+  | DEQ+  -- ^ Equal to -credit :: PostFam -> Bool-credit p = Q.drCr p == B.Credit+  | DGTEQ+  -- ^ Greater than or equal to --- * Matching delimited fields+  | DGT+  -- ^ Greater than -matchDelimited ::-  HasTextList a-  => Text-  -> (Text -> Bool)-  -> a -> Bool-matchDelimited d f = f . X.concat . intersperse d . textList+  | DNE+  -- ^ Not equal to+  deriving Eq --- * Commodity+-- | Describes a Comp, and returns a function to actually perform+-- comparisons.+descComp :: Ord a => Comp -> (Text, a -> a -> Bool)+descComp c = case c of+  DLT -> ("less than", (<))+  DLTEQ -> ("less than or equal to", (<=))+  DEQ -> ("equal to", (==))+  DGTEQ -> ("greater than or equal to", (>=))+  DGT -> ("greater than", (>))+  DNE -> ("not equal to", (/=)) -commodity :: (Text -> Bool) -> PostFam -> Bool-commodity f = f . text . Q.commodity+date+  :: Comp+  -> Time.UTCTime+  -> LPdct+date c d = P.operand desc pd+  where+    desc = "UTC date is " <> dd <> " " <> X.pack (show d)+    (dd, cmp) = descComp c+    pd pf = (B.toUTC . Q.dateTime $ pf) `cmp` d  --- * Account-account :: Text -> (Text -> Bool) -> PostFam -> Bool-account t f = matchDelimited t f . Q.account+qty :: Comp -> B.Qty -> LPdct+qty c q = P.operand desc pd+  where+    desc = "quantity is " <> dd <> " " <> X.pack (show q)+    (dd, cmp) = descComp c+    pd pf = (Q.qty pf) `cmp` q -accountLevel :: Int -> (Text -> Bool) -> PostFam -> Bool-accountLevel i f = matchLevel i f . Q.account+drCr :: B.DrCr -> LPdct+drCr dc = P.operand desc pd+  where+    desc = "entry is a " <> s+    s = case dc of { B.Debit -> "debit"; B.Credit -> "credit" }+    pd pf = Q.drCr pf == dc -accountAny :: (Text -> Bool) -> PostFam -> Bool-accountAny f = matchAny f . Q.account+debit :: LPdct+debit = drCr B.Debit --- * Tags-tag :: (Text -> Bool) -> PostFam -> Bool-tag f = matchAny f . Q.tags+credit :: LPdct+credit = drCr B.Credit --- * Combining predicates-(&&&) :: (a -> Bool) -> (a -> Bool) -> (a -> Bool)-(&&&) l r = \a -> l a && r a+commodity :: M.Matcher -> LPdct+commodity = match "commodity" Q.commodity -infixr 3 &&&+account :: M.Matcher -> LPdct+account = matchDelimited ":" "account" Q.account -(|||) :: (a -> Bool) -> (a -> Bool) -> (a -> Bool)-(|||) l r = \a -> l a || r a+accountLevel :: Int -> M.Matcher -> LPdct+accountLevel i = matchLevel i "account" Q.account -infixr 2 |||+accountAny :: M.Matcher -> LPdct+accountAny = matchAny "any sub-account" Q.account +tag :: M.Matcher -> LPdct+tag = matchAny "any tag" Q.tags --- * Clones+-- | True if a posting is reconciled; that is, its flag is exactly+-- @R@.+reconciled :: LPdct+reconciled = P.operand d p+  where+    d = "posting flag is exactly \"R\" (is reconciled)"+    p = maybe False ((== X.singleton 'R') . B.unFlag) . Q.flag  -- | Returns True if these two transactions are clones; that is, if -- they are identical in all respects except some aspects of their@@ -193,3 +285,4 @@   && (T.pEntry p1 == T.pEntry p2)   && (T.pMemo p1 == T.pMemo p2)   && (T.pInferred p1 == T.pInferred p2)+