Skip to content

Instantly share code, notes, and snippets.

@nicolashery
Created September 9, 2022 14:01
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
Star You must be signed in to star a gist
Embed
What would you like to do?
Haskell ReaderT LoggingT - MonadBaseControl vs. MonadUnliftIO
module AsyncMonadBaseControlExample where
import Blammo.Logging (LoggingT)
import Control.Concurrent.Async.Lifted.Safe (concurrently)
import Control.Monad.Base (MonadBase)
import Control.Monad.Reader (MonadIO, MonadReader, MonadTrans (lift), ReaderT)
import Control.Monad.Trans.Control (MonadBaseControl (liftBaseWith, restoreM), StM)
import Data.Text.Lazy qualified as TL
import Web.Scotty.Trans (ActionT, text)
data AppEnv = AppEnv
newtype App a = App
{ unApp :: ReaderT AppEnv (LoggingT IO) a
}
deriving (Functor, Applicative, Monad, MonadIO, MonadReader AppEnv, MonadBase IO)
-- Instance copied from:
-- https://stackoverflow.com/questions/28137838/creating-monadbasecontrol-instance-for-newtype
instance MonadBaseControl IO App where
type StM App a = a
liftBaseWith f = App $ liftBaseWith $ \runInBase -> f (runInBase . unApp)
restoreM = App . restoreM
executeTaskA :: App TL.Text
executeTaskA = undefined
executeTaskB :: App TL.Text
executeTaskB = undefined
exampleHandler :: ActionT TL.Text App ()
exampleHandler = do
-- ...
(resultA, resultB) <- lift $ concurrently executeTaskA executeTaskB
-- ...
text $ mconcat [resultA, "\n", resultB]
module AsyncMonadUnliftIOExample where
import Blammo.Logging (LoggingT)
import Control.Monad.Reader (MonadIO, MonadReader, MonadTrans (lift), ReaderT)
import Data.Text.Lazy qualified as TL
import UnliftIO (MonadUnliftIO)
import UnliftIO.Async (concurrently)
import Web.Scotty.Trans (ActionT, text)
data AppEnv = AppEnv
newtype App a = App
{ unApp :: ReaderT AppEnv (LoggingT IO) a
}
deriving (Functor, Applicative, Monad, MonadIO, MonadReader AppEnv, MonadUnliftIO)
executeTaskA :: App TL.Text
executeTaskA = undefined
executeTaskB :: App TL.Text
executeTaskB = undefined
exampleHandler :: ActionT TL.Text App ()
exampleHandler = do
-- ...
(resultA, resultB) <- lift $ concurrently executeTaskA executeTaskB
-- ...
text $ mconcat [resultA, "\n", resultB]
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment