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 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
type LPdct = P.Pdct PostFam
type MakePdct = M.Matcher -> LPdct
match
:: HasText a
=> Text
-> (PostFam -> a)
-> 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
-> (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
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
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)
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
-> Text
-> (PostFam -> a)
-> M.Matcher
-> LPdct
matchDelimited sep lbl f m = match lbl f' m
where
f' = 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
transactionMemo :: MakePdct
transactionMemo = matchMemo "transaction memo" Q.transactionMemo
data Comp
= DLT
| DLTEQ
| DEQ
| DGTEQ
| DGT
| DNE
deriving Eq
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
-> 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
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
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
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 = maybe False ((== X.singleton 'R') . B.unFlag) . Q.flag
clonedTransactions :: T.Transaction -> T.Transaction -> Bool
clonedTransactions a b =
let (F.Family ta p1a p2a psa) = T.unTransaction a
(F.Family tb p1b p2b psb) = T.unTransaction b
in clonedTopLines ta tb
&& clonedPostings p1a p1b
&& clonedPostings p2a p2b
&& (length psa == length psb)
&& (and (zipWith clonedPostings psa psb))
clonedTopLines :: T.TopLine -> T.TopLine -> Bool
clonedTopLines t1 t2 =
(T.tDateTime t1 == T.tDateTime t2)
&& (T.tFlag t1 == T.tFlag t2)
&& (T.tNumber t1 == T.tNumber t2)
&& (T.tPayee t2 == T.tPayee t2)
&& (T.tMemo t1 == T.tMemo t2)
clonedPostings :: T.Posting -> T.Posting -> Bool
clonedPostings p1 p2 =
(T.pPayee p1 == T.pPayee p2)
&& (T.pNumber p1 == T.pNumber p2)
&& (T.pFlag p1 == T.pFlag p2)
&& (T.pAccount p1 == T.pAccount p2)
&& (T.pTags p1 == T.pTags p2)
&& (T.pEntry p1 == T.pEntry p2)
&& (T.pMemo p1 == T.pMemo p2)
&& (T.pInferred p1 == T.pInferred p2)