urbit/pkg/hs/urbit-king/lib/Urbit/Vere/Ames/LaneCache.hs
2020-10-15 21:22:48 -07:00

33 lines
705 B
Haskell

module Urbit.Vere.Ames.LaneCache (cache) where
import Urbit.Prelude
import Urbit.Noun.Time
expiry :: Gap
expiry = (2 * 60) ^. from secs
cache :: forall a b m n
. (Ord a, MonadIO m, MonadIO n)
=> (a -> m b)
-> n (a -> m b)
cache act = do
cas <- newTVarIO (mempty :: Map a (Wen, b))
let fun x = lookup x <$> readTVarIO cas >>= \case
Nothing -> thru
Just (t, v) -> do
t' <- io now
if gap t' t > expiry
then thru
else pure v
where
thru :: m b
thru = do
t <- io now
v <- act x
atomically $ modifyTVar' cas (insertMap x (t, v))
pure v
pure fun