{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module Main where
import Counter
import Weather
import MockWeather
import MockCounter
import Control.Monad.Trans.Class
-- 'someApp' works for any underlying monad 'm'
-- and any instance of 'MonadCounter'
-- and any instance of 'MonadWeather'
someApp :: (Monad m, MonadCounter m , MonadWeather m) => m String
someApp = do
_ <- increment
(WeatherData weather) <- byCity "Amsterdam"
return weather
newtype MyAppM m a = MyAppM { unMyAppM :: MockCounter (MockWeather m) a }
deriving (Functor, Applicative, Monad, MonadCounter, MonadWeather)
instance MonadTrans MyAppM where
lift = MyAppM . lift . lift
runMyAppM :: Int -> MyAppM m a -> m (a, Int)
runMyAppM i = runMockWeather . (`runMockCounter` i) . unMyAppM
-- set the underlying monad to 'IO'
-- and 'MonadCounter' instance to 'MockCounter'
-- and 'MonadWeather' instance to 'MockWeather'
main :: IO ()
main = runMyAppM 12 (someApp >> someApp) >>= print
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE GADTs #-}
module Weather where
import Control.Monad.Trans.Class
newtype WeatherData = WeatherData String deriving (Show)
class Monad m => MonadWeather m where
byCity :: String -> m WeatherData
default byCity :: (MonadTrans t, MonadWeather m', m ~ t m') => String -> m WeatherData
byCity = lift . byCity
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE GADTs #-}
module Counter where
import Control.Monad.Trans.Class
class Monad m => MonadCounter m where
increment :: m Int
current :: m Int
default increment :: (MonadTrans t, MonadCounter m', m ~ t m') => m Int
increment = lift increment
default current :: (MonadTrans t, MonadCounter m', m ~ t m') => m Int
current = lift current
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module MockWeather where
import Weather
import Counter
import Control.Monad.Trans.Class
import Control.Monad.Trans.Identity
import Control.Monad.IO.Class
newtype MockWeather m a = MockWeather {
unMockWeather :: IdentityT m a
} deriving (Functor, Applicative, Monad, MonadTrans, MonadIO)
runMockWeather :: MockWeather f a -> f a
runMockWeather = runIdentityT . unMockWeather
instance MonadCounter m => MonadCounter (MockWeather m)
instance Monad m => MonadWeather (MockWeather m) where
byCity city = MockWeather $ return $ WeatherData $ "It is sunny in " ++ city
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module MockCounter where
import Weather
import Counter
import Control.Monad.Trans.Class
import Control.Monad.State
import Control.Monad.Identity
newtype MockCounter m a = MockCounter {
unMockCounter :: StateT Int m a
} deriving (Functor, Applicative, Monad, MonadTrans, MonadState Int, MonadIO)
instance MonadWeather m => MonadWeather (MockCounter m)
defaultMockCounter :: MockCounter Identity ()
defaultMockCounter = MockCounter $ put 0
runMockCounter :: MockCounter m a -> Int -> m (a, Int)
runMockCounter = runStateT . unMockCounter
instance Monad m => MonadCounter (MockCounter m) where
increment = MockCounter $ do
c <- get
let n = c + 1
put n
return n
current = MockCounter get
