{-# LANGUAGE UnicodeSyntax #-}

{- |
Description : MonadAllocate-conferring transformer for no-continuation monads
Copyright   : Copyright 2022 Shea Levy.
License     : Apache-2.0
Maintainer  : shea@shealevy.com

This module defines a 'MonadTrans'former, 'NoContinuationResourceT', which allows for
running t'Control.Monad.Allocate.MonadAllocate' code in pure 'PrimMonad's. This allows
for writing monad-generic resource-safe code and freely switching between
t'Control.Monad.Trans.Resource.ResourceT' on top of 'IO' and the pure 'NoContinuationResourceT'
on top of 'Control.Monad.ST.ST'.
-}
module Control.Monad.NoContinuation.Resource
  ( NoContinuationResourceT
  , runNoContinuationResourceT
  , StupidlyManyResources (..)
  )
where

import Control.Monad
import Control.Monad.NoContinuation.Resource.Internal
import Control.Monad.Primitive
import Control.Monad.Reader
import Control.Monad.With
import Data.GeneralAllocate
import Data.IntMap.Strict as IntMap
import Data.Primitive.MutVar

-- | Run a 'NoContinuationResourceT' computation, freeing all resources before continuing.
runNoContinuationResourceT ∷ (PrimMonad m, MonadWith m) ⇒ NoContinuationResourceT m a → m a
runNoContinuationResourceT :: forall (m :: * -> *) a.
(PrimMonad m, MonadWith m) =>
NoContinuationResourceT m a -> m a
runNoContinuationResourceT (NoContinuationResourceT ReaderT (MutVar (PrimState m) (NoContinuationReleaseMap m)) m a
r) = do
  let cleanup' :: [(a, t -> f ())] -> t -> f ()
cleanup' [] t
_ = forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
      cleanup' ((a
_, t -> f ()
rel) : [(a, t -> f ())]
tl) t
res = forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a b. MonadWith m => m a -> m b -> m (a, b)
generalFinally (t -> f ()
rel t
res) ([(a, t -> f ())] -> t -> f ()
cleanup' [(a, t -> f ())]
tl t
res)
      cleanup :: MutVar (PrimState m) (NoContinuationReleaseMap m)
-> GeneralReleaseType (WithException m) a -> m ()
cleanup MutVar (PrimState m) (NoContinuationReleaseMap m)
st GeneralReleaseType (WithException m) a
res = do
        IntMap (GeneralReleaseType (WithException m) () -> m ())
actions ← forall (m :: * -> *).
NoContinuationReleaseMap m
-> IntMap (GeneralReleaseType (WithException m) () -> m ())
releaseActions forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a.
PrimMonad m =>
MutVar (PrimState m) a -> m a
readMutVar MutVar (PrimState m) (NoContinuationReleaseMap m)
st
        forall {f :: * -> *} {a} {t}.
MonadWith f =>
[(a, t -> f ())] -> t -> f ()
cleanup' (forall a. IntMap a -> [(Key, a)]
toAscList IntMap (GeneralReleaseType (WithException m) () -> m ())
actions) (forall (f :: * -> *) a. Functor f => f a -> f ()
void GeneralReleaseType (WithException m) a
res)
      alloc :: GeneralAllocate
  m
  (WithException m)
  ()
  releaseArg
  (MutVar (PrimState m) (NoContinuationReleaseMap m))
alloc = forall (m :: * -> *) e releaseReturn releaseArg a.
((forall x. m x -> m x)
 -> m (GeneralAllocated m e releaseReturn releaseArg a))
-> GeneralAllocate m e releaseReturn releaseArg a
GeneralAllocate forall a b. (a -> b) -> a -> b
$ \forall x. m x -> m x
restore → do
        MutVar (PrimState m) (NoContinuationReleaseMap m)
st ←
          forall x. m x -> m x
restore forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a.
PrimMonad m =>
a -> m (MutVar (PrimState m) a)
newMutVar forall a b. (a -> b) -> a -> b
$
            NoContinuationReleaseMap
              { nextKey :: Key
nextKey = forall a. Bounded a => a
maxBound
              , releaseActions :: IntMap (GeneralReleaseType (WithException m) () -> m ())
releaseActions = forall a. IntMap a
IntMap.empty
              }
        forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) e releaseReturn releaseArg a.
a
-> (GeneralReleaseType e releaseArg -> m releaseReturn)
-> GeneralAllocated m e releaseReturn releaseArg a
GeneralAllocated MutVar (PrimState m) (NoContinuationReleaseMap m)
st (forall {m :: * -> *} {a}.
(PrimMonad m, MonadWith m) =>
MutVar (PrimState m) (NoContinuationReleaseMap m)
-> GeneralReleaseType (WithException m) a -> m ()
cleanup MutVar (PrimState m) (NoContinuationReleaseMap m)
st)
  forall (m :: * -> *) b a.
MonadWith m =>
With m b a -> (a -> m b) -> m b
generalWith forall {releaseArg}.
GeneralAllocate
  m
  (WithException m)
  ()
  releaseArg
  (MutVar (PrimState m) (NoContinuationReleaseMap m))
alloc (forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT (MutVar (PrimState m) (NoContinuationReleaseMap m)) m a
r)