content: {-# LANGUAGE DerivingVia #-}
  {-# OPTIONS_HADDOCK not-home #-}
  module Control.Effect.Internal.Regional where
  
  import Control.Effect
  import Control.Effect.Carrier
  
  import Control.Effect.Type.Regional
  
  import Control.Effect.Carrier.Internal.Interpret
  
  import Control.Monad.Trans.Control
  
  import Data.Kind (Type)
  
  newtype HoistCall b = HoistCall (forall x. b x -> b x)
  
  -- | A useful specialization of 'Regional' where the
  -- constant type is @'HoistCall' b@. From this,
  -- you can derive 'Control.Effect.Regional.hoist'.
  type Hoist (b :: Type -> Type) = Regional (HoistCall b)
  
  data HoistH
  
  instance Carrier m => PrimHandler HoistH (Hoist m) m where
    effPrimHandler (Regionally (HoistCall b) m) = b m
    {-# INLINEABLE effPrimHandler #-}
  
  data HoistToFinalH
  
  newtype HoistC m a = HoistC {
      unHoistC :: m a
    }
    deriving ( Functor, Applicative, Monad
             , Alternative, MonadPlus
             , MonadFix, MonadFail, MonadIO
             , MonadThrow, MonadCatch, MonadMask
             )
    deriving (MonadTrans, MonadTransControl) via IdentityT
  
  deriving via InterpretPrimC HoistH (Hoist m) m
      instance Carrier m => Carrier (HoistC m)
  
  instance ( Carrier m
           , MonadBaseControl b m
           )
        => PrimHandler HoistToFinalH (Hoist b) m where
    effPrimHandler (Regionally (HoistCall b) m) = control $ \lower -> b (lower m)
    {-# INLINEABLE effPrimHandler #-}
  