REF clean code

This commit is contained in:
Nathan Dwarshuis 2023-06-26 19:04:37 -04:00
parent f8669e5a15
commit d617fa52cc
1 changed files with 16 additions and 16 deletions

View File

@ -339,21 +339,21 @@ balanceTxs
=> [EntryBin]
-> m ([UEBalanced], [KeyTx CommitR])
balanceTxs es =
(first concat . partitionEithers . catMaybes)
first concat . partitionEithers . catMaybes
<$> evalStateT (mapErrors go $ L.sortOn binDate es) M.empty
where
go (ToUpdate utx) = fmap (Just . Left) $ liftInnerS $ rebalanceEntrySet utx
go (ToRead ReadEntry {reCurrency, reAcnt, reValue}) = do
modify $ mapAdd_ (reAcnt, reCurrency) reValue
return Nothing
go (ToInsert (t@Tx {txEntries, txDate})) =
go (ToInsert t@Tx {txEntries}) =
(\es' -> Just $ Right $ t {txEntries = concat es'})
<$> mapM (balanceEntrySet txDate) txEntries
<$> mapErrors balanceEntrySet txEntries
binDate :: EntryBin -> Day
binDate (ToUpdate (UpdateEntrySet {utDate})) = utDate
binDate (ToUpdate UpdateEntrySet {utDate}) = utDate
binDate (ToRead ReadEntry {reDate}) = reDate
binDate (ToInsert (Tx {txDate})) = txDate
binDate (ToInsert Tx {txDate}) = txDate
type EntryBals = M.Map (AccountRId, CurrencyRId) Rational
@ -383,10 +383,10 @@ rebalanceEntrySet
++ (UET_Balance <$> utFromUnk)
++ (UET_Linked <$> utPairs)
fs' <- mapM goFrom fs
let f0val = utTotalValue - (sum $ fmap value fs')
let f0val = utTotalValue - sum (fmap value fs')
let f0 = utFrom0 {ueValue = EntryValue f0val}
let (tpairs, fs'') = partitionEithers $ concatMap flatten fs'
let tsLink0 = fmap (\e -> e {ueValue = EntryValue $ -f0val * (unLinkScale $ ueValue e)}) utToUnkLink0
let tsLink0 = fmap (\e -> e {ueValue = EntryValue $ -f0val * unLinkScale (ueValue e)}) utToUnkLink0
let ts =
L.sortOn idx2 $
(UET_Linked <$> (tpairs ++ tsLink0))
@ -394,10 +394,10 @@ rebalanceEntrySet
++ (UET_ReadOnly <$> utToRO)
(tsRO, tsUnk) <- partitionEithers <$> mapM goTo ts
let t0val =
(EntryValue utTotalValue)
- (sum $ (fmap ueValue tsRO) ++ (fmap ueValue tsUnk))
EntryValue utTotalValue
- sum (fmap ueValue tsRO ++ fmap ueValue tsUnk)
let t0 = utTo0 {ueValue = t0val}
return $ (f0 : (fmap (fmap (EntryValue . unBalanceTarget)) fs'')) ++ (t0 : tsUnk)
return $ (f0 : fmap (fmap (EntryValue . unBalanceTarget)) fs'') ++ (t0 : tsUnk)
where
project f _ _ (UET_ReadOnly e) = f e
project _ f _ (UET_Balance e) = f e
@ -409,7 +409,7 @@ rebalanceEntrySet
(unEntryValue . ueValue)
(unBalanceTarget . ueValue)
(unBalanceTarget . ueValue . fst)
flatten = project (const []) ((: []) . Right) (\(a, bs) -> (Right a) : (Left <$> bs))
flatten = project (const []) ((: []) . Right) (\(a, bs) -> Right a : (Left <$> bs))
-- TODO the following is wetter than the average groupie
goFrom (UET_ReadOnly e) = do
modify $ mapAdd_ (ueAcnt e, utCurrency) (unEntryValue $ ueValue e)
@ -426,7 +426,7 @@ rebalanceEntrySet
let newVal = unBalanceTarget (ueValue e0) - curBal
modify $ mapAdd_ key newVal
return $
UET_Linked $
UET_Linked
( e0 {ueValue = BalanceTarget newVal}
, fmap (\e -> e {ueValue = EntryValue $ (-newVal) * unLinkScale (ueValue e)}) es
)
@ -445,11 +445,9 @@ rebalanceEntrySet
balanceEntrySet
:: (MonadInsertError m, MonadFinance m)
=> Day
-> DeferredEntrySet
=> DeferredEntrySet
-> StateT EntryBals m [KeyEntry]
balanceEntrySet
day
EntrySet
{ esFrom = HalfEntrySet {hesPrimary = f0, hesOther = fs}
, esTo = HalfEntrySet {hesPrimary = t0, hesOther = ts}
@ -482,7 +480,7 @@ doEntries
-> NonEmpty Int
-> StateT EntryBals m [FullEntry AccountRId CurrencyRId TagRId]
doEntries f curID tot e es (i0 :| iN) = do
es' <- mapM (uncurry f) $ zip iN es
es' <- mapErrors (uncurry f) $ zip iN es
let val0 = tot - entrySum es'
e' <- balanceEntry (\_ _ -> return (val0, Nothing)) curID i0 e
return $ e' : es'
@ -505,6 +503,8 @@ balanceLinked from curID precision acntID lg = case lg of
let res = fmap (go lngScale) $ from V.!? fromIntegral lngIndex
case res of
Just v -> return $ (v, Just $ EntryLinked lngIndex $ toRational lngScale)
-- TODO this error would be much more informative if I had access to the
-- file from which it came
Nothing -> throwError undefined
(LinkDeferred d) -> liftInnerS $ balanceDeferred curID acntID d
where