ENH add inverter to shadow acnt matcher

This commit is contained in:
Nathan Dwarshuis 2023-08-13 23:29:22 -04:00
parent 4fef3714a2
commit fa41ead348
3 changed files with 51 additions and 24 deletions

View File

@ -984,18 +984,23 @@ let Income =
} }
} }
let AcntMatcher_ =
{-
Regex pattern by which matching account ids will be identified
-}
\(re : Type) ->
{ Type = { amPat : re, amInvert : Bool }, default.amInvert = False }
let AcntMatcher = AcntMatcher_ Text
let TransferMatcher_ = let TransferMatcher_ =
{- {-
Means to match a transfer (which will be used to "clone" it in some Means to match a transfer (which will be used to "clone" it in some
fashion) fashion)
-} -}
\(re : Type) -> \(re : Type) ->
{ tmFrom : { tmFrom : Optional (AcntMatcher_ re).Type
{- , tmTo : Optional (AcntMatcher_ re).Type
Regex pattern by which matching account ids will be identified
-}
Optional re
, tmTo : Optional re
, tmDate : , tmDate :
{- {-
If given, means to match the date of a transfer. If given, means to match the date of a transfer.
@ -1011,8 +1016,8 @@ let TransferMatcher_ =
let TransferMatcher = let TransferMatcher =
{ Type = TransferMatcher_ Text { Type = TransferMatcher_ Text
, default = , default =
{ tmFrom = None Text { tmFrom = None AcntMatcher.Type
, tmTo = None Text , tmTo = None AcntMatcher.Type
, tmDate = None DateMatcher , tmDate = None DateMatcher
, tmVal = ValMatcher.default , tmVal = ValMatcher.default
} }
@ -1158,4 +1163,6 @@ in { CurID
, TransferAmount , TransferAmount
, MultiAlloAmount , MultiAlloAmount
, SingleAlloAmount , SingleAlloAmount
, AcntMatcher_
, AcntMatcher
} }

View File

@ -378,13 +378,17 @@ shadowMatches
getAcntFrom = getAcnt esFrom getAcntFrom = getAcnt esFrom
getAcntTo = getAcnt esTo getAcntTo = getAcnt esTo
getAcnt f = eAcnt . hesPrimary . f getAcnt f = eAcnt . hesPrimary . f
acntMatches (AcntID a) = maybe (return True) (matchMaybe a) acntMatches (AcntID a) = maybe (return True) (match' a)
match' a AcntMatcher_ {amPat, amInvert} =
(if amInvert then not else id) <$> matchMaybe a amPat
compileMatch :: TransferMatcher_ T.Text -> AppExcept TransferMatcherRe compileMatch :: TransferMatcher_ T.Text -> AppExcept TransferMatcherRe
compileMatch m@TransferMatcher_ {tmTo, tmFrom} = compileMatch m@TransferMatcher_ {tmTo, tmFrom} =
combineError tres fres $ \t f -> m {tmTo = t, tmFrom = f} combineError tres fres $ \t f -> m {tmTo = t, tmFrom = f}
where where
go = fmap snd . compileRegex False go a@AcntMatcher_ {amPat} = do
(_, p) <- compileRegex False amPat
return $ a {amPat = p}
tres = mapM go tmTo tres = mapM go tmTo
fres = mapM go tmFrom fres = mapM go tmFrom

View File

@ -57,7 +57,10 @@ makeHaskellTypesWith
"TxOpts" "TxOpts"
"TxOpts" "TxOpts"
"\\(re : Type) -> ((./dhall/Types.dhall).TxOpts_ re).Type" "\\(re : Type) -> ((./dhall/Types.dhall).TxOpts_ re).Type"
, SingleConstructor "TransferMatcher_" "TransferMatcher_" "(./dhall/Types.dhall).TransferMatcher_" , SingleConstructor
"AcntMatcher_"
"AcntMatcher_"
"\\(re : Type) -> ((./dhall/Types.dhall).AcntMatcher_ re).Type"
, SingleConstructor "Field" "Field" "(./dhall/Types.dhall).Field" , SingleConstructor "Field" "Field" "(./dhall/Types.dhall).Field"
, SingleConstructor "Entry" "Entry" "(./dhall/Types.dhall).Entry" , SingleConstructor "Entry" "Entry" "(./dhall/Types.dhall).Entry"
, SingleConstructor "PretaxValue" "PretaxValue" "(./dhall/Types.dhall).PretaxValue" , SingleConstructor "PretaxValue" "PretaxValue" "(./dhall/Types.dhall).PretaxValue"
@ -185,27 +188,34 @@ newtype BudgetName = BudgetName {unBudgetName :: T.Text}
deriving newtype (Show, Eq, Ord, Hashable, FromDhall, PersistField, PersistFieldSql) deriving newtype (Show, Eq, Ord, Hashable, FromDhall, PersistField, PersistFieldSql)
data Budget = Budget data Budget = Budget
{ bgtLabel :: BudgetName { bgtLabel :: !BudgetName
, bgtIncomes :: [Income] , bgtIncomes :: ![Income]
, bgtPretax :: [MultiAllocation PretaxValue] , bgtPretax :: ![MultiAllocation PretaxValue]
, bgtTax :: [MultiAllocation TaxValue] , bgtTax :: ![MultiAllocation TaxValue]
, bgtPosttax :: [MultiAllocation PosttaxValue] , bgtPosttax :: ![MultiAllocation PosttaxValue]
, bgtTransfers :: [PairedTransfer] , bgtTransfers :: ![PairedTransfer]
, bgtShadowTransfers :: [ShadowTransfer] , bgtShadowTransfers :: ![ShadowTransfer]
, bgtInterval :: !(Maybe Interval) , bgtInterval :: !(Maybe Interval)
} }
deriving (Generic, Hashable, FromDhall) deriving (Generic, Hashable, FromDhall)
data ShadowTransfer = ShadowTransfer data ShadowTransfer = ShadowTransfer
{ stFrom :: TaggedAcnt { stFrom :: !TaggedAcnt
, stTo :: TaggedAcnt , stTo :: !TaggedAcnt
, stCurrency :: CurID , stCurrency :: !CurID
, stDesc :: Text , stDesc :: !Text
, stMatch :: TransferMatcher_ Text , stMatch :: !(TransferMatcher_ Text)
, stRatio :: Double , stRatio :: !Double
} }
deriving (Generic, Hashable, FromDhall) deriving (Generic, Hashable, FromDhall)
data TransferMatcher_ re = TransferMatcher_
{ tmFrom :: !(Maybe (AcntMatcher_ re))
, tmTo :: !(Maybe (AcntMatcher_ re))
, tmDate :: !(Maybe DateMatcher)
, tmVal :: !ValMatcher
}
deriving instance Hashable PretaxValue deriving instance Hashable PretaxValue
deriving instance Hashable TaxBracket deriving instance Hashable TaxBracket
@ -323,6 +333,12 @@ deriving instance Hashable (TransferMatcher_ Text)
deriving instance FromDhall (TransferMatcher_ Text) deriving instance FromDhall (TransferMatcher_ Text)
deriving instance Generic (AcntMatcher_ Text)
deriving instance Hashable (AcntMatcher_ Text)
deriving instance FromDhall (AcntMatcher_ Text)
deriving instance Hashable ValMatcher deriving instance Hashable ValMatcher
deriving instance Hashable YMDMatcher deriving instance Hashable YMDMatcher