unliftio-core-0.2.1.0/src/0000755000000000000000000000000014370231514013404 5ustar0000000000000000unliftio-core-0.2.1.0/src/Control/0000755000000000000000000000000014370231514015024 5ustar0000000000000000unliftio-core-0.2.1.0/src/Control/Monad/0000755000000000000000000000000014370231514016062 5ustar0000000000000000unliftio-core-0.2.1.0/src/Control/Monad/IO/0000755000000000000000000000000014370231571016374 5ustar0000000000000000unliftio-core-0.2.1.0/src/Control/Monad/IO/Unlift.hs0000644000000000000000000001342114370231571020172 0ustar0000000000000000{-# LANGUAGE RankNTypes #-} -- | Please see the README.md file for information on using this -- package at . module Control.Monad.IO.Unlift ( MonadUnliftIO (..) , UnliftIO (..) , askUnliftIO , askRunInIO , withUnliftIO , toIO , wrappedWithRunInIO , liftIOOp , MonadIO (..) ) where import Control.Monad.IO.Class import Control.Monad.Trans.Reader (ReaderT (..)) import Control.Monad.Trans.Identity (IdentityT (..)) -- | The ability to run any monadic action @m a@ as @IO a@. -- -- This is more precisely a natural transformation. We need to new -- datatype (instead of simply using a @forall@) due to lack of -- support in GHC for impredicative types. -- -- @since 0.1.0.0 newtype UnliftIO m = UnliftIO { unliftIO :: forall a. m a -> IO a } -- | Monads which allow their actions to be run in 'IO'. -- -- While 'MonadIO' allows an 'IO' action to be lifted into another -- monad, this class captures the opposite concept: allowing you to -- capture the monadic context. Note that, in order to meet the laws -- given below, the intuition is that a monad must have no monadic -- state, but may have monadic context. This essentially limits -- 'MonadUnliftIO' to 'ReaderT' and 'IdentityT' transformers on top of -- 'IO'. -- -- Laws. For any function @run@ provided by 'withRunInIO', it must meet the -- monad transformer laws as reformulated for @MonadUnliftIO@: -- -- * @run . return = return@ -- -- * @run (m >>= f) = run m >>= run . f@ -- -- Instances of @MonadUnliftIO@ must also satisfy the following laws: -- -- [Identity law] @withRunInIO (\\run -> run m) = m@ -- [Inverse law] @withRunInIO (\\_ -> m) = liftIO m@ -- -- As an example of an invalid instance, a naive implementation of -- @MonadUnliftIO (StateT s m)@ might be -- -- @ -- withRunInIO inner = -- StateT $ \\s -> -- withRunInIO $ \\run -> -- inner (run . flip evalStateT s) -- @ -- -- This breaks the identity law because the inner @run m@ would throw away -- any state changes in @m@. -- -- @since 0.1.0.0 class MonadIO m => MonadUnliftIO m where -- | Convenience function for capturing the monadic context and running an 'IO' -- action with a runner function. The runner function is used to run a monadic -- action @m@ in @IO@. -- -- @since 0.1.0.0 withRunInIO :: ((forall a. m a -> IO a) -> IO b) -> m b instance MonadUnliftIO IO where {-# INLINE withRunInIO #-} withRunInIO inner = inner id instance MonadUnliftIO m => MonadUnliftIO (ReaderT r m) where {-# INLINE withRunInIO #-} withRunInIO inner = ReaderT $ \r -> withRunInIO $ \run -> inner (run . flip runReaderT r) instance MonadUnliftIO m => MonadUnliftIO (IdentityT m) where {-# INLINE withRunInIO #-} withRunInIO inner = IdentityT $ withRunInIO $ \run -> inner (run . runIdentityT) -- | Capture the current monadic context, providing the ability to -- run monadic actions in 'IO'. -- -- See 'UnliftIO' for an explanation of why we need a helper -- datatype here. -- -- Prior to version 0.2.0.0 of this library, this was a method in the -- 'MonadUnliftIO' type class. It was moved out due to -- . -- -- @since 0.1.0.0 askUnliftIO :: MonadUnliftIO m => m (UnliftIO m) askUnliftIO = withRunInIO (\run -> return (UnliftIO run)) {-# INLINE askUnliftIO #-} -- Would be better, but GHC hates us -- askUnliftIO :: m (forall a. m a -> IO a) -- | Same as 'askUnliftIO', but returns a monomorphic function -- instead of a polymorphic newtype wrapper. If you only need to apply -- the transformation on one concrete type, this function can be more -- convenient. -- -- @since 0.1.0.0 {-# INLINE askRunInIO #-} askRunInIO :: MonadUnliftIO m => m (m a -> IO a) -- withRunInIO return would be nice, but GHC 7.8.4 doesn't like it askRunInIO = withRunInIO (\run -> (return (\ma -> run ma))) -- | Convenience function for capturing the monadic context and running -- an 'IO' action. The 'UnliftIO' newtype wrapper is rarely needed, so -- prefer 'withRunInIO' to this function. -- -- @since 0.1.0.0 {-# INLINE withUnliftIO #-} withUnliftIO :: MonadUnliftIO m => (UnliftIO m -> IO a) -> m a withUnliftIO inner = askUnliftIO >>= liftIO . inner -- | Convert an action in @m@ to an action in @IO@. -- -- @since 0.1.0.0 {-# INLINE toIO #-} toIO :: MonadUnliftIO m => m a -> m (IO a) toIO m = withRunInIO $ \run -> return $ run m {- | A helper function for implementing @MonadUnliftIO@ instances. Useful for the common case where you want to simply delegate to the underlying transformer. Note: You can derive 'MonadUnliftIO' for newtypes without this helper function in @unliftio-core@ 0.2.0.0 and later. @since 0.1.2.0 ==== __Example__ > newtype AppT m a = AppT { unAppT :: ReaderT Int (ResourceT m) a } > deriving (Functor, Applicative, Monad, MonadIO) > > -- Same as `deriving newtype (MonadUnliftIO)` > instance MonadUnliftIO m => MonadUnliftIO (AppT m) where > withRunInIO = wrappedWithRunInIO AppT unAppT -} {-# INLINE wrappedWithRunInIO #-} wrappedWithRunInIO :: MonadUnliftIO n => (n b -> m b) -- ^ The wrapper, for instance @IdentityT@. -> (forall a. m a -> n a) -- ^ The inverse, for instance @runIdentityT@. -> ((forall a. m a -> IO a) -> IO b) -- ^ The actual function to invoke 'withRunInIO' with. -> m b wrappedWithRunInIO wrap unwrap inner = wrap $ withRunInIO $ \run -> inner $ run . unwrap {- | A helper function for lifting @IO a -> IO b@ functions into any @MonadUnliftIO@. === __Example__ > liftedTry :: (Exception e, MonadUnliftIO m) => m a -> m (Either e a) > liftedTry m = liftIOOp Control.Exception.try m @since 0.2.1.0 -} liftIOOp :: MonadUnliftIO m => (IO a -> IO b) -> m a -> m b liftIOOp f x = do runInIO <- askRunInIO liftIO $ f $ runInIO x unliftio-core-0.2.1.0/LICENSE0000644000000000000000000000203714370231514013624 0ustar0000000000000000Copyright (c) 2017 FP Complete Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. unliftio-core-0.2.1.0/Setup.hs0000644000000000000000000000005614370231514014252 0ustar0000000000000000import Distribution.Simple main = defaultMain unliftio-core-0.2.1.0/unliftio-core.cabal0000644000000000000000000000167414370231573016375 0ustar0000000000000000cabal-version: 1.12 -- This file has been generated from package.yaml by hpack version 0.35.1. -- -- see: https://github.com/sol/hpack name: unliftio-core version: 0.2.1.0 synopsis: The MonadUnliftIO typeclass for unlifting monads to IO description: Please see the documentation and README at category: Control homepage: https://github.com/fpco/unliftio/tree/master/unliftio-core#readme author: Michael Snoyman, Francesco Mazzoli maintainer: michael@snoyman.com copyright: 2017-2020 FP Complete license: MIT license-file: LICENSE build-type: Simple extra-source-files: README.md ChangeLog.md library exposed-modules: Control.Monad.IO.Unlift other-modules: Paths_unliftio_core hs-source-dirs: src build-depends: base >=4.9 && <4.17 , transformers >=0.2 && <0.7 default-language: Haskell2010 unliftio-core-0.2.1.0/README.md0000644000000000000000000000045014370231514014073 0ustar0000000000000000# unliftio-core Provides the core `MonadUnliftIO` typeclass, instances for `base` and `transformers`, and basic utility functions. Typically, you'll want to use the [unliftio](https://www.stackage.org/package/unliftio) library, which provides more functionality (and a much better description). unliftio-core-0.2.1.0/ChangeLog.md0000644000000000000000000000141014370231571014765 0ustar0000000000000000# ChangeLog for unliftio-core ## 0.2.1.0 * Added `Control.Monad.IO.Unlift.liftIOOp` ## 0.2.0.2 * Widen `base` upperbound to `< 4.17` to support ghc-9.2. ## 0.2.0.1 * Remove faulty default implementation of `withRunInIO` [#56](https://github.com/fpco/unliftio/issues/56) ## 0.2.0.0 * Move `askUnliftIO` out of class [#55](https://github.com/fpco/unliftio/issues/55) ## 0.1.2.0 * Add `wrappedWithRunInIO`. ## 0.1.1.0 * Doc improvements. * Inline functions in `Control.Monad.IO.Unlift` module [#4](https://github.com/fpco/unliftio/pull/4). * Fully polymorphic `withRunInIO` [#12](https://github.com/fpco/unliftio/pull/12). * Move `withRunInIO` into the `MonadUnliftIO` typeclass itself[#13](https://github.com/fpco/unliftio/issues/13) ## 0.1.0.0 * Initial release.