-- | Internal module for 'Scoped', 'ScopedResource' & co.
--
-- Only import this if you need to wrap an otherwise some still interface around resources
module Control.Monad.Scoped.Internal
  ( -- * definitions of 'Scoped' and 'ScopedResource' and functions to work with them
    Scoped (..)
  , ScopedResource (..)
  , scoped
  , registerHandler

    -- ** Helpers to create your own 'Scoped' wrappers around resources
  , bracketScoped
  )
where

import Control.Applicative (Alternative (empty, (<|>)))
import Control.Monad (MonadPlus, ap)
import Control.Monad.Trans.Class (MonadTrans (lift))
import Data.Kind (Type)
import GHC.Exts
import UnliftIO (MonadIO (liftIO), MonadUnliftIO, bracket, finally)

type role Scoped nominal representational representational

-- | The 'Scoped' monad that provides the possibility to safely scope the allocation of a resource
--
-- It is used to abstract over all of the CPS style withSomething functions, like 'System.IO.withFile'
--
-- Be sure to properly mask handlers if you are using 'UnsafeMkScoped'. Use safe helper functions like
-- 'registerHandler' or 'bracketScoped' where possible.
type Scoped :: forall {l} {k} {rep :: RuntimeRep}. l -> (k -> TYPE rep) -> Type -> Type
newtype Scoped s m a = UnsafeMkScoped
  { forall {l} {k} (s :: l) (m :: k -> Type) a.
Scoped s m a -> forall (b :: k). (a -> m b) -> m b
unsafeRunScoped :: forall b. (a -> m b) -> m b
  -- ^ Unsafely runs a scoped block. use 'scoped' instead, otherwise resources might escape
  }
  deriving stock ((forall a b. (a -> b) -> Scoped s m a -> Scoped s m b)
-> (forall a b. a -> Scoped s m b -> Scoped s m a)
-> Functor (Scoped s m)
forall l (s :: l) k (m :: k -> Type) a b.
a -> Scoped s m b -> Scoped s m a
forall l (s :: l) k (m :: k -> Type) a b.
(a -> b) -> Scoped s m a -> Scoped s m b
forall a b. a -> Scoped s m b -> Scoped s m a
forall a b. (a -> b) -> Scoped s m a -> Scoped s m b
forall (f :: Type -> Type).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall l (s :: l) k (m :: k -> Type) a b.
(a -> b) -> Scoped s m a -> Scoped s m b
fmap :: forall a b. (a -> b) -> Scoped s m a -> Scoped s m b
$c<$ :: forall l (s :: l) k (m :: k -> Type) a b.
a -> Scoped s m b -> Scoped s m a
<$ :: forall a b. a -> Scoped s m b -> Scoped s m a
Functor)

type role ScopedResource nominal representational

-- | A scoped resource with token @s@ belonging to a 'Scoped' block with the same token.
--
-- If you are creating a 'ScopedResource', make sure the resource is deallocated properly
-- when the 'Scoped' block is exited.
type ScopedResource :: forall {k}. k -> Type -> Type
newtype ScopedResource s a = UnsafeMkScopedResource
  { forall {k} (s :: k) a. ScopedResource s a -> a
unsafeUnwrapScopedResource :: a
  -- ^ Unsafely runs a scoped resource. It forgets the scope of the resource and may now be escaped incorrectly
  }
  deriving stock (ScopedResource s a -> ScopedResource s a -> Bool
(ScopedResource s a -> ScopedResource s a -> Bool)
-> (ScopedResource s a -> ScopedResource s a -> Bool)
-> Eq (ScopedResource s a)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall k (s :: k) a.
Eq a =>
ScopedResource s a -> ScopedResource s a -> Bool
$c== :: forall k (s :: k) a.
Eq a =>
ScopedResource s a -> ScopedResource s a -> Bool
== :: ScopedResource s a -> ScopedResource s a -> Bool
$c/= :: forall k (s :: k) a.
Eq a =>
ScopedResource s a -> ScopedResource s a -> Bool
/= :: ScopedResource s a -> ScopedResource s a -> Bool
Eq, Eq (ScopedResource s a)
Eq (ScopedResource s a) =>
(ScopedResource s a -> ScopedResource s a -> Ordering)
-> (ScopedResource s a -> ScopedResource s a -> Bool)
-> (ScopedResource s a -> ScopedResource s a -> Bool)
-> (ScopedResource s a -> ScopedResource s a -> Bool)
-> (ScopedResource s a -> ScopedResource s a -> Bool)
-> (ScopedResource s a -> ScopedResource s a -> ScopedResource s a)
-> (ScopedResource s a -> ScopedResource s a -> ScopedResource s a)
-> Ord (ScopedResource s a)
ScopedResource s a -> ScopedResource s a -> Bool
ScopedResource s a -> ScopedResource s a -> Ordering
ScopedResource s a -> ScopedResource s a -> ScopedResource s a
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall k (s :: k) a. Ord a => Eq (ScopedResource s a)
forall k (s :: k) a.
Ord a =>
ScopedResource s a -> ScopedResource s a -> Bool
forall k (s :: k) a.
Ord a =>
ScopedResource s a -> ScopedResource s a -> Ordering
forall k (s :: k) a.
Ord a =>
ScopedResource s a -> ScopedResource s a -> ScopedResource s a
$ccompare :: forall k (s :: k) a.
Ord a =>
ScopedResource s a -> ScopedResource s a -> Ordering
compare :: ScopedResource s a -> ScopedResource s a -> Ordering
$c< :: forall k (s :: k) a.
Ord a =>
ScopedResource s a -> ScopedResource s a -> Bool
< :: ScopedResource s a -> ScopedResource s a -> Bool
$c<= :: forall k (s :: k) a.
Ord a =>
ScopedResource s a -> ScopedResource s a -> Bool
<= :: ScopedResource s a -> ScopedResource s a -> Bool
$c> :: forall k (s :: k) a.
Ord a =>
ScopedResource s a -> ScopedResource s a -> Bool
> :: ScopedResource s a -> ScopedResource s a -> Bool
$c>= :: forall k (s :: k) a.
Ord a =>
ScopedResource s a -> ScopedResource s a -> Bool
>= :: ScopedResource s a -> ScopedResource s a -> Bool
$cmax :: forall k (s :: k) a.
Ord a =>
ScopedResource s a -> ScopedResource s a -> ScopedResource s a
max :: ScopedResource s a -> ScopedResource s a -> ScopedResource s a
$cmin :: forall k (s :: k) a.
Ord a =>
ScopedResource s a -> ScopedResource s a -> ScopedResource s a
min :: ScopedResource s a -> ScopedResource s a -> ScopedResource s a
Ord, Int -> ScopedResource s a -> ShowS
[ScopedResource s a] -> ShowS
ScopedResource s a -> String
(Int -> ScopedResource s a -> ShowS)
-> (ScopedResource s a -> String)
-> ([ScopedResource s a] -> ShowS)
-> Show (ScopedResource s a)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (s :: k) a. Show a => Int -> ScopedResource s a -> ShowS
forall k (s :: k) a. Show a => [ScopedResource s a] -> ShowS
forall k (s :: k) a. Show a => ScopedResource s a -> String
$cshowsPrec :: forall k (s :: k) a. Show a => Int -> ScopedResource s a -> ShowS
showsPrec :: Int -> ScopedResource s a -> ShowS
$cshow :: forall k (s :: k) a. Show a => ScopedResource s a -> String
show :: ScopedResource s a -> String
$cshowList :: forall k (s :: k) a. Show a => [ScopedResource s a] -> ShowS
showList :: [ScopedResource s a] -> ShowS
Show)

-- | Run a 'Scoped' block safely, making sure that none of the safely allocated resources can escape it, using
-- the same trick as 'Control.Monad.ST.ST'
--
-- All of the allocated resources will live until the end of the block is reached
scoped
  :: forall m a
   . Applicative m
  => (forall s. Scoped s m a)
  -- ^ the scoped computation to be run
  -> m a
scoped :: forall {l} (m :: Type -> Type) a.
Applicative m =>
(forall (s :: l). Scoped s m a) -> m a
scoped forall (s :: l). Scoped s m a
act = Scoped Any m a -> forall b. (a -> m b) -> m b
forall {l} {k} (s :: l) (m :: k -> Type) a.
Scoped s m a -> forall (b :: k). (a -> m b) -> m b
unsafeRunScoped Scoped Any m a
forall (s :: l). Scoped s m a
act a -> m a
forall a. a -> m a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure

-- | Run a handler masked for async exception when the 'Scoped' block ends
--
-- You can register a handler wherever in your 'Scoped' block you want, but it will nonetheless be run
-- in reverse order that the handlers have been registered, after the scoped block's actions have been finished
registerHandler
  :: MonadUnliftIO m
  => m a
  -- ^ the handler to be registered
  -> Scoped s m ()
registerHandler :: forall {l} (m :: Type -> Type) a (s :: l).
MonadUnliftIO m =>
m a -> Scoped s m ()
registerHandler m a
hdl = (forall b. (() -> m b) -> m b) -> Scoped s m ()
forall {l} {k} (s :: l) (m :: k -> Type) a.
(forall (b :: k). (a -> m b) -> m b) -> Scoped s m a
UnsafeMkScoped \() -> m b
k -> () -> m b
k () m b -> m a -> m b
forall (m :: Type -> Type) a b.
MonadUnliftIO m =>
m a -> m b -> m a
`finally` m a
hdl

-- | A wrapper around 'Control.Exception.bracket' to allocate a resource safely in a 'Scoped' block
--
-- It returns a 'ScopedResource' that belongs to the 'Scoped' block it was allocated in
bracketScoped
  :: MonadUnliftIO m
  => m a
  -- ^ an action that allocates a resource of type @a@
  -> (a -> m b)
  -- ^ an action that deallocates a resource of type @a@
  -> Scoped s m (ScopedResource s a)
bracketScoped :: forall {k} (m :: Type -> Type) a b (s :: k).
MonadUnliftIO m =>
m a -> (a -> m b) -> Scoped s m (ScopedResource s a)
bracketScoped m a
act a -> m b
kfail = (forall b. (ScopedResource s a -> m b) -> m b)
-> Scoped s m (ScopedResource s a)
forall {l} {k} (s :: l) (m :: k -> Type) a.
(forall (b :: k). (a -> m b) -> m b) -> Scoped s m a
UnsafeMkScoped \ScopedResource s a -> m b
k -> m a -> (a -> m b) -> (a -> m b) -> m b
forall (m :: Type -> Type) a b c.
MonadUnliftIO m =>
m a -> (a -> m b) -> (a -> m c) -> m c
bracket m a
act a -> m b
kfail (ScopedResource s a -> m b
k (ScopedResource s a -> m b)
-> (a -> ScopedResource s a) -> a -> m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ScopedResource s a
forall {k} (s :: k) a. a -> ScopedResource s a
UnsafeMkScopedResource)

instance Applicative (Scoped s m) where
  pure :: forall a. a -> Scoped s m a
pure a
a = (forall (b :: k). (a -> m b) -> m b) -> Scoped s m a
forall {l} {k} (s :: l) (m :: k -> Type) a.
(forall (b :: k). (a -> m b) -> m b) -> Scoped s m a
UnsafeMkScoped \a -> m b
k -> a -> m b
k a
a
  <*> :: forall a b. Scoped s m (a -> b) -> Scoped s m a -> Scoped s m b
(<*>) = Scoped s m (a -> b) -> Scoped s m a -> Scoped s m b
forall (m :: Type -> Type) a b. Monad m => m (a -> b) -> m a -> m b
ap

instance Alternative m => Alternative (Scoped s m) where
  empty :: forall a. Scoped s m a
empty = (forall b. (a -> m b) -> m b) -> Scoped s m a
forall {l} {k} (s :: l) (m :: k -> Type) a.
(forall (b :: k). (a -> m b) -> m b) -> Scoped s m a
UnsafeMkScoped (m b -> (a -> m b) -> m b
forall a b. a -> b -> a
const m b
forall a. m a
forall (f :: Type -> Type) a. Alternative f => f a
empty)
  UnsafeMkScoped forall b. (a -> m b) -> m b
a <|> :: forall a. Scoped s m a -> Scoped s m a -> Scoped s m a
<|> UnsafeMkScoped forall b. (a -> m b) -> m b
b = (forall b. (a -> m b) -> m b) -> Scoped s m a
forall {l} {k} (s :: l) (m :: k -> Type) a.
(forall (b :: k). (a -> m b) -> m b) -> Scoped s m a
UnsafeMkScoped (\a -> m b
k -> (a -> m b) -> m b
forall b. (a -> m b) -> m b
a a -> m b
k m b -> m b -> m b
forall a. m a -> m a -> m a
forall (f :: Type -> Type) a. Alternative f => f a -> f a -> f a
<|> (a -> m b) -> m b
forall b. (a -> m b) -> m b
b a -> m b
k)

instance Monad (Scoped s m) where
  UnsafeMkScoped forall (b :: k). (a -> m b) -> m b
m >>= :: forall a b. Scoped s m a -> (a -> Scoped s m b) -> Scoped s m b
>>= a -> Scoped s m b
k = (forall (b :: k). (b -> m b) -> m b) -> Scoped s m b
forall {l} {k} (s :: l) (m :: k -> Type) a.
(forall (b :: k). (a -> m b) -> m b) -> Scoped s m a
UnsafeMkScoped \b -> m b
k' -> (a -> m b) -> m b
forall (b :: k). (a -> m b) -> m b
m \a
a -> Scoped s m b -> forall (b :: k). (b -> m b) -> m b
forall {l} {k} (s :: l) (m :: k -> Type) a.
Scoped s m a -> forall (b :: k). (a -> m b) -> m b
unsafeRunScoped (a -> Scoped s m b
k a
a) b -> m b
k'

instance Alternative m => MonadPlus (Scoped s m)

-- | You can perform 'IO' in a scoped block, but it does not inherit its safety guarantees
instance MonadIO m => MonadIO (Scoped s m) where
  liftIO :: forall a. IO a -> Scoped s m a
liftIO = m a -> Scoped s m a
forall (m :: Type -> Type) a. Monad m => m a -> Scoped s m a
forall (t :: (Type -> Type) -> Type -> Type) (m :: Type -> Type) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> Scoped s m a) -> (IO a -> m a) -> IO a -> Scoped s m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO a -> m a
forall a. IO a -> m a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO

instance MonadFail m => MonadFail (Scoped s m) where
  fail :: forall a. String -> Scoped s m a
fail = m a -> Scoped s m a
forall (m :: Type -> Type) a. Monad m => m a -> Scoped s m a
forall (t :: (Type -> Type) -> Type -> Type) (m :: Type -> Type) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> Scoped s m a) -> (String -> m a) -> String -> Scoped s m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> m a
forall a. String -> m a
forall (m :: Type -> Type) a. MonadFail m => String -> m a
fail

instance MonadTrans (Scoped s) where
  lift :: forall (m :: Type -> Type) a. Monad m => m a -> Scoped s m a
lift m a
m = (forall b. (a -> m b) -> m b) -> Scoped s m a
forall {l} {k} (s :: l) (m :: k -> Type) a.
(forall (b :: k). (a -> m b) -> m b) -> Scoped s m a
UnsafeMkScoped (m a
m m a -> (a -> m b) -> m b
forall a b. m a -> (a -> m b) -> m b
forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>=)