{-# LANGUAGE QuantifiedConstraints #-}

-- SPDX-License-Identifier: MPL-2.0

{- |
Copyright   :  (c) 2024 Sayo contributors
License     :  MPL-2.0 (see the file LICENSE)
Maintainer  :  ymdfield@outlook.jp
-}
module Data.Effect.HFunctor.HCont where

import Control.Effect (type (~>))
import Data.Effect (EffectOrder (HigherOrder), OrderOf)
import Data.Effect.HFunctor (HFunctor, hfmap)
import Data.Kind (Type)

-- | This represents that the effect @ff@ is finally interpreted as the base carrier @b@.
newtype HCont ff b f (a :: Type) = HCont {forall (ff :: (* -> *) -> * -> *) (b :: * -> *) (f :: * -> *) a.
HCont ff b f a -> (f ~> b) -> ff b a
unHCont :: (f ~> b) -> ff b a}
    deriving stock ((forall a b. (a -> b) -> HCont ff b f a -> HCont ff b f b)
-> (forall a b. a -> HCont ff b f b -> HCont ff b f a)
-> Functor (HCont ff b f)
forall a b. a -> HCont ff b f b -> HCont ff b f a
forall a b. (a -> b) -> HCont ff b f a -> HCont ff b f b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
forall (ff :: (* -> *) -> * -> *) (b :: * -> *) (f :: * -> *) a b.
Functor (ff b) =>
a -> HCont ff b f b -> HCont ff b f a
forall (ff :: (* -> *) -> * -> *) (b :: * -> *) (f :: * -> *) a b.
Functor (ff b) =>
(a -> b) -> HCont ff b f a -> HCont ff b f b
$cfmap :: forall (ff :: (* -> *) -> * -> *) (b :: * -> *) (f :: * -> *) a b.
Functor (ff b) =>
(a -> b) -> HCont ff b f a -> HCont ff b f b
fmap :: forall a b. (a -> b) -> HCont ff b f a -> HCont ff b f b
$c<$ :: forall (ff :: (* -> *) -> * -> *) (b :: * -> *) (f :: * -> *) a b.
Functor (ff b) =>
a -> HCont ff b f b -> HCont ff b f a
<$ :: forall a b. a -> HCont ff b f b -> HCont ff b f a
Functor)

type instance OrderOf (HCont ff b) = 'HigherOrder

instance HFunctor (HCont ff g) where
    hfmap :: forall (f :: * -> *) (g :: * -> *) a.
(forall x. f x -> g x) -> HCont ff g f a -> HCont ff g g a
hfmap forall x. f x -> g x
phi (HCont (f ~> g) -> ff g a
f) = ((g ~> g) -> ff g a) -> HCont ff g g a
forall (ff :: (* -> *) -> * -> *) (b :: * -> *) (f :: * -> *) a.
((f ~> b) -> ff b a) -> HCont ff b f a
HCont \g ~> g
k -> (f ~> g) -> ff g a
f ((f ~> g) -> ff g a) -> (f ~> g) -> ff g a
forall a b. (a -> b) -> a -> b
$ g x -> g x
g ~> g
k (g x -> g x) -> (f x -> g x) -> f x -> g x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f x -> g x
forall x. f x -> g x
phi
    {-# INLINE hfmap #-}