ndwarshuis
/
pwncash
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

142
dhall/Types.dhall
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,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
}

6
dhall/common.dhall
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

4
lib/Internal/Types/Dhall.hs
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]

56
lib/Internal/Utils.hs
View File

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