ADD comment and tags to txgetter
This commit is contained in:
parent
5858e2f8ce
commit
c18750d600
|
@ -483,31 +483,24 @@ let TxSubGetter =
|
||||||
{-
|
{-
|
||||||
A means for transforming one row in a statement to a transaction
|
A means for transforming one row in a statement to a transaction
|
||||||
-}
|
-}
|
||||||
{ tsgFromAcnt :
|
{ Type =
|
||||||
{-
|
{ tsgFromAcnt : EntryAcntGetter
|
||||||
-}
|
, tsgToAcnt : EntryAcntGetter
|
||||||
EntryAcntGetter
|
, tsgValue : EntryNumGetter
|
||||||
, tsgToAcnt :
|
, tsgCurrency : EntryCurGetter
|
||||||
{-
|
, tsgFromEntries : List EntryGetter.Type
|
||||||
-}
|
, tsgFromComment : Text
|
||||||
EntryAcntGetter
|
, tsgToComment : Text
|
||||||
, tsgValue :
|
, tsgFromTags : List TagID
|
||||||
{-
|
, tsgToTags : List TagID
|
||||||
-}
|
, tsgToEntries : List EntryGetter.Type
|
||||||
EntryNumGetter
|
}
|
||||||
, tsgCurrency :
|
, default =
|
||||||
{-
|
{ tsgFromTags = [] : List TagID
|
||||||
-}
|
, tsgToTags = [] : List TagID
|
||||||
EntryCurGetter
|
, tsgFromComment = ""
|
||||||
, tsgFromEntries :
|
, tsgToComment = ""
|
||||||
{-
|
}
|
||||||
-}
|
|
||||||
List EntryGetter.Type
|
|
||||||
, tsgToEntries :
|
|
||||||
{-
|
|
||||||
A means of getting entries for this transaction (minimum 1)
|
|
||||||
-}
|
|
||||||
List EntryGetter.Type
|
|
||||||
}
|
}
|
||||||
|
|
||||||
let TxGetter =
|
let TxGetter =
|
||||||
|
@ -531,6 +524,7 @@ let TxGetter =
|
||||||
rules for this type regarding balancing and splitting value.
|
rules for this type regarding balancing and splitting value.
|
||||||
|
|
||||||
-}
|
-}
|
||||||
|
{ Type =
|
||||||
{ tgFromAcnt :
|
{ tgFromAcnt :
|
||||||
{-
|
{-
|
||||||
Account from which this transaction will be balanced. The value of
|
Account from which this transaction will be balanced. The value of
|
||||||
|
@ -545,6 +539,10 @@ let TxGetter =
|
||||||
entries are specified (see below).
|
entries are specified (see below).
|
||||||
-}
|
-}
|
||||||
EntryAcntGetter
|
EntryAcntGetter
|
||||||
|
, tgFromComment : Text
|
||||||
|
, tgToComment : Text
|
||||||
|
, tgFromTags : List TagID
|
||||||
|
, tgToTags : List TagID
|
||||||
, tgCurrency :
|
, tgCurrency :
|
||||||
{-
|
{-
|
||||||
Currency to assign to the account/value denoted by 'tgFromAcnt'
|
Currency to assign to the account/value denoted by 'tgFromAcnt'
|
||||||
|
@ -572,7 +570,15 @@ let TxGetter =
|
||||||
, tgOtherEntries :
|
, tgOtherEntries :
|
||||||
{-
|
{-
|
||||||
-}
|
-}
|
||||||
List TxSubGetter
|
List TxSubGetter.Type
|
||||||
|
}
|
||||||
|
, default =
|
||||||
|
{ tgOtherEntries = [] : List TxSubGetter.Type
|
||||||
|
, tgFromTags = [] : List TagID
|
||||||
|
, tgToTags = [] : List TagID
|
||||||
|
, tgFromComment = ""
|
||||||
|
, tgToComment = ""
|
||||||
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
let StatementParser_ =
|
let StatementParser_ =
|
||||||
|
@ -612,7 +618,7 @@ let StatementParser_ =
|
||||||
a transaction. If none, don't make a transaction (eg 'skip'
|
a transaction. If none, don't make a transaction (eg 'skip'
|
||||||
this row in the statement).
|
this row in the statement).
|
||||||
-}
|
-}
|
||||||
Optional TxGetter
|
Optional TxGetter.Type
|
||||||
, spTimes :
|
, spTimes :
|
||||||
{-
|
{-
|
||||||
Match at most this many rows; if none there is no limit
|
Match at most this many rows; if none there is no limit
|
||||||
|
@ -629,7 +635,7 @@ let StatementParser_ =
|
||||||
, spVal = ValMatcher::{=}
|
, spVal = ValMatcher::{=}
|
||||||
, spDesc = None Text
|
, spDesc = None Text
|
||||||
, spOther = [] : List (FieldMatcher_ re)
|
, spOther = [] : List (FieldMatcher_ re)
|
||||||
, spTx = None TxGetter
|
, spTx = None TxGetter.Type
|
||||||
, spTimes = None Natural
|
, spTimes = None Natural
|
||||||
, spPriority = +0
|
, spPriority = +0
|
||||||
}
|
}
|
||||||
|
|
|
@ -36,12 +36,14 @@ let cron1 =
|
||||||
|
|
||||||
let matchInf_ = nullMatch
|
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) -> nullMatch // { spTimes = Some n }
|
||||||
|
|
||||||
let matchN =
|
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
|
let match1_ = matchN_ 1
|
||||||
|
|
||||||
|
|
|
@ -505,6 +505,10 @@ data TxSubGetter = TxSubGetter
|
||||||
data TxGetter = TxGetter
|
data TxGetter = TxGetter
|
||||||
{ tgFromAcnt :: !EntryAcnt
|
{ tgFromAcnt :: !EntryAcnt
|
||||||
, tgToAcnt :: !EntryAcnt
|
, tgToAcnt :: !EntryAcnt
|
||||||
|
, tgFromComment :: !T.Text
|
||||||
|
, tgToComment :: !T.Text
|
||||||
|
, tgFromTags :: ![TagID]
|
||||||
|
, tgToTags :: ![TagID]
|
||||||
, tgCurrency :: !EntryCur
|
, tgCurrency :: !EntryCur
|
||||||
, tgFromEntries :: ![EntryGetter]
|
, tgFromEntries :: ![EntryGetter]
|
||||||
, tgToEntries :: ![EntryGetter]
|
, tgToEntries :: ![EntryGetter]
|
||||||
|
|
|
@ -309,34 +309,31 @@ matches
|
||||||
|
|
||||||
toTx :: TxGetter -> TxRecord -> InsertExceptT CurrencyM DeferredTx
|
toTx :: TxGetter -> TxRecord -> InsertExceptT CurrencyM DeferredTx
|
||||||
toTx
|
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
|
r@TxRecord {trAmount, trDate, trDesc} = do
|
||||||
combineError3 acntRes curRes subRes $ \(fa, ta) (cur, fe, te) ss -> do
|
combineError3 acntRes curRes subRes $ \(fa, ta) (cur, fe, te) ss ->
|
||||||
let fromEntry =
|
Tx
|
||||||
Entry
|
|
||||||
{ eAcnt = fa
|
|
||||||
, eValue = ()
|
|
||||||
, eComment = "" -- TODO actually fill this in
|
|
||||||
, eTags = [] -- TODO what goes here?
|
|
||||||
}
|
|
||||||
toEntry =
|
|
||||||
Entry
|
|
||||||
{ eAcnt = ta
|
|
||||||
, eValue = ()
|
|
||||||
, eComment = ""
|
|
||||||
, eTags = []
|
|
||||||
}
|
|
||||||
in Tx
|
|
||||||
{ dtxDate = trDate
|
{ dtxDate = trDate
|
||||||
, dtxDescr = trDesc
|
, dtxDescr = trDesc
|
||||||
, dtxEntries =
|
, dtxEntries =
|
||||||
EntrySet
|
EntrySet
|
||||||
{ desTotalValue = trAmount
|
{ desTotalValue = trAmount
|
||||||
, desCurrency = cur
|
, desCurrency = cur
|
||||||
, desFromEntry0 = fromEntry
|
, desFromEntry0 = entry0 fa tgFromComment tgFromTags
|
||||||
, desFromEntries = fe
|
, desFromEntries = fe
|
||||||
, desToEntries = te
|
, desToEntries = te
|
||||||
, desToEntryBal = toEntry
|
, desToEntryBal = entry0 ta tgToComment tgToTags
|
||||||
}
|
}
|
||||||
: ss
|
: ss
|
||||||
}
|
}
|
||||||
|
@ -353,6 +350,7 @@ toTx
|
||||||
let teRes = mapErrors (resolveEntry cur r) tgToEntries
|
let teRes = mapErrors (resolveEntry cur r) tgToEntries
|
||||||
combineError feRes teRes (cur,,)
|
combineError feRes teRes (cur,,)
|
||||||
subRes = mapErrors (resolveSubGetter r) tgOtherEntries
|
subRes = mapErrors (resolveSubGetter r) tgOtherEntries
|
||||||
|
entry0 a c ts = Entry {eAcnt = a, eValue = (), eComment = c, eTags = ts}
|
||||||
|
|
||||||
resolveSubGetter
|
resolveSubGetter
|
||||||
:: TxRecord
|
:: TxRecord
|
||||||
|
|
Loading…
Reference in New Issue