content: {-# OPTIONS_HADDOCK not-home #-}
  module Control.Effect.Type.Split where
  
  import Control.Effect.Internal.Union
  import Control.Monad.Trans
  import Control.Monad.Trans.Reader
  import qualified Control.Monad.Trans.State.Lazy    as LSt
  import qualified Control.Monad.Trans.State.Strict  as SSt
  import qualified Control.Monad.Trans.Writer.Lazy   as LWr
  import qualified Control.Monad.Trans.Writer.Strict as SWr
  import qualified Control.Monad.Trans.Writer.CPS    as CPSWr
  
  -- | An effect for splitting a nondeterministic computation
  -- into its head and tail.
  --
  -- __'Split' is typically used as a primitive effect.__
  -- If you define a 'Control.Effect.Carrier' that relies on a novel
  -- non-trivial monad transformer, then you need to make
  -- a @'ThreadsEff'@ instance for that monad transformer
  -- to lift 'Split' (if possible).
  --
  -- The following threading constraints accept 'Split':
  --
  -- * 'Control.Effect.ReaderThreads'
  -- * 'Control.Effect.State.StateThreads'
  -- * 'Control.Effect.State.StateLazyThreads'
  -- * 'Control.Effect.Writer.WriterThreads'
  -- * 'Control.Effect.Writer.WriterLazyThreads'
  data Split :: Effect where
    Split :: (Maybe (a, m a) -> b) -> m a -> Split m b
  
  instance ThreadsEff (ReaderT s) Split where
    threadEff alg (Split c m) = ReaderT $ \s ->
      alg $ Split (c . (fmap . fmap) lift) (runReaderT m s)
    {-# INLINE threadEff #-}
  
  instance ThreadsEff (LSt.StateT s) Split where
    threadEff alg (Split c m) = LSt.StateT $ \s ->
      alg $
        Split
          (maybe
            (c Nothing, s)
            (\ ~( ~(a, s'), m') ->
               (c $ Just (a, LSt.StateT $ \_ -> m'), s')
            )
          )
          (LSt.runStateT m s)
    {-# INLINE threadEff #-}
  
  instance ThreadsEff (SSt.StateT s) Split where
    threadEff alg (Split c m) = SSt.StateT $ \s ->
      alg $
        Split
          (maybe
            (c Nothing, s)
            (\((a, s'), m') ->
               (c $ Just (a, SSt.StateT $ \_ -> m'), s')
            )
          )
          (SSt.runStateT m s)
    {-# INLINE threadEff #-}
  
  instance Monoid s => ThreadsEff (LWr.WriterT s) Split where
    threadEff alg (Split c m) = LWr.WriterT $
      alg $
        Split
          (maybe
            (c Nothing, mempty)
            (\ ~( ~(a, s'), m') ->
               (c $ Just (a, LWr.WriterT m'), s')
            )
          )
          (LWr.runWriterT m)
    {-# INLINE threadEff #-}
  
  instance Monoid s => ThreadsEff (SWr.WriterT s) Split where
    threadEff alg (Split c m) = SWr.WriterT $
      alg $
        Split
          (maybe
            (c Nothing, mempty)
            (\((a, s'), m') ->
               (c $ Just (a, SWr.WriterT m'), s')
            )
          )
          (SWr.runWriterT m)
    {-# INLINE threadEff #-}
  
  instance Monoid s => ThreadsEff (CPSWr.WriterT s) Split where
    threadEff alg (Split c m) = CPSWr.writerT $
      alg $
        Split
          (maybe
            (c Nothing, mempty)
            (\((a, s'), m') ->
               (c $ Just (a, CPSWr.writerT m'), s')
            )
          )
          (CPSWr.runWriterT m)
    {-# INLINE threadEff #-}
  