PureScript Transformers

Main.purs

module Main where

import Prelude
import Control.Monad.Eff
import Control.Monad.Eff.Console
import Control.Monad.Free
import Control.Monad.Eff.Class (class MonadEff, liftEff)
import Control.Monad.Eff.Ref (REF, Ref, newRef, modifyRef, readRef)
import Control.Monad.Trans.Class (class MonadTrans, lift)
import Control.Monad.Reader (class MonadAsk, ReaderT, ask, runReaderT)
import TryPureScript

-- MonadWeather.purs

newtype WeatherData = WeatherData String 

class Monad m <= MonadWeather m where
  byCity :: String -> m WeatherData
  

-- MonadStringAppend.purs

class Monad m <= MonadStringAppend m where
  appendStr :: String -> m Unit
  

-- StringAppendT.purs

newtype StringAppendT m a = StringAppendT (ReaderT (Ref String) m a)
runStringAppendT (StringAppendT m) = runReaderT m 

derive newtype instance functorStringAppendT :: Functor m => Functor (StringAppendT m)
derive newtype instance applicativeStringAppendT :: Applicative m => Applicative (StringAppendT m)
derive newtype instance monadStringAppendT :: Monad m => Monad (StringAppendT m)
derive newtype instance applyStringAppendT :: Apply m => Apply (StringAppendT m)
derive newtype instance bindStringAppendT :: Bind m => Bind (StringAppendT m)

instance monadTransStringAppendT :: MonadTrans StringAppendT where
  lift = StringAppendT <<< lift

instance monadEffStringAppendT :: MonadEff eff m => MonadEff eff (StringAppendT m) where
  liftEff = lift <<< liftEff
derive newtype instance monadAskStringAppendT :: Monad m => MonadAsk (Ref String) (StringAppendT m)

instance monadWeatherStringAppendT :: (MonadWeather m) => MonadWeather (StringAppendT m) where
  byCity = lift <<< byCity

instance myMonadStringAppendT :: (Monad m, MonadEff (ref ∷ REF | e) m) => MonadStringAppend (StringAppendT m) where
  appendStr val = do
    ref <- ask
    liftEff $ modifyRef ref (\s -> s <> val)
    

-- MockWeatherT.purs

newtype MockWeatherT m a = MockWeatherT ( m a)
runMockWeatherT (MockWeatherT m) =  m 

derive newtype instance functorMockWeatherT :: Functor m => Functor (MockWeatherT m)
derive newtype instance applicativeMockWeatherT :: Applicative m => Applicative (MockWeatherT m)
derive newtype instance monadMockWeatherT :: Monad m => Monad (MockWeatherT m)
derive newtype instance applyMockWeatherT :: Apply m => Apply (MockWeatherT m)
derive newtype instance bindMockWeatherT :: Bind m => Bind (MockWeatherT m)
instance monadTransMockWeatherT :: MonadTrans MockWeatherT where
  lift = MockWeatherT 
instance monadEffMockWeatherT :: MonadEff eff m => MonadEff eff (MockWeatherT m) where
  liftEff = lift <<< liftEff
derive newtype instance monadAskMockWeatherT :: MonadAsk r m => MonadAsk r (MockWeatherT m)
instance monadStringAppendMockWeatherT :: MonadStringAppend m => MonadStringAppend (MockWeatherT m) where
  appendStr = lift <<< appendStr

instance myMonadMockWeatherT :: (Monad m, MonadEff e m) => MonadWeather (MockWeatherT m) where
  byCity val = pure $ WeatherData $ "It is sunny in " <> val


-- SomeApp.purs

someApp :: forall m. Monad m => MonadWeather m => MonadStringAppend m => m String
someApp = do
  appendStr " world"
  (WeatherData weather) <- byCity "Amsterdam"
  pure weather


-- Main.purs

type MyApp m a = StringAppendT (MockWeatherT m) a

runMyApp :: forall m a. StringAppendT (MockWeatherT m) a -> Ref String -> m a
runMyApp m ref = runMockWeatherT (runStringAppendT m ref)


main = render =<< withConsole do
  ref <- newRef "hello"
  s <- runMyApp (someApp *> someApp) ref
  r <- readRef ref
  log s
  log r