module Polysemy.Final.IO
  (
    -- * Combinators for Interpreting to the Final Monad
    interpretFinalGlobal

    -- * Interpretations for other effects
  , asyncToIOFinalGlobal
  , resourceToIOFinalGlobal
  ) where

import qualified Control.Concurrent.Async as A
import qualified Control.Exception as X

import Polysemy
import Polysemy.Final
import Polysemy.Final.IO.Internal
import Polysemy.Async
import Polysemy.Resource

------------------------------------------------------------------------------
-- | 'asyncToIOFinal' implemented using 'interpretFinalGlobal'.
--
-- This behaves semantically very much like 'asyncToIO',
-- but doesn't need to spin up an interpreter thread, making it more
-- efficient (but not any more safe).
asyncToIOFinalGlobal :: Member (Final IO) r
                     => Sem (Async ': r) a
                     -> Sem r a
asyncToIOFinalGlobal :: Sem (Async : r) a -> Sem r a
asyncToIOFinalGlobal = (forall x (n :: * -> *). Async n x -> Strategic IO n x)
-> Sem (Async : r) a -> Sem r a
forall (e :: (* -> *) -> * -> *) a (r :: EffectRow).
Member (Final IO) r =>
(forall x (n :: * -> *). e n x -> Strategic IO n x)
-> Sem (e : r) a -> Sem r a
interpretFinalGlobal ((forall x (n :: * -> *). Async n x -> Strategic IO n x)
 -> Sem (Async : r) a -> Sem r a)
-> (forall x (n :: * -> *). Async n x -> Strategic IO n x)
-> Sem (Async : r) a
-> Sem r a
forall a b. (a -> b) -> a -> b
$ \case
  Async m -> do
    Inspector f
ins <- Sem (WithStrategy IO f n) (Inspector f)
forall (m :: * -> *) (f :: * -> *) (n :: * -> *).
Sem (WithStrategy m f n) (Inspector f)
getInspectorS
    IO (f a1)
m'  <- n a1 -> Sem (WithStrategy IO f n) (IO (f a1))
forall (n :: * -> *) a (m :: * -> *) (f :: * -> *).
n a -> Sem (WithStrategy m f n) (m (f a))
runS n a1
m
    IO (Async (Maybe a1)) -> Strategic IO n (Async (Maybe a1))
forall (m :: * -> *) a (n :: * -> *).
Functor m =>
m a -> Strategic m n a
liftS (IO (Async (Maybe a1)) -> Strategic IO n (Async (Maybe a1)))
-> IO (Async (Maybe a1)) -> Strategic IO n (Async (Maybe a1))
forall a b. (a -> b) -> a -> b
$ IO (Maybe a1) -> IO (Async (Maybe a1))
forall a. IO a -> IO (Async a)
A.async (Inspector f -> forall x. f x -> Maybe x
forall (f :: * -> *). Inspector f -> forall x. f x -> Maybe x
inspect Inspector f
ins (f a1 -> Maybe a1) -> IO (f a1) -> IO (Maybe a1)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (f a1)
m')
  Await a -> IO x -> Strategic IO n x
forall (m :: * -> *) a (n :: * -> *).
Functor m =>
m a -> Strategic m n a
liftS (Async x -> IO x
forall a. Async a -> IO a
A.wait Async x
a)
  Cancel a -> IO () -> Strategic IO n ()
forall (m :: * -> *) a (n :: * -> *).
Functor m =>
m a -> Strategic m n a
liftS (Async a1 -> IO ()
forall a. Async a -> IO ()
A.cancel Async a1
a)
{-# INLINE asyncToIOFinalGlobal #-}
------------------------------------------------------------------------------
-- | 'resourceToIOFinal' implemented using 'interpretFinalGlobal'.
--
-- This behaves semantically very much like 'resourceToIO',
-- but doesn't need to spin up an interpreter thread,
-- making it more efficient (but not any more safe).
resourceToIOFinalGlobal :: Member (Final IO) r
                        => Sem (Resource ': r) a
                        -> Sem r a
resourceToIOFinalGlobal :: Sem (Resource : r) a -> Sem r a
resourceToIOFinalGlobal = (forall x (n :: * -> *). Resource n x -> Strategic IO n x)
-> Sem (Resource : r) a -> Sem r a
forall (e :: (* -> *) -> * -> *) a (r :: EffectRow).
Member (Final IO) r =>
(forall x (n :: * -> *). e n x -> Strategic IO n x)
-> Sem (e : r) a -> Sem r a
interpretFinalGlobal ((forall x (n :: * -> *). Resource n x -> Strategic IO n x)
 -> Sem (Resource : r) a -> Sem r a)
-> (forall x (n :: * -> *). Resource n x -> Strategic IO n x)
-> Sem (Resource : r) a
-> Sem r a
forall a b. (a -> b) -> a -> b
$ \case
  Bracket alloc dealloc use -> do
    IO (f a1)
a <- n a1 -> Sem (WithStrategy IO f n) (IO (f a1))
forall (n :: * -> *) a (m :: * -> *) (f :: * -> *).
n a -> Sem (WithStrategy m f n) (m (f a))
runS  n a1
alloc
    f a1 -> IO (f c)
d <- (a1 -> n c) -> Sem (WithStrategy IO f n) (f a1 -> IO (f c))
forall a (n :: * -> *) b (m :: * -> *) (f :: * -> *).
(a -> n b) -> Sem (WithStrategy m f n) (f a -> m (f b))
bindS a1 -> n c
dealloc
    f a1 -> IO (f x)
u <- (a1 -> n x) -> Sem (WithStrategy IO f n) (f a1 -> IO (f x))
forall a (n :: * -> *) b (m :: * -> *) (f :: * -> *).
(a -> n b) -> Sem (WithStrategy m f n) (f a -> m (f b))
bindS a1 -> n x
use
    IO (f x) -> Sem (WithStrategy IO f n) (IO (f x))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (IO (f x) -> Sem (WithStrategy IO f n) (IO (f x)))
-> IO (f x) -> Sem (WithStrategy IO f n) (IO (f x))
forall a b. (a -> b) -> a -> b
$ IO (f a1) -> (f a1 -> IO (f c)) -> (f a1 -> IO (f x)) -> IO (f x)
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
X.bracket IO (f a1)
a f a1 -> IO (f c)
d f a1 -> IO (f x)
u

  BracketOnError alloc dealloc use -> do
    IO (f a1)
a <- n a1 -> Sem (WithStrategy IO f n) (IO (f a1))
forall (n :: * -> *) a (m :: * -> *) (f :: * -> *).
n a -> Sem (WithStrategy m f n) (m (f a))
runS  n a1
alloc
    f a1 -> IO (f c)
d <- (a1 -> n c) -> Sem (WithStrategy IO f n) (f a1 -> IO (f c))
forall a (n :: * -> *) b (m :: * -> *) (f :: * -> *).
(a -> n b) -> Sem (WithStrategy m f n) (f a -> m (f b))
bindS a1 -> n c
dealloc
    f a1 -> IO (f x)
u <- (a1 -> n x) -> Sem (WithStrategy IO f n) (f a1 -> IO (f x))
forall a (n :: * -> *) b (m :: * -> *) (f :: * -> *).
(a -> n b) -> Sem (WithStrategy m f n) (f a -> m (f b))
bindS a1 -> n x
use
    IO (f x) -> Sem (WithStrategy IO f n) (IO (f x))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (IO (f x) -> Sem (WithStrategy IO f n) (IO (f x)))
-> IO (f x) -> Sem (WithStrategy IO f n) (IO (f x))
forall a b. (a -> b) -> a -> b
$ IO (f a1) -> (f a1 -> IO (f c)) -> (f a1 -> IO (f x)) -> IO (f x)
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
X.bracketOnError IO (f a1)
a f a1 -> IO (f c)
d f a1 -> IO (f x)
u
{-# INLINE resourceToIOFinalGlobal #-}