{-# LANGUAGE TemplateHaskell #-}

module Polysemy.Floodgate
  ( -- * Effect
    Floodgate (..)
    -- * Actions
  , hold
  , release

    -- * Interpretations
  , runFloodgate
  , runFloodgateDry
  ) where

import Control.Monad
import GHC.Types
import Polysemy
import Polysemy.State
import Unsafe.Coerce

------------------------------------------------------------------------------
-- |
--
-- @since 0.3.1.0
data Floodgate m a where
  Hold    :: m () -> Floodgate m ()
  Release :: Floodgate m ()

makeSem ''Floodgate


------------------------------------------------------------------------------
-- |
--
-- @since 0.3.1.0
runFloodgate
    :: Sem (Floodgate ': r) a
    -> Sem r a
runFloodgate :: Sem (Floodgate : r) a -> Sem r a
runFloodgate = (([Any], a) -> a) -> Sem r ([Any], a) -> Sem r a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([Any], a) -> a
forall a b. (a, b) -> b
snd (Sem r ([Any], a) -> Sem r a)
-> (Sem (Floodgate : r) a -> Sem r ([Any], a))
-> Sem (Floodgate : r) a
-> Sem r a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Any] -> Sem (State [Any] : r) a -> Sem r ([Any], a)
forall s (r :: [(* -> *) -> * -> *]) a.
s -> Sem (State s : r) a -> Sem r (s, a)
runState @[Any] [] (Sem (State [Any] : r) a -> Sem r ([Any], a))
-> (Sem (Floodgate : r) a -> Sem (State [Any] : r) a)
-> Sem (Floodgate : r) a
-> Sem r ([Any], a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall (rInitial :: [(* -> *) -> * -> *]) x.
 Floodgate (Sem rInitial) x
 -> Tactical Floodgate (Sem rInitial) (State [Any] : r) x)
-> Sem (Floodgate : r) a -> Sem (State [Any] : r) a
forall (e1 :: (* -> *) -> * -> *) (e2 :: (* -> *) -> * -> *)
       (r :: [(* -> *) -> * -> *]) a.
(forall (rInitial :: [(* -> *) -> * -> *]) x.
 e1 (Sem rInitial) x -> Tactical e1 (Sem rInitial) (e2 : r) x)
-> Sem (e1 : r) a -> Sem (e2 : r) a
reinterpretH
  ( \case
      Hold m -> do
        Sem (Floodgate : State [Any] : r) ()
m' <- (Sem (Floodgate : State [Any] : r) (f ())
 -> Sem (Floodgate : State [Any] : r) ())
-> Sem
     (WithTactics Floodgate f (Sem rInitial) (State [Any] : r))
     (Sem (Floodgate : State [Any] : r) (f ()))
-> Sem
     (WithTactics Floodgate f (Sem rInitial) (State [Any] : r))
     (Sem (Floodgate : State [Any] : r) ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Sem (Floodgate : State [Any] : r) (f ())
-> Sem (Floodgate : State [Any] : r) ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Sem
   (WithTactics Floodgate f (Sem rInitial) (State [Any] : r))
   (Sem (Floodgate : State [Any] : r) (f ()))
 -> Sem
      (WithTactics Floodgate f (Sem rInitial) (State [Any] : r))
      (Sem (Floodgate : State [Any] : r) ()))
-> Sem
     (WithTactics Floodgate f (Sem rInitial) (State [Any] : r))
     (Sem (Floodgate : State [Any] : r) (f ()))
-> Sem
     (WithTactics Floodgate f (Sem rInitial) (State [Any] : r))
     (Sem (Floodgate : State [Any] : r) ())
forall a b. (a -> b) -> a -> b
$ Sem rInitial ()
-> Sem
     (WithTactics Floodgate f (Sem rInitial) (State [Any] : r))
     (Sem (Floodgate : State [Any] : r) (f ()))
forall (m :: * -> *) a (e :: (* -> *) -> * -> *) (f :: * -> *)
       (r :: [(* -> *) -> * -> *]).
m a -> Sem (WithTactics e f m r) (Sem (e : r) (f a))
runT Sem rInitial ()
m
        -- These 'Any's are here because the monadic action references 'r', and
        -- if we exposed that, 'r' would be an infinite type
        ([Any] -> [Any])
-> Sem
     (WithTactics Floodgate f (Sem rInitial) (State [Any] : r)) ()
forall s (r :: [(* -> *) -> * -> *]).
Member (State s) r =>
(s -> s) -> Sem r ()
modify (Sem (Any : State [Any] : r) () -> Any
forall a b. a -> b
unsafeCoerce @_ @Any (Sem (State [Any] : r) () -> Sem (Any : State [Any] : r) ()
forall (e :: (* -> *) -> * -> *) (r :: [(* -> *) -> * -> *]) a.
Sem r a -> Sem (e : r) a
raise (Sem (State [Any] : r) () -> Sem (Any : State [Any] : r) ())
-> Sem (State [Any] : r) () -> Sem (Any : State [Any] : r) ()
forall a b. (a -> b) -> a -> b
$ Sem (Floodgate : State [Any] : r) () -> Sem (State [Any] : r) ()
forall (r :: [(* -> *) -> * -> *]) a.
Sem (Floodgate : r) a -> Sem r a
runFloodgate Sem (Floodgate : State [Any] : r) ()
m') Any -> [Any] -> [Any]
forall a. a -> [a] -> [a]
:)
        Sem
  (WithTactics Floodgate f (Sem rInitial) (State [Any] : r)) (f x)
forall (f :: * -> *) (m :: * -> *) (r :: [(* -> *) -> * -> *])
       (e :: (* -> *) -> * -> *).
Sem (WithTactics e f m r) (f ())
getInitialStateT

      Floodgate (Sem rInitial) x
Release -> do
        [Sem
   (WithTactics Floodgate f (Sem rInitial) (State [Any] : r)) Any]
ms' <- ([Any]
 -> [Sem
       (WithTactics Floodgate f (Sem rInitial) (State [Any] : r)) Any])
-> Sem
     (WithTactics Floodgate f (Sem rInitial) (State [Any] : r))
     [Sem
        (WithTactics Floodgate f (Sem rInitial) (State [Any] : r)) Any]
forall s a (r :: [(* -> *) -> * -> *]).
Member (State s) r =>
(s -> a) -> Sem r a
gets @[Any] ((Any
 -> Sem
      (WithTactics Floodgate f (Sem rInitial) (State [Any] : r)) Any)
-> [Any]
-> [Sem
      (WithTactics Floodgate f (Sem rInitial) (State [Any] : r)) Any]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Any
-> Sem
     (WithTactics Floodgate f (Sem rInitial) (State [Any] : r)) Any
forall a b. a -> b
unsafeCoerce ([Any]
 -> [Sem
       (WithTactics Floodgate f (Sem rInitial) (State [Any] : r)) Any])
-> ([Any] -> [Any])
-> [Any]
-> [Sem
      (WithTactics Floodgate f (Sem rInitial) (State [Any] : r)) Any]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Any] -> [Any]
forall a. [a] -> [a]
reverse)
        [Sem
   (WithTactics Floodgate f (Sem rInitial) (State [Any] : r)) Any]
-> Sem
     (WithTactics Floodgate f (Sem rInitial) (State [Any] : r)) ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ [Sem
   (WithTactics Floodgate f (Sem rInitial) (State [Any] : r)) Any]
ms'
        Sem
  (WithTactics Floodgate f (Sem rInitial) (State [Any] : r)) (f x)
forall (f :: * -> *) (m :: * -> *) (r :: [(* -> *) -> * -> *])
       (e :: (* -> *) -> * -> *).
Sem (WithTactics e f m r) (f ())
getInitialStateT
  )


------------------------------------------------------------------------------
-- | Like 'runFloodgate', but will do a final flush to 'release' anything that
-- might still be behind the floodgate.
--
-- @since 0.3.1.0
runFloodgateDry
    :: Sem (Floodgate ': r) a
    -> Sem r a
runFloodgateDry :: Sem (Floodgate : r) a -> Sem r a
runFloodgateDry Sem (Floodgate : r) a
m = Sem (Floodgate : r) a -> Sem r a
forall (r :: [(* -> *) -> * -> *]) a.
Sem (Floodgate : r) a -> Sem r a
runFloodgate (Sem (Floodgate : r) a -> Sem r a)
-> Sem (Floodgate : r) a -> Sem r a
forall a b. (a -> b) -> a -> b
$ Sem (Floodgate : r) a
m Sem (Floodgate : r) a
-> Sem (Floodgate : r) () -> Sem (Floodgate : r) a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Sem (Floodgate : r) ()
forall (r :: [(* -> *) -> * -> *]). Member Floodgate r => Sem r ()
release