REF remove "split" lingo

This commit is contained in:
Nathan Dwarshuis 2023-05-29 16:11:19 -04:00
parent 627704704e
commit ff0393dc02
8 changed files with 86 additions and 92 deletions

View File

@ -12,6 +12,17 @@ import qualified RIO.NonEmpty as NE
import qualified RIO.Text as T import qualified RIO.Text as T
import RIO.Time import RIO.Time
-- each budget (designated at the top level by a 'name') is processed in the
-- following steps
-- 1. expand all transactions given the desired date range and date patterns for
-- each directive in the budget
-- 2. sort all transactions by date
-- 3. propagate all balances forward, and while doing so assign values to each
-- transaction (some of which depend on the 'current' balance of the
-- target account)
-- 4. assign shadow transactions (TODO)
-- 5. insert all transactions
insertBudget insertBudget
:: (MonadInsertError m, MonadSqlQuery m, MonadFinance m) :: (MonadInsertError m, MonadSqlQuery m, MonadFinance m)
=> Budget => Budget
@ -73,8 +84,8 @@ insertBudgetTx FlatTransfer {ftFrom, ftTo, ftMeta, ftCur, ftValue, ftDesc, ftWhe
k <- insert $ TransactionR (bmCommit ftMeta) ftWhen ftDesc k <- insert $ TransactionR (bmCommit ftMeta) ftWhen ftDesc
insertBudgetLabel k from insertBudgetLabel k from
insertBudgetLabel k to insertBudgetLabel k to
insertBudgetLabel k split = do insertBudgetLabel k entry = do
sk <- insertSplit k split sk <- insertEntry k entry
insert_ $ BudgetLabelR sk $ bmName ftMeta insert_ $ BudgetLabelR sk $ bmName ftMeta
entryPair entryPair
@ -83,7 +94,7 @@ entryPair
-> TaggedAcnt -> TaggedAcnt
-> BudgetCurrency -> BudgetCurrency
-> Rational -> Rational
-> m (SplitPair, Maybe SplitPair) -> m (EntryPair, Maybe EntryPair)
entryPair from to cur val = case cur of entryPair from to cur val = case cur of
NoX curid -> (,Nothing) <$> pair curid from to val NoX curid -> (,Nothing) <$> pair curid from to val
X Exchange {xFromCur, xToCur, xAcnt, xRate} -> do X Exchange {xFromCur, xToCur, xAcnt, xRate} -> do
@ -93,11 +104,11 @@ entryPair from to cur val = case cur of
combineError res1 res2 $ \a b -> (a, Just b) combineError res1 res2 $ \a b -> (a, Just b)
where where
pair curid from_ to_ v = do pair curid from_ to_ v = do
let s1 = split curid from_ (-v) let s1 = entry curid from_ (-v)
let s2 = split curid to_ v let s2 = entry curid to_ v
combineError s1 s2 (,) combineError s1 s2 (,)
split c TaggedAcnt {taAcnt, taTags} v = entry c TaggedAcnt {taAcnt, taTags} v =
resolveSplit $ resolveEntry $
Entry Entry
{ eAcnt = taAcnt { eAcnt = taAcnt
, eValue = v , eValue = v
@ -368,7 +379,7 @@ allocatePost precision aftertax = fmap (fmap go)
else roundPrecision precision v else roundPrecision precision v
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
-- Transfer -- Standalone Transfer
expandTransfers expandTransfers
:: (MonadInsertError m, MonadSqlQuery m, MonadFinance m) :: (MonadInsertError m, MonadSqlQuery m, MonadFinance m)
@ -520,7 +531,7 @@ type IntAllocations =
type DaySpanAllocation = Allocation DaySpan type DaySpanAllocation = Allocation DaySpan
type SplitPair = (KeySplit, KeySplit) type EntryPair = (KeyEntry, KeyEntry)
type PeriodScaler = Natural -> Double -> Double type PeriodScaler = Natural -> Double -> Double

View File

@ -10,8 +10,8 @@ module Internal.Database.Ops
, mkPool , mkPool
, whenHash , whenHash
, whenHash_ , whenHash_
, insertSplit , insertEntry
, resolveSplit , resolveEntry
) )
where where
@ -401,14 +401,14 @@ whenHash_ t o f = do
hs <- askDBState kmNewCommits hs <- askDBState kmNewCommits
if h `elem` hs then Just . (c,) <$> f else return Nothing if h `elem` hs then Just . (c,) <$> f else return Nothing
insertSplit :: MonadSqlQuery m => TransactionRId -> KeySplit -> m SplitRId insertEntry :: MonadSqlQuery m => TransactionRId -> KeyEntry -> m EntryRId
insertSplit t Entry {eAcnt, eCurrency, eValue, eComment, eTags} = do insertEntry t Entry {eAcnt, eCurrency, eValue, eComment, eTags} = do
k <- insert $ SplitR t eCurrency eAcnt eComment eValue k <- insert $ EntryR t eCurrency eAcnt eComment eValue
mapM_ (insert_ . TagRelationR k) eTags mapM_ (insert_ . TagRelationR k) eTags
return k return k
resolveSplit :: (MonadInsertError m, MonadFinance m) => BalSplit -> m KeySplit resolveEntry :: (MonadInsertError m, MonadFinance m) => BalEntry -> m KeyEntry
resolveSplit s@Entry {eAcnt, eCurrency, eValue, eTags} = do resolveEntry s@Entry {eAcnt, eCurrency, eValue, eTags} = do
let aRes = lookupAccountKey eAcnt let aRes = lookupAccountKey eAcnt
let cRes = lookupCurrencyKey eCurrency let cRes = lookupCurrencyKey eCurrency
let sRes = lookupAccountSign eAcnt let sRes = lookupAccountSign eAcnt

View File

@ -16,23 +16,6 @@ import RIO hiding (to)
import qualified RIO.Text as T import qualified RIO.Text as T
import RIO.Time import RIO.Time
--------------------------------------------------------------------------------
-- budget
-- each budget (designated at the top level by a 'name') is processed in the
-- following steps
-- 1. expand all transactions given the desired date range and date patterns for
-- each directive in the budget
-- 2. sort all transactions by date
-- 3. propagate all balances forward, and while doing so assign values to each
-- transaction (some of which depend on the 'current' balance of the
-- target account)
-- 4. assign shadow transactions (TODO)
-- 5. insert all transactions
--------------------------------------------------------------------------------
-- statements
splitHistory :: [History] -> ([HistTransfer], [Statement]) splitHistory :: [History] -> ([HistTransfer], [Statement])
splitHistory = partitionEithers . fmap go splitHistory = partitionEithers . fmap go
where where
@ -118,16 +101,16 @@ txPair day from to cur val desc = resolveTx tx
Tx Tx
{ txDescr = desc { txDescr = desc
, txDate = day , txDate = day
, txSplits = [split from (-val), split to val] , txEntries = [split from (-val), split to val]
} }
resolveTx :: (MonadInsertError m, MonadFinance m) => BalTx -> m KeyTx resolveTx :: (MonadInsertError m, MonadFinance m) => BalTx -> m KeyTx
resolveTx t@Tx {txSplits = ss} = resolveTx t@Tx {txEntries = ss} =
fmap (\kss -> t {txSplits = kss}) $ fmap (\kss -> t {txEntries = kss}) $
combineErrors $ combineErrors $
fmap resolveSplit ss fmap resolveEntry ss
insertTx :: MonadSqlQuery m => CommitRId -> KeyTx -> m () insertTx :: MonadSqlQuery m => CommitRId -> KeyTx -> m ()
insertTx c Tx {txDate = d, txDescr = e, txSplits = ss} = do insertTx c Tx {txDate = d, txDescr = e, txEntries = ss} = do
k <- insert $ TransactionR c d e k <- insert $ TransactionR c d e
mapM_ (insertSplit k) ss mapM_ (insertEntry k) ss

View File

@ -217,12 +217,12 @@ matchNonDates ms = go ([], [], initZipper ms)
in go (m, u, resetZipper z') rs in go (m, u, resetZipper z') rs
balanceTx :: RawTx -> InsertExcept BalTx balanceTx :: RawTx -> InsertExcept BalTx
balanceTx t@Tx {txSplits = ss} = do balanceTx t@Tx {txEntries = ss} = do
bs <- balanceSplits ss bs <- balanceEntries ss
return $ t {txSplits = bs} return $ t {txEntries = bs}
balanceSplits :: [RawSplit] -> InsertExcept [BalSplit] balanceEntries :: [RawEntry] -> InsertExcept [BalEntry]
balanceSplits ss = balanceEntries ss =
fmap concat fmap concat
<$> mapM (uncurry bal) <$> mapM (uncurry bal)
$ groupByKey $ groupByKey
@ -231,7 +231,7 @@ balanceSplits ss =
haeValue s@Entry {eValue = Just v} = Right s {eValue = v} haeValue s@Entry {eValue = Just v} = Right s {eValue = v}
haeValue s = Left s haeValue s = Left s
bal cur rss bal cur rss
| length rss < 2 = throwError $ InsertException [BalanceError TooFewSplits cur rss] | length rss < 2 = throwError $ InsertException [BalanceError TooFewEntries cur rss]
| otherwise = case partitionEithers $ fmap haeValue rss of | otherwise = case partitionEithers $ fmap haeValue rss of
([noVal], val) -> return $ noVal {eValue = foldr (\s x -> x - eValue s) 0 val} : val ([noVal], val) -> return $ noVal {eValue = foldr (\s x -> x - eValue s) 0 val} : val
([], val) -> return val ([], val) -> return val

View File

@ -44,7 +44,7 @@ TransactionR sql=transactions
date Day date Day
description T.Text description T.Text
deriving Show Eq deriving Show Eq
SplitR sql=splits EntryR sql=entries
transaction TransactionRId OnDeleteCascade transaction TransactionRId OnDeleteCascade
currency CurrencyRId OnDeleteCascade currency CurrencyRId OnDeleteCascade
account AccountRId OnDeleteCascade account AccountRId OnDeleteCascade
@ -52,10 +52,10 @@ SplitR sql=splits
value Rational value Rational
deriving Show Eq deriving Show Eq
TagRelationR sql=tag_relations TagRelationR sql=tag_relations
split SplitRId OnDeleteCascade entry EntryRId OnDeleteCascade
tag TagRId OnDeleteCascade tag TagRId OnDeleteCascade
BudgetLabelR sql=budget_labels BudgetLabelR sql=budget_labels
split SplitRId OnDeleteCascade entry EntryRId OnDeleteCascade
budgetName T.Text budgetName T.Text
deriving Show Eq deriving Show Eq
|] |]

View File

@ -421,7 +421,7 @@ data History
| HistStatement !Statement | HistStatement !Statement
deriving (Eq, Generic, Hashable, FromDhall) deriving (Eq, Generic, Hashable, FromDhall)
type EntryGetter = Entry SplitAcnt (Maybe EntryNumGetter) SplitCur TagID type EntryGetter = Entry EntryAcnt (Maybe EntryNumGetter) EntryCur TagID
instance FromDhall EntryGetter instance FromDhall EntryGetter
@ -436,7 +436,7 @@ deriving instance (Eq a, Eq v, Eq c, Eq t) => Eq (Entry a v c t)
data Tx s = Tx data Tx s = Tx
{ txDescr :: !T.Text { txDescr :: !T.Text
, txDate :: !Day , txDate :: !Day
, txSplits :: ![s] , txEntries :: ![s]
} }
deriving (Generic) deriving (Generic)
@ -463,7 +463,7 @@ data Statement = Statement
} }
deriving (Eq, Hashable, Generic, FromDhall) deriving (Eq, Hashable, Generic, FromDhall)
-- | the value of a field in split (text version) -- | the value of a field in entry (text version)
-- can either be a raw (constant) value, a lookup from the record, or a map -- can either be a raw (constant) value, a lookup from the record, or a map
-- between the lookup and some other value -- between the lookup and some other value
data EntryTextGetter t data EntryTextGetter t
@ -473,9 +473,9 @@ data EntryTextGetter t
| Map2T !(FieldMap (T.Text, T.Text) t) | Map2T !(FieldMap (T.Text, T.Text) t)
deriving (Eq, Generic, Hashable, Show, FromDhall) deriving (Eq, Generic, Hashable, Show, FromDhall)
type SplitCur = EntryTextGetter CurID type EntryCur = EntryTextGetter CurID
type SplitAcnt = EntryTextGetter AcntID type EntryAcnt = EntryTextGetter AcntID
deriving instance (Show k, Show v) => Show (Field k v) deriving instance (Show k, Show v) => Show (Field k v)
@ -504,8 +504,8 @@ data FieldMatcher re
deriving instance Show (FieldMatcher T.Text) deriving instance Show (FieldMatcher T.Text)
data TxGetter = TxGetter data TxGetter = TxGetter
{ tgCurrency :: !SplitCur { tgCurrency :: !EntryCur
, tgAcnt :: !SplitAcnt , tgAcnt :: !EntryAcnt
, tgEntries :: ![EntryGetter] , tgEntries :: ![EntryGetter]
} }
deriving (Eq, Generic, Hashable, Show, FromDhall) deriving (Eq, Generic, Hashable, Show, FromDhall)

View File

@ -57,9 +57,9 @@ data DBState = DBState
type CurrencyM = Reader CurrencyMap type CurrencyM = Reader CurrencyMap
type KeySplit = Entry AccountRId Rational CurrencyRId TagRId type KeyEntry = Entry AccountRId Rational CurrencyRId TagRId
type KeyTx = Tx KeySplit type KeyTx = Tx KeyEntry
type TreeR = Tree ([T.Text], AccountRId) type TreeR = Tree ([T.Text], AccountRId)
@ -125,30 +125,30 @@ accountSign IncomeT = Credit
accountSign LiabilityT = Credit accountSign LiabilityT = Credit
accountSign EquityT = Credit accountSign EquityT = Credit
type RawSplit = Entry AcntID (Maybe Rational) CurID TagID type RawEntry = Entry AcntID (Maybe Rational) CurID TagID
type BalSplit = Entry AcntID Rational CurID TagID type BalEntry = Entry AcntID Rational CurID TagID
type RawTx = Tx RawSplit type RawTx = Tx RawEntry
type BalTx = Tx BalSplit type BalTx = Tx BalEntry
data MatchRes a = MatchPass !a | MatchFail | MatchSkip data MatchRes a = MatchPass !a | MatchFail | MatchSkip
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
-- exception types -- exception types
data BalanceType = TooFewSplits | NotOneBlank deriving (Show) data BalanceType = TooFewEntries | NotOneBlank deriving (Show)
data MatchType = MatchNumeric | MatchText deriving (Show) data MatchType = MatchNumeric | MatchText deriving (Show)
data SplitIDType = AcntField | CurField | TagField deriving (Show) data EntryIDType = AcntField | CurField | TagField deriving (Show)
data LookupSuberr data LookupSuberr
= SplitIDField !SplitIDType = EntryIDField !EntryIDType
| SplitValField | EntryValField
| MatchField !MatchType | MatchField !MatchType
| DBKey !SplitIDType | DBKey !EntryIDType
deriving (Show) deriving (Show)
data AllocationSuberr data AllocationSuberr
@ -168,7 +168,7 @@ data InsertError
| ParseError !T.Text | ParseError !T.Text
| ConversionError !T.Text | ConversionError !T.Text
| LookupError !LookupSuberr !T.Text | LookupError !LookupSuberr !T.Text
| BalanceError !BalanceType !CurID ![RawSplit] | BalanceError !BalanceType !CurID ![RawEntry]
| IncomeError !Day !T.Text !Rational | IncomeError !Day !T.Text !Rational
| PatternError !Natural !Natural !(Maybe Natural) !PatternSuberr | PatternError !Natural !Natural !(Maybe Natural) !PatternSuberr
| DaySpanError !Gregorian !(Maybe Gregorian) | DaySpanError !Gregorian !(Maybe Gregorian)

View File

@ -306,10 +306,10 @@ matches
desc = maybe (return True) (matchMaybe trDesc . snd) spDesc desc = maybe (return True) (matchMaybe trDesc . snd) spDesc
convert (TxGetter cur a ss) = MatchPass <$> toTx cur a ss r convert (TxGetter cur a ss) = MatchPass <$> toTx cur a ss r
toTx :: SplitCur -> SplitAcnt -> [EntryGetter] -> TxRecord -> InsertExceptT CurrencyM RawTx toTx :: EntryCur -> EntryAcnt -> [EntryGetter] -> TxRecord -> InsertExceptT CurrencyM RawTx
toTx sc sa toSplits r@TxRecord {trAmount, trDate, trDesc} = do toTx sc sa toEntries r@TxRecord {trAmount, trDate, trDesc} = do
combineError3 acntRes curRes ssRes $ \a c ss -> combineError3 acntRes curRes ssRes $ \a c es ->
let fromSplit = let fromEntry =
Entry Entry
{ eAcnt = a { eAcnt = a
, eCurrency = c , eCurrency = c
@ -320,12 +320,12 @@ toTx sc sa toSplits r@TxRecord {trAmount, trDate, trDesc} = do
in Tx in Tx
{ txDate = trDate { txDate = trDate
, txDescr = trDesc , txDescr = trDesc
, txSplits = fromSplit : ss , txEntries = fromEntry : es
} }
where where
acntRes = liftInner $ resolveAcnt r sa acntRes = liftInner $ resolveAcnt r sa
curRes = liftInner $ resolveCurrency r sc curRes = liftInner $ resolveCurrency r sc
ssRes = combineErrors $ fmap (resolveEntry r) toSplits ssRes = combineErrors $ fmap (resolveEntry r) toEntries
valMatches :: ValMatcher -> Rational -> InsertExcept Bool valMatches :: ValMatcher -> Rational -> InsertExcept Bool
valMatches ValMatcher {vmDen, vmSign, vmNum, vmPrec} x valMatches ValMatcher {vmDen, vmSign, vmNum, vmPrec} x
@ -351,7 +351,7 @@ otherMatches dict m = case m of
where where
lookup_ t n = lookupErr (MatchField t) n dict lookup_ t n = lookupErr (MatchField t) n dict
resolveEntry :: TxRecord -> EntryGetter -> InsertExceptT CurrencyM RawSplit resolveEntry :: TxRecord -> EntryGetter -> InsertExceptT CurrencyM RawEntry
resolveEntry r s@Entry {eAcnt, eValue, eCurrency} = do resolveEntry r s@Entry {eAcnt, eValue, eCurrency} = do
m <- ask m <- ask
liftInner $ combineErrorM3 acntRes curRes valRes $ \a c v -> do liftInner $ combineErrorM3 acntRes curRes valRes $ \a c v -> do
@ -447,18 +447,18 @@ collectErrorsIO = mapErrorsIO id
resolveValue :: TxRecord -> EntryNumGetter -> InsertExcept Double resolveValue :: TxRecord -> EntryNumGetter -> InsertExcept Double
resolveValue TxRecord {trOther, trAmount} s = case s of resolveValue TxRecord {trOther, trAmount} s = case s of
(LookupN t) -> readDouble =<< lookupErr SplitValField t trOther (LookupN t) -> readDouble =<< lookupErr EntryValField t trOther
(ConstN c) -> return c (ConstN c) -> return c
AmountN m -> return $ (* m) $ fromRational trAmount AmountN m -> return $ (* m) $ fromRational trAmount
resolveAcnt :: TxRecord -> SplitAcnt -> InsertExcept T.Text resolveAcnt :: TxRecord -> EntryAcnt -> InsertExcept T.Text
resolveAcnt = resolveSplitField AcntField resolveAcnt = resolveEntryField AcntField
resolveCurrency :: TxRecord -> SplitCur -> InsertExcept T.Text resolveCurrency :: TxRecord -> EntryCur -> InsertExcept T.Text
resolveCurrency = resolveSplitField CurField resolveCurrency = resolveEntryField CurField
resolveSplitField :: SplitIDType -> TxRecord -> SplitAcnt -> InsertExcept T.Text resolveEntryField :: EntryIDType -> TxRecord -> EntryAcnt -> InsertExcept T.Text
resolveSplitField t TxRecord {trOther = o} s = case s of resolveEntryField t TxRecord {trOther = o} s = case s of
ConstT p -> return p ConstT p -> return p
LookupT f -> lookup_ f o LookupT f -> lookup_ f o
MapT (Field f m) -> do MapT (Field f m) -> do
@ -469,7 +469,7 @@ resolveSplitField t TxRecord {trOther = o} s = case s of
lookup_ (k1, k2) m lookup_ (k1, k2) m
where where
lookup_ :: (Ord k, Show k) => k -> M.Map k v -> InsertExcept v lookup_ :: (Ord k, Show k) => k -> M.Map k v -> InsertExcept v
lookup_ = lookupErr (SplitIDField t) lookup_ = lookupErr (EntryIDField t)
lookupErr :: (Ord k, Show k) => LookupSuberr -> k -> M.Map k v -> InsertExcept v lookupErr :: (Ord k, Show k) => LookupSuberr -> k -> M.Map k v -> InsertExcept v
lookupErr what k m = case M.lookup k m of lookupErr what k m = case M.lookup k m of
@ -596,8 +596,8 @@ showError other = case other of
[T.unwords ["Could not find field", f, "when resolving", what]] [T.unwords ["Could not find field", f, "when resolving", what]]
where where
what = case t of what = case t of
SplitIDField st -> T.unwords ["split", idName st, "ID"] EntryIDField st -> T.unwords ["entry", idName st, "ID"]
SplitValField -> "split value" EntryValField -> "entry value"
MatchField mt -> T.unwords [matchName mt, "match"] MatchField mt -> T.unwords [matchName mt, "match"]
DBKey st -> T.unwords ["database", idName st, "ID key"] DBKey st -> T.unwords ["database", idName st, "ID key"]
-- TODO this should be its own function -- TODO this should be its own function
@ -629,15 +629,15 @@ showError other = case other of
[ msg [ msg
, "for currency" , "for currency"
, singleQuote cur , singleQuote cur
, "and for splits" , "and for entries"
, splits , entries
] ]
] ]
where where
msg = case t of msg = case t of
TooFewSplits -> "Need at least two splits to balance" TooFewEntries -> "Need at least two entries to balance"
NotOneBlank -> "Exactly one split must be blank" NotOneBlank -> "Exactly one entries must be blank"
splits = T.intercalate ", " $ fmap (singleQuote . showSplit) rss entries = T.intercalate ", " $ fmap (singleQuote . showEntry) rss
showGregorian_ :: Gregorian -> T.Text showGregorian_ :: Gregorian -> T.Text
showGregorian_ Gregorian {gYear, gMonth, gDay} = T.intercalate "-" $ showT <$> [gYear, gMonth, gDay] showGregorian_ Gregorian {gYear, gMonth, gDay} = T.intercalate "-" $ showT <$> [gYear, gMonth, gDay]
@ -725,8 +725,8 @@ showMatchOther (Val (Field f mv)) =
, singleQuote $ fromMaybe "*" $ showValMatcher mv , singleQuote $ fromMaybe "*" $ showValMatcher mv
] ]
showSplit :: RawSplit -> T.Text showEntry :: RawEntry -> T.Text
showSplit Entry {eAcnt, eValue, eComment} = showEntry Entry {eAcnt, eValue, eComment} =
keyVals keyVals
[ ("account", eAcnt) [ ("account", eAcnt)
, ("value", T.pack $ show ((fromRational <$> eValue) :: Maybe Float)) , ("value", T.pack $ show ((fromRational <$> eValue) :: Maybe Float))
@ -921,7 +921,7 @@ lookupTag = lookupFinance TagField kmTag
lookupFinance lookupFinance
:: (MonadInsertError m, MonadFinance m) :: (MonadInsertError m, MonadFinance m)
=> SplitIDType => EntryIDType
-> (DBState -> M.Map T.Text a) -> (DBState -> M.Map T.Text a)
-> T.Text -> T.Text
-> m a -> m a