{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveAnyClass #-}

-- SPDX-License-Identifier: MPL-2.0

{- |
Copyright   :  (c) 2024 Sayo contributors
License     :  MPL-2.0 (see the LICENSE file)
Maintainer  :  ymdfield@outlook.jp

Interpreters for the [non-determinism]("Data.Effect.NonDet") effects.
-}
module Control.Monad.Hefty.NonDet (
    module Control.Monad.Hefty.NonDet,
    module Data.Effect.NonDet,
)
where

import Control.Applicative (Alternative ((<|>)), (<|>))
#if ( __GLASGOW_HASKELL__ < 906 )
import Control.Applicative (liftA2)
#endif
import Control.Applicative qualified as A
import Control.Monad.Hefty (Eff, FOEs, interpretBy, interpretsBy, nil, (!:))
import Data.Effect.NonDet

-- | [NonDet]("Data.Effect.NonDet") effects handler for alternative answer type.
runNonDet
    :: forall f es a
     . (Alternative f, FOEs es)
    => Eff (Choose ': Empty ': es) a
    -> Eff es (f a)
runNonDet :: forall (f :: * -> *) (es :: [Effect]) a.
(Alternative f, FOEs es) =>
Eff (Choose : Empty : es) a -> Eff es (f a)
runNonDet =
    (a -> Eff Freer es (f a))
-> AlgHandler
     (Union '[Choose, Empty])
     (Eff ('[Choose, Empty] ++ es))
     (Eff Freer es)
     (f a)
-> Eff Freer ('[Choose, Empty] ++ es) a
-> Eff Freer es (f a)
forall (es :: [Effect]) (r :: [Effect]) ans a.
(FOEs r, KnownLength es) =>
(a -> Eff r ans)
-> AlgHandler (Union es) (Eff (es ++ r)) (Eff r) ans
-> Eff (es ++ r) a
-> Eff r ans
interpretsBy
        (f a -> Eff Freer es (f a)
forall a. a -> Eff Freer es a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (f a -> Eff Freer es (f a))
-> (a -> f a) -> a -> Eff Freer es (f a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> f a
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure)
        (AlgHandler
   (Union '[Choose, Empty])
   (Eff ('[Choose, Empty] ++ es))
   (Eff Freer es)
   (f a)
 -> Eff Freer ('[Choose, Empty] ++ es) a -> Eff Freer es (f a))
-> AlgHandler
     (Union '[Choose, Empty])
     (Eff ('[Choose, Empty] ++ es))
     (Eff Freer es)
     (f a)
-> Eff Freer ('[Choose, Empty] ++ es) a
-> Eff Freer es (f a)
forall a b. (a -> b) -> a -> b
$ (\Choose (Eff (Choose : Empty : es)) x
Choose x -> Eff Freer es (f a)
k -> (f a -> f a -> f a)
-> Eff Freer es (f a) -> Eff Freer es (f a) -> Eff Freer es (f a)
forall a b c.
(a -> b -> c) -> Eff Freer es a -> Eff Freer es b -> Eff Freer es c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 f a -> f a -> f a
forall a. f a -> f a -> f a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>) (x -> Eff Freer es (f a)
k x
Bool
False) (x -> Eff Freer es (f a)
k x
Bool
True))
            (Choose (Eff (Choose : Empty : es)) x
 -> (x -> Eff Freer es (f a)) -> Eff Freer es (f a))
-> (Union '[Empty] (Eff (Choose : Empty : es)) x
    -> (x -> Eff Freer es (f a)) -> Eff Freer es (f a))
-> Union '[Choose, Empty] (Eff (Choose : Empty : es)) x
-> (x -> Eff Freer es (f a))
-> Eff Freer es (f a)
forall (f :: * -> *) a r (es :: [Effect]).
(Choose f a -> r)
-> (Union es f a -> r) -> Union (Choose : es) f a -> r
forall (e :: Effect) (order :: EffectOrder) (f :: * -> *) a r
       (es :: [Effect]).
Elem e order =>
(e f a -> r) -> (Union es f a -> r) -> Union (e : es) f a -> r
!: (\Empty (Eff (Choose : Empty : es)) x
Empty x -> Eff Freer es (f a)
_ -> f a -> Eff Freer es (f a)
forall a. a -> Eff Freer es a
forall (f :: * -> *) a. Applicative f => a -> f a
pure f a
forall a. f a
forall (f :: * -> *) a. Alternative f => f a
A.empty)
            (Empty (Eff (Choose : Empty : es)) x
 -> (x -> Eff Freer es (f a)) -> Eff Freer es (f a))
-> (Union '[] (Eff (Choose : Empty : es)) x
    -> (x -> Eff Freer es (f a)) -> Eff Freer es (f a))
-> Union '[Empty] (Eff (Choose : Empty : es)) x
-> (x -> Eff Freer es (f a))
-> Eff Freer es (f a)
forall (f :: * -> *) a r (es :: [Effect]).
(Empty f a -> r)
-> (Union es f a -> r) -> Union (Empty : es) f a -> r
forall (e :: Effect) (order :: EffectOrder) (f :: * -> *) a r
       (es :: [Effect]).
Elem e order =>
(e f a -> r) -> (Union es f a -> r) -> Union (e : es) f a -> r
!: Union '[] (Eff (Choose : Empty : es)) x
-> (x -> Eff Freer es (f a)) -> Eff Freer es (f a)
forall (f :: * -> *) a r. Union '[] f a -> r
nil
{-# INLINE runNonDet #-}

-- | [NonDet]("Data.Effect.NonDet") effects handler for monoidal answer type.
runNonDetMonoid
    :: forall ans es a
     . (Monoid ans, FOEs es)
    => (a -> Eff es ans)
    -> Eff (Choose ': Empty ': es) a
    -> Eff es ans
runNonDetMonoid :: forall ans (es :: [Effect]) a.
(Monoid ans, FOEs es) =>
(a -> Eff es ans) -> Eff (Choose : Empty : es) a -> Eff es ans
runNonDetMonoid a -> Eff es ans
ret =
    (a -> Eff es ans)
-> AlgHandler
     (Union '[Choose, Empty])
     (Eff ('[Choose, Empty] ++ es))
     (Eff es)
     ans
-> Eff Freer ('[Choose, Empty] ++ es) a
-> Eff es ans
forall (es :: [Effect]) (r :: [Effect]) ans a.
(FOEs r, KnownLength es) =>
(a -> Eff r ans)
-> AlgHandler (Union es) (Eff (es ++ r)) (Eff r) ans
-> Eff (es ++ r) a
-> Eff r ans
interpretsBy
        a -> Eff es ans
ret
        (AlgHandler
   (Union '[Choose, Empty])
   (Eff ('[Choose, Empty] ++ es))
   (Eff es)
   ans
 -> Eff Freer ('[Choose, Empty] ++ es) a -> Eff es ans)
-> AlgHandler
     (Union '[Choose, Empty])
     (Eff ('[Choose, Empty] ++ es))
     (Eff es)
     ans
-> Eff Freer ('[Choose, Empty] ++ es) a
-> Eff es ans
forall a b. (a -> b) -> a -> b
$ (\Choose (Eff (Choose : Empty : es)) x
Choose x -> Eff es ans
k -> (ans -> ans -> ans) -> Eff es ans -> Eff es ans -> Eff es ans
forall a b c.
(a -> b -> c) -> Eff Freer es a -> Eff Freer es b -> Eff Freer es c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 ans -> ans -> ans
forall a. Semigroup a => a -> a -> a
(<>) (x -> Eff es ans
k x
Bool
False) (x -> Eff es ans
k x
Bool
True))
            (Choose (Eff (Choose : Empty : es)) x
 -> (x -> Eff es ans) -> Eff es ans)
-> (Union '[Empty] (Eff (Choose : Empty : es)) x
    -> (x -> Eff es ans) -> Eff es ans)
-> Union '[Choose, Empty] (Eff (Choose : Empty : es)) x
-> (x -> Eff es ans)
-> Eff es ans
forall (f :: * -> *) a r (es :: [Effect]).
(Choose f a -> r)
-> (Union es f a -> r) -> Union (Choose : es) f a -> r
forall (e :: Effect) (order :: EffectOrder) (f :: * -> *) a r
       (es :: [Effect]).
Elem e order =>
(e f a -> r) -> (Union es f a -> r) -> Union (e : es) f a -> r
!: (\Empty (Eff (Choose : Empty : es)) x
Empty x -> Eff es ans
_ -> ans -> Eff es ans
forall a. a -> Eff Freer es a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ans
forall a. Monoid a => a
mempty)
            (Empty (Eff (Choose : Empty : es)) x
 -> (x -> Eff es ans) -> Eff es ans)
-> (Union '[] (Eff (Choose : Empty : es)) x
    -> (x -> Eff es ans) -> Eff es ans)
-> Union '[Empty] (Eff (Choose : Empty : es)) x
-> (x -> Eff es ans)
-> Eff es ans
forall (f :: * -> *) a r (es :: [Effect]).
(Empty f a -> r)
-> (Union es f a -> r) -> Union (Empty : es) f a -> r
forall (e :: Effect) (order :: EffectOrder) (f :: * -> *) a r
       (es :: [Effect]).
Elem e order =>
(e f a -> r) -> (Union es f a -> r) -> Union (e : es) f a -> r
!: Union '[] (Eff (Choose : Empty : es)) x
-> (x -> Eff es ans) -> Eff es ans
forall (f :: * -> *) a r. Union '[] f a -> r
nil
{-# INLINE runNonDetMonoid #-}

-- | t'Choose' effect handler for alternative answer type.
runChoose
    :: forall f es a
     . (Alternative f, FOEs es)
    => Eff (Choose ': es) a
    -> Eff es (f a)
runChoose :: forall (f :: * -> *) (es :: [Effect]) a.
(Alternative f, FOEs es) =>
Eff (Choose : es) a -> Eff es (f a)
runChoose =
    (a -> Eff es (f a))
-> AlgHandler Choose (Eff (Choose : es)) (Eff Freer es) (f a)
-> Eff (Choose : es) a
-> Eff es (f a)
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 (f a -> Eff es (f a)
forall a. a -> Eff Freer es a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (f a -> Eff es (f a)) -> (a -> f a) -> a -> Eff es (f a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> f a
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure) \Choose (Eff (Choose : es)) x
Choose x -> Eff es (f a)
k ->
        (f a -> f a -> f a) -> Eff es (f a) -> Eff es (f a) -> Eff es (f a)
forall a b c.
(a -> b -> c) -> Eff Freer es a -> Eff Freer es b -> Eff Freer es c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 f a -> f a -> f a
forall a. f a -> f a -> f a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>) (x -> Eff es (f a)
k x
Bool
False) (x -> Eff es (f a)
k x
Bool
True)
{-# INLINE runChoose #-}

-- | t'Choose' effect handler for monoidal answer type.
runChooseMonoid
    :: forall ans es a
     . (Semigroup ans, FOEs es)
    => (a -> Eff es ans)
    -> Eff (Choose ': es) a
    -> Eff es ans
runChooseMonoid :: forall ans (es :: [Effect]) a.
(Semigroup ans, FOEs es) =>
(a -> Eff es ans) -> Eff (Choose : es) a -> Eff es ans
runChooseMonoid a -> Eff es ans
f =
    (a -> Eff es ans)
-> AlgHandler Choose (Eff (Choose : es)) (Eff es) ans
-> Eff (Choose : 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
f \Choose (Eff (Choose : es)) x
Choose x -> Eff es ans
k ->
        (ans -> ans -> ans) -> Eff es ans -> Eff es ans -> Eff es ans
forall a b c.
(a -> b -> c) -> Eff Freer es a -> Eff Freer es b -> Eff Freer es c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 ans -> ans -> ans
forall a. Semigroup a => a -> a -> a
(<>) (x -> Eff es ans
k x
Bool
False) (x -> Eff es ans
k x
Bool
True)
{-# INLINE runChooseMonoid #-}

-- | t'Empty' effect handler.
runEmpty :: forall a es. (FOEs es) => Eff (Empty ': es) a -> Eff es (Maybe a)
runEmpty :: forall a (es :: [Effect]).
FOEs es =>
Eff (Empty : es) a -> Eff es (Maybe a)
runEmpty =
    (a -> Eff es (Maybe a))
-> AlgHandler Empty (Eff (Empty : es)) (Eff Freer es) (Maybe a)
-> Eff (Empty : es) a
-> Eff es (Maybe a)
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
        (Maybe a -> Eff es (Maybe a)
forall a. a -> Eff Freer es a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe a -> Eff es (Maybe a))
-> (a -> Maybe a) -> a -> Eff es (Maybe a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Maybe a
forall a. a -> Maybe a
Just)
        \Empty (Eff (Empty : es)) x
Empty x -> Eff es (Maybe a)
_ -> Maybe a -> Eff es (Maybe a)
forall a. a -> Eff Freer es a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
forall a. Maybe a
Nothing
{-# INLINE runEmpty #-}