content: {-# LANGUAGE AllowAmbiguousTypes #-}
  
  -- | Description: The 'Bundle' effect for bundling effects
  module Polysemy.Bundle
    ( -- * Effect
      Bundle (..)
      -- * Actions
    , sendBundle
    , injBundle
      -- * Interpretations
    , runBundle
    , subsumeBundle
      -- * Miscellaneous
    ) where
  
  import Polysemy
  import Polysemy.Internal
  import Polysemy.Internal.Union
  import Polysemy.Internal.Bundle (subsumeMembership)
  import Polysemy.Internal.Sing (KnownList (singList))
  
  ------------------------------------------------------------------------------
  -- | An effect for collecting multiple effects into one effect.
  --
  -- Useful for effect newtypes -- effects defined through creating a newtype
  -- over an existing effect, and then defining actions and interpretations on
  -- the newtype by using 'rewrite' and 'transform'.
  --
  -- By making a newtype of 'Bundle', it's possible to wrap multiple effects in
  -- one newtype.
  data Bundle r m a where
    Bundle :: ElemOf e r -> e m a -> Bundle r m a
  
  ------------------------------------------------------------------------------
  -- | Injects an effect into a 'Bundle'. Useful together with 'transform'.
  injBundle :: forall e r m a. Member e r => e m a -> Bundle r m a
  injBundle = Bundle membership
  {-# INLINE injBundle #-}
  
  ------------------------------------------------------------------------------
  -- | Send uses of an effect to a 'Bundle' containing that effect.
  sendBundle
    :: forall e r' r a
     . (Member e r', Member (Bundle r') r)
    => Sem (e ': r) a
    -> Sem r a
  sendBundle = hoistSem $ \u -> case decomp u of
    Right (Weaving e s wv ex ins) ->
      injWeaving $
        Weaving (Bundle (membership @e @r') e) s (sendBundle @e @r' . wv) ex ins
    Left g -> hoist (sendBundle @e @r') g
  {-# INLINE sendBundle #-}
  
  ------------------------------------------------------------------------------
  -- | Run a @'Bundle' r@ by prepending @r@ to the effect stack.
  runBundle
    :: forall r' r a
     . KnownList r'
    => Sem (Bundle r' ': r) a
    -> Sem (Append r' r) a
  runBundle = hoistSem $ \u -> hoist runBundle $ case decomp u of
    Right (Weaving (Bundle pr e) s wv ex ins) ->
      Union (extendMembershipRight @r' @r pr) $ Weaving e s wv ex ins
    Left g -> weakenList @r' @r (singList @r') g
  {-# INLINE runBundle #-}
  
  ------------------------------------------------------------------------------
  -- | Run a @'Bundle' r@ if the effect stack contains all effects of @r@.
  subsumeBundle
    :: forall r' r a
     . Members r' r
    => Sem (Bundle r' ': r) a
    -> Sem r a
  subsumeBundle = hoistSem $ \u -> hoist subsumeBundle $ case decomp u of
    Right (Weaving (Bundle pr e) s wv ex ins) ->
      Union (subsumeMembership pr) (Weaving e s wv ex ins)
    Left g -> g
  {-# INLINE subsumeBundle #-}
  