content: {-# LANGUAGE BangPatterns, TemplateHaskell #-}
  
  -- | Description: The 'Output' effect for sending side-effecting messages
  module Polysemy.Output
    ( -- * Effect
      Output (..)
  
      -- * Actions
    , output
  
      -- * Interpretations
    , runOutputList
    , runLazyOutputList
    , runOutputMonoid
    , runLazyOutputMonoid
    , runOutputMonoidAssocR
    , runLazyOutputMonoidAssocR
    , runOutputMonoidIORef
    , runOutputMonoidTVar
    , outputToIOMonoid
    , outputToIOMonoidAssocR
    , ignoreOutput
    , runOutputBatched
    , runOutputSem
    ) where
  
  import Data.IORef
  import Control.Concurrent.STM
  import qualified Control.Monad.Trans.Writer.Lazy as Lazy
  
  import Data.Semigroup (Endo(..))
  import Data.Bifunctor (first)
  import Polysemy
  import Polysemy.State
  import Control.Monad (when)
  
  import Polysemy.Internal.Union
  import Polysemy.Internal.Writer
  
  
  ------------------------------------------------------------------------------
  -- | An effect capable of sending messages. Useful for streaming output and for
  -- logging.
  data Output o m a where
    -- | Output a message.
    Output :: o -> Output o m ()
  
  makeSem ''Output
  
  
  ------------------------------------------------------------------------------
  -- | Run an 'Output' effect by transforming it into a list of its values.
  --
  -- @since 1.0.0.0
  runOutputList
      :: forall o r a
       . Sem (Output o ': r) a
      -> Sem r ([o], a)
  runOutputList = fmap (first reverse) . runState [] . reinterpret
    (\case
        Output o -> modify' (o :)
    )
  {-# INLINE runOutputList #-}
  
  
  ------------------------------------------------------------------------------
  -- | Run an 'Output' effect by transforming it into a list of its values,
  -- lazily.
  --
  -- __Warning: This inherits the nasty space leak issue of__
  -- __'Lazy.WriterT'! Don't use this if you don't have to.__
  --
  -- @since 1.3.0.0
  runLazyOutputList
      :: forall o r a
       . Sem (Output o ': r) a
      -> Sem r ([o], a)
  runLazyOutputList = runLazyOutputMonoidAssocR pure
  {-# INLINE runLazyOutputList #-}
  
  ------------------------------------------------------------------------------
  -- | Run an 'Output' effect by transforming it into a monoid.
  --
  -- @since 1.0.0.0
  runOutputMonoid
      :: forall o m r a
       . Monoid m
      => (o -> m)
      -> Sem (Output o ': r) a
      -> Sem r (m, a)
  runOutputMonoid f = runState mempty . reinterpret
    (\case
        Output o -> modify' (`mappend` f o)
    )
  {-# INLINE runOutputMonoid #-}
  
  
  ------------------------------------------------------------------------------
  -- | Run an 'Output' effect by transforming it into a monoid, and accumulate
  -- it lazily.
  --
  -- __Warning: This inherits the nasty space leak issue of__
  -- __'Lazy.WriterT'! Don't use this if you don't have to.__
  --
  -- @since 1.3.0.0
  runLazyOutputMonoid
      :: forall o m r a
       . Monoid m
      => (o -> m)
      -> Sem (Output o ': r) a
      -> Sem r (m, a)
  runLazyOutputMonoid f = interpretViaLazyWriter $ \(Weaving e s _ ex _) ->
    case e of
      Output o -> ex s <$ Lazy.tell (f o)
  
  ------------------------------------------------------------------------------
  -- | Like 'runOutputMonoid', but right-associates uses of '<>'.
  --
  -- This asymptotically improves performance if the time complexity of '<>' for
  -- the 'Monoid' depends only on the size of the first argument.
  --
  -- You should always use this instead of 'runOutputMonoid' if the monoid
  -- is a list, such as 'String'.
  --
  -- @since 1.1.0.0
  runOutputMonoidAssocR
      :: forall o m r a
       . Monoid m
      => (o -> m)
      -> Sem (Output o ': r) a
      -> Sem r (m, a)
  runOutputMonoidAssocR f =
      fmap (first (`appEndo` mempty))
    . runOutputMonoid (\o -> let !o' = f o in Endo (o' <>))
  {-# INLINE runOutputMonoidAssocR #-}
  
  ------------------------------------------------------------------------------
  -- | Like 'runLazyOutputMonoid', but right-associates uses of '<>'.
  --
  -- This asymptotically improves performance if the time complexity of '<>' for
  -- the 'Monoid' depends only on the size of the first argument.
  --
  -- You should always use this instead of 'runLazyOutputMonoid' if the monoid
  -- is a list, such as 'String'.
  --
  -- __Warning: This inherits the nasty space leak issue of__
  -- __'Lazy.WriterT'! Don't use this if you don't have to.__
  --
  -- @since 1.3.0.0
  runLazyOutputMonoidAssocR
      :: forall o m r a
       . Monoid m
      => (o -> m)
      -> Sem (Output o ': r) a
      -> Sem r (m, a)
  runLazyOutputMonoidAssocR f =
      fmap (first (`appEndo` mempty))
    . runLazyOutputMonoid (\o -> let o' = f o in Endo (o' <>))
                                --   ^ N.B. No bang pattern
  {-# INLINE runLazyOutputMonoidAssocR #-}
  
  ------------------------------------------------------------------------------
  -- | Run an 'Output' effect by transforming it into atomic operations
  -- over an 'IORef'.
  --
  -- @since 1.1.0.0
  runOutputMonoidIORef
      :: forall o m r a
       . (Monoid m, Member (Embed IO) r)
      => IORef m
      -> (o -> m)
      -> Sem (Output o ': r) a
      -> Sem r a
  runOutputMonoidIORef ref f = interpret $ \case
    Output o -> embed $ atomicModifyIORef' ref (\s -> let !o' = f o in (s <> o', ()))
  {-# INLINE runOutputMonoidIORef #-}
  
  ------------------------------------------------------------------------------
  -- | Run an 'Output' effect by transforming it into atomic operations
  -- over a 'TVar'.
  --
  -- @since 1.1.0.0
  runOutputMonoidTVar
      :: forall o m r a
       . (Monoid m, Member (Embed IO) r)
      => TVar m
      -> (o -> m)
      -> Sem (Output o ': r) a
      -> Sem r a
  runOutputMonoidTVar tvar f = interpret $ \case
    Output o -> embed $ atomically $ do
      s <- readTVar tvar
      writeTVar tvar $! s <> f o
  {-# INLINE runOutputMonoidTVar #-}
  
  
  --------------------------------------------------------------------
  -- | Run an 'Output' effect in terms of atomic operations
  -- in 'IO'.
  --
  -- Internally, this simply creates a new 'IORef', passes it to
  -- 'runOutputMonoidIORef', and then returns the result and the final value
  -- of the 'IORef'.
  --
  -- /Beware/: As this uses an 'IORef' internally,
  -- all other effects will have local
  -- state semantics in regards to 'Output' effects
  -- interpreted this way.
  -- For example, 'Polysemy.Error.throw' and 'Polysemy.Error.catch' will
  -- never revert 'output's, even if 'Polysemy.Error.runError' is used
  -- after 'outputToIOMonoid'.
  --
  -- @since 1.2.0.0
  outputToIOMonoid
    :: forall o m r a
     . (Monoid m, Member (Embed IO) r)
    => (o -> m)
    -> Sem (Output o ': r) a
    -> Sem r (m, a)
  outputToIOMonoid f sem = do
    ref <- embed $ newIORef mempty
    res <- runOutputMonoidIORef ref f sem
    end <- embed $ readIORef ref
    return (end, res)
  
  ------------------------------------------------------------------------------
  -- | Like 'outputToIOMonoid', but right-associates uses of '<>'.
  --
  -- This asymptotically improves performance if the time complexity of '<>' for
  -- the 'Monoid' depends only on the size of the first argument.
  --
  -- You should always use this instead of 'outputToIOMonoid' if the monoid
  -- is a list, such as 'String'.
  --
  -- /Beware/: As this uses an 'IORef' internally,
  -- all other effects will have local
  -- state semantics in regards to 'Output' effects
  -- interpreted this way.
  -- For example, 'Polysemy.Error.throw' and 'Polysemy.Error.catch' will
  -- never revert 'output's, even if 'Polysemy.Error.runError' is used
  -- after 'outputToIOMonoidAssocR'.
  --
  -- @since 1.2.0.0
  outputToIOMonoidAssocR
    :: forall o m r a
     . (Monoid m, Member (Embed IO) r)
    => (o -> m)
    -> Sem (Output o ': r) a
    -> Sem r (m, a)
  outputToIOMonoidAssocR f =
      (fmap . first) (`appEndo` mempty)
    . outputToIOMonoid (\o -> let !o' = f o in Endo (o' <>))
  
  ------------------------------------------------------------------------------
  -- | Run an 'Output' effect by ignoring it.
  --
  -- @since 1.0.0.0
  ignoreOutput :: Sem (Output o ': r) a -> Sem r a
  ignoreOutput = interpret $ \case
    Output _ -> pure ()
  {-# INLINE ignoreOutput #-}
  
  
  ------------------------------------------------------------------------------
  -- | Accumulate 'output's so they are delayed until they reach at least size
  -- @size@.
  --
  -- If @size@ is 0, this interpretation will not emit anything in the resulting
  -- 'Output' effect.
  --
  -- @since 1.0.0.0
  runOutputBatched
      :: forall o r a
       . Member (Output [o]) r
      => Int
      -> Sem (Output o ': r) a
      -> Sem r a
  runOutputBatched 0 m = ignoreOutput m
  runOutputBatched size m = do
    ((c, res), a) <-
      runState (0 :: Int, [] :: [o]) $ reinterpret (\case
        Output o -> do
          (count, acc) <- get
          let newCount = 1 + count
              newAcc = o : acc
          if newCount < size
            then put (newCount, newAcc)
            else do
              output (reverse newAcc)
              put (0 :: Int, [] :: [o])
      ) m
    when (c > 0) $ output @[o] (reverse res)
    pure a
  
  ------------------------------------------------------------------------------
  -- | Runs an 'Output' effect by running a monadic action for each of its
  -- values.
  runOutputSem :: (o -> Sem r ()) -> Sem (Output o ': r) a -> Sem r a
  runOutputSem act = interpret $ \case
      Output o -> act o
  {-# INLINE runOutputSem #-}
  