content: {-# LANGUAGE AllowAmbiguousTypes #-}
  {-# OPTIONS_HADDOCK not-home #-}
  -- |
  -- Copyright: (c) 2021 Xy Ren
  -- License: BSD3
  -- Maintainer: xy.r@outlook.com
  -- Stability: unstable
  -- Portability: non-portable (GHC only)
  --
  -- Operations on the effect environment type 'Env'. These operations are more flexible than the public API; you may
  -- want to use these in conjunction with the effect stack manipulation operations in "Cleff.Internal.Stack".
  --
  -- __This is an /internal/ module and its API may change even between minor versions.__ Therefore you should be
  -- extra careful if you're to depend on this module.
  module Cleff.Internal.Env
    ( Env
    , Handling
    , Handler
    , esSend
    , empty
    , read
    , adjust
    , overwriteLocal
    , overwriteGlobal
    , overwriteSelfGlobal
    , extend
    , update
    ) where
  
  import           Cleff.Internal.Monad
  import           Cleff.Internal.Stack (Stack)
  import qualified Cleff.Internal.Stack as Stack
  import           Data.Any             (fromAny, pattern Any)
  import qualified Data.RadixVec        as Vec
  import           Prelude              hiding (read)
  import           Unsafe.Coerce        (unsafeCoerce)
  
  -- | The internal representation of effect handlers. This is just a natural transformation from the effect type
  -- @e ('Eff' es)@ to the effect monad @'Eff' es@ for any effect stack @es@.
  --
  -- In interpreting functions (see "Cleff.Internal.Interpret"), the user-facing 'Cleff.Handler' type is transformed into
  -- this type.
  newtype InternalHandler e = InternalHandler (∀ es. e (Eff es) ~> Eff es)
  
  -- | The send-site environment.
  data SendSite esSend e = SendSite
    {-# UNPACK #-} !(Env esSend) -- ^ The send-site 'Env'.
    {-# UNPACK #-} !(HandlerPtr e) -- ^ The pointer to the current effect handler.
  
  -- | The typeclass that denotes a handler scope, handling effect @e@ sent from the effect stack @esSend@ in the
  -- effect stack @es@.
  --
  -- You should not define instances for this typeclass whatsoever.
  class Handling esSend e es | esSend -> e es where
    -- @esSend@ is existential so it uniquely determines the other two variables. As handling scopes can nest, the other
    -- two variables cannot determine anything.
  
    -- | Obtain the send-site environment.
    sendSite :: SendSite esSend e
    sendSite = error
      "Cleff.Internal.Env.sendSite: Attempting to access the send site without a reflected value. This is perhaps \
      \because you are trying to define an instance for the 'Handling' typeclass, which you should not be doing \
      \whatsoever. If that or other shenanigans seem unlikely, please report this as a bug."
  
  -- | Get the pointer to the current effect handler itself.
  hdlPtr :: ∀ esSend e es. Handling esSend e es => HandlerPtr e
  hdlPtr = let SendSite _ ptr = sendSite @esSend in ptr
  
  -- | Get the send-site 'Env'.
  esSend :: Handling esSend e es => Env esSend
  esSend = let SendSite env _ = sendSite in env
  
  -- | Newtype wrapper for instantiating the 'Handling' typeclass locally, a la the reflection trick. We do not use
  -- the @reflection@ library directly so as not to expose this piece of implementation detail to the user.
  newtype InstHandling esSend e es a = InstHandling (Handling esSend e es => a)
  
  -- | Instantiate an 'Handling' typeclass, /i.e./ pass an implicit send-site environment in. This function shouldn't
  -- be directly used anyhow.
  instHandling :: ∀ esSend e es a. (Handling esSend e es => a) -> SendSite esSend e -> a
  instHandling x = unsafeCoerce (InstHandling x :: InstHandling esSend e es a)
  
  -- | The type of an /effect handler/, which is a function that transforms an effect @e@ from an arbitrary effect stack
  -- into computations in the effect stack @es@.
  type Handler e es = ∀ esSend. Handling esSend e es => e (Eff esSend) ~> Eff es
  
  -- | Transform a 'Handler' into an 'InternalHandler' given a pointer that is going to point to the 'InternalHandler'
  -- and the current 'Env'.
  mkInternalHandler :: HandlerPtr e -> Env es -> Handler e es -> InternalHandler e
  mkInternalHandler ptr es handle = InternalHandler \e -> Eff \ess ->
    unEff (instHandling handle (SendSite ess ptr) e) (update ess es)
  
  -- | Create an empty 'Env' with no address allocated.
  empty :: Env '[]
  empty = Env Stack.empty Vec.empty
  
  -- | Read the handler a pointer points to. \( O(1) \).
  read :: ∀ e es. e :> es => Env es -> ∀ es'. e (Eff es') ~> Eff es'
  read (Env stack heap) = fromAny $ Vec.lookup (unHandlerPtr (Stack.index @e stack)) heap
  
  -- | Adjust the effect stack via an function over 'Stack'.
  adjust :: ∀ es' es. (Stack es -> Stack es') -> Env es -> Env es'
  adjust f = \(Env stack heap) -> Env (f stack) heap
  
  -- | Replace the handler a pointer points to. \( O(1) \).
  overwriteGlobal :: ∀ e es es'. e :> es => Env es' -> Handler e es' -> Env es -> Env es
  overwriteGlobal es hdl (Env stack heap) = Env stack $
    Vec.update m (Any $ mkInternalHandler ptr es hdl) heap
    where ptr@(HandlerPtr m) = Stack.index @e stack
  
  -- | Replace the handler a pointer points to. \( O(1) \).
  overwriteSelfGlobal :: ∀ e es es' esSend. Handling esSend e es => Env es' -> Handler e es' -> Env esSend -> Env esSend
  overwriteSelfGlobal es hdl (Env stack heap) = Env stack $
    Vec.update ix (Any $ mkInternalHandler ptr es hdl) heap
    where ptr@(HandlerPtr ix) = hdlPtr @esSend
  
  -- | Replace the handler pointer of an effect in the stack. \( O(n) \).
  overwriteLocal :: ∀ e es es'. e :> es => Env es' -> Handler e es' -> Env es -> Env es
  overwriteLocal es hdl (Env stack heap) = Env
    (Stack.update @e ptr stack)
    (Vec.snoc heap $ Any $ mkInternalHandler ptr es hdl)
    where ptr = HandlerPtr (Vec.size heap)
  
  -- | Add a new effect to the stack with its corresponding handler pointer. \( O(n) \).
  extend :: ∀ e es es'. Env es' -> Handler e es' -> Env es -> Env (e : es)
  extend es hdl (Env stack heap) = Env
    (Stack.cons ptr stack)
    (Vec.snoc heap $ Any $ mkInternalHandler ptr es hdl)
    where ptr = HandlerPtr (Vec.size heap)
  
  -- | Use the state of LHS as a newer version for RHS. \( O(1) \).
  update :: ∀ es es'. Env es' -> Env es -> Env es
  update (Env _ heap) (Env stack _) = Env stack heap
  