REF clean up useless types
This commit is contained in:
parent
ad5e4a0748
commit
cafc066881
14
app/Main.hs
14
app/Main.hs
|
|
@ -231,11 +231,11 @@ runSync threads c bs hs = do
|
|||
-- the database, don't read it but record the commit so we can update it.
|
||||
toIns <-
|
||||
flip runReaderT state $ do
|
||||
(CRUDOps hSs _ _ _) <- askDBState csHistStmts
|
||||
(CRUDOps hSs _ _ _) <- asks csHistStmts
|
||||
hSs' <- mapErrorsIO (readHistStmt root) hSs
|
||||
(CRUDOps hTs _ _ _) <- askDBState csHistTrans
|
||||
(CRUDOps hTs _ _ _) <- asks csHistTrans
|
||||
hTs' <- liftIOExceptT $ mapErrors readHistTransfer hTs
|
||||
(CRUDOps bTs _ _ _) <- askDBState csBudgets
|
||||
(CRUDOps bTs _ _ _) <- asks csBudgets
|
||||
bTs' <- liftIOExceptT $ mapErrors readBudget bTs
|
||||
return $ concat $ hSs' ++ hTs' ++ bTs'
|
||||
|
||||
|
|
@ -244,9 +244,9 @@ runSync threads c bs hs = do
|
|||
-- NOTE this must come first (unless we defer foreign keys)
|
||||
updateDBState
|
||||
res <- runExceptT $ do
|
||||
(CRUDOps _ bRs bUs _) <- askDBState csBudgets
|
||||
(CRUDOps _ tRs tUs _) <- askDBState csHistTrans
|
||||
(CRUDOps _ sRs sUs _) <- askDBState csHistStmts
|
||||
(CRUDOps _ bRs bUs _) <- asks csBudgets
|
||||
(CRUDOps _ tRs tUs _) <- asks csHistTrans
|
||||
(CRUDOps _ sRs sUs _) <- asks csHistStmts
|
||||
let ebs = fmap ToUpdate (bUs ++ tUs ++ sUs) ++ fmap ToRead (bRs ++ tRs ++ sRs) ++ fmap ToInsert toIns
|
||||
insertAll ebs
|
||||
-- NOTE this rerunnable thing is a bit misleading; fromEither will throw
|
||||
|
|
@ -259,8 +259,6 @@ runSync threads c bs hs = do
|
|||
liftIO $ mapM_ TI.putStrLn $ concatMap showError es
|
||||
exitFailure
|
||||
|
||||
-- showBalances
|
||||
|
||||
readConfig :: MonadUnliftIO m => FilePath -> m Config
|
||||
readConfig = fmap unfix . readDhall
|
||||
|
||||
|
|
|
|||
|
|
@ -49,7 +49,7 @@ readBudget
|
|||
++ (alloAcnt <$> bgtTax)
|
||||
++ (alloAcnt <$> bgtPosttax)
|
||||
getSpan = do
|
||||
globalSpan <- askDBState (unBSpan . csBudgetScope)
|
||||
globalSpan <- asks (unBSpan . csBudgetScope)
|
||||
case bgtInterval of
|
||||
Nothing -> return $ Just globalSpan
|
||||
Just bi -> do
|
||||
|
|
@ -253,20 +253,22 @@ selectAllos day Allocation {alloAmts, alloTo} =
|
|||
, faDesc = amtDesc
|
||||
}
|
||||
|
||||
allo2Trans :: FlatAllocation Decimal -> Entry AcntID LinkDeferred TagID
|
||||
allo2Trans :: FlatAllocation Decimal -> Entry AcntID EntryLink TagID
|
||||
allo2Trans FlatAllocation {faValue, faTo = TaggedAcnt {taAcnt, taTags}, faDesc} =
|
||||
Entry
|
||||
{ eValue = LinkDeferred (EntryFixed faValue)
|
||||
{ eValue = LinkValue (EntryFixed faValue)
|
||||
, eComment = faDesc
|
||||
, eAcnt = AcntID taAcnt
|
||||
, eTags = TagID <$> taTags
|
||||
}
|
||||
|
||||
type PreDeductions = M.Map T.Text Decimal
|
||||
|
||||
allocatePre
|
||||
:: Precision
|
||||
-> Decimal
|
||||
-> [FlatAllocation PretaxValue]
|
||||
-> (M.Map T.Text Decimal, [FlatAllocation Decimal])
|
||||
-> (PreDeductions, [FlatAllocation Decimal])
|
||||
allocatePre precision gross = L.mapAccumR go M.empty
|
||||
where
|
||||
go m f@FlatAllocation {faValue = PretaxValue {preCategory, preValue, prePercent}} =
|
||||
|
|
@ -279,7 +281,7 @@ allocatePre precision gross = L.mapAccumR go M.empty
|
|||
allocateTax
|
||||
:: Precision
|
||||
-> Decimal
|
||||
-> M.Map T.Text Decimal
|
||||
-> PreDeductions
|
||||
-> PeriodScaler
|
||||
-> [FlatAllocation TaxValue]
|
||||
-> [FlatAllocation Decimal]
|
||||
|
|
|
|||
|
|
@ -674,7 +674,7 @@ makeUnkUE k e = makeUE k e ()
|
|||
|
||||
insertAll
|
||||
:: (MonadInsertError m, MonadSqlQuery m, MonadFinance m)
|
||||
=> [EntryBin]
|
||||
=> [EntryCRU]
|
||||
-> m ()
|
||||
insertAll ebs = do
|
||||
(toUpdate, toInsert) <- balanceTxs ebs
|
||||
|
|
@ -692,7 +692,7 @@ insertTx c InsertTx {itxDate, itxDescr, itxEntrySets, itxBudget, itxPriority} =
|
|||
insertEntrySet tk i InsertEntrySet {iesCurrency, iesFromEntries, iesToEntries} = do
|
||||
let fs = NE.toList iesFromEntries
|
||||
let ts = NE.toList iesToEntries
|
||||
let rebalance = any (isJust . ieDeferred) (fs ++ ts)
|
||||
let rebalance = any (isJust . ieCached) (fs ++ ts)
|
||||
esk <- insert $ EntrySetR tk iesCurrency i rebalance
|
||||
mapM_ (uncurry (go esk)) $ zip [0 ..] ts ++ zip (negate <$> [1 ..]) fs
|
||||
go k i e = void $ insertEntry k i e
|
||||
|
|
@ -703,17 +703,17 @@ insertEntry
|
|||
i
|
||||
InsertEntry
|
||||
{ ieEntry = Entry {eValue, eTags, eAcnt, eComment}
|
||||
, ieDeferred
|
||||
, ieCached
|
||||
} =
|
||||
do
|
||||
ek <- insert $ EntryR k eAcnt eComment (toRational eValue) i cval ctype deflink
|
||||
mapM_ (insert_ . TagRelationR ek) eTags
|
||||
return ek
|
||||
where
|
||||
(cval, ctype, deflink) = case ieDeferred of
|
||||
(Just (DBEntryLinked x s)) -> (Just (toRational s), Nothing, Just $ fromIntegral x)
|
||||
(Just (DBEntryBalance b)) -> (Just (toRational b), Just TBalance, Nothing)
|
||||
(Just (DBEntryPercent p)) -> (Just (toRational p), Just TPercent, Nothing)
|
||||
(cval, ctype, deflink) = case ieCached of
|
||||
(Just (CachedLink x s)) -> (Just (toRational s), Nothing, Just x)
|
||||
(Just (CachedBalance b)) -> (Just (toRational b), Just TBalance, Nothing)
|
||||
(Just (CachedPercent p)) -> (Just (toRational p), Just TPercent, Nothing)
|
||||
Nothing -> (Nothing, Just TFixed, Nothing)
|
||||
|
||||
updateTx :: MonadSqlQuery m => UEBalanced -> m ()
|
||||
|
|
|
|||
|
|
@ -41,7 +41,7 @@ readHistTransfer
|
|||
=> PairedTransfer
|
||||
-> m [Tx CommitR]
|
||||
readHistTransfer ht = do
|
||||
bounds <- askDBState (unHSpan . csHistoryScope)
|
||||
bounds <- asks (unHSpan . csHistoryScope)
|
||||
expandTransfer c historyName bounds ht
|
||||
where
|
||||
c = CommitR (CommitHash $ hash ht) CTHistoryTransfer
|
||||
|
|
@ -56,7 +56,7 @@ readHistStmt
|
|||
-> m [Tx CommitR]
|
||||
readHistStmt root i = do
|
||||
bs <- readImport root i
|
||||
bounds <- askDBState (unHSpan . csHistoryScope)
|
||||
bounds <- asks (unHSpan . csHistoryScope)
|
||||
return $ filter (inDaySpan bounds . txDate) $ fmap (\t -> t {txCommit = c}) bs
|
||||
where
|
||||
c = CommitR (CommitHash $ hash i) CTHistoryStatement
|
||||
|
|
@ -317,7 +317,7 @@ toTx
|
|||
}
|
||||
where
|
||||
curRes = do
|
||||
m <- askDBState csCurrencyMap
|
||||
m <- asks csCurrencyMap
|
||||
cur <- liftInner $ resolveCurrency m r tgCurrency
|
||||
let prec = cpPrec cur
|
||||
let fromRes = liftInner $ resolveHalfEntry resolveFromValue prec r () tgFrom
|
||||
|
|
@ -331,7 +331,7 @@ resolveSubGetter
|
|||
-> TxSubGetter
|
||||
-> InsertExceptT m SecondayEntrySet
|
||||
resolveSubGetter r TxSubGetter {tsgFrom, tsgTo, tsgValue, tsgCurrency} = do
|
||||
m <- askDBState csCurrencyMap
|
||||
m <- asks csCurrencyMap
|
||||
cur <- liftInner $ resolveCurrency m r tsgCurrency
|
||||
let prec = cpPrec cur
|
||||
let toRes = resolveHalfEntry resolveToValue prec r () tsgTo
|
||||
|
|
@ -391,9 +391,9 @@ resolveEntry f prec r s@Entry {eAcnt, eValue} =
|
|||
resolveFromValue :: Precision -> TxRecord -> EntryNumGetter -> InsertExcept EntryValue
|
||||
resolveFromValue = resolveValue
|
||||
|
||||
resolveToValue :: Precision -> TxRecord -> LinkedEntryNumGetter -> InsertExcept LinkDeferred
|
||||
resolveToValue :: Precision -> TxRecord -> LinkedEntryNumGetter -> InsertExcept EntryLink
|
||||
resolveToValue _ _ (Linked l) = return $ LinkIndex l
|
||||
resolveToValue prec r (Getter g) = LinkDeferred <$> resolveValue prec r g
|
||||
resolveToValue prec r (Getter g) = LinkValue <$> resolveValue prec r g
|
||||
|
||||
resolveValue :: Precision -> TxRecord -> EntryNumGetter -> InsertExcept EntryValue
|
||||
resolveValue prec TxRecord {trOther, trAmount} s = case s of
|
||||
|
|
|
|||
|
|
@ -75,10 +75,10 @@ data CRUDOps c r u d = CRUDOps
|
|||
}
|
||||
deriving (Show)
|
||||
|
||||
data DBDeferred
|
||||
= DBEntryLinked Natural Double
|
||||
| DBEntryBalance Decimal
|
||||
| DBEntryPercent Double
|
||||
data CachedEntry
|
||||
= CachedLink EntryIndex LinkScale
|
||||
| CachedBalance Decimal
|
||||
| CachedPercent Double
|
||||
|
||||
data ReadEntry = ReadEntry
|
||||
{ reCurrency :: !CurrencyRId
|
||||
|
|
@ -98,12 +98,10 @@ data UpdateEntry i v = UpdateEntry
|
|||
}
|
||||
deriving (Show)
|
||||
|
||||
data CurrencyRound = CurrencyRound CurID Natural
|
||||
|
||||
deriving instance Functor (UpdateEntry i)
|
||||
|
||||
newtype LinkScale = LinkScale {unLinkScale :: Decimal}
|
||||
deriving newtype (Num, Show)
|
||||
newtype LinkScale = LinkScale {unLinkScale :: Double}
|
||||
deriving newtype (Num, Show, Eq, Ord, Real, Fractional)
|
||||
|
||||
newtype StaticValue = StaticValue {unStaticValue :: Decimal}
|
||||
deriving newtype (Num, Show)
|
||||
|
|
@ -139,18 +137,13 @@ type TotalUpdateEntrySet = UpdateEntrySet (UEBlank, [UELink]) Decimal
|
|||
|
||||
type FullUpdateEntrySet = UpdateEntrySet (Either UE_RO (UEUnk, [UELink])) ()
|
||||
|
||||
data EntryBin
|
||||
data EntryCRU
|
||||
= ToUpdate (Either TotalUpdateEntrySet FullUpdateEntrySet)
|
||||
| ToRead ReadEntry
|
||||
| ToInsert (Tx CommitR)
|
||||
|
||||
type TreeR = Tree ([T.Text], AccountRId)
|
||||
|
||||
type MonadFinance = MonadReader ConfigState
|
||||
|
||||
askDBState :: MonadFinance m => (ConfigState -> a) -> m a
|
||||
askDBState = asks
|
||||
|
||||
-------------------------------------------------------------------------------
|
||||
-- misc
|
||||
|
||||
|
|
@ -190,13 +183,13 @@ type TotalEntrySet v0 vpN vtN = EntrySet v0 () vpN vtN
|
|||
|
||||
type FullEntrySet vp0 vpN vtN = EntrySet () vp0 vpN vtN
|
||||
|
||||
type PrimaryEntrySet = TotalEntrySet Decimal EntryValue LinkDeferred
|
||||
type PrimaryEntrySet = TotalEntrySet Decimal EntryValue EntryLink
|
||||
|
||||
type SecondayEntrySet = FullEntrySet EntryValue EntryValue LinkDeferred
|
||||
type SecondayEntrySet = FullEntrySet EntryValue EntryValue EntryLink
|
||||
|
||||
type TransferEntrySet = SecondayEntrySet
|
||||
|
||||
type ShadowEntrySet = TotalEntrySet Double EntryValue LinkDeferred
|
||||
type ShadowEntrySet = TotalEntrySet Double EntryValue EntryLink
|
||||
|
||||
data TxCommit = HistoryCommit CommitR | BudgetCommit CommitR T.Text
|
||||
deriving (Eq, Ord, Show)
|
||||
|
|
@ -213,7 +206,7 @@ data Tx k = Tx
|
|||
deriving (Generic, Show)
|
||||
|
||||
data InsertEntry = InsertEntry
|
||||
{ ieDeferred :: !(Maybe DBDeferred)
|
||||
{ ieCached :: !(Maybe CachedEntry)
|
||||
, ieEntry :: !(Entry AccountRId Decimal TagRId)
|
||||
}
|
||||
|
||||
|
|
@ -233,18 +226,13 @@ data InsertTx = InsertTx
|
|||
}
|
||||
deriving (Generic)
|
||||
|
||||
data Deferred a = Deferred Bool a
|
||||
deriving (Show, Functor, Foldable, Traversable)
|
||||
|
||||
data EntryValue_ a = EntryValue_ TransferType a
|
||||
deriving (Show, Functor, Foldable, Traversable)
|
||||
|
||||
data EntryValue = EntryFixed Decimal | EntryPercent Double | EntryBalance Decimal
|
||||
deriving (Show, Eq, Ord)
|
||||
|
||||
data LinkDeferred
|
||||
= LinkDeferred EntryValue
|
||||
| LinkIndex LinkedNumGetter
|
||||
data EntryLink = LinkValue EntryValue | LinkIndex LinkedNumGetter
|
||||
deriving (Show)
|
||||
|
||||
data MatchRes a = MatchPass !a | MatchFail | MatchSkip
|
||||
|
|
@ -302,13 +290,6 @@ type InsertExceptT = ExceptT InsertException
|
|||
|
||||
type InsertExcept = InsertExceptT Identity
|
||||
|
||||
data XGregorian = XGregorian
|
||||
{ xgYear :: !Int
|
||||
, xgMonth :: !Int
|
||||
, xgDay :: !Int
|
||||
, xgDayOfWeek :: !Int
|
||||
}
|
||||
|
||||
type MatchRe = StatementParser (T.Text, Regex)
|
||||
|
||||
type TxOptsRe = TxOpts (T.Text, Regex)
|
||||
|
|
|
|||
|
|
@ -30,9 +30,7 @@ module Internal.Utils
|
|||
, showError
|
||||
, tshow
|
||||
, lookupErr
|
||||
, gregorians
|
||||
, uncurry3
|
||||
, xGregToDay
|
||||
, dateMatches
|
||||
, valMatches
|
||||
, lookupAccount
|
||||
|
|
@ -152,7 +150,7 @@ askDays
|
|||
-> Maybe Interval
|
||||
-> m [Day]
|
||||
askDays dp i = do
|
||||
globalSpan <- askDBState (unBSpan . csBudgetScope)
|
||||
globalSpan <- asks (unBSpan . csBudgetScope)
|
||||
case i of
|
||||
Just i' -> do
|
||||
localSpan <- liftExcept $ resolveDaySpan i'
|
||||
|
|
@ -174,33 +172,6 @@ fromWeekday Fri = Friday
|
|||
fromWeekday Sat = Saturday
|
||||
fromWeekday Sun = Sunday
|
||||
|
||||
-- | find the next date
|
||||
-- this is meant to go in a very tight loop and be very fast (hence no
|
||||
-- complex date functions, most of which heavily use 'mod' and friends)
|
||||
nextXGreg :: XGregorian -> XGregorian
|
||||
nextXGreg XGregorian {xgYear = y, xgMonth = m, xgDay = d, xgDayOfWeek = w}
|
||||
| m == 12 && d == 31 = XGregorian (y + 1) 1 1 w_
|
||||
| (m == 2 && (not leap && d == 28 || (leap && d == 29)))
|
||||
|| (m `elem` [4, 6, 9, 11] && d == 30)
|
||||
|| (d == 31) =
|
||||
XGregorian y (m + 1) 1 w_
|
||||
| otherwise = XGregorian y m (d + 1) w_
|
||||
where
|
||||
-- don't use DayOfWeek from Data.Time since this uses mod (which uses a
|
||||
-- division opcode) and thus will be slower than just checking for equality
|
||||
-- and adding
|
||||
w_ = if w == 6 then 0 else w + 1
|
||||
leap = isLeapYear $ fromIntegral y
|
||||
|
||||
gregorians :: Day -> [XGregorian]
|
||||
gregorians x = L.iterate nextXGreg $ XGregorian (fromIntegral y) m d w
|
||||
where
|
||||
(y, m, d) = toGregorian x
|
||||
w = fromEnum $ dayOfWeek x
|
||||
|
||||
xGregToDay :: XGregorian -> Day
|
||||
xGregToDay XGregorian {xgYear = y, xgMonth = m, xgDay = d} = fromGregorian (fromIntegral y) m d
|
||||
|
||||
gregTup :: Gregorian -> (Integer, Int, Int)
|
||||
gregTup Gregorian {gYear, gMonth, gDay} =
|
||||
( fromIntegral gYear
|
||||
|
|
@ -645,11 +616,11 @@ lookupFinance
|
|||
-> (ConfigState -> M.Map k a)
|
||||
-> k
|
||||
-> m a
|
||||
lookupFinance t f c = (liftExcept . lookupErr (DBKey t) c) =<< askDBState f
|
||||
lookupFinance t f c = (liftExcept . lookupErr (DBKey t) c) =<< asks f
|
||||
|
||||
balanceTxs
|
||||
:: (MonadInsertError m, MonadFinance m)
|
||||
=> [EntryBin]
|
||||
=> [EntryCRU]
|
||||
-> m ([UEBalanced], [InsertTx])
|
||||
balanceTxs ebs =
|
||||
first concat . partitionEithers . catMaybes
|
||||
|
|
@ -684,7 +655,7 @@ balanceTxs ebs =
|
|||
(balancePrimaryEntrySet txBudget . fromShadow tot)
|
||||
fromShadow tot e@EntrySet {esTotalValue} = e {esTotalValue = tot *. esTotalValue}
|
||||
|
||||
binDate :: EntryBin -> (Day, Int)
|
||||
binDate :: EntryCRU -> (Day, Int)
|
||||
binDate (ToRead ReadEntry {reDate, rePriority}) = (reDate, rePriority)
|
||||
binDate (ToInsert Tx {txDate, txPriority}) = (txDate, txPriority)
|
||||
binDate (ToUpdate u) = either go go u
|
||||
|
|
@ -768,7 +739,7 @@ rebalanceDebit k ro linked = do
|
|||
return (v, e0' : es')
|
||||
|
||||
unlink :: Decimal -> UELink -> UEBalanced
|
||||
unlink v e = e {ueValue = StaticValue $ (-v) * unLinkScale (ueValue e)}
|
||||
unlink v e = e {ueValue = StaticValue $ (-v) *. unLinkScale (ueValue e)}
|
||||
|
||||
rebalanceCredit
|
||||
:: BCKey
|
||||
|
|
@ -880,7 +851,7 @@ balanceFinal
|
|||
-> Decimal
|
||||
-> NonEmpty InsertEntry
|
||||
-> Entry AccountRId () TagRId
|
||||
-> [Entry AccountRId LinkDeferred TagRId]
|
||||
-> [Entry AccountRId EntryLink TagRId]
|
||||
-> StateT EntryBals m InsertEntrySet
|
||||
balanceFinal k@(curID, _) tot fs t0 ts = do
|
||||
let fv = V.fromList $ NE.toList $ fmap (eValue . ieEntry) fs
|
||||
|
|
@ -895,7 +866,7 @@ balanceFinal k@(curID, _) tot fs t0 ts = do
|
|||
|
||||
balanceTotalEntrySet
|
||||
:: (MonadInsertError m)
|
||||
=> (ABCKey -> v -> StateT EntryBals m (Decimal, Maybe DBDeferred))
|
||||
=> (ABCKey -> v -> StateT EntryBals m (Decimal, Maybe CachedEntry))
|
||||
-> BCKey
|
||||
-> Decimal
|
||||
-> Entry AccountRId () TagRId
|
||||
|
|
@ -909,7 +880,7 @@ balanceTotalEntrySet f k tot e@Entry {eAcnt = acntID} es = do
|
|||
let e' =
|
||||
InsertEntry
|
||||
{ ieEntry = e {eValue = e0val, eAcnt = acntID}
|
||||
, ieDeferred = Nothing
|
||||
, ieCached = Nothing
|
||||
}
|
||||
return $ e' :| es'
|
||||
where
|
||||
|
|
@ -922,42 +893,42 @@ balanceLinked
|
|||
:: MonadInsertError m
|
||||
=> Vector Decimal
|
||||
-> ABCKey
|
||||
-> LinkDeferred
|
||||
-> StateT EntryBals m (Decimal, Maybe DBDeferred)
|
||||
-> EntryLink
|
||||
-> StateT EntryBals m (Decimal, Maybe CachedEntry)
|
||||
balanceLinked from k lg = case lg of
|
||||
(LinkIndex LinkedNumGetter {lngIndex, lngScale}) -> do
|
||||
let res = fmap (go lngScale) $ from V.!? fromIntegral lngIndex
|
||||
case res of
|
||||
Just v -> return (v, Just $ DBEntryLinked lngIndex lngScale)
|
||||
Just v -> return (v, Just $ CachedLink (EntryIndex $ fromIntegral lngIndex) (LinkScale 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 k d
|
||||
(LinkValue d) -> liftInnerS $ balanceDeferred k d
|
||||
where
|
||||
go s = negate . (*. s)
|
||||
|
||||
balanceDeferred :: ABCKey -> EntryValue -> State EntryBals (Decimal, Maybe DBDeferred)
|
||||
balanceDeferred :: ABCKey -> EntryValue -> State EntryBals (Decimal, Maybe CachedEntry)
|
||||
balanceDeferred k e = do
|
||||
newval <- findBalance k e
|
||||
let d = case e of
|
||||
EntryFixed _ -> Nothing
|
||||
EntryBalance v -> Just $ DBEntryBalance v
|
||||
EntryPercent v -> Just $ DBEntryPercent v
|
||||
EntryBalance v -> Just $ CachedBalance v
|
||||
EntryPercent v -> Just $ CachedPercent v
|
||||
return (newval, d)
|
||||
|
||||
balanceEntry
|
||||
:: (MonadInsertError m)
|
||||
=> (ABCKey -> v -> StateT EntryBals m (Decimal, Maybe DBDeferred))
|
||||
=> (ABCKey -> v -> StateT EntryBals m (Decimal, Maybe CachedEntry))
|
||||
-> BCKey
|
||||
-> Entry AccountRId v TagRId
|
||||
-> StateT EntryBals m InsertEntry
|
||||
balanceEntry f k e@Entry {eValue, eAcnt = acntID} = do
|
||||
(newVal, deferred) <- f (acntID, k) eValue
|
||||
(newVal, cached) <- f (acntID, k) eValue
|
||||
modify (mapAdd_ (acntID, k) newVal)
|
||||
return $
|
||||
InsertEntry
|
||||
{ ieEntry = e {eValue = newVal, eAcnt = acntID}
|
||||
, ieDeferred = deferred
|
||||
, ieCached = cached
|
||||
}
|
||||
|
||||
resolveAcntAndTags
|
||||
|
|
|
|||
Loading…
Reference in New Issue