{-# LANGUAGE CPP #-}
-- |
-- Module      : Streamly.Internal.Control.Exception
-- Copyright   : (c) 2019 Composewell Technologies
--
-- License     : BSD3
-- Maintainer  : streamly@composewell.com
-- Stability   : experimental
-- Portability : GHC
--
-- Additional "Control.Exception" utilities.

module Streamly.Internal.Control.Exception
    (
    -- * Verify
      verify
    , verifyM

    -- * Resource Management
    -- | Exception safe, thread safe resource managment operations, similar to
    -- but more powerful than the @bracket@ and @finally@ operations available
    -- in the base package.
    --
    -- These operations support allocation and free only in the IO monad,
    -- hence the IO suffix.
    --
    , AcquireIO(..)
    , Priority(..)
    , allocator
    , releaser
    , withAcquireIO
    , acquireWith
    , acquire
    , acquire_
    , registerWith
    , register
    , hook
    )
where

-- import Control.Concurrent (myThreadId)
import Control.Monad (void)
import Control.Monad.IO.Class (MonadIO(..))
import Control.Exception (mask_)
import Control.Monad.Catch (MonadMask)
import Data.IntMap.Strict (IntMap)
import Data.IORef (IORef, newIORef, atomicModifyIORef')

import qualified Control.Monad.Catch as MC
import qualified Data.IntMap.Strict as Map

#include "DocTestControlException.hs"

-------------------------------------------------------------------------------
-- Asserts
-------------------------------------------------------------------------------

-- | Like 'assert' but is not removed by the compiler, it is always present in
-- production code.
--
-- /Pre-release/
--
{-# INLINE verify #-}
verify :: Bool -> a -> a
verify :: forall a. Bool -> a -> a
verify Bool
predicate a
val =
    if Bool
predicate
    -- XXX it would be nice if we can print the predicate expr.
    then [Char] -> a
forall a. HasCallStack => [Char] -> a
error [Char]
"verify failed"
    else a
val

-- Like 'verify' but returns @()@ in an 'Applicative' context so that it can be
-- used as an independent statement in a @do@ block.
--
-- /Pre-release/
--
{-# INLINE verifyM #-}
verifyM :: Applicative f => Bool -> f ()
verifyM :: forall (f :: * -> *). Applicative f => Bool -> f ()
verifyM Bool
predicate = Bool -> f () -> f ()
forall a. Bool -> a -> a
verify Bool
predicate (() -> f ()
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())

-------------------------------------------------------------------------------
-- Resource management
-------------------------------------------------------------------------------

-- XXX In a manual release mechanism of resources we always have the risk of
-- using the resource by some persisting thread even after it has been freed.
-- Ideally, we should use the GC to clean up resources because that way we do
-- not need to worry about references, we can pass around resources to other
-- threads and we get an automatic reference counting. Is it possible to use
-- compact regions to confine resource to smaller areas so that we can perform
-- a limited GC to free them? We can then just put gc sync barriers at points
-- where we want to ensure that resources are freed.

-- | Resources with 'Priority1' are freed before 'Priority2'. Priority is
-- especially introduced to take care of the case where we need to free
-- concurrency channels, so that all the workers of the channel are cleaned up
-- before we free the resources allocated by the workers of the channel.
-- Otherwise we might free the resources and workers may be trying to use them
-- and start misbehaving.
--
data Priority = Priority1 | Priority2 deriving Int -> Priority -> ShowS
[Priority] -> ShowS
Priority -> [Char]
(Int -> Priority -> ShowS)
-> (Priority -> [Char]) -> ([Priority] -> ShowS) -> Show Priority
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Priority -> ShowS
showsPrec :: Int -> Priority -> ShowS
$cshow :: Priority -> [Char]
show :: Priority -> [Char]
$cshowList :: [Priority] -> ShowS
showList :: [Priority] -> ShowS
Show

-- To keep the type signatures simple and to avoid inference problems we should
-- use this newtype. We cannot pass around a foralled type without wrapping
-- it in a newtype.

-- | @AcquireIO@ is used to acquire a resource safely such that it is
-- automatically released if not released manually.
--
-- See 'withAcquireIO'.
--
newtype AcquireIO = AcquireIO
    (forall b c. Priority -> IO b -> (b -> IO c) -> IO (b, IO ()))

-- | /Internal/.
allocator :: MonadIO m =>
       IORef (Int, IntMap (IO ()), IntMap (IO ()))
    -> Priority
    -> IO a
    -> (a -> IO b)
    -> m (a, m ())
allocator :: forall (m :: * -> *) a b.
MonadIO m =>
IORef (Int, IntMap (IO ()), IntMap (IO ()))
-> Priority -> IO a -> (a -> IO b) -> m (a, m ())
allocator IORef (Int, IntMap (IO ()), IntMap (IO ()))
ref Priority
pri IO a
alloc a -> IO b
free = do
    let insertResource :: a
-> (Int, IntMap (IO ()), IntMap (IO ()))
-> ((Int, IntMap (IO ()), IntMap (IO ())), Int)
insertResource a
r (Int
i, IntMap (IO ())
mp1, IntMap (IO ())
mp2) =
            case Priority
pri of
                Priority
Priority1 ->
                    ((Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1, Int -> IO () -> IntMap (IO ()) -> IntMap (IO ())
forall a. Int -> a -> IntMap a -> IntMap a
Map.insert Int
i (IO b -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO b -> IO ()) -> IO b -> IO ()
forall a b. (a -> b) -> a -> b
$ a -> IO b
free a
r) IntMap (IO ())
mp1, IntMap (IO ())
mp2), Int
i)
                Priority
Priority2 ->
                    ((Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1, IntMap (IO ())
mp1, Int -> IO () -> IntMap (IO ()) -> IntMap (IO ())
forall a. Int -> a -> IntMap a -> IntMap a
Map.insert Int
i (IO b -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO b -> IO ()) -> IO b -> IO ()
forall a b. (a -> b) -> a -> b
$ a -> IO b
free a
r) IntMap (IO ())
mp2), Int
i)

    (a
r, Int
index) <-
        IO (a, Int) -> m (a, Int)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (a, Int) -> m (a, Int)) -> IO (a, Int) -> m (a, Int)
forall a b. (a -> b) -> a -> b
$ IO (a, Int) -> IO (a, Int)
forall a. IO a -> IO a
mask_ (IO (a, Int) -> IO (a, Int)) -> IO (a, Int) -> IO (a, Int)
forall a b. (a -> b) -> a -> b
$ do
            -- tid <- myThreadId
            a
r <- IO a
alloc
            Int
idx <- IORef (Int, IntMap (IO ()), IntMap (IO ()))
-> ((Int, IntMap (IO ()), IntMap (IO ()))
    -> ((Int, IntMap (IO ()), IntMap (IO ())), Int))
-> IO Int
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef' IORef (Int, IntMap (IO ()), IntMap (IO ()))
ref (a
-> (Int, IntMap (IO ()), IntMap (IO ()))
-> ((Int, IntMap (IO ()), IntMap (IO ())), Int)
insertResource a
r)
            -- liftIO $ putStrLn $ "insert: " ++ show pri
            --      ++ " " ++ show idx ++ " " ++ show tid
            (a, Int) -> IO (a, Int)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (a
r, Int
idx)

    let deleteResource :: (a, IntMap a, IntMap a) -> ((a, IntMap a, IntMap a), Maybe a)
deleteResource (a
i, IntMap a
mp1, IntMap a
mp2) =
            case Priority
pri of
                Priority
Priority1 ->
                    let res :: Maybe a
res = Int -> IntMap a -> Maybe a
forall a. Int -> IntMap a -> Maybe a
Map.lookup Int
index IntMap a
mp1
                     in ((a
i, Int -> IntMap a -> IntMap a
forall a. Int -> IntMap a -> IntMap a
Map.delete Int
index IntMap a
mp1, IntMap a
mp2), Maybe a
res)
                Priority
Priority2 ->
                    let res :: Maybe a
res = Int -> IntMap a -> Maybe a
forall a. Int -> IntMap a -> Maybe a
Map.lookup Int
index IntMap a
mp2
                     in ((a
i, IntMap a
mp1, Int -> IntMap a -> IntMap a
forall a. Int -> IntMap a -> IntMap a
Map.delete Int
index IntMap a
mp2), Maybe a
res)

        release :: m ()
release =
            -- IMPORTANT: do not use interruptible operations in this
            -- critical section. Even putStrLn can make tests fail.
            IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ IO () -> IO ()
forall a. IO a -> IO a
mask_ (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
                -- tid <- myThreadId
                -- liftIO $ putStrLn $ "releasing index: " ++ show index
                --      ++ " " ++ show tid
                Maybe (IO ())
f <- IORef (Int, IntMap (IO ()), IntMap (IO ()))
-> ((Int, IntMap (IO ()), IntMap (IO ()))
    -> ((Int, IntMap (IO ()), IntMap (IO ())), Maybe (IO ())))
-> IO (Maybe (IO ()))
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef' IORef (Int, IntMap (IO ()), IntMap (IO ()))
ref (Int, IntMap (IO ()), IntMap (IO ()))
-> ((Int, IntMap (IO ()), IntMap (IO ())), Maybe (IO ()))
forall {a} {a}.
(a, IntMap a, IntMap a) -> ((a, IntMap a, IntMap a), Maybe a)
deleteResource
                -- restoring exceptions makes it non-atomic, tests fail.
                -- Can use allowInterrupt in "free" if desired.
                Maybe (IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ Maybe (IO ())
f
    (a, m ()) -> m (a, m ())
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (a
r, m ()
release)

-- XXX can we ensure via GC that the resources that we are freeing are all
-- dead, there are no other references to them?

-- | We ensure that all async workers for concurrent streams are stopped
-- before we release the resources so that nobody could be using the
-- resource after they are freed.
--
-- The only other possibility, could be user issued forkIO not being
-- tracked by us, however, that would be a programming error and any such
-- threads could misbehave if we freed the resources from under them.
--
-- We use GC based hooks in 'Stream.bracketIO\'' so there could be async threads
-- spawned by GC, releasing resources concurrently with us. For that reason we
-- need to make sure that the "release" in the bracket end action is executed
-- only once in that case.
--
-- /Internal/.
releaser :: MonadIO m => IORef (a, IntMap (IO b), IntMap (IO b)) -> m ()
releaser :: forall (m :: * -> *) a b.
MonadIO m =>
IORef (a, IntMap (IO b), IntMap (IO b)) -> m ()
releaser IORef (a, IntMap (IO b), IntMap (IO b))
ref =
    IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ IO () -> IO ()
forall a. IO a -> IO a
mask_ (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
        -- Delete the map from the ref first so that anyone else (GC)
        -- releasing concurrently cannot find the map.
        -- liftIO $ putStrLn "cleaning up priority 1"
        IntMap (IO b)
mp1 <- IORef (a, IntMap (IO b), IntMap (IO b))
-> ((a, IntMap (IO b), IntMap (IO b))
    -> ((a, IntMap (IO b), IntMap (IO b)), IntMap (IO b)))
-> IO (IntMap (IO b))
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef' IORef (a, IntMap (IO b), IntMap (IO b))
ref
            (\(a
i, IntMap (IO b)
mp1,IntMap (IO b)
mp2) -> ((a
i, IntMap (IO b)
forall a. IntMap a
Map.empty, IntMap (IO b)
mp2), IntMap (IO b)
mp1))
        -- Note that the channel cleanup function is interruptible because
        -- it has blocking points.
        IntMap (IO b) -> IO ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ IntMap (IO b)
mp1
        -- Now nobody would be changing mp2, we can read it safely
        -- liftIO $ putStrLn "cleaning up priority 2"
        IntMap (IO b)
mp2 <- IORef (a, IntMap (IO b), IntMap (IO b))
-> ((a, IntMap (IO b), IntMap (IO b))
    -> ((a, IntMap (IO b), IntMap (IO b)), IntMap (IO b)))
-> IO (IntMap (IO b))
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef' IORef (a, IntMap (IO b), IntMap (IO b))
ref
            (\(a
i, IntMap (IO b)
mp,IntMap (IO b)
mp2) -> ((a
i, IntMap (IO b)
mp, IntMap (IO b)
forall a. IntMap a
Map.empty), IntMap (IO b)
mp2))
        IntMap (IO b) -> IO ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ IntMap (IO b)
mp2
        -- XXX We can now assert that the IORef has both maps empty.

-- | @withAcquireIO action@ runs the given @action@, providing it with a
-- an 'AcquireIO' reference called @ref@ as argument. @ref@ is used for resource
-- acquisition or hook registeration within the scope of @action@. An @acquire
-- ref alloc free@ call can be used within @action@ any number of times to
-- acquire resources that are automatically freed when the scope of @action@
-- ends or if an exception occurs at any time. @alloc@ is a function supplied
-- by the user to allocate a resource and @free@ is supplied to free the
-- allocated resource. @acquire@ returns @(resource, release)@ -- the acquired
-- @resource@ and a @release@ action to release it.
--
-- @acquire@ allocates a resource in an exception safe manner and sets up its
-- automatic release on exception or when the scope of @action@ ends. The
-- @release@ function returned by @acquire@ can be used to free the resource
-- manually at any time. @release@ is guaranteed to free the resource once and
-- only once even if it is called concurrently or multiple times.
--
-- Here is an example to allocate resources that are guaranteed to be released
-- automatically, and can be released manually as well:
--
-- >>> :{
-- close x h = do
--  putStrLn $ "closing: " ++ x
--  hClose h
-- :}
--
-- >>> :{
-- action ref =
--      Stream.fromList ["file1", "file2"]
--    & Stream.mapM
--        (\x -> do
--            (h, release) <- Exception.acquire ref (openFile x ReadMode) (close x)
--            -- use h here
--            threadDelay 1000000
--            when (x == "file1") $ do
--                putStrLn $ "Manually releasing: " ++ x
--                release
--            return x
--        )
--    & Stream.trace print
--    & Stream.fold Fold.drain
-- :}
--
-- >>> run = Exception.withAcquireIO action
--
-- In the above code, you should see the \"closing:\" message for both the
-- files, and only once for each file. Even if you interrupt the program with
-- CTRL-C you should still see the \"closing:\" message for the files opened
-- before the interrupt. Make sure you create "file1" and "file2" before
-- running this code snippet.
--
-- Cleanup is guaranteed to happen as soon as the scope of 'action'
-- finishes or if an exception occurs.
--
-- Here is an example for just registering hooks to be called eventually:
--
-- >>> :{
-- action ref =
--      Stream.fromList ["file1", "file2"]
--    & Stream.mapM
--        (\x -> do
--            Exception.register ref $ putStrLn $ "saw: " ++ x
--            threadDelay 1000000
--            return x
--        )
--    & Stream.trace print
--    & Stream.fold Fold.drain
-- :}
--
-- >>> run = Exception.withAcquireIO action
--
-- In the above code, even if you interrupt the program with CTRL-C you should
-- still see the "saw:" message for the elements seen before the interrupt.
--
-- The registered hooks are guaranteed to be invoked as soon as the scope of
-- 'action' finishes or if an exception occurs.
--
-- This function provides functionality similar to the @bracket@ function
-- available in the base library. However, it is more powerful as any number of
-- resources can be allocated and released within the scope of 'action'.
--
-- Exception safe, thread safe.
{-# INLINE withAcquireIO #-}
withAcquireIO :: (MonadIO m, MonadMask m) => (AcquireIO -> m a) -> m a
withAcquireIO :: forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
(AcquireIO -> m a) -> m a
withAcquireIO AcquireIO -> m a
action = do
    -- Assuming 64-bit int counter will never overflow
    IORef (Int, IntMap (IO ()), IntMap (IO ()))
ref <- IO (IORef (Int, IntMap (IO ()), IntMap (IO ())))
-> m (IORef (Int, IntMap (IO ()), IntMap (IO ())))
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef (Int, IntMap (IO ()), IntMap (IO ())))
 -> m (IORef (Int, IntMap (IO ()), IntMap (IO ()))))
-> IO (IORef (Int, IntMap (IO ()), IntMap (IO ())))
-> m (IORef (Int, IntMap (IO ()), IntMap (IO ())))
forall a b. (a -> b) -> a -> b
$ (Int, IntMap (IO ()), IntMap (IO ()))
-> IO (IORef (Int, IntMap (IO ()), IntMap (IO ())))
forall a. a -> IO (IORef a)
newIORef (Int
0 :: Int, IntMap (IO ())
forall a. IntMap a
Map.empty, IntMap (IO ())
forall a. IntMap a
Map.empty)
    AcquireIO -> m a
action ((forall b c. Priority -> IO b -> (b -> IO c) -> IO (b, IO ()))
-> AcquireIO
AcquireIO (IORef (Int, IntMap (IO ()), IntMap (IO ()))
-> Priority -> IO b -> (b -> IO c) -> IO (b, IO ())
forall (m :: * -> *) a b.
MonadIO m =>
IORef (Int, IntMap (IO ()), IntMap (IO ()))
-> Priority -> IO a -> (a -> IO b) -> m (a, m ())
allocator IORef (Int, IntMap (IO ()), IntMap (IO ()))
ref)) m a -> m () -> m a
forall (m :: * -> *) a b.
(HasCallStack, MonadMask m) =>
m a -> m b -> m a
`MC.finally` IORef (Int, IntMap (IO ()), IntMap (IO ())) -> m ()
forall (m :: * -> *) a b.
MonadIO m =>
IORef (a, IntMap (IO b), IntMap (IO b)) -> m ()
releaser IORef (Int, IntMap (IO ()), IntMap (IO ()))
ref

-- | Like 'acquire' but allows specifying a priority for releasing the
-- resource. 'Priority1' resources are released before 'Priority2'. This allows
-- us to specify a dependency between resource release.
{-# INLINE acquireWith #-}
acquireWith :: Priority -> AcquireIO -> IO b -> (b -> IO c) -> IO (b, IO ())
acquireWith :: forall b c.
Priority -> AcquireIO -> IO b -> (b -> IO c) -> IO (b, IO ())
acquireWith Priority
pri (AcquireIO forall b c. Priority -> IO b -> (b -> IO c) -> IO (b, IO ())
f) = Priority -> IO b -> (b -> IO c) -> IO (b, IO ())
forall b c. Priority -> IO b -> (b -> IO c) -> IO (b, IO ())
f Priority
pri

-- | @acquire ref alloc free@ is used in bracket-style safe resource allocation
-- functions, where @alloc@ is a function supplied by the user to allocate a
-- resource and @free@ is supplied to free it. @acquire@ returns a tuple
-- @(resource, release)@ where @resource@ is the allocated resource and
-- @release@ is an action that can be called later to release the resource.
-- Both @alloc@ and @free@ are invoked with async signals masked. You can use
-- @allowInterrupt@ from base package for allowing interrupts if required.
--
-- The @release@ action can be called multiple times or even concurrently from
-- multiple threads,  but it will release the resource only once. If @release@
-- is never called by the programmer it will be automatically called at the end
-- of the bracket scope.
--
acquire :: AcquireIO -> IO b -> (b -> IO c) -> IO (b, IO ())
acquire :: forall b c. AcquireIO -> IO b -> (b -> IO c) -> IO (b, IO ())
acquire = Priority -> AcquireIO -> IO b -> (b -> IO c) -> IO (b, IO ())
forall b c.
Priority -> AcquireIO -> IO b -> (b -> IO c) -> IO (b, IO ())
acquireWith Priority
Priority2

-- | Like 'acquire' but does not return a release action. The resource is freed
-- automatically only.
acquire_ :: AcquireIO -> IO b -> (b -> IO c) -> IO b
acquire_ :: forall b c. AcquireIO -> IO b -> (b -> IO c) -> IO b
acquire_ AcquireIO
a IO b
b b -> IO c
c = ((b, IO ()) -> b) -> IO (b, IO ()) -> IO b
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (b, IO ()) -> b
forall a b. (a, b) -> a
fst (IO (b, IO ()) -> IO b) -> IO (b, IO ()) -> IO b
forall a b. (a -> b) -> a -> b
$ AcquireIO -> IO b -> (b -> IO c) -> IO (b, IO ())
forall b c. AcquireIO -> IO b -> (b -> IO c) -> IO (b, IO ())
acquire AcquireIO
a IO b
b b -> IO c
c

-- | Like 'register' but specifies a 'Priority' for calling the hook.
{-# INLINE registerWith #-}
registerWith :: Priority -> AcquireIO -> IO () -> IO ()
registerWith :: Priority -> AcquireIO -> IO () -> IO ()
registerWith Priority
pri (AcquireIO forall b c. Priority -> IO b -> (b -> IO c) -> IO (b, IO ())
f) IO ()
g = IO ((), IO ()) -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO ((), IO ()) -> IO ()) -> IO ((), IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ Priority -> IO () -> (() -> IO ()) -> IO ((), IO ())
forall b c. Priority -> IO b -> (b -> IO c) -> IO (b, IO ())
f Priority
pri (() -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()) (\() -> IO ()
g)

-- | Register a hook to be executed at the end of a bracket.
register :: AcquireIO -> IO () -> IO ()
register :: AcquireIO -> IO () -> IO ()
register = Priority -> AcquireIO -> IO () -> IO ()
registerWith Priority
Priority2

-- | Like 'register' but returns a hook release function as well. When the
-- returned hook release function is called, the hook is invoked and removed.
-- If the returned function is never called by the programmer then it is
-- automatically invoked at the end of the bracket. The hook is invoked once
-- and only once.
--
hook :: AcquireIO -> IO () -> IO (IO())
hook :: AcquireIO -> IO () -> IO (IO ())
hook (AcquireIO forall b c. Priority -> IO b -> (b -> IO c) -> IO (b, IO ())
f) IO ()
g = (((), IO ()) -> IO ()) -> IO ((), IO ()) -> IO (IO ())
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((), IO ()) -> IO ()
forall a b. (a, b) -> b
snd (IO ((), IO ()) -> IO (IO ())) -> IO ((), IO ()) -> IO (IO ())
forall a b. (a -> b) -> a -> b
$ Priority -> IO () -> (() -> IO ()) -> IO ((), IO ())
forall b c. Priority -> IO b -> (b -> IO c) -> IO (b, IO ())
f Priority
Priority2 (() -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()) (\() -> IO ()
g)