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

{- | Provides 'NonDetC', a carrier for 'NonDet' effects providing choice and failure.

Under the hood, it uses a Church-encoded structure and a binary tree to prevent the problems associated with a naïve list-based implementation.

@since 1.0.0.0
-}

module Control.Carrier.NonDet.Church
( -- * NonDet carrier
  runNonDet
, runNonDetA
, runNonDetM
, NonDetC(..)
  -- * NonDet effects
, module Control.Effect.NonDet
) where

import Control.Algebra
import Control.Applicative (liftA2)
import Control.Effect.NonDet
import 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 'NonDet' effect, using the provided functions to interpret choice, leaf results, and failure.
--
-- @
-- runNonDet fork leaf nil ('pure' a '<|>' 'empty') = leaf a \`fork\` nil
-- @
--
-- @since 1.0.0.0
runNonDet
  :: (m b -> m b -> m b) -- ^ Handles choice ('<|>')
  -> (a -> m b)          -- ^ Handles embedding results ('pure')
  -> m b                 -- ^ Handles failure ('empty')
  -> NonDetC m a         -- ^ A nondeterministic computation to execute
  -> m b
runNonDet :: (m b -> m b -> m b) -> (a -> m b) -> m b -> NonDetC m a -> m b
runNonDet m b -> m b -> m b
fork a -> m b
leaf m b
nil (NonDetC forall b. (m b -> m b -> m b) -> (a -> m b) -> m b -> m b
m) = (m b -> m b -> m b) -> (a -> m b) -> m b -> m b
forall b. (m b -> m b -> m b) -> (a -> m b) -> m b -> m b
m m b -> m b -> m b
fork a -> m b
leaf m b
nil
{-# INLINE runNonDet #-}

-- | Run a 'NonDet' effect, collecting all branches’ results into an 'Alternative' functor.
--
-- Using @[]@ as the 'Alternative' functor will produce all results, while 'Maybe' will return only the first. However, unless used with 'Control.Effect.Cull.cull', this will still enumerate the entire search space before returning, meaning that it will diverge for infinite search spaces, even when using 'Maybe'.
--
-- @
-- 'runNonDetA' ('pure' a) = 'pure' [a]
-- @
-- @
-- 'runNonDetA' ('pure' a) = 'pure' ('Just' a)
-- @
--
-- @since 1.0.0.0
runNonDetA :: (Alternative f, Applicative m) => NonDetC m a -> m (f a)
runNonDetA :: NonDetC m a -> m (f a)
runNonDetA = (m (f a) -> m (f a) -> m (f a))
-> (a -> m (f a)) -> m (f a) -> NonDetC m a -> m (f a)
forall (m :: * -> *) b a.
(m b -> m b -> m b) -> (a -> m b) -> m b -> NonDetC m a -> m b
runNonDet ((f a -> f a -> f a) -> m (f a) -> m (f a) -> m (f a)
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 f a -> f a -> f a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>)) (f a -> m (f a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (f a -> m (f a)) -> (a -> f a) -> a -> m (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)
{-# INLINE runNonDetA #-}

-- | Run a 'NonDet' effect, mapping results into a 'Monoid'.
--
-- @since 1.0.0.0
runNonDetM :: (Applicative m, Monoid b) => (a -> b) -> NonDetC m a -> m b
runNonDetM :: (a -> b) -> NonDetC m a -> m b
runNonDetM a -> b
leaf = (m b -> m b -> m b) -> (a -> m b) -> m b -> NonDetC m a -> m b
forall (m :: * -> *) b a.
(m b -> m b -> m b) -> (a -> m b) -> m b -> NonDetC m a -> m b
runNonDet ((b -> b -> b) -> m b -> m b -> m b
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 b -> b -> b
forall a. Monoid a => a -> a -> a
mappend) (b -> m b
forall (f :: * -> *) a. Applicative f => a -> f a
pure (b -> m b) -> (a -> b) -> a -> m 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)
{-# INLINE runNonDetM #-}

-- | A carrier for 'NonDet' effects based on Ralf Hinze’s design described in [Deriving Backtracking Monad Transformers](https://www.cs.ox.ac.uk/ralf.hinze/publications/#P12).
--
-- @since 1.0.0.0
newtype NonDetC m a = NonDetC (forall b . (m b -> m b -> m b) -> (a -> m b) -> m b -> m b)
  deriving (a -> NonDetC m b -> NonDetC m a
(a -> b) -> NonDetC m a -> NonDetC m b
(forall a b. (a -> b) -> NonDetC m a -> NonDetC m b)
-> (forall a b. a -> NonDetC m b -> NonDetC m a)
-> Functor (NonDetC m)
forall a b. a -> NonDetC m b -> NonDetC m a
forall a b. (a -> b) -> NonDetC m a -> NonDetC 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 -> NonDetC m b -> NonDetC m a
forall (m :: * -> *) a b. (a -> b) -> NonDetC m a -> NonDetC m b
<$ :: a -> NonDetC m b -> NonDetC m a
$c<$ :: forall (m :: * -> *) a b. a -> NonDetC m b -> NonDetC m a
fmap :: (a -> b) -> NonDetC m a -> NonDetC m b
$cfmap :: forall (m :: * -> *) a b. (a -> b) -> NonDetC m a -> NonDetC m b
Functor)

instance Applicative (NonDetC m) where
  pure :: a -> NonDetC m a
pure a
a = (forall b. (m b -> m b -> m b) -> (a -> m b) -> m b -> m b)
-> NonDetC m a
forall (m :: * -> *) a.
(forall b. (m b -> m b -> m b) -> (a -> m b) -> m b -> m b)
-> NonDetC m a
NonDetC (\ m b -> m b -> m b
_ a -> m b
leaf m b
_ -> a -> m b
leaf a
a)
  {-# INLINE pure #-}

  NonDetC forall b. (m b -> m b -> m b) -> ((a -> b) -> m b) -> m b -> m b
f <*> :: NonDetC m (a -> b) -> NonDetC m a -> NonDetC m b
<*> NonDetC forall b. (m b -> m b -> m b) -> (a -> m b) -> m b -> m b
a = (forall b. (m b -> m b -> m b) -> (b -> m b) -> m b -> m b)
-> NonDetC m b
forall (m :: * -> *) a.
(forall b. (m b -> m b -> m b) -> (a -> m b) -> m b -> m b)
-> NonDetC m a
NonDetC ((forall b. (m b -> m b -> m b) -> (b -> m b) -> m b -> m b)
 -> NonDetC m b)
-> (forall b. (m b -> m b -> m b) -> (b -> m b) -> m b -> m b)
-> NonDetC m b
forall a b. (a -> b) -> a -> b
$ \ m b -> m b -> m b
fork b -> m b
leaf m b
nil ->
    (m b -> m b -> m b) -> ((a -> b) -> m b) -> m b -> m b
forall b. (m b -> m b -> m b) -> ((a -> b) -> m b) -> m b -> m b
f m b -> m b -> m b
fork (\ a -> b
f' -> (m b -> m b -> m b) -> (a -> m b) -> m b -> m b
forall b. (m b -> m b -> m b) -> (a -> m b) -> m b -> m b
a m b -> m b -> m b
fork (b -> m b
leaf (b -> m b) -> (a -> b) -> a -> m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f') m b
nil) m b
nil
  {-# INLINE (<*>) #-}

instance Alternative (NonDetC m) where
  empty :: NonDetC m a
empty = (forall b. (m b -> m b -> m b) -> (a -> m b) -> m b -> m b)
-> NonDetC m a
forall (m :: * -> *) a.
(forall b. (m b -> m b -> m b) -> (a -> m b) -> m b -> m b)
-> NonDetC m a
NonDetC (\ m b -> m b -> m b
_ a -> m b
_ m b
nil -> m b
nil)
  {-# INLINE empty #-}

  NonDetC forall b. (m b -> m b -> m b) -> (a -> m b) -> m b -> m b
l <|> :: NonDetC m a -> NonDetC m a -> NonDetC m a
<|> NonDetC forall b. (m b -> m b -> m b) -> (a -> m b) -> m b -> m b
r = (forall b. (m b -> m b -> m b) -> (a -> m b) -> m b -> m b)
-> NonDetC m a
forall (m :: * -> *) a.
(forall b. (m b -> m b -> m b) -> (a -> m b) -> m b -> m b)
-> NonDetC m a
NonDetC ((forall b. (m b -> m b -> m b) -> (a -> m b) -> m b -> m b)
 -> NonDetC m a)
-> (forall b. (m b -> m b -> m b) -> (a -> m b) -> m b -> m b)
-> NonDetC m a
forall a b. (a -> b) -> a -> b
$ \ m b -> m b -> m b
fork a -> m b
leaf m b
nil ->
    (m b -> m b -> m b) -> (a -> m b) -> m b -> m b
forall b. (m b -> m b -> m b) -> (a -> m b) -> m b -> m b
l m b -> m b -> m b
fork a -> m b
leaf m b
nil m b -> m b -> m b
`fork` (m b -> m b -> m b) -> (a -> m b) -> m b -> m b
forall b. (m b -> m b -> m b) -> (a -> m b) -> m b -> m b
r m b -> m b -> m b
fork a -> m b
leaf m b
nil
  {-# INLINE (<|>) #-}

instance Monad (NonDetC m) where
  NonDetC forall b. (m b -> m b -> m b) -> (a -> m b) -> m b -> m b
a >>= :: NonDetC m a -> (a -> NonDetC m b) -> NonDetC m b
>>= a -> NonDetC m b
f = (forall b. (m b -> m b -> m b) -> (b -> m b) -> m b -> m b)
-> NonDetC m b
forall (m :: * -> *) a.
(forall b. (m b -> m b -> m b) -> (a -> m b) -> m b -> m b)
-> NonDetC m a
NonDetC ((forall b. (m b -> m b -> m b) -> (b -> m b) -> m b -> m b)
 -> NonDetC m b)
-> (forall b. (m b -> m b -> m b) -> (b -> m b) -> m b -> m b)
-> NonDetC m b
forall a b. (a -> b) -> a -> b
$ \ m b -> m b -> m b
fork b -> m b
leaf m b
nil ->
    (m b -> m b -> m b) -> (a -> m b) -> m b -> m b
forall b. (m b -> m b -> m b) -> (a -> m b) -> m b -> m b
a m b -> m b -> m b
fork ((m b -> m b -> m b) -> (b -> m b) -> m b -> NonDetC m b -> m b
forall (m :: * -> *) b a.
(m b -> m b -> m b) -> (a -> m b) -> m b -> NonDetC m a -> m b
runNonDet m b -> m b -> m b
fork b -> m b
leaf m b
nil (NonDetC m b -> m b) -> (a -> NonDetC m b) -> a -> m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> NonDetC m b
f) m b
nil
  {-# INLINE (>>=) #-}

instance Fail.MonadFail m => Fail.MonadFail (NonDetC m) where
  fail :: String -> NonDetC m a
fail String
s = m a -> NonDetC 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 #-}

-- | Separate fixpoints are computed for each branch.
instance MonadFix m => MonadFix (NonDetC m) where
  mfix :: (a -> NonDetC m a) -> NonDetC m a
mfix a -> NonDetC m a
f = (forall b. (m b -> m b -> m b) -> (a -> m b) -> m b -> m b)
-> NonDetC m a
forall (m :: * -> *) a.
(forall b. (m b -> m b -> m b) -> (a -> m b) -> m b -> m b)
-> NonDetC m a
NonDetC ((forall b. (m b -> m b -> m b) -> (a -> m b) -> m b -> m b)
 -> NonDetC m a)
-> (forall b. (m b -> m b -> m b) -> (a -> m b) -> m b -> m b)
-> NonDetC m a
forall a b. (a -> b) -> a -> b
$ \ m b -> m b -> m b
fork a -> m b
leaf m b
nil ->
    ([a] -> m [a]) -> m [a]
forall (m :: * -> *) a. MonadFix m => (a -> m a) -> m a
mfix (NonDetC m a -> m [a]
forall (f :: * -> *) (m :: * -> *) a.
(Alternative f, Applicative m) =>
NonDetC m a -> m (f a)
runNonDetA (NonDetC m a -> m [a]) -> ([a] -> NonDetC m a) -> [a] -> m [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> NonDetC m a
f (a -> NonDetC m a) -> ([a] -> a) -> [a] -> NonDetC m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> a
forall a. [a] -> a
head)
    m [a] -> ([a] -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (m b -> m b -> m b) -> (a -> m b) -> m b -> NonDetC m a -> m b
forall (m :: * -> *) b a.
(m b -> m b -> m b) -> (a -> m b) -> m b -> NonDetC m a -> m b
runNonDet m b -> m b -> m b
fork a -> m b
leaf m b
nil (NonDetC m a -> m b) -> ([a] -> NonDetC m a) -> [a] -> m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> NonDetC m a -> NonDetC m a)
-> NonDetC m a -> [a] -> NonDetC m a
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr
      (\ a
a NonDetC m a
_ -> a -> NonDetC m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a NonDetC m a -> NonDetC m a -> NonDetC m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (a -> NonDetC m a) -> NonDetC m a
forall (m :: * -> *) a. MonadFix m => (a -> m a) -> m a
mfix (m [a] -> NonDetC m a
forall (m :: * -> *) (t :: * -> *) a.
(Monad m, Foldable t) =>
m (t a) -> NonDetC m a
liftAll (m [a] -> NonDetC m a) -> (a -> m [a]) -> a -> NonDetC m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([a] -> [a]) -> m [a] -> m [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [a] -> [a]
forall a. [a] -> [a]
tail (m [a] -> m [a]) -> (a -> m [a]) -> a -> m [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonDetC m a -> m [a]
forall (f :: * -> *) (m :: * -> *) a.
(Alternative f, Applicative m) =>
NonDetC m a -> m (f a)
runNonDetA (NonDetC m a -> m [a]) -> (a -> NonDetC m a) -> a -> m [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> NonDetC m a
f))
      NonDetC m a
forall (f :: * -> *) a. Alternative f => f a
empty where
    liftAll :: m (t a) -> NonDetC m a
liftAll m (t a)
m = (forall b. (m b -> m b -> m b) -> (a -> m b) -> m b -> m b)
-> NonDetC m a
forall (m :: * -> *) a.
(forall b. (m b -> m b -> m b) -> (a -> m b) -> m b -> m b)
-> NonDetC m a
NonDetC ((forall b. (m b -> m b -> m b) -> (a -> m b) -> m b -> m b)
 -> NonDetC m a)
-> (forall b. (m b -> m b -> m b) -> (a -> m b) -> m b -> m b)
-> NonDetC m a
forall a b. (a -> b) -> a -> b
$ \ m b -> m b -> m b
fork a -> m b
leaf m b
nil -> m (t a)
m m (t a) -> (t 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 -> t a -> m b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (m b -> m b -> m b
fork (m b -> m b -> m b) -> (a -> m b) -> a -> m b -> m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> m b
leaf) m b
nil
  {-# INLINE mfix #-}

instance MonadIO m => MonadIO (NonDetC m) where
  liftIO :: IO a -> NonDetC m a
liftIO IO a
io = m a -> NonDetC 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 (NonDetC m)

instance MonadTrans NonDetC where
  lift :: m a -> NonDetC m a
lift m a
m = (forall b. (m b -> m b -> m b) -> (a -> m b) -> m b -> m b)
-> NonDetC m a
forall (m :: * -> *) a.
(forall b. (m b -> m b -> m b) -> (a -> m b) -> m b -> m b)
-> NonDetC m a
NonDetC (\ m b -> m b -> m b
_ a -> m b
leaf m b
_ -> 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
leaf)
  {-# INLINE lift #-}

instance Algebra sig m => Algebra (NonDet :+: sig) (NonDetC m) where
  alg :: Handler ctx n (NonDetC m)
-> (:+:) NonDet sig n a -> ctx () -> NonDetC m (ctx a)
alg Handler ctx n (NonDetC m)
hdl (:+:) NonDet sig n a
sig ctx ()
ctx = (forall b. (m b -> m b -> m b) -> (ctx a -> m b) -> m b -> m b)
-> NonDetC m (ctx a)
forall (m :: * -> *) a.
(forall b. (m b -> m b -> m b) -> (a -> m b) -> m b -> m b)
-> NonDetC m a
NonDetC ((forall b. (m b -> m b -> m b) -> (ctx a -> m b) -> m b -> m b)
 -> NonDetC m (ctx a))
-> (forall b. (m b -> m b -> m b) -> (ctx a -> m b) -> m b -> m b)
-> NonDetC m (ctx a)
forall a b. (a -> b) -> a -> b
$ \ m b -> m b -> m b
fork ctx a -> m b
leaf m b
nil -> case (:+:) NonDet sig n a
sig of
    L (L Empty n a
Empty)  -> m b
nil
    L (R Choose n a
Choose) -> ctx a -> m b
leaf (Bool
True Bool -> ctx () -> ctx Bool
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ctx ()
ctx) m b -> m b -> m b
`fork` ctx a -> m b
leaf (Bool
False Bool -> ctx () -> ctx Bool
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ctx ()
ctx)
    R sig n a
other      -> Handler (Compose (NonDetC Identity) ctx) n m
-> sig n a
-> NonDetC Identity (ctx ())
-> m (NonDetC Identity (ctx a))
forall (ctx1 :: * -> *) (ctx2 :: * -> *)
       (sig :: (* -> *) -> * -> *) (m :: * -> *) (n :: * -> *) a.
(Functor ctx1, Functor ctx2, Algebra sig m) =>
Handler (Compose ctx1 ctx2) n m
-> sig n a -> ctx1 (ctx2 ()) -> m (ctx1 (ctx2 a))
thread (forall x. NonDetC Identity (NonDetC m x) -> m (NonDetC Identity x)
forall (m :: * -> *) a.
Applicative m =>
NonDetC Identity (NonDetC m a) -> m (NonDetC Identity a)
dst (forall x.
 NonDetC Identity (NonDetC m x) -> m (NonDetC Identity x))
-> Handler ctx n (NonDetC m)
-> Handler (Compose (NonDetC Identity) ctx) n m
forall (n :: * -> *) (ctx1 :: * -> *) (m :: * -> *)
       (ctx2 :: * -> *) (l :: * -> *).
(Functor n, Functor ctx1) =>
Handler ctx1 m n
-> Handler ctx2 l m -> Handler (Compose ctx1 ctx2) l n
~<~ Handler ctx n (NonDetC m)
hdl) sig n a
other (ctx () -> NonDetC Identity (ctx ())
forall (f :: * -> *) a. Applicative f => a -> f a
pure ctx ()
ctx) m (NonDetC Identity (ctx a))
-> (NonDetC Identity (ctx 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)
-> (NonDetC Identity (ctx a) -> Identity (m b))
-> NonDetC Identity (ctx a)
-> m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Identity (m b) -> Identity (m b) -> Identity (m b))
-> (ctx a -> Identity (m b))
-> Identity (m b)
-> NonDetC Identity (ctx a)
-> Identity (m b)
forall (m :: * -> *) b a.
(m b -> m b -> m b) -> (a -> m b) -> m b -> NonDetC m a -> m b
runNonDet ((m b -> m b -> m b)
-> Identity (m b) -> Identity (m b) -> Identity (m b)
coerce m b -> m b -> m b
fork) ((ctx a -> m b) -> ctx a -> Identity (m b)
coerce ctx a -> m b
leaf) (m b -> Identity (m b)
coerce m b
nil)
    where
    dst :: Applicative m => NonDetC Identity (NonDetC m a) -> m (NonDetC Identity a)
    dst :: NonDetC Identity (NonDetC m a) -> m (NonDetC Identity a)
dst = Identity (m (NonDetC Identity a)) -> m (NonDetC Identity a)
forall a. Identity a -> a
run (Identity (m (NonDetC Identity a)) -> m (NonDetC Identity a))
-> (NonDetC Identity (NonDetC m a)
    -> Identity (m (NonDetC Identity a)))
-> NonDetC Identity (NonDetC m a)
-> m (NonDetC Identity a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Identity (m (NonDetC Identity a))
 -> Identity (m (NonDetC Identity a))
 -> Identity (m (NonDetC Identity a)))
-> (NonDetC m a -> Identity (m (NonDetC Identity a)))
-> Identity (m (NonDetC Identity a))
-> NonDetC Identity (NonDetC m a)
-> Identity (m (NonDetC Identity a))
forall (m :: * -> *) b a.
(m b -> m b -> m b) -> (a -> m b) -> m b -> NonDetC m a -> m b
runNonDet ((m (NonDetC Identity a)
 -> m (NonDetC Identity a) -> m (NonDetC Identity a))
-> Identity (m (NonDetC Identity a))
-> Identity (m (NonDetC Identity a))
-> Identity (m (NonDetC Identity a))
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 ((NonDetC Identity a -> NonDetC Identity a -> NonDetC Identity a)
-> m (NonDetC Identity a)
-> m (NonDetC Identity a)
-> m (NonDetC Identity a)
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 NonDetC Identity a -> NonDetC Identity a -> NonDetC Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>))) (m (NonDetC Identity a) -> Identity (m (NonDetC Identity a))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (m (NonDetC Identity a) -> Identity (m (NonDetC Identity a)))
-> (NonDetC m a -> m (NonDetC Identity a))
-> NonDetC m a
-> Identity (m (NonDetC Identity a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonDetC m a -> m (NonDetC Identity a)
forall (f :: * -> *) (m :: * -> *) a.
(Alternative f, Applicative m) =>
NonDetC m a -> m (f a)
runNonDetA) (m (NonDetC Identity a) -> Identity (m (NonDetC Identity a))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NonDetC Identity a -> m (NonDetC Identity a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure NonDetC Identity a
forall (f :: * -> *) a. Alternative f => f a
empty))
  {-# INLINE alg #-}