module Reflex.Monad.Class
( MonadSwitch (..)
, MonadReflex
, module Reflex
, module Reflex.Switching
, module Reflex.Updated
, module Control.Monad.Writer.Class
) where
import Reflex
import Reflex.Updated
import Reflex.Switching
import Data.Maybe
import Data.Functor
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Control.Monad
import Control.Monad.Reader
import Control.Monad.Writer
import Control.Monad.Writer.Class
import Prelude
type MonadReflex t m = (Reflex t, MonadHold t m, MonadFix m)
class (MonadReflex t m) => MonadSwitch t m | m -> t where
switchM :: Updated t (m a) -> m (Updated t a)
switchM u = do
m <- switchMapM (toMap (Just <$> u))
return $ fromJust <$> fromMap m
switchMapM :: Ord k => UpdatedMap t k (m a) -> m (UpdatedMap t k a)
instance MonadSwitch t m => MonadSwitch t (ReaderT e m) where
switchM u = do
env <- ask
lift $ switchM (flip runReaderT env <$> u)
switchMapM um = do
env <- ask
lift . switchMapM $ flip runReaderT env <$> um
instance (MonadSwitch t m, SwitchMerge t w) => MonadSwitch t (WriterT w m) where
switchM u = do
(a, w) <- lift $ split <$> switchM (runWriterT <$> u)
tell =<< switching' w
return a
switchMapM um = do
(a, w) <- lift $ split <$> switchMapM (runWriterT <$> um)
tell =<< switchMerge' w
return a
maybeToMap :: Maybe a -> Map () a
maybeToMap Nothing = mempty
maybeToMap (Just a) = Map.singleton () a
mapToMaybe :: Map () a -> Maybe a
mapToMaybe m = listToMaybe $ Map.elems m
toMap :: Reflex t => Updated t (Maybe a) -> UpdatedMap t () a
toMap (Updated initial e) = UpdatedMap (maybeToMap initial) (Map.singleton () <$> e)
fromMap :: Reflex t => UpdatedMap t () a -> Updated t (Maybe a)
fromMap (UpdatedMap initial e) = Updated (mapToMaybe initial) (fmapMaybe mapToMaybe e)