{-# LANGUAGE ImpredicativeTypes #-}
{-# OPTIONS_GHC -Wno-orphans #-}
{-# OPTIONS_GHC -Wno-simplifiable-class-constraints #-}

-- | Import and use with `OverloadedLabels` to use labels as name for (generic)
-- constructor leads. That is @#MkT@ instead of 'lead' @@\"MkT\"@.
--
-- Because of the very generic type of the 'IsLabel' instance, importing this
-- module isn't unlikely to interfere with other uses of `OverloadedLabels`.
-- This is why it's defined in a separate module from
-- "Control.Monad.Indexed.Cont2.Lead.Generic".
module Control.Monad.Indexed.Cont2.Lead.Labels () where

import Control.Monad.Indexed qualified as Indexed
import Control.Monad.Indexed.Cont2 qualified as Cont2
import Control.Monad.Indexed.Cont2.Lead.Generic
import GHC.Generics
import GHC.OverloadedLabels

instance
  ( Leading c t,
    Indexed.MonadPlus m,
    Cont2.Stacked m,
    s ~ (CFieldsType c (Rep t ()) r),
    u ~ (CFieldsType c (Rep t ()) t)
  ) =>
  IsLabel c (m (t -> r) s u)
  where
  fromLabel :: m (t -> r) s u
fromLabel = forall (c :: Symbol) t r (m :: * -> * -> * -> *).
(Leading c t, MonadPlus m, Stacked m) =>
m (t -> r)
  (CFieldsType c (Rep t ()) r)
  (CFieldsType c (Rep t ()) t)
lead @c @t @r @m