Skip to content

Commit

Permalink
Add Instances for StoreT, New MonadStore Instances, Rework MonadAsk I…
Browse files Browse the repository at this point in the history
…nstance (#14)

* Add instances for StoreT and make MonadAsk delegate to base monad

* Add MonadStore instances for common transformers
  • Loading branch information
jhbertra authored Mar 1, 2022
1 parent 368a8e4 commit f31a39f
Show file tree
Hide file tree
Showing 2 changed files with 65 additions and 3 deletions.
2 changes: 2 additions & 0 deletions spago.dhall
Original file line number Diff line number Diff line change
@@ -1,6 +1,7 @@
{ name = "halogen-store"
, dependencies =
[ "aff"
, "distributive"
, "effect"
, "foldable-traversable"
, "halogen"
Expand All @@ -9,6 +10,7 @@
, "maybe"
, "prelude"
, "refs"
, "tailrec"
, "transformers"
, "tuples"
, "unsafe-coerce"
Expand Down
66 changes: 63 additions & 3 deletions src/Halogen/Store/Monad.purs
Original file line number Diff line number Diff line change
Expand Up @@ -2,8 +2,18 @@ module Halogen.Store.Monad where

import Prelude

import Control.Monad.Cont (class MonadCont, ContT)
import Control.Monad.Error.Class (class MonadError, class MonadThrow)
import Control.Monad.Reader (class MonadAsk, ReaderT, ask, lift, mapReaderT, runReaderT)
import Control.Monad.Except (ExceptT)
import Control.Monad.Identity.Trans (IdentityT)
import Control.Monad.Maybe.Trans (MaybeT)
import Control.Monad.RWS (RWST)
import Control.Monad.Reader (class MonadAsk, class MonadReader, ReaderT(..), ask, lift, local, mapReaderT, runReaderT)
import Control.Monad.Rec.Class (class MonadRec)
import Control.Monad.State (class MonadState, StateT)
import Control.Monad.Trans.Class (class MonadTrans)
import Control.Monad.Writer (class MonadTell, class MonadWriter, WriterT)
import Data.Distributive (class Distributive)
import Data.Foldable (traverse_)
import Data.Maybe (Maybe(..))
import Effect (Effect)
Expand Down Expand Up @@ -55,9 +65,19 @@ derive newtype instance MonadEffect m => MonadEffect (StoreT a s m)
derive newtype instance MonadAff m => MonadAff (StoreT a s m)
derive newtype instance MonadThrow e m => MonadThrow e (StoreT a s m)
derive newtype instance MonadError e m => MonadError e (StoreT a s m)
derive newtype instance MonadTell w m => MonadTell w (StoreT a s m)
derive newtype instance MonadWriter w m => MonadWriter w (StoreT a s m)
derive newtype instance MonadState s m => MonadState s (StoreT a s m)
derive newtype instance MonadCont m => MonadCont (StoreT a s m)
derive newtype instance MonadRec m => MonadRec (StoreT a s m)
derive newtype instance Distributive g => Distributive (StoreT a s g)
derive newtype instance MonadTrans (StoreT a s)

instance MonadEffect m => MonadAsk s (StoreT a s m) where
ask = getStore
instance MonadAsk r m => MonadAsk r (StoreT a s m) where
ask = lift ask

instance MonadReader r m => MonadReader r (StoreT a s m) where
local f (StoreT (ReaderT r)) = StoreT $ ReaderT $ local f <<< r

instance MonadEffect m => MonadStore a s (StoreT a s m) where
getStore = StoreT do
Expand Down Expand Up @@ -109,6 +129,46 @@ instance monadStoreHookM :: MonadStore a s m => MonadStore a s (Hooks.HookM m) w
updateStore = lift <<< updateStore
emitSelected = lift <<< emitSelected

instance MonadStore a s m => MonadStore a s (ContT r m) where
getStore = lift getStore
updateStore = lift <<< updateStore
emitSelected = lift <<< emitSelected

instance MonadStore a s m => MonadStore a s (ExceptT e m) where
getStore = lift getStore
updateStore = lift <<< updateStore
emitSelected = lift <<< emitSelected

instance MonadStore a s m => MonadStore a s (IdentityT m) where
getStore = lift getStore
updateStore = lift <<< updateStore
emitSelected = lift <<< emitSelected

instance MonadStore a s m => MonadStore a s (MaybeT m) where
getStore = lift getStore
updateStore = lift <<< updateStore
emitSelected = lift <<< emitSelected

instance (MonadStore a s m, Monoid w) => MonadStore a s (RWST r w s m) where
getStore = lift getStore
updateStore = lift <<< updateStore
emitSelected = lift <<< emitSelected

instance MonadStore a s m => MonadStore a s (ReaderT r m) where
getStore = lift getStore
updateStore = lift <<< updateStore
emitSelected = lift <<< emitSelected

instance MonadStore a s m => MonadStore a s (StateT s m) where
getStore = lift getStore
updateStore = lift <<< updateStore
emitSelected = lift <<< emitSelected

instance (MonadStore a s m, Monoid w) => MonadStore a s (WriterT w m) where
getStore = lift getStore
updateStore = lift <<< updateStore
emitSelected = lift <<< emitSelected

-- | Run a component in the `StoreT` monad.
-- |
-- | Requires an initial value for the store, `s`, and a reducer that updates
Expand Down

0 comments on commit f31a39f

Please sign in to comment.