packages feed

unliftio (empty) → 0.1.0.0

raw patch · 16 files changed

+1863/−0 lines, 16 filesdep +asyncdep +basedep +deepseqsetup-changed

Dependencies added: async, base, deepseq, directory, filepath, monad-logger, resourcet, transformers, unix, unliftio-core

Files

+ ChangeLog.md view
@@ -0,0 +1,3 @@+## 0.1.0.0++* Initial release
+ LICENSE view
@@ -0,0 +1,20 @@+Copyright (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.
+ README.md view
@@ -0,0 +1,373 @@+# unliftio++[![Travis Build Status](https://travis-ci.org/fpco/unliftio.svg?branch=master)](https://travis-ci.org/fpco/unliftio)+[![AppVeyor Build status](https://ci.appveyor.com/api/projects/status/sprg5nlyh0codcpv?svg=true)](https://ci.appveyor.com/project/snoyberg/unliftio)+++Provides the core `MonadUnliftIO` typeclass, a number of common+instances, and a collection of common functions working with it.  Not+sure what the `MonadUnliftIO` typeclass is all about? Read on!++__NOTE__ This library is young, and will likely undergo some serious changes+over time. It's also very lightly tested. That said: the core concept of+`MonadUnliftIO` has been refined for years and is pretty solid, and even though+the code here is lightly tested, the vast majority of it is simply apply+`withUnliftIO` to existing functionality. Caveat emptor and all that.++## Quickstart++* Replace imports like `Control.Exception` with+  `UnliftIO.Exception`. Yay, your `catch` and `finally` are more+  powerful and safer!+* Similar with `Control.Concurrent.Async` with `UnliftIO.Async`+* Or go all in and import `UnliftIO`+* Naming conflicts: let `unliftio` win+* Drop the deps on `monad-control`, `lifted-base`, and `exceptions`+* Compilation failures? You may have just avoided subtle runtime bugs++Sound like magic? It's not. Keep reading!++## Unlifting in 2 minutes++Let's say I have a function:++```haskell+readFile :: FilePath -> IO ByteString+```++But I'm writing code inside a function that uses `ReaderT Env IO`, not+just plain `IO`. How can I call my `readFile` function in that+context? One way is to manually unwrap the `ReaderT` data constructor:++```haskell+myReadFile :: FilePath -> ReaderT Env IO ByteString+myReadFile fp = ReaderT $ \_env -> readFile fp+```++But having to do this regularly is tedious, and ties our code to a+specific monad transformer stack. Instead, many of us would use+`MonadIO`:++```haskell+myReadFile :: MonadIO m => FilePath -> m ByteString+myReadFile = liftIO . readFile+```++But now let's play with a different function:++```haskell+withBinaryFile :: FilePath -> IOMode -> (Handle -> IO a) -> IO a+```++We want a function with signature:++```haskell+myWithBinaryFile+    :: FilePath+    -> IOMode+    -> (Handle -> ReaderT Env IO a)+    -> ReaderT Env IO a+```++If I squint hard enough, I can accomplish this directly with the+`ReaderT` constructor via:++```haskell+myWithBinaryFile fp mode inner =+  ReaderT $ \env -> withBinaryFile+    fp+    mode+    (\h -> runReaderT (inner h) env)+```++I dare you to try to and accomplish this with `MonadIO` and+`liftIO`. It simply can't be done. (If you're looking for the+technical reason, it's because `IO` appears in+[negative/argument position](https://www.fpcomplete.com/blog/2016/11/covariance-contravariance)+in `withBinaryFile`.)++However, with `MonadUnliftIO`, this is possible:++```haskell+import Control.Monad.IO.Unlift++myWithBinaryFile+    :: MonadUnliftIO m+    => FilePath+    -> IOMode+    -> (Handle -> m a)+    -> m a+myWithBinaryFile fp mode inner =+  withRunInIO $ \runInIO ->+  withBinaryFile+    fp+    mode+    (\h -> runInIO (inner h))+```++That's it, you now know the entire basis of this library.++## How common is this problem?++This pops up in a number of places. Some examples:++* Proper exception handling, with functions like `bracket`, `catch`,+  and `finally`+* Working with `MVar`s via `modifyMVar` and similar+* Using the `timeout` function+* Installing callback handlers (e.g., do you want to do+  [logging](https://www.stackage.org/package/monad-logger) in a signal+  handler?).++This also pops up when working with libraries which are monomorphic on+`IO`, even if they could be written more extensibly.++## Examples++Reading through the codebase here is likely the best example to see+how to use `MonadUnliftIO` in practice. And for many cases, you can+simply add the `MonadUnliftIO` constraint and then use the+pre-unlifted versions of functions (like+`UnliftIO.Exception.catch`). But ultimately, you'll probably want to+use the typeclass directly. Here are some simple examples. First: ome+typeclass instances:++```haskell+instance MonadUnliftIO IO where+  askUnliftIO = return (UnliftIO id)+instance MonadUnliftIO m => MonadUnliftIO (IdentityT m) where+  askUnliftIO = IdentityT $+                withUnliftIO $ \u ->+                return (UnliftIO (unliftIO u . runIdentityT))+instance MonadUnliftIO m => MonadUnliftIO (ReaderT r m) where+  askUnliftIO = ReaderT $ \r ->+                withUnliftIO $ \u ->+                return (UnliftIO (unliftIO u . flip runReaderT r))+```++Note that:++* The `IO` instance does not actually do any lifting or unlifting, and+  therefore it can use `id`+* `IdentityT` is essentially just wrapping/unwrapping its data+  constructor, and then recursively calling `withUnliftIO` on the+  underlying monad.+* `ReaderT` is just like `IdentityT`, but it captures the reader+  environment when starting.++Second, using `withRunInIO` to unlift a function:++```haskell+timeout :: MonadUnliftIO m => Int -> m a -> m (Maybe a)+timeout x y = withRunInIO $ \run -> System.Timeout.timeout x $ run y+```++This is a common pattern: use `withRunInIO` to capture a run function,+and then call the original function with the user-supplied arguments,+applying `run` as necessary.++Thirdly, using `askUnliftIO` directly when multiple types are needed:++```haskell+race :: MonadUnliftIO m => m a -> m b -> m (Either a b)+race a b = withUnliftIO $ \u -> A.race (unliftIO u a) (unliftIO u b)+```++This works just like `withRunIO`, except we use `unliftIO u` instead+of `run`, which is polymorphic. You _could_ get away with multiple+`withRunInIO` calls here instead, but this approach is idiomatic and+may be more performant (depending on optimizations).++And finally, a much more complex usage, when unlifting the `mask`+function. This function needs to unlift vaues to be passed into the+`restore` function, and then `liftIO` the result of the `restore`+function.++```haskell+mask :: MonadUnliftIO m => ((forall a. m a -> m a) -> m b) -> m b+mask f = withUnliftIO $ \u -> Control.Exception.mask $ \unmask ->+  unliftIO u $ f $ liftIO . unmask . unliftIO u+```++## Limitations++Not all monads which can be an instance of `MonadIO` can be instances+of `MonadUnliftIO`, due to the `MonadUnliftIO` laws (described in the+Haddocks for the typeclass). This prevents instances for a number of+classes of transformers:++* Transformers using continuations (e.g., `ContT`, `ConduitM`, `Pipe`)+* Transformers with some monadic state (e.g., `StateT`, `WriterT`)+* Transformers with multiple exit points (e.g., `ExceptT` and its ilk)++In fact, there are two specific classes of transformers that this+approach does work for:++* Transformers with no context at all (e.g., `IdentityT`, `NoLoggingT`)+* Transformers with a context but no state (e.g., `ReaderT`, `LoggingT`)++This may sound restrictive, but this restriction is fully+intentional. Trying to unlift actions in stateful monads leads to+unpredictable behavior. For a long and exhaustive example of this, see+[A Tale of Two Brackets](https://www.fpcomplete.com/blog/2017/06/tale-of-two-brackets),+which was a large motivation for writing this library.++## Comparison to other approaches++You may be thinking "Haven't I seen a way to do `catch` in `StateT`?"+You almost certainly have. Let's compare this approach with+alternatives. (For an older but more thorough rundown of the options,+see+[Exceptions and monad transformers](http://www.yesodweb.com/blog/2014/06/exceptions-transformers).)++There are really two approaches to this problem:++* Use a set of typeclasses for the specific functionality we care+  about. This is the approach taken by the `exceptions` package with+  `MonadThrow`, `MonadCatch`, and `MonadMask`. (Earlier approaches+  include `MonadCatchIO-mtl` and `MonadCatchIO-transformers`.)+* Define a generic typeclass that allows any control structure to be+  unlifted. This is the approach taken by the `monad-control`+  package. (Earlier approaches include `monad-peel` and `neither`.)++The first style gives extra functionality in allowing instances that+have nothing to do with runtime exceptions (e.g., a `MonadCatch`+instance for `Either`). This is arguably a good thing. The second+style gives extra functionality in allowing more operations to be+unlifted (like threading primitives, not supported by the `exceptions`+package).++Another distinction within the generic typeclass family is whether we+unlift to just `IO`, or to arbitrary base monads. For those familiar,+this is the distinction between the `MonadIO` and `MonadBase`+typeclasses.++This package's main objection to all of the above approaches is that+they work for too many monads, and provide difficult-to-predict+behavior for a number of them (arguably: plain wrong behavior). For+example, in `lifted-base` (built on top of `monad-control`), the+`finally` operation will discard mutated state coming from the cleanup+action, which is usually not what people expect. `exceptions` has+_different_ behavior here, which is arguably better. But we're arguing+here that we should disallow all such ambiguity at the type level.++So comparing to other approaches:++### monad-unlift++Throwing this one out there now: the `monad-unlift` library is built+on top of `monad-control`, and uses fairly sophisticated type level+features to restrict it to only the safe subset of monads. The same+approach is taken by `Control.Concurrent.Async.Lifted.Safe` in the+`lifted-async` package. Two problems with this:++* The complicated type level functionality can confuse GHC in some+  cases, making it difficult to get code to compile.+* We don't have an ecosystem of functions like `lifted-base` built on+  top of it, making it likely people will revert to the less safe+  cousin functions.++### monad-control++The main contention until now is that unlifting in a transformer like+`StateT` is unsafe. This is not universally true: if only one action+is being unlifted, no ambiguity exists. So, for example, `try :: IO a+-> IO (Either e a)` can safely be unlifted in `StateT`, while `finally+:: IO a -> IO b -> IO a` cannot.++`monad-control` allows us to unlift both styles. In theory, we could+write a variant of `lifted-base` that never does state discards, and+let `try` be more general than `finally`. In other words, this is an+advantage of `monad-control` over `MonadUnliftIO`. We've avoided+providing any such extra typeclass in this package though, for two+reasons:++* `MonadUnliftIO` is a simple typeclass, easy to explain. We don't+  want to complicated matters (`MonadBaseControl` is a notoriously+  difficult to understand typeclass)+* Having this kind of split would be confusing in user code, when+  suddenly `finally` is not available to us. We would rather encourage+  [good practices](https://www.fpcomplete.com/blog/2017/06/readert-design-pattern)+  from the beginning.++Another distinction is that `monad-control` uses the `MonadBase`+style, allowing unlifting to arbitrary base monads. In this package,+we've elected to go with `MonadIO` style. This limits what we can do+(e.g., no unlifting to `STM`), but we went this way because:++* In practice, we've found that the vast majority of cases are dealing+  with `IO`+* The split in the ecosystem between constraints like `MonadBase IO`+  and `MonadIO` leads to significant confusion, and `MonadIO` is by+  far the more common constraints (with the typeclass existing in+  `base`)++### exceptions++One thing we lose by leaving the `exceptions` approach is the ability+to model both pure and side-effecting (via `IO`) monads with a single+paradigm. For example, it can be pretty convenient to have+`MonadThrow` constraints for parsing functions, which will either+return an `Either` value or throw a runtime exception. That said,+there are detractors of that approach:++* You lose type information about which exception was thrown+* There is ambiguity about _how_ the exception was returned in a+  constraint like `(MonadIO m, MonadThrow m`)++The latter could be addressed by defining a law such as `throwM =+liftIO . throwIO`. However, we've decided in this library to go the+route of encouraging `Either` return values for pure functions, and+using runtime exceptions in `IO` otherwise. (You're of course free to+also return `IO (Either e a)`.)++By losing `MonadCatch`, we lose the ability to define a generic way to+catch exceptions in continuation based monads (such as+`ConduitM`). Our argument here is that those monads can freely provide+their own catching functions. And in practice, long before the+`MonadCatch` typeclass existed, `conduit` provided a `catchC`+function.++In exchange for the `MonadThrow` typeclass, we provide helper+functions to convert `Either` values to runtime exceptions in this+package. And the `MonadMask` typeclass is now replaced fully by+`MonadUnliftIO`, which like the `monad-control` case limits which+monads we can be working with.++## Async exception safety++The `safe-exceptions` package builds on top of the `exceptions`+package and provides intelligent behavior for dealing with+asynchronous exceptions, a common pitfall. This library provides a set+of exception handling functions with the same async exception behavior+as that library. You can consider this library a drop-in replacement+for `safe-exceptions`. In the future, we may reimplement+`safe-exceptions` to use `MonadUnliftIO` instead of `MonadCatch` and+`MonadMask`.++## Package split++The `unliftio-core` package provides just the typeclass with minimal+dependencies (just `base` and `transformers`). If you're writing a+library, we recommend depending on that package to provide your+instances. The `unliftio` package is a "batteries loaded" library+providing a plethora of pre-unlifted helper functions. It's a good+choice for importing, or even for use in a custom prelude.++## Orphans++The `unliftio` package currently provides orphan instances for types+from the `resourcet` and `monad-logger` packages. This is not intended+as a long-term solution; once `unliftio` is deemed more stable, the+plan is to move those instances into the respective libraries and+remove the dependency on them here.++If there are other temporary orphans that should be added, please+bring it up in the issue tracker or send a PR, but we'll need to be+selective about adding dependencies.++## Future questions++* Should we extend the set of functions exposed in `UnliftIO.IO` to include+  things like `hSeek`?+* Are there other libraries that deserve to be unlifted here?
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ src/UnliftIO.hs view
@@ -0,0 +1,25 @@+module UnliftIO+  ( module Control.Monad.IO.Unlift+  , module UnliftIO.Async+  , module UnliftIO.Chan+  , module UnliftIO.Exception+  , module UnliftIO.IO+  , module UnliftIO.IORef+  , module UnliftIO.Instances+  , module UnliftIO.MVar+  , module UnliftIO.Resource+  , module UnliftIO.Temporary+  , module UnliftIO.Timeout+  ) where++import Control.Monad.IO.Unlift+import UnliftIO.Async+import UnliftIO.Chan+import UnliftIO.Exception+import UnliftIO.IO+import UnliftIO.IORef+import UnliftIO.Instances+import UnliftIO.MVar+import UnliftIO.Resource+import UnliftIO.Temporary+import UnliftIO.Timeout
+ src/UnliftIO/Async.hs view
@@ -0,0 +1,350 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE RankNTypes #-}+-- | Unlifted "Control.Concurrent.Async"+--+-- @since 0.1.0.0+module UnliftIO.Async+  (+    -- * Asynchronous actions+    Async,+    -- ** Spawning+    async, asyncBound, asyncOn, asyncWithUnmask, asyncOnWithUnmask,++    -- ** Spawning with automatic 'cancel'ation+    withAsync, withAsyncBound, withAsyncOn, withAsyncWithUnmask,+    withAsyncOnWithUnmask,++    -- ** Querying 'Async's+    wait, poll, waitCatch, cancel, uninterruptibleCancel, cancelWith,+    A.asyncThreadId,++    -- ** STM operations+    A.waitSTM, A.pollSTM, A.waitCatchSTM,++    -- ** Waiting for multiple 'Async's+    waitAny, waitAnyCatch, waitAnyCancel, waitAnyCatchCancel,+    waitEither, waitEitherCatch, waitEitherCancel, waitEitherCatchCancel,+    waitEither_,+    waitBoth,++    -- ** Waiting for multiple 'Async's in STM+    A.waitAnySTM, A.waitAnyCatchSTM,+    A.waitEitherSTM, A.waitEitherCatchSTM,+    A.waitEitherSTM_,+    A.waitBothSTM,++    -- ** Linking+    link, link2,++    -- * Convenient utilities+    race, race_,+    concurrently, concurrently_,+    mapConcurrently, forConcurrently,+    mapConcurrently_, forConcurrently_,+    replicateConcurrently, replicateConcurrently_,+    Concurrently(..),+  ) where++import Control.Applicative+import Control.Concurrent.Async (Async)+import Control.Exception (SomeException, Exception)+import qualified UnliftIO.Exception as E+import qualified Control.Concurrent.Async as A+import Control.Concurrent (threadDelay)+import Control.Monad (forever, liftM)+import Control.Monad.IO.Unlift++#if MIN_VERSION_base(4,9,0)+import Data.Semigroup+#else+import Data.Monoid+import Data.Foldable (Foldable)+import Data.Traversable (Traversable)+#endif++-- | Unlift 'A.async'+--+-- @since 0.1.0.0+async :: MonadUnliftIO m => m a -> m (Async a)+async m = withRunInIO $ \run -> A.async $ run m++-- | Unlift 'A.asyncBound'+--+-- @since 0.1.0.0+asyncBound :: MonadUnliftIO m => m a -> m (Async a)+asyncBound m = withRunInIO $ \run -> A.asyncBound $ run m++-- | Unlift 'A.asyncOn'+--+-- @since 0.1.0.0+asyncOn :: MonadUnliftIO m => Int -> m a -> m (Async a)+asyncOn i m = withRunInIO $ \run -> A.asyncOn i $ run m++-- | Unlift 'A.asyncWithUnmask'+--+-- @since 0.1.0.0+asyncWithUnmask :: MonadUnliftIO m => ((forall b. m b -> m b) -> m a) -> m (Async a)+asyncWithUnmask m =+  withUnliftIO $ \u -> A.asyncWithUnmask $ \unmask -> unliftIO u $ m $ liftIO . unmask . unliftIO u++-- | Unlift 'A.asyncOnWithUnmask'+--+-- @since 0.1.0.0+asyncOnWithUnmask :: MonadUnliftIO m => Int -> ((forall b. m b -> m b) -> m a) -> m (Async a)+asyncOnWithUnmask i m =+  withUnliftIO $ \u -> A.asyncOnWithUnmask i $ \unmask -> unliftIO u $ m $ liftIO . unmask . unliftIO u++-- | Unlift 'A.withAsync'+--+-- @since 0.1.0.0+withAsync :: MonadUnliftIO m => m a -> (Async a -> m b) -> m b+withAsync a b = withUnliftIO $ \u -> A.withAsync (unliftIO u a) (unliftIO u . b)++-- | Unlift 'A.withAsyncBound'+--+-- @since 0.1.0.0+withAsyncBound :: MonadUnliftIO m => m a -> (Async a -> m b) -> m b+withAsyncBound a b = withUnliftIO $ \u -> A.withAsyncBound (unliftIO u a) (unliftIO u . b)++-- | Unlift 'A.withAsyncOn'+--+-- @since 0.1.0.0+withAsyncOn :: MonadUnliftIO m => Int -> m a -> (Async a -> m b) -> m b+withAsyncOn i a b = withUnliftIO $ \u -> A.withAsyncOn i (unliftIO u a) (unliftIO u . b)++-- | Unlift 'A.withAsyncWithUnmask'+--+-- @since 0.1.0.0+withAsyncWithUnmask+  :: MonadUnliftIO m+  => ((forall c. m c -> m c) -> m a)+  -> (Async a -> m b)+  -> m b+withAsyncWithUnmask a b =+  withUnliftIO $ \u -> A.withAsyncWithUnmask+    (\unmask -> unliftIO u $ a $ liftIO . unmask . unliftIO u)+    (unliftIO u . b)++-- | Unlift 'A.withAsyncOnWithMask'+--+-- @since 0.1.0.0+withAsyncOnWithUnmask+  :: MonadUnliftIO m+  => Int+  -> ((forall c. m c -> m c) -> m a)+  -> (Async a -> m b)+  -> m b+withAsyncOnWithUnmask i a b =+  withUnliftIO $ \u -> A.withAsyncOnWithUnmask i+    (\unmask -> unliftIO u $ a $ liftIO . unmask . unliftIO u)+    (unliftIO u . b)++-- | Lifted 'A.wait'+--+-- @since 0.1.0.0+wait :: MonadIO m => Async a -> m a+wait = liftIO . A.wait++-- | Lifted 'A.poll'+--+-- @since 0.1.0.0+poll :: MonadIO m => Async a -> m (Maybe (Either SomeException a))+poll = liftIO . A.poll++-- | Lifted 'A.waitCatch'+--+-- @since 0.1.0.0+waitCatch :: MonadIO m => Async a -> m (Either SomeException a)+waitCatch = liftIO . A.waitCatch++-- | Lifted 'A.cancel'+--+-- @since 0.1.0.0+cancel :: MonadIO m => Async a -> m ()+cancel = liftIO . A.cancel++-- | Lifted 'A.uninterruptibleCancel'+--+-- @since 0.1.0.0+uninterruptibleCancel :: MonadIO m => Async a -> m ()+uninterruptibleCancel = liftIO . A.uninterruptibleCancel++-- | Lifted 'A.cancelWith'. Additionally uses 'E.toAsyncException' to+-- ensure async exception safety.+--+-- @since 0.1.0.0+cancelWith :: (Exception e, MonadIO m) => Async a -> e -> m ()+cancelWith a e = liftIO (A.cancelWith a (E.toAsyncException e))++-- | Lifted 'A.waitAny'+--+-- @since 0.1.0.0+waitAny :: MonadIO m => [Async a] -> m (Async a, a)+waitAny = liftIO . A.waitAny++-- | Lifted 'A.waitAnyCatch'+--+-- @since 0.1.0.0+waitAnyCatch :: MonadIO m => [Async a] -> m (Async a, Either SomeException a)+waitAnyCatch = liftIO . A.waitAnyCatch++-- | Lifted 'A.waitAnyCancel'+--+-- @since 0.1.0.0+waitAnyCancel :: MonadIO m => [Async a] -> m (Async a, a)+waitAnyCancel = liftIO . A.waitAnyCancel++-- | Lifted 'A.waitAnyCatchCancel'+--+-- @since 0.1.0.0+waitAnyCatchCancel :: MonadIO m => [Async a] -> m (Async a, Either SomeException a)+waitAnyCatchCancel = liftIO . A.waitAnyCatchCancel++-- | Lifted 'A.waitEither'+--+-- @since 0.1.0.0+waitEither :: MonadIO m => Async a -> Async b -> m (Either a b)+waitEither a b = liftIO (A.waitEither a b)++-- | Lifted 'A.waitEitherCatch'+--+-- @since 0.1.0.0+waitEitherCatch :: MonadIO m => Async a -> Async b -> m (Either (Either SomeException a) (Either SomeException b))+waitEitherCatch a b = liftIO (A.waitEitherCatch a b)++-- | Lifted 'A.waitEitherCancel'+--+-- @since 0.1.0.0+waitEitherCancel :: MonadIO m => Async a -> Async b -> m (Either a b)+waitEitherCancel a b = liftIO (A.waitEitherCancel a b)++-- | Lifted 'A.waitEitherCatchCancel'+--+-- @since 0.1.0.0+waitEitherCatchCancel :: MonadIO m => Async a -> Async b -> m (Either (Either SomeException a) (Either SomeException b))+waitEitherCatchCancel a b = liftIO (A.waitEitherCatchCancel a b)++-- | Lifted 'A.waitEither_'+--+-- @since 0.1.0.0+waitEither_ :: MonadIO m => Async a -> Async b -> m ()+waitEither_ a b = liftIO (A.waitEither_ a b)++-- | Lifted 'A.waitBoth'+--+-- @since 0.1.0.0+waitBoth :: MonadIO m => Async a -> Async b -> m (a, b)+waitBoth a b = liftIO (A.waitBoth a b)++-- | Lifted 'A.link'+--+-- @since 0.1.0.0+link :: MonadIO m => Async a -> m ()+link = liftIO . A.link++-- | Lifted 'A.link2'+--+-- @since 0.1.0.0+link2 :: MonadIO m => Async a -> Async b -> m ()+link2 a b = liftIO (A.link2 a b)++-- | Unlifted 'A.race'+--+-- @since 0.1.0.0+race :: MonadUnliftIO m => m a -> m b -> m (Either a b)+race a b = withUnliftIO $ \u -> A.race (unliftIO u a) (unliftIO u b)++-- | Unlifted 'A.race_'+--+-- @since 0.1.0.0+race_ :: MonadUnliftIO m => m a -> m b -> m ()+race_ a b = withUnliftIO $ \u -> A.race_ (unliftIO u a) (unliftIO u b)++-- | Unlifted 'A.concurrently'+--+-- @since 0.1.0.0+concurrently :: MonadUnliftIO m => m a -> m b -> m (a, b)+concurrently a b = withUnliftIO $ \u -> A.concurrently (unliftIO u a) (unliftIO u b)++-- | Unlifted 'A.concurrently_'+--+-- @since 0.1.0.0+concurrently_ :: MonadUnliftIO m => m a -> m b -> m ()+concurrently_ a b = withUnliftIO $ \u -> A.concurrently_ (unliftIO u a) (unliftIO u b)++-- | Unlifted 'A.mapConcurrently'+--+-- @since 0.1.0.0+mapConcurrently :: MonadUnliftIO m => Traversable t => (a -> m b) -> t a -> m (t b)+mapConcurrently f t = withRunInIO $ \run -> A.mapConcurrently (run . f) t++-- | Unlifted 'A.forConcurrently'+--+-- @since 0.1.0.0+forConcurrently :: MonadUnliftIO m => Traversable t => t a -> (a -> m b) -> m (t b)+forConcurrently t f = withRunInIO $ \run -> A.forConcurrently t (run . f)++-- | Unlifted 'A.mapConcurrently_'+--+-- @since 0.1.0.0+mapConcurrently_ :: MonadUnliftIO m => Foldable f => (a -> m b) -> f a -> m ()+mapConcurrently_ f t = withRunInIO $ \run -> A.mapConcurrently_ (run . f) t++-- | Unlifted 'A.forConcurrently_'+--+-- @since 0.1.0.0+forConcurrently_ :: MonadUnliftIO m => Foldable f => f a -> (a -> m b) -> m ()+forConcurrently_ t f = withRunInIO $ \run -> A.forConcurrently_ t (run . f)++-- | Unlifted 'A.replicateConcurrently'+--+-- @since 0.1.0.0+replicateConcurrently :: MonadUnliftIO m => Int -> m a -> m [a]+replicateConcurrently i m = withRunInIO $ \run -> A.replicateConcurrently i (run m)++-- | Unlifted 'A.replicateConcurrently_'+--+-- @since 0.1.0.0+replicateConcurrently_ :: MonadUnliftIO m => Int -> m a -> m ()+replicateConcurrently_ i m = withRunInIO $ \run -> A.replicateConcurrently_ i (run m)++-- | Unlifted 'A.Concurrently'+--+-- @since 0.1.0.0+newtype Concurrently m a = Concurrently+  { runConcurrently :: m a+  }++-- | @since 0.1.0.0+instance Monad m => Functor (Concurrently m) where+  fmap f (Concurrently a) = Concurrently $ liftM f a++-- | @since 0.1.0.0+instance MonadUnliftIO m => Applicative (Concurrently m) where+  pure = Concurrently . return+  Concurrently fs <*> Concurrently as =+    Concurrently $ liftM (\(f, a) -> f a) (concurrently fs as)++-- | @since 0.1.0.0+instance MonadUnliftIO m => Alternative (Concurrently m) where+  empty = Concurrently $ liftIO (forever (threadDelay maxBound))+  Concurrently as <|> Concurrently bs =+    Concurrently $ liftM (either id id) (race as bs)++#if MIN_VERSION_base(4,9,0)+-- | Only defined by @async@ for @base >= 4.9@+--+-- @since 0.1.0.0+instance (MonadUnliftIO m, Semigroup a) => Semigroup (Concurrently m a) where+  (<>) = liftA2 (<>)++-- | @since 0.1.0.0+instance (Semigroup a, Monoid a, MonadUnliftIO m) => Monoid (Concurrently m a) where+  mempty = pure mempty+  mappend = (<>)+#else+-- | @since 0.1.0.0+instance (Monoid a, MonadUnliftIO m) => Monoid (Concurrently m a) where+  mempty = pure mempty+  mappend = liftA2 mappend+#endif
+ src/UnliftIO/Chan.hs view
@@ -0,0 +1,52 @@+-- | Lifted "Control.Concurrent.Chan"+--+-- @since 0.1.0.0+module UnliftIO.Chan+  ( Chan+  , newChan+  , writeChan+  , readChan+  , dupChan+  , getChanContents+  , writeList2Chan+  ) where++import Control.Monad.IO.Unlift+import Control.Concurrent.Chan (Chan)+import qualified Control.Concurrent.Chan as C++-- | Lifted 'C.newChan'+--+-- @since 0.1.0.0+newChan :: MonadIO m => m (Chan a)+newChan = liftIO C.newChan++-- | Lifted 'C.writeChan'+--+-- @since 0.1.0.0+writeChan :: Chan a -> a -> IO ()+writeChan c = liftIO . C.writeChan c++-- | Lifted 'C.readChan'+--+-- @since 0.1.0.0+readChan :: Chan a -> IO a+readChan = liftIO . C.readChan++-- | Lifted 'C.dupChan'+--+-- @since 0.1.0.0+dupChan :: Chan a -> IO (Chan a)+dupChan = liftIO . C.dupChan++-- | Lifted 'C.getChanContents'+--+-- @since 0.1.0.0+getChanContents :: Chan a -> IO [a]+getChanContents = liftIO . C.getChanContents++-- | Lifted 'C.writeList2Chan'+--+-- @since 0.1.0.0+writeList2Chan :: Chan a -> [a] -> IO ()+writeList2Chan c = liftIO . C.writeList2Chan c
+ src/UnliftIO/Exception.hs view
@@ -0,0 +1,565 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE ExistentialQuantification #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE ImplicitParams #-}+-- | Unlifted "Control.Exception", with extra async exception safety+-- and more helper functions.+module UnliftIO.Exception+  ( -- * Throwing+    throwIO+  , throwString+  , StringException (..)+  , stringException+  , throwTo+  , impureThrow+  , fromEither+  , fromEitherIO+  , fromEitherM+    -- * Catching (with recovery)+  , catch+  , catchIO+  , catchAny+  , catchDeep+  , catchAnyDeep+  , catchJust++  , handle+  , handleIO+  , handleAny+  , handleDeep+  , handleAnyDeep+  , handleJust++  , try+  , tryIO+  , tryAny+  , tryDeep+  , tryAnyDeep+  , tryJust++  , Handler(..)+  , catches+  , catchesDeep++    -- * Cleanup (no recovery)+  , onException+  , bracket+  , bracket_+  , finally+  , withException+  , bracketOnError+  , bracketOnError_++    -- * Coercion to sync and async+  , SyncExceptionWrapper (..)+  , toSyncException+  , AsyncExceptionWrapper (..)+  , toAsyncException++    -- * Check exception type+  , isSyncException+  , isAsyncException+    -- * Masking+  , mask+  , uninterruptibleMask+  , mask_+  , uninterruptibleMask_+    -- * Evaluation+  , evaluate+  , evaluateDeep+    -- * Reexports+  , Exception (..)+  , Typeable+  , SomeException (..)+  , SomeAsyncException (..)+  , IOException+  , EUnsafe.assert+#if !MIN_VERSION_base(4,8,0)+  , displayException+#endif+  ) where++import Control.Concurrent (ThreadId)+import Control.Monad (liftM)+import Control.Monad.IO.Unlift+import Control.Exception (Exception (..), SomeException (..), IOException, SomeAsyncException (..))+import qualified Control.Exception as EUnsafe+import Control.DeepSeq (NFData (..), ($!!))+import Data.Typeable (Typeable, cast)++#if MIN_VERSION_base(4,9,0)+import GHC.Stack (prettySrcLoc)+import GHC.Stack.Types (HasCallStack, CallStack, getCallStack)+#endif++-- | Unlifted 'EUnsafe.catch', but will not catch asynchronous exceptions+--+-- @since 0.1.0.0+catch :: (MonadUnliftIO m, Exception e) => m a -> (e -> m a) -> m a+catch f g = withUnliftIO $ \u -> unliftIO u f `EUnsafe.catch` \e ->+  if isSyncException e+    then unliftIO u (g e)+    -- intentionally rethrowing an async exception synchronously,+    -- since we want to preserve async behavior+    else EUnsafe.throwIO e++-- | 'catch' specialized to only catching 'IOException's+--+-- @since 0.1.0.0+catchIO :: MonadUnliftIO m => m a -> (IOException -> m a) -> m a+catchIO = catch++-- | 'catch' specialized to catch all synchronous exception+--+-- @since 0.1.0.0+catchAny :: MonadUnliftIO m => m a -> (SomeException -> m a) -> m a+catchAny = catch++-- | Same as 'catch', but fully force evaluation of the result value+-- to find all impure exceptions.+--+-- @since 0.1.0.0+catchDeep :: (MonadUnliftIO m, Exception e, NFData a)+          => m a -> (e -> m a) -> m a+catchDeep m = catch (m >>= evaluateDeep)++-- | 'catchDeep' specialized to catch all synchronous exception+--+-- @since 0.1.1.0+catchAnyDeep :: (NFData a, MonadUnliftIO m) => m a -> (SomeException -> m a) -> m a+catchAnyDeep = catchDeep++-- | 'catchJust' is like 'catch' but it takes an extra argument which+-- is an exception predicate, a function which selects which type of+-- exceptions we're interested in.+--+-- @since 0.1.0.0+catchJust :: (MonadUnliftIO m, Exception e) => (e -> Maybe b) -> m a -> (b -> m a) -> m a+catchJust f a b = a `catch` \e -> maybe (liftIO (throwIO e)) b $ f e++-- | Flipped version of 'catch'+--+-- @since 0.1.0.0+handle :: (MonadUnliftIO m, Exception e) => (e -> m a) -> m a -> m a+handle = flip catch++-- | 'C.handle' specialized to only catching 'IOException's+--+-- @since 0.1.0.0+handleIO :: MonadUnliftIO m => (IOException -> m a) -> m a -> m a+handleIO = handle++-- | Flipped version of 'catchAny'+--+-- @since 0.1.0.0+handleAny :: MonadUnliftIO m => (SomeException -> m a) -> m a -> m a+handleAny = handle++-- | Flipped version of 'catchDeep'+--+-- @since 0.1.1.0+handleDeep :: (MonadUnliftIO m, Exception e, NFData a) => (e -> m a) -> m a -> m a+handleDeep = flip catchDeep++-- | Flipped version of 'catchAnyDeep'+--+-- @since 0.1.0.0+handleAnyDeep :: (MonadUnliftIO m, NFData a) => (SomeException -> m a) -> m a -> m a+handleAnyDeep = flip catchAnyDeep++-- | Flipped 'catchJust'.+--+-- @since 0.1.0.0+handleJust :: (MonadUnliftIO m, Exception e) => (e -> Maybe b) -> (b -> m a) -> m a -> m a+handleJust f = flip (catchJust f)++-- | Unlifted 'EUnsafe.try', but will not catch asynchronous exceptions+--+-- @since 0.1.0.0+try :: (MonadUnliftIO m, Exception e) => m a -> m (Either e a)+try f = catch (liftM Right f) (return . Left)++-- | 'try' specialized to only catching 'IOException's+--+-- @since 0.1.0.0+tryIO :: MonadUnliftIO m => m a -> m (Either IOException a)+tryIO = try++-- | 'try' specialized to catch all synchronous exceptions+--+-- @since 0.1.0.0+tryAny :: MonadUnliftIO m => m a -> m (Either SomeException a)+tryAny = try++-- | Same as 'try', but fully force evaluation of the result value+-- to find all impure exceptions.+--+-- @since 0.1.0.0+tryDeep :: (MonadUnliftIO m, Exception e, NFData a) => m a -> m (Either e a)+tryDeep f = catch (liftM Right (f >>= evaluateDeep)) (return . Left)++-- | 'tryDeep' specialized to catch all synchronous exceptions+--+-- @since 0.1.1.0+tryAnyDeep :: (MonadUnliftIO m, NFData a) => m a -> m (Either SomeException a)+tryAnyDeep = tryDeep++-- | A variant of 'try' that takes an exception predicate to select+-- which exceptions are caught.+--+-- @since 0.1.0.0+tryJust :: (MonadUnliftIO m, Exception e) => (e -> Maybe b) -> m a -> m (Either b a)+tryJust f a = catch (Right `liftM` a) (\e -> maybe (throwIO e) (return . Left) (f e))++-- | Generalized version of 'EUnsafe.Handler'+--+-- @since 0.1.0.0+data Handler m a = forall e . Exception e => Handler (e -> m a)++-- | Internal+catchesHandler :: MonadIO m => [Handler m a] -> SomeException -> m a+catchesHandler handlers e = foldr tryHandler (liftIO (EUnsafe.throwIO e)) handlers+    where tryHandler (Handler handler) res+              = case fromException e of+                Just e' -> handler e'+                Nothing -> res++-- | Same as upstream 'EUnsafe.catches', but will not catch+-- asynchronous exceptions+--+-- @since 0.1.0.0+catches :: MonadUnliftIO m => m a -> [Handler m a] -> m a+catches io handlers = io `catch` catchesHandler handlers++-- | Same as 'catches', but fully force evaluation of the result value+-- to find all impure exceptions.+--+-- @since 0.1.0.0+catchesDeep :: (MonadUnliftIO m, NFData a) => m a -> [Handler m a] -> m a+catchesDeep io handlers = (io >>= evaluateDeep) `catch` catchesHandler handlers++-- | Lifted version of 'EUnsafe.evaluate'+evaluate :: MonadIO m => a -> m a+evaluate = liftIO . EUnsafe.evaluate++-- | Deeply evaluate a value using 'evaluate' and 'NFData'.+--+-- @since 0.1.0.0+evaluateDeep :: (MonadIO m, NFData a) => a -> m a+evaluateDeep = (evaluate $!!)++-- | Async safe version of 'EUnsafe.bracket'+--+-- @since 0.1.0.0+bracket :: MonadUnliftIO m => m a -> (a -> m b) -> (a -> m c) -> m c+bracket before after thing = withUnliftIO $ \u -> EUnsafe.mask $ \restore -> do+  x <- unliftIO u before+  res1 <- EUnsafe.try $ restore $ unliftIO u $ thing x+  case res1 of+    Left (e1 :: SomeException) -> do+      -- explicitly ignore exceptions from after. We know that+      -- no async exceptions were thrown there, so therefore+      -- the stronger exception must come from thing+      --+      -- https://github.com/fpco/safe-exceptions/issues/2+      _ :: Either SomeException b <-+          EUnsafe.try $ EUnsafe.uninterruptibleMask_ $ unliftIO u $ after x+      EUnsafe.throwIO e1+    Right y -> do+      _ <- EUnsafe.uninterruptibleMask_ $ unliftIO u $ after x+      return y++-- | Async safe version of 'EUnsafe.bracket_'+--+-- @since 0.1.0.0+bracket_ :: MonadUnliftIO m => m a -> m b -> m c -> m c+bracket_ before after thing = bracket before (const after) (const thing)++-- | Async safe version of 'EUnsafe.bracketOnError'+--+-- @since 0.1.0.0+bracketOnError :: MonadUnliftIO m => m a -> (a -> m b) -> (a -> m c) -> m c+bracketOnError before after thing = withUnliftIO $ \u -> EUnsafe.mask $ \restore -> do+  x <- unliftIO u before+  res1 <- EUnsafe.try $ restore $ unliftIO u $ thing x+  case res1 of+    Left (e1 :: SomeException) -> do+      -- ignore the exception, see bracket for explanation+      _ :: Either SomeException b <-+        EUnsafe.try $ EUnsafe.uninterruptibleMask_ $ unliftIO u $ after x+      EUnsafe.throwIO e1+    Right y -> return y++-- | A variant of 'bracketOnError' where the return value from the first+-- computation is not required.+--+-- @since 0.1.0.0+bracketOnError_ :: MonadUnliftIO m => m a -> m b -> m c -> m c+bracketOnError_ before after thing = bracketOnError before (const after) (const thing)++-- | Async safe version of 'EUnsafe.finally'+--+-- @since 0.1.0.0+finally :: MonadUnliftIO m => m a -> m b -> m a+finally thing after = withUnliftIO $ \u -> EUnsafe.uninterruptibleMask $ \restore -> do+  res1 <- EUnsafe.try $ restore $ unliftIO u thing+  case res1 of+    Left (e1 :: SomeException) -> do+      -- see bracket for explanation+      _ :: Either SomeException b <- EUnsafe.try $ unliftIO u after+      EUnsafe.throwIO e1+    Right x -> do+      _ <- unliftIO u after+      return x++-- | Like 'onException', but provides the handler the thrown+-- exception.+--+-- @since 0.1.0.0+withException :: (MonadUnliftIO m, Exception e)+              => m a -> (e -> m b) -> m a+withException thing after = withUnliftIO $ \u -> EUnsafe.uninterruptibleMask $ \restore -> do+    res1 <- EUnsafe.try $ restore $ unliftIO u thing+    case res1 of+        Left e1 -> do+            -- see explanation in bracket+            _ :: Either SomeException b <- EUnsafe.try $ unliftIO u $ after e1+            EUnsafe.throwIO e1+        Right x -> return x++-- | Async safe version of 'EUnsafe.onException'+--+-- @since 0.1.0.0+onException :: MonadUnliftIO m => m a -> m b -> m a+onException thing after = withException thing (\(_ :: SomeException) -> after)++-- | Synchronously throw the given exception+--+-- @since 0.1.0.0+throwIO :: (MonadIO m, Exception e) => e -> m a+throwIO = liftIO . EUnsafe.throwIO . toSyncException++-- | Wrap up an asynchronous exception to be treated as a synchronous+-- exception+--+-- This is intended to be created via 'toSyncException'+--+-- @since 0.1.0.0+data SyncExceptionWrapper = forall e. Exception e => SyncExceptionWrapper e+    deriving Typeable+instance Show SyncExceptionWrapper where+    show (SyncExceptionWrapper e) = show e+instance Exception SyncExceptionWrapper where+#if MIN_VERSION_base(4,8,0)+    displayException (SyncExceptionWrapper e) = displayException e+#endif++-- | Convert an exception into a synchronous exception+--+-- For synchronous exceptions, this is the same as 'toException'.+-- For asynchronous exceptions, this will wrap up the exception with+-- 'SyncExceptionWrapper'+--+-- @since 0.1.0.0+toSyncException :: Exception e => e -> SomeException+toSyncException e =+    case fromException se of+        Just (SomeAsyncException _) -> toException (SyncExceptionWrapper e)+        Nothing -> se+  where+    se = toException e++-- | Wrap up a synchronous exception to be treated as an asynchronous+-- exception+--+-- This is intended to be created via 'toAsyncException'+--+-- @since 0.1.0.0+data AsyncExceptionWrapper = forall e. Exception e => AsyncExceptionWrapper e+    deriving Typeable+instance Show AsyncExceptionWrapper where+    show (AsyncExceptionWrapper e) = show e+instance Exception AsyncExceptionWrapper where+    toException = toException . SomeAsyncException+    fromException se = do+        SomeAsyncException e <- fromException se+        cast e+#if MIN_VERSION_base(4,8,0)+    displayException (AsyncExceptionWrapper e) = displayException e+#endif++-- | Convert an exception into an asynchronous exception+--+-- For asynchronous exceptions, this is the same as 'toException'.+-- For synchronous exceptions, this will wrap up the exception with+-- 'AsyncExceptionWrapper'+--+-- @since 0.1.0.0+toAsyncException :: Exception e => e -> SomeException+toAsyncException e =+    case fromException se of+        Just (SomeAsyncException _) -> se+        Nothing -> toException (AsyncExceptionWrapper e)+  where+    se = toException e++-- | Check if the given exception is synchronous+--+-- @since 0.1.0.0+isSyncException :: Exception e => e -> Bool+isSyncException e =+    case fromException (toException e) of+        Just (SomeAsyncException _) -> False+        Nothing -> True++-- | Check if the given exception is asynchronous+--+-- @since 0.1.0.0+isAsyncException :: Exception e => e -> Bool+isAsyncException = not . isSyncException+{-# INLINE isAsyncException #-}++#if !MIN_VERSION_base(4,8,0)+-- | A synonym for 'show', specialized to 'Exception' instances.+--+-- Starting with base 4.8, the 'Exception' typeclass has a method @displayException@, used for user-friendly display of exceptions. This function provides backwards compatibility for users on base 4.7 and earlier, so that anyone importing this module can simply use @displayException@.+--+-- @since 0.1.0.0+displayException :: Exception e => e -> String+displayException = show+#endif++-- | Unlifted version of 'EUnsafe.mask'+--+-- @since 0.1.0.0+mask :: MonadUnliftIO m => ((forall a. m a -> m a) -> m b) -> m b+mask f = withUnliftIO $ \u -> EUnsafe.mask $ \unmask ->+  unliftIO u $ f $ liftIO . unmask . unliftIO u++-- | Unlifted version of 'EUnsafe.uninterruptibleMask'+--+-- @since 0.1.0.0+uninterruptibleMask :: MonadUnliftIO m => ((forall a. m a -> m a) -> m b) -> m b+uninterruptibleMask f = withUnliftIO $ \u -> EUnsafe.uninterruptibleMask $ \unmask ->+  unliftIO u $ f $ liftIO . unmask . unliftIO u++-- | Unlifted version of 'EUnsafe.mask_'+--+-- @since 0.1.0.0+mask_ :: MonadUnliftIO m => m a -> m a+mask_ f = withRunInIO $ \run -> EUnsafe.mask_ (run f)++-- | Unlifted version of 'EUnsafe.uninterruptibleMask_'+--+-- @since 0.1.0.0+uninterruptibleMask_ :: MonadUnliftIO m => m a -> m a+uninterruptibleMask_ f = withRunInIO $ \run -> EUnsafe.uninterruptibleMask_ (run f)++-- | A convenience function for throwing a user error. This is useful+-- for cases where it would be too high a burden to define your own+-- exception type.+--+-- This throws an exception of type 'StringException'. When GHC+-- supports it (base 4.9 and GHC 8.0 and onward), it includes a call+-- stack.+--+-- @since 0.1.0.0+#if MIN_VERSION_base(4,9,0)+throwString :: (MonadIO m, HasCallStack) => String -> m a+throwString s = throwIO (StringException s ?callStack)+#else+throwString :: MonadIO m => String -> m a+throwString s = throwIO (StringException s ())+#endif++-- | Smart constructor for a 'StringException' that deals with the+-- call stack.+--+-- @since 0.1.0.0+#if MIN_VERSION_base(4,9,0)+stringException :: HasCallStack => String -> StringException+stringException s = StringException s ?callStack+#else+stringException :: String -> StringException+stringException s = StringException s ()+#endif++-- | Exception type thrown by 'throwString'.+--+-- Note that the second field of the data constructor depends on+-- GHC/base version. For base 4.9 and GHC 8.0 and later, the second+-- field is a call stack. Previous versions of GHC and base do not+-- support call stacks, and the field is simply unit (provided to make+-- pattern matching across GHC versions easier).+--+-- @since 0.1.5.0+#if MIN_VERSION_base(4,9,0)+data StringException = StringException String CallStack+  deriving Typeable++instance Show StringException where+    show (StringException s cs) = concat+        $ "Control.Exception.Safe.throwString called with:\n\n"+        : s+        : "\nCalled from:\n"+        : map go (getCallStack cs)+      where+        go (x, y) = concat+          [ "  "+          , x+          , " ("+          , prettySrcLoc y+          , ")\n"+          ]+#else+data StringException = StringException String ()+  deriving Typeable++instance Show StringException where+    show (StringException s _) = "Control.Exception.Safe.throwString called with:\n\n" ++ s+#endif+instance Exception StringException++-- | Throw an asynchronous exception to another thread.+--+-- Synchronously typed exceptions will be wrapped into an+-- `AsyncExceptionWrapper`, see+-- <https://github.com/fpco/safe-exceptions#determining-sync-vs-async>+--+-- It's usually a better idea to use the async package, see+-- <https://github.com/fpco/safe-exceptions#quickstart>+--+-- @since 0.1.0.0+throwTo :: (Exception e, MonadIO m) => ThreadId -> e -> m ()+throwTo tid = liftIO . EUnsafe.throwTo tid . toAsyncException++-- | Generate a pure value which, when forced, will synchronously+-- throw the given exception+--+-- Generally it's better to avoid using this function and instead use 'throw',+-- see <https://github.com/fpco/safe-exceptions#quickstart>+--+-- @since 0.1.0.0+impureThrow :: Exception e => e -> a+impureThrow = EUnsafe.throw . toSyncException++-- | Unwrap an 'Either' value, throwing its 'Left' value as a runtime+-- exception via 'throwIO' if present.+--+-- @since 0.1.0.0+fromEither :: (Exception e, MonadIO m) => Either e a -> m a+fromEither = either throwIO return++-- | Same as 'fromEither', but works on an 'IO'-wrapped 'Either'.+--+-- @since 0.1.0.0+fromEitherIO :: (Exception e, MonadIO m) => IO (Either e a) -> m a+fromEitherIO = fromEitherM . liftIO++-- | Same as 'fromEither', but works on an 'm'-wrapped 'Either'.+--+-- @since 0.1.0.0+fromEitherM :: (Exception e, MonadIO m) => m (Either e a) -> m a+fromEitherM = (>>= fromEither)
+ src/UnliftIO/IO.hs view
@@ -0,0 +1,21 @@+-- | Unlifted "System.IO"+--+-- @since 0.1.0.0+module UnliftIO.IO+  ( IOMode (..)+  , Handle+  , withFile+  , withBinaryFile+  ) where++import qualified System.IO as IO+import System.IO (Handle, IOMode (..))+import Control.Monad.IO.Unlift++-- | @since 0.1.0.0+withFile :: MonadUnliftIO m => FilePath -> IOMode -> (Handle -> m a) -> m a+withFile fp mode inner = withRunInIO $ \run -> IO.withFile fp mode $ run . inner++-- | @since 0.1.0.0+withBinaryFile :: MonadUnliftIO m => FilePath -> IOMode -> (Handle -> m a) -> m a+withBinaryFile fp mode inner = withRunInIO $ \run -> IO.withBinaryFile fp mode $ run . inner
+ src/UnliftIO/IORef.hs view
@@ -0,0 +1,74 @@+-- | Unlifted "Data.IORef"+--+-- @since 0.1.0.0+module UnliftIO.IORef+  ( IORef+  , newIORef+  , readIORef+  , writeIORef+  , modifyIORef+  , modifyIORef'+  , atomicModifyIORef+  , atomicModifyIORef'+  , atomicWriteIORef+  , mkWeakIORef+  ) where++import Data.IORef (IORef)+import qualified Data.IORef as I+import Control.Monad.IO.Unlift+import System.Mem.Weak (Weak)++-- | Lifted 'I.newIORef'+--+-- @since 0.1.0.0+newIORef :: MonadIO m => a -> m (IORef a)+newIORef = liftIO . I.newIORef++-- | Lifted 'I.readIORef'+--+-- @since 0.1.0.0+readIORef :: MonadIO m => IORef a -> m a+readIORef = liftIO . I.readIORef++-- | Lifted 'I.writeIORef'+--+-- @since 0.1.0.0+writeIORef :: MonadIO m => IORef a -> a -> m ()+writeIORef ref = liftIO . I.writeIORef ref++-- | Lifted 'I.modifyIORef'+--+-- @since 0.1.0.0+modifyIORef :: MonadIO m => IORef a -> (a -> a) -> m ()+modifyIORef ref = liftIO . I.modifyIORef ref++-- | Lifted 'I.modifyIORef''+--+-- @since 0.1.0.0+modifyIORef' :: MonadIO m => IORef a -> (a -> a) -> m ()+modifyIORef' ref = liftIO . I.modifyIORef' ref++-- | Lifted 'I.atomicModifyIORef'+--+-- @since 0.1.0.0+atomicModifyIORef :: MonadIO m => IORef a -> (a -> (a, b)) -> m b+atomicModifyIORef ref = liftIO . I.atomicModifyIORef ref++-- | Lifted 'I.atomicModifyIORef''+--+-- @since 0.1.0.0+atomicModifyIORef' :: MonadIO m => IORef a -> (a -> (a, b)) -> m b+atomicModifyIORef' ref = liftIO . I.atomicModifyIORef' ref++-- | Lifted 'I.atomicWriteIORef'+--+-- @since 0.1.0.0+atomicWriteIORef :: MonadIO m => IORef a -> a -> m ()+atomicWriteIORef ref = liftIO . I.atomicWriteIORef ref++-- | Unlifted 'I.mkWeakIORef'+--+-- @since 0.1.0.0+mkWeakIORef :: MonadUnliftIO m => IORef a -> m () -> m (Weak (IORef a))+mkWeakIORef ref final = withRunInIO $ \run -> I.mkWeakIORef ref (run final)
+ src/UnliftIO/Instances.hs view
@@ -0,0 +1,21 @@+-- | Orphans instances+--+-- @since 0.1.0.0+module UnliftIO.Instances () where++import Control.Monad.IO.Unlift+import Control.Monad.Logger (LoggingT (..), NoLoggingT (..)) -- FIXME move these instances into monad-logger+import Control.Monad.Trans.Resource.Internal (ResourceT (..))++instance MonadUnliftIO m => MonadUnliftIO (LoggingT m) where+  askUnliftIO = LoggingT $ \f ->+                withUnliftIO $ \u ->+                return (UnliftIO (unliftIO u . flip runLoggingT f))+instance MonadUnliftIO m => MonadUnliftIO (NoLoggingT m) where+  askUnliftIO = NoLoggingT $+                withUnliftIO $ \u ->+                return (UnliftIO (unliftIO u . runNoLoggingT))+instance MonadUnliftIO m => MonadUnliftIO (ResourceT m) where+  askUnliftIO = ResourceT $ \r ->+                withUnliftIO $ \u ->+                return (UnliftIO (unliftIO u . flip unResourceT r))
+ src/UnliftIO/MVar.hs view
@@ -0,0 +1,130 @@+-- | Unlifted "Control.Concurrent.MVar"+--+-- @since 0.1.0.0+module UnliftIO.MVar+  ( MVar+  , newEmptyMVar+  , newMVar+  , takeMVar+  , putMVar+  , readMVar+  , swapMVar+  , tryTakeMVar+  , tryPutMVar+  , isEmptyMVar+  , withMVar+  , withMVarMasked+  , modifyMVar+  , modifyMVar_+  , modifyMVarMasked+  , modifyMVarMasked_+  , tryReadMVar+  , mkWeakMVar+  ) where++import System.Mem.Weak (Weak)+import Control.Concurrent.MVar (MVar)+import Control.Monad.IO.Unlift+import qualified Control.Concurrent.MVar as M++-- | Lifted 'M.newEmptyMVar'+--+-- @since 0.1.0.0+newEmptyMVar :: MonadIO m => m (MVar a)+newEmptyMVar = liftIO M.newEmptyMVar++-- | Lifted 'M.newMVar'+--+-- @since 0.1.0.0+newMVar :: MonadIO m => a -> m (MVar a)+newMVar = liftIO . M.newMVar++-- | Lifted 'M.takeMVar'+--+-- @since 0.1.0.0+takeMVar :: MonadIO m => MVar a -> m a+takeMVar = liftIO . M.takeMVar++-- | Lifted 'M.putMVar'+--+-- @since 0.1.0.0+putMVar :: MonadIO m => MVar a -> a -> m ()+putMVar var = liftIO . M.putMVar var++-- | Lifted 'M.readMVar'+--+-- @since 0.1.0.0+readMVar :: MonadIO m => MVar a -> m a+readMVar = liftIO . M.readMVar++-- | Lifted 'M.swapMVar'+--+-- @since 0.1.0.0+swapMVar :: MonadIO m => MVar a -> a -> m a+swapMVar var = liftIO . M.swapMVar var++-- | Lifted 'M.tryTakeMVar'+--+-- @since 0.1.0.0+tryTakeMVar :: MonadIO m => MVar a -> m (Maybe a)+tryTakeMVar = liftIO . M.tryTakeMVar++-- | Lifted 'M.tryPutMVar'+--+-- @since 0.1.0.0+tryPutMVar :: MonadIO m => MVar a -> a -> m Bool+tryPutMVar var = liftIO . M.tryPutMVar var++-- | Lifted 'M.isEmptyMVar'+--+-- @since 0.1.0.0+isEmptyMVar :: MonadIO m => MVar a -> m Bool+isEmptyMVar = liftIO . M.isEmptyMVar++-- | Lifted 'M.tryReadMVar'+--+-- @since 0.1.0.0+tryReadMVar :: MonadIO m => MVar a -> m (Maybe a)+tryReadMVar = liftIO . M.tryReadMVar++-- | Unlifted 'M.withMVar'+--+-- @since 0.1.0.0+withMVar :: MonadUnliftIO m => MVar a -> (a -> m b) -> m b+withMVar var f = withRunInIO $ \run -> M.withMVar var (run . f)++-- | Unlifted 'M.withMVarMasked'+--+-- @since 0.1.0.0+withMVarMasked :: MonadUnliftIO m => MVar a -> (a -> m b) -> m b+withMVarMasked var f = withRunInIO $ \run -> M.withMVarMasked var (run . f)++-- | Unlifted 'M.modifyMVar_'+--+-- @since 0.1.0.0+modifyMVar_ :: MonadUnliftIO m => MVar a -> (a -> m a) -> m ()+modifyMVar_ var f = withRunInIO $ \run -> M.modifyMVar_ var (run . f)++-- | Unlifted 'M.modifyMVar'+--+-- @since 0.1.0.0+modifyMVar :: MonadUnliftIO m => MVar a -> (a -> m (a, b)) -> m b+modifyMVar var f = withRunInIO $ \run -> M.modifyMVar var (run . f)++-- | Unlifted 'M.modifyMVarMasked_'+--+-- @since 0.1.0.0+modifyMVarMasked_ :: MonadUnliftIO m => MVar a -> (a -> m a) -> m ()+modifyMVarMasked_ var f = withRunInIO $ \run -> M.modifyMVarMasked_ var (run . f)++-- | Unlifted 'M.modifyMVarMasked'+--+-- @since 0.1.0.0+modifyMVarMasked :: MonadUnliftIO m => MVar a -> (a -> m (a, b)) -> m b+modifyMVarMasked var f = withRunInIO $ \run -> M.modifyMVarMasked var (run . f)++-- | Unlifted 'M.mkWeakMVar'+--+-- @since 0.1.0.0+mkWeakMVar :: MonadUnliftIO m => MVar a -> m () -> m (Weak (MVar a))+mkWeakMVar var f = withRunInIO $ \run -> M.mkWeakMVar var (run f)
+ src/UnliftIO/Resource.hs view
@@ -0,0 +1,24 @@+-- | Unlifted "Control.Monad.Trans.Resource"+--+-- @since 0.1.0.0+module UnliftIO.Resource+  ( ResourceT+  , runResourceT+  , liftResourceT+  -- FIXME add relevant reexports+  ) where++-- FIXME consider moving this module into resourcet package itself++import qualified Control.Monad.Trans.Resource as Res+import Control.Monad.Trans.Resource.Internal (ResourceT (..))+import Control.Monad.IO.Unlift+import UnliftIO.Instances ()++-- | @since 0.1.0.0+runResourceT :: MonadUnliftIO m => ResourceT m a -> m a+runResourceT m = withRunInIO $ \run -> Res.runResourceT $ Res.transResourceT run m++-- | @since 0.1.0.0+liftResourceT :: MonadIO m => ResourceT IO a -> Res.ResourceT m a+liftResourceT (ResourceT f) = ResourceT $ liftIO . f
+ src/UnliftIO/Temporary.hs view
@@ -0,0 +1,135 @@+{-# LANGUAgE CPP #-}+-- | Temporary file and directory support+--+-- Strongly inspired by/stolen from the temporary package+--+-- @since 0.1.0.0+module UnliftIO.Temporary+  ( withSystemTempFile+  , withSystemTempDirectory+  , withTempFile+  , withTempDirectory+  ) where++import Control.Monad.IO.Unlift+import Control.Monad (liftM)+import UnliftIO.Exception+import System.Directory+import System.IO (Handle, openTempFile, hClose)+import System.IO.Error+import System.Posix.Internals (c_getpid)+import System.FilePath ((</>))++#ifdef mingw32_HOST_OS+import System.Directory       ( createDirectory )+#else+import qualified System.Posix+#endif++-- | Create and use a temporary file in the system standard temporary directory.+--+-- Behaves exactly the same as 'withTempFile', except that the parent temporary directory+-- will be that returned by 'getCanonicalTemporaryDirectory'.+--+-- @since 0.1.0.0+withSystemTempFile :: MonadUnliftIO m =>+                      String   -- ^ File name template. See 'openTempFile'.+                   -> (FilePath -> Handle -> m a) -- ^ Callback that can use the file+                   -> m a+withSystemTempFile template action = liftIO getCanonicalTemporaryDirectory >>= \tmpDir -> withTempFile tmpDir template action++-- | Create and use a temporary directory in the system standard temporary directory.+--+-- Behaves exactly the same as 'withTempDirectory', except that the parent temporary directory+-- will be that returned by 'getCanonicalTemporaryDirectory'.+--+-- @since 0.1.0.0+withSystemTempDirectory :: MonadUnliftIO m =>+                           String   -- ^ Directory name template. See 'openTempFile'.+                        -> (FilePath -> m a) -- ^ Callback that can use the directory+                        -> m a+withSystemTempDirectory template action = liftIO getCanonicalTemporaryDirectory >>= \tmpDir -> withTempDirectory tmpDir template action+++-- | Use a temporary filename that doesn't already exist.+--+-- Creates a new temporary file inside the given directory, making use of the+-- template. The temp file is deleted after use. For example:+--+-- > withTempFile "src" "sdist." $ \tmpFile hFile -> do ...+--+-- The @tmpFile@ will be file in the given directory, e.g.+-- @src/sdist.342@.+--+-- @since 0.1.0.0+withTempFile :: MonadUnliftIO m =>+                FilePath -- ^ Temp dir to create the file in+             -> String   -- ^ File name template. See 'openTempFile'.+             -> (FilePath -> Handle -> m a) -- ^ Callback that can use the file+             -> m a+withTempFile tmpDir template action =+  bracket+    (liftIO (openTempFile tmpDir template))+    (\(name, handle) -> liftIO (hClose handle >> ignoringIOErrors (removeFile name)))+    (uncurry action)++-- | Create and use a temporary directory.+--+-- Creates a new temporary directory inside the given directory, making use+-- of the template. The temp directory is deleted after use. For example:+--+-- > withTempDirectory "src" "sdist." $ \tmpDir -> do ...+--+-- The @tmpDir@ will be a new subdirectory of the given directory, e.g.+-- @src/sdist.342@.+--+-- @since 0.1.0.0+withTempDirectory :: MonadUnliftIO m =>+                     FilePath -- ^ Temp directory to create the directory in+                  -> String   -- ^ Directory name template. See 'openTempFile'.+                  -> (FilePath -> m a) -- ^ Callback that can use the directory+                  -> m a+withTempDirectory targetDir template =+  bracket+    (liftIO (createTempDirectory targetDir template))+    (liftIO . ignoringIOErrors . removeDirectoryRecursive)++-- | Return the absolute and canonical path to the system temporary+-- directory.+--+-- >>> setCurrentDirectory "/home/feuerbach/"+-- >>> setEnv "TMPDIR" "."+-- >>> getTemporaryDirectory+-- "."+-- >>> getCanonicalTemporaryDirectory+-- "/home/feuerbach"+getCanonicalTemporaryDirectory :: IO FilePath+getCanonicalTemporaryDirectory = getTemporaryDirectory >>= canonicalizePath++-- | Create a temporary directory. See 'withTempDirectory'.+createTempDirectory+  :: FilePath -- ^ Temp directory to create the directory in+  -> String -- ^ Directory name template+  -> IO FilePath+createTempDirectory dir template = do+  pid <- c_getpid+  findTempName pid+  where+    findTempName x = do+      let dirpath = dir </> template ++ show x+      r <- try $ mkPrivateDir dirpath+      case r of+        Right _ -> return dirpath+        Left  e | isAlreadyExistsError e -> findTempName (x+1)+                | otherwise              -> ioError e+++mkPrivateDir :: String -> IO ()+#ifdef mingw32_HOST_OS+mkPrivateDir s = createDirectory s+#else+mkPrivateDir s = System.Posix.createDirectory s 0o700+#endif++ignoringIOErrors :: MonadUnliftIO m => m () -> m ()+ignoringIOErrors = liftM (const ()) . tryIO -- yes, it's just void, but for pre-AMP GHCs
+ src/UnliftIO/Timeout.hs view
@@ -0,0 +1,15 @@+-- | Unlifted "System.Timeout"+--+-- @since 0.1.0.0+module UnliftIO.Timeout+  ( timeout+  ) where++import qualified System.Timeout as S+import Control.Monad.IO.Unlift++-- | Unlifted 'S.timeout'+--+-- @since 0.1.0.0+timeout :: MonadUnliftIO m => Int -> m a -> m (Maybe a)+timeout x y = withRunInIO $ \run -> S.timeout x $ run y
+ unliftio.cabal view
@@ -0,0 +1,53 @@+-- This file has been generated from package.yaml by hpack version 0.17.0.+--+-- see: https://github.com/sol/hpack++name:           unliftio+version:        0.1.0.0+synopsis:       The MonadUnliftIO typeclass for unlifting monads to IO (batteries included)+description:    Please see the README.md file for details+category:       Control+homepage:       https://github.com/fpco/monad-unlift/tree/master/unliftio#readme+author:         Michael Snoyman, Francesco Mazzoli+maintainer:     michael@snoyman.com+copyright:      2017 FP Complete+license:        MIT+license-file:   LICENSE+build-type:     Simple+cabal-version:  >= 1.10++extra-source-files:+    ChangeLog.md+    README.md++library+  hs-source-dirs:+      src+  build-depends:+      base >= 4.7 && < 5+    , async > 2.1.1+    , deepseq+    , directory+    , filepath+    , monad-logger+    , resourcet+    , transformers+    , unliftio-core+  if !os(Windows)+    build-depends:+        unix+  exposed-modules:+      UnliftIO+      UnliftIO.Async+      UnliftIO.Chan+      UnliftIO.Exception+      UnliftIO.IO+      UnliftIO.IORef+      UnliftIO.Instances+      UnliftIO.MVar+      UnliftIO.Resource+      UnliftIO.Temporary+      UnliftIO.Timeout+  other-modules:+      Paths_unliftio+  default-language: Haskell2010