{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module Main where
import Counter
import Weather
newtype MyAppM m a = MyAppM { unMyAppM :: MockCounter (MockWeather m) a }
deriving (Functor, Applicative, Monad, CounterT, WeatherT)
instance Monad m => WeatherT (MockCounter (MockWeather m))
runMyAppM :: Int -> MyAppM m a -> m (a, Int)
runMyAppM i = runMockWeather . (`runMockCounter` i) . unMyAppM
myApp :: (Monad m, CounterT m , WeatherT m) => m String
myApp = do
_ <- increment
(WeatherData weather) <- byCity "Amsterdam"
return weather
main :: IO ()
main = runMyAppM 12 myApp >>= print
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module Weather where
import Control.Monad.Except
import Control.Monad.Reader
import Control.Monad.State
import Control.Monad.Trans.Identity
import Control.Monad.Trans.Maybe
import Control.Monad.Writer
newtype WeatherData = WeatherData String deriving (Show)
class Monad m => WeatherT m where
byCity :: String -> m WeatherData
default byCity :: (MonadTrans t, WeatherT m', m ~ t m') => String -> m WeatherData
byCity = lift . byCity
instance WeatherT m => WeatherT (ExceptT e m)
instance WeatherT m => WeatherT (MaybeT m)
instance WeatherT m => WeatherT (ReaderT r m)
instance WeatherT m => WeatherT (StateT s m)
instance (Monoid w, WeatherT m) => WeatherT (WriterT w m)
newtype MockWeather m a = MockWeather {
unMockWeather :: IdentityT m a
} deriving (Functor, Applicative, Monad, MonadTrans, MonadIO, MonadError e, MonadReader r, MonadWriter w)
runMockWeather :: MockWeather f a -> f a
runMockWeather = runIdentityT . unMockWeather
instance Monad m => WeatherT (MockWeather m) where
byCity city = MockWeather $ return $ WeatherData $ "It is sunny in " ++ city
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module Counter where
import Control.Monad.Except
import Control.Monad.Identity
import Control.Monad.Reader
import Control.Monad.State
import Control.Monad.Trans.Maybe
import Control.Monad.Writer
class Monad m => CounterT m where
increment :: m Int
current :: m Int
default increment :: (MonadTrans t, CounterT m', m ~ t m') => m Int
increment = lift increment
default current :: (MonadTrans t, CounterT m', m ~ t m') => m Int
current = lift current
instance CounterT m => CounterT (ExceptT e m)
instance CounterT m => CounterT (MaybeT m)
instance CounterT m => CounterT (ReaderT r m)
instance CounterT m => CounterT (StateT s m)
instance (Monoid w, CounterT m) => CounterT (WriterT w m)
newtype MockCounter m a = MockCounter {
unMockCounter :: StateT Int m a
} deriving (Functor, Applicative, Monad, MonadTrans, MonadIO, MonadError e, MonadReader r, MonadWriter w, MonadState Int)
defaultMockCounter :: MockCounter Identity ()
defaultMockCounter = MockCounter $ put 0
runMockCounter :: MockCounter m a -> Int -> m (a, Int)
runMockCounter = runStateT . unMockCounter
instance Monad m => CounterT (MockCounter m) where
increment = MockCounter $ do
c <- get
let n = c + 1
put n
return n
current = MockCounter get
