content: {-# LANGUAGE DerivingVia #-}
  module Control.Effect.Regional
    ( -- * Effects
      Regional(..)
    , Hoist
  
      -- * Actions
    , regionally
    , hoist
  
      -- * Interpretations
    , runHoist
  
    , hoistToFinal
  
      -- * Threading utilities
    , threadRegionalViaOptional
  
      -- * Combinators for 'Algebra's
      -- Intended to be used for custom 'Carrier' instances when
      -- defining 'algPrims'.
    , powerAlgHoist
    , powerAlgHoistFinal
  
      -- * Carriers
    , HoistC
    , HoistToFinalC
    ) where
  
  import Control.Effect
  import Control.Effect.Carrier
  
  import Control.Effect.Type.Regional
  import Control.Effect.Type.Optional
  import Control.Effect.Internal.Regional
  
  import Control.Monad.Trans.Control (control)
  
  -- | Execute a computation modified in some way, providing
  -- the interpreter of @'Regional' s@ a constant to indicate
  -- how the computation should be modified.
  regionally :: Eff (Regional s) m => s -> m a -> m a
  regionally s m = send (Regionally s m)
  {-# INLINE regionally #-}
  
  -- | Lift a natural transformation of a base monad to the
  -- current monad.
  hoist :: Eff (Hoist b) m => (forall x. b x -> b x) -> m a -> m a
  hoist n = regionally (HoistCall n)
  {-# INLINE hoist #-}
  
  type HoistToFinalC b = InterpretPrimC HoistToFinalH (Hoist b)
  
  -- | Run a @'Hoist' m@ effect, where the base monad @m@ is the current monad.
  --
  -- @'Derivs' ('HoistC' m) = 'Hoist' m ': 'Derivs' m@
  --
  -- @'Prims'  ('HoistC' m) = 'Hoist' m ': 'Prims' m@
  runHoist :: Carrier m
           => HoistC m a
           -> m a
  runHoist = unHoistC
  {-# INLINE runHoist #-}
  
  -- | Run a @'Hoist' b@ effect, where the base monad @b@ is the final base monad.
  --
  -- @'Derivs' ('HoistToFinalC' b m) = 'Hoist' b ': 'Derivs' m@
  --
  -- @'Prims'  ('HoistToFinalC' b m) = 'Hoist' b ': 'Prims' m@
  hoistToFinal :: ( MonadBaseControl b m
                  , Carrier m
                  )
               => HoistToFinalC b m a
               -> m a
  hoistToFinal = interpretPrimViaHandler
  {-# INLINE hoistToFinal #-}
  
  -- | Strengthen an @'Algebra' p m@ by adding a @'Hoist' m@ handler
  powerAlgHoist :: forall m p a
                 . Algebra' p m a
                -> Algebra' (Hoist m ': p) m a
  powerAlgHoist alg = powerAlg alg $ \(Regionally (HoistCall n) m) -> n m
  {-# INLINE powerAlgHoist #-}
  
  -- | Strengthen an @'Algebra' p m@ by adding a @'Hoist' b@ handler, where
  -- @b@ is the final base monad.
  powerAlgHoistFinal :: forall b m p a
                      . MonadBaseControl b m
                     => Algebra' p m a
                     -> Algebra' (Hoist b ': p) m a
  powerAlgHoistFinal alg = powerAlg alg $ \case
    Regionally (HoistCall n) m -> control $ \lower -> n (lower m)
  {-# INLINE powerAlgHoistFinal #-}
  