From c18750d600bf939e051b882f610b0a5030a8caae Mon Sep 17 00:00:00 2001 From: ndwarshuis Date: Sat, 17 Jun 2023 00:16:01 -0400 Subject: [PATCH] ADD comment and tags to txgetter --- dhall/Types.dhall | 142 +++++++++++++++++++----------------- dhall/common.dhall | 6 +- lib/Internal/Types/Dhall.hs | 4 + lib/Internal/Utils.hs | 56 +++++++------- 4 files changed, 109 insertions(+), 99 deletions(-) diff --git a/dhall/Types.dhall b/dhall/Types.dhall index 8294282..c9c31c8 100644 --- a/dhall/Types.dhall +++ b/dhall/Types.dhall @@ -483,31 +483,24 @@ let TxSubGetter = {- A means for transforming one row in a statement to a transaction -} - { tsgFromAcnt : - {- - -} - EntryAcntGetter - , tsgToAcnt : - {- - -} - EntryAcntGetter - , tsgValue : - {- - -} - EntryNumGetter - , tsgCurrency : - {- - -} - EntryCurGetter - , tsgFromEntries : - {- - -} - List EntryGetter.Type - , tsgToEntries : - {- - A means of getting entries for this transaction (minimum 1) - -} - List EntryGetter.Type + { Type = + { tsgFromAcnt : EntryAcntGetter + , tsgToAcnt : EntryAcntGetter + , tsgValue : EntryNumGetter + , tsgCurrency : EntryCurGetter + , tsgFromEntries : List EntryGetter.Type + , tsgFromComment : Text + , tsgToComment : Text + , tsgFromTags : List TagID + , tsgToTags : List TagID + , tsgToEntries : List EntryGetter.Type + } + , default = + { tsgFromTags = [] : List TagID + , tsgToTags = [] : List TagID + , tsgFromComment = "" + , tsgToComment = "" + } } let TxGetter = @@ -531,48 +524,61 @@ let TxGetter = rules for this type regarding balancing and splitting value. -} - { tgFromAcnt : - {- - Account from which this transaction will be balanced. The value of - the transaction will be assigned to this account unless other from - entries are specified (see below). - -} - EntryAcntGetter - , tgToAcnt : - {- - Account from which this transaction will be balanced. The value of - the transaction will be assigned to this account unless other from - entries are specified (see below). - -} - EntryAcntGetter - , tgCurrency : - {- - Currency to assign to the account/value denoted by 'tgFromAcnt' - above. - -} - EntryCurGetter - , tgFromEntries : - {- - Means of getting additional entries from which this transaction will - be balanced (minimum 0). If this list is empty, the total value of the - transaction will be assigned to the value defined by 'tgFromAcnt'. - Otherwise, the entries specified here will be added to the credit side - of this transaction, and their sum value will be subtracted from the - total value of the transaction and assigned to 'tgFromAcnt'. + { Type = + { tgFromAcnt : + {- + Account from which this transaction will be balanced. The value of + the transaction will be assigned to this account unless other from + entries are specified (see below). + -} + EntryAcntGetter + , tgToAcnt : + {- + Account from which this transaction will be balanced. The value of + the transaction will be assigned to this account unless other from + entries are specified (see below). + -} + EntryAcntGetter + , tgFromComment : Text + , tgToComment : Text + , tgFromTags : List TagID + , tgToTags : List TagID + , tgCurrency : + {- + Currency to assign to the account/value denoted by 'tgFromAcnt' + above. + -} + EntryCurGetter + , tgFromEntries : + {- + Means of getting additional entries from which this transaction will + be balanced (minimum 0). If this list is empty, the total value of the + transaction will be assigned to the value defined by 'tgFromAcnt'. + Otherwise, the entries specified here will be added to the credit side + of this transaction, and their sum value will be subtracted from the + total value of the transaction and assigned to 'tgFromAcnt'. - This is useful for situations where a particular transaction denotes - values that come from multiple subaccounts. - -} - List EntryGetter.Type - , tgToEntries : - {- - A means of getting entries for this transaction - -} - List EntryGetter.Type - , tgOtherEntries : - {- - -} - List TxSubGetter + This is useful for situations where a particular transaction denotes + values that come from multiple subaccounts. + -} + List EntryGetter.Type + , tgToEntries : + {- + A means of getting entries for this transaction + -} + List EntryGetter.Type + , tgOtherEntries : + {- + -} + List TxSubGetter.Type + } + , default = + { tgOtherEntries = [] : List TxSubGetter.Type + , tgFromTags = [] : List TagID + , tgToTags = [] : List TagID + , tgFromComment = "" + , tgToComment = "" + } } let StatementParser_ = @@ -612,7 +618,7 @@ let StatementParser_ = a transaction. If none, don't make a transaction (eg 'skip' this row in the statement). -} - Optional TxGetter + Optional TxGetter.Type , spTimes : {- Match at most this many rows; if none there is no limit @@ -629,7 +635,7 @@ let StatementParser_ = , spVal = ValMatcher::{=} , spDesc = None Text , spOther = [] : List (FieldMatcher_ re) - , spTx = None TxGetter + , spTx = None TxGetter.Type , spTimes = None Natural , spPriority = +0 } diff --git a/dhall/common.dhall b/dhall/common.dhall index dd888bf..0f2a6e2 100644 --- a/dhall/common.dhall +++ b/dhall/common.dhall @@ -36,12 +36,14 @@ let cron1 = let matchInf_ = nullMatch -let matchInf = \(x : T.TxGetter) -> nullMatch // { spTx = Some x } +let matchInf = \(x : T.TxGetter.Type) -> nullMatch // { spTx = Some x } let matchN_ = \(n : Natural) -> nullMatch // { spTimes = Some n } let matchN = - \(n : Natural) -> \(x : T.TxGetter) -> matchInf x // { spTimes = Some n } + \(n : Natural) -> + \(x : T.TxGetter.Type) -> + matchInf x // { spTimes = Some n } let match1_ = matchN_ 1 diff --git a/lib/Internal/Types/Dhall.hs b/lib/Internal/Types/Dhall.hs index 49b6fe1..9988d6d 100644 --- a/lib/Internal/Types/Dhall.hs +++ b/lib/Internal/Types/Dhall.hs @@ -505,6 +505,10 @@ data TxSubGetter = TxSubGetter data TxGetter = TxGetter { tgFromAcnt :: !EntryAcnt , tgToAcnt :: !EntryAcnt + , tgFromComment :: !T.Text + , tgToComment :: !T.Text + , tgFromTags :: ![TagID] + , tgToTags :: ![TagID] , tgCurrency :: !EntryCur , tgFromEntries :: ![EntryGetter] , tgToEntries :: ![EntryGetter] diff --git a/lib/Internal/Utils.hs b/lib/Internal/Utils.hs index bb8090c..3bebb16 100644 --- a/lib/Internal/Utils.hs +++ b/lib/Internal/Utils.hs @@ -309,37 +309,34 @@ matches toTx :: TxGetter -> TxRecord -> InsertExceptT CurrencyM DeferredTx toTx - TxGetter {tgFromAcnt, tgToAcnt, tgCurrency, tgFromEntries, tgToEntries, tgOtherEntries} + TxGetter + { tgFromAcnt + , tgToAcnt + , tgFromComment + , tgToComment + , tgFromTags + , tgToTags + , tgCurrency + , tgFromEntries + , tgToEntries + , tgOtherEntries + } r@TxRecord {trAmount, trDate, trDesc} = do - combineError3 acntRes curRes subRes $ \(fa, ta) (cur, fe, te) ss -> do - let fromEntry = - Entry - { eAcnt = fa - , eValue = () - , eComment = "" -- TODO actually fill this in - , eTags = [] -- TODO what goes here? + combineError3 acntRes curRes subRes $ \(fa, ta) (cur, fe, te) ss -> + Tx + { dtxDate = trDate + , dtxDescr = trDesc + , dtxEntries = + EntrySet + { desTotalValue = trAmount + , desCurrency = cur + , desFromEntry0 = entry0 fa tgFromComment tgFromTags + , desFromEntries = fe + , desToEntries = te + , desToEntryBal = entry0 ta tgToComment tgToTags } - toEntry = - Entry - { eAcnt = ta - , eValue = () - , eComment = "" - , eTags = [] - } - in Tx - { dtxDate = trDate - , dtxDescr = trDesc - , dtxEntries = - EntrySet - { desTotalValue = trAmount - , desCurrency = cur - , desFromEntry0 = fromEntry - , desFromEntries = fe - , desToEntries = te - , desToEntryBal = toEntry - } - : ss - } + : ss + } where resolveAcnt_ = liftInner . resolveAcnt r acntRes = @@ -353,6 +350,7 @@ toTx let teRes = mapErrors (resolveEntry cur r) tgToEntries combineError feRes teRes (cur,,) subRes = mapErrors (resolveSubGetter r) tgOtherEntries + entry0 a c ts = Entry {eAcnt = a, eValue = (), eComment = c, eTags = ts} resolveSubGetter :: TxRecord