unliftio-0.1.1.0/src/0000755000000000000000000000000013131436235012456 5ustar0000000000000000unliftio-0.1.1.0/src/UnliftIO/0000755000000000000000000000000013170602466014153 5ustar0000000000000000unliftio-0.1.1.0/src/UnliftIO.hs0000644000000000000000000000112513131436235014502 0ustar0000000000000000module 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 unliftio-0.1.1.0/src/UnliftIO/Async.hs0000644000000000000000000002362713170602466015576 0ustar0000000000000000{-# 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 -- | Unlifted 'A.async'. -- -- @since 0.1.0.0 async :: MonadUnliftIO m => m a -> m (Async a) async m = withRunInIO $ \run -> A.async $ run m -- | Unlifted 'A.asyncBound'. -- -- @since 0.1.0.0 asyncBound :: MonadUnliftIO m => m a -> m (Async a) asyncBound m = withRunInIO $ \run -> A.asyncBound $ run m -- | Unlifted '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 -- | Unlifted '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 -- | Unlifted '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 -- | Unlifted '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) -- | Unlifted '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) -- | Unlifted '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) -- | Unlifted '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) -- | Unlifted '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 unliftio-0.1.1.0/src/UnliftIO/Chan.hs0000644000000000000000000000210013170602466015351 0ustar0000000000000000-- | 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 :: MonadIO m => Chan a -> a -> m () writeChan c = liftIO . C.writeChan c -- | Lifted 'C.readChan'. -- -- @since 0.1.0.0 readChan :: MonadIO m => Chan a -> m a readChan = liftIO . C.readChan -- | Lifted 'C.dupChan'. -- -- @since 0.1.0.0 dupChan :: MonadIO m => Chan a -> m (Chan a) dupChan = liftIO . C.dupChan -- | Lifted 'C.getChanContents'. -- -- @since 0.1.0.0 getChanContents :: MonadIO m => Chan a -> m [a] getChanContents = liftIO . C.getChanContents -- | Lifted 'C.writeList2Chan'. -- -- @since 0.1.0.0 writeList2Chan :: MonadIO m => Chan a -> [a] -> m () writeList2Chan c = liftIO . C.writeList2Chan c unliftio-0.1.1.0/src/UnliftIO/Concurrent.hs0000644000000000000000000001200513170602466016627 0ustar0000000000000000{-# LANGUAGE RankNTypes #-} -- | Unlifted "Control.Concurrent". -- -- This module is not reexported by "UnliftIO", -- use it only if "UnliftIO.Async" is not enough. -- -- @since 0.1.1.0 module UnliftIO.Concurrent ( -- * Concurrent Haskell ThreadId, -- * Basic concurrency operations myThreadId, forkIO, forkWithUnmask, forkFinally, killThread, throwTo, -- ** Threads with affinity forkOn, forkOnWithUnmask, getNumCapabilities, setNumCapabilities, threadCapability, -- * Scheduling yield, -- ** Waiting threadDelay, threadWaitRead, threadWaitWrite, -- * Communication abstractions module UnliftIO.MVar, module UnliftIO.Chan, -- * Bound Threads C.rtsSupportsBoundThreads, forkOS, isCurrentThreadBound, runInBoundThread, runInUnboundThread, -- * Weak references to ThreadIds mkWeakThreadId ) where import Control.Monad.IO.Class (MonadIO, liftIO) import System.Posix.Types (Fd) import System.Mem.Weak (Weak) import Control.Concurrent (ThreadId) import qualified Control.Concurrent as C import Control.Monad.IO.Unlift import UnliftIO.MVar import UnliftIO.Chan import UnliftIO.Exception (throwTo, SomeException) -- | Lifted version of 'C.myThreadId'. -- -- @since 0.1.1.0 myThreadId :: MonadIO m => m ThreadId myThreadId = liftIO C.myThreadId {-# INLINABLE myThreadId #-} -- | Unlifted version of 'C.forkIO'. -- -- @since 0.1.1.0 forkIO :: MonadUnliftIO m => m () -> m ThreadId forkIO m = withRunInIO $ \run -> C.forkIO $ run m {-# INLINABLE forkIO #-} -- | Unlifted version of 'C.forkIOWithUnmask'. -- -- @since 0.1.1.0 forkWithUnmask :: MonadUnliftIO m => ((forall a. m a -> m a) -> m ()) -> m ThreadId forkWithUnmask m = withUnliftIO $ \u -> C.forkIOWithUnmask $ \unmask -> unliftIO u $ m $ liftIO . unmask . unliftIO u {-# INLINABLE forkWithUnmask #-} -- | Unlifted version of 'C.forkFinally'. -- -- @since 0.1.1.0 forkFinally :: MonadUnliftIO m => m a -> (Either SomeException a -> m ()) -> m ThreadId forkFinally m1 m2 = withUnliftIO $ \u -> C.forkFinally (unliftIO u m1) $ unliftIO u . m2 {-# INLINABLE forkFinally #-} -- | Lifted version of 'C.killThread'. -- -- @since 0.1.1.0 killThread :: MonadIO m => ThreadId -> m () killThread = liftIO . C.killThread {-# INLINABLE killThread #-} -- | Unlifted version of 'C.forkOn'. -- -- @since 0.1.1.0 forkOn :: MonadUnliftIO m => Int -> m () -> m ThreadId forkOn i m = withRunInIO $ \run -> C.forkOn i $ run m {-# INLINABLE forkOn #-} -- | Unlifted version of 'C.forkOnWithUnmask'. -- -- @since 0.1.1.0 forkOnWithUnmask :: MonadUnliftIO m => Int -> ((forall a. m a -> m a) -> m ()) -> m ThreadId forkOnWithUnmask i m = withUnliftIO $ \u -> C.forkOnWithUnmask i $ \unmask -> unliftIO u $ m $ liftIO . unmask . unliftIO u {-# INLINABLE forkOnWithUnmask #-} -- | Lifted version of 'C.getNumCapabilities'. -- -- @since 0.1.1.0 getNumCapabilities :: MonadIO m => m Int getNumCapabilities = liftIO C.getNumCapabilities {-# INLINABLE getNumCapabilities #-} -- | Lifted version of 'C.setNumCapabilities'. -- -- @since 0.1.1.0 setNumCapabilities :: MonadIO m => Int -> m () setNumCapabilities = liftIO . C.setNumCapabilities {-# INLINABLE setNumCapabilities #-} -- | Lifted version of 'C.threadCapability'. -- -- @since 0.1.1.0 threadCapability :: MonadIO m => ThreadId -> m (Int, Bool) threadCapability = liftIO . C.threadCapability {-# INLINABLE threadCapability #-} -- | Lifted version of 'C.yield'. -- -- @since 0.1.1.0 yield :: MonadIO m => m () yield = liftIO C.yield {-# INLINABLE yield #-} -- | Lifted version of 'C.threadDelay'. -- -- @since 0.1.1.0 threadDelay :: MonadIO m => Int -> m () threadDelay = liftIO . C.threadDelay {-# INLINABLE threadDelay #-} -- | Lifted version of 'C.threadWaitRead'. -- -- @since 0.1.1.0 threadWaitRead :: MonadIO m => Fd -> m () threadWaitRead = liftIO . C.threadWaitRead {-# INLINABLE threadWaitRead #-} -- | Lifted version of 'C.threadWaitWrite'. -- -- @since 0.1.1.0 threadWaitWrite :: MonadIO m => Fd -> m () threadWaitWrite = liftIO . C.threadWaitWrite {-# INLINABLE threadWaitWrite #-} -- | Unflifted version of 'C.forkOS'. -- -- @since 0.1.1.0 forkOS :: MonadUnliftIO m => m () -> m ThreadId forkOS m = withRunInIO $ \run -> C.forkOS $ run m {-# INLINABLE forkOS #-} -- | Lifted version of 'C.isCurrentThreadBound'. -- -- @since 0.1.1.0 isCurrentThreadBound :: MonadIO m => m Bool isCurrentThreadBound = liftIO C.isCurrentThreadBound {-# INLINABLE isCurrentThreadBound #-} -- | Unlifted version of 'C.runInBoundThread'. -- -- @since 0.1.1.0 runInBoundThread :: MonadUnliftIO m => m a -> m a runInBoundThread m = withRunInIO $ \run -> C.runInBoundThread $ run m {-# INLINABLE runInBoundThread #-} -- | Unlifted version of 'C.runInUnboundThread'. -- -- @since 0.1.1.0 runInUnboundThread :: MonadUnliftIO m => m a -> m a runInUnboundThread m = withRunInIO $ \run -> C.runInUnboundThread $ run m {-# INLINABLE runInUnboundThread #-} -- | Lifted version of 'C.mkWeakThreadId'. -- -- @since 0.1.1.0 mkWeakThreadId :: MonadIO m => ThreadId -> m (Weak ThreadId) mkWeakThreadId = liftIO . C.mkWeakThreadId {-# INLINABLE mkWeakThreadId #-} unliftio-0.1.1.0/src/UnliftIO/Exception.hs0000644000000000000000000004266213170602466016457 0ustar0000000000000000{-# 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.0.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 -- | '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.0.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.0.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'. -- -- @since 0.1.0.0 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 -- | @since 0.1.0.0 instance Show SyncExceptionWrapper where show (SyncExceptionWrapper e) = show e -- | @since 0.1.0.0 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 -- | @since 0.1.0.0 instance Show AsyncExceptionWrapper where show (AsyncExceptionWrapper e) = show e -- | @since 0.1.0.0 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.0.0 #if MIN_VERSION_base(4,9,0) data StringException = StringException String CallStack deriving Typeable -- | @since 0.1.0.0 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 -- | @since 0.1.0.0 instance Show StringException where show (StringException s _) = "Control.Exception.Safe.throwString called with:\n\n" ++ s #endif -- | @since 0.1.0.0 instance Exception StringException -- | Throw an asynchronous exception to another thread. -- -- Synchronously typed exceptions will be wrapped into an -- `AsyncExceptionWrapper`, see -- . -- -- It's usually a better idea to use the "UnliftIO.Async" module, see -- . -- -- @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 'throwIO', -- see . -- -- @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) unliftio-0.1.1.0/src/UnliftIO/IO.hs0000644000000000000000000000127613170602466015024 0ustar0000000000000000-- | 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 -- | Unlifted version of 'IO.withFile'. -- -- @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 -- | Unlifted version of 'IO.withBinaryFile'. -- -- @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 unliftio-0.1.1.0/src/UnliftIO/IORef.hs0000644000000000000000000000340013170602466015450 0ustar0000000000000000-- | 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) unliftio-0.1.1.0/src/UnliftIO/Instances.hs0000644000000000000000000000165213170602466016442 0ustar0000000000000000-- | 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 (..)) -- | @since 0.1.0.0 instance MonadUnliftIO m => MonadUnliftIO (LoggingT m) where askUnliftIO = LoggingT $ \f -> withUnliftIO $ \u -> return (UnliftIO (unliftIO u . flip runLoggingT f)) -- | @since 0.1.0.0 instance MonadUnliftIO m => MonadUnliftIO (NoLoggingT m) where askUnliftIO = NoLoggingT $ withUnliftIO $ \u -> return (UnliftIO (unliftIO u . runNoLoggingT)) -- | @since 0.1.0.0 instance MonadUnliftIO m => MonadUnliftIO (ResourceT m) where askUnliftIO = ResourceT $ \r -> withUnliftIO $ \u -> return (UnliftIO (unliftIO u . flip unResourceT r)) unliftio-0.1.1.0/src/UnliftIO/MVar.hs0000644000000000000000000000612013170602466015353 0ustar0000000000000000-- | 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) unliftio-0.1.1.0/src/UnliftIO/Resource.hs0000644000000000000000000000146013170602466016277 0ustar0000000000000000-- | 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 () -- | Unlifted version of 'Res.runResourceT'. -- -- @since 0.1.0.0 runResourceT :: MonadUnliftIO m => ResourceT m a -> m a runResourceT m = withRunInIO $ \run -> Res.runResourceT $ Res.transResourceT run m -- | Lifted version of 'Res.liftResourceT'. -- -- @since 0.1.0.0 liftResourceT :: MonadIO m => ResourceT IO a -> ResourceT m a liftResourceT (ResourceT f) = ResourceT $ liftIO . f unliftio-0.1.1.0/src/UnliftIO/Temporary.hs0000644000000000000000000001137113170602466016474 0ustar0000000000000000{-# LANGUAgE CPP #-} -- | Temporary file and directory support. -- -- Strongly inspired by\/stolen from the 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 unliftio-0.1.1.0/src/UnliftIO/Timeout.hs0000644000000000000000000000051113170602466016132 0ustar0000000000000000-- | 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-0.1.1.0/LICENSE0000644000000000000000000000203713131436235012676 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-0.1.1.0/Setup.hs0000644000000000000000000000005613131436235013324 0ustar0000000000000000import Distribution.Simple main = defaultMain unliftio-0.1.1.0/unliftio.cabal0000644000000000000000000000242413170602476014513 0ustar0000000000000000-- This file has been generated from package.yaml by hpack version 0.18.1. -- -- see: https://github.com/sol/hpack name: unliftio version: 0.1.1.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/unliftio/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.Concurrent UnliftIO.Exception UnliftIO.IO UnliftIO.IORef UnliftIO.Instances UnliftIO.MVar UnliftIO.Resource UnliftIO.Temporary UnliftIO.Timeout other-modules: Paths_unliftio default-language: Haskell2010 unliftio-0.1.1.0/ChangeLog.md0000644000000000000000000000034713170602466014050 0ustar0000000000000000## 0.1.1.0 * Doc improvements. * Fix `UnliftIO.Chan` type signatures [#3](https://github.com/fpco/unliftio/pull/3). * Add `UnliftIO.Concurrent` module [#5](https://github.com/fpco/unliftio/pull/5). ## 0.1.0.0 * Initial release. unliftio-0.1.1.0/README.md0000644000000000000000000003624613132104153013151 0ustar0000000000000000# 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. The type class has only one method -- `askUnliftIO`: ```haskell newtype UnliftIO m = UnliftIO { unliftIO :: forall a. m a -> IO a } class MonadIO m => MonadUnliftIO m where askUnliftIO :: m (UnliftIO m) ``` `askUnliftIO` gives us a function to run arbitrary computation in `m` in `IO`. Thus the "unlift": it's like `liftIO`, but the other way around. Here are some sample 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. We can use `askUnliftIO` to unlift a function: ```haskell timeout :: MonadUnliftIO m => Int -> m a -> m (Maybe a) timeout x y = do u <- askUnliftIO System.Timeout.timeout x $ unliftIO u y ``` or more concisely using `withRunIO`: ```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. `withRunIO` takes care of invoking `unliftIO` for us. However, if we want to use the run function with different types, we must use `askUnliftIO`: ```haskell race :: MonadUnliftIO m => m a -> m b -> m (Either a b) race a b = do u <- askUnliftIO liftIO (A.race (unliftIO u a) (unliftIO u b)) ``` or more idiomatically `withUnliftIO`: ```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 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). This simplicity is captured by the laws for `MonadUnliftIO`, which make the behavior of the run functions close to that of the already familiar `lift` and `liftIO`. * 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?