-- | Support for accumulation of values in a shared list.
--
-- @since 2.7.0.0
module Effectful.Output.Static.Shared.List
  ( -- * Effect
    Output

    -- ** Handlers
  , runOutput

    -- ** Operations
  , output
  ) where

import Control.Concurrent.MVar.Strict qualified as S
import Data.Kind

import Effectful
import Effectful.Dispatch.Static
import Effectful.Dispatch.Static.Primitive

-- | Provide access to accumulation of values of type @o@ in a shared list.
data Output (o :: Type) :: Effect

type instance DispatchOf (Output o) = Static NoSideEffects
newtype instance StaticRep (Output o) = Output (S.MVar [o])

-- | Run the 'Output' effect and return the final value along with the
-- accumulated list.
runOutput :: HasCallStack => Eff (Output o : es) a -> Eff es (a, [o])
runOutput :: forall o (es :: [(Type -> Type) -> Type -> Type]) a.
HasCallStack =>
Eff (Output o : es) a -> Eff es (a, [o])
runOutput Eff (Output o : es) a
action = do
  MVar [o]
v <- IO (MVar [o]) -> Eff es (MVar [o])
forall a (es :: [(Type -> Type) -> Type -> Type]). IO a -> Eff es a
unsafeEff_ (IO (MVar [o]) -> Eff es (MVar [o]))
-> IO (MVar [o]) -> Eff es (MVar [o])
forall a b. (a -> b) -> a -> b
$ [o] -> IO (MVar [o])
forall a. a -> IO (MVar a)
S.newMVar []
  a
a <- StaticRep (Output o) -> Eff (Output o : es) a -> Eff es a
forall (e :: (Type -> Type) -> Type -> Type)
       (sideEffects :: SideEffects)
       (es :: [(Type -> Type) -> Type -> Type]) a.
(HasCallStack, DispatchOf e ~ 'Static sideEffects,
 MaybeIOE sideEffects es) =>
StaticRep e -> Eff (e : es) a -> Eff es a
evalStaticRep (MVar [o] -> StaticRep (Output o)
forall o. MVar [o] -> StaticRep (Output o)
Output MVar [o]
v) Eff (Output o : es) a
action
  (a
a, ) ([o] -> (a, [o])) -> ([o] -> [o]) -> [o] -> (a, [o])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [o] -> [o]
forall a. [a] -> [a]
reverse ([o] -> (a, [o])) -> Eff es [o] -> Eff es (a, [o])
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> IO [o] -> Eff es [o]
forall a (es :: [(Type -> Type) -> Type -> Type]). IO a -> Eff es a
unsafeEff_ (MVar [o] -> IO [o]
forall a. MVar a -> IO a
S.readMVar MVar [o]
v)

-- | Append the value to the end of the list.
output
  :: (HasCallStack, Output o :> es)
  => o -- ^ The value.
  -> Eff es ()
output :: forall o (es :: [(Type -> Type) -> Type -> Type]).
(HasCallStack, Output o :> es) =>
o -> Eff es ()
output !o
o = (Env es -> IO ()) -> Eff es ()
forall (es :: [(Type -> Type) -> Type -> Type]) a.
(Env es -> IO a) -> Eff es a
unsafeEff ((Env es -> IO ()) -> Eff es ()) -> (Env es -> IO ()) -> Eff es ()
forall a b. (a -> b) -> a -> b
$ \Env es
es -> do
  Output MVar [o]
v <- Env es -> IO (EffectRep (DispatchOf (Output o)) (Output o))
forall (e :: (Type -> Type) -> Type -> Type)
       (es :: [(Type -> Type) -> Type -> Type]).
(HasCallStack, e :> es) =>
Env es -> IO (EffectRep (DispatchOf e) e)
getEnv Env es
es
  MVar [o] -> ([o] -> IO [o]) -> IO ()
forall a. MVar a -> (a -> IO a) -> IO ()
S.modifyMVar_ MVar [o]
v (([o] -> IO [o]) -> IO ()) -> ([o] -> IO [o]) -> IO ()
forall a b. (a -> b) -> a -> b
$ \[o]
acc -> [o] -> IO [o]
forall a. a -> IO a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (o
o o -> [o] -> [o]
forall a. a -> [a] -> [a]
: [o]
acc)