{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE BlockArguments #-}
module Haskus.Utils.MonadVar
( MonadVar (..)
, updateMonadVarForce
, updateMonadVarMaybe
, updateMonadVar
, MonadVarNE (..)
, updateMonadVarNEMaybe
, updateMonadVarNE
)
where
import Haskus.Utils.Flow
import Haskus.Utils.Maybe
data MonadVar m s a
= MonadVar !(m s) (s -> a)
| CachedMonadVar a !s !(m s) (s -> a)
deriving (Functor)
updateMonadVarMaybe :: (Monad m, Eq s) => MonadVar m s a -> m (Maybe (MonadVar m s a))
updateMonadVarMaybe dv@(MonadVar {}) = Just <|| updateMonadVarForce dv
updateMonadVarMaybe (CachedMonadVar _ s io f) = do
s' <- io
if s == s'
then pure Nothing
else pure <| Just <| CachedMonadVar (f s') s' io f
updateMonadVar :: (Monad m, Eq s) => MonadVar m s a -> m (MonadVar m s a)
updateMonadVar dv = fromMaybe dv <|| updateMonadVarMaybe dv
updateMonadVarForce :: (Monad m, Eq s) => MonadVar m s a -> m (MonadVar m s a)
updateMonadVarForce (CachedMonadVar _ _ io f) = do
s <- io
pure (CachedMonadVar (f s) s io f)
updateMonadVarForce (MonadVar io f) = do
s <- io
pure (CachedMonadVar (f s) s io f)
data MonadVarNE m s a
= MonadVarNE a !(Maybe s) !(m s) (s -> a)
deriving (Functor)
updateMonadVarNEMaybe :: (Monad m, Eq s) => MonadVarNE m s a -> m (Maybe (MonadVarNE m s a))
updateMonadVarNEMaybe (MonadVarNE _ ms io f) = do
s' <- io
pure case ms of
Just s | s == s' -> Nothing
_ -> Just <| MonadVarNE (f s') (Just s') io f
updateMonadVarNE :: (Monad m, Eq s) => MonadVarNE m s a -> m (MonadVarNE m s a)
updateMonadVarNE dv = fromMaybe dv <|| updateMonadVarNEMaybe dv