content: {-# LANGUAGE TypeFamilies #-}
  {-# OPTIONS_HADDOCK show-extensions #-}
  
  -- |
  -- Module      :  Language.Spectacle.Lang.Member
  -- Copyright   :  (c) Arista Networks, 2022-2023
  -- License     :  Apache License 2.0, see LICENSE
  --
  -- Stability   :  stable
  -- Portability :  non-portable (GHC extensions)
  --
  -- Effect membership.
  --
  -- @since 1.0.0
  module Language.Spectacle.Lang.Member
    ( Members,
      Member (inject, project, injectS, projectS),
    )
  where
  
  import Data.Kind (Constraint)
  
  import Language.Spectacle.Lang.Op (Op (OHere, OThere))
  import Language.Spectacle.Lang.Scoped (Effect, EffectK, Scoped (SHere, SThere))
  
  -- -------------------------------------------------------------------------------------------------
  
  -- | N-ary, infix operator for 'Member'.
  --
  -- * @Members '[A, B, C] effs = (Member A effs, Member B effs, Member C effs)@
  -- * @Members A effs = Members '[A] effs = Member A effs@
  --
  -- @since 1.0.0
  type Members :: forall k. k -> [EffectK] -> Constraint
  type family Members eff effs where
  -- Type ascription is used here rather than a type application to the LHS of the equations since
  -- fourmolu does not know how to parse type applications at the type level yet.
  --
  -- https://github.com/tweag/ormolu/issues/698
    Members (eff :: EffectK) effs = Member eff effs
    Members (eff ': effs' :: [EffectK]) effs = (Member eff effs, Members effs' effs)
    Members ('[] :: [EffectK]) effs = ()
  
  -- | An effect @eff@ is a member of the effect signature @effs@ if @eff@ occurs in @effs@.
  --
  -- @since 1.0.0
  type Member :: EffectK -> [EffectK] -> Constraint
  class Member eff effs where
    -- | Inject a first order effect @eff a@ into a sum of first-order effects 'Op'. Higher-order
    -- operations must be injected with 'injectS'.
    --
    -- @since 1.0.0
    inject :: eff a -> Op effs a
  
    -- | Projects the effect @eff@ from the given 'Op' if it is the inhabitant, otherwise 'Nothing'.
    --
    -- @since 1.0.0
    project :: Op effs a -> Maybe (eff a)
  
    -- | Like 'inject', but specifically for scoped operations.
    --
    -- @since 1.0.0
    injectS :: Effect eff m a -> Scoped effs m a
  
    -- | Like 'project', but specifically for scoped operations.
    --
    -- @since 1.0.0
    projectS :: Scoped effs m a -> Maybe (Effect eff m a)
  
  -- | @since 1.0.0
  instance {-# OVERLAPS #-} Member eff (eff ': effs) where
    inject = OHere
    {-# INLINE CONLIKE inject #-}
  
    project (OHere op) = Just op
    -- We only have to scrutinize this case because there is technically nothing preventing an effect
    -- signature from having two of the same effect in the list; however, the only way to make that
    -- happen is to instantiate Lang with a monomorphic list containing duplicates. Nubbing effect
    -- signatures isn't worth it in any case since running handlers is idempotent so this case can
    -- just be thrown out.
    project (OThere _) = Nothing
    {-# INLINE CONLIKE project #-}
  
    injectS = SHere
    {-# INLINE CONLIKE injectS #-}
  
    projectS (SHere s) = Just s
    projectS (SThere _) = Nothing
    {-# INLINE CONLIKE projectS #-}
  
  -- | @since 1.0.0
  instance Member eff effs => Member eff (eff' ': effs) where
    inject = OThere . inject
    {-# INLINE CONLIKE inject #-}
  
    project (OThere op) = project op
    project _ = Nothing
    {-# INLINE CONLIKE project #-}
  
    injectS = SThere . injectS
    {-# INLINE CONLIKE injectS #-}
  
    projectS (SThere scoped) = projectS scoped
    projectS _ = Nothing
    {-# INLINE CONLIKE projectS #-}
  