{-# LANGUAGE DeriveFunctor, ExistentialQuantification, StandaloneDeriving #-}
{- | Provides an effect to cull choices in a given nondeterministic context. This effect is used in concert with 'Control.Effect.NonDet.NonDet'.

Computations run inside a call to 'cull' will return at most one result.

Predefined carriers:

* "Control.Carrier.Cull.Church"

@since 0.1.2.0
-}
module Control.Effect.Cull
( -- * Cull effect
  Cull(..)
, cull
  -- * Re-exports
, Algebra
, Effect
, Has
, run
) where

import Control.Algebra

-- | 'Cull' effects are used with 'Control.Effect.Choose' to provide control over branching.
--
-- @since 0.1.2.0
data Cull m k
  = forall a . Cull (m a) (a -> m k)

deriving instance Functor m => Functor (Cull m)

instance HFunctor Cull where
  hmap :: (forall x. m x -> n x) -> Cull m a -> Cull n a
hmap f :: forall x. m x -> n x
f (Cull m :: m a
m k :: a -> m a
k) = n a -> (a -> n a) -> Cull n a
forall (m :: * -> *) k a. m a -> (a -> m k) -> Cull m k
Cull (m a -> n a
forall x. m x -> n x
f m a
m) (m a -> n a
forall x. m x -> n x
f (m a -> n a) -> (a -> m a) -> a -> n a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> m a
k)
  {-# INLINE hmap #-}

instance Effect Cull where
  thread :: ctx ()
-> (forall x. ctx (m x) -> n (ctx x)) -> Cull m a -> Cull n (ctx a)
thread ctx :: ctx ()
ctx handler :: forall x. ctx (m x) -> n (ctx x)
handler (Cull m :: m a
m k :: a -> m a
k) = n (ctx a) -> (ctx a -> n (ctx a)) -> Cull n (ctx a)
forall (m :: * -> *) k a. m a -> (a -> m k) -> Cull m k
Cull (ctx (m a) -> n (ctx a)
forall x. ctx (m x) -> n (ctx x)
handler (m a
m m a -> ctx () -> ctx (m a)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ctx ()
ctx)) (ctx (m a) -> n (ctx a)
forall x. ctx (m x) -> n (ctx x)
handler (ctx (m a) -> n (ctx a))
-> (ctx a -> ctx (m a)) -> ctx a -> n (ctx a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> m a) -> ctx a -> ctx (m a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> m a
k)
  {-# INLINE thread #-}

-- | Cull nondeterminism in the argument, returning at most one result.
--
-- @
-- 'cull' ('pure' a 'Control.Effect.Choose.<|>' m) 'Control.Effect.Choose.<|>' n = 'pure' a 'Control.Effect.Choose.<|>' n
-- @
--
-- @since 0.1.2.0
cull :: Has Cull sig m => m a -> m a
cull :: m a -> m a
cull m :: m a
m = Cull m a -> m a
forall (eff :: (* -> *) -> * -> *) (sig :: (* -> *) -> * -> *)
       (m :: * -> *) a.
(Member eff sig, Algebra sig m) =>
eff m a -> m a
send (m a -> (a -> m a) -> Cull m a
forall (m :: * -> *) k a. m a -> (a -> m k) -> Cull m k
Cull m a
m a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure)