ADD comment and tags to txgetter

This commit is contained in:
Nathan Dwarshuis 2023-06-17 00:16:01 -04:00
parent 5858e2f8ce
commit c18750d600
4 changed files with 109 additions and 99 deletions

View File

@ -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,6 +524,7 @@ let TxGetter =
rules for this type regarding balancing and splitting value.
-}
{ Type =
{ tgFromAcnt :
{-
Account from which this transaction will be balanced. The value of
@ -545,6 +539,10 @@ let TxGetter =
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'
@ -572,7 +570,15 @@ let TxGetter =
, tgOtherEntries :
{-
-}
List TxSubGetter
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
}

View File

@ -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

View File

@ -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]

View File

@ -309,34 +309,31 @@ 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?
}
toEntry =
Entry
{ eAcnt = ta
, eValue = ()
, eComment = ""
, eTags = []
}
in Tx
combineError3 acntRes curRes subRes $ \(fa, ta) (cur, fe, te) ss ->
Tx
{ dtxDate = trDate
, dtxDescr = trDesc
, dtxEntries =
EntrySet
{ desTotalValue = trAmount
, desCurrency = cur
, desFromEntry0 = fromEntry
, desFromEntry0 = entry0 fa tgFromComment tgFromTags
, desFromEntries = fe
, desToEntries = te
, desToEntryBal = toEntry
, desToEntryBal = entry0 ta tgToComment tgToTags
}
: ss
}
@ -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