module Penny.Lincoln.Predicates.Siblings
( LPdct
, MakePdct
, payee
, number
, flag
, postingMemo
, qty
, parseQty
, drCr
, debit
, credit
, commodity
, account
, accountLevel
, accountAny
, tag
, reconciled
, serialPdct
, MakeSerialPdct
, fwdGlobalPosting
, backGlobalPosting
, fwdFilePosting
, backFilePosting
, fwdGlobalTransaction
, backGlobalTransaction
, fwdFileTransaction
, backFileTransaction
) where
import Control.Arrow (second)
import Data.List (intersperse)
import Data.Maybe (catMaybes)
import Data.Monoid ((<>))
import Data.Text (Text)
import qualified Data.Text as X
import qualified Penny.Lincoln.Bits as B
import qualified Penny.Lincoln.Ents as E
import Penny.Lincoln.Serial (forward, backward)
import Penny.Lincoln.HasText (HasText, text, HasTextList, textList)
import qualified Penny.Lincoln.Queries.Siblings as Q
import Penny.Lincoln.Ents (Posting)
import qualified Text.Matchers as M
import qualified Data.Prednote.Pdct as P
type LPdct = P.Pdct Posting
type MakePdct = M.Matcher -> LPdct
match
:: HasText a
=> Text
-> (Posting -> [a])
-> 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
-> (Posting -> [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
matchAny
:: HasTextList a
=> Text
-> (Posting -> [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
matchLevel
:: HasTextList a
=> Int
-> Text
-> (Posting -> [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
matchMemo
:: Text
-> (Posting -> [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
-> Text
-> (Posting -> [a])
-> M.Matcher
-> LPdct
matchDelimited sep lbl f m = match lbl f' m
where
f' = map (X.concat . intersperse sep . textList) . f
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
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
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
serialPdct
:: Text
-> ((B.TopLineData, E.Ent B.PostingData) -> Maybe Int)
-> Int
-> Ordering
-> P.Pdct E.Posting
serialPdct name getSer i o = P.operand n f
where
n = "serial " <> name <> " is " <> descCmp <> " "
<> X.pack (show i)
descCmp = case o of
EQ -> "equal to"
LT -> "less than"
GT -> "greater than"
f = any (\ser -> compare ser i == o )
. catMaybes
. map getSer
. E.unrollSnd
. second (\(x, xs) -> (x:xs))
. second E.tailEnts
. E.unPosting
type MakeSerialPdct = Int -> Ordering -> P.Pdct Posting
fwdGlobalPosting :: MakeSerialPdct
fwdGlobalPosting =
serialPdct "fwdGlobalPosting"
$ fmap (forward . B.unGlobalPosting)
. B.pdGlobal
. E.meta
. snd
backGlobalPosting :: MakeSerialPdct
backGlobalPosting =
serialPdct "revGlobalPosting"
$ fmap (backward . B.unGlobalPosting)
. B.pdGlobal
. E.meta
. snd
fwdFilePosting :: MakeSerialPdct
fwdFilePosting
= serialPdct "fwdFilePosting"
$ fmap (forward . B.unFilePosting . B.pFilePosting)
. B.pdFileMeta
. E.meta
. snd
backFilePosting :: MakeSerialPdct
backFilePosting
= serialPdct "revFilePosting"
$ fmap (backward . B.unFilePosting . B.pFilePosting)
. B.pdFileMeta
. E.meta
. snd
fwdGlobalTransaction :: MakeSerialPdct
fwdGlobalTransaction
= serialPdct "fwdGlobalTransaction"
$ fmap (forward . B.unGlobalTransaction)
. B.tlGlobal
. fst
backGlobalTransaction :: MakeSerialPdct
backGlobalTransaction
= serialPdct "backGlobalTransaction"
$ fmap (backward . B.unGlobalTransaction)
. B.tlGlobal
. fst
fwdFileTransaction :: MakeSerialPdct
fwdFileTransaction
= serialPdct "fwdFileTransaction"
$ fmap (forward . B.unFileTransaction . B.tFileTransaction)
. B.tlFileMeta
. fst
backFileTransaction :: MakeSerialPdct
backFileTransaction
= serialPdct "backFileTransaction"
$ fmap (backward . B.unFileTransaction . B.tFileTransaction)
. B.tlFileMeta
. fst