{-# LANGUAGE UndecidableInstances #-}

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

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

import Control.Applicative (Alternative (empty, (<|>)))
import Control.Monad (MonadPlus (mplus), ap, mzero)
import Control.Monad.Trans.Class (MonadTrans (lift))
import Data.Kind (Constraint, Type)
import Data.Type.Equality (type (~~))
import GHC.Exts (RuntimeRep, TYPE)
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.
--
-- Scoped also works for wrapping unboxed and unlifted monad transformers.
type Scoped :: forall {k} {rep :: RuntimeRep}. [Type] -> (k -> TYPE rep) -> Type -> Type
newtype Scoped s m a = UnsafeMkScoped
  { forall {k} (s :: [Type]) (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
  }

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 :: Type -> Type -> Type
newtype ScopedResource s a = UnsafeMkScopedResource
  { forall s 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 s a.
Eq a =>
ScopedResource s a -> ScopedResource s a -> Bool
$c== :: forall s a.
Eq a =>
ScopedResource s a -> ScopedResource s a -> Bool
== :: ScopedResource s a -> ScopedResource s a -> Bool
$c/= :: forall s 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 s a. Ord a => Eq (ScopedResource s a)
forall s a.
Ord a =>
ScopedResource s a -> ScopedResource s a -> Bool
forall s a.
Ord a =>
ScopedResource s a -> ScopedResource s a -> Ordering
forall s a.
Ord a =>
ScopedResource s a -> ScopedResource s a -> ScopedResource s a
$ccompare :: forall s a.
Ord a =>
ScopedResource s a -> ScopedResource s a -> Ordering
compare :: ScopedResource s a -> ScopedResource s a -> Ordering
$c< :: forall s a.
Ord a =>
ScopedResource s a -> ScopedResource s a -> Bool
< :: ScopedResource s a -> ScopedResource s a -> Bool
$c<= :: forall s a.
Ord a =>
ScopedResource s a -> ScopedResource s a -> Bool
<= :: ScopedResource s a -> ScopedResource s a -> Bool
$c> :: forall s a.
Ord a =>
ScopedResource s a -> ScopedResource s a -> Bool
> :: ScopedResource s a -> ScopedResource s a -> Bool
$c>= :: forall s a.
Ord a =>
ScopedResource s a -> ScopedResource s a -> Bool
>= :: ScopedResource s a -> ScopedResource s a -> Bool
$cmax :: forall s a.
Ord a =>
ScopedResource s a -> ScopedResource s a -> ScopedResource s a
max :: ScopedResource s a -> ScopedResource s a -> ScopedResource s a
$cmin :: forall s 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 s a. Show a => Int -> ScopedResource s a -> ShowS
forall s a. Show a => [ScopedResource s a] -> ShowS
forall s a. Show a => ScopedResource s a -> String
$cshowsPrec :: forall s a. Show a => Int -> ScopedResource s a -> ShowS
showsPrec :: Int -> ScopedResource s a -> ShowS
$cshow :: forall s a. Show a => ScopedResource s a -> String
show :: ScopedResource s a -> String
$cshowList :: forall s a. Show a => [ScopedResource s a] -> ShowS
showList :: [ScopedResource s a] -> ShowS
Show)

-- | when using a resource, all that matters is that the resource can only be used in the scope that it was created in
--   or any scope that is farther in than that scope
--
--   This constraint has to be put to connect the resource and the scope that it was created in
type (:<) :: Type -> [Type] -> Constraint
class s :< ss

instance s :< '[s]

instance {-# INCOHERENT #-} s :< (s : s'' : ss)

instance s :< (s'' : ss) => s :< (s' : s'' : ss)

-- | the 'Scoping' class is there to give overloading to blocks, s.t. we don't have to run different functions
-- depending on whether we run a final block or not.
--
-- This type class is internal since there should not be any more instances and since it is expected that the contraint
-- on 'scoped' is immediately discharged
type Scoping :: [Type] -> (k -> TYPE r) -> (Type -> Type) -> Constraint
class Scoping ss m n | n -> m ss where
  -- | 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 s. Scoped (s : ss) m a) -> n a

instance (Applicative m, m ~ n, l ~ '[]) => Scoping l m n where
  scoped :: forall a. (forall s. Scoped (s : l) m a) -> n a
scoped forall s. Scoped (s : l) m a
act = Scoped (Any : l) n a -> forall b. (a -> n b) -> n b
forall {k} (s :: [Type]) (m :: k -> Type) a.
Scoped s m a -> forall (b :: k). (a -> m b) -> m b
unsafeRunScoped Scoped (Any : l) m a
Scoped (Any : l) n a
forall s. Scoped (s : l) m a
act a -> n a
forall a. a -> n a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure

instance {-# OVERLAPPING #-} Monad m => Scoping (s : ss) m (Scoped (s : ss) m) where
  scoped :: forall a.
(forall s. Scoped (s : s : ss) m a) -> Scoped (s : ss) m a
scoped forall s. Scoped (s : s : ss) m a
act = m a -> Scoped (s : ss) m a
forall (m :: Type -> Type) a. Monad m => m a -> Scoped (s : ss) m a
forall (t :: (Type -> Type) -> Type -> Type) (m :: Type -> Type) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Scoped (Any : s : ss) m a -> forall b. (a -> m b) -> m b
forall {k} (s :: [Type]) (m :: k -> Type) a.
Scoped s m a -> forall (b :: k). (a -> m b) -> m b
unsafeRunScoped Scoped (Any : s : ss) m a
forall s. Scoped (s : s : ss) 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 ss m ()
registerHandler :: forall (m :: Type -> Type) a (ss :: [Type]).
MonadUnliftIO m =>
m a -> Scoped ss m ()
registerHandler m a
hdl = (forall b. (() -> m b) -> m b) -> Scoped ss m ()
forall {k} (s :: [Type]) (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 : ss) m (ScopedResource s a)
bracketScoped :: forall (m :: Type -> Type) a b s (ss :: [Type]).
MonadUnliftIO m =>
m a -> (a -> m b) -> Scoped (s : ss) m (ScopedResource s a)
bracketScoped m a
act a -> m b
kfail = (forall b. (ScopedResource s a -> m b) -> m b)
-> Scoped (s : ss) m (ScopedResource s a)
forall {k} (s :: [Type]) (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 s a. a -> ScopedResource s a
UnsafeMkScopedResource)

instance Functor (Scoped s m) where
  fmap :: forall a b. (a -> b) -> Scoped s m a -> Scoped s m b
fmap a -> b
f (UnsafeMkScoped forall (b :: k). (a -> m b) -> m b
m) = (forall (b :: k). (b -> m b) -> m b) -> Scoped s m b
forall {k} (s :: [Type]) (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 (b -> m b
k (b -> m b) -> (a -> b) -> a -> m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f)
  {-# INLINE fmap #-}

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 {k} (s :: [Type]) (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
  {-# INLINE pure #-}
  <*> :: 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
  {-# INLINE (<*>) #-}

instance (Alternative m', m' ~~ m) => Alternative (Scoped s m) where
  empty :: forall a. Scoped s m a
empty = (forall (b :: k). (a -> m b) -> m b) -> Scoped s m a
forall {k} (s :: [Type]) (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)
  {-# INLINE empty #-}
  UnsafeMkScoped forall (b :: k). (a -> m b) -> m b
a <|> :: forall a. Scoped s m a -> Scoped s m a -> Scoped s m a
<|> UnsafeMkScoped forall (b :: k). (a -> m b) -> m b
b = (forall (b :: k). (a -> m b) -> m b) -> Scoped s m a
forall {k} (s :: [Type]) (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 :: k). (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 :: k). (a -> m b) -> m b
b a -> m b
k)
  {-# INLINE (<|>) #-}

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 {k} (s :: [Type]) (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 {k} (s :: [Type]) (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'
  {-# INLINE (>>=) #-}

instance (Alternative m', m' ~~ m) => MonadPlus (Scoped s m) where
  mplus :: forall a. Scoped s m a -> Scoped s m a -> Scoped s m a
mplus = Scoped s m a -> Scoped s m a -> Scoped s m a
forall a. Scoped s m a -> Scoped s m a -> Scoped s m a
forall (f :: Type -> Type) a. Alternative f => f a -> f a -> f a
(<|>)
  {-# INLINE mplus #-}
  mzero :: forall a. Scoped s m a
mzero = Scoped s m a
forall a. Scoped s m a
forall (f :: Type -> Type) a. Alternative f => f a
empty
  {-# INLINE mzero #-}

-- | You can perform 'IO' in a scoped block, but it does not inherit its safety guarantees
instance (MonadIO m', m' ~~ m) => MonadIO (Scoped s m) where
  liftIO :: forall a. IO a -> Scoped s m a
liftIO = m a -> Scoped s m a
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
  {-# INLINE liftIO #-}

-- | You can 'fail' in a Scoped block
instance (MonadFail m', m' ~~ m) => MonadFail (Scoped s m) where
  fail :: forall a. String -> Scoped s m a
fail = m a -> Scoped s m a
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
  {-# INLINE fail #-}

-- | You can use all the actions you can use in the underlying monad @m@ also in the 'Scoped' monad by 'lift'ing into it.
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 {k} (s :: [Type]) (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
>>=)
  {-# INLINE lift #-}