-- SPDX-License-Identifier: MPL-2.0

{- |
Copyright   :  (c) 2024-2025 Sayo contributors
License     :  MPL-2.0 (see the LICENSE file)
Maintainer  :  ymdfield@outlook.jp
-}
module Control.Monad.Hefty.CC (
    module Control.Monad.Hefty.CC,
    module Data.Effect.CC,
)
where

import Control.Monad.Hefty (AlgHandler, Eff, interpretBy)
import Data.Effect.CC
import Data.Effect.OpenUnion (FOEs)
import Data.Functor.Contravariant (Op (Op))

runCC :: (FOEs es) => (a -> Eff es ans) -> Eff (CC (Op (Eff es ans)) ': es) a -> Eff es ans
runCC :: forall (es :: [Effect]) a ans.
FOEs es =>
(a -> Eff es ans)
-> Eff (CC (Op (Eff es ans)) : es) a -> Eff es ans
runCC a -> Eff es ans
k = (a -> Eff es ans)
-> AlgHandler
     (CC (Op (Eff es ans)))
     (Eff (CC (Op (Eff es ans)) : es))
     (Eff es)
     ans
-> Eff (CC (Op (Eff es ans)) : es) a
-> Eff es ans
forall (e :: Effect) (es :: [Effect]) ans a.
(KnownOrder e, FOEs es) =>
(a -> Eff es ans)
-> AlgHandler e (Eff (e : es)) (Eff es) ans
-> Eff (e : es) a
-> Eff es ans
interpretBy a -> Eff es ans
k CC (Op (Eff es ans)) (Eff (CC (Op (Eff es ans)) : es)) x
-> (x -> Eff es ans) -> Eff es ans
AlgHandler
  (CC (Op (Eff es ans)))
  (Eff (CC (Op (Eff es ans)) : es))
  (Eff es)
  ans
forall (g :: * -> *) ans (f :: * -> *) x.
CC (Op (g ans)) f x -> (x -> g ans) -> g ans
handleCC
{-# INLINE runCC #-}

handleCC :: AlgHandler (CC (Op (g ans))) f g ans
handleCC :: forall (g :: * -> *) ans (f :: * -> *) x.
CC (Op (g ans)) f x -> (x -> g ans) -> g ans
handleCC = \case
    CC (Op (g ans)) f x
SubFork -> \x -> g ans
exit -> x -> g ans
exit (x -> g ans) -> ((a1 -> g ans) -> x) -> (a1 -> g ans) -> g ans
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Op (g ans) a1 -> x
Op (g ans) a1 -> Either (Op (g ans) a1) a1
forall a b. a -> Either a b
Left (Op (g ans) a1 -> x)
-> ((a1 -> g ans) -> Op (g ans) a1) -> (a1 -> g ans) -> x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a1 -> g ans) -> Op (g ans) a1
forall a b. (b -> a) -> Op a b
Op ((a1 -> g ans) -> g ans) -> (a1 -> g ans) -> g ans
forall a b. (a -> b) -> a -> b
$ x -> g ans
exit (x -> g ans) -> (a1 -> x) -> a1 -> g ans
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a1 -> x
a1 -> Either (Op (g ans) a1) a1
forall a b. b -> Either a b
Right
    Jump (Op a1 -> g ans
exit) a1
x -> \x -> g ans
_ -> a1 -> g ans
exit a1
x
{-# INLINE handleCC #-}

evalCC :: (FOEs es) => Eff (CC (Op (Eff es a)) ': es) a -> Eff es a
evalCC :: forall (es :: [Effect]) a.
FOEs es =>
Eff (CC (Op (Eff es a)) : es) a -> Eff es a
evalCC = (a -> Eff es a) -> Eff (CC (Op (Eff es a)) : es) a -> Eff es a
forall (es :: [Effect]) a ans.
FOEs es =>
(a -> Eff es ans)
-> Eff (CC (Op (Eff es ans)) : es) a -> Eff es ans
runCC a -> Eff es a
forall a. a -> Eff Freer es a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
{-# INLINE evalCC #-}