diff --git a/lib/Internal/Budget.hs b/lib/Internal/Budget.hs index aabe2db..935bedb 100644 --- a/lib/Internal/Budget.hs +++ b/lib/Internal/Budget.hs @@ -12,6 +12,17 @@ import qualified RIO.NonEmpty as NE import qualified RIO.Text as T 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 :: (MonadInsertError m, MonadSqlQuery m, MonadFinance m) => Budget @@ -73,8 +84,8 @@ insertBudgetTx FlatTransfer {ftFrom, ftTo, ftMeta, ftCur, ftValue, ftDesc, ftWhe k <- insert $ TransactionR (bmCommit ftMeta) ftWhen ftDesc insertBudgetLabel k from insertBudgetLabel k to - insertBudgetLabel k split = do - sk <- insertSplit k split + insertBudgetLabel k entry = do + sk <- insertEntry k entry insert_ $ BudgetLabelR sk $ bmName ftMeta entryPair @@ -83,7 +94,7 @@ entryPair -> TaggedAcnt -> BudgetCurrency -> Rational - -> m (SplitPair, Maybe SplitPair) + -> m (EntryPair, Maybe EntryPair) entryPair from to cur val = case cur of NoX curid -> (,Nothing) <$> pair curid from to val 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) where pair curid from_ to_ v = do - let s1 = split curid from_ (-v) - let s2 = split curid to_ v + let s1 = entry curid from_ (-v) + let s2 = entry curid to_ v combineError s1 s2 (,) - split c TaggedAcnt {taAcnt, taTags} v = - resolveSplit $ + entry c TaggedAcnt {taAcnt, taTags} v = + resolveEntry $ Entry { eAcnt = taAcnt , eValue = v @@ -368,7 +379,7 @@ allocatePost precision aftertax = fmap (fmap go) else roundPrecision precision v -------------------------------------------------------------------------------- --- Transfer +-- Standalone Transfer expandTransfers :: (MonadInsertError m, MonadSqlQuery m, MonadFinance m) @@ -520,7 +531,7 @@ type IntAllocations = type DaySpanAllocation = Allocation DaySpan -type SplitPair = (KeySplit, KeySplit) +type EntryPair = (KeyEntry, KeyEntry) type PeriodScaler = Natural -> Double -> Double diff --git a/lib/Internal/Database/Ops.hs b/lib/Internal/Database/Ops.hs index 9676269..e32df5b 100644 --- a/lib/Internal/Database/Ops.hs +++ b/lib/Internal/Database/Ops.hs @@ -10,8 +10,8 @@ module Internal.Database.Ops , mkPool , whenHash , whenHash_ - , insertSplit - , resolveSplit + , insertEntry + , resolveEntry ) where @@ -401,14 +401,14 @@ whenHash_ t o f = do hs <- askDBState kmNewCommits if h `elem` hs then Just . (c,) <$> f else return Nothing -insertSplit :: MonadSqlQuery m => TransactionRId -> KeySplit -> m SplitRId -insertSplit t Entry {eAcnt, eCurrency, eValue, eComment, eTags} = do - k <- insert $ SplitR t eCurrency eAcnt eComment eValue +insertEntry :: MonadSqlQuery m => TransactionRId -> KeyEntry -> m EntryRId +insertEntry t Entry {eAcnt, eCurrency, eValue, eComment, eTags} = do + k <- insert $ EntryR t eCurrency eAcnt eComment eValue mapM_ (insert_ . TagRelationR k) eTags return k -resolveSplit :: (MonadInsertError m, MonadFinance m) => BalSplit -> m KeySplit -resolveSplit s@Entry {eAcnt, eCurrency, eValue, eTags} = do +resolveEntry :: (MonadInsertError m, MonadFinance m) => BalEntry -> m KeyEntry +resolveEntry s@Entry {eAcnt, eCurrency, eValue, eTags} = do let aRes = lookupAccountKey eAcnt let cRes = lookupCurrencyKey eCurrency let sRes = lookupAccountSign eAcnt diff --git a/lib/Internal/History.hs b/lib/Internal/History.hs index 92284bb..72d50a4 100644 --- a/lib/Internal/History.hs +++ b/lib/Internal/History.hs @@ -16,23 +16,6 @@ import RIO hiding (to) import qualified RIO.Text as T 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 = partitionEithers . fmap go where @@ -118,16 +101,16 @@ txPair day from to cur val desc = resolveTx tx Tx { txDescr = desc , 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 t@Tx {txSplits = ss} = - fmap (\kss -> t {txSplits = kss}) $ +resolveTx t@Tx {txEntries = ss} = + fmap (\kss -> t {txEntries = kss}) $ combineErrors $ - fmap resolveSplit ss + fmap resolveEntry ss 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 - mapM_ (insertSplit k) ss + mapM_ (insertEntry k) ss diff --git a/lib/Internal/Statement.hs b/lib/Internal/Statement.hs index cf09dcb..386d96c 100644 --- a/lib/Internal/Statement.hs +++ b/lib/Internal/Statement.hs @@ -217,12 +217,12 @@ matchNonDates ms = go ([], [], initZipper ms) in go (m, u, resetZipper z') rs balanceTx :: RawTx -> InsertExcept BalTx -balanceTx t@Tx {txSplits = ss} = do - bs <- balanceSplits ss - return $ t {txSplits = bs} +balanceTx t@Tx {txEntries = ss} = do + bs <- balanceEntries ss + return $ t {txEntries = bs} -balanceSplits :: [RawSplit] -> InsertExcept [BalSplit] -balanceSplits ss = +balanceEntries :: [RawEntry] -> InsertExcept [BalEntry] +balanceEntries ss = fmap concat <$> mapM (uncurry bal) $ groupByKey @@ -231,7 +231,7 @@ balanceSplits ss = haeValue s@Entry {eValue = Just v} = Right s {eValue = v} haeValue s = Left s 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 ([noVal], val) -> return $ noVal {eValue = foldr (\s x -> x - eValue s) 0 val} : val ([], val) -> return val diff --git a/lib/Internal/Types/Database.hs b/lib/Internal/Types/Database.hs index 9e82ca6..6ea5506 100644 --- a/lib/Internal/Types/Database.hs +++ b/lib/Internal/Types/Database.hs @@ -44,7 +44,7 @@ TransactionR sql=transactions date Day description T.Text deriving Show Eq -SplitR sql=splits +EntryR sql=entries transaction TransactionRId OnDeleteCascade currency CurrencyRId OnDeleteCascade account AccountRId OnDeleteCascade @@ -52,10 +52,10 @@ SplitR sql=splits value Rational deriving Show Eq TagRelationR sql=tag_relations - split SplitRId OnDeleteCascade + entry EntryRId OnDeleteCascade tag TagRId OnDeleteCascade BudgetLabelR sql=budget_labels - split SplitRId OnDeleteCascade + entry EntryRId OnDeleteCascade budgetName T.Text deriving Show Eq |] diff --git a/lib/Internal/Types/Dhall.hs b/lib/Internal/Types/Dhall.hs index 9a96a14..ea29dbf 100644 --- a/lib/Internal/Types/Dhall.hs +++ b/lib/Internal/Types/Dhall.hs @@ -421,7 +421,7 @@ data History | HistStatement !Statement deriving (Eq, Generic, Hashable, FromDhall) -type EntryGetter = Entry SplitAcnt (Maybe EntryNumGetter) SplitCur TagID +type EntryGetter = Entry EntryAcnt (Maybe EntryNumGetter) EntryCur TagID 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 { txDescr :: !T.Text , txDate :: !Day - , txSplits :: ![s] + , txEntries :: ![s] } deriving (Generic) @@ -463,7 +463,7 @@ data Statement = Statement } 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 -- between the lookup and some other value data EntryTextGetter t @@ -473,9 +473,9 @@ data EntryTextGetter t | Map2T !(FieldMap (T.Text, T.Text) t) 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) @@ -504,8 +504,8 @@ data FieldMatcher re deriving instance Show (FieldMatcher T.Text) data TxGetter = TxGetter - { tgCurrency :: !SplitCur - , tgAcnt :: !SplitAcnt + { tgCurrency :: !EntryCur + , tgAcnt :: !EntryAcnt , tgEntries :: ![EntryGetter] } deriving (Eq, Generic, Hashable, Show, FromDhall) diff --git a/lib/Internal/Types/Main.hs b/lib/Internal/Types/Main.hs index 7b4d127..9605d41 100644 --- a/lib/Internal/Types/Main.hs +++ b/lib/Internal/Types/Main.hs @@ -57,9 +57,9 @@ data DBState = DBState 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) @@ -125,30 +125,30 @@ accountSign IncomeT = Credit accountSign LiabilityT = 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 -------------------------------------------------------------------------------- -- exception types -data BalanceType = TooFewSplits | NotOneBlank deriving (Show) +data BalanceType = TooFewEntries | NotOneBlank deriving (Show) data MatchType = MatchNumeric | MatchText deriving (Show) -data SplitIDType = AcntField | CurField | TagField deriving (Show) +data EntryIDType = AcntField | CurField | TagField deriving (Show) data LookupSuberr - = SplitIDField !SplitIDType - | SplitValField + = EntryIDField !EntryIDType + | EntryValField | MatchField !MatchType - | DBKey !SplitIDType + | DBKey !EntryIDType deriving (Show) data AllocationSuberr @@ -168,7 +168,7 @@ data InsertError | ParseError !T.Text | ConversionError !T.Text | LookupError !LookupSuberr !T.Text - | BalanceError !BalanceType !CurID ![RawSplit] + | BalanceError !BalanceType !CurID ![RawEntry] | IncomeError !Day !T.Text !Rational | PatternError !Natural !Natural !(Maybe Natural) !PatternSuberr | DaySpanError !Gregorian !(Maybe Gregorian) diff --git a/lib/Internal/Utils.hs b/lib/Internal/Utils.hs index fa392bc..fcca4d1 100644 --- a/lib/Internal/Utils.hs +++ b/lib/Internal/Utils.hs @@ -306,10 +306,10 @@ matches desc = maybe (return True) (matchMaybe trDesc . snd) spDesc convert (TxGetter cur a ss) = MatchPass <$> toTx cur a ss r -toTx :: SplitCur -> SplitAcnt -> [EntryGetter] -> TxRecord -> InsertExceptT CurrencyM RawTx -toTx sc sa toSplits r@TxRecord {trAmount, trDate, trDesc} = do - combineError3 acntRes curRes ssRes $ \a c ss -> - let fromSplit = +toTx :: EntryCur -> EntryAcnt -> [EntryGetter] -> TxRecord -> InsertExceptT CurrencyM RawTx +toTx sc sa toEntries r@TxRecord {trAmount, trDate, trDesc} = do + combineError3 acntRes curRes ssRes $ \a c es -> + let fromEntry = Entry { eAcnt = a , eCurrency = c @@ -320,12 +320,12 @@ toTx sc sa toSplits r@TxRecord {trAmount, trDate, trDesc} = do in Tx { txDate = trDate , txDescr = trDesc - , txSplits = fromSplit : ss + , txEntries = fromEntry : es } where acntRes = liftInner $ resolveAcnt r sa curRes = liftInner $ resolveCurrency r sc - ssRes = combineErrors $ fmap (resolveEntry r) toSplits + ssRes = combineErrors $ fmap (resolveEntry r) toEntries valMatches :: ValMatcher -> Rational -> InsertExcept Bool valMatches ValMatcher {vmDen, vmSign, vmNum, vmPrec} x @@ -351,7 +351,7 @@ otherMatches dict m = case m of where 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 m <- ask liftInner $ combineErrorM3 acntRes curRes valRes $ \a c v -> do @@ -447,18 +447,18 @@ collectErrorsIO = mapErrorsIO id resolveValue :: TxRecord -> EntryNumGetter -> InsertExcept Double 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 AmountN m -> return $ (* m) $ fromRational trAmount -resolveAcnt :: TxRecord -> SplitAcnt -> InsertExcept T.Text -resolveAcnt = resolveSplitField AcntField +resolveAcnt :: TxRecord -> EntryAcnt -> InsertExcept T.Text +resolveAcnt = resolveEntryField AcntField -resolveCurrency :: TxRecord -> SplitCur -> InsertExcept T.Text -resolveCurrency = resolveSplitField CurField +resolveCurrency :: TxRecord -> EntryCur -> InsertExcept T.Text +resolveCurrency = resolveEntryField CurField -resolveSplitField :: SplitIDType -> TxRecord -> SplitAcnt -> InsertExcept T.Text -resolveSplitField t TxRecord {trOther = o} s = case s of +resolveEntryField :: EntryIDType -> TxRecord -> EntryAcnt -> InsertExcept T.Text +resolveEntryField t TxRecord {trOther = o} s = case s of ConstT p -> return p LookupT f -> lookup_ f o MapT (Field f m) -> do @@ -469,7 +469,7 @@ resolveSplitField t TxRecord {trOther = o} s = case s of lookup_ (k1, k2) m where 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 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]] where what = case t of - SplitIDField st -> T.unwords ["split", idName st, "ID"] - SplitValField -> "split value" + EntryIDField st -> T.unwords ["entry", idName st, "ID"] + EntryValField -> "entry value" MatchField mt -> T.unwords [matchName mt, "match"] DBKey st -> T.unwords ["database", idName st, "ID key"] -- TODO this should be its own function @@ -629,15 +629,15 @@ showError other = case other of [ msg , "for currency" , singleQuote cur - , "and for splits" - , splits + , "and for entries" + , entries ] ] where msg = case t of - TooFewSplits -> "Need at least two splits to balance" - NotOneBlank -> "Exactly one split must be blank" - splits = T.intercalate ", " $ fmap (singleQuote . showSplit) rss + TooFewEntries -> "Need at least two entries to balance" + NotOneBlank -> "Exactly one entries must be blank" + entries = T.intercalate ", " $ fmap (singleQuote . showEntry) rss showGregorian_ :: Gregorian -> T.Text showGregorian_ Gregorian {gYear, gMonth, gDay} = T.intercalate "-" $ showT <$> [gYear, gMonth, gDay] @@ -725,8 +725,8 @@ showMatchOther (Val (Field f mv)) = , singleQuote $ fromMaybe "*" $ showValMatcher mv ] -showSplit :: RawSplit -> T.Text -showSplit Entry {eAcnt, eValue, eComment} = +showEntry :: RawEntry -> T.Text +showEntry Entry {eAcnt, eValue, eComment} = keyVals [ ("account", eAcnt) , ("value", T.pack $ show ((fromRational <$> eValue) :: Maybe Float)) @@ -921,7 +921,7 @@ lookupTag = lookupFinance TagField kmTag lookupFinance :: (MonadInsertError m, MonadFinance m) - => SplitIDType + => EntryIDType -> (DBState -> M.Map T.Text a) -> T.Text -> m a