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

View File

@ -378,13 +378,17 @@ shadowMatches
getAcntFrom = getAcnt esFrom
getAcntTo = getAcnt esTo
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 m@TransferMatcher_ {tmTo, tmFrom} =
combineError tres fres $ \t f -> m {tmTo = t, tmFrom = f}
where
go = fmap snd . compileRegex False
go a@AcntMatcher_ {amPat} = do
(_, p) <- compileRegex False amPat
return $ a {amPat = p}
tres = mapM go tmTo
fres = mapM go tmFrom

View File

@ -57,7 +57,10 @@ makeHaskellTypesWith
"TxOpts"
"TxOpts"
"\\(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 "Entry" "Entry" "(./dhall/Types.dhall).Entry"
, 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)
data Budget = Budget
{ bgtLabel :: BudgetName
, bgtIncomes :: [Income]
, bgtPretax :: [MultiAllocation PretaxValue]
, bgtTax :: [MultiAllocation TaxValue]
, bgtPosttax :: [MultiAllocation PosttaxValue]
, bgtTransfers :: [PairedTransfer]
, bgtShadowTransfers :: [ShadowTransfer]
{ bgtLabel :: !BudgetName
, bgtIncomes :: ![Income]
, bgtPretax :: ![MultiAllocation PretaxValue]
, bgtTax :: ![MultiAllocation TaxValue]
, bgtPosttax :: ![MultiAllocation PosttaxValue]
, bgtTransfers :: ![PairedTransfer]
, bgtShadowTransfers :: ![ShadowTransfer]
, bgtInterval :: !(Maybe Interval)
}
deriving (Generic, Hashable, FromDhall)
data ShadowTransfer = ShadowTransfer
{ stFrom :: TaggedAcnt
, stTo :: TaggedAcnt
, stCurrency :: CurID
, stDesc :: Text
, stMatch :: TransferMatcher_ Text
, stRatio :: Double
{ stFrom :: !TaggedAcnt
, stTo :: !TaggedAcnt
, stCurrency :: !CurID
, stDesc :: !Text
, stMatch :: !(TransferMatcher_ Text)
, stRatio :: !Double
}
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 TaxBracket
@ -323,6 +333,12 @@ deriving instance Hashable (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 YMDMatcher