content: {-# LANGUAGE EmptyCase #-}
  {-# OPTIONS_HADDOCK not-home #-}
  module Control.Effect.Internal.Membership where
  
  import GHC.TypeLits
  import Data.Type.Equality
  
  data ElemOf (e :: a) (r :: [a]) where
    Here  :: ElemOf e (e ': r)
    There :: ElemOf e r -> ElemOf e (_e ': r)
  
  absurdMember :: ElemOf e '[] -> b
  absurdMember = \case
  {-# INLINE absurdMember #-}
  
  deriving instance Show (ElemOf e r)
  
  sameMember :: forall e e' r
              . ElemOf e r
             -> ElemOf e' r
             -> Maybe (e :~: e')
  sameMember Here Here = Just Refl
  sameMember (There pr) (There pr') = sameMember pr pr'
  sameMember _ _ = Nothing
  
  -- | A constraint that @e@ is part of the effect row @r@.
  --
  -- @r@ is typically @'Control.Effect.Derivs' m@ for some @m@.
  -- @Member e ('Control.Effect.Derivs' m)@ allows you to use
  -- actions of @e@ with @m@.
  --
  -- If @e@ occurs multiple times in @r@, then the first
  -- occurence will be used.
  --
  -- If possible, use @'Control.Effect.Eff'/s@ instead.
  class Member e r where
    membership :: ElemOf e r
  
  instance {-# OVERLAPPING #-} Member e (e ': r) where
    membership = Here
    {-# INLINE membership #-}
  
  instance Member e r => Member e (_e ': r) where
    membership = There membership
    {-# INLINEABLE membership #-}
  
  instance TypeError (     'Text "Unhandled effect: " ':<>: 'ShowType e
                     ':$$: 'Text "You need to either add or replace an \
                                 \interpreter in your interpretation stack \
                                 \so that the effect gets handled."
                     ':$$: 'Text "To check what effects are currently \
                                 \handled by your interpretation stack, use \
                                 \`debugEffects' from `Control.Effect.Debug'."
                     )
                  => Member e '[] where
    membership = error "impossible"
  