Created
September 9, 2022 14:01
-
-
Save nicolashery/ce5d627090553d8615d61f607078e778 to your computer and use it in GitHub Desktop.
Haskell ReaderT LoggingT - MonadBaseControl vs. MonadUnliftIO
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 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] |
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 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