{-# HLINT ignore "Avoid lambda" #-}
{-# LANGUAGE AllowAmbiguousTypes #-}
{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}

-- 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 Data.Effect.CC (
    module Data.Effect.CC,
    CC (SubFork, Jump),
    callCC_,
    sub,
)
where

import Control.Effect (callCC_, sub)
import Data.Effect (CC (Jump, SubFork))
import Data.Function (fix)

makeEffectF_' (def & noGenerateLabel & noGenerateOrderInstance) ''CC

callCC
    :: forall a ref es ff c
     . (CC ref :> es, Monad (Eff ff es), Free c ff)
    => ((forall b. a -> Eff ff es b) -> Eff ff es a)
    -> Eff ff es a
callCC :: forall a (ref :: * -> *) (es :: [Effect]) (ff :: Effect)
       (c :: (* -> *) -> Constraint).
(CC ref :> es, Monad (Eff ff es), Free c ff) =>
((forall b. a -> Eff ff es b) -> Eff ff es a) -> Eff ff es a
callCC (forall b. a -> Eff ff es b) -> Eff ff es a
f = (ref a -> Eff ff es a) -> (a -> Eff ff es a) -> Eff ff es a
forall (ref :: * -> *) a b (es :: [Effect]) (ff :: Effect)
       (c :: (* -> *) -> Constraint).
(CC ref :> es, Monad (Eff ff es), Free c ff) =>
(ref a -> Eff ff es b) -> (a -> Eff ff es b) -> Eff ff es b
sub (\ref a
x -> (forall b. a -> Eff ff es b) -> Eff ff es a
f ((forall b. a -> Eff ff es b) -> Eff ff es a)
-> (forall b. a -> Eff ff es b) -> Eff ff es a
forall a b. (a -> b) -> a -> b
$ ref a -> a -> Eff ff es b
forall (ref :: * -> *) a1 b (a :: * -> *) (es :: [Effect])
       (ff :: Effect) (c :: (* -> *) -> Constraint).
(Free c ff, a ~ Eff ff es, CC ref :> es) =>
ref a1 -> a1 -> a b
jump ref a
x) a -> Eff ff es a
forall a. a -> Eff ff es a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
{-# INLINE callCC #-}

getCC
    :: forall a ref es ff c
     . (CC ref :> es, Monad (Eff ff es), Free c ff)
    => Eff ff es (Eff ff es a)
getCC :: forall a (ref :: * -> *) (es :: [Effect]) (ff :: Effect)
       (c :: (* -> *) -> Constraint).
(CC ref :> es, Monad (Eff ff es), Free c ff) =>
Eff ff es (Eff ff es a)
getCC = ((Eff ff es a -> Eff ff es a) -> Eff ff es (Eff ff es a))
-> Eff ff es (Eff ff es a)
forall (ref :: * -> *) a b (es :: [Effect]) (ff :: Effect)
       (c :: (* -> *) -> Constraint).
(CC ref :> es, Monad (Eff ff es), Free c ff) =>
((a -> Eff ff es b) -> Eff ff es a) -> Eff ff es a
callCC_ (((Eff ff es a -> Eff ff es a) -> Eff ff es (Eff ff es a))
 -> Eff ff es (Eff ff es a))
-> ((Eff ff es a -> Eff ff es a) -> Eff ff es (Eff ff es a))
-> Eff ff es (Eff ff es a)
forall a b. (a -> b) -> a -> b
$ Eff ff es a -> Eff ff es (Eff ff es a)
forall a. a -> Eff ff es a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Eff ff es a -> Eff ff es (Eff ff es a))
-> ((Eff ff es a -> Eff ff es a) -> Eff ff es a)
-> (Eff ff es a -> Eff ff es a)
-> Eff ff es (Eff ff es a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Eff ff es a -> Eff ff es a) -> Eff ff es a
forall a. (a -> a) -> a
fix
{-# INLINE getCC #-}