diff --git a/dhall/Types.dhall b/dhall/Types.dhall index fe90f1c..4218cad 100644 --- a/dhall/Types.dhall +++ b/dhall/Types.dhall @@ -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 } diff --git a/lib/Internal/Budget.hs b/lib/Internal/Budget.hs index bce154b..23a3f1c 100644 --- a/lib/Internal/Budget.hs +++ b/lib/Internal/Budget.hs @@ -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 diff --git a/lib/Internal/Types/Dhall.hs b/lib/Internal/Types/Dhall.hs index ef26bde..094f34e 100644 --- a/lib/Internal/Types/Dhall.hs +++ b/lib/Internal/Types/Dhall.hs @@ -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