content: {-# LANGUAGE AllowAmbiguousTypes  #-}
  {-# LANGUAGE ConstraintKinds      #-}
  {-# LANGUAGE TemplateHaskell      #-}
  {-# LANGUAGE TypeFamilies         #-}
  {-# LANGUAGE UndecidableInstances #-}
  
  {-# OPTIONS_HADDOCK not-home, prune #-}
  
  -- | Description: type-errors-pretty redefinitions
  module Polysemy.Internal.CustomErrors
    ( WhenStuck
    , FirstOrder
    , type (<>)
    , type (%)
    ) where
  
  import Data.Kind
  import Fcf
  import GHC.TypeLits (Symbol)
  import Type.Errors hiding (IfStuck, UnlessStuck, WhenStuck)
  
  import Polysemy.Internal.CustomErrors.Redefined
  import Polysemy.Internal.Kind
  
  
  -- These are taken from type-errors-pretty because it's not in stackage for 9.0.1
  -- See https://github.com/polysemy-research/polysemy/issues/401
  type family ToErrorMessage (t :: k) :: ErrorMessage where
      ToErrorMessage (t :: Symbol) = 'Text t
      ToErrorMessage (t :: ErrorMessage) = t
      ToErrorMessage t = 'ShowType t
  
  infixl 5 <>
  type family (<>) (l :: k1) (r :: k2) :: ErrorMessage where
      l <> r = ToErrorMessage l ':<>: ToErrorMessage r
  
  infixr 4 %
  type family (%) (t :: k1) (b :: k2) :: ErrorMessage where
      t % b = ToErrorMessage t ':$$: ToErrorMessage b
  
  data FirstOrderErrorFcf :: k -> Symbol -> Exp Constraint
  type instance Eval (FirstOrderErrorFcf e fn) = $(te[t|
      UnlessPhantom
          (e PHANTOM)
          ( "'" <> e <> "' is higher-order, but '" <> fn <> "' can help only"
          % "with first-order effects."
          % "Fix:"
          % "  use '" <> fn <> "H' instead."
          ) |])
  
  ------------------------------------------------------------------------------
  -- | This constraint gives helpful error messages if you attempt to use a
  -- first-order combinator with a higher-order type.
  type FirstOrder (e :: Effect) fn = UnlessStuck e (FirstOrderErrorFcf e fn)
  
  
  data DoError :: ErrorMessage -> Exp k
  type instance Eval (DoError a) = TypeError a
  