{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}

-- | A carrier for 'Cut' and 'NonDet' effects used in tandem (@Cut :+: NonDet@).
--
-- @since 1.0.0.0
module Control.Carrier.Cut.Church
( -- * Cut carrier
  runCut
, runCutA
, runCutM
, CutC(..)
  -- * Cut effect
, module Control.Effect.Cut
  -- * NonDet effects
, module Control.Effect.NonDet
) where

import           Control.Algebra
import           Control.Applicative (liftA2)
import           Control.Effect.Cut
import           Control.Effect.NonDet
import qualified Control.Monad.Fail as Fail
import           Control.Monad.Fix
import           Control.Monad.IO.Class
import           Control.Monad.Trans.Class
import           Data.Coerce (coerce)
import           Data.Functor.Identity

-- | Run a 'Cut' effect with continuations respectively interpreting 'pure' / '<|>', 'empty', and 'cutfail'.
--
-- @since 1.0.0.0
runCut :: (a -> m b -> m b) -> m b -> m b -> CutC m a -> m b
runCut :: (a -> m b -> m b) -> m b -> m b -> CutC m a -> m b
runCut cons :: a -> m b -> m b
cons nil :: m b
nil fail :: m b
fail (CutC runCutC :: forall b. (a -> m b -> m b) -> m b -> m b -> m b
runCutC) = (a -> m b -> m b) -> m b -> m b -> m b
forall b. (a -> m b -> m b) -> m b -> m b -> m b
runCutC a -> m b -> m b
cons m b
nil m b
fail

-- | Run a 'Cut' effect, returning all its results in an 'Alternative' collection.
--
-- @since 1.0.0.0
runCutA :: (Alternative f, Applicative m) => CutC m a -> m (f a)
runCutA :: CutC m a -> m (f a)
runCutA = (a -> m (f a) -> m (f a))
-> m (f a) -> m (f a) -> CutC m a -> m (f a)
forall a (m :: * -> *) b.
(a -> m b -> m b) -> m b -> m b -> CutC m a -> m b
runCut ((f a -> f a) -> m (f a) -> m (f a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((f a -> f a) -> m (f a) -> m (f a))
-> (a -> f a -> f a) -> a -> m (f a) -> m (f a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f a -> f a -> f a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>) (f a -> f a -> f a) -> (a -> f a) -> a -> f a -> f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure) (f a -> m (f a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure f a
forall (f :: * -> *) a. Alternative f => f a
empty) (f a -> m (f a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure f a
forall (f :: * -> *) a. Alternative f => f a
empty)

-- | Run a 'Cut' effect, mapping results into a 'Monoid'.
--
-- @since 1.0.0.0
runCutM :: (Applicative m, Monoid b) => (a -> b) -> CutC m a -> m b
runCutM :: (a -> b) -> CutC m a -> m b
runCutM leaf :: a -> b
leaf = (a -> m b -> m b) -> m b -> m b -> CutC m a -> m b
forall a (m :: * -> *) b.
(a -> m b -> m b) -> m b -> m b -> CutC m a -> m b
runCut ((b -> b) -> m b -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((b -> b) -> m b -> m b) -> (a -> b -> b) -> a -> m b -> m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> b -> b
forall a. Monoid a => a -> a -> a
mappend (b -> b -> b) -> (a -> b) -> a -> b -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
leaf) (b -> m b
forall (f :: * -> *) a. Applicative f => a -> f a
pure b
forall a. Monoid a => a
mempty) (b -> m b
forall (f :: * -> *) a. Applicative f => a -> f a
pure b
forall a. Monoid a => a
mempty)

-- | @since 1.0.0.0
newtype CutC m a = CutC (forall b . (a -> m b -> m b) -> m b -> m b -> m b)
  deriving (a -> CutC m b -> CutC m a
(a -> b) -> CutC m a -> CutC m b
(forall a b. (a -> b) -> CutC m a -> CutC m b)
-> (forall a b. a -> CutC m b -> CutC m a) -> Functor (CutC m)
forall a b. a -> CutC m b -> CutC m a
forall a b. (a -> b) -> CutC m a -> CutC m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
forall (m :: * -> *) a b. a -> CutC m b -> CutC m a
forall (m :: * -> *) a b. (a -> b) -> CutC m a -> CutC m b
<$ :: a -> CutC m b -> CutC m a
$c<$ :: forall (m :: * -> *) a b. a -> CutC m b -> CutC m a
fmap :: (a -> b) -> CutC m a -> CutC m b
$cfmap :: forall (m :: * -> *) a b. (a -> b) -> CutC m a -> CutC m b
Functor)

instance Applicative (CutC m) where
  pure :: a -> CutC m a
pure a :: a
a = (forall b. (a -> m b -> m b) -> m b -> m b -> m b) -> CutC m a
forall (m :: * -> *) a.
(forall b. (a -> m b -> m b) -> m b -> m b -> m b) -> CutC m a
CutC (\ cons :: a -> m b -> m b
cons nil :: m b
nil _ -> a -> m b -> m b
cons a
a m b
nil)
  {-# INLINE pure #-}
  CutC f :: forall b. ((a -> b) -> m b -> m b) -> m b -> m b -> m b
f <*> :: CutC m (a -> b) -> CutC m a -> CutC m b
<*> CutC a :: forall b. (a -> m b -> m b) -> m b -> m b -> m b
a = (forall b. (b -> m b -> m b) -> m b -> m b -> m b) -> CutC m b
forall (m :: * -> *) a.
(forall b. (a -> m b -> m b) -> m b -> m b -> m b) -> CutC m a
CutC ((forall b. (b -> m b -> m b) -> m b -> m b -> m b) -> CutC m b)
-> (forall b. (b -> m b -> m b) -> m b -> m b -> m b) -> CutC m b
forall a b. (a -> b) -> a -> b
$ \ cons :: b -> m b -> m b
cons nil :: m b
nil fail :: m b
fail ->
    ((a -> b) -> m b -> m b) -> m b -> m b -> m b
forall b. ((a -> b) -> m b -> m b) -> m b -> m b -> m b
f (\ f' :: a -> b
f' fs :: m b
fs -> (a -> m b -> m b) -> m b -> m b -> m b
forall b. (a -> m b -> m b) -> m b -> m b -> m b
a (b -> m b -> m b
cons (b -> m b -> m b) -> (a -> b) -> a -> m b -> m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f') m b
fs m b
fail) m b
nil m b
fail
  {-# INLINE (<*>) #-}

instance Alternative (CutC m) where
  empty :: CutC m a
empty = (forall b. (a -> m b -> m b) -> m b -> m b -> m b) -> CutC m a
forall (m :: * -> *) a.
(forall b. (a -> m b -> m b) -> m b -> m b -> m b) -> CutC m a
CutC (\ _ nil :: m b
nil _ -> m b
nil)
  {-# INLINE empty #-}
  CutC l :: forall b. (a -> m b -> m b) -> m b -> m b -> m b
l <|> :: CutC m a -> CutC m a -> CutC m a
<|> CutC r :: forall b. (a -> m b -> m b) -> m b -> m b -> m b
r = (forall b. (a -> m b -> m b) -> m b -> m b -> m b) -> CutC m a
forall (m :: * -> *) a.
(forall b. (a -> m b -> m b) -> m b -> m b -> m b) -> CutC m a
CutC (\ cons :: a -> m b -> m b
cons nil :: m b
nil fail :: m b
fail -> (a -> m b -> m b) -> m b -> m b -> m b
forall b. (a -> m b -> m b) -> m b -> m b -> m b
l a -> m b -> m b
cons ((a -> m b -> m b) -> m b -> m b -> m b
forall b. (a -> m b -> m b) -> m b -> m b -> m b
r a -> m b -> m b
cons m b
nil m b
fail) m b
fail)
  {-# INLINE (<|>) #-}

instance Monad (CutC m) where
  CutC a :: forall b. (a -> m b -> m b) -> m b -> m b -> m b
a >>= :: CutC m a -> (a -> CutC m b) -> CutC m b
>>= f :: a -> CutC m b
f = (forall b. (b -> m b -> m b) -> m b -> m b -> m b) -> CutC m b
forall (m :: * -> *) a.
(forall b. (a -> m b -> m b) -> m b -> m b -> m b) -> CutC m a
CutC ((forall b. (b -> m b -> m b) -> m b -> m b -> m b) -> CutC m b)
-> (forall b. (b -> m b -> m b) -> m b -> m b -> m b) -> CutC m b
forall a b. (a -> b) -> a -> b
$ \ cons :: b -> m b -> m b
cons nil :: m b
nil fail :: m b
fail ->
    (a -> m b -> m b) -> m b -> m b -> m b
forall b. (a -> m b -> m b) -> m b -> m b -> m b
a (\ a' :: a
a' as :: m b
as -> (b -> m b -> m b) -> m b -> m b -> CutC m b -> m b
forall a (m :: * -> *) b.
(a -> m b -> m b) -> m b -> m b -> CutC m a -> m b
runCut b -> m b -> m b
cons m b
as m b
fail (a -> CutC m b
f a
a')) m b
nil m b
fail
  {-# INLINE (>>=) #-}

instance Fail.MonadFail m => Fail.MonadFail (CutC m) where
  fail :: String -> CutC m a
fail s :: String
s = m a -> CutC m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
Fail.fail String
s)
  {-# INLINE fail #-}

-- | A single fixpoint is shared between all branches.
instance MonadFix m => MonadFix (CutC m) where
  mfix :: (a -> CutC m a) -> CutC m a
mfix f :: a -> CutC m a
f = (forall b. (a -> m b -> m b) -> m b -> m b -> m b) -> CutC m a
forall (m :: * -> *) a.
(forall b. (a -> m b -> m b) -> m b -> m b -> m b) -> CutC m a
CutC ((forall b. (a -> m b -> m b) -> m b -> m b -> m b) -> CutC m a)
-> (forall b. (a -> m b -> m b) -> m b -> m b -> m b) -> CutC m a
forall a b. (a -> b) -> a -> b
$ \ cons :: a -> m b -> m b
cons nil :: m b
nil fail :: m b
fail -> (CutC Identity a -> m (CutC Identity a)) -> m (CutC Identity a)
forall (m :: * -> *) a. MonadFix m => (a -> m a) -> m a
mfix
    (CutC m a -> m (CutC Identity a)
forall a. CutC m a -> m (CutC Identity a)
toCut (CutC m a -> m (CutC Identity a))
-> (CutC Identity a -> CutC m a)
-> CutC Identity a
-> m (CutC Identity a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> CutC m a
f (a -> CutC m a)
-> (CutC Identity a -> a) -> CutC Identity a -> CutC m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identity a -> a
forall a. Identity a -> a
run (Identity a -> a)
-> (CutC Identity a -> Identity a) -> CutC Identity a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CutC Identity a -> Identity a
forall b. CutC Identity b -> Identity b
fromCut)
    m (CutC Identity a) -> (CutC Identity a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Identity (m b) -> m b
forall a. Identity a -> a
run (Identity (m b) -> m b)
-> (CutC Identity a -> Identity (m b)) -> CutC Identity a -> m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Identity (m b) -> Identity (m b))
-> Identity (m b)
-> Identity (m b)
-> CutC Identity a
-> Identity (m b)
forall a (m :: * -> *) b.
(a -> m b -> m b) -> m b -> m b -> CutC m a -> m b
runCut ((m b -> m b) -> Identity (m b) -> Identity (m b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((m b -> m b) -> Identity (m b) -> Identity (m b))
-> (a -> m b -> m b) -> a -> Identity (m b) -> Identity (m b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> m b -> m b
cons) (m b -> Identity (m b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure m b
nil) (m b -> Identity (m b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure m b
fail) where
    toCut :: CutC m a -> m (CutC Identity a)
toCut = (a -> m (CutC Identity a) -> m (CutC Identity a))
-> m (CutC Identity a)
-> m (CutC Identity a)
-> CutC m a
-> m (CutC Identity a)
forall a (m :: * -> *) b.
(a -> m b -> m b) -> m b -> m b -> CutC m a -> m b
runCut ((CutC Identity a -> CutC Identity a)
-> m (CutC Identity a) -> m (CutC Identity a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((CutC Identity a -> CutC Identity a)
 -> m (CutC Identity a) -> m (CutC Identity a))
-> (a -> CutC Identity a -> CutC Identity a)
-> a
-> m (CutC Identity a)
-> m (CutC Identity a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CutC Identity a -> CutC Identity a -> CutC Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>) (CutC Identity a -> CutC Identity a -> CutC Identity a)
-> (a -> CutC Identity a)
-> a
-> CutC Identity a
-> CutC Identity a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> CutC Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure) (CutC Identity a -> m (CutC Identity a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure CutC Identity a
forall (f :: * -> *) a. Alternative f => f a
empty) (CutC Identity a -> m (CutC Identity a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure CutC Identity a
forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has Cut sig m =>
m a
cutfail)
    fromCut :: CutC Identity b -> Identity b
fromCut = (b -> Identity b -> Identity b)
-> Identity b -> Identity b -> CutC Identity b -> Identity b
forall a (m :: * -> *) b.
(a -> m b -> m b) -> m b -> m b -> CutC m a -> m b
runCut b -> Identity b -> Identity b
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
(<$) (String -> Identity b
forall a. HasCallStack => String -> a
error "mfix CutC: empty") (String -> Identity b
forall a. HasCallStack => String -> a
error "mfix CutC: cutfail")
  {-# INLINE mfix #-}

instance MonadIO m => MonadIO (CutC m) where
  liftIO :: IO a -> CutC m a
liftIO io :: IO a
io = m a -> CutC m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO a
io)
  {-# INLINE liftIO #-}

instance MonadPlus (CutC m)

instance MonadTrans CutC where
  lift :: m a -> CutC m a
lift m :: m a
m = (forall b. (a -> m b -> m b) -> m b -> m b -> m b) -> CutC m a
forall (m :: * -> *) a.
(forall b. (a -> m b -> m b) -> m b -> m b -> m b) -> CutC m a
CutC (\ cons :: a -> m b -> m b
cons nil :: m b
nil _ -> m a
m m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (a -> m b -> m b) -> m b -> a -> m b
forall a b c. (a -> b -> c) -> b -> a -> c
flip a -> m b -> m b
cons m b
nil)
  {-# INLINE lift #-}

instance (Algebra sig m, Effect sig) => Algebra (Cut :+: NonDet :+: sig) (CutC m) where
  alg :: (:+:) Cut (NonDet :+: sig) (CutC m) a -> CutC m a
alg (L Cutfail)    = (forall b. (a -> m b -> m b) -> m b -> m b -> m b) -> CutC m a
forall (m :: * -> *) a.
(forall b. (a -> m b -> m b) -> m b -> m b -> m b) -> CutC m a
CutC ((forall b. (a -> m b -> m b) -> m b -> m b -> m b) -> CutC m a)
-> (forall b. (a -> m b -> m b) -> m b -> m b -> m b) -> CutC m a
forall a b. (a -> b) -> a -> b
$ \ _    _   fail :: m b
fail -> m b
fail
  alg (L (Call m :: CutC m a
m k :: a -> CutC m a
k)) = (forall b. (a -> m b -> m b) -> m b -> m b -> m b) -> CutC m a
forall (m :: * -> *) a.
(forall b. (a -> m b -> m b) -> m b -> m b -> m b) -> CutC m a
CutC ((forall b. (a -> m b -> m b) -> m b -> m b -> m b) -> CutC m a)
-> (forall b. (a -> m b -> m b) -> m b -> m b -> m b) -> CutC m a
forall a b. (a -> b) -> a -> b
$ \ cons :: a -> m b -> m b
cons nil :: m b
nil fail :: m b
fail -> (a -> m b -> m b) -> m b -> m b -> CutC m a -> m b
forall a (m :: * -> *) b.
(a -> m b -> m b) -> m b -> m b -> CutC m a -> m b
runCut (\ a :: a
a as :: m b
as -> (a -> m b -> m b) -> m b -> m b -> CutC m a -> m b
forall a (m :: * -> *) b.
(a -> m b -> m b) -> m b -> m b -> CutC m a -> m b
runCut a -> m b -> m b
cons m b
as m b
fail (a -> CutC m a
k a
a)) m b
nil m b
nil CutC m a
m
  alg (R (L (L Empty)))      = CutC m a
forall (f :: * -> *) a. Alternative f => f a
empty
  alg (R (L (R (Choose k :: Bool -> CutC m a
k)))) = Bool -> CutC m a
k Bool
True CutC m a -> CutC m a -> CutC m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Bool -> CutC m a
k Bool
False
  alg (R (R other :: sig (CutC m) a
other))          = (forall b. (a -> m b -> m b) -> m b -> m b -> m b) -> CutC m a
forall (m :: * -> *) a.
(forall b. (a -> m b -> m b) -> m b -> m b -> m b) -> CutC m a
CutC ((forall b. (a -> m b -> m b) -> m b -> m b -> m b) -> CutC m a)
-> (forall b. (a -> m b -> m b) -> m b -> m b -> m b) -> CutC m a
forall a b. (a -> b) -> a -> b
$ \ cons :: a -> m b -> m b
cons nil :: m b
nil fail :: m b
fail -> sig m (CutC Identity a) -> m (CutC Identity a)
forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Algebra sig m =>
sig m a -> m a
alg (CutC Identity ()
-> (forall x. CutC Identity (CutC m x) -> m (CutC Identity x))
-> sig (CutC m) a
-> sig m (CutC Identity a)
forall (sig :: (* -> *) -> * -> *) (ctx :: * -> *) (m :: * -> *)
       (n :: * -> *) a.
(Effect sig, Functor ctx, Monad m) =>
ctx ()
-> (forall x. ctx (m x) -> n (ctx x)) -> sig m a -> sig n (ctx a)
thread (() -> CutC Identity ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) forall x. CutC Identity (CutC m x) -> m (CutC Identity x)
forall (m :: * -> *) a.
Applicative m =>
CutC Identity (CutC m a) -> m (CutC Identity a)
dst sig (CutC m) a
other) m (CutC Identity a) -> (CutC Identity a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Identity (m b) -> m b
forall a. Identity a -> a
runIdentity (Identity (m b) -> m b)
-> (CutC Identity a -> Identity (m b)) -> CutC Identity a -> m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Identity (m b) -> Identity (m b))
-> Identity (m b)
-> Identity (m b)
-> CutC Identity a
-> Identity (m b)
forall a (m :: * -> *) b.
(a -> m b -> m b) -> m b -> m b -> CutC m a -> m b
runCut ((a -> m b -> m b) -> a -> Identity (m b) -> Identity (m b)
forall a b. Coercible a b => a -> b
coerce a -> m b -> m b
cons) (m b -> Identity (m b)
forall a b. Coercible a b => a -> b
coerce m b
nil) (m b -> Identity (m b)
forall a b. Coercible a b => a -> b
coerce m b
fail) where
    dst :: Applicative m => CutC Identity (CutC m a) -> m (CutC Identity a)
    dst :: CutC Identity (CutC m a) -> m (CutC Identity a)
dst = Identity (m (CutC Identity a)) -> m (CutC Identity a)
forall a. Identity a -> a
runIdentity (Identity (m (CutC Identity a)) -> m (CutC Identity a))
-> (CutC Identity (CutC m a) -> Identity (m (CutC Identity a)))
-> CutC Identity (CutC m a)
-> m (CutC Identity a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CutC m a
 -> Identity (m (CutC Identity a))
 -> Identity (m (CutC Identity a)))
-> Identity (m (CutC Identity a))
-> Identity (m (CutC Identity a))
-> CutC Identity (CutC m a)
-> Identity (m (CutC Identity a))
forall a (m :: * -> *) b.
(a -> m b -> m b) -> m b -> m b -> CutC m a -> m b
runCut ((m (CutC Identity a) -> m (CutC Identity a))
-> Identity (m (CutC Identity a)) -> Identity (m (CutC Identity a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((m (CutC Identity a) -> m (CutC Identity a))
 -> Identity (m (CutC Identity a))
 -> Identity (m (CutC Identity a)))
-> (CutC m a -> m (CutC Identity a) -> m (CutC Identity a))
-> CutC m a
-> Identity (m (CutC Identity a))
-> Identity (m (CutC Identity a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CutC Identity a -> CutC Identity a -> CutC Identity a)
-> m (CutC Identity a)
-> m (CutC Identity a)
-> m (CutC Identity a)
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 CutC Identity a -> CutC Identity a -> CutC Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>) (m (CutC Identity a) -> m (CutC Identity a) -> m (CutC Identity a))
-> (CutC m a -> m (CutC Identity a))
-> CutC m a
-> m (CutC Identity a)
-> m (CutC Identity a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> m (CutC Identity a) -> m (CutC Identity a))
-> m (CutC Identity a)
-> m (CutC Identity a)
-> CutC m a
-> m (CutC Identity a)
forall a (m :: * -> *) b.
(a -> m b -> m b) -> m b -> m b -> CutC m a -> m b
runCut ((CutC Identity a -> CutC Identity a)
-> m (CutC Identity a) -> m (CutC Identity a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((CutC Identity a -> CutC Identity a)
 -> m (CutC Identity a) -> m (CutC Identity a))
-> (a -> CutC Identity a -> CutC Identity a)
-> a
-> m (CutC Identity a)
-> m (CutC Identity a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CutC Identity a -> CutC Identity a -> CutC Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>) (CutC Identity a -> CutC Identity a -> CutC Identity a)
-> (a -> CutC Identity a)
-> a
-> CutC Identity a
-> CutC Identity a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> CutC Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure) (CutC Identity a -> m (CutC Identity a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure CutC Identity a
forall (f :: * -> *) a. Alternative f => f a
empty) (CutC Identity a -> m (CutC Identity a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure CutC Identity a
forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has Cut sig m =>
m a
cutfail)) (m (CutC Identity a) -> Identity (m (CutC Identity a))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CutC Identity a -> m (CutC Identity a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure CutC Identity a
forall (f :: * -> *) a. Alternative f => f a
empty)) (m (CutC Identity a) -> Identity (m (CutC Identity a))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CutC Identity a -> m (CutC Identity a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure CutC Identity a
forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has Cut sig m =>
m a
cutfail))
  {-# INLINE alg #-}