Skip to content

Instantly share code, notes, and snippets.

@cideM
Last active June 11, 2019 16:04
Show Gist options
  • Save cideM/aa69df23cf8cb50295ed629f2432d6a6 to your computer and use it in GitHub Desktop.
Save cideM/aa69df23cf8cb50295ed629f2432d6a6 to your computer and use it in GitHub Desktop.
File that accompanies my blog post about unliftio-core
#!/usr/bin/env stack
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-
stack
script
--resolver lts-13.16
--package transformers
-}
import Control.Monad.IO.Class
import Control.Monad.Trans.Reader (ReaderT (..))
test :: (String -> IO ()) -> IO ()
test f = f "test"
test2 :: (String -> ReaderT env IO ()) -> ReaderT env IO ()
test2 f =
askUnliftIO
>>= \wrappedUnliftedThing ->
let unwrapped = unwrap wrappedUnliftedThing
in liftIO $ test (unwrapped . f)
where
unwrap :: UnliftIO m -> m a -> IO a
unwrap = unliftIO
myPrint :: String -> ReaderT String IO ()
myPrint string = ReaderT $ \env -> print $ env ++ " " ++ string
main :: IO ()
main = runReaderT (test2 myPrint) "Environment"
instance MonadUnliftIO IO where
askUnliftIO = return (UnliftIO id)
instance MonadUnliftIO m => MonadUnliftIO (ReaderT r m) where
askUnliftIO =
ReaderT $ \env ->
askUnliftIO >>= \unliftedIO
-> liftIO $
return (UnliftIO (unliftIO unliftedIO . flip runReaderT env))
newtype UnliftIO m = UnliftIO
{ unliftIO :: forall a. m a -> IO a
}
class MonadIO m =>
MonadUnliftIO m
where
askUnliftIO :: m (UnliftIO m)
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment