penny-lib 0.10.0.0 → 0.12.0.0

raw patch · 13 files changed

+715/−185 lines, 13 filesdep ~multiargdep ~prednotePVP ok

version bump matches the API change (PVP)

Dependency ranges changed: multiarg, prednote

API changes (from Hackage documentation)

Files

• Penny.hs +8/−4
• Penny/Brenner.hs +38/−22
• Penny/Cabin/Posts/Parser.hs +5/−8
• Penny/Liberty.hs +226/−50
• Penny/Lincoln/Bits/Qty.hs +3/−0
• Penny/Lincoln/HasText.hs +3/−0
• Penny/Lincoln/Predicates.hs +12/−46
• Penny/Lincoln/Predicates/Siblings.hs +210/−0
• Penny/Lincoln/Queries.hs +8/−0
• Penny/Lincoln/Queries/Siblings.hs +87/−0
• Penny/Wheat.hs +26/−19
• Penny/Zinc.hs +81/−33
• penny-lib.cabal +8/−3

@@ -5,7 +5,8 @@      -- | Everything you need to create a custom Penny program is     -- available by importing only this module.-    Defaults(..)+    Version(..)+  , Defaults(..)   , Z.Matcher(..)    -- ** Color schemes@@ -85,6 +86,7 @@   ) where  import qualified Data.Text as X+import Data.Version (Version(..)) import qualified Penny.Cabin.Balance.Convert as Conv import qualified Penny.Cabin.Balance.Convert.Parser as CP import qualified Penny.Cabin.Balance.Convert.Options as ConvOpts@@ -231,16 +233,18 @@  -- | Creates an IO action that you can use for the main function. runPenny-  :: (S.Runtime -> Defaults)+  :: Version+  -- ^ Version of the executable+  -> (S.Runtime -> Defaults)      -- ^ runPenny will apply this function to the Runtime. This way      -- the defaults you use can vary depending on environment      -- variables, the terminal type, the date, etc.   -> IO ()-runPenny getDefaults = do+runPenny ver getDefaults = do   rt <- S.runtime   let df = getDefaults rt       rs = allReports df-  Z.runZinc (toZincDefaults df) rt rs+  Z.runZinc ver (toZincDefaults df) rt rs  -- | The commodity to which to convert the commodities in the convert -- report.

@@ -18,8 +18,11 @@   ) where  import qualified Penny.Brenner.Types as Y-import Data.Maybe (mapMaybe)+import Control.Monad (join)+import Data.Either (partitionEithers) import qualified Data.Text as X+import qualified Data.Version as V+import qualified Penny.Liberty as Ly import qualified Penny.Lincoln as L import qualified Penny.Lincoln.Builders as Bd import qualified Penny.Copper.Render as R@@ -32,33 +35,46 @@ import qualified System.Console.MultiArg as MA import qualified Control.Monad.Exception.Synchronous as Ex -brennerMain :: Config -> IO ()-brennerMain cf = do+brennerMain+  :: V.Version+  -- ^ Binary version+  -> Config+  -> IO ()+brennerMain v cf = do   let cf' = convertConfig cf-  ioAction <- MA.modesWithHelp (help cf') globalOpts+  join $ MA.modesWithHelp (help cf') (globalOpts v)     (preProcessor cf')-  ioAction -data Arg = AFitAcct String-  deriving (Eq, Show)--toFitAcctOpt :: Arg -> Maybe String-toFitAcctOpt a = case a of { AFitAcct s -> Just s }--globalOpts :: [MA.OptSpec Arg]-globalOpts =-  [ MA.OptSpec ["fit-account"] "f" (MA.OneArg AFitAcct) ]+globalOpts+  :: V.Version+  -- ^ Binary version+  -> [MA.OptSpec (Either (IO ()) String)]+globalOpts v =+  [ MA.OptSpec ["fit-account"] "f" (MA.OneArg Right)+  , fmap Left (Ly.version v)+  ]  preProcessor-  :: Y.Config -> [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 ->+  :: Y.Config+  -> [Either (IO ()) String]+  -> Either (a -> IO ()) [MA.Mode (IO ())]+preProcessor cf args =+  let (vers, as) = partitionEithers args+  in case vers of+      [] -> makeModes cf as+      x:_ -> Left (const x)++makeModes+  :: Y.Config+  -> [String]+  -- ^ Names of financial institutions given on command line+  -> Either (a -> IO ()) [MA.Mode (IO ())]+makeModes cf as = Ex.toEither . Ex.mapException (const . fail) $ do+  fi <- case as of+    [] -> return $ Y.defaultFitAcct cf+    _ ->       let pdct (Y.Name n, _) = n == X.pack s+          s = last as       in case filter pdct (Y.moreFitAccts cf) of            [] -> Ex.throw $               "financial institution account "

@@ -26,7 +26,6 @@ import qualified Data.Prednote.Expressions as Exp import qualified Data.Prednote.Pdct as Pt import qualified Penny.Lincoln as L-import qualified Penny.Lincoln.Predicates as Pd import qualified Penny.Shield as S import qualified Text.Matchers as M @@ -99,14 +98,12 @@ optBoxSerial nm f = C.OptSpec [nm] "" (C.TwoArg g)   where     g a1 a2 st = do-      cmp <- Ly.parseComparer a1       i <- Ly.parseInt a2-      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+      let getPd = Pt.compareBy (X.pack . show $ i)+                  ("serial " <> X.pack nm) cmp+          cmp l = compare (f . L.boxMeta $ l) i+      pd <- Ly.parseComparer a1 getPd+      let tok = Exp.operand pd       return $ st { tokens = tokens st ++ [tok] }  optFilteredNum :: C.OptSpec (State -> Ex.Exceptional Error State)

@@ -36,6 +36,9 @@   caseSelectSpecs,   operatorSpecs, +  -- * Version+  version,+   -- * Errors   Error @@ -49,14 +52,16 @@ import Data.List (sortBy) import Data.Text (Text, pack) import qualified Data.Time as Time+import qualified System.Console.MultiArg as MA import qualified System.Console.MultiArg.Combinator as C import System.Console.MultiArg.Combinator (OptSpec) import Text.Parsec (parse)  import qualified Penny.Copper.Parsec as Pc -import Penny.Lincoln.Family.Child (child, parent)+import Penny.Lincoln.Family.Child (Child(Child), child, parent) import qualified Penny.Lincoln.Predicates as P+import qualified Penny.Lincoln.Predicates.Siblings as PS import qualified Data.Prednote.Pdct as E import qualified Penny.Lincoln as L import qualified System.Console.Rainbow as C@@ -66,6 +71,10 @@   CaseSensitive(Sensitive, Insensitive)) import qualified Text.Matchers as TM +import qualified Paths_penny_lib as PPL+import qualified Data.Version as V+import qualified System.Exit as Exit+ -- | A multiline Text that holds an error message. type Error = Text @@ -224,19 +233,12 @@  -- | Parses comparers given on command line to a function. Fails if -- the string given is invalid.-parseComparer :: String -> Ex.Exceptional Error P.Comp-parseComparer 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"+parseComparer+  :: String+  -> (Ordering -> E.Pdct a)+  -> Ex.Exceptional Error (E.Pdct a)+parseComparer s f = Ex.fromMaybe ("bad comparer: " <> pack s <> "\n")+                  $ E.parseComparer (pack s) f  -- | Parses a date from the command line. On failure, throws back the -- error message from the failed parse.@@ -256,13 +258,15 @@ date :: OptSpec (Ex.Exceptional Error Operand) date = C.OptSpec ["date"] ['d'] (C.TwoArg f)   where-    f a1 a2 = P.date <$> parseComparer a1 <*> parseDate a2+    f a1 a2 = do+      utct <- parseDate a2+      parseComparer a1 (flip P.date utct)   current :: L.DateTime -> OptSpec Operand current dt = C.OptSpec ["current"] [] (C.NoArg f)   where-    f = P.date P.DLTEQ (L.toUTC dt)+    f = E.or [P.date LT (L.toUTC dt), P.date EQ (L.toUTC dt)]  -- | Parses exactly one integer; fails if it cannot read exactly one. parseInt :: String -> Ex.Exceptional Error Int@@ -338,18 +342,23 @@ number :: OptSpec ( CaseSensitive                     -> MatcherFactory                     -> Ex.Exceptional Error Operand )-number = patternOption "number" Nothing P.number+number = patternOption "number" (Just 'n') P.number  flag :: OptSpec ( CaseSensitive                   -> MatcherFactory                   -> Ex.Exceptional Error Operand)-flag = patternOption "flag" Nothing P.flag+flag = patternOption "flag" (Just 'f') P.flag  commodity :: OptSpec ( CaseSensitive                        -> MatcherFactory                        -> Ex.Exceptional Error Operand)-commodity = patternOption "commodity" Nothing P.commodity+commodity = patternOption "commodity" (Just 'y') P.commodity +filename :: OptSpec ( CaseSensitive+                      -> MatcherFactory+                      -> Ex.Exceptional Error Operand )+filename = patternOption "filename" Nothing P.filename+ postingMemo :: OptSpec ( CaseSensitive                          -> MatcherFactory                          -> Ex.Exceptional Error Operand)@@ -368,9 +377,11 @@ credit = C.OptSpec ["credit"] [] (C.NoArg P.credit)  qtyOption :: OptSpec (Ex.Exceptional Error Operand)-qtyOption = C.OptSpec ["qty"] [] (C.TwoArg f)+qtyOption = C.OptSpec ["qty"] "q" (C.TwoArg f)   where-    f a1 a2 = P.qty <$> parseComparer a1 <*> parseQty a2+    f a1 a2 = do+      qt <- parseQty a2+      parseComparer a1 (flip P.qty qt)     parseQty a = case parse Pc.quantity "" (pack a) of       Left e -> Ex.throw $ "could not parse quantity: "         <> pack a <> " - "@@ -378,7 +389,6 @@       Right g -> pure g  - -- | Creates two options suitable for comparison of serial numbers, -- one for ascending, one for descending. serialOption ::@@ -397,20 +407,64 @@ serialOption getSerial n = (osA, osD)   where     osA = C.OptSpec [n] []-          (C.TwoArg (f L.forward))-    osD = C.OptSpec [addPrefix "rev" n] []-          (C.TwoArg (f L.backward))-    f getInt a1 a2 = do-      cmp <- parseComparer a1+          (C.TwoArg (f n L.forward))+    osD = let name = addPrefix "rev" n+          in C.OptSpec [name] []+             (C.TwoArg (f name L.backward))+    f name getInt a1 a2 = do       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)+      let getPdct = E.compareByMaybe (pack . show $ num) (pack name) cmp+          cmp l = case getSerial l of+            Nothing -> Nothing+            Just ser -> Just $ compare (getInt ser) num+      parseComparer a1 getPdct  +-- | Creates two options suitable for comparison of sibling serial+-- numbers. Similar to 'serialOption'.+siblingSerialOption++  :: (L.Posting -> Maybe L.Serial)+  -- ^ Function that, when applied to a PostFam, returns the serial+  -- you are interested in.++  -> String+  -- ^ Name of the command line option, such as @global-posting@++  -> ( OptSpec (Ex.Exceptional Error Operand)+     , OptSpec (Ex.Exceptional Error Operand) )+  -- ^ Parses both descending and ascending serial options.++siblingSerialOption getSerial n = (osA, osD)+  where+    osA = C.OptSpec ["s-" ++ n] []+          (C.TwoArg (f n L.forward))+    osD = let name = addPrefix "rev" n+          in C.OptSpec ["s-" ++ name] []+             (C.TwoArg (f name L.backward))+    f name getInt a1 a2 = do+      num <- parseInt a2+      let getPdct ord = E.operand desc fn+            where+              desc = "any sibling serial " <> pack name+                     <> " is " <> descCmp ord+                     <> " " <> (pack . show $ num)+              fn = any doCmp . getSiblings . L.unPostFam+              doCmp p = case getSerial p of+                Nothing -> False+                Just ser -> compare (getInt ser) num == ord+      parseComparer a1 getPdct+++getSiblings :: Child p c -> [c]+getSiblings (Child _ s1 ss _) = s1:ss++descCmp :: Ordering -> Text+descCmp o = case o of+  LT -> "less than"+  EQ -> "equal to"+  GT -> "greater than"+ -- | Takes a string, adds a prefix and capitalizes the first letter of -- the old string. e.g. applied to "rev" and "globalTransaction", -- returns "revGlobalTransaction".@@ -476,9 +530,23 @@   , commodity   , postingMemo   , transactionMemo+  , filename   , fmap (const . const . pure) debit   , fmap (const . const . pure) credit   , fmap (const . const) qtyOption++  , sAccount+  , sAccountLevel+  , sAccountAny+  , sPayee+  , sTag+  , sNumber+  , sFlag+  , sCommodity+  , sPostingMemo+  , fmap (const . const . pure) sDebit+  , fmap (const . const. pure) sCredit+  , fmap (const . const) sQtyOption   ]   ++ serialSpecs @@ -489,7 +557,8 @@   = concat   $ [unDouble]   <*> [ globalTransaction, globalPosting,-        filePosting, fileTransaction ]+        filePosting, fileTransaction,+        sGlobalPosting, sFilePosting ]  unDouble   :: Functor f@@ -533,9 +602,6 @@ -- Matcher control ------------------------------------------------------------ -noArg :: a -> String -> OptSpec a-noArg a s = C.OptSpec [s] "" (C.NoArg a)- parseInsensitive :: OptSpec CaseSensitive parseInsensitive =   C.OptSpec ["case-insensitive"] ['i'] (C.NoArg Insensitive)@@ -547,16 +613,19 @@   within :: OptSpec MatcherFactory-within = noArg (\c t -> return (TM.within c t)) "within"+within =+  C.OptSpec ["within"] "w" . C.NoArg $ \c t ->+    return (TM.within c t)  pcre :: OptSpec MatcherFactory-pcre = noArg TM.pcre "pcre"+pcre = C.OptSpec ["pcre"] "r" (C.NoArg TM.pcre)  posix :: OptSpec MatcherFactory-posix = noArg TM.tdfa "posix"+posix = C.OptSpec ["posix"] "" (C.NoArg TM.tdfa)  exact :: OptSpec MatcherFactory-exact = noArg (\c t -> return (TM.exact c t)) "exact"+exact = C.OptSpec ["exact"] "x" . C.NoArg $ \c t ->+        return (TM.exact c t)  matcherSelectSpecs :: [OptSpec MatcherFactory] matcherSelectSpecs = [within, pcre, posix, exact]@@ -570,23 +639,23 @@  -- | Open parentheses open :: OptSpec (X.Token a)-open = noArg X.openParen "open"+open = C.OptSpec ["open"] "(" (C.NoArg X.openParen)  -- | Close parentheses close :: OptSpec (X.Token a)-close = noArg X.closeParen "close"+close = C.OptSpec ["close"] ")" (C.NoArg X.closeParen)  -- | and operator parseAnd :: OptSpec (X.Token a)-parseAnd = noArg X.opAnd "and"+parseAnd = C.OptSpec ["and"] "A" (C.NoArg X.opAnd)  -- | or operator parseOr :: OptSpec (X.Token a)-parseOr = noArg X.opOr "or"+parseOr = C.OptSpec ["or"] "O" (C.NoArg X.opOr)  -- | not operator parseNot :: OptSpec (X.Token a)-parseNot = noArg X.opNot "not"+parseNot = C.OptSpec ["not"] "N" (C.NoArg X.opNot)  operatorSpecs :: [OptSpec (X.Token a)] operatorSpecs =@@ -595,18 +664,125 @@ -- Infix and RPN expression selectors  parseInfix :: OptSpec X.ExprDesc-parseInfix = noArg X.Infix "infix"+parseInfix = C.OptSpec ["infix"] "" (C.NoArg X.Infix)  parseRPN :: OptSpec X.ExprDesc-parseRPN = noArg X.RPN "rpn"+parseRPN = C.OptSpec ["rpn"] "" (C.NoArg X.RPN)  -- | Both Infix and RPN options. exprDesc :: [OptSpec X.ExprDesc] exprDesc = [ parseInfix, parseRPN ]  showExpression :: OptSpec ()-showExpression = noArg () "show-expression"+showExpression = C.OptSpec ["show-expression"] "" (C.NoArg ())  verboseFilter :: OptSpec ()-verboseFilter = noArg () "verbose-filter"+verboseFilter = C.OptSpec ["verbose-filter"] "" (C.NoArg ()) +--+-- Siblings+--++sGlobalPosting :: ( OptSpec (Ex.Exceptional Error Operand)+                  , OptSpec (Ex.Exceptional Error Operand) )+sGlobalPosting =+  siblingSerialOption (fmap (fmap L.unGlobalPosting) L.pGlobalPosting)+                      "globalPosting"++sFilePosting :: ( OptSpec (Ex.Exceptional Error Operand)+                  , OptSpec (Ex.Exceptional Error Operand) )+sFilePosting =+  siblingSerialOption (fmap (fmap L.unFilePosting) L.pFilePosting)+                      "filePosting"++sAccount :: OptSpec ( CaseSensitive+                    -> MatcherFactory+                    -> Ex.Exceptional Error Operand )+sAccount = C.OptSpec ["s-account"] "" (C.OneArg f)+  where+    f a1 cs fty = fmap PS.account+                  $ getMatcher a1 cs fty++sAccountLevel :: OptSpec ( CaseSensitive+                         -> MatcherFactory+                         -> Ex.Exceptional Error Operand )+sAccountLevel = C.OptSpec ["s-account-level"] "" (C.TwoArg f)+  where+    f a1 a2 cs fty+      = PS.accountLevel <$> parseInt a1 <*> getMatcher a2 cs fty++sAccountAny :: OptSpec ( CaseSensitive+                        -> MatcherFactory+                        -> Ex.Exceptional Error Operand )+sAccountAny = patternOption "s-account-any" Nothing PS.accountAny++-- | The payee option; returns True if the matcher matches the payee+-- name.+sPayee :: OptSpec ( CaseSensitive+                 -> MatcherFactory+                 -> Ex.Exceptional Error Operand )+sPayee = patternOption "s-payee" (Just 'p') PS.payee++sTag :: OptSpec ( CaseSensitive+                 -> MatcherFactory+                 -> Ex.Exceptional Error Operand)+sTag = patternOption "s-tag" (Just 't') PS.tag++sNumber :: OptSpec ( CaseSensitive+                    -> MatcherFactory+                    -> Ex.Exceptional Error Operand )+sNumber = patternOption "s-number" Nothing PS.number++sFlag :: OptSpec ( CaseSensitive+                  -> MatcherFactory+                  -> Ex.Exceptional Error Operand)+sFlag = patternOption "s-flag" Nothing PS.flag++sCommodity :: OptSpec ( CaseSensitive+                       -> MatcherFactory+                       -> Ex.Exceptional Error Operand)+sCommodity = patternOption "s-commodity" Nothing PS.commodity++sPostingMemo :: OptSpec ( CaseSensitive+                         -> MatcherFactory+                         -> Ex.Exceptional Error Operand)+sPostingMemo = patternOption "s-posting-memo" Nothing PS.postingMemo++sDebit :: OptSpec Operand+sDebit = C.OptSpec ["s-debit"] [] (C.NoArg PS.debit)++sCredit :: OptSpec Operand+sCredit = C.OptSpec ["s-credit"] [] (C.NoArg PS.credit)++sQtyOption :: OptSpec (Ex.Exceptional Error Operand)+sQtyOption = C.OptSpec ["s-qty"] [] (C.TwoArg f)+  where+    f a1 a2 = do+      qt <- parseQty a2+      parseComparer a1 (flip PS.qty qt)+    parseQty a = case parse Pc.quantity "" (pack a) of+      Left e -> Ex.throw $ "could not parse quantity: "+        <> pack a <> " - "+        <> (pack . show $ e)+      Right g -> pure g++--+-- Versions+--++-- | Parses the @--version@ option and returns an IO action that+-- prints it and exits successfully. You supply the version of the+-- executable, as there is no easy way to get that automatically.++version+  :: V.Version+  -- ^ Version of binary+  -> OptSpec (IO a)+version v = C.OptSpec ["version"] [] (C.NoArg f)+  where+    f = do+      pn <- MA.getProgName+      putStrLn $ pn ++ " version " ++ V.showVersion v+      putStrLn $ "using version " ++ V.showVersion PPL.version+                 ++ " of penny-lib"+      Exit.exitSuccess

@@ -93,6 +93,9 @@              else b ++ ['.'] ++ end  +-- | Compares Qty after equalizing their exponents.+--+-- > compare (newQty 15 1) (newQty 1500 3) == EQ instance Ord Qty where   compare q1 q2 = compare (mantissa q1') (mantissa q2')     where

@@ -28,6 +28,9 @@ instance HasText B.Tag where   text = B.unTag +instance HasText B.Filename where+  text = B.unFilename+ class HasTextList a where   textList :: a -> [Text] 

@@ -11,8 +11,6 @@   , flag   , postingMemo   , transactionMemo-  , Comp(..)-  , descComp   , date   , qty   , drCr@@ -23,6 +21,7 @@   , accountLevel   , accountAny   , tag+  , filename   , reconciled   , clonedTransactions   , clonedTopLines@@ -149,6 +148,9 @@ flag :: MakePdct flag = matchMaybe "flag" Q.flag +filename :: MakePdct+filename = matchMaybe "filename" Q.filename+ postingMemo :: MakePdct postingMemo = matchMemo "posting memo" Q.postingMemo @@ -157,55 +159,19 @@  -- * Date --- | Comparisons.-data Comp-  = 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-  deriving Eq---- | 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", (/=))- date-  :: Comp+  :: Ordering   -> 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+date ord u = P.compareBy (X.pack . show $ u)+             "UTC date and time"+           (\l -> compare (B.toUTC . Q.dateTime $ l) u) ord  -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+qty :: Ordering -> B.Qty -> LPdct+qty o q = P.compareBy (X.pack . show $ q) "quantity"+          (\l -> compare (Q.qty l) q) o+  drCr :: B.DrCr -> LPdct drCr dc = P.operand desc pd

@@ -0,0 +1,210 @@+{-# 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.Siblings+  ( LPdct+  , MakePdct+  , payee+  , number+  , flag+  , postingMemo+  , qty+  , parseQty+  , drCr+  , debit+  , credit+  , commodity+  , account+  , accountLevel+  , accountAny+  , tag+  , reconciled+  ) where+++import Data.List (intersperse)+import Data.Monoid ((<>))+import Data.Text (Text)+import qualified Data.Text as X+import qualified Penny.Lincoln.Bits as B+import Penny.Lincoln.HasText (HasText, text, HasTextList, textList)+import qualified Penny.Lincoln.Queries.Siblings as Q+import Penny.Lincoln.Transaction (PostFam)+import qualified Text.Matchers as M+import qualified Data.Prednote.Pdct as P++type LPdct = P.Pdct PostFam++type MakePdct = M.Matcher -> LPdct++-- * 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 = any (M.match m) . map 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 = any (== (Just True))+         . map (fmap (M.match m . text))+         . f++makeDesc :: Text -> M.Matcher -> Text+makeDesc t m+  = "subject: " <> t <> " (any sibling posting) matcher: "+  <> M.matchDesc m++-- | Does the given matcher match any of the elements of the Texts in+-- a HasTextList?+matchAny+  :: HasTextList a+  => Text+  -> (PostFam -> [a])+  -> M.Matcher+  -> LPdct+matchAny t f m = P.operand desc pd+  where+    desc = makeDesc t m+    pd = any (any (M.match m)) . map 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+  -> (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 doMatch list = if l < 0 || l >= length list+                               then False+                               else M.match m (list !! l)+            in any doMatch . map textList . f $ pf++-- | Does the matcher match the text of the memo? Joins each line of+-- the memo with a space.+matchMemo+  :: Text+  -> (PostFam -> [Maybe B.Memo])+  -> M.Matcher+  -> LPdct+matchMemo t f m = P.operand desc pd+  where+    desc = makeDesc t m+    pd = any (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' = map (X.concat . intersperse sep . textList) . f++-- * Pattern matching fields++payee :: MakePdct+payee = matchMaybe "payee" Q.payee++number :: MakePdct+number = matchMaybe "number" Q.number++flag :: MakePdct+flag = matchMaybe "flag" Q.flag++postingMemo :: MakePdct+postingMemo = matchMemo "posting memo" Q.postingMemo++-- | A Pdct that returns True if @compare subject qty@ returns the+-- given Ordering.+qty :: Ordering -> B.Qty -> LPdct+qty o q = P.operand desc pd+  where+    desc = "quantity of any sibling is " <> dd <> " " <> X.pack (show q)+    dd = case o of+      LT -> "less than"+      GT -> "greater than"+      EQ -> "equal to"+    pd = any ((== o) . (`compare` q)) . Q.qty++parseQty+  :: X.Text+  -> Maybe (B.Qty -> LPdct)+parseQty x+  | x == "==" = Just (qty EQ)+  | x == "=" = Just (qty EQ)+  | x == ">" = Just (qty GT)+  | x == "<" = Just (qty LT)+  | x == "/=" = Just (\q -> P.not (qty EQ q))+  | x == "!=" = Just (\q -> P.not (qty EQ q))+  | x == ">=" = Just (\q -> P.or [qty GT q, qty EQ q])+  | x == "<=" = Just (\q -> P.or [qty LT q, qty EQ q])+  | otherwise = Nothing++drCr :: B.DrCr -> LPdct+drCr dc = P.operand desc pd+  where+    desc = "entry of any sibling is a " <> s+    s = case dc of { B.Debit -> "debit"; B.Credit -> "credit" }+    pd = any (== dc) . Q.drCr++debit :: LPdct+debit = drCr B.Debit++credit :: LPdct+credit = drCr B.Credit++commodity :: M.Matcher -> LPdct+commodity = match "commodity" Q.commodity++account :: M.Matcher -> LPdct+account = matchDelimited ":" "account" Q.account++accountLevel :: Int -> M.Matcher -> LPdct+accountLevel i = matchLevel i "account" Q.account++accountAny :: M.Matcher -> LPdct+accountAny = matchAny "any sub-account" Q.account++tag :: M.Matcher -> LPdct+tag = matchAny "any tag" Q.tags++-- | 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 = any (maybe False ((== X.singleton 'R') . B.unFlag))+        . Q.flag+

@@ -1,3 +1,9 @@+-- | Examining a PostFam for a particular component of the main+-- posting (as opposed to the sibling postings) in the PostFam. For+-- some components, such as the payee, the posting might have one+-- piece of data while the TopLine has something else. These functions+-- will examine the Posting first and, if it has no information, use+-- the data from the TopLine if it is there. module Penny.Lincoln.Queries where  import qualified Penny.Lincoln.Bits as B@@ -6,6 +12,8 @@ import Penny.Lincoln.Balance (Balance, entryToBalance) import qualified Data.Time as Time +-- | Uses the data from the Posting if it is set; otherwise, use the+-- data from the TopLine. best ::   (T.Posting -> Maybe a)   -> (T.TopLine -> Maybe a)

@@ -0,0 +1,87 @@+-- | Like 'Penny.Lincoln.Queries' but instead of querying the main+-- posting of the PostFam, queries the siblings. Therefore, these+-- functions return a list, with each entry in the list containing the+-- best answer for each sibling. There is one item in the list for+-- each sibling, even if all these items contain the same data (for+-- instance, a posting might have five siblings, but all five siblings+-- might have the same payee. Nonetheless the 'payee' function will+-- return a list of five items.)+module Penny.Lincoln.Queries.Siblings where++import qualified Penny.Lincoln.Bits as B+import Penny.Lincoln.Family.Child (Child(Child))+import qualified Penny.Lincoln.Transaction as T+import Penny.Lincoln.Balance (Balance, entryToBalance)++-- | For all siblings, uses information from the Posting if it is set;+-- otherwise, uses data from the TopLine.+bestSibs+  :: (T.Posting -> Maybe a)+  -> (T.TopLine -> Maybe a)+  -> T.PostFam+  -> [Maybe a]+bestSibs fp ft pf =+  let (Child _ s1 ss p) = T.unPostFam pf+      get = maybe (ft p) Just . fp+  in get s1 : map get ss++-- | For all siblings, get the information from the Posting if it+-- exists; otherwise Nothing.+sibs+  :: (T.Posting -> a)+  -> T.PostFam+  -> [a]+sibs fp pf =+  let (Child _ s1 ss _) = T.unPostFam pf+  in fp s1 : map fp ss++payee :: T.PostFam -> [Maybe B.Payee]+payee = bestSibs T.pPayee T.tPayee++number :: T.PostFam -> [Maybe B.Number]+number = bestSibs T.pNumber T.tNumber++flag :: T.PostFam -> [Maybe B.Flag]+flag = bestSibs T.pFlag T.tFlag++postingMemo :: T.PostFam -> [Maybe B.Memo]+postingMemo = sibs T.pMemo++account :: T.PostFam -> [B.Account]+account = sibs T.pAccount++tags :: T.PostFam -> [B.Tags]+tags = sibs T.pTags++entry :: T.PostFam -> [B.Entry]+entry = sibs T.pEntry++balance :: T.PostFam -> [Balance]+balance = map entryToBalance . entry++drCr :: T.PostFam -> [B.DrCr]+drCr = map B.drCr . entry++amount :: T.PostFam -> [B.Amount]+amount = map B.amount . entry++qty :: T.PostFam -> [B.Qty]+qty = map B.qty . amount++commodity :: T.PostFam -> [B.Commodity]+commodity = map B.commodity . amount++postingLine :: T.PostFam -> [Maybe B.PostingLine]+postingLine = sibs T.pPostingLine++side :: T.PostFam -> [Maybe B.Side]+side = map B.side . amount++spaceBetween :: T.PostFam -> [Maybe B.SpaceBetween]+spaceBetween = map B.spaceBetween . amount++globalPosting :: T.PostFam -> [Maybe B.GlobalPosting]+globalPosting = sibs T.pGlobalPosting++filePosting :: T.PostFam -> [Maybe B.FilePosting]+filePosting = sibs T.pFilePosting

@@ -26,10 +26,12 @@  import Control.Monad (when) import qualified Control.Monad.Exception.Synchronous as Ex+import Data.Either (partitionEithers) import Data.Maybe (mapMaybe) import qualified Penny.Copper as Cop import qualified Penny.Copper.Parsec as CP import qualified Penny.Lincoln as L+import qualified Penny.Liberty as Ly import qualified Data.Text as X import qualified Data.Time as Time import qualified Text.Matchers as M@@ -38,6 +40,7 @@ import qualified System.IO as IO import qualified Penny.Shield as S +import qualified Data.Version as V import qualified Data.Prednote.TestTree as TT import qualified Data.Prednote.Pdct as Pe import qualified System.Console.Rainbow as Rb@@ -153,24 +156,19 @@  allOpts :: [MA.OptSpec (Parsed -> Parsed)] allOpts =+  let allChoices =+        [ ("silent", \p -> p { p_failVerbosity = TT.Silent })+        , ("minimal", \p -> p { p_failVerbosity = TT.PassFail })+        , ("false", \p -> p { p_failVerbosity = TT.FalseSubjects })+        , ("true", \p -> p { p_failVerbosity = TT.TrueSubjects })+        , ("all", \p -> p { p_failVerbosity = TT.Discards })+        ] in   [ MA.OptSpec ["indentation"] "i"     (fmap (\i p -> p { p_indentAmt = i }) (MA.OneArgE MA.reader)) -  , MA.OptSpec ["pass-verbosity"] "p" $ MA.ChoiceArg-    [ ("silent", \p -> p { p_passVerbosity = TT.Silent })-    , ("minimal", \p -> p { p_passVerbosity = TT.PassFail })-    , ("false", \p -> p { p_passVerbosity = TT.FalseSubjects })-    , ("true", \p -> p { p_passVerbosity = TT.TrueSubjects })-    , ("all", \p -> p { p_passVerbosity = TT.Discards })-    ]+  , MA.OptSpec ["pass-verbosity"] "p" $ MA.ChoiceArg allChoices -  , MA.OptSpec ["fail-verbosity"] "f" $ MA.ChoiceArg-    [ ("silent", \p -> p { p_failVerbosity = TT.Silent })-    , ("minimal", \p -> p { p_failVerbosity = TT.PassFail })-    , ("false", \p -> p { p_failVerbosity = TT.FalseSubjects })-    , ("true", \p -> p { p_failVerbosity = TT.TrueSubjects })-    , ("all", \p -> p { p_failVerbosity = TT.Discards })-    ]+  , MA.OptSpec ["fail-verbosity"] "f" $ MA.ChoiceArg allChoices    , MA.OptSpec ["group-regexp"] "g"     (fmap (\f p -> p { p_groupPred = f }) (MA.OneArgE parseRegexp))@@ -216,13 +214,22 @@ -- | Runs Wheat tests. Prints the result to standard output. Exits -- unsuccessfully if the user gave bad command line options or if at -- least a single test failed; exits successfully if all tests--- succeeded.-main :: (S.Runtime -> WheatConf) -> IO ()-main getWc = do+-- succeeded. Shows the version number and exits successfully if that+-- was requested.+main+  :: V.Version+  -- ^ Version of the binary+  -> (S.Runtime -> WheatConf) -> IO ()+main ver getWc = do   rt <- S.runtime   let wc = getWc rt-  fns <- MA.simpleWithHelp (help wc) MA.Intersperse allOpts-         parseArg+  parsed <- MA.simpleWithHelp (help wc) MA.Intersperse+         (fmap Left (Ly.version ver) : (map (fmap Right) allOpts))+         (fmap Right parseArg)+  let (showVers, fns) = partitionEithers parsed+  case showVers of+    [] -> return ()+    x:_ -> x   let fn = foldl (flip (.)) id fns       psd = fn (getParsedFromWheatConf wc)   term <- Rb.smartTermFromEnv (p_colorToFile psd) IO.stdout

@@ -32,6 +32,7 @@ import Data.Monoid (mappend, mconcat, (<>)) import Data.Ord (comparing) import Data.Text (Text, pack)+import Data.Version (Version) import qualified Data.Text.IO as TIO import qualified System.Console.MultiArg as MA import qualified System.Exit as Exit@@ -40,14 +41,16 @@ import qualified System.Console.Rainbow as R  runZinc-  :: Defaults+  :: Version+  -- ^ Version of the executable+  -> Defaults   -> S.Runtime   -> [I.Report]   -> IO ()-runZinc df rt rs = do+runZinc ver df rt rs = do   let ord = sortPairsToFn . sorter $ df       hlp = helpText df rt rs-  join $ MA.modesWithHelp hlp (allOpts (S.currentTime rt) df)+  join $ MA.modesWithHelp hlp (allOpts ver (S.currentTime rt) df)     (processGlobal rt ord df rs)  @@ -160,6 +163,7 @@   | RExprDesc X.ExprDesc   | RShowExpression   | RVerboseFilter+  | RShowVersion (IO ())  getPostFilters   :: [OptResult]@@ -196,6 +200,13 @@      then return i      else fmap mconcat . sequence $ exSpecs +getShowVersion :: [OptResult] -> Maybe (IO ())+getShowVersion ls = case mapMaybe f ls of+  [] -> Nothing+  xs -> Just $ last xs+  where+    f o = case o of { RShowVersion i -> Just i; _ -> Nothing }+ type Factory = M.CaseSensitive              -> Text -> Ex.Exceptional Text M.Matcher @@ -237,8 +248,8 @@   in fmap (\xs -> (xs, st')) . sequence . catMaybes $ ls  -allOpts :: L.DateTime -> Defaults -> [MA.OptSpec OptResult]-allOpts dt df =+allOpts :: Version -> L.DateTime -> Defaults -> [MA.OptSpec OptResult]+allOpts ver dt df =   map (fmap ROperand) (Ly.operandSpecs dt)   ++ [fmap RPostFilter . fst $ Ly.postFilterSpecs]   ++ [fmap RPostFilter . snd $ Ly.postFilterSpecs]@@ -252,6 +263,7 @@   ++ map (fmap RExprDesc) Ly.exprDesc   ++ [ RShowExpression <$ Ly.showExpression      , RVerboseFilter <$ Ly.verboseFilter+     , fmap RShowVersion (Ly.version ver)      ]  optColorToFile :: MA.OptSpec OptResult@@ -334,25 +346,32 @@ processGlobal rt srt df rpts os   = case processFiltOpts srt df os of       Ex.Exception s -> Left $ (const $ handleTextError s)-      Ex.Success fo -> Right $ map (makeMode rt fo) rpts+      Ex.Success mayFo -> case mayFo of+        Left i -> Left . const $ i+        Right fo -> Right $ map (makeMode rt fo) rpts  processFiltOpts   :: Orderer   -> Defaults   -> [OptResult]-  -> Ex.Exceptional Error FilterOpts-processFiltOpts ord df os = do-  postFilts <- getPostFilters os-  sortSpec <- getSortSpec ord os-  (toks, (rs, rf)) <- makeTokens df os-  let ctf = getColorToFile df os-      sch = getScheme df os-      expDsc = getExprDesc df os-      showExpr = getShowExpression os-      verbFilt = getVerboseFilter os-  pdct <- Ly.parsePredicate expDsc toks-  let sf = Ly.xactionsToFiltered pdct postFilts sortSpec-  return $ FilterOpts rf rs sf sch ctf expDsc pdct showExpr verbFilt+  -> Ex.Exceptional Error (Either (IO ()) FilterOpts)+  -- ^ Left if the user asked to see the version; Right with the+  -- FilterOpts otherwise.+processFiltOpts ord df os = case getShowVersion os of+  Just i -> return $ Left i+  Nothing -> do+    postFilts <- getPostFilters os+    sortSpec <- getSortSpec ord os+    (toks, (rs, rf)) <- makeTokens df os+    let ctf = getColorToFile df os+        sch = getScheme df os+        expDsc = getExprDesc df os+        showExpr = getShowExpression os+        verbFilt = getVerboseFilter os+    pdct <- Ly.parsePredicate expDsc toks+    let sf = Ly.xactionsToFiltered pdct postFilts sortSpec+    return . Right $ FilterOpts rf rs sf sch+                                ctf expDsc pdct showExpr verbFilt  makeMode   :: S.Runtime@@ -524,7 +543,7 @@   , "Dates"   , "-----"   , ""-  , "--date cmp timespec, -d cmp timespec"+  , "-d, --date cmp timespec"   , "  Date must be within the time frame given. timespec"   , "  is a day or a day and a time. Valid values for cmp:"   , "     <, >, <=, >=, ==, /=, !="@@ -561,12 +580,12 @@   , "  Payee must match pattern"   , "-t pattern, --tag pattern"   , "  Tag must match pattern"-  , "--number pattern"+  , "-n, --number pattern"   , "  Number must match pattern"-  , "--flag pattern"+  , "-f, --flag pattern"   , "  Flag must match pattern"-  , "--commodity pattern"-  , "  Pattern must match colon-separated commodity name"+  , "-y, --commodity pattern"+  , "  Pattern must match commodity name"   , "--posting-memo pattern"   , "  Posting memo must match pattern"   , "--transaction-memo pattern"@@ -578,9 +597,30 @@   , "  Entry must be a debit"   , "--credit"   , "  Entry must be a credit"-  , "--qty cmp number"+  , "-q, --qty cmp number"   , "  Entry quantity must fall within given range"+  , "--filename pattern"+  , "  Filename of posting must match pattern"   , ""+  , "Filtering based upon sibling postings"+  , "-------------------------------------"+  , "--s-globalPosting"+  , "--s-revGlobalPosting"+  , "--s-filePosting"+  , "--s-revFilePosting"+  , "--s-account"+  , "--s-account-level"+  , "--s-account-any"+  , "--s-payee"+  , "--s-tag"+  , "--s-number"+  , "--s-flag"+  , "--s-commodity"+  , "--s-posting-memo"+  , "--s-debit"+  , "--s-credit"+  , "--s-qty"+  , ""   , "Options affecting patterns"   , "--------------------------"   , ""@@ -595,11 +635,11 @@    , "" -  , "--within"+  , "-w, --within"   , "  Use \"within\" matcher"     ++ ifDefault (matcher d == Within) -  , "--pcre"+  , "-r, --pcre"   , "  Use \"pcre\" matcher"     ++ ifDefault (matcher d == PCRE) @@ -607,7 +647,7 @@   , "  Use \"posix\" matcher"     ++ ifDefault (matcher d == TDFA) -  , "--exact"+  , "-x, --exact"   , "  Use \"exact\" matcher"     ++ ifDefault (matcher d == Exact)   , ""@@ -622,19 +662,22 @@   , "(all are left associative)"   , "--------------------------"   , "--open expr --close"+  , "-( expr -)"   , "  Force precedence (as in \"open\" and \"close\" parentheses)"-  , "--not expr"+  , "--not, -N expr"   , "  True if expr is false"-  , "expr1 --and expr2 "+  , "expr1 --and expr2"+  , "expr -A expr2"   , "  True if expr and expr2 are both true"   , "expr1 --or expr2"+  , "expr1 -O expr2"   , "  True if either expr1 or expr2 is true"   , ""   , "RPN Operators"   , "-------------"-  , "--not"-  , "--and"-  , "--or"+  , "--not, -N"+  , "--and, -A"+  , "--or, -O"   , "  RPN counterparts to the infix operators"   , "  are postfix and manipulate the RPN stack accordingly"   , ""@@ -687,6 +730,11 @@   , "  Whether to use color when standard output is not a"   , "  terminal (default: " ++     if unColorToFile . colorToFile $ d then "yes)" else "no)"+  , ""+  , "Meta"+  , "----"+  , "--help, -h - show this help and exit"+  , "--version - show version and exit"   ]  

@@ -1,5 +1,5 @@ Name: penny-lib-Version: 0.10.0.0+Version: 0.12.0.0 Cabal-version: >=1.8 Build-Type: Simple License: BSD3@@ -45,11 +45,11 @@     , explicit-exception ==0.1.*     , matchers ==0.6.*     , monad-loops ==0.3.*-    , multiarg ==0.12.*+    , multiarg ==0.14.*     , old-locale ==1.0.*     , parsec >= 3.1.2 && < 3.2     , pcre-light ==0.4.*-    , prednote == 0.4.*+    , prednote == 0.8.*     , pretty-show ==1.5.*     , rainbow ==0.2.*     , semigroups ==0.9.*@@ -121,8 +121,10 @@     , Penny.Lincoln.HasText     , Penny.Lincoln.Matchers     , Penny.Lincoln.Predicates+    , Penny.Lincoln.Predicates.Siblings     , Penny.Lincoln.PriceDb     , Penny.Lincoln.Queries+    , Penny.Lincoln.Queries.Siblings     , Penny.Lincoln.Serial     , Penny.Lincoln.Transaction     , Penny.Lincoln.Transaction.Unverified@@ -131,6 +133,9 @@     , Penny.Steel.NestedMap     , Penny.Wheat     , Penny.Zinc++  Other-modules:+      Paths_penny_lib     ghc-options: -Wall