fused-effects-0.4.0.0: A fast, flexible, fused effect system.

Safe HaskellNone
LanguageHaskell2010

Control.Effect.Cut

Synopsis

Documentation

data Cut m k Source #

Cut effects are used with NonDet to provide control over backtracking.

Constructors

Cutfail 
Call (m a) (a -> k) 
Instances
Effect Cut Source # 
Instance details

Defined in Control.Effect.Cut

Methods

handle :: Functor f => f () -> (forall x. f (m x) -> n (f x)) -> Cut m (m a) -> Cut n (n (f a)) Source #

HFunctor Cut Source # 
Instance details

Defined in Control.Effect.Cut

Methods

fmap' :: (a -> b) -> Cut m a -> Cut m b Source #

hmap :: (forall x. m x -> n x) -> Cut m a -> Cut n a Source #

Functor (Cut m) Source # 
Instance details

Defined in Control.Effect.Cut

Methods

fmap :: (a -> b) -> Cut m a -> Cut m b #

(<$) :: a -> Cut m b -> Cut m a #

(Carrier sig m, Effect sig) => Carrier (Cut :+: (NonDet :+: sig)) (CutC m) Source # 
Instance details

Defined in Control.Effect.Cut

Methods

eff :: (Cut :+: (NonDet :+: sig)) (CutC m) (CutC m a) -> CutC m a Source #

cutfail :: (Carrier sig m, Member Cut sig) => m a Source #

Fail the current branch, and prevent backtracking within the nearest enclosing call (if any).

Contrast with empty, which fails the current branch but allows backtracking.

run (runNonDet (runCut (cutfail <|> pure a))) == []
run (runNonDet (runCut (pure a <|> cutfail))) == [a]

call :: (Carrier sig m, Member Cut sig) => m a -> m a Source #

Delimit the effect of cutfails, allowing backtracking to resume.

run (runNonDet (runCut (call (cutfail <|> pure a) <|> pure b))) == [b]

cut :: (Alternative m, Carrier sig m, Member Cut sig) => m () Source #

Commit to the current branch, preventing backtracking within the nearest enclosing call (if any) on failure.

run (runNonDet (runCut (pure a <|> cut *> pure b))) == [a, b]
run (runNonDet (runCut (cut *> pure a <|> pure b))) == [a]
run (runNonDet (runCut (cut *> empty <|> pure a))) == []

runCut :: Alternative m => CutC m a -> m a Source #

Run a Cut effect within an underlying Alternative instance (typically another Carrier for a NonDet effect).

run (runNonDetOnce (runCut (pure a))) == Just a

runCutAll :: (Alternative f, Applicative m) => CutC m a -> m (f a) Source #

Run a Cut effect, returning all its results in an Alternative collection.

newtype CutC m a Source #

Constructors

CutC 

Fields

  • runCutC :: forall b. (a -> m b -> m b) -> m b -> m b -> m b

    A higher-order function receiving three parameters: a function to combine each solution with the rest of the solutions, an action to run when no results are produced (e.g. on empty), and an action to run when no results are produced and backtrcking should not be attempted (e.g. on cutfail).

Instances
MonadTrans CutC Source # 
Instance details

Defined in Control.Effect.Cut

Methods

lift :: Monad m => m a -> CutC m a #

Monad (CutC m) Source # 
Instance details

Defined in Control.Effect.Cut

Methods

(>>=) :: CutC m a -> (a -> CutC m b) -> CutC m b #

(>>) :: CutC m a -> CutC m b -> CutC m b #

return :: a -> CutC m a #

fail :: String -> CutC m a #

Functor (CutC m) Source # 
Instance details

Defined in Control.Effect.Cut

Methods

fmap :: (a -> b) -> CutC m a -> CutC m b #

(<$) :: a -> CutC m b -> CutC m a #

MonadFail m => MonadFail (CutC m) Source # 
Instance details

Defined in Control.Effect.Cut

Methods

fail :: String -> CutC m a #

Applicative (CutC m) Source # 
Instance details

Defined in Control.Effect.Cut

Methods

pure :: a -> CutC m a #

(<*>) :: CutC m (a -> b) -> CutC m a -> CutC m b #

liftA2 :: (a -> b -> c) -> CutC m a -> CutC m b -> CutC m c #

(*>) :: CutC m a -> CutC m b -> CutC m b #

(<*) :: CutC m a -> CutC m b -> CutC m a #

MonadIO m => MonadIO (CutC m) Source # 
Instance details

Defined in Control.Effect.Cut

Methods

liftIO :: IO a -> CutC m a #

Alternative (CutC m) Source # 
Instance details

Defined in Control.Effect.Cut

Methods

empty :: CutC m a #

(<|>) :: CutC m a -> CutC m a -> CutC m a #

some :: CutC m a -> CutC m [a] #

many :: CutC m a -> CutC m [a] #

MonadPlus (CutC m) Source # 
Instance details

Defined in Control.Effect.Cut

Methods

mzero :: CutC m a #

mplus :: CutC m a -> CutC m a -> CutC m a #

(Carrier sig m, Effect sig) => Carrier (Cut :+: (NonDet :+: sig)) (CutC m) Source # 
Instance details

Defined in Control.Effect.Cut

Methods

eff :: (Cut :+: (NonDet :+: sig)) (CutC m) (CutC m a) -> CutC m a Source #