REF clean code
This commit is contained in:
parent
f8669e5a15
commit
d617fa52cc
|
@ -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
|
||||
|
|
Loading…
Reference in New Issue