This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
module Counter where | |
import Prelude | |
import Control.Monad.Eff.Class (class MonadEff, liftEff) | |
import Control.Monad.Eff.Console (logShow) | |
import Control.Monad.RWS.Trans (class MonadTrans) | |
import Control.Monad.State (StateT, get, put, runStateT) | |
import Control.Monad.Trans.Class (lift) | |
import Data.Tuple (Tuple) | |
class Monad m <= MonadCounter m where | |
increment :: m Int | |
current :: m Int | |
newtype CounterT m a = CounterT (StateT Int m a) | |
runCounterT :: forall m a. CounterT m a -> Int -> m (Tuple a Int) | |
runCounterT (CounterT c) = runStateT c | |
derive newtype instance functorCounterT :: Functor m => Functor (CounterT m) | |
derive newtype instance monadCounterT :: Monad m => Monad (CounterT m) | |
derive newtype instance applicativeCounterT :: Monad m => Applicative (CounterT m) | |
derive newtype instance applyCounterT :: Monad m => Apply (CounterT m) | |
instance monadTransCounterT :: MonadTrans CounterT where | |
lift = CounterT <<< lift | |
instance monadEffCounterT :: MonadEff eff m => MonadEff eff (CounterT m) where | |
liftEff = lift <<< liftEff | |
-- Actual CounterT implementation: | |
instance monadCounterCounterT :: Monad m => MonadCounter (CounterT m) where | |
increment = CounterT $ do | |
c <- get | |
let n = c + 1 | |
put n | |
pure n | |
current = CounterT get | |
--- | |
-- simpleApp should work for any instance of MonadCounter | |
myApp :: forall m. Monad m => MonadCounter m => m Int | |
myApp = increment | |
--- | |
newtype SimpleApp m a = SimpleApp (CounterT m a) | |
runSimpleApp :: ∀ a m. SimpleApp m a → Int → m (Tuple a Int) | |
runSimpleApp (SimpleApp c) = runCounterT c | |
derive newtype instance functorSimpleApp :: Functor m => Functor (SimpleApp m) | |
derive newtype instance monadSimpleApp :: Monad m => Monad (SimpleApp m) | |
derive newtype instance applySimpleApp :: Monad m => Apply (SimpleApp m) | |
derive newtype instance applicativeSimpleApp :: Monad m => Applicative (SimpleApp m) | |
derive newtype instance monadCounterSimpleApp :: MonadCounter m => MonadCounter (SimpleApp m) | |
derive newtype instance monadEffSimpleApp :: MonadEff eff m => MonadEff eff (SimpleApp m) | |
-- main :: forall e. Eff | |
-- ( console :: CONSOLE | |
-- | e | |
-- ) | |
-- Unit | |
-- main = runSimpleApp myApp 12 >>= logShow | |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment