{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE UndecidableInstances #-}

{- | An effect modelling nondeterminism without failure (one or more successful results).

The 'Control.Effect.NonDet.NonDet' effect is the composition of 'Choose' and 'Empty'.

Predefined carriers:

* "Control.Carrier.Choose.Church".
* If 'Choose' is the last effect in a stack, it can be interpreted directly to a 'NonEmpty'.

@since 1.0.0.0
-}

module Control.Effect.Choose
( -- * Choose effect
  Choose(..)
, (<|>)
, optional
, many
, some
, some1
  -- * Choosing semigroup
, Choosing(..)
  -- * Re-exports
, Algebra
, Has
, run
) where

import           Control.Algebra
import qualified Control.Applicative as A
import           Control.Effect.Choose.Internal (Choose(..))
import           Control.Effect.Empty
import           Control.Monad (MonadPlus)
import           Control.Monad.Fail as Fail
import           Control.Monad.Fix
import           Control.Monad.IO.Class (MonadIO)
import           Control.Monad.IO.Unlift (MonadUnliftIO)
import           Control.Monad.Trans.Class (MonadTrans(..))
import           Control.Monad.Zip
import           Data.Bool (bool)
import           Data.List.NonEmpty (NonEmpty(..))
import qualified Data.Semigroup as S

-- | Nondeterministically choose between two computations.
--
-- @
-- (m '<|>' n) '>>=' k = (m '>>=' k) '<|>' (n '>>=' k)
-- @
-- @
-- (m '<|>' n) '<|>' o = m '<|>' (n '<|>' o)
-- @
-- @
-- 'empty' '<|>' m = m
-- @
-- @
-- m '<|>' 'empty' = m
-- @
--
-- @since 1.0.0.0
(<|>) :: Has Choose sig m => m a -> m a -> m a
m a
a <|> :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has Choose sig m =>
m a -> m a -> m a
<|> m a
b = forall (eff :: (* -> *) -> * -> *) (sig :: (* -> *) -> * -> *)
       (m :: * -> *) a.
(Member eff sig, Algebra sig m) =>
eff m a -> m a
send forall (m :: * -> *). Choose m Bool
Choose forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. a -> a -> Bool -> a
bool m a
b m a
a
{-# INLINE (<|>) #-}

infixl 3 <|>

-- | Select between 'Just' the result of an operation, and 'Nothing'.
--
-- @
-- 'optional' 'empty' = 'pure' 'Nothing'
-- @
-- @
-- 'optional' ('pure' a) = 'pure' ('Just' a)
-- @
--
-- @since 1.0.0.0
optional :: Has Choose sig m => m a -> m (Maybe a)
optional :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has Choose sig m =>
m a -> m (Maybe a)
optional m a
a = forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m a
a forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has Choose sig m =>
m a -> m a -> m a
<|> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
{-# INLINE optional #-}

-- | Zero or more.
--
-- @
-- 'many' m = 'some' m '<|>' 'pure' []
-- @
--
-- @since 1.0.0.0
many :: Has Choose sig m => m a -> m [a]
many :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has Choose sig m =>
m a -> m [a]
many m a
a = m [a]
go where go :: m [a]
go = (:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m a
a forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m [a]
go forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has Choose sig m =>
m a -> m a -> m a
<|> forall (f :: * -> *) a. Applicative f => a -> f a
pure []
{-# INLINE many #-}

-- | One or more.
--
-- @
-- 'some' m = (:) '<$>' m '<*>' 'many' m
-- @
--
-- @since 1.0.0.0
some :: Has Choose sig m => m a -> m [a]
some :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has Choose sig m =>
m a -> m [a]
some m a
a = (:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m a
a forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has Choose sig m =>
m a -> m [a]
many m a
a
{-# INLINE some #-}

-- | One or more, returning a 'NonEmpty' list of the results.
--
-- @
-- 'some1' m = (':|') '<$>' m '<*>' 'many' m
-- @
--
-- @since 1.0.0.0
some1 :: Has Choose sig m => m a -> m (NonEmpty a)
some1 :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has Choose sig m =>
m a -> m (NonEmpty a)
some1 m a
a = forall a. a -> [a] -> NonEmpty a
(:|) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m a
a forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has Choose sig m =>
m a -> m [a]
many m a
a
{-# INLINE some1 #-}


-- | @since 1.0.0.0
newtype Choosing m a = Choosing { forall (m :: * -> *) a. Choosing m a -> m a
getChoosing :: m a }
  deriving (Algebra sig, forall a. a -> Choosing m a
forall a b. Choosing m a -> Choosing m b -> Choosing m a
forall a b. Choosing m a -> Choosing m b -> Choosing m b
forall a b. Choosing m (a -> b) -> Choosing m a -> Choosing m b
forall a b c.
(a -> b -> c) -> Choosing m a -> Choosing m b -> Choosing m c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
forall {m :: * -> *}. Applicative m => Functor (Choosing m)
forall (m :: * -> *) a. Applicative m => a -> Choosing m a
forall (m :: * -> *) a b.
Applicative m =>
Choosing m a -> Choosing m b -> Choosing m a
forall (m :: * -> *) a b.
Applicative m =>
Choosing m a -> Choosing m b -> Choosing m b
forall (m :: * -> *) a b.
Applicative m =>
Choosing m (a -> b) -> Choosing m a -> Choosing m b
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c) -> Choosing m a -> Choosing m b -> Choosing m c
<* :: forall a b. Choosing m a -> Choosing m b -> Choosing m a
$c<* :: forall (m :: * -> *) a b.
Applicative m =>
Choosing m a -> Choosing m b -> Choosing m a
*> :: forall a b. Choosing m a -> Choosing m b -> Choosing m b
$c*> :: forall (m :: * -> *) a b.
Applicative m =>
Choosing m a -> Choosing m b -> Choosing m b
liftA2 :: forall a b c.
(a -> b -> c) -> Choosing m a -> Choosing m b -> Choosing m c
$cliftA2 :: forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c) -> Choosing m a -> Choosing m b -> Choosing m c
<*> :: forall a b. Choosing m (a -> b) -> Choosing m a -> Choosing m b
$c<*> :: forall (m :: * -> *) a b.
Applicative m =>
Choosing m (a -> b) -> Choosing m a -> Choosing m b
pure :: forall a. a -> Choosing m a
$cpure :: forall (m :: * -> *) a. Applicative m => a -> Choosing m a
Applicative, forall a. Eq a => a -> Choosing m a -> Bool
forall a. Num a => Choosing m a -> a
forall a. Ord a => Choosing m a -> a
forall m. Monoid m => Choosing m m -> m
forall a. Choosing m a -> Bool
forall a. Choosing m a -> Int
forall a. Choosing m a -> [a]
forall a. (a -> a -> a) -> Choosing m a -> a
forall m a. Monoid m => (a -> m) -> Choosing m a -> m
forall b a. (b -> a -> b) -> b -> Choosing m a -> b
forall a b. (a -> b -> b) -> b -> Choosing m a -> b
forall (m :: * -> *) a.
(Foldable m, Eq a) =>
a -> Choosing m a -> Bool
forall (m :: * -> *) a. (Foldable m, Num a) => Choosing m a -> a
forall (m :: * -> *) a. (Foldable m, Ord a) => Choosing m a -> a
forall (m :: * -> *) m. (Foldable m, Monoid m) => Choosing m m -> m
forall (m :: * -> *) a. Foldable m => Choosing m a -> Bool
forall (m :: * -> *) a. Foldable m => Choosing m a -> Int
forall (m :: * -> *) a. Foldable m => Choosing m a -> [a]
forall (m :: * -> *) a.
Foldable m =>
(a -> a -> a) -> Choosing m a -> a
forall (m :: * -> *) m a.
(Foldable m, Monoid m) =>
(a -> m) -> Choosing m a -> m
forall (m :: * -> *) b a.
Foldable m =>
(b -> a -> b) -> b -> Choosing m a -> b
forall (m :: * -> *) a b.
Foldable m =>
(a -> b -> b) -> b -> Choosing m a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: forall a. Num a => Choosing m a -> a
$cproduct :: forall (m :: * -> *) a. (Foldable m, Num a) => Choosing m a -> a
sum :: forall a. Num a => Choosing m a -> a
$csum :: forall (m :: * -> *) a. (Foldable m, Num a) => Choosing m a -> a
minimum :: forall a. Ord a => Choosing m a -> a
$cminimum :: forall (m :: * -> *) a. (Foldable m, Ord a) => Choosing m a -> a
maximum :: forall a. Ord a => Choosing m a -> a
$cmaximum :: forall (m :: * -> *) a. (Foldable m, Ord a) => Choosing m a -> a
elem :: forall a. Eq a => a -> Choosing m a -> Bool
$celem :: forall (m :: * -> *) a.
(Foldable m, Eq a) =>
a -> Choosing m a -> Bool
length :: forall a. Choosing m a -> Int
$clength :: forall (m :: * -> *) a. Foldable m => Choosing m a -> Int
null :: forall a. Choosing m a -> Bool
$cnull :: forall (m :: * -> *) a. Foldable m => Choosing m a -> Bool
toList :: forall a. Choosing m a -> [a]
$ctoList :: forall (m :: * -> *) a. Foldable m => Choosing m a -> [a]
foldl1 :: forall a. (a -> a -> a) -> Choosing m a -> a
$cfoldl1 :: forall (m :: * -> *) a.
Foldable m =>
(a -> a -> a) -> Choosing m a -> a
foldr1 :: forall a. (a -> a -> a) -> Choosing m a -> a
$cfoldr1 :: forall (m :: * -> *) a.
Foldable m =>
(a -> a -> a) -> Choosing m a -> a
foldl' :: forall b a. (b -> a -> b) -> b -> Choosing m a -> b
$cfoldl' :: forall (m :: * -> *) b a.
Foldable m =>
(b -> a -> b) -> b -> Choosing m a -> b
foldl :: forall b a. (b -> a -> b) -> b -> Choosing m a -> b
$cfoldl :: forall (m :: * -> *) b a.
Foldable m =>
(b -> a -> b) -> b -> Choosing m a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> Choosing m a -> b
$cfoldr' :: forall (m :: * -> *) a b.
Foldable m =>
(a -> b -> b) -> b -> Choosing m a -> b
foldr :: forall a b. (a -> b -> b) -> b -> Choosing m a -> b
$cfoldr :: forall (m :: * -> *) a b.
Foldable m =>
(a -> b -> b) -> b -> Choosing m a -> b
foldMap' :: forall m a. Monoid m => (a -> m) -> Choosing m a -> m
$cfoldMap' :: forall (m :: * -> *) m a.
(Foldable m, Monoid m) =>
(a -> m) -> Choosing m a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> Choosing m a -> m
$cfoldMap :: forall (m :: * -> *) m a.
(Foldable m, Monoid m) =>
(a -> m) -> Choosing m a -> m
fold :: forall m. Monoid m => Choosing m m -> m
$cfold :: forall (m :: * -> *) m. (Foldable m, Monoid m) => Choosing m m -> m
Foldable, forall a b. a -> Choosing m b -> Choosing m a
forall a b. (a -> b) -> Choosing m a -> Choosing m b
forall (m :: * -> *) a b.
Functor m =>
a -> Choosing m b -> Choosing m a
forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> Choosing m a -> Choosing m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> Choosing m b -> Choosing m a
$c<$ :: forall (m :: * -> *) a b.
Functor m =>
a -> Choosing m b -> Choosing m a
fmap :: forall a b. (a -> b) -> Choosing m a -> Choosing m b
$cfmap :: forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> Choosing m a -> Choosing m b
Functor, forall a. a -> Choosing m a
forall a b. Choosing m a -> Choosing m b -> Choosing m b
forall a b. Choosing m a -> (a -> Choosing m b) -> Choosing m b
forall {m :: * -> *}. Monad m => Applicative (Choosing m)
forall (m :: * -> *) a. Monad m => a -> Choosing m a
forall (m :: * -> *) a b.
Monad m =>
Choosing m a -> Choosing m b -> Choosing m b
forall (m :: * -> *) a b.
Monad m =>
Choosing m a -> (a -> Choosing m b) -> Choosing m b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: forall a. a -> Choosing m a
$creturn :: forall (m :: * -> *) a. Monad m => a -> Choosing m a
>> :: forall a b. Choosing m a -> Choosing m b -> Choosing m b
$c>> :: forall (m :: * -> *) a b.
Monad m =>
Choosing m a -> Choosing m b -> Choosing m b
>>= :: forall a b. Choosing m a -> (a -> Choosing m b) -> Choosing m b
$c>>= :: forall (m :: * -> *) a b.
Monad m =>
Choosing m a -> (a -> Choosing m b) -> Choosing m b
Monad, forall a. String -> Choosing m a
forall (m :: * -> *).
Monad m -> (forall a. String -> m a) -> MonadFail m
forall {m :: * -> *}. MonadFail m => Monad (Choosing m)
forall (m :: * -> *) a. MonadFail m => String -> Choosing m a
fail :: forall a. String -> Choosing m a
$cfail :: forall (m :: * -> *) a. MonadFail m => String -> Choosing m a
Fail.MonadFail, forall a. (a -> Choosing m a) -> Choosing m a
forall (m :: * -> *).
Monad m -> (forall a. (a -> m a) -> m a) -> MonadFix m
forall {m :: * -> *}. MonadFix m => Monad (Choosing m)
forall (m :: * -> *) a.
MonadFix m =>
(a -> Choosing m a) -> Choosing m a
mfix :: forall a. (a -> Choosing m a) -> Choosing m a
$cmfix :: forall (m :: * -> *) a.
MonadFix m =>
(a -> Choosing m a) -> Choosing m a
MonadFix, forall a. IO a -> Choosing m a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
forall {m :: * -> *}. MonadIO m => Monad (Choosing m)
forall (m :: * -> *) a. MonadIO m => IO a -> Choosing m a
liftIO :: forall a. IO a -> Choosing m a
$cliftIO :: forall (m :: * -> *) a. MonadIO m => IO a -> Choosing m a
MonadIO, forall b.
((forall a. Choosing m a -> IO a) -> IO b) -> Choosing m b
forall (m :: * -> *).
MonadIO m
-> (forall b. ((forall a. m a -> IO a) -> IO b) -> m b)
-> MonadUnliftIO m
forall {m :: * -> *}. MonadUnliftIO m => MonadIO (Choosing m)
forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. Choosing m a -> IO a) -> IO b) -> Choosing m b
withRunInIO :: forall b.
((forall a. Choosing m a -> IO a) -> IO b) -> Choosing m b
$cwithRunInIO :: forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. Choosing m a -> IO a) -> IO b) -> Choosing m b
MonadUnliftIO, forall a b. Choosing m a -> Choosing m b -> Choosing m (a, b)
forall a b. Choosing m (a, b) -> (Choosing m a, Choosing m b)
forall a b c.
(a -> b -> c) -> Choosing m a -> Choosing m b -> Choosing m c
forall (m :: * -> *).
Monad m
-> (forall a b. m a -> m b -> m (a, b))
-> (forall a b c. (a -> b -> c) -> m a -> m b -> m c)
-> (forall a b. m (a, b) -> (m a, m b))
-> MonadZip m
forall {m :: * -> *}. MonadZip m => Monad (Choosing m)
forall (m :: * -> *) a b.
MonadZip m =>
Choosing m a -> Choosing m b -> Choosing m (a, b)
forall (m :: * -> *) a b.
MonadZip m =>
Choosing m (a, b) -> (Choosing m a, Choosing m b)
forall (m :: * -> *) a b c.
MonadZip m =>
(a -> b -> c) -> Choosing m a -> Choosing m b -> Choosing m c
munzip :: forall a b. Choosing m (a, b) -> (Choosing m a, Choosing m b)
$cmunzip :: forall (m :: * -> *) a b.
MonadZip m =>
Choosing m (a, b) -> (Choosing m a, Choosing m b)
mzipWith :: forall a b c.
(a -> b -> c) -> Choosing m a -> Choosing m b -> Choosing m c
$cmzipWith :: forall (m :: * -> *) a b c.
MonadZip m =>
(a -> b -> c) -> Choosing m a -> Choosing m b -> Choosing m c
mzip :: forall a b. Choosing m a -> Choosing m b -> Choosing m (a, b)
$cmzip :: forall (m :: * -> *) a b.
MonadZip m =>
Choosing m a -> Choosing m b -> Choosing m (a, b)
MonadZip)

instance Has Choose sig m => S.Semigroup (Choosing m a) where
  Choosing m a
m1 <> :: Choosing m a -> Choosing m a -> Choosing m a
<> Choosing m a
m2 = forall (m :: * -> *) a. m a -> Choosing m a
Choosing (m a
m1 forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has Choose sig m =>
m a -> m a -> m a
<|> m a
m2)
  {-# INLINE (<>) #-}

instance (Has Choose sig m, Has Empty sig m) => Monoid (Choosing m a) where
  mempty :: Choosing m a
mempty = forall (m :: * -> *) a. m a -> Choosing m a
Choosing forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has Empty sig m =>
m a
empty
  {-# INLINE mempty #-}

  mappend :: Choosing m a -> Choosing m a -> Choosing m a
mappend = forall a. Semigroup a => a -> a -> a
(S.<>)
  {-# INLINE mappend #-}

instance (Has Choose sig m, Has Empty sig m) => A.Alternative (Choosing m) where
  empty :: forall a. Choosing m a
empty = forall a. Monoid a => a
mempty
  {-# INLINE empty #-}

  <|> :: forall a. Choosing m a -> Choosing m a -> Choosing m a
(<|>) = forall a. Monoid a => a -> a -> a
mappend
  {-# INLINE (<|>) #-}

instance (Has Choose sig m, Has Empty sig m) => MonadPlus (Choosing m)

instance MonadTrans Choosing where
  lift :: forall (m :: * -> *) a. Monad m => m a -> Choosing m a
lift = forall (m :: * -> *) a. m a -> Choosing m a
Choosing
  {-# INLINE lift #-}

instance Traversable m => Traversable (Choosing m) where
  sequenceA :: forall (f :: * -> *) a.
Applicative f =>
Choosing m (f a) -> f (Choosing m a)
sequenceA (Choosing m (f a)
m) = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (m :: * -> *) a. m a -> Choosing m a
Choosing (forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA m (f a)
m)
  {-# INLINE sequenceA #-}

  traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Choosing m a -> f (Choosing m b)
traverse a -> f b
f (Choosing m a
m) = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (m :: * -> *) a. m a -> Choosing m a
Choosing (forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> f b
f m a
m)
  {-# INLINE traverse #-}

  sequence :: forall (m :: * -> *) a.
Monad m =>
Choosing m (m a) -> m (Choosing m a)
sequence (Choosing m (m a)
m) = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (m :: * -> *) a. m a -> Choosing m a
Choosing (forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence m (m a)
m)
  {-# INLINE sequence #-}

  mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Choosing m a -> m (Choosing m b)
mapM a -> m b
f (Choosing m a
m) = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (m :: * -> *) a. m a -> Choosing m a
Choosing (forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM a -> m b
f m a
m)
  {-# INLINE mapM #-}