{-# LANGUAGE TemplateHaskell #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Control.Effect.Managed
-- Copyright   :  (c) Michael Szvetits, 2020
-- License     :  BSD3 (see the file LICENSE)
-- Maintainer  :  typedbyte@qualified.name
-- Stability   :  stable
-- Portability :  portable
--
-- The managed effect allows a computation to allocate resources which are
-- guaranteed to be released after the end of the computation. This effect
-- provides a monadic interface for managing one or more long-living
-- resources in a more readable way than nesting 'IO.bracket'-style
-- operations of the "Control.Effect.Resource" effect.
-----------------------------------------------------------------------------
module Control.Effect.Managed
  ( -- * Tagged Managed Effect
    Managed'(..)
    -- * Untagged Managed Effect
    -- | If you don't require disambiguation of multiple managed effects
    -- (i.e., you only have one managed effect in your monadic context),
    -- it is recommended to always use the untagged managed effect.
  , Managed
  , manage
    -- * Interpretations
  , Bracket
  , runManaged'
  , runManaged
    -- * Tagging and Untagging
    -- | Conversion functions between the tagged and untagged managed effect,
    -- usually used in combination with type applications, like:
    --
    -- @
    --     'tagManaged'' \@\"newTag\" program
    --     'retagManaged'' \@\"oldTag\" \@\"newTag\" program
    --     'untagManaged'' \@\"erasedTag\" program
    -- @
    -- 
  , tagManaged'
  , retagManaged'
  , untagManaged'
  ) where

-- base
import qualified Control.Exception as IO
import Data.IORef (IORef, atomicModifyIORef', newIORef, readIORef)

-- transformers
import Control.Monad.Trans.Reader (ReaderT(ReaderT), runReaderT)

import Control.Effect.Machinery

-- | An effect that allows a computation to allocate resources which are
-- guaranteed to be released after the computation.
--
-- @since 0.3.0.0
class Monad m => Managed' tag m where
  -- | Acquire a resource by specifying an acquisition action and a release
  -- action to be used for cleanup after the computation.
  --
  -- @since 0.3.0.0
  manage' :: m a        -- ^ The computation which acquires the resource.
          -> (a -> m b) -- ^ The computation which releases the resource.
          -> m a        -- ^ The acquired resource.

makeTaggedEffect ''Managed'

-- | The bracket-based interpreter of the managed effect. This type implements
-- the 'Managed'' type class by using 'IO.bracket', thus requiring 'IO' at the
-- bottom of the monad transformer stack.
--
-- When interpreting the effect, you usually don\'t interact with this type directly,
-- but instead use one of its corresponding interpretation functions.
--
-- @since 0.3.0.0
newtype Bracket n m a = Bracket { Bracket n m a -> ReaderT (IORef [n ()]) m a
runBracket :: ReaderT (IORef [n ()]) m a }
  deriving (Functor (Bracket n m)
a -> Bracket n m a
Functor (Bracket n m) =>
(forall a. a -> Bracket n m a)
-> (forall a b.
    Bracket n m (a -> b) -> Bracket n m a -> Bracket n m b)
-> (forall a b c.
    (a -> b -> c) -> Bracket n m a -> Bracket n m b -> Bracket n m c)
-> (forall a b. Bracket n m a -> Bracket n m b -> Bracket n m b)
-> (forall a b. Bracket n m a -> Bracket n m b -> Bracket n m a)
-> Applicative (Bracket n m)
Bracket n m a -> Bracket n m b -> Bracket n m b
Bracket n m a -> Bracket n m b -> Bracket n m a
Bracket n m (a -> b) -> Bracket n m a -> Bracket n m b
(a -> b -> c) -> Bracket n m a -> Bracket n m b -> Bracket n m c
forall a. a -> Bracket n m a
forall a b. Bracket n m a -> Bracket n m b -> Bracket n m a
forall a b. Bracket n m a -> Bracket n m b -> Bracket n m b
forall a b. Bracket n m (a -> b) -> Bracket n m a -> Bracket n m b
forall a b c.
(a -> b -> c) -> Bracket n m a -> Bracket n m b -> Bracket n m c
forall (f :: SomeMonad).
Functor f =>
(forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
forall (n :: SomeMonad) (m :: SomeMonad).
Applicative m =>
Functor (Bracket n m)
forall (n :: SomeMonad) (m :: SomeMonad) a.
Applicative m =>
a -> Bracket n m a
forall (n :: SomeMonad) (m :: SomeMonad) a b.
Applicative m =>
Bracket n m a -> Bracket n m b -> Bracket n m a
forall (n :: SomeMonad) (m :: SomeMonad) a b.
Applicative m =>
Bracket n m a -> Bracket n m b -> Bracket n m b
forall (n :: SomeMonad) (m :: SomeMonad) a b.
Applicative m =>
Bracket n m (a -> b) -> Bracket n m a -> Bracket n m b
forall (n :: SomeMonad) (m :: SomeMonad) a b c.
Applicative m =>
(a -> b -> c) -> Bracket n m a -> Bracket n m b -> Bracket n m c
<* :: Bracket n m a -> Bracket n m b -> Bracket n m a
$c<* :: forall (n :: SomeMonad) (m :: SomeMonad) a b.
Applicative m =>
Bracket n m a -> Bracket n m b -> Bracket n m a
*> :: Bracket n m a -> Bracket n m b -> Bracket n m b
$c*> :: forall (n :: SomeMonad) (m :: SomeMonad) a b.
Applicative m =>
Bracket n m a -> Bracket n m b -> Bracket n m b
liftA2 :: (a -> b -> c) -> Bracket n m a -> Bracket n m b -> Bracket n m c
$cliftA2 :: forall (n :: SomeMonad) (m :: SomeMonad) a b c.
Applicative m =>
(a -> b -> c) -> Bracket n m a -> Bracket n m b -> Bracket n m c
<*> :: Bracket n m (a -> b) -> Bracket n m a -> Bracket n m b
$c<*> :: forall (n :: SomeMonad) (m :: SomeMonad) a b.
Applicative m =>
Bracket n m (a -> b) -> Bracket n m a -> Bracket n m b
pure :: a -> Bracket n m a
$cpure :: forall (n :: SomeMonad) (m :: SomeMonad) a.
Applicative m =>
a -> Bracket n m a
$cp1Applicative :: forall (n :: SomeMonad) (m :: SomeMonad).
Applicative m =>
Functor (Bracket n m)
Applicative, a -> Bracket n m b -> Bracket n m a
(a -> b) -> Bracket n m a -> Bracket n m b
(forall a b. (a -> b) -> Bracket n m a -> Bracket n m b)
-> (forall a b. a -> Bracket n m b -> Bracket n m a)
-> Functor (Bracket n m)
forall a b. a -> Bracket n m b -> Bracket n m a
forall a b. (a -> b) -> Bracket n m a -> Bracket n m b
forall (f :: SomeMonad).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
forall (n :: SomeMonad) (m :: SomeMonad) a b.
Functor m =>
a -> Bracket n m b -> Bracket n m a
forall (n :: SomeMonad) (m :: SomeMonad) a b.
Functor m =>
(a -> b) -> Bracket n m a -> Bracket n m b
<$ :: a -> Bracket n m b -> Bracket n m a
$c<$ :: forall (n :: SomeMonad) (m :: SomeMonad) a b.
Functor m =>
a -> Bracket n m b -> Bracket n m a
fmap :: (a -> b) -> Bracket n m a -> Bracket n m b
$cfmap :: forall (n :: SomeMonad) (m :: SomeMonad) a b.
Functor m =>
(a -> b) -> Bracket n m a -> Bracket n m b
Functor, Applicative (Bracket n m)
a -> Bracket n m a
Applicative (Bracket n m) =>
(forall a b.
 Bracket n m a -> (a -> Bracket n m b) -> Bracket n m b)
-> (forall a b. Bracket n m a -> Bracket n m b -> Bracket n m b)
-> (forall a. a -> Bracket n m a)
-> Monad (Bracket n m)
Bracket n m a -> (a -> Bracket n m b) -> Bracket n m b
Bracket n m a -> Bracket n m b -> Bracket n m b
forall a. a -> Bracket n m a
forall a b. Bracket n m a -> Bracket n m b -> Bracket n m b
forall a b. Bracket n m a -> (a -> Bracket n m b) -> Bracket n m b
forall (m :: SomeMonad).
Applicative m =>
(forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
forall (n :: SomeMonad) (m :: SomeMonad).
Monad m =>
Applicative (Bracket n m)
forall (n :: SomeMonad) (m :: SomeMonad) a.
Monad m =>
a -> Bracket n m a
forall (n :: SomeMonad) (m :: SomeMonad) a b.
Monad m =>
Bracket n m a -> Bracket n m b -> Bracket n m b
forall (n :: SomeMonad) (m :: SomeMonad) a b.
Monad m =>
Bracket n m a -> (a -> Bracket n m b) -> Bracket n m b
return :: a -> Bracket n m a
$creturn :: forall (n :: SomeMonad) (m :: SomeMonad) a.
Monad m =>
a -> Bracket n m a
>> :: Bracket n m a -> Bracket n m b -> Bracket n m b
$c>> :: forall (n :: SomeMonad) (m :: SomeMonad) a b.
Monad m =>
Bracket n m a -> Bracket n m b -> Bracket n m b
>>= :: Bracket n m a -> (a -> Bracket n m b) -> Bracket n m b
$c>>= :: forall (n :: SomeMonad) (m :: SomeMonad) a b.
Monad m =>
Bracket n m a -> (a -> Bracket n m b) -> Bracket n m b
$cp1Monad :: forall (n :: SomeMonad) (m :: SomeMonad).
Monad m =>
Applicative (Bracket n m)
Monad, Monad (Bracket n m)
Monad (Bracket n m) =>
(forall a. IO a -> Bracket n m a) -> MonadIO (Bracket n m)
IO a -> Bracket n m a
forall a. IO a -> Bracket n m a
forall (m :: SomeMonad).
Monad m =>
(forall a. IO a -> m a) -> MonadIO m
forall (n :: SomeMonad) (m :: SomeMonad).
MonadIO m =>
Monad (Bracket n m)
forall (n :: SomeMonad) (m :: SomeMonad) a.
MonadIO m =>
IO a -> Bracket n m a
liftIO :: IO a -> Bracket n m a
$cliftIO :: forall (n :: SomeMonad) (m :: SomeMonad) a.
MonadIO m =>
IO a -> Bracket n m a
$cp1MonadIO :: forall (n :: SomeMonad) (m :: SomeMonad).
MonadIO m =>
Monad (Bracket n m)
MonadIO)
  deriving (m a -> Bracket n m a
(forall (m :: SomeMonad) a. Monad m => m a -> Bracket n m a)
-> MonadTrans (Bracket n)
forall (m :: SomeMonad) a. Monad m => m a -> Bracket n m a
forall (n :: SomeMonad) (m :: SomeMonad) a.
Monad m =>
m a -> Bracket n m a
forall (t :: SomeMonad -> SomeMonad).
(forall (m :: SomeMonad) a. Monad m => m a -> t m a)
-> MonadTrans t
lift :: m a -> Bracket n m a
$clift :: forall (n :: SomeMonad) (m :: SomeMonad) a.
Monad m =>
m a -> Bracket n m a
MonadTrans, MonadTrans (Bracket n)
m (StT (Bracket n) a) -> Bracket n m a
MonadTrans (Bracket n) =>
(forall (m :: SomeMonad) a.
 Monad m =>
 (Run (Bracket n) -> m a) -> Bracket n m a)
-> (forall (m :: SomeMonad) a.
    Monad m =>
    m (StT (Bracket n) a) -> Bracket n m a)
-> MonadTransControl (Bracket n)
(Run (Bracket n) -> m a) -> Bracket n m a
forall (n :: SomeMonad). MonadTrans (Bracket n)
forall (m :: SomeMonad) a.
Monad m =>
m (StT (Bracket n) a) -> Bracket n m a
forall (m :: SomeMonad) a.
Monad m =>
(Run (Bracket n) -> m a) -> Bracket n m a
forall (n :: SomeMonad) (m :: SomeMonad) a.
Monad m =>
m (StT (Bracket n) a) -> Bracket n m a
forall (n :: SomeMonad) (m :: SomeMonad) a.
Monad m =>
(Run (Bracket n) -> m a) -> Bracket n m a
forall (t :: SomeMonad -> SomeMonad).
MonadTrans t =>
(forall (m :: SomeMonad) a. Monad m => (Run t -> m a) -> t m a)
-> (forall (m :: SomeMonad) a. Monad m => m (StT t a) -> t m a)
-> MonadTransControl t
restoreT :: m (StT (Bracket n) a) -> Bracket n m a
$crestoreT :: forall (n :: SomeMonad) (m :: SomeMonad) a.
Monad m =>
m (StT (Bracket n) a) -> Bracket n m a
liftWith :: (Run (Bracket n) -> m a) -> Bracket n m a
$cliftWith :: forall (n :: SomeMonad) (m :: SomeMonad) a.
Monad m =>
(Run (Bracket n) -> m a) -> Bracket n m a
$cp1MonadTransControl :: forall (n :: SomeMonad). MonadTrans (Bracket n)
MonadTransControl)
  deriving (MonadBase b, MonadBaseControl b)

instance MonadBase IO m => Managed' tag (Bracket m m) where
  manage' :: Bracket m m a -> (a -> Bracket m m b) -> Bracket m m a
manage' alloc :: Bracket m m a
alloc free :: a -> Bracket m m b
free = ReaderT (IORef [m ()]) m a -> Bracket m m a
forall (n :: SomeMonad) (m :: SomeMonad) a.
ReaderT (IORef [n ()]) m a -> Bracket n m a
Bracket (ReaderT (IORef [m ()]) m a -> Bracket m m a)
-> ((IORef [m ()] -> m a) -> ReaderT (IORef [m ()]) m a)
-> (IORef [m ()] -> m a)
-> Bracket m m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (IORef [m ()] -> m a) -> ReaderT (IORef [m ()]) m a
forall r (m :: SomeMonad) a. (r -> m a) -> ReaderT r m a
ReaderT ((IORef [m ()] -> m a) -> Bracket m m a)
-> (IORef [m ()] -> m a) -> Bracket m m a
forall a b. (a -> b) -> a -> b
$
    \ref :: IORef [m ()]
ref -> do
      a
a <- ReaderT (IORef [m ()]) m a -> IORef [m ()] -> m a
forall r (m :: SomeMonad) a. ReaderT r m a -> r -> m a
runReaderT (Bracket m m a -> ReaderT (IORef [m ()]) m a
forall (n :: SomeMonad) (m :: SomeMonad) a.
Bracket n m a -> ReaderT (IORef [n ()]) m a
runBracket Bracket m m a
alloc) IORef [m ()]
ref
      IO () -> m ()
forall (b :: SomeMonad) (m :: SomeMonad) α.
MonadBase b m =>
b α -> m α
liftBase (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$
        IORef [m ()] -> ([m ()] -> ([m ()], ())) -> IO ()
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef' IORef [m ()]
ref (([m ()] -> ([m ()], ())) -> IO ())
-> ([m ()] -> ([m ()], ())) -> IO ()
forall a b. (a -> b) -> a -> b
$
          \frees :: [m ()]
frees -> (ReaderT (IORef [m ()]) m () -> IORef [m ()] -> m ()
forall r (m :: SomeMonad) a. ReaderT r m a -> r -> m a
runReaderT (Bracket m m () -> ReaderT (IORef [m ()]) m ()
forall (n :: SomeMonad) (m :: SomeMonad) a.
Bracket n m a -> ReaderT (IORef [n ()]) m a
runBracket (a -> Bracket m m b
free a
a Bracket m m b -> Bracket m m () -> Bracket m m ()
forall (m :: SomeMonad) a b. Monad m => m a -> m b -> m b
>> () -> Bracket m m ()
forall (f :: SomeMonad) a. Applicative f => a -> f a
pure ())) IORef [m ()]
ref m () -> [m ()] -> [m ()]
forall a. a -> [a] -> [a]
: [m ()]
frees, ())
      a -> m a
forall (f :: SomeMonad) a. Applicative f => a -> f a
pure a
a
  {-# INLINE manage' #-}

-- | Runs the managed effect using 'IO.bracket'.
--
-- @since 0.3.0.0
runManaged' :: forall tag m a. MonadBaseControl IO m => (Managed' tag `Via` Bracket m) m a -> m a
runManaged' :: Via (Managed' tag) (Bracket m) m a -> m a
runManaged' program :: Via (Managed' tag) (Bracket m) m a
program =
  m (IORef [m ()])
-> (IORef [m ()] -> m ()) -> (IORef [m ()] -> m a) -> m a
forall (n :: SomeMonad) b c d.
MonadBaseControl IO n =>
n b -> (b -> n c) -> (b -> n d) -> n d
liftedBracket
    ( m (IORef [m ()])
forall (n :: SomeMonad). MonadBase IO n => n (IORef [n ()])
allocRef )
    ( IORef [m ()] -> m ()
forall (n :: SomeMonad). MonadBase IO n => IORef [n ()] -> n ()
freeRef  )
    ( ReaderT (IORef [m ()]) m a -> IORef [m ()] -> m a
forall r (m :: SomeMonad) a. ReaderT r m a -> r -> m a
runReaderT (Bracket m m a -> ReaderT (IORef [m ()]) m a
forall (n :: SomeMonad) (m :: SomeMonad) a.
Bracket n m a -> ReaderT (IORef [n ()]) m a
runBracket (Via (Managed' tag) (Bracket m) m a -> Bracket m m a
forall (effs :: [Effect]) (t :: SomeMonad -> SomeMonad)
       (m :: SomeMonad) a.
EachVia effs t m a -> t m a
runVia Via (Managed' tag) (Bracket m) m a
program)) )
  where
    allocRef :: forall n. MonadBase IO n => n (IORef [n ()])
    allocRef :: n (IORef [n ()])
allocRef = IO (IORef [n ()]) -> n (IORef [n ()])
forall (b :: SomeMonad) (m :: SomeMonad) α.
MonadBase b m =>
b α -> m α
liftBase (IO (IORef [n ()]) -> n (IORef [n ()]))
-> IO (IORef [n ()]) -> n (IORef [n ()])
forall a b. (a -> b) -> a -> b
$ [n ()] -> IO (IORef [n ()])
forall a. a -> IO (IORef a)
newIORef []
    
    freeRef :: forall n. MonadBase IO n => IORef [n ()] -> n ()
    freeRef :: IORef [n ()] -> n ()
freeRef = ([n ()] -> n ()
forall (t :: SomeMonad) (m :: SomeMonad) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ ([n ()] -> n ()) -> n [n ()] -> n ()
forall (m :: SomeMonad) a b. Monad m => (a -> m b) -> m a -> m b
=<<) (n [n ()] -> n ())
-> (IORef [n ()] -> n [n ()]) -> IORef [n ()] -> n ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO [n ()] -> n [n ()]
forall (b :: SomeMonad) (m :: SomeMonad) α.
MonadBase b m =>
b α -> m α
liftBase (IO [n ()] -> n [n ()])
-> (IORef [n ()] -> IO [n ()]) -> IORef [n ()] -> n [n ()]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IORef [n ()] -> IO [n ()]
forall a. IORef a -> IO a
readIORef
    
    liftedBracket :: forall n b c d. MonadBaseControl IO n => n b -> (b -> n c) -> (b -> n d) -> n d
    liftedBracket :: n b -> (b -> n c) -> (b -> n d) -> n d
liftedBracket alloc :: n b
alloc free :: b -> n c
free use :: b -> n d
use =
      (RunInBase n IO -> IO (StM n d)) -> n d
forall (b :: SomeMonad) (m :: SomeMonad) a.
MonadBaseControl b m =>
(RunInBase m b -> b (StM m a)) -> m a
control ((RunInBase n IO -> IO (StM n d)) -> n d)
-> (RunInBase n IO -> IO (StM n d)) -> n d
forall a b. (a -> b) -> a -> b
$ \run :: RunInBase n IO
run ->
        IO (StM n b)
-> (StM n b -> IO (StM n c))
-> (StM n b -> IO (StM n d))
-> IO (StM n d)
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
IO.bracket
          ( n b -> IO (StM n b)
RunInBase n IO
run n b
alloc )
          ( \a :: StM n b
a -> n c -> IO (StM n c)
RunInBase n IO
run (StM n b -> n b
forall (b :: SomeMonad) (m :: SomeMonad) a.
MonadBaseControl b m =>
StM m a -> m a
restoreM StM n b
a n b -> (b -> n c) -> n c
forall (m :: SomeMonad) a b. Monad m => m a -> (a -> m b) -> m b
>>= b -> n c
free) )
          ( \a :: StM n b
a -> n d -> IO (StM n d)
RunInBase n IO
run (StM n b -> n b
forall (b :: SomeMonad) (m :: SomeMonad) a.
MonadBaseControl b m =>
StM m a -> m a
restoreM StM n b
a n b -> (b -> n d) -> n d
forall (m :: SomeMonad) a b. Monad m => m a -> (a -> m b) -> m b
>>= b -> n d
use) )
{-# INLINE runManaged' #-}

-- | The untagged version of 'runManaged''.
--
-- @since 0.3.0.0
runManaged :: MonadBaseControl IO m => (Managed `Via` Bracket m) m a -> m a
runManaged :: Via (Managed' G) (Bracket m) m a -> m a
runManaged = forall k (tag :: k) (m :: SomeMonad) a.
MonadBaseControl IO m =>
Via (Managed' tag) (Bracket m) m a -> m a
forall (m :: SomeMonad) a.
MonadBaseControl IO m =>
Via (Managed' G) (Bracket m) m a -> m a
runManaged' @G
{-# INLINE runManaged #-}