{-# LANGUAGE BlockArguments, DerivingVia #-}
module Control.Effect.Writer
  ( -- * Effects
    Tell(..)
  , Listen(..)
  , Pass(..)
  , Writer

  -- * Actions
  , tell
  , listen
  , pass
  , censor

  -- * Interpretations for 'Tell'
  , runTell

  , runTellLazy

  , runTellList

  , runTellListLazy

  , tellToIO
  , runTellIORef
  , runTellTVar

  , tellIntoEndoTell

  , tellToTell
  , tellIntoTell

  -- * Simple variants of interpretations for 'Tell'
  , tellToIOSimple
  , runTellIORefSimple
  , runTellTVarSimple

  , tellToTellSimple
  , tellIntoTellSimple

  -- * Interpretations for 'Tell' + 'Listen'
  , runListen

  , runListenLazy

  , listenToIO
  , runListenTVar

  , listenIntoEndoListen

  -- * Interpretations for 'Writer' ('Tell' + 'Listen' + 'Pass')
  , runWriter

  , runWriterLazy

  , writerToIO
  , runWriterTVar

  , writerToBracket
  , writerToBracketTVar

  , writerIntoEndoWriter

    -- * Other utilities
  , fromEndoWriter

    -- * Threading constraints
  , WriterThreads
  , WriterLazyThreads

    -- * MonadMask
  , C.MonadMask

    -- * Carriers
  , TellC
  , TellLazyC
  , TellListC
  , TellListLazyC
  , TellIntoEndoTellC
  , ListenC
  , ListenLazyC
  , ListenTVarC
  , ListenIntoEndoListenC
  , WriterC
  , WriterLazyC
  , WriterTVarC
  , WriterToBracketC
  , WriterIntoEndoWriterC
  ) where

import Data.Bifunctor
import Data.Semigroup
import Data.Tuple (swap)
import Data.IORef

import Control.Concurrent.STM

import Control.Monad

import Control.Effect
import Control.Effect.Reader
import Control.Effect.Bracket
import Control.Effect.Type.ListenPrim
import Control.Effect.Type.WriterPrim

import Control.Effect.Carrier
import Control.Effect.Internal.Writer

import qualified Control.Monad.Catch as C

import qualified Control.Monad.Trans.Writer.CPS as W
import qualified Control.Monad.Trans.Writer.Lazy as LW

-- For coercion purposes
import Control.Effect.Internal.Utils
import Control.Effect.Carrier.Internal.Interpret
import Control.Effect.Carrier.Internal.Compose
import Control.Effect.Carrier.Internal.Intro
import Control.Monad.Trans.Identity

-- | A pseudo-effect for connected @'Tell' s@, @'Listen' s@ and @'Pass' s@ effects.
--
-- @'Writer'@ should only ever be used inside of 'Eff' and 'Effs'
-- constraints. It is not a real effect! See 'Bundle'.
type Writer s = Bundle '[Tell s, Listen s, Pass s]

tell :: Eff (Tell s) m => s -> m ()
tell :: s -> m ()
tell = Tell s m () -> m ()
forall (e :: Effect) (m :: * -> *) a.
(Member e (Derivs m), Carrier m) =>
e m a -> m a
send (Tell s m () -> m ()) -> (s -> Tell s m ()) -> s -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> Tell s m ()
forall k s (m :: k). s -> Tell s m ()
Tell
{-# INLINE tell #-}

listen :: Eff (Listen s) m => m a -> m (s, a)
listen :: m a -> m (s, a)
listen = Listen s m (s, a) -> m (s, a)
forall (e :: Effect) (m :: * -> *) a.
(Member e (Derivs m), Carrier m) =>
e m a -> m a
send (Listen s m (s, a) -> m (s, a))
-> (m a -> Listen s m (s, a)) -> m a -> m (s, a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m a -> Listen s m (s, a)
forall (m :: * -> *) a s. m a -> Listen s m (s, a)
Listen
{-# INLINE listen #-}

pass :: Eff (Pass s) m => m (s -> s, a) -> m a
pass :: m (s -> s, a) -> m a
pass = Pass s m a -> m a
forall (e :: Effect) (m :: * -> *) a.
(Member e (Derivs m), Carrier m) =>
e m a -> m a
send (Pass s m a -> m a)
-> (m (s -> s, a) -> Pass s m a) -> m (s -> s, a) -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m (s -> s, a) -> Pass s m a
forall (m :: * -> *) s a. m (s -> s, a) -> Pass s m a
Pass
{-# INLINE pass #-}

censor :: Eff (Pass s) m => (s -> s) -> m a -> m a
censor :: (s -> s) -> m a -> m a
censor s -> s
f = m (s -> s, a) -> m a
forall s (m :: * -> *) a. Eff (Pass s) m => m (s -> s, a) -> m a
pass (m (s -> s, a) -> m a) -> (m a -> m (s -> s, a)) -> m a -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> (s -> s, a)) -> m a -> m (s -> s, a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((,) s -> s
f)
{-# INLINE censor #-}


data TellListH

type TellListC s = CompositionC
 '[ ReinterpretC TellListH (Tell s) '[Tell (Dual [s])]
  , TellC (Dual [s])
  ]

instance Eff (Tell (Dual [s])) m
      => Handler TellListH (Tell s) m where
  effHandler :: Tell s (Effly z) x -> Effly z x
effHandler (Tell s
s) = Dual [s] -> Effly z ()
forall s (m :: * -> *). Eff (Tell s) m => s -> m ()
tell ([s] -> Dual [s]
forall a. a -> Dual a
Dual [s
s])
  {-# INLINEABLE effHandler #-}

-- | Run a @'Tell' s@ by gathering the 'tell's into a list.
--
-- The resulting list is produced strictly. See 'runTellListLazy' for a lazy
-- variant.
runTellList :: forall s m a p
             . ( Carrier m
               , Threaders '[WriterThreads] m p
               )
            => TellListC s m a
            -> m ([s], a)
runTellList :: TellListC s m a -> m ([s], a)
runTellList =
     (((Dual [s], a) -> ([s], a)) -> m (Dual [s], a) -> m ([s], a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((Dual [s], a) -> ([s], a)) -> m (Dual [s], a) -> m ([s], a))
-> ((Dual [s] -> [s]) -> (Dual [s], a) -> ([s], a))
-> (Dual [s] -> [s])
-> m (Dual [s], a)
-> m ([s], a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Dual [s] -> [s]) -> (Dual [s], a) -> ([s], a)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first) ([s] -> [s]
forall a. [a] -> [a]
reverse ([s] -> [s]) -> (Dual [s] -> [s]) -> Dual [s] -> [s]
forall b a c. Coercible b a => (b -> c) -> (a -> b) -> a -> c
.# Dual [s] -> [s]
forall a. Dual a -> a
getDual)
  (m (Dual [s], a) -> m ([s], a))
-> (TellC (Dual [s]) m a -> m (Dual [s], a))
-> TellC (Dual [s]) m a
-> m ([s], a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  TellC (Dual [s]) m a -> m (Dual [s], a)
forall s (m :: * -> *) a (p :: [Effect]).
(Monoid s, Carrier m, Threaders '[WriterThreads] m p) =>
TellC s m a -> m (s, a)
runTell
  (TellC (Dual [s]) m a -> m ([s], a))
-> (ReinterpretC
      TellListH (Tell s) '[Tell (Dual [s])] (TellC (Dual [s]) m) a
    -> TellC (Dual [s]) m a)
-> ReinterpretC
     TellListH (Tell s) '[Tell (Dual [s])] (TellC (Dual [s]) m) a
-> m ([s], a)
forall b a c. Coercible b a => (b -> c) -> (a -> b) -> a -> c
.# ReinterpretC
  TellListH (Tell s) '[Tell (Dual [s])] (TellC (Dual [s]) m) a
-> TellC (Dual [s]) m a
forall h (e :: Effect) (new :: [Effect]) (m :: * -> *) a.
(Handler h e m, KnownList new, HeadEffs new m) =>
ReinterpretC h e new m a -> m a
reinterpretViaHandler
  (ReinterpretC
   TellListH (Tell s) '[Tell (Dual [s])] (TellC (Dual [s]) m) a
 -> m ([s], a))
-> (TellListC s m a
    -> ReinterpretC
         TellListH (Tell s) '[Tell (Dual [s])] (TellC (Dual [s]) m) a)
-> TellListC s m a
-> m ([s], a)
forall b a c. Coercible b a => (b -> c) -> (a -> b) -> a -> c
.# TellListC s m a
-> ReinterpretC
     TellListH (Tell s) '[Tell (Dual [s])] (TellC (Dual [s]) m) a
forall (ts :: [Effect]) (m :: * -> *) a.
CompositionC ts m a -> CompositionBaseM ts m a
runComposition
{-# INLINE runTellList #-}

data TellListLazyH

type TellListLazyC s = CompositionC
 '[ ReinterpretC TellListLazyH (Tell s) '[Tell (Endo [s])]
  , TellLazyC (Endo [s])
  ]

instance Eff (Tell (Endo [s])) m
      => Handler TellListLazyH (Tell s) m where
  effHandler :: Tell s (Effly z) x -> Effly z x
effHandler (Tell s
s) = Endo [s] -> Effly z ()
forall s (m :: * -> *). Eff (Tell s) m => s -> m ()
tell (([s] -> [s]) -> Endo [s]
forall a. (a -> a) -> Endo a
Endo (s
ss -> [s] -> [s]
forall a. a -> [a] -> [a]
:))
  {-# INLINEABLE effHandler #-}

-- | Run a @'Tell' s@ by gathering the 'tell's into a list.
--
-- This is a variant of 'runTellList' that produces the
-- final list lazily. __Use this only if you need__
-- __the laziness, as this would otherwise incur an unneccesary space leak.__
runTellListLazy :: forall s m a p
                 . ( Carrier m
                   , Threaders '[WriterLazyThreads] m p
                   )
                => TellListLazyC s m a
                -> m ([s], a)
runTellListLazy :: TellListLazyC s m a -> m ([s], a)
runTellListLazy =
     m (Endo [s], a) -> m ([s], a)
forall s (f :: * -> *) a.
(Monoid s, Functor f) =>
f (Endo s, a) -> f (s, a)
fromEndoWriter
  (m (Endo [s], a) -> m ([s], a))
-> (TellLazyC (Endo [s]) m a -> m (Endo [s], a))
-> TellLazyC (Endo [s]) m a
-> m ([s], a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  TellLazyC (Endo [s]) m a -> m (Endo [s], a)
forall s (m :: * -> *) a (p :: [Effect]).
(Monoid s, Carrier m, Threaders '[WriterLazyThreads] m p) =>
TellLazyC s m a -> m (s, a)
runTellLazy
  (TellLazyC (Endo [s]) m a -> m ([s], a))
-> (ReinterpretC
      TellListLazyH
      (Tell s)
      '[Tell (Endo [s])]
      (TellLazyC (Endo [s]) m)
      a
    -> TellLazyC (Endo [s]) m a)
-> ReinterpretC
     TellListLazyH
     (Tell s)
     '[Tell (Endo [s])]
     (TellLazyC (Endo [s]) m)
     a
-> m ([s], a)
forall b a c. Coercible b a => (b -> c) -> (a -> b) -> a -> c
.# ReinterpretC
  TellListLazyH
  (Tell s)
  '[Tell (Endo [s])]
  (TellLazyC (Endo [s]) m)
  a
-> TellLazyC (Endo [s]) m a
forall h (e :: Effect) (new :: [Effect]) (m :: * -> *) a.
(Handler h e m, KnownList new, HeadEffs new m) =>
ReinterpretC h e new m a -> m a
reinterpretViaHandler
  (ReinterpretC
   TellListLazyH
   (Tell s)
   '[Tell (Endo [s])]
   (TellLazyC (Endo [s]) m)
   a
 -> m ([s], a))
-> (TellListLazyC s m a
    -> ReinterpretC
         TellListLazyH
         (Tell s)
         '[Tell (Endo [s])]
         (TellLazyC (Endo [s]) m)
         a)
-> TellListLazyC s m a
-> m ([s], a)
forall b a c. Coercible b a => (b -> c) -> (a -> b) -> a -> c
.# TellListLazyC s m a
-> ReinterpretC
     TellListLazyH
     (Tell s)
     '[Tell (Endo [s])]
     (TellLazyC (Endo [s]) m)
     a
forall (ts :: [Effect]) (m :: * -> *) a.
CompositionC ts m a -> CompositionBaseM ts m a
runComposition
{-# INLINE runTellListLazy #-}


-- | Run a @'Tell' s@ effect, where @s@ is a 'Monoid', by accumulating
-- all the uses of 'tell'.
--
-- You may want to combine this with 'tellIntoTell'.
--
-- Unlike 'runListen' and 'runWriter', this does not provide the ability to
-- interact with the 'tell's through 'listen' and 'pass'; but also doesn't
-- impose any primitive effects, meaning 'runTell' doesn't restrict what
-- interpreters are run before it.
--
-- @'Derivs' ('TellC' s m) = 'Tell' s ': 'Derivs' m@
--
-- @'Prims'  ('TellC' s m) = 'Prims' m@
--
-- This produces the final accumulation @s@ strictly. See 'runTellLazy' for a
-- lazy variant of this.
runTell :: forall s m a p
         . ( Monoid s
           , Carrier m
           , Threaders '[WriterThreads] m p
           )
        => TellC s m a
        -> m (s, a)
runTell :: TellC s m a -> m (s, a)
runTell (TellC WriterT s m a
m) = do
  (a
a, s
s) <- WriterT s m a -> m (a, s)
forall w (m :: * -> *) a. Monoid w => WriterT w m a -> m (a, w)
W.runWriterT WriterT s m a
m
  (s, a) -> m (s, a)
forall (m :: * -> *) a. Monad m => a -> m a
return (s
s, a
a)
{-# INLINE runTell #-}

-- | Run connected @'Listen' s@ and @'Tell' s@ effects, where @s@ is a 'Monoid',
-- by accumulating all the uses of 'tell'.
--
-- Unlike 'runWriter', this does not provide the power of 'pass'; but because
-- of that, it also doesn't impose 'Pass' as a primitive effect, meaning
-- a larger variety of interpreters may be run before 'runListen' compared to
-- 'runWriter'.
--
-- @'Derivs' ('ListenC' s m) = 'Listen' s ': 'Tell' s ': 'Derivs' m@
--
-- @'Prims'  ('ListenC' s m) = 'ListenPrim' s ': 'Prims' m@
--
-- This produces the final accumulation strictly. See 'runListenLazy' for a
-- lazy variant of this.
runListen :: forall s m a p
           . ( Monoid s
             , Carrier m
             , Threaders '[WriterThreads] m p
             )
          => ListenC s m a
          -> m (s, a)
runListen :: ListenC s m a -> m (s, a)
runListen (ListenC WriterT s m a
m) = do
  (a
a, s
s) <- WriterT s m a -> m (a, s)
forall w (m :: * -> *) a. Monoid w => WriterT w m a -> m (a, w)
W.runWriterT WriterT s m a
m
  (s, a) -> m (s, a)
forall (m :: * -> *) a. Monad m => a -> m a
return (s
s, a
a)
{-# INLINE runListen #-}

-- | Run connected @'Pass' s@, @'Listen' s@ and @'Tell' s@ effects,
-- -- i.e. @'Writer' s@ -- where @s@ is a 'Monoid', by accumulating all the
-- uses of 'tell'.
--
-- @'Pass' s@ is a fairly restrictive primitive effect. Notably,
-- 'Control.Effect.Cont.runCont' can't be used before 'runWriter'.
-- If you don't need 'pass', consider using 'runTell' or 'runListen' instead.
--
-- @'Derivs' ('WriterC' s m) = 'Pass' s ': 'Listen' s ': 'Tell' s ': 'Derivs' m@
--
-- @'Prims'  ('WriterC' s m) = 'WriterPrim' s ': 'Prims' m@
--
-- This produces the final accumulation strictly. See 'runWriterLazy' for a
-- lazy variant of this.
runWriter :: forall s m a p
           . ( Monoid s
             , Carrier m
             , Threaders '[WriterThreads] m p
             )
          => WriterC s m a
          -> m (s, a)
runWriter :: WriterC s m a -> m (s, a)
runWriter (WriterC WriterT s m a
m) = do
  (a
a, s
s) <- WriterT s m a -> m (a, s)
forall w (m :: * -> *) a. Monoid w => WriterT w m a -> m (a, w)
W.runWriterT WriterT s m a
m
  (s, a) -> m (s, a)
forall (m :: * -> *) a. Monad m => a -> m a
return (s
s, a
a)
{-# INLINE runWriter #-}


-- | Run a @'Tell' s@ effect, where @s@ is a 'Monoid', by accumulating all the
-- uses of 'tell' lazily.
--
-- @'Derivs' ('TellLazyC' s m) = 'Tell' s ': 'Derivs' m@
--
-- @'Prims'  ('TellLazyC' s m) = 'Prims' m@
--
-- This is a variant of 'runTell' that produces the final accumulation
-- lazily. __Use this only if you need__
-- __the laziness, as this would otherwise incur an unneccesary space leak.__
runTellLazy :: forall s m a p
         . ( Monoid s
           , Carrier m
           , Threaders '[WriterLazyThreads] m p
           )
        => TellLazyC s m a
        -> m (s, a)
runTellLazy :: TellLazyC s m a -> m (s, a)
runTellLazy (TellLazyC WriterT s m a
m) = (a, s) -> (s, a)
forall a b. (a, b) -> (b, a)
swap ((a, s) -> (s, a)) -> m (a, s) -> m (s, a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WriterT s m a -> m (a, s)
forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
LW.runWriterT WriterT s m a
m
{-# INLINE runTellLazy #-}

-- | Run connected @'Listen' s@ and @'Tell' s@ effects,
-- where @s@ is a 'Monoid', by accumulating all the uses of 'tell' lazily.
--
-- @'Derivs' ('ListenLazyC' s m) = 'Listen' s ': 'Tell' s ': 'Derivs' m@
--
-- @'Prims'  ('ListenLazyC' s m) = 'ListenPrim' s ': 'Prims' m@
--
-- This is a variant of 'runListen' that produces the
-- final accumulation lazily. __Use this only if you need__
-- __the laziness, as this would otherwise incur an unneccesary space leak.__
runListenLazy :: forall s m a p
           . ( Monoid s
             , Carrier m
             , Threaders '[WriterThreads] m p
             )
          => ListenLazyC s m a
          -> m (s, a)
runListenLazy :: ListenLazyC s m a -> m (s, a)
runListenLazy (ListenLazyC WriterT s m a
m) = (a, s) -> (s, a)
forall a b. (a, b) -> (b, a)
swap ((a, s) -> (s, a)) -> m (a, s) -> m (s, a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WriterT s m a -> m (a, s)
forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
LW.runWriterT WriterT s m a
m
{-# INLINE runListenLazy #-}

-- | Run connected @'Pass' s@, @'Listen' s@ and @'Tell' s@ effects,
-- -- i.e. @'Writer' s@ -- where @s@ is a 'Monoid',
-- by accumulating all the uses of 'tell' lazily.
--
-- @'Derivs' ('ListenLazyC' s m) = 'Pass' s ': 'Listen' s ': 'Tell' s ': 'Derivs' m@
--
-- @'Prims'  ('ListenLazyC' s m) = 'WriterPrim' s ': 'Prims' m@
--
-- This is a variant of 'runListen' that produces the
-- final accumulation lazily. __Use this only if you need__
-- __the laziness, as this would otherwise incur an unneccesary space leak.__
runWriterLazy :: forall s m a p
               . ( Monoid s
                 , Carrier m
                 , Threaders '[WriterLazyThreads] m p
                 )
              => WriterLazyC s m a
              -> m (s, a)
runWriterLazy :: WriterLazyC s m a -> m (s, a)
runWriterLazy (WriterLazyC WriterT s m a
m) = (a, s) -> (s, a)
forall a b. (a, b) -> (b, a)
swap ((a, s) -> (s, a)) -> m (a, s) -> m (s, a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WriterT s m a -> m (a, s)
forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
LW.runWriterT WriterT s m a
m
{-# INLINE runWriterLazy #-}

tellTVar :: ( Monoid s
            , Effs '[Reader (s -> STM ()), Embed IO] m
            )
         => s
         -> m ()
tellTVar :: s -> m ()
tellTVar s
o = do
  s -> STM ()
write <- m (s -> STM ())
forall i (m :: * -> *). Eff (Ask i) m => m i
ask
  IO () -> m ()
forall (b :: * -> *) (m :: * -> *) a. Eff (Embed b) m => b a -> m a
embed (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ s -> STM ()
write s
o
{-# INLINE tellTVar #-}


data WriterToEndoWriterH

instance (Monoid s, Eff (Tell (Endo s)) m)
      => Handler WriterToEndoWriterH (Tell s) m where
  effHandler :: Tell s (Effly z) x -> Effly z x
effHandler (Tell s
s) = Endo s -> Effly z ()
forall s (m :: * -> *). Eff (Tell s) m => s -> m ()
tell ((s -> s) -> Endo s
forall a. (a -> a) -> Endo a
Endo (s
s s -> s -> s
forall a. Semigroup a => a -> a -> a
<>))
  {-# INLINEABLE effHandler #-}

instance (Monoid s, Eff (Listen (Endo s)) m)
      => Handler WriterToEndoWriterH (Listen s) m where
  effHandler :: Listen s (Effly z) x -> Effly z x
effHandler (Listen Effly z a
m) =
    (((Endo s, a) -> (s, a)) -> Effly z (Endo s, a) -> Effly z (s, a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((Endo s, a) -> (s, a)) -> Effly z (Endo s, a) -> Effly z (s, a))
-> ((Endo s -> s) -> (Endo s, a) -> (s, a))
-> (Endo s -> s)
-> Effly z (Endo s, a)
-> Effly z (s, a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Endo s -> s) -> (Endo s, a) -> (s, a)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first) (\(Endo s -> s
f) -> s -> s
f s
forall a. Monoid a => a
mempty) (Effly z (Endo s, a) -> Effly z (s, a))
-> Effly z (Endo s, a) -> Effly z (s, a)
forall a b. (a -> b) -> a -> b
$ Effly z a -> Effly z (Endo s, a)
forall s (m :: * -> *) a. Eff (Listen s) m => m a -> m (s, a)
listen Effly z a
m
  {-# INLINEABLE effHandler #-}

instance (Monoid s, Eff (Pass (Endo s)) m)
      => Handler WriterToEndoWriterH (Pass s) m where
  effHandler :: Pass s (Effly z) x -> Effly z x
effHandler (Pass Effly z (s -> s, x)
m) =
    Effly z (Endo s -> Endo s, x) -> Effly z x
forall s (m :: * -> *) a. Eff (Pass s) m => m (s -> s, a) -> m a
pass (Effly z (Endo s -> Endo s, x) -> Effly z x)
-> Effly z (Endo s -> Endo s, x) -> Effly z x
forall a b. (a -> b) -> a -> b
$
      (((s -> s, x) -> (Endo s -> Endo s, x))
-> Effly z (s -> s, x) -> Effly z (Endo s -> Endo s, x)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((s -> s, x) -> (Endo s -> Endo s, x))
 -> Effly z (s -> s, x) -> Effly z (Endo s -> Endo s, x))
-> (((s -> s) -> Endo s -> Endo s)
    -> (s -> s, x) -> (Endo s -> Endo s, x))
-> ((s -> s) -> Endo s -> Endo s)
-> Effly z (s -> s, x)
-> Effly z (Endo s -> Endo s, x)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((s -> s) -> Endo s -> Endo s)
-> (s -> s, x) -> (Endo s -> Endo s, x)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first)
        (\s -> s
f (Endo s -> s
ss) -> let !s' :: s
s' = s -> s
f (s -> s
ss s
forall a. Monoid a => a
mempty) in (s -> s) -> Endo s
forall a. (a -> a) -> Endo a
Endo (s
s' s -> s -> s
forall a. Semigroup a => a -> a -> a
<>))
        Effly z (s -> s, x)
m
  {-# INLINEABLE effHandler #-}

fromEndoWriter :: (Monoid s, Functor f)
               => f (Endo s, a)
               -> f (s, a)
fromEndoWriter :: f (Endo s, a) -> f (s, a)
fromEndoWriter = (((Endo s, a) -> (s, a)) -> f (Endo s, a) -> f (s, a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((Endo s, a) -> (s, a)) -> f (Endo s, a) -> f (s, a))
-> ((Endo s -> s) -> (Endo s, a) -> (s, a))
-> (Endo s -> s)
-> f (Endo s, a)
-> f (s, a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Endo s -> s) -> (Endo s, a) -> (s, a)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first) (\(Endo s -> s
f) -> s -> s
f s
forall a. Monoid a => a
mempty)
{-# INLINE fromEndoWriter #-}

type TellIntoEndoTellC s =
  ReinterpretC WriterToEndoWriterH (Tell s) '[Tell (Endo s)]

-- | Rewrite a @'Tell' s@ effect into a @'Tell' ('Endo' s)@ effect.
--
-- This effectively right-associates all uses of 'tell', which
-- asymptotically improves performance if the time complexity of '<>' for the
-- 'Monoid' depends only on the size of the first argument.
-- In particular, you should use this (if you can be bothered) if the monoid
-- is a list, such as 'String'.
--
-- Usage is to combine this with the 'Tell' interpreter of your choice, followed
-- by 'fromEndoWriter', like this:
--
-- @
--    'run'
--  $ ...
--  $ 'fromEndoWriter'
--  $ 'runTell'
--  $ 'tellIntoEndoTell' \@String -- The 'Monoid' must be specified
--  $ ...
-- @
tellIntoEndoTell :: ( Monoid s
                    , HeadEff (Tell (Endo s)) m
                    )
                 => TellIntoEndoTellC s m a
                 -> m a
tellIntoEndoTell :: TellIntoEndoTellC s m a -> m a
tellIntoEndoTell = TellIntoEndoTellC s m a -> m a
forall h (e :: Effect) (new :: [Effect]) (m :: * -> *) a.
(Handler h e m, KnownList new, HeadEffs new m) =>
ReinterpretC h e new m a -> m a
reinterpretViaHandler
{-# INLINE tellIntoEndoTell #-}

type ListenIntoEndoListenC s = CompositionC
  '[ IntroC '[Listen s, Tell s] '[Listen (Endo s), Tell (Endo s)]
   , InterpretC WriterToEndoWriterH (Listen s)
   , InterpretC WriterToEndoWriterH (Tell s)
   ]

-- | Rewrite connected @'Listen' s@ and @'Tell' s@ effects into
-- connected @'Listen' ('Endo' s)@ and @'Tell' ('Endo' s)@ effects.
--
-- This effectively right-associates all uses of 'tell', which
-- asymptotically improves performance if the time complexity of '<>' for the
-- 'Monoid' depends only on the size of the first argument.
-- In particular, you should use this (if you can be bothered) if the monoid
-- is a list, such as String.
--
-- Usage is to combine this with the 'Listen' interpreter of your choice,
-- followed by 'fromEndoWriter', like this:
--
-- @
--    'run'
--  $ ...
--  $ 'fromEndoWriter'
--  $ 'runListen'
--  $ 'listenIntoEndoListen' \@String -- The 'Monoid' must be specified
--  $ ...
-- @
--
listenIntoEndoListen :: ( Monoid s
                        , HeadEffs '[Listen (Endo s), Tell (Endo s)] m
                        )
                     => ListenIntoEndoListenC s m a
                     -> m a
listenIntoEndoListen :: ListenIntoEndoListenC s m a -> m a
listenIntoEndoListen =
     InterpretC WriterToEndoWriterH (Tell s) m a -> m a
forall h (e :: Effect) (m :: * -> *) a.
Handler h e m =>
InterpretC h e m a -> m a
interpretViaHandler
  (InterpretC WriterToEndoWriterH (Tell s) m a -> m a)
-> (InterpretC
      WriterToEndoWriterH
      (Listen s)
      (InterpretC WriterToEndoWriterH (Tell s) m)
      a
    -> InterpretC WriterToEndoWriterH (Tell s) m a)
-> InterpretC
     WriterToEndoWriterH
     (Listen s)
     (InterpretC WriterToEndoWriterH (Tell s) m)
     a
-> m a
forall b a c. Coercible b a => (b -> c) -> (a -> b) -> a -> c
.# InterpretC
  WriterToEndoWriterH
  (Listen s)
  (InterpretC WriterToEndoWriterH (Tell s) m)
  a
-> InterpretC WriterToEndoWriterH (Tell s) m a
forall h (e :: Effect) (m :: * -> *) a.
Handler h e m =>
InterpretC h e m a -> m a
interpretViaHandler
  (InterpretC
   WriterToEndoWriterH
   (Listen s)
   (InterpretC WriterToEndoWriterH (Tell s) m)
   a
 -> m a)
-> (IntroUnderManyC
      '[Listen s, Tell s]
      '[Listen (Endo s), Tell (Endo s)]
      (InterpretC
         WriterToEndoWriterH
         (Listen s)
         (InterpretC WriterToEndoWriterH (Tell s) m))
      a
    -> InterpretC
         WriterToEndoWriterH
         (Listen s)
         (InterpretC WriterToEndoWriterH (Tell s) m)
         a)
-> IntroUnderManyC
     '[Listen s, Tell s]
     '[Listen (Endo s), Tell (Endo s)]
     (InterpretC
        WriterToEndoWriterH
        (Listen s)
        (InterpretC WriterToEndoWriterH (Tell s) m))
     a
-> m a
forall b a c. Coercible b a => (b -> c) -> (a -> b) -> a -> c
.# IntroUnderManyC
  '[Listen s, Tell s]
  '[Listen (Endo s), Tell (Endo s)]
  (InterpretC
     WriterToEndoWriterH
     (Listen s)
     (InterpretC WriterToEndoWriterH (Tell s) m))
  a
-> InterpretC
     WriterToEndoWriterH
     (Listen s)
     (InterpretC WriterToEndoWriterH (Tell s) m)
     a
forall (top :: [Effect]) (new :: [Effect]) (m :: * -> *) a.
(KnownList top, KnownList new, IntroConsistent top new m) =>
IntroUnderManyC top new m a -> m a
introUnderMany
  (IntroUnderManyC
   '[Listen s, Tell s]
   '[Listen (Endo s), Tell (Endo s)]
   (InterpretC
      WriterToEndoWriterH
      (Listen s)
      (InterpretC WriterToEndoWriterH (Tell s) m))
   a
 -> m a)
-> (ListenIntoEndoListenC s m a
    -> IntroUnderManyC
         '[Listen s, Tell s]
         '[Listen (Endo s), Tell (Endo s)]
         (InterpretC
            WriterToEndoWriterH
            (Listen s)
            (InterpretC WriterToEndoWriterH (Tell s) m))
         a)
-> ListenIntoEndoListenC s m a
-> m a
forall b a c. Coercible b a => (b -> c) -> (a -> b) -> a -> c
.# ListenIntoEndoListenC s m a
-> IntroUnderManyC
     '[Listen s, Tell s]
     '[Listen (Endo s), Tell (Endo s)]
     (InterpretC
        WriterToEndoWriterH
        (Listen s)
        (InterpretC WriterToEndoWriterH (Tell s) m))
     a
forall (ts :: [Effect]) (m :: * -> *) a.
CompositionC ts m a -> CompositionBaseM ts m a
runComposition
{-# INLINE listenIntoEndoListen #-}

type WriterIntoEndoWriterC s = CompositionC
  '[ IntroC '[Pass s, Listen s, Tell s]
            '[Pass (Endo s), Listen (Endo s), Tell (Endo s)]
   , InterpretC WriterToEndoWriterH (Pass s)
   , InterpretC WriterToEndoWriterH (Listen s)
   , InterpretC WriterToEndoWriterH (Tell s)
   ]

-- | Rewrite connected @'Pass' s@, @'Listen' s@ and @'Tell' s@ effects
-- -- i.e. @'Writer' s@ -- into connected @'Pass' ('Endo' s)@,
-- @'Listen' ('Endo' s)@ and @'Tell' (Endo s)@ effects on top of the effect
-- stack -- i.e. @'Writer' (Endo s)@.
--
-- This effectively right-associates all uses of 'tell', which
-- asymptotically improves performance if the time complexity of '<>' for the
-- 'Monoid' depends only on the size of the first argument.
-- In particular, you should use this (if you can be bothered) if the
-- monoid is a list, such as String.
--
-- Usage is to combine this with the 'Writer' interpreter of your choice,
-- followed by 'fromEndoWriter', like this:
--
-- @
--    'run'
--  $ ...
--  $ 'fromEndoWriter'
--  $ 'runWriter'
--  $ 'writerIntoEndoWriter' \@String -- The 'Monoid' must be specified
--  $ ...
-- @
writerIntoEndoWriter :: ( Monoid s
                        , HeadEffs
                           '[Pass (Endo s), Listen (Endo s), Tell (Endo s)]
                           m
                        )
                     => WriterIntoEndoWriterC s m a
                     -> m a
writerIntoEndoWriter :: WriterIntoEndoWriterC s m a -> m a
writerIntoEndoWriter =
     InterpretC WriterToEndoWriterH (Tell s) m a -> m a
forall h (e :: Effect) (m :: * -> *) a.
Handler h e m =>
InterpretC h e m a -> m a
interpretViaHandler
  (InterpretC WriterToEndoWriterH (Tell s) m a -> m a)
-> (InterpretC
      WriterToEndoWriterH
      (Listen s)
      (InterpretC WriterToEndoWriterH (Tell s) m)
      a
    -> InterpretC WriterToEndoWriterH (Tell s) m a)
-> InterpretC
     WriterToEndoWriterH
     (Listen s)
     (InterpretC WriterToEndoWriterH (Tell s) m)
     a
-> m a
forall b a c. Coercible b a => (b -> c) -> (a -> b) -> a -> c
.# InterpretC
  WriterToEndoWriterH
  (Listen s)
  (InterpretC WriterToEndoWriterH (Tell s) m)
  a
-> InterpretC WriterToEndoWriterH (Tell s) m a
forall h (e :: Effect) (m :: * -> *) a.
Handler h e m =>
InterpretC h e m a -> m a
interpretViaHandler
  (InterpretC
   WriterToEndoWriterH
   (Listen s)
   (InterpretC WriterToEndoWriterH (Tell s) m)
   a
 -> m a)
-> (InterpretC
      WriterToEndoWriterH
      (Pass s)
      (InterpretC
         WriterToEndoWriterH
         (Listen s)
         (InterpretC WriterToEndoWriterH (Tell s) m))
      a
    -> InterpretC
         WriterToEndoWriterH
         (Listen s)
         (InterpretC WriterToEndoWriterH (Tell s) m)
         a)
-> InterpretC
     WriterToEndoWriterH
     (Pass s)
     (InterpretC
        WriterToEndoWriterH
        (Listen s)
        (InterpretC WriterToEndoWriterH (Tell s) m))
     a
-> m a
forall b a c. Coercible b a => (b -> c) -> (a -> b) -> a -> c
.# InterpretC
  WriterToEndoWriterH
  (Pass s)
  (InterpretC
     WriterToEndoWriterH
     (Listen s)
     (InterpretC WriterToEndoWriterH (Tell s) m))
  a
-> InterpretC
     WriterToEndoWriterH
     (Listen s)
     (InterpretC WriterToEndoWriterH (Tell s) m)
     a
forall h (e :: Effect) (m :: * -> *) a.
Handler h e m =>
InterpretC h e m a -> m a
interpretViaHandler
  (InterpretC
   WriterToEndoWriterH
   (Pass s)
   (InterpretC
      WriterToEndoWriterH
      (Listen s)
      (InterpretC WriterToEndoWriterH (Tell s) m))
   a
 -> m a)
-> (IntroUnderManyC
      '[Pass s, Listen s, Tell s]
      '[Pass (Endo s), Listen (Endo s), Tell (Endo s)]
      (InterpretC
         WriterToEndoWriterH
         (Pass s)
         (InterpretC
            WriterToEndoWriterH
            (Listen s)
            (InterpretC WriterToEndoWriterH (Tell s) m)))
      a
    -> InterpretC
         WriterToEndoWriterH
         (Pass s)
         (InterpretC
            WriterToEndoWriterH
            (Listen s)
            (InterpretC WriterToEndoWriterH (Tell s) m))
         a)
-> IntroUnderManyC
     '[Pass s, Listen s, Tell s]
     '[Pass (Endo s), Listen (Endo s), Tell (Endo s)]
     (InterpretC
        WriterToEndoWriterH
        (Pass s)
        (InterpretC
           WriterToEndoWriterH
           (Listen s)
           (InterpretC WriterToEndoWriterH (Tell s) m)))
     a
-> m a
forall b a c. Coercible b a => (b -> c) -> (a -> b) -> a -> c
.# IntroUnderManyC
  '[Pass s, Listen s, Tell s]
  '[Pass (Endo s), Listen (Endo s), Tell (Endo s)]
  (InterpretC
     WriterToEndoWriterH
     (Pass s)
     (InterpretC
        WriterToEndoWriterH
        (Listen s)
        (InterpretC WriterToEndoWriterH (Tell s) m)))
  a
-> InterpretC
     WriterToEndoWriterH
     (Pass s)
     (InterpretC
        WriterToEndoWriterH
        (Listen s)
        (InterpretC WriterToEndoWriterH (Tell s) m))
     a
forall (top :: [Effect]) (new :: [Effect]) (m :: * -> *) a.
(KnownList top, KnownList new, IntroConsistent top new m) =>
IntroUnderManyC top new m a -> m a
introUnderMany
  (IntroUnderManyC
   '[Pass s, Listen s, Tell s]
   '[Pass (Endo s), Listen (Endo s), Tell (Endo s)]
   (InterpretC
      WriterToEndoWriterH
      (Pass s)
      (InterpretC
         WriterToEndoWriterH
         (Listen s)
         (InterpretC WriterToEndoWriterH (Tell s) m)))
   a
 -> m a)
-> (WriterIntoEndoWriterC s m a
    -> IntroUnderManyC
         '[Pass s, Listen s, Tell s]
         '[Pass (Endo s), Listen (Endo s), Tell (Endo s)]
         (InterpretC
            WriterToEndoWriterH
            (Pass s)
            (InterpretC
               WriterToEndoWriterH
               (Listen s)
               (InterpretC WriterToEndoWriterH (Tell s) m)))
         a)
-> WriterIntoEndoWriterC s m a
-> m a
forall b a c. Coercible b a => (b -> c) -> (a -> b) -> a -> c
.# WriterIntoEndoWriterC s m a
-> IntroUnderManyC
     '[Pass s, Listen s, Tell s]
     '[Pass (Endo s), Listen (Endo s), Tell (Endo s)]
     (InterpretC
        WriterToEndoWriterH
        (Pass s)
        (InterpretC
           WriterToEndoWriterH
           (Listen s)
           (InterpretC WriterToEndoWriterH (Tell s) m)))
     a
forall (ts :: [Effect]) (m :: * -> *) a.
CompositionC ts m a -> CompositionBaseM ts m a
runComposition
{-# INLINE writerIntoEndoWriter #-}

-- | Transform a 'Tell' effect into another 'Tell' effect by providing a function
-- to transform the type told.
--
-- This is useful to transform a @'Tell' s@ effect where @s@ isn't a 'Monoid'
-- into a @'Tell' t@ effect where @t@ /is/ a 'Monoid', and thus can be
-- interpreted using the various 'Monoid'al 'Tell' interpreters.
--
-- This has a higher-rank type, as it makes use of 'InterpretReifiedC'.
-- __This makes 'tellToTell' very difficult to use partially applied.__
-- __In particular, it can't be composed using @'.'@.__
--
-- If performance is secondary, consider using the slower
-- 'tellToTellSimple', which doesn't have a higher-rank type.
tellToTell :: forall s t m a
            . Eff (Tell t) m
           => (s -> t)
           -> InterpretReifiedC (Tell s) m a
           -> m a
tellToTell :: (s -> t) -> InterpretReifiedC (Tell s) m a -> m a
tellToTell s -> t
f = EffHandler (Tell s) m -> InterpretReifiedC (Tell s) m a -> m a
forall (e :: Effect) (m :: * -> *) a.
(RepresentationalEff e, Carrier m) =>
EffHandler e m -> InterpretReifiedC e m a -> m a
interpret (EffHandler (Tell s) m -> InterpretReifiedC (Tell s) m a -> m a)
-> EffHandler (Tell s) m -> InterpretReifiedC (Tell s) m a -> m a
forall a b. (a -> b) -> a -> b
$ \case
  Tell s -> t -> Effly z ()
forall s (m :: * -> *). Eff (Tell s) m => s -> m ()
tell (s -> t
f s
s)
{-# INLINE tellToTell #-}

-- | Transform a 'Tell' effect into another 'Tell' effect by providing a function
-- to transform the type told.
--
-- This is useful to transform a @'Tell' s@ where @s@ isn't a 'Monoid' into a
-- @'Tell' t@ effect where @t@ /is/ a 'Monoid', and thus can be interpreted using
-- the various 'Monoid'al 'Tell' interpreters.
--
-- This is a less performant version of 'tellToTell' that doesn't have
-- a higher-rank type, making it much easier to use partially applied.
tellToTellSimple :: forall s t m a p
                  . ( Eff (Tell t) m
                    , Threaders '[ReaderThreads] m p
                    )
                 => (s -> t)
                 -> InterpretSimpleC (Tell s) m a
                 -> m a
tellToTellSimple :: (s -> t) -> InterpretSimpleC (Tell s) m a -> m a
tellToTellSimple s -> t
f = EffHandler (Tell s) m -> InterpretSimpleC (Tell s) m a -> m a
forall (e :: Effect) (m :: * -> *) a (p :: [Effect]).
(RepresentationalEff e, Threaders '[ReaderThreads] m p,
 Carrier m) =>
EffHandler e m -> InterpretSimpleC e m a -> m a
interpretSimple (EffHandler (Tell s) m -> InterpretSimpleC (Tell s) m a -> m a)
-> EffHandler (Tell s) m -> InterpretSimpleC (Tell s) m a -> m a
forall a b. (a -> b) -> a -> b
$ \case
  Tell s -> t -> Effly z ()
forall s (m :: * -> *). Eff (Tell s) m => s -> m ()
tell (s -> t
f s
s)
{-# INLINE tellToTellSimple #-}

-- | Rewrite a 'Tell' effect into another 'Tell' effect on top of the effect
-- stack by providing a function to transform the type told.
--
-- This is useful to rewrite a @'Tell' s@ effect where @s@ isn't a 'Monoid'
-- into a @'Tell' t@ effect where @t@ /is/ a 'Monoid', and thus can be
-- interpreted using the various 'Monoid'al 'Tell' interpreters.
--
-- This has a higher-rank type, as it makes use of 'InterpretReifiedC'.
-- __This makes 'tellToTell' very difficult to use partially applied.__
-- __In particular, it can't be composed using @'.'@.__
--
-- If performance is secondary, consider using the slower
-- 'tellIntoTellSimple', which doesn't have a higher-rank type.
tellIntoTell :: forall s t m a
              . HeadEff (Tell t) m
             => (s -> t)
             -> ReinterpretReifiedC (Tell s) '[Tell t] m a
             -> m a
tellIntoTell :: (s -> t) -> ReinterpretReifiedC (Tell s) '[Tell t] m a -> m a
tellIntoTell s -> t
f = EffHandler (Tell s) m
-> ReinterpretReifiedC (Tell s) '[Tell t] m a -> m a
forall (e :: Effect) (new :: [Effect]) (m :: * -> *) a.
(RepresentationalEff e, KnownList new, HeadEffs new m) =>
EffHandler e m -> ReinterpretReifiedC e new m a -> m a
reinterpret (EffHandler (Tell s) m
 -> ReinterpretReifiedC (Tell s) '[Tell t] m a -> m a)
-> EffHandler (Tell s) m
-> ReinterpretReifiedC (Tell s) '[Tell t] m a
-> m a
forall a b. (a -> b) -> a -> b
$ \case
  Tell s -> t -> Effly z ()
forall s (m :: * -> *). Eff (Tell s) m => s -> m ()
tell (s -> t
f s
s)
{-# INLINE tellIntoTell #-}

-- | Rewrite a 'Tell' effect into another 'Tell' effect on top of the effect
-- stack by providing a function to transform the type told.
--
-- This is useful to rewrite a @'Tell' s@ effect where @s@ isn't a 'Monoid'
-- into a @'Tell' t@ effect where @t@ /is/ a 'Monoid', and thus can be
-- interpreted using the various 'Monoid'al 'Tell' interpreters.
--
-- This has a higher-rank type, as it makes use of 'InterpretReifiedC'.
-- __This makes 'tellToTell' very difficult to use partially applied.__
-- __In particular, it can't be composed using @'.'@.__
--
-- If performance is secondary, consider using the slower
-- 'tellIntoTellSimple', which doesn't have a higher-rank type.
--
-- This is a less performant version of 'tellIntoTell' that doesn't have
-- a higher-rank type, making it much easier to use partially applied.
tellIntoTellSimple :: forall s t m a p
                    . ( HeadEff (Tell t) m
                      , Threaders '[ReaderThreads] m p
                      )
                   => (s -> t)
                   -> ReinterpretSimpleC (Tell s) '[Tell t] m a
                   -> m a
tellIntoTellSimple :: (s -> t) -> ReinterpretSimpleC (Tell s) '[Tell t] m a -> m a
tellIntoTellSimple s -> t
f = EffHandler (Tell s) m
-> ReinterpretSimpleC (Tell s) '[Tell t] m a -> m a
forall (e :: Effect) (new :: [Effect]) (m :: * -> *) a
       (p :: [Effect]).
(RepresentationalEff e, KnownList new, HeadEffs new m,
 Threaders '[ReaderThreads] m p) =>
EffHandler e m -> ReinterpretSimpleC e new m a -> m a
reinterpretSimple (EffHandler (Tell s) m
 -> ReinterpretSimpleC (Tell s) '[Tell t] m a -> m a)
-> EffHandler (Tell s) m
-> ReinterpretSimpleC (Tell s) '[Tell t] m a
-> m a
forall a b. (a -> b) -> a -> b
$ \case
  Tell s -> t -> Effly z ()
forall s (m :: * -> *). Eff (Tell s) m => s -> m ()
tell (s -> t
f s
s)
{-# INLINE tellIntoTellSimple #-}



listenTVar :: forall s m a
            . ( Monoid s
              , Effs '[Reader (s -> STM ()), Embed IO, Bracket] m
              )
           => m a
           -> m (s, a)
listenTVar :: m a -> m (s, a)
listenTVar m a
main = do
  s -> STM ()
writeGlobal <- m (s -> STM ())
forall i (m :: * -> *). Eff (Ask i) m => m i
ask
  TVar s
localVar    <- IO (TVar s) -> m (TVar s)
forall (b :: * -> *) (m :: * -> *) a. Eff (Embed b) m => b a -> m a
embed (IO (TVar s) -> m (TVar s)) -> IO (TVar s) -> m (TVar s)
forall a b. (a -> b) -> a -> b
$ s -> IO (TVar s)
forall a. a -> IO (TVar a)
newTVarIO s
forall a. Monoid a => a
mempty
  TVar Bool
switch      <- IO (TVar Bool) -> m (TVar Bool)
forall (b :: * -> *) (m :: * -> *) a. Eff (Embed b) m => b a -> m a
embed (IO (TVar Bool) -> m (TVar Bool))
-> IO (TVar Bool) -> m (TVar Bool)
forall a b. (a -> b) -> a -> b
$ Bool -> IO (TVar Bool)
forall a. a -> IO (TVar a)
newTVarIO Bool
True
  let
    writeLocal :: s -> STM ()
    writeLocal :: s -> STM ()
writeLocal s
o = do
      Bool
writeToLocal <- TVar Bool -> STM Bool
forall a. TVar a -> STM a
readTVar TVar Bool
switch
      Bool -> STM () -> STM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
writeToLocal (STM () -> STM ()) -> STM () -> STM ()
forall a b. (a -> b) -> a -> b
$ do
        s
s <- TVar s -> STM s
forall a. TVar a -> STM a
readTVar TVar s
localVar
        TVar s -> s -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar TVar s
localVar (s -> STM ()) -> s -> STM ()
forall a b. (a -> b) -> a -> b
$! s
s s -> s -> s
forall a. Semigroup a => a -> a -> a
<> s
o
      s -> STM ()
writeGlobal s
o
  a
a <- (((s -> STM ()) -> s -> STM ()) -> m a -> m a
forall i (m :: * -> *) a. Eff (Local i) m => (i -> i) -> m a -> m a
local (\s -> STM ()
_ -> s -> STM ()
writeLocal) m a
main)
         m a -> m () -> m a
forall (m :: * -> *) a b. Eff Bracket m => m a -> m b -> m a
`finally`
       (IO () -> m ()
forall (b :: * -> *) (m :: * -> *) a. Eff (Embed b) m => b a -> m a
embed (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ TVar Bool -> Bool -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar TVar Bool
switch Bool
False)
  s
s <- IO s -> m s
forall (b :: * -> *) (m :: * -> *) a. Eff (Embed b) m => b a -> m a
embed (IO s -> m s) -> IO s -> m s
forall a b. (a -> b) -> a -> b
$ TVar s -> IO s
forall a. TVar a -> IO a
readTVarIO TVar s
localVar
  (s, a) -> m (s, a)
forall (m :: * -> *) a. Monad m => a -> m a
return (s
s, a
a)

passTVar :: forall s m a
          . ( Monoid s
            , Effs '[Reader (s -> STM ()), Embed IO, Bracket] m
            )
         => m (s -> s, a)
         -> m a
passTVar :: m (s -> s, a) -> m a
passTVar m (s -> s, a)
main = do
  s -> STM ()
writeGlobal <- m (s -> STM ())
forall i (m :: * -> *). Eff (Ask i) m => m i
ask
  TVar s
localVar    <- IO (TVar s) -> m (TVar s)
forall (b :: * -> *) (m :: * -> *) a. Eff (Embed b) m => b a -> m a
embed (IO (TVar s) -> m (TVar s)) -> IO (TVar s) -> m (TVar s)
forall a b. (a -> b) -> a -> b
$ s -> IO (TVar s)
forall a. a -> IO (TVar a)
newTVarIO s
forall a. Monoid a => a
mempty
  TVar Bool
switch      <- IO (TVar Bool) -> m (TVar Bool)
forall (b :: * -> *) (m :: * -> *) a. Eff (Embed b) m => b a -> m a
embed (IO (TVar Bool) -> m (TVar Bool))
-> IO (TVar Bool) -> m (TVar Bool)
forall a b. (a -> b) -> a -> b
$ Bool -> IO (TVar Bool)
forall a. a -> IO (TVar a)
newTVarIO Bool
True
  let
    writeLocal :: s -> STM ()
    writeLocal :: s -> STM ()
writeLocal s
o = do
      Bool
writeToLocal <- TVar Bool -> STM Bool
forall a. TVar a -> STM a
readTVar TVar Bool
switch
      if Bool
writeToLocal then do
        s
s <- TVar s -> STM s
forall a. TVar a -> STM a
readTVar TVar s
localVar
        TVar s -> s -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar TVar s
localVar (s -> STM ()) -> s -> STM ()
forall a b. (a -> b) -> a -> b
$! s
s s -> s -> s
forall a. Semigroup a => a -> a -> a
<> s
o
      else
        s -> STM ()
writeGlobal s
o

    commit :: (s -> s) -> IO ()
    commit :: (s -> s) -> IO ()
commit s -> s
f = STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
      Bool
notAlreadyCommited <- TVar Bool -> STM Bool
forall a. TVar a -> STM a
readTVar TVar Bool
switch
      Bool -> STM () -> STM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
notAlreadyCommited (STM () -> STM ()) -> STM () -> STM ()
forall a b. (a -> b) -> a -> b
$ do
        s
s <- TVar s -> STM s
forall a. TVar a -> STM a
readTVar TVar s
localVar
        s -> STM ()
writeGlobal (s -> s
f s
s)
        TVar Bool -> Bool -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar TVar Bool
switch Bool
False

  ((s -> s
_, a
a), ()
_) <-
    m ()
-> (() -> ExitCase (s -> s, a) -> m ())
-> (() -> m (s -> s, a))
-> m ((s -> s, a), ())
forall (m :: * -> *) a b c.
Eff Bracket m =>
m a -> (a -> ExitCase b -> m c) -> (a -> m b) -> m (b, c)
generalBracket
      (() -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
      (\()
_ -> \case
        ExitCaseSuccess (s -> s
f, a
_) -> IO () -> m ()
forall (b :: * -> *) (m :: * -> *) a. Eff (Embed b) m => b a -> m a
embed ((s -> s) -> IO ()
commit s -> s
f)
        ExitCase (s -> s, a)
_                      -> IO () -> m ()
forall (b :: * -> *) (m :: * -> *) a. Eff (Embed b) m => b a -> m a
embed ((s -> s) -> IO ()
commit s -> s
forall a. a -> a
id)
      )
      (\()
_ -> ((s -> STM ()) -> s -> STM ()) -> m (s -> s, a) -> m (s -> s, a)
forall i (m :: * -> *) a. Eff (Local i) m => (i -> i) -> m a -> m a
local (\s -> STM ()
_ -> s -> STM ()
writeLocal) m (s -> s, a)
main)
  a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a

data WriterToBracketH

type WriterToBracketC s = CompositionC
 '[ IntroC '[Pass s, Listen s, Tell s] '[Local (s -> STM ()), Ask (s -> STM ())]
  , InterpretC WriterToBracketH (Pass s)
  , InterpretC WriterToBracketH (Listen s)
  , InterpretC WriterTVarH (Tell s)
  , ReaderC (s -> STM ())
  ]

instance ( Monoid s
         , Effs '[Reader (s -> STM ()), Embed IO, Bracket] m
         )
      => Handler WriterToBracketH (Listen s) m where
  effHandler :: Listen s (Effly z) x -> Effly z x
effHandler (Listen Effly z a
m) = Effly z a -> Effly z (s, a)
forall s (m :: * -> *) a.
(Monoid s, Effs '[Reader (s -> STM ()), Embed IO, Bracket] m) =>
m a -> m (s, a)
listenTVar Effly z a
m
  {-# INLINEABLE effHandler #-}

instance ( Monoid s
         , Effs '[Reader (s -> STM ()), Embed IO, Bracket] m
         )
      => Handler WriterToBracketH (Pass s) m where
  effHandler :: Pass s (Effly z) x -> Effly z x
effHandler (Pass Effly z (s -> s, x)
m) = Effly z (s -> s, x) -> Effly z x
forall s (m :: * -> *) a.
(Monoid s, Effs '[Reader (s -> STM ()), Embed IO, Bracket] m) =>
m (s -> s, a) -> m a
passTVar Effly z (s -> s, x)
m
  {-# INLINEABLE effHandler #-}

-- | Run connected @'Pass' s@, @'Listen' s@ and @'Tell' s@ effects
-- -- i.e. @'Writer' s@ -- by accumulating uses of 'tell' through using atomic
-- operations in 'IO', relying on the provided protection of 'Bracket' for
-- the implementation.
--
-- @'Derivs' ('WriterToBracketC' s m) = 'Pass' s ': 'Listen' s : 'Tell' s ': 'Derivs' m@
--
-- @'Prims'  ('WriterToBracketC' s m) = 'Control.Effect.Type.ReaderPrim.ReaderPrim' (s -> STM ()) ': 'Prims' m@
--
-- Note that unlike 'writerToIO', this does not have a higher-rank type.
writerToBracket :: forall s m a p
                 . ( Monoid s
                   , Effs [Embed IO, Bracket] m
                   , Threaders '[ReaderThreads] m p
                   )
                => WriterToBracketC s m a
                -> m (s, a)
writerToBracket :: WriterToBracketC s m a -> m (s, a)
writerToBracket WriterToBracketC s m a
m = do
  TVar s
tvar <- IO (TVar s) -> m (TVar s)
forall (b :: * -> *) (m :: * -> *) a. Eff (Embed b) m => b a -> m a
embed (IO (TVar s) -> m (TVar s)) -> IO (TVar s) -> m (TVar s)
forall a b. (a -> b) -> a -> b
$ s -> IO (TVar s)
forall a. a -> IO (TVar a)
newTVarIO s
forall a. Monoid a => a
mempty
  a
a    <- TVar s -> WriterToBracketC s m a -> m a
forall s (m :: * -> *) a (p :: [Effect]).
(Monoid s, Effs '[Embed IO, Bracket] m,
 Threaders '[ReaderThreads] m p) =>
TVar s -> WriterToBracketC s m a -> m a
writerToBracketTVar TVar s
tvar WriterToBracketC s m a
m
  s
s    <- IO s -> m s
forall (b :: * -> *) (m :: * -> *) a. Eff (Embed b) m => b a -> m a
embed (IO s -> m s) -> IO s -> m s
forall a b. (a -> b) -> a -> b
$ TVar s -> IO s
forall a. TVar a -> IO a
readTVarIO TVar s
tvar
  (s, a) -> m (s, a)
forall (m :: * -> *) a. Monad m => a -> m a
return (s
s, a
a)
{-# INLINE writerToBracket #-}

-- | Run connected @'Pass' s@, @'Listen' s@ and @'Tell' s@ effects
-- -- i.e. @'Writer' s@ -- by accumulating uses of 'tell' through using atomic
-- operations in 'IO' over a 'TVar', relying on the provided protection
-- of 'Bracket' for the implementation.
--
-- @'Derivs' ('WriterToBracketC' s m) = 'Pass' s ': 'Listen' s : 'Tell' s ': 'Derivs' m@
--
-- @'Prims'  ('WriterToBracketC' s m) = 'Control.Effect.Type.ReaderPrim.ReaderPrim' (s -> STM ()) ': 'Prims' m@
--
-- Note that unlike 'runTellTVar', this does not have a higher-rank type.
writerToBracketTVar :: forall s m a p
                     . ( Monoid s
                       , Effs [Embed IO, Bracket] m
                       , Threaders '[ReaderThreads] m p
                       )
                    => TVar s
                    -> WriterToBracketC s m a
                    -> m a
writerToBracketTVar :: TVar s -> WriterToBracketC s m a -> m a
writerToBracketTVar TVar s
tvar =
     (s -> STM ()) -> ReaderC (s -> STM ()) m a -> m a
forall i (m :: * -> *) a (p :: [Effect]).
(Carrier m, Threaders '[ReaderThreads] m p) =>
i -> ReaderC i m a -> m a
runReader (\s
o -> do
       s
s <- TVar s -> STM s
forall a. TVar a -> STM a
readTVar TVar s
tvar
       TVar s -> s -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar TVar s
tvar (s -> STM ()) -> s -> STM ()
forall a b. (a -> b) -> a -> b
$! s
s s -> s -> s
forall a. Semigroup a => a -> a -> a
<> s
o
     )
  (ReaderC (s -> STM ()) m a -> m a)
-> (InterpretC WriterTVarH (Tell s) (ReaderC (s -> STM ()) m) a
    -> ReaderC (s -> STM ()) m a)
-> InterpretC WriterTVarH (Tell s) (ReaderC (s -> STM ()) m) a
-> m a
forall b a c. Coercible b a => (b -> c) -> (a -> b) -> a -> c
.# InterpretC WriterTVarH (Tell s) (ReaderC (s -> STM ()) m) a
-> ReaderC (s -> STM ()) m a
forall h (e :: Effect) (m :: * -> *) a.
Handler h e m =>
InterpretC h e m a -> m a
interpretViaHandler
  (InterpretC WriterTVarH (Tell s) (ReaderC (s -> STM ()) m) a
 -> m a)
-> (InterpretC
      WriterToBracketH
      (Listen s)
      (InterpretC WriterTVarH (Tell s) (ReaderC (s -> STM ()) m))
      a
    -> InterpretC WriterTVarH (Tell s) (ReaderC (s -> STM ()) m) a)
-> InterpretC
     WriterToBracketH
     (Listen s)
     (InterpretC WriterTVarH (Tell s) (ReaderC (s -> STM ()) m))
     a
-> m a
forall b a c. Coercible b a => (b -> c) -> (a -> b) -> a -> c
.# InterpretC
  WriterToBracketH
  (Listen s)
  (InterpretC WriterTVarH (Tell s) (ReaderC (s -> STM ()) m))
  a
-> InterpretC WriterTVarH (Tell s) (ReaderC (s -> STM ()) m) a
forall h (e :: Effect) (m :: * -> *) a.
Handler h e m =>
InterpretC h e m a -> m a
interpretViaHandler
  (InterpretC
   WriterToBracketH
   (Listen s)
   (InterpretC WriterTVarH (Tell s) (ReaderC (s -> STM ()) m))
   a
 -> m a)
-> (InterpretC
      WriterToBracketH
      (Pass s)
      (InterpretC
         WriterToBracketH
         (Listen s)
         (InterpretC WriterTVarH (Tell s) (ReaderC (s -> STM ()) m)))
      a
    -> InterpretC
         WriterToBracketH
         (Listen s)
         (InterpretC WriterTVarH (Tell s) (ReaderC (s -> STM ()) m))
         a)
-> InterpretC
     WriterToBracketH
     (Pass s)
     (InterpretC
        WriterToBracketH
        (Listen s)
        (InterpretC WriterTVarH (Tell s) (ReaderC (s -> STM ()) m)))
     a
-> m a
forall b a c. Coercible b a => (b -> c) -> (a -> b) -> a -> c
.# InterpretC
  WriterToBracketH
  (Pass s)
  (InterpretC
     WriterToBracketH
     (Listen s)
     (InterpretC WriterTVarH (Tell s) (ReaderC (s -> STM ()) m)))
  a
-> InterpretC
     WriterToBracketH
     (Listen s)
     (InterpretC WriterTVarH (Tell s) (ReaderC (s -> STM ()) m))
     a
forall h (e :: Effect) (m :: * -> *) a.
Handler h e m =>
InterpretC h e m a -> m a
interpretViaHandler
  (InterpretC
   WriterToBracketH
   (Pass s)
   (InterpretC
      WriterToBracketH
      (Listen s)
      (InterpretC WriterTVarH (Tell s) (ReaderC (s -> STM ()) m)))
   a
 -> m a)
-> (IntroUnderManyC
      '[Pass s, Listen s, Tell s]
      '[Local (s -> STM ()), Ask (s -> STM ())]
      (InterpretC
         WriterToBracketH
         (Pass s)
         (InterpretC
            WriterToBracketH
            (Listen s)
            (InterpretC WriterTVarH (Tell s) (ReaderC (s -> STM ()) m))))
      a
    -> InterpretC
         WriterToBracketH
         (Pass s)
         (InterpretC
            WriterToBracketH
            (Listen s)
            (InterpretC WriterTVarH (Tell s) (ReaderC (s -> STM ()) m)))
         a)
-> IntroUnderManyC
     '[Pass s, Listen s, Tell s]
     '[Local (s -> STM ()), Ask (s -> STM ())]
     (InterpretC
        WriterToBracketH
        (Pass s)
        (InterpretC
           WriterToBracketH
           (Listen s)
           (InterpretC WriterTVarH (Tell s) (ReaderC (s -> STM ()) m))))
     a
-> m a
forall b a c. Coercible b a => (b -> c) -> (a -> b) -> a -> c
.# IntroUnderManyC
  '[Pass s, Listen s, Tell s]
  '[Local (s -> STM ()), Ask (s -> STM ())]
  (InterpretC
     WriterToBracketH
     (Pass s)
     (InterpretC
        WriterToBracketH
        (Listen s)
        (InterpretC WriterTVarH (Tell s) (ReaderC (s -> STM ()) m))))
  a
-> InterpretC
     WriterToBracketH
     (Pass s)
     (InterpretC
        WriterToBracketH
        (Listen s)
        (InterpretC WriterTVarH (Tell s) (ReaderC (s -> STM ()) m)))
     a
forall (top :: [Effect]) (new :: [Effect]) (m :: * -> *) a.
(KnownList top, KnownList new, IntroConsistent top new m) =>
IntroUnderManyC top new m a -> m a
introUnderMany
  (IntroUnderManyC
   '[Pass s, Listen s, Tell s]
   '[Local (s -> STM ()), Ask (s -> STM ())]
   (InterpretC
      WriterToBracketH
      (Pass s)
      (InterpretC
         WriterToBracketH
         (Listen s)
         (InterpretC WriterTVarH (Tell s) (ReaderC (s -> STM ()) m))))
   a
 -> m a)
-> (WriterToBracketC s m a
    -> IntroUnderManyC
         '[Pass s, Listen s, Tell s]
         '[Local (s -> STM ()), Ask (s -> STM ())]
         (InterpretC
            WriterToBracketH
            (Pass s)
            (InterpretC
               WriterToBracketH
               (Listen s)
               (InterpretC WriterTVarH (Tell s) (ReaderC (s -> STM ()) m))))
         a)
-> WriterToBracketC s m a
-> m a
forall b a c. Coercible b a => (b -> c) -> (a -> b) -> a -> c
.# WriterToBracketC s m a
-> IntroUnderManyC
     '[Pass s, Listen s, Tell s]
     '[Local (s -> STM ()), Ask (s -> STM ())]
     (InterpretC
        WriterToBracketH
        (Pass s)
        (InterpretC
           WriterToBracketH
           (Listen s)
           (InterpretC WriterTVarH (Tell s) (ReaderC (s -> STM ()) m))))
     a
forall (ts :: [Effect]) (m :: * -> *) a.
CompositionC ts m a -> CompositionBaseM ts m a
runComposition
{-# INLINE writerToBracketTVar #-}

data WriterTVarH

type ListenTVarC s = CompositionC
 '[ IntroC '[Listen s, Tell s]
     '[ ListenPrim s
      , Local (s -> STM ())
      , Ask (s -> STM ())
      ]
  , InterpretC WriterTVarH (Listen s)
  , InterpretC WriterTVarH (Tell s)
  , InterpretPrimC WriterTVarH (ListenPrim s)
  , ReaderC (s -> STM ())
  ]

type WriterTVarC s = CompositionC
 '[ IntroC '[Pass s, Listen s, Tell s]
     '[ ListenPrim s
      , WriterPrim s
      , Local (s -> STM ())
      , Ask (s -> STM ())
      ]
  , InterpretC WriterTVarH (Pass s)
  , InterpretC WriterTVarH (Listen s)
  , InterpretC WriterTVarH (Tell s)
  , InterpretC WriterTVarH (ListenPrim s)
  , InterpretPrimC WriterTVarH (WriterPrim s)
  , ReaderC (s -> STM ())
  ]

instance ( Monoid s
         , Effs '[Reader (s -> STM ()), Embed IO] m
         )
      => Handler WriterTVarH (Tell s) m where
  effHandler :: Tell s (Effly z) x -> Effly z x
effHandler (Tell s
o) = s -> Effly z ()
forall s (m :: * -> *).
(Monoid s, Effs '[Reader (s -> STM ()), Embed IO] m) =>
s -> m ()
tellTVar s
o
  {-# INLINEABLE effHandler #-}

instance Eff (ListenPrim s) m
      => Handler WriterTVarH (Listen s) m where
  effHandler :: Listen s (Effly z) x -> Effly z x
effHandler (Listen Effly z a
m) = ListenPrim s (Effly z) (s, a) -> Effly z (s, a)
forall (e :: Effect) (m :: * -> *) a.
(Member e (Derivs m), Carrier m) =>
e m a -> m a
send (ListenPrim s (Effly z) (s, a) -> Effly z (s, a))
-> ListenPrim s (Effly z) (s, a) -> Effly z (s, a)
forall a b. (a -> b) -> a -> b
$ Effly z a -> ListenPrim s (Effly z) (s, a)
forall (m :: * -> *) a w. m a -> ListenPrim w m (w, a)
ListenPrimListen Effly z a
m
  {-# INLINEABLE effHandler #-}

instance Eff (WriterPrim s) m
      => Handler WriterTVarH (Pass s) m where
  effHandler :: Pass s (Effly z) x -> Effly z x
effHandler (Pass Effly z (s -> s, x)
m) = WriterPrim s (Effly z) x -> Effly z x
forall (e :: Effect) (m :: * -> *) a.
(Member e (Derivs m), Carrier m) =>
e m a -> m a
send (WriterPrim s (Effly z) x -> Effly z x)
-> WriterPrim s (Effly z) x -> Effly z x
forall a b. (a -> b) -> a -> b
$ Effly z (s -> s, x) -> WriterPrim s (Effly z) x
forall (m :: * -> *) w a. m (w -> w, a) -> WriterPrim w m a
WriterPrimPass Effly z (s -> s, x)
m
  {-# INLINEABLE effHandler #-}

instance Eff (WriterPrim s) m
      => Handler WriterTVarH (ListenPrim s) m where
  effHandler :: ListenPrim s (Effly z) x -> Effly z x
effHandler = \case
    ListenPrimTell s
o   -> WriterPrim s (Effly z) () -> Effly z ()
forall (e :: Effect) (m :: * -> *) a.
(Member e (Derivs m), Carrier m) =>
e m a -> m a
send (WriterPrim s (Effly z) () -> Effly z ())
-> WriterPrim s (Effly z) () -> Effly z ()
forall a b. (a -> b) -> a -> b
$ s -> WriterPrim s (Effly z) ()
forall w (m :: * -> *). w -> WriterPrim w m ()
WriterPrimTell s
o
    ListenPrimListen Effly z a
m -> WriterPrim s (Effly z) (s, a) -> Effly z (s, a)
forall (e :: Effect) (m :: * -> *) a.
(Member e (Derivs m), Carrier m) =>
e m a -> m a
send (WriterPrim s (Effly z) (s, a) -> Effly z (s, a))
-> WriterPrim s (Effly z) (s, a) -> Effly z (s, a)
forall a b. (a -> b) -> a -> b
$ Effly z a -> WriterPrim s (Effly z) (s, a)
forall (m :: * -> *) a w. m a -> WriterPrim w m (w, a)
WriterPrimListen Effly z a
m
  {-# INLINEABLE effHandler #-}

instance ( Monoid s
         , Effs '[Reader (s -> STM ()), Embed IO] m
         , C.MonadMask m
         )
      => PrimHandler WriterTVarH (ListenPrim s) m where
  effPrimHandler :: ListenPrim s m x -> m x
effPrimHandler = \case
    ListenPrimTell s
o -> s -> m ()
forall s (m :: * -> *).
(Monoid s, Effs '[Reader (s -> STM ()), Embed IO] m) =>
s -> m ()
tellTVar s
o
    ListenPrimListen m a
m -> BracketToIOC m (s, a) -> m (s, a)
forall (m :: * -> *) a.
(Carrier m, MonadMask m) =>
BracketToIOC m a -> m a
bracketToIO (InterpretPrimC BracketToIOH Bracket m a -> BracketToIOC m (s, a)
forall s (m :: * -> *) a.
(Monoid s, Effs '[Reader (s -> STM ()), Embed IO, Bracket] m) =>
m a -> m (s, a)
listenTVar (m a -> InterpretPrimC BracketToIOH Bracket m a
forall (t :: Effect) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m a
m))
  {-# INLINEABLE effPrimHandler #-}

instance ( Monoid s
         , Effs '[Reader (s -> STM ()), Embed IO] m
         , C.MonadMask m
         )
      => PrimHandler WriterTVarH (WriterPrim s) m where
  effPrimHandler :: WriterPrim s m x -> m x
effPrimHandler = \case
    WriterPrimTell s
o   -> s -> m ()
forall s (m :: * -> *).
(Monoid s, Effs '[Reader (s -> STM ()), Embed IO] m) =>
s -> m ()
tellTVar s
o
    WriterPrimListen m a
m -> BracketToIOC m (s, a) -> m (s, a)
forall (m :: * -> *) a.
(Carrier m, MonadMask m) =>
BracketToIOC m a -> m a
bracketToIO (InterpretPrimC BracketToIOH Bracket m a -> BracketToIOC m (s, a)
forall s (m :: * -> *) a.
(Monoid s, Effs '[Reader (s -> STM ()), Embed IO, Bracket] m) =>
m a -> m (s, a)
listenTVar (m a -> InterpretPrimC BracketToIOH Bracket m a
forall (t :: Effect) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m a
m))
    WriterPrimPass m (s -> s, x)
m   -> BracketToIOC m x -> m x
forall (m :: * -> *) a.
(Carrier m, MonadMask m) =>
BracketToIOC m a -> m a
bracketToIO (InterpretPrimC BracketToIOH Bracket m (s -> s, x)
-> BracketToIOC m x
forall s (m :: * -> *) a.
(Monoid s, Effs '[Reader (s -> STM ()), Embed IO, Bracket] m) =>
m (s -> s, a) -> m a
passTVar (m (s -> s, x) -> InterpretPrimC BracketToIOH Bracket m (s -> s, x)
forall (t :: Effect) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m (s -> s, x)
m))
  {-# INLINEABLE effPrimHandler #-}

-- | Run a @'Tell' s@ effect where @s@ is a 'Monoid' by accumulating uses of
-- 'tell' through atomic operations in 'IO'.
--
-- You may want to combine this with 'tellIntoTell'.
--
-- This has a higher-rank type, as it makes use of 'InterpretReifiedC'.
-- __This makes 'tellToIO' very difficult to use partially applied.__
-- __In particular, it can't be composed using @'.'@.__
--
-- If performance is secondary, consider using the slower
-- 'tellToIOSimple', which doesn't have a higher-rank type.
tellToIO :: forall s m a
          . ( Monoid s
            , Eff (Embed IO) m
            )
         => InterpretReifiedC (Tell s) m a
         -> m (s, a)
tellToIO :: InterpretReifiedC (Tell s) m a -> m (s, a)
tellToIO InterpretReifiedC (Tell s) m a
m = do
  IORef s
ref <- IO (IORef s) -> m (IORef s)
forall (b :: * -> *) (m :: * -> *) a. Eff (Embed b) m => b a -> m a
embed (IO (IORef s) -> m (IORef s)) -> IO (IORef s) -> m (IORef s)
forall a b. (a -> b) -> a -> b
$ s -> IO (IORef s)
forall a. a -> IO (IORef a)
newIORef s
forall a. Monoid a => a
mempty
  a
a   <- IORef s -> InterpretReifiedC (Tell s) m a -> m a
forall s (m :: * -> *) a.
(Monoid s, Eff (Embed IO) m) =>
IORef s -> InterpretReifiedC (Tell s) m a -> m a
runTellIORef IORef s
ref InterpretReifiedC (Tell s) m a
m
  s
s   <- IO s -> m s
forall (b :: * -> *) (m :: * -> *) a. Eff (Embed b) m => b a -> m a
embed (IO s -> m s) -> IO s -> m s
forall a b. (a -> b) -> a -> b
$ IORef s -> IO s
forall a. IORef a -> IO a
readIORef IORef s
ref
  (s, a) -> m (s, a)
forall (m :: * -> *) a. Monad m => a -> m a
return (s
s, a
a)
{-# INLINE tellToIO #-}

-- | Run a @'Tell' s@ effect where @s@ is a 'Monoid' by accumulating uses of
-- 'tell' through using atomic operations in 'IO' over the provided 'IORef'.
--
-- This has a higher-rank type, as it makes use of 'InterpretReifiedC'.
-- __This makes 'runTellIORef' very difficult to use partially applied.__
-- __In particular, it can't be composed using @'.'@.__
--
-- If performance is secondary, consider using the slower
-- 'runTellIORefSimple', which doesn't have a higher-rank type.
runTellIORef :: forall s m a
              . ( Monoid s
                , Eff (Embed IO) m
                )
             => IORef s
             -> InterpretReifiedC (Tell s) m a
             -> m a
runTellIORef :: IORef s -> InterpretReifiedC (Tell s) m a -> m a
runTellIORef IORef s
ref = EffHandler (Tell s) m -> InterpretReifiedC (Tell s) m a -> m a
forall (e :: Effect) (m :: * -> *) a.
(RepresentationalEff e, Carrier m) =>
EffHandler e m -> InterpretReifiedC e m a -> m a
interpret (EffHandler (Tell s) m -> InterpretReifiedC (Tell s) m a -> m a)
-> EffHandler (Tell s) m -> InterpretReifiedC (Tell s) m a -> m a
forall a b. (a -> b) -> a -> b
$ \case
  Tell o -> IO () -> Effly z ()
forall (b :: * -> *) (m :: * -> *) a. Eff (Embed b) m => b a -> m a
embed (IO () -> Effly z ()) -> IO () -> Effly z ()
forall a b. (a -> b) -> a -> b
$ IORef s -> (s -> (s, ())) -> IO ()
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef' IORef s
ref (\s
s -> (s
s s -> s -> s
forall a. Semigroup a => a -> a -> a
<> s
o, ()))
{-# INLINE runTellIORef #-}

-- | Run a @'Tell' s@ effect where @s@ is a 'Monoid' by accumulating uses of
-- 'tell' through using atomic operations in 'IO' over the provided 'TVar'.
--
-- This has a higher-rank type, as it makes use of 'InterpretReifiedC'.
-- __This makes 'runTellTVar' very difficult to use partially applied.__
-- __In particular, it can't be composed using @'.'@.__
--
-- If performance is secondary, consider using the slower
-- 'runTellTVarSimple', which doesn't have a higher-rank type.
runTellTVar :: forall s m a
             . ( Monoid s
               , Eff (Embed IO) m
               )
            => TVar s
            -> InterpretReifiedC (Tell s) m a
            -> m a
runTellTVar :: TVar s -> InterpretReifiedC (Tell s) m a -> m a
runTellTVar TVar s
tvar = EffHandler (Tell s) m -> InterpretReifiedC (Tell s) m a -> m a
forall (e :: Effect) (m :: * -> *) a.
(RepresentationalEff e, Carrier m) =>
EffHandler e m -> InterpretReifiedC e m a -> m a
interpret (EffHandler (Tell s) m -> InterpretReifiedC (Tell s) m a -> m a)
-> EffHandler (Tell s) m -> InterpretReifiedC (Tell s) m a -> m a
forall a b. (a -> b) -> a -> b
$ \case
  Tell o -> IO () -> Effly z ()
forall (b :: * -> *) (m :: * -> *) a. Eff (Embed b) m => b a -> m a
embed (IO () -> Effly z ()) -> IO () -> Effly z ()
forall a b. (a -> b) -> a -> b
$ STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
    s
s <- TVar s -> STM s
forall a. TVar a -> STM a
readTVar TVar s
tvar
    TVar s -> s -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar TVar s
tvar (s -> STM ()) -> s -> STM ()
forall a b. (a -> b) -> a -> b
$! s
s s -> s -> s
forall a. Semigroup a => a -> a -> a
<> s
o
{-# INLINE runTellTVar #-}

-- | Run a @'Tell' s@ effect where @s@ is a 'Monoid' by accumulating uses of
-- 'tell' through atomic operations in 'IO'.
--
-- You may want to combine this with 'tellIntoTellSimple'.
--
-- This is a less performant version of 'tellToIO' that doesn't have
-- a higher-rank type, making it much easier to use partially applied.
tellToIOSimple :: forall s m a p
                . ( Monoid s
                  , Eff (Embed IO) m
                  , Threaders '[ReaderThreads] m p
                  )
               => InterpretSimpleC (Tell s) m a
               -> m (s, a)
tellToIOSimple :: InterpretSimpleC (Tell s) m a -> m (s, a)
tellToIOSimple InterpretSimpleC (Tell s) m a
m = do
  IORef s
ref <- IO (IORef s) -> m (IORef s)
forall (b :: * -> *) (m :: * -> *) a. Eff (Embed b) m => b a -> m a
embed (IO (IORef s) -> m (IORef s)) -> IO (IORef s) -> m (IORef s)
forall a b. (a -> b) -> a -> b
$ s -> IO (IORef s)
forall a. a -> IO (IORef a)
newIORef s
forall a. Monoid a => a
mempty
  a
a   <- IORef s -> InterpretSimpleC (Tell s) m a -> m a
forall s (m :: * -> *) a (p :: [Effect]).
(Monoid s, Eff (Embed IO) m, Threaders '[ReaderThreads] m p) =>
IORef s -> InterpretSimpleC (Tell s) m a -> m a
runTellIORefSimple IORef s
ref InterpretSimpleC (Tell s) m a
m
  s
s   <- IO s -> m s
forall (b :: * -> *) (m :: * -> *) a. Eff (Embed b) m => b a -> m a
embed (IO s -> m s) -> IO s -> m s
forall a b. (a -> b) -> a -> b
$ IORef s -> IO s
forall a. IORef a -> IO a
readIORef IORef s
ref
  (s, a) -> m (s, a)
forall (m :: * -> *) a. Monad m => a -> m a
return (s
s, a
a)
{-# INLINE tellToIOSimple #-}

-- | Run a @'Tell' s@ effect where @s@ is a 'Monoid' by accumulating uses of
-- 'tell' through using atomic operations in 'IO' over the provided 'IORef'.
--
-- This is a less performant version of 'tellToIO' that doesn't have
-- a higher-rank type, making it much easier to use partially applied.
runTellIORefSimple :: forall s m a p
                    . ( Monoid s
                      , Eff (Embed IO) m
                      , Threaders '[ReaderThreads] m p
                      )
                   => IORef s
                   -> InterpretSimpleC (Tell s) m a
                   -> m a
runTellIORefSimple :: IORef s -> InterpretSimpleC (Tell s) m a -> m a
runTellIORefSimple IORef s
ref = EffHandler (Tell s) m -> InterpretSimpleC (Tell s) m a -> m a
forall (e :: Effect) (m :: * -> *) a (p :: [Effect]).
(RepresentationalEff e, Threaders '[ReaderThreads] m p,
 Carrier m) =>
EffHandler e m -> InterpretSimpleC e m a -> m a
interpretSimple (EffHandler (Tell s) m -> InterpretSimpleC (Tell s) m a -> m a)
-> EffHandler (Tell s) m -> InterpretSimpleC (Tell s) m a -> m a
forall a b. (a -> b) -> a -> b
$ \case
  Tell o -> IO () -> Effly z ()
forall (b :: * -> *) (m :: * -> *) a. Eff (Embed b) m => b a -> m a
embed (IO () -> Effly z ()) -> IO () -> Effly z ()
forall a b. (a -> b) -> a -> b
$ IORef s -> (s -> (s, ())) -> IO ()
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef' IORef s
ref (\s
s -> (s
s s -> s -> s
forall a. Semigroup a => a -> a -> a
<> s
o, ()))
{-# INLINE runTellIORefSimple #-}

-- | Run a @'Tell' s@ effect where @s@ is a 'Monoid' by accumulating uses of
-- 'tell' through using atomic operations in 'IO' over the provided 'TVar'.
--
-- This is a less performant version of 'tellToIO' that doesn't have
-- a higher-rank type, making it much easier to use partially applied.
runTellTVarSimple :: forall s m a p
                   . ( Monoid s
                     , Eff (Embed IO) m
                     , Threaders '[ReaderThreads] m p
                     )
                  => TVar s
                  -> InterpretSimpleC (Tell s) m a
                  -> m a
runTellTVarSimple :: TVar s -> InterpretSimpleC (Tell s) m a -> m a
runTellTVarSimple TVar s
tvar = EffHandler (Tell s) m -> InterpretSimpleC (Tell s) m a -> m a
forall (e :: Effect) (m :: * -> *) a (p :: [Effect]).
(RepresentationalEff e, Threaders '[ReaderThreads] m p,
 Carrier m) =>
EffHandler e m -> InterpretSimpleC e m a -> m a
interpretSimple (EffHandler (Tell s) m -> InterpretSimpleC (Tell s) m a -> m a)
-> EffHandler (Tell s) m -> InterpretSimpleC (Tell s) m a -> m a
forall a b. (a -> b) -> a -> b
$ \case
  Tell o -> IO () -> Effly z ()
forall (b :: * -> *) (m :: * -> *) a. Eff (Embed b) m => b a -> m a
embed (IO () -> Effly z ()) -> IO () -> Effly z ()
forall a b. (a -> b) -> a -> b
$ STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
    s
s <- TVar s -> STM s
forall a. TVar a -> STM a
readTVar TVar s
tvar
    TVar s -> s -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar TVar s
tvar (s -> STM ()) -> s -> STM ()
forall a b. (a -> b) -> a -> b
$! s
s s -> s -> s
forall a. Semigroup a => a -> a -> a
<> s
o
{-# INLINE runTellTVarSimple #-}

-- | Run connected @'Listen' s@ and @'Tell' s@ effects by accumulating uses of
-- 'tell' through using atomic operations in 'IO'.
--
-- @'Derivs' ('ListenTVarC' s m) = 'Listen' s ': 'Tell' s ': 'Derivs' m@
--
-- @'Prims'  ('ListenTVarC' s m) = 'ListenPrim' s ': 'Control.Effect.Type.ReaderPrim.ReaderPrim' (s -> STM ()) ': 'Prims' m@
--
-- Note that unlike 'tellToIO', this does not have a higher-rank type.
listenToIO :: forall s m a p
            . ( Monoid s
              , Eff (Embed IO) m
              , C.MonadMask m
              , Threaders '[ReaderThreads] m p
              )
           => ListenTVarC s m a
           -> m (s, a)
listenToIO :: ListenTVarC s m a -> m (s, a)
listenToIO ListenTVarC s m a
m = do
  TVar s
tvar <- IO (TVar s) -> m (TVar s)
forall (b :: * -> *) (m :: * -> *) a. Eff (Embed b) m => b a -> m a
embed (IO (TVar s) -> m (TVar s)) -> IO (TVar s) -> m (TVar s)
forall a b. (a -> b) -> a -> b
$ s -> IO (TVar s)
forall a. a -> IO (TVar a)
newTVarIO s
forall a. Monoid a => a
mempty
  a
a    <- TVar s -> ListenTVarC s m a -> m a
forall s (m :: * -> *) a (p :: [Effect]).
(Monoid s, Eff (Embed IO) m, MonadMask m,
 Threaders '[ReaderThreads] m p) =>
TVar s -> ListenTVarC s m a -> m a
runListenTVar TVar s
tvar ListenTVarC s m a
m
  s
s    <- IO s -> m s
forall (b :: * -> *) (m :: * -> *) a. Eff (Embed b) m => b a -> m a
embed (IO s -> m s) -> IO s -> m s
forall a b. (a -> b) -> a -> b
$ TVar s -> IO s
forall a. TVar a -> IO a
readTVarIO TVar s
tvar
  (s, a) -> m (s, a)
forall (m :: * -> *) a. Monad m => a -> m a
return (s
s, a
a)
{-# INLINE listenToIO #-}

-- | Run connected @'Listen' s@ and @'Tell' s@ effects by accumulating uses of
-- 'tell' through using atomic operations in 'IO' over the provided 'TVar'.
--
-- @'Derivs' ('ListenTVarC' s m) = 'Listen' s : 'Tell' s ': 'Derivs' m@
--
-- @'Prims'  ('ListenTVarC' s m) = 'ListenPrim' s ': 'Control.Effect.Type.ReaderPrim.ReaderPrim' (s -> STM ()) ': 'Prims' m@
--
-- Note that unlike 'runTellTVar', this does not have a higher-rank type.
runListenTVar :: forall s m a p
               . ( Monoid s
                 , Eff (Embed IO) m
                 , C.MonadMask m
                 , Threaders '[ReaderThreads] m p
                 )
              => TVar s
              -> ListenTVarC s m a
              -> m a
runListenTVar :: TVar s -> ListenTVarC s m a -> m a
runListenTVar TVar s
tvar =
     (s -> STM ()) -> ReaderC (s -> STM ()) m a -> m a
forall i (m :: * -> *) a (p :: [Effect]).
(Carrier m, Threaders '[ReaderThreads] m p) =>
i -> ReaderC i m a -> m a
runReader (\s
o -> do
       s
s <- TVar s -> STM s
forall a. TVar a -> STM a
readTVar TVar s
tvar
       TVar s -> s -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar TVar s
tvar (s -> STM ()) -> s -> STM ()
forall a b. (a -> b) -> a -> b
$! s
s s -> s -> s
forall a. Semigroup a => a -> a -> a
<> s
o
     )
  (ReaderC (s -> STM ()) m a -> m a)
-> (InterpretPrimC
      WriterTVarH (ListenPrim s) (ReaderC (s -> STM ()) m) a
    -> ReaderC (s -> STM ()) m a)
-> InterpretPrimC
     WriterTVarH (ListenPrim s) (ReaderC (s -> STM ()) m) a
-> m a
forall b a c. Coercible b a => (b -> c) -> (a -> b) -> a -> c
.# InterpretPrimC
  WriterTVarH (ListenPrim s) (ReaderC (s -> STM ()) m) a
-> ReaderC (s -> STM ()) m a
forall h (e :: Effect) (m :: * -> *) a.
PrimHandler h e m =>
InterpretPrimC h e m a -> m a
interpretPrimViaHandler
  (InterpretPrimC
   WriterTVarH (ListenPrim s) (ReaderC (s -> STM ()) m) a
 -> m a)
-> (InterpretC
      WriterTVarH
      (Tell s)
      (InterpretPrimC
         WriterTVarH (ListenPrim s) (ReaderC (s -> STM ()) m))
      a
    -> InterpretPrimC
         WriterTVarH (ListenPrim s) (ReaderC (s -> STM ()) m) a)
-> InterpretC
     WriterTVarH
     (Tell s)
     (InterpretPrimC
        WriterTVarH (ListenPrim s) (ReaderC (s -> STM ()) m))
     a
-> m a
forall b a c. Coercible b a => (b -> c) -> (a -> b) -> a -> c
.# InterpretC
  WriterTVarH
  (Tell s)
  (InterpretPrimC
     WriterTVarH (ListenPrim s) (ReaderC (s -> STM ()) m))
  a
-> InterpretPrimC
     WriterTVarH (ListenPrim s) (ReaderC (s -> STM ()) m) a
forall h (e :: Effect) (m :: * -> *) a.
Handler h e m =>
InterpretC h e m a -> m a
interpretViaHandler
  (InterpretC
   WriterTVarH
   (Tell s)
   (InterpretPrimC
      WriterTVarH (ListenPrim s) (ReaderC (s -> STM ()) m))
   a
 -> m a)
-> (InterpretC
      WriterTVarH
      (Listen s)
      (InterpretC
         WriterTVarH
         (Tell s)
         (InterpretPrimC
            WriterTVarH (ListenPrim s) (ReaderC (s -> STM ()) m)))
      a
    -> InterpretC
         WriterTVarH
         (Tell s)
         (InterpretPrimC
            WriterTVarH (ListenPrim s) (ReaderC (s -> STM ()) m))
         a)
-> InterpretC
     WriterTVarH
     (Listen s)
     (InterpretC
        WriterTVarH
        (Tell s)
        (InterpretPrimC
           WriterTVarH (ListenPrim s) (ReaderC (s -> STM ()) m)))
     a
-> m a
forall b a c. Coercible b a => (b -> c) -> (a -> b) -> a -> c
.# InterpretC
  WriterTVarH
  (Listen s)
  (InterpretC
     WriterTVarH
     (Tell s)
     (InterpretPrimC
        WriterTVarH (ListenPrim s) (ReaderC (s -> STM ()) m)))
  a
-> InterpretC
     WriterTVarH
     (Tell s)
     (InterpretPrimC
        WriterTVarH (ListenPrim s) (ReaderC (s -> STM ()) m))
     a
forall h (e :: Effect) (m :: * -> *) a.
Handler h e m =>
InterpretC h e m a -> m a
interpretViaHandler
  (InterpretC
   WriterTVarH
   (Listen s)
   (InterpretC
      WriterTVarH
      (Tell s)
      (InterpretPrimC
         WriterTVarH (ListenPrim s) (ReaderC (s -> STM ()) m)))
   a
 -> m a)
-> (IntroUnderManyC
      '[Listen s, Tell s]
      '[ListenPrim s, Local (s -> STM ()), Ask (s -> STM ())]
      (InterpretC
         WriterTVarH
         (Listen s)
         (InterpretC
            WriterTVarH
            (Tell s)
            (InterpretPrimC
               WriterTVarH (ListenPrim s) (ReaderC (s -> STM ()) m))))
      a
    -> InterpretC
         WriterTVarH
         (Listen s)
         (InterpretC
            WriterTVarH
            (Tell s)
            (InterpretPrimC
               WriterTVarH (ListenPrim s) (ReaderC (s -> STM ()) m)))
         a)
-> IntroUnderManyC
     '[Listen s, Tell s]
     '[ListenPrim s, Local (s -> STM ()), Ask (s -> STM ())]
     (InterpretC
        WriterTVarH
        (Listen s)
        (InterpretC
           WriterTVarH
           (Tell s)
           (InterpretPrimC
              WriterTVarH (ListenPrim s) (ReaderC (s -> STM ()) m))))
     a
-> m a
forall b a c. Coercible b a => (b -> c) -> (a -> b) -> a -> c
.# IntroUnderManyC
  '[Listen s, Tell s]
  '[ListenPrim s, Local (s -> STM ()), Ask (s -> STM ())]
  (InterpretC
     WriterTVarH
     (Listen s)
     (InterpretC
        WriterTVarH
        (Tell s)
        (InterpretPrimC
           WriterTVarH (ListenPrim s) (ReaderC (s -> STM ()) m))))
  a
-> InterpretC
     WriterTVarH
     (Listen s)
     (InterpretC
        WriterTVarH
        (Tell s)
        (InterpretPrimC
           WriterTVarH (ListenPrim s) (ReaderC (s -> STM ()) m)))
     a
forall (top :: [Effect]) (new :: [Effect]) (m :: * -> *) a.
(KnownList top, KnownList new, IntroConsistent top new m) =>
IntroUnderManyC top new m a -> m a
introUnderMany
  (IntroUnderManyC
   '[Listen s, Tell s]
   '[ListenPrim s, Local (s -> STM ()), Ask (s -> STM ())]
   (InterpretC
      WriterTVarH
      (Listen s)
      (InterpretC
         WriterTVarH
         (Tell s)
         (InterpretPrimC
            WriterTVarH (ListenPrim s) (ReaderC (s -> STM ()) m))))
   a
 -> m a)
-> (ListenTVarC s m a
    -> IntroUnderManyC
         '[Listen s, Tell s]
         '[ListenPrim s, Local (s -> STM ()), Ask (s -> STM ())]
         (InterpretC
            WriterTVarH
            (Listen s)
            (InterpretC
               WriterTVarH
               (Tell s)
               (InterpretPrimC
                  WriterTVarH (ListenPrim s) (ReaderC (s -> STM ()) m))))
         a)
-> ListenTVarC s m a
-> m a
forall b a c. Coercible b a => (b -> c) -> (a -> b) -> a -> c
.# ListenTVarC s m a
-> IntroUnderManyC
     '[Listen s, Tell s]
     '[ListenPrim s, Local (s -> STM ()), Ask (s -> STM ())]
     (InterpretC
        WriterTVarH
        (Listen s)
        (InterpretC
           WriterTVarH
           (Tell s)
           (InterpretPrimC
              WriterTVarH (ListenPrim s) (ReaderC (s -> STM ()) m))))
     a
forall (ts :: [Effect]) (m :: * -> *) a.
CompositionC ts m a -> CompositionBaseM ts m a
runComposition
{-# INLINE runListenTVar #-}

-- | Run connected @'Pass' s@, @'Listen' s@ and @'Tell' s@ effects
-- -- i.e. @'Writer' s@ -- by accumulating uses of 'tell' through using atomic
-- operations in 'IO'.
--
-- @'Derivs' ('WriterTVarC' s m) = 'Pass' s ': 'Listen' s : 'Tell' s ': 'Derivs' m@
--
-- @'Prims'  ('WriterTVarC' s m) = 'WriterPrim' s ': 'Control.Effect.Type.ReaderPrim.ReaderPrim' (s -> STM ()) ': 'Prims' m@
--
-- Note that unlike 'tellToIO', this does not have a higher-rank type.
writerToIO :: forall s m a p
            . ( Monoid s
              , Eff (Embed IO) m
              , C.MonadMask m
              , Threaders '[ReaderThreads] m p
              )
           => WriterTVarC s m a
           -> m (s, a)
writerToIO :: WriterTVarC s m a -> m (s, a)
writerToIO WriterTVarC s m a
m = do
  TVar s
tvar <- IO (TVar s) -> m (TVar s)
forall (b :: * -> *) (m :: * -> *) a. Eff (Embed b) m => b a -> m a
embed (IO (TVar s) -> m (TVar s)) -> IO (TVar s) -> m (TVar s)
forall a b. (a -> b) -> a -> b
$ s -> IO (TVar s)
forall a. a -> IO (TVar a)
newTVarIO s
forall a. Monoid a => a
mempty
  a
a    <- TVar s -> WriterTVarC s m a -> m a
forall s (m :: * -> *) a (p :: [Effect]).
(Monoid s, Eff (Embed IO) m, MonadMask m,
 Threaders '[ReaderThreads] m p) =>
TVar s -> WriterTVarC s m a -> m a
runWriterTVar TVar s
tvar WriterTVarC s m a
m
  s
s    <- IO s -> m s
forall (b :: * -> *) (m :: * -> *) a. Eff (Embed b) m => b a -> m a
embed (IO s -> m s) -> IO s -> m s
forall a b. (a -> b) -> a -> b
$ TVar s -> IO s
forall a. TVar a -> IO a
readTVarIO TVar s
tvar
  (s, a) -> m (s, a)
forall (m :: * -> *) a. Monad m => a -> m a
return (s
s, a
a)
{-# INLINE writerToIO #-}

-- | Run connected @'Pass' s@, @'Listen' s@ and @'Tell' s@ effects
-- -- i.e. @'Writer' s@ -- by accumulating uses of 'tell' through using atomic
-- operations in 'IO' over a 'TVar'.
--
-- @'Derivs' ('WriterTVarC' s m) = 'Pass' s ': 'Listen' s : 'Tell' s ': 'Derivs' m@
--
-- @'Prims'  ('WriterTVarC' s m) = 'WriterPrim' s ': 'Control.Effect.Type.ReaderPrim.ReaderPrim' (s -> STM ()) ': 'Prims' m@
--
-- Note that unlike 'runTellTVar', this does not have a higher-rank type.
runWriterTVar :: forall s m a p
               . ( Monoid s
                 , Eff (Embed IO) m
                 , C.MonadMask m
                 , Threaders '[ReaderThreads] m p
                 )
              => TVar s
              -> WriterTVarC s m a
              -> m a
runWriterTVar :: TVar s -> WriterTVarC s m a -> m a
runWriterTVar TVar s
tvar =
     (s -> STM ()) -> ReaderC (s -> STM ()) m a -> m a
forall i (m :: * -> *) a (p :: [Effect]).
(Carrier m, Threaders '[ReaderThreads] m p) =>
i -> ReaderC i m a -> m a
runReader (\s
o -> do
       s
s <- TVar s -> STM s
forall a. TVar a -> STM a
readTVar TVar s
tvar
       TVar s -> s -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar TVar s
tvar (s -> STM ()) -> s -> STM ()
forall a b. (a -> b) -> a -> b
$! s
s s -> s -> s
forall a. Semigroup a => a -> a -> a
<> s
o
     )
  (ReaderC (s -> STM ()) m a -> m a)
-> (InterpretPrimC
      WriterTVarH (WriterPrim s) (ReaderC (s -> STM ()) m) a
    -> ReaderC (s -> STM ()) m a)
-> InterpretPrimC
     WriterTVarH (WriterPrim s) (ReaderC (s -> STM ()) m) a
-> m a
forall b a c. Coercible b a => (b -> c) -> (a -> b) -> a -> c
.# InterpretPrimC
  WriterTVarH (WriterPrim s) (ReaderC (s -> STM ()) m) a
-> ReaderC (s -> STM ()) m a
forall h (e :: Effect) (m :: * -> *) a.
PrimHandler h e m =>
InterpretPrimC h e m a -> m a
interpretPrimViaHandler
  (InterpretPrimC
   WriterTVarH (WriterPrim s) (ReaderC (s -> STM ()) m) a
 -> m a)
-> (InterpretC
      WriterTVarH
      (ListenPrim s)
      (InterpretPrimC
         WriterTVarH (WriterPrim s) (ReaderC (s -> STM ()) m))
      a
    -> InterpretPrimC
         WriterTVarH (WriterPrim s) (ReaderC (s -> STM ()) m) a)
-> InterpretC
     WriterTVarH
     (ListenPrim s)
     (InterpretPrimC
        WriterTVarH (WriterPrim s) (ReaderC (s -> STM ()) m))
     a
-> m a
forall b a c. Coercible b a => (b -> c) -> (a -> b) -> a -> c
.# InterpretC
  WriterTVarH
  (ListenPrim s)
  (InterpretPrimC
     WriterTVarH (WriterPrim s) (ReaderC (s -> STM ()) m))
  a
-> InterpretPrimC
     WriterTVarH (WriterPrim s) (ReaderC (s -> STM ()) m) a
forall h (e :: Effect) (m :: * -> *) a.
Handler h e m =>
InterpretC h e m a -> m a
interpretViaHandler
  (InterpretC
   WriterTVarH
   (ListenPrim s)
   (InterpretPrimC
      WriterTVarH (WriterPrim s) (ReaderC (s -> STM ()) m))
   a
 -> m a)
-> (InterpretC
      WriterTVarH
      (Tell s)
      (InterpretC
         WriterTVarH
         (ListenPrim s)
         (InterpretPrimC
            WriterTVarH (WriterPrim s) (ReaderC (s -> STM ()) m)))
      a
    -> InterpretC
         WriterTVarH
         (ListenPrim s)
         (InterpretPrimC
            WriterTVarH (WriterPrim s) (ReaderC (s -> STM ()) m))
         a)
-> InterpretC
     WriterTVarH
     (Tell s)
     (InterpretC
        WriterTVarH
        (ListenPrim s)
        (InterpretPrimC
           WriterTVarH (WriterPrim s) (ReaderC (s -> STM ()) m)))
     a
-> m a
forall b a c. Coercible b a => (b -> c) -> (a -> b) -> a -> c
.# InterpretC
  WriterTVarH
  (Tell s)
  (InterpretC
     WriterTVarH
     (ListenPrim s)
     (InterpretPrimC
        WriterTVarH (WriterPrim s) (ReaderC (s -> STM ()) m)))
  a
-> InterpretC
     WriterTVarH
     (ListenPrim s)
     (InterpretPrimC
        WriterTVarH (WriterPrim s) (ReaderC (s -> STM ()) m))
     a
forall h (e :: Effect) (m :: * -> *) a.
Handler h e m =>
InterpretC h e m a -> m a
interpretViaHandler
  (InterpretC
   WriterTVarH
   (Tell s)
   (InterpretC
      WriterTVarH
      (ListenPrim s)
      (InterpretPrimC
         WriterTVarH (WriterPrim s) (ReaderC (s -> STM ()) m)))
   a
 -> m a)
-> (InterpretC
      WriterTVarH
      (Listen s)
      (InterpretC
         WriterTVarH
         (Tell s)
         (InterpretC
            WriterTVarH
            (ListenPrim s)
            (InterpretPrimC
               WriterTVarH (WriterPrim s) (ReaderC (s -> STM ()) m))))
      a
    -> InterpretC
         WriterTVarH
         (Tell s)
         (InterpretC
            WriterTVarH
            (ListenPrim s)
            (InterpretPrimC
               WriterTVarH (WriterPrim s) (ReaderC (s -> STM ()) m)))
         a)
-> InterpretC
     WriterTVarH
     (Listen s)
     (InterpretC
        WriterTVarH
        (Tell s)
        (InterpretC
           WriterTVarH
           (ListenPrim s)
           (InterpretPrimC
              WriterTVarH (WriterPrim s) (ReaderC (s -> STM ()) m))))
     a
-> m a
forall b a c. Coercible b a => (b -> c) -> (a -> b) -> a -> c
.# InterpretC
  WriterTVarH
  (Listen s)
  (InterpretC
     WriterTVarH
     (Tell s)
     (InterpretC
        WriterTVarH
        (ListenPrim s)
        (InterpretPrimC
           WriterTVarH (WriterPrim s) (ReaderC (s -> STM ()) m))))
  a
-> InterpretC
     WriterTVarH
     (Tell s)
     (InterpretC
        WriterTVarH
        (ListenPrim s)
        (InterpretPrimC
           WriterTVarH (WriterPrim s) (ReaderC (s -> STM ()) m)))
     a
forall h (e :: Effect) (m :: * -> *) a.
Handler h e m =>
InterpretC h e m a -> m a
interpretViaHandler
  (InterpretC
   WriterTVarH
   (Listen s)
   (InterpretC
      WriterTVarH
      (Tell s)
      (InterpretC
         WriterTVarH
         (ListenPrim s)
         (InterpretPrimC
            WriterTVarH (WriterPrim s) (ReaderC (s -> STM ()) m))))
   a
 -> m a)
-> (InterpretC
      WriterTVarH
      (Pass s)
      (InterpretC
         WriterTVarH
         (Listen s)
         (InterpretC
            WriterTVarH
            (Tell s)
            (InterpretC
               WriterTVarH
               (ListenPrim s)
               (InterpretPrimC
                  WriterTVarH (WriterPrim s) (ReaderC (s -> STM ()) m)))))
      a
    -> InterpretC
         WriterTVarH
         (Listen s)
         (InterpretC
            WriterTVarH
            (Tell s)
            (InterpretC
               WriterTVarH
               (ListenPrim s)
               (InterpretPrimC
                  WriterTVarH (WriterPrim s) (ReaderC (s -> STM ()) m))))
         a)
-> InterpretC
     WriterTVarH
     (Pass s)
     (InterpretC
        WriterTVarH
        (Listen s)
        (InterpretC
           WriterTVarH
           (Tell s)
           (InterpretC
              WriterTVarH
              (ListenPrim s)
              (InterpretPrimC
                 WriterTVarH (WriterPrim s) (ReaderC (s -> STM ()) m)))))
     a
-> m a
forall b a c. Coercible b a => (b -> c) -> (a -> b) -> a -> c
.# InterpretC
  WriterTVarH
  (Pass s)
  (InterpretC
     WriterTVarH
     (Listen s)
     (InterpretC
        WriterTVarH
        (Tell s)
        (InterpretC
           WriterTVarH
           (ListenPrim s)
           (InterpretPrimC
              WriterTVarH (WriterPrim s) (ReaderC (s -> STM ()) m)))))
  a
-> InterpretC
     WriterTVarH
     (Listen s)
     (InterpretC
        WriterTVarH
        (Tell s)
        (InterpretC
           WriterTVarH
           (ListenPrim s)
           (InterpretPrimC
              WriterTVarH (WriterPrim s) (ReaderC (s -> STM ()) m))))
     a
forall h (e :: Effect) (m :: * -> *) a.
Handler h e m =>
InterpretC h e m a -> m a
interpretViaHandler
  (InterpretC
   WriterTVarH
   (Pass s)
   (InterpretC
      WriterTVarH
      (Listen s)
      (InterpretC
         WriterTVarH
         (Tell s)
         (InterpretC
            WriterTVarH
            (ListenPrim s)
            (InterpretPrimC
               WriterTVarH (WriterPrim s) (ReaderC (s -> STM ()) m)))))
   a
 -> m a)
-> (IntroUnderManyC
      '[Pass s, Listen s, Tell s]
      '[ListenPrim s, WriterPrim s, Local (s -> STM ()),
        Ask (s -> STM ())]
      (InterpretC
         WriterTVarH
         (Pass s)
         (InterpretC
            WriterTVarH
            (Listen s)
            (InterpretC
               WriterTVarH
               (Tell s)
               (InterpretC
                  WriterTVarH
                  (ListenPrim s)
                  (InterpretPrimC
                     WriterTVarH (WriterPrim s) (ReaderC (s -> STM ()) m))))))
      a
    -> InterpretC
         WriterTVarH
         (Pass s)
         (InterpretC
            WriterTVarH
            (Listen s)
            (InterpretC
               WriterTVarH
               (Tell s)
               (InterpretC
                  WriterTVarH
                  (ListenPrim s)
                  (InterpretPrimC
                     WriterTVarH (WriterPrim s) (ReaderC (s -> STM ()) m)))))
         a)
-> IntroUnderManyC
     '[Pass s, Listen s, Tell s]
     '[ListenPrim s, WriterPrim s, Local (s -> STM ()),
       Ask (s -> STM ())]
     (InterpretC
        WriterTVarH
        (Pass s)
        (InterpretC
           WriterTVarH
           (Listen s)
           (InterpretC
              WriterTVarH
              (Tell s)
              (InterpretC
                 WriterTVarH
                 (ListenPrim s)
                 (InterpretPrimC
                    WriterTVarH (WriterPrim s) (ReaderC (s -> STM ()) m))))))
     a
-> m a
forall b a c. Coercible b a => (b -> c) -> (a -> b) -> a -> c
.# IntroUnderManyC
  '[Pass s, Listen s, Tell s]
  '[ListenPrim s, WriterPrim s, Local (s -> STM ()),
    Ask (s -> STM ())]
  (InterpretC
     WriterTVarH
     (Pass s)
     (InterpretC
        WriterTVarH
        (Listen s)
        (InterpretC
           WriterTVarH
           (Tell s)
           (InterpretC
              WriterTVarH
              (ListenPrim s)
              (InterpretPrimC
                 WriterTVarH (WriterPrim s) (ReaderC (s -> STM ()) m))))))
  a
-> InterpretC
     WriterTVarH
     (Pass s)
     (InterpretC
        WriterTVarH
        (Listen s)
        (InterpretC
           WriterTVarH
           (Tell s)
           (InterpretC
              WriterTVarH
              (ListenPrim s)
              (InterpretPrimC
                 WriterTVarH (WriterPrim s) (ReaderC (s -> STM ()) m)))))
     a
forall (top :: [Effect]) (new :: [Effect]) (m :: * -> *) a.
(KnownList top, KnownList new, IntroConsistent top new m) =>
IntroUnderManyC top new m a -> m a
introUnderMany
  (IntroUnderManyC
   '[Pass s, Listen s, Tell s]
   '[ListenPrim s, WriterPrim s, Local (s -> STM ()),
     Ask (s -> STM ())]
   (InterpretC
      WriterTVarH
      (Pass s)
      (InterpretC
         WriterTVarH
         (Listen s)
         (InterpretC
            WriterTVarH
            (Tell s)
            (InterpretC
               WriterTVarH
               (ListenPrim s)
               (InterpretPrimC
                  WriterTVarH (WriterPrim s) (ReaderC (s -> STM ()) m))))))
   a
 -> m a)
-> (WriterTVarC s m a
    -> IntroUnderManyC
         '[Pass s, Listen s, Tell s]
         '[ListenPrim s, WriterPrim s, Local (s -> STM ()),
           Ask (s -> STM ())]
         (InterpretC
            WriterTVarH
            (Pass s)
            (InterpretC
               WriterTVarH
               (Listen s)
               (InterpretC
                  WriterTVarH
                  (Tell s)
                  (InterpretC
                     WriterTVarH
                     (ListenPrim s)
                     (InterpretPrimC
                        WriterTVarH (WriterPrim s) (ReaderC (s -> STM ()) m))))))
         a)
-> WriterTVarC s m a
-> m a
forall b a c. Coercible b a => (b -> c) -> (a -> b) -> a -> c
.# WriterTVarC s m a
-> IntroUnderManyC
     '[Pass s, Listen s, Tell s]
     '[ListenPrim s, WriterPrim s, Local (s -> STM ()),
       Ask (s -> STM ())]
     (InterpretC
        WriterTVarH
        (Pass s)
        (InterpretC
           WriterTVarH
           (Listen s)
           (InterpretC
              WriterTVarH
              (Tell s)
              (InterpretC
                 WriterTVarH
                 (ListenPrim s)
                 (InterpretPrimC
                    WriterTVarH (WriterPrim s) (ReaderC (s -> STM ()) m))))))
     a
forall (ts :: [Effect]) (m :: * -> *) a.
CompositionC ts m a -> CompositionBaseM ts m a
runComposition
{-# INLINE runWriterTVar #-}