-- | Provider of the t'Control.Applicative.Alternative' and
-- t'Control.Monad.MonadPlus' instance for 'Eff'.
module Effectful.NonDet
  ( -- * Effect
    NonDet(..)
  , OnEmptyPolicy(..)

    -- ** Handlers
  , runNonDet

  -- * Operations
  , emptyEff
  , plusEff
  , sumEff

    -- * Re-exports
  , Alternative(..)
  , HasCallStack
  , CallStack
  , getCallStack
  , prettyCallStack
  ) where

import Control.Applicative
import Data.IORef.Strict
import GHC.Generics
import GHC.Stack

import Effectful
import Effectful.Dispatch.Dynamic
import Effectful.Dispatch.Static
import Effectful.Dispatch.Static.Primitive
import Effectful.Error.Static
import Effectful.Internal.Env qualified as I
import Effectful.Internal.Monad (NonDet(..))

-- | Policy of dealing with modifications to __thread local__ state in the
-- environment in branches that end up calling the 'Empty' operation.
--
-- /Note:/ 'OnEmptyKeep' is faster as there is no need to back up the
-- environment on each call to ':<|>:'.
--
-- @since 2.2.0.0
data OnEmptyPolicy
  = OnEmptyKeep
  -- ^ Keep modifications on 'Empty'.
  | OnEmptyRollback
  -- ^ Rollback modifications on 'Empty'.
  --
  -- /Note:/ state modifications are rolled back on 'Empty' only. In particular,
  -- they are __not__ rolled back on exceptions.
  deriving stock (OnEmptyPolicy -> OnEmptyPolicy -> Bool
(OnEmptyPolicy -> OnEmptyPolicy -> Bool)
-> (OnEmptyPolicy -> OnEmptyPolicy -> Bool) -> Eq OnEmptyPolicy
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: OnEmptyPolicy -> OnEmptyPolicy -> Bool
== :: OnEmptyPolicy -> OnEmptyPolicy -> Bool
$c/= :: OnEmptyPolicy -> OnEmptyPolicy -> Bool
/= :: OnEmptyPolicy -> OnEmptyPolicy -> Bool
Eq, (forall x. OnEmptyPolicy -> Rep OnEmptyPolicy x)
-> (forall x. Rep OnEmptyPolicy x -> OnEmptyPolicy)
-> Generic OnEmptyPolicy
forall x. Rep OnEmptyPolicy x -> OnEmptyPolicy
forall x. OnEmptyPolicy -> Rep OnEmptyPolicy x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. OnEmptyPolicy -> Rep OnEmptyPolicy x
from :: forall x. OnEmptyPolicy -> Rep OnEmptyPolicy x
$cto :: forall x. Rep OnEmptyPolicy x -> OnEmptyPolicy
to :: forall x. Rep OnEmptyPolicy x -> OnEmptyPolicy
Generic, Eq OnEmptyPolicy
Eq OnEmptyPolicy =>
(OnEmptyPolicy -> OnEmptyPolicy -> Ordering)
-> (OnEmptyPolicy -> OnEmptyPolicy -> Bool)
-> (OnEmptyPolicy -> OnEmptyPolicy -> Bool)
-> (OnEmptyPolicy -> OnEmptyPolicy -> Bool)
-> (OnEmptyPolicy -> OnEmptyPolicy -> Bool)
-> (OnEmptyPolicy -> OnEmptyPolicy -> OnEmptyPolicy)
-> (OnEmptyPolicy -> OnEmptyPolicy -> OnEmptyPolicy)
-> Ord OnEmptyPolicy
OnEmptyPolicy -> OnEmptyPolicy -> Bool
OnEmptyPolicy -> OnEmptyPolicy -> Ordering
OnEmptyPolicy -> OnEmptyPolicy -> OnEmptyPolicy
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: OnEmptyPolicy -> OnEmptyPolicy -> Ordering
compare :: OnEmptyPolicy -> OnEmptyPolicy -> Ordering
$c< :: OnEmptyPolicy -> OnEmptyPolicy -> Bool
< :: OnEmptyPolicy -> OnEmptyPolicy -> Bool
$c<= :: OnEmptyPolicy -> OnEmptyPolicy -> Bool
<= :: OnEmptyPolicy -> OnEmptyPolicy -> Bool
$c> :: OnEmptyPolicy -> OnEmptyPolicy -> Bool
> :: OnEmptyPolicy -> OnEmptyPolicy -> Bool
$c>= :: OnEmptyPolicy -> OnEmptyPolicy -> Bool
>= :: OnEmptyPolicy -> OnEmptyPolicy -> Bool
$cmax :: OnEmptyPolicy -> OnEmptyPolicy -> OnEmptyPolicy
max :: OnEmptyPolicy -> OnEmptyPolicy -> OnEmptyPolicy
$cmin :: OnEmptyPolicy -> OnEmptyPolicy -> OnEmptyPolicy
min :: OnEmptyPolicy -> OnEmptyPolicy -> OnEmptyPolicy
Ord, Int -> OnEmptyPolicy -> ShowS
[OnEmptyPolicy] -> ShowS
OnEmptyPolicy -> String
(Int -> OnEmptyPolicy -> ShowS)
-> (OnEmptyPolicy -> String)
-> ([OnEmptyPolicy] -> ShowS)
-> Show OnEmptyPolicy
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> OnEmptyPolicy -> ShowS
showsPrec :: Int -> OnEmptyPolicy -> ShowS
$cshow :: OnEmptyPolicy -> String
show :: OnEmptyPolicy -> String
$cshowList :: [OnEmptyPolicy] -> ShowS
showList :: [OnEmptyPolicy] -> ShowS
Show)

-- | Run the 'NonDet' effect with a given 'OnEmptyPolicy'.
--
-- /Note:/ ':<|>:' executes the second computation if (and only if) the first
-- computation calls 'Empty'.
--
-- @since 2.2.0.0
runNonDet
  :: HasCallStack
  => OnEmptyPolicy
  -> Eff (NonDet : es) a
  -> Eff es (Either CallStack a)
runNonDet :: forall (es :: [(Type -> Type) -> Type -> Type]) a.
HasCallStack =>
OnEmptyPolicy -> Eff (NonDet : es) a -> Eff es (Either CallStack a)
runNonDet = \case
  OnEmptyPolicy
OnEmptyKeep     -> Eff (NonDet : es) a -> Eff es (Either CallStack a)
forall (es :: [(Type -> Type) -> Type -> Type]) a.
HasCallStack =>
Eff (NonDet : es) a -> Eff es (Either CallStack a)
runNonDetKeep
  OnEmptyPolicy
OnEmptyRollback -> Eff (NonDet : es) a -> Eff es (Either CallStack a)
forall (es :: [(Type -> Type) -> Type -> Type]) a.
HasCallStack =>
Eff (NonDet : es) a -> Eff es (Either CallStack a)
runNonDetRollback

runNonDetKeep
  :: HasCallStack
  => Eff (NonDet : es) a
  -> Eff es (Either CallStack a)
runNonDetKeep :: forall (es :: [(Type -> Type) -> Type -> Type]) a.
HasCallStack =>
Eff (NonDet : es) a -> Eff es (Either CallStack a)
runNonDetKeep = (Eff (Error ErrorEmpty : es) a -> Eff es (Either CallStack a))
-> (forall {a} {localEs :: [(Type -> Type) -> Type -> Type]}.
    (HasCallStack, NonDet :> localEs) =>
    LocalEnv localEs (Error ErrorEmpty : es)
    -> NonDet (Eff localEs) a -> Eff (Error ErrorEmpty : es) a)
-> Eff (NonDet : es) a
-> Eff es (Either CallStack a)
forall (e :: (Type -> Type) -> Type -> Type)
       (handlerEs :: [(Type -> Type) -> Type -> Type]) a
       (es :: [(Type -> Type) -> Type -> Type]) b.
(HasCallStack, DispatchOf e ~ 'Dynamic) =>
(Eff handlerEs a -> Eff es b)
-> EffectHandler e handlerEs -> Eff (e : es) a -> Eff es b
reinterpret ((Either (CallStack, ErrorEmpty) a -> Either CallStack a)
-> Eff es (Either (CallStack, ErrorEmpty) a)
-> Eff es (Either CallStack a)
forall a b. (a -> b) -> Eff es a -> Eff es b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap Either (CallStack, ErrorEmpty) a -> Either CallStack a
forall cs e a. Either (cs, e) a -> Either cs a
noError (Eff es (Either (CallStack, ErrorEmpty) a)
 -> Eff es (Either CallStack a))
-> (Eff (Error ErrorEmpty : es) a
    -> Eff es (Either (CallStack, ErrorEmpty) a))
-> Eff (Error ErrorEmpty : es) a
-> Eff es (Either CallStack a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e (es :: [(Type -> Type) -> Type -> Type]) a.
HasCallStack =>
Eff (Error e : es) a -> Eff es (Either (CallStack, e) a)
runError @ErrorEmpty) ((forall {a} {localEs :: [(Type -> Type) -> Type -> Type]}.
  (HasCallStack, NonDet :> localEs) =>
  LocalEnv localEs (Error ErrorEmpty : es)
  -> NonDet (Eff localEs) a -> Eff (Error ErrorEmpty : es) a)
 -> Eff (NonDet : es) a -> Eff es (Either CallStack a))
-> (forall {a} {localEs :: [(Type -> Type) -> Type -> Type]}.
    (HasCallStack, NonDet :> localEs) =>
    LocalEnv localEs (Error ErrorEmpty : es)
    -> NonDet (Eff localEs) a -> Eff (Error ErrorEmpty : es) a)
-> Eff (NonDet : es) a
-> Eff es (Either CallStack a)
forall a b. (a -> b) -> a -> b
$ \LocalEnv localEs (Error ErrorEmpty : es)
env -> \case
  NonDet (Eff localEs) a
Empty       -> ErrorEmpty -> Eff (Error ErrorEmpty : es) a
forall e (es :: [(Type -> Type) -> Type -> Type]) a.
(HasCallStack, Error e :> es, Show e) =>
e -> Eff es a
throwError ErrorEmpty
ErrorEmpty
  Eff localEs a
m1 :<|>: Eff localEs a
m2 -> LocalEnv localEs (Error ErrorEmpty : es)
-> ((forall {r}. Eff localEs r -> Eff (Error ErrorEmpty : es) r)
    -> Eff (Error ErrorEmpty : es) a)
-> Eff (Error ErrorEmpty : es) a
forall (es :: [(Type -> Type) -> Type -> Type])
       (handlerEs :: [(Type -> Type) -> Type -> Type])
       (localEs :: [(Type -> Type) -> Type -> Type]) a.
(HasCallStack, SharedSuffix es handlerEs) =>
LocalEnv localEs handlerEs
-> ((forall r. Eff localEs r -> Eff es r) -> Eff es a) -> Eff es a
localSeqUnlift LocalEnv localEs (Error ErrorEmpty : es)
env (((forall {r}. Eff localEs r -> Eff (Error ErrorEmpty : es) r)
  -> Eff (Error ErrorEmpty : es) a)
 -> Eff (Error ErrorEmpty : es) a)
-> ((forall {r}. Eff localEs r -> Eff (Error ErrorEmpty : es) r)
    -> Eff (Error ErrorEmpty : es) a)
-> Eff (Error ErrorEmpty : es) a
forall a b. (a -> b) -> a -> b
$ \forall {r}. Eff localEs r -> Eff (Error ErrorEmpty : es) r
unlift -> do
    Maybe a
mr <- (a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a)
-> Eff (Error ErrorEmpty : es) a
-> Eff (Error ErrorEmpty : es) (Maybe a)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Eff localEs a -> Eff (Error ErrorEmpty : es) a
forall {r}. Eff localEs r -> Eff (Error ErrorEmpty : es) r
unlift Eff localEs a
m1) Eff (Error ErrorEmpty : es) (Maybe a)
-> (CallStack
    -> ErrorEmpty -> Eff (Error ErrorEmpty : es) (Maybe a))
-> Eff (Error ErrorEmpty : es) (Maybe a)
forall e (es :: [(Type -> Type) -> Type -> Type]) a.
(HasCallStack, Error e :> es) =>
Eff es a -> (CallStack -> e -> Eff es a) -> Eff es a
`catchError` \CallStack
_ ErrorEmpty
ErrorEmpty -> Maybe a -> Eff (Error ErrorEmpty : es) (Maybe a)
forall a. a -> Eff (Error ErrorEmpty : es) a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Maybe a
forall a. Maybe a
Nothing
    case Maybe a
mr of
      Just a
r  -> a -> Eff (Error ErrorEmpty : es) a
forall a. a -> Eff (Error ErrorEmpty : es) a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure a
r
      Maybe a
Nothing -> Eff localEs a -> Eff (Error ErrorEmpty : es) a
forall {r}. Eff localEs r -> Eff (Error ErrorEmpty : es) r
unlift Eff localEs a
m2

runNonDetRollback
  :: HasCallStack
  => Eff (NonDet : es) a
  -> Eff es (Either CallStack a)
runNonDetRollback :: forall (es :: [(Type -> Type) -> Type -> Type]) a.
HasCallStack =>
Eff (NonDet : es) a -> Eff es (Either CallStack a)
runNonDetRollback = (Eff (Error ErrorEmpty : es) a -> Eff es (Either CallStack a))
-> (forall {a} {localEs :: [(Type -> Type) -> Type -> Type]}.
    (HasCallStack, NonDet :> localEs) =>
    LocalEnv localEs (Error ErrorEmpty : es)
    -> NonDet (Eff localEs) a -> Eff (Error ErrorEmpty : es) a)
-> Eff (NonDet : es) a
-> Eff es (Either CallStack a)
forall (e :: (Type -> Type) -> Type -> Type)
       (handlerEs :: [(Type -> Type) -> Type -> Type]) a
       (es :: [(Type -> Type) -> Type -> Type]) b.
(HasCallStack, DispatchOf e ~ 'Dynamic) =>
(Eff handlerEs a -> Eff es b)
-> EffectHandler e handlerEs -> Eff (e : es) a -> Eff es b
reinterpret Eff (Error ErrorEmpty : es) a -> Eff es (Either CallStack a)
forall {es :: [(Type -> Type) -> Type -> Type]} {b}.
Eff (Error ErrorEmpty : es) b -> Eff es (Either CallStack b)
setup ((forall {a} {localEs :: [(Type -> Type) -> Type -> Type]}.
  (HasCallStack, NonDet :> localEs) =>
  LocalEnv localEs (Error ErrorEmpty : es)
  -> NonDet (Eff localEs) a -> Eff (Error ErrorEmpty : es) a)
 -> Eff (NonDet : es) a -> Eff es (Either CallStack a))
-> (forall {a} {localEs :: [(Type -> Type) -> Type -> Type]}.
    (HasCallStack, NonDet :> localEs) =>
    LocalEnv localEs (Error ErrorEmpty : es)
    -> NonDet (Eff localEs) a -> Eff (Error ErrorEmpty : es) a)
-> Eff (NonDet : es) a
-> Eff es (Either CallStack a)
forall a b. (a -> b) -> a -> b
$ \LocalEnv localEs (Error ErrorEmpty : es)
env -> \case
  NonDet (Eff localEs) a
Empty       -> ErrorEmpty -> Eff (Error ErrorEmpty : es) a
forall e (es :: [(Type -> Type) -> Type -> Type]) a.
(HasCallStack, Error e :> es, Show e) =>
e -> Eff es a
throwError ErrorEmpty
ErrorEmpty
  Eff localEs a
m1 :<|>: Eff localEs a
m2 -> do
    StorageData
backupData <- (Env (Error ErrorEmpty : es) -> IO StorageData)
-> Eff (Error ErrorEmpty : es) StorageData
forall (es :: [(Type -> Type) -> Type -> Type]) a.
(Env es -> IO a) -> Eff es a
unsafeEff Env (Error ErrorEmpty : es) -> IO StorageData
forall (es :: [(Type -> Type) -> Type -> Type]).
HasCallStack =>
Env es -> IO StorageData
backupStorageData
    LocalEnv localEs (Error ErrorEmpty : es)
-> ((forall {r}. Eff localEs r -> Eff (Error ErrorEmpty : es) r)
    -> Eff (Error ErrorEmpty : es) a)
-> Eff (Error ErrorEmpty : es) a
forall (es :: [(Type -> Type) -> Type -> Type])
       (handlerEs :: [(Type -> Type) -> Type -> Type])
       (localEs :: [(Type -> Type) -> Type -> Type]) a.
(HasCallStack, SharedSuffix es handlerEs) =>
LocalEnv localEs handlerEs
-> ((forall r. Eff localEs r -> Eff es r) -> Eff es a) -> Eff es a
localSeqUnlift LocalEnv localEs (Error ErrorEmpty : es)
env (((forall {r}. Eff localEs r -> Eff (Error ErrorEmpty : es) r)
  -> Eff (Error ErrorEmpty : es) a)
 -> Eff (Error ErrorEmpty : es) a)
-> ((forall {r}. Eff localEs r -> Eff (Error ErrorEmpty : es) r)
    -> Eff (Error ErrorEmpty : es) a)
-> Eff (Error ErrorEmpty : es) a
forall a b. (a -> b) -> a -> b
$ \forall {r}. Eff localEs r -> Eff (Error ErrorEmpty : es) r
unlift -> do
      Maybe a
mr <- (a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a)
-> Eff (Error ErrorEmpty : es) a
-> Eff (Error ErrorEmpty : es) (Maybe a)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Eff localEs a -> Eff (Error ErrorEmpty : es) a
forall {r}. Eff localEs r -> Eff (Error ErrorEmpty : es) r
unlift Eff localEs a
m1) Eff (Error ErrorEmpty : es) (Maybe a)
-> (CallStack
    -> ErrorEmpty -> Eff (Error ErrorEmpty : es) (Maybe a))
-> Eff (Error ErrorEmpty : es) (Maybe a)
forall e (es :: [(Type -> Type) -> Type -> Type]) a.
(HasCallStack, Error e :> es) =>
Eff es a -> (CallStack -> e -> Eff es a) -> Eff es a
`catchError` \CallStack
_ ErrorEmpty
ErrorEmpty -> do
        -- If m1 failed, restore the data.
        (Env (Error ErrorEmpty : es) -> IO ())
-> Eff (Error ErrorEmpty : es) ()
forall (es :: [(Type -> Type) -> Type -> Type]) a.
(Env es -> IO a) -> Eff es a
unsafeEff ((Env (Error ErrorEmpty : es) -> IO ())
 -> Eff (Error ErrorEmpty : es) ())
-> (Env (Error ErrorEmpty : es) -> IO ())
-> Eff (Error ErrorEmpty : es) ()
forall a b. (a -> b) -> a -> b
$ StorageData -> Env (Error ErrorEmpty : es) -> IO ()
forall (es :: [(Type -> Type) -> Type -> Type]).
HasCallStack =>
StorageData -> Env es -> IO ()
I.restoreStorageData StorageData
backupData
        Maybe a -> Eff (Error ErrorEmpty : es) (Maybe a)
forall a. a -> Eff (Error ErrorEmpty : es) a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Maybe a
forall a. Maybe a
Nothing
      case Maybe a
mr of
        Just a
r  -> a -> Eff (Error ErrorEmpty : es) a
forall a. a -> Eff (Error ErrorEmpty : es) a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure a
r
        Maybe a
Nothing -> Eff localEs a -> Eff (Error ErrorEmpty : es) a
forall {r}. Eff localEs r -> Eff (Error ErrorEmpty : es) r
unlift Eff localEs a
m2
  where
    setup :: Eff (Error ErrorEmpty : es) b -> Eff es (Either CallStack b)
setup Eff (Error ErrorEmpty : es) b
action = do
      StorageData
backupData <- (Env es -> IO StorageData) -> Eff es StorageData
forall (es :: [(Type -> Type) -> Type -> Type]) a.
(Env es -> IO a) -> Eff es a
unsafeEff Env es -> IO StorageData
forall (es :: [(Type -> Type) -> Type -> Type]).
HasCallStack =>
Env es -> IO StorageData
backupStorageData
      forall e (es :: [(Type -> Type) -> Type -> Type]) a.
HasCallStack =>
Eff (Error e : es) a -> Eff es (Either (CallStack, e) a)
runError @ErrorEmpty Eff (Error ErrorEmpty : es) b
action Eff es (Either (CallStack, ErrorEmpty) b)
-> (Either (CallStack, ErrorEmpty) b
    -> Eff es (Either CallStack b))
-> Eff es (Either CallStack b)
forall a b. Eff es a -> (a -> Eff es b) -> Eff es b
forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Right b
r -> Either CallStack b -> Eff es (Either CallStack b)
forall a. a -> Eff es a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (Either CallStack b -> Eff es (Either CallStack b))
-> Either CallStack b -> Eff es (Either CallStack b)
forall a b. (a -> b) -> a -> b
$ b -> Either CallStack b
forall a b. b -> Either a b
Right b
r
        Left (CallStack
cs, ErrorEmpty
_) -> do
          -- If the whole action failed, restore the data.
          (Env es -> IO ()) -> Eff es ()
forall (es :: [(Type -> Type) -> Type -> Type]) a.
(Env es -> IO a) -> Eff es a
unsafeEff ((Env es -> IO ()) -> Eff es ()) -> (Env es -> IO ()) -> Eff es ()
forall a b. (a -> b) -> a -> b
$ StorageData -> Env es -> IO ()
forall (es :: [(Type -> Type) -> Type -> Type]).
HasCallStack =>
StorageData -> Env es -> IO ()
I.restoreStorageData StorageData
backupData
          Either CallStack b -> Eff es (Either CallStack b)
forall a. a -> Eff es a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (Either CallStack b -> Eff es (Either CallStack b))
-> Either CallStack b -> Eff es (Either CallStack b)
forall a b. (a -> b) -> a -> b
$ CallStack -> Either CallStack b
forall a b. a -> Either a b
Left CallStack
cs

----------------------------------------

-- | Specialized version of 'empty' with the 'HasCallStack' constraint for
-- tracking purposes.
--
-- @since 2.2.0.0
emptyEff :: (HasCallStack, NonDet :> es) => Eff es a
emptyEff :: forall (es :: [(Type -> Type) -> Type -> Type]) a.
(HasCallStack, NonDet :> es) =>
Eff es a
emptyEff = (HasCallStack => NonDet (Eff es) a -> Eff es a)
-> NonDet (Eff es) a -> Eff es a
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack HasCallStack => NonDet (Eff es) a -> Eff es a
NonDet (Eff es) a -> Eff es a
forall (e :: (Type -> Type) -> Type -> Type)
       (es :: [(Type -> Type) -> Type -> Type]) a.
(HasCallStack, DispatchOf e ~ 'Dynamic, e :> es) =>
e (Eff es) a -> Eff es a
send NonDet (Eff es) a
forall (a :: Type -> Type) b. NonDet a b
Empty

-- | Specialized version of '<|>' with the `HasCallStack` constraint for
-- tracking purposes.
--
-- @since 2.5.0.0
plusEff :: (HasCallStack, NonDet :> es) => Eff es a -> Eff es a -> Eff es a
plusEff :: forall (es :: [(Type -> Type) -> Type -> Type]) a.
(HasCallStack, NonDet :> es) =>
Eff es a -> Eff es a -> Eff es a
plusEff Eff es a
m1 Eff es a
m2 = NonDet (Eff es) a -> Eff es a
forall (e :: (Type -> Type) -> Type -> Type)
       (es :: [(Type -> Type) -> Type -> Type]) a.
(HasCallStack, DispatchOf e ~ 'Dynamic, e :> es) =>
e (Eff es) a -> Eff es a
send (Eff es a
m1 Eff es a -> Eff es a -> NonDet (Eff es) a
forall (a :: Type -> Type) b. a b -> a b -> NonDet a b
:<|>: Eff es a
m2)
infixl 3 `plusEff` -- same as <|>

-- | Specialized version of 'asum' with the 'HasCallStack' constraint for
-- tracking purposes.
--
-- @since 2.2.0.0
sumEff :: (HasCallStack, Foldable t, NonDet :> es) => t (Eff es a) -> Eff es a
sumEff :: forall (t :: Type -> Type) (es :: [(Type -> Type) -> Type -> Type])
       a.
(HasCallStack, Foldable t, NonDet :> es) =>
t (Eff es a) -> Eff es a
sumEff = (Eff es a -> Eff es a -> Eff es a)
-> Eff es a -> t (Eff es a) -> Eff es a
forall a b. (a -> b -> b) -> b -> t a -> b
forall (t :: Type -> Type) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Eff es a -> Eff es a -> Eff es a
forall (es :: [(Type -> Type) -> Type -> Type]) a.
(HasCallStack, NonDet :> es) =>
Eff es a -> Eff es a -> Eff es a
plusEff Eff es a
forall (es :: [(Type -> Type) -> Type -> Type]) a.
(HasCallStack, NonDet :> es) =>
Eff es a
emptyEff

----------------------------------------
-- Internal helpers

-- | Internal error type for the Empty action. Better than '()' in case it
-- escapes the scope of 'runNonDet' and shows up in error messages.
data ErrorEmpty = ErrorEmpty
instance Show ErrorEmpty where
  show :: ErrorEmpty -> String
show ErrorEmpty
ErrorEmpty = String
"Effectful.NonDet.ErrorEmpty"

noError :: Either (cs, e) a -> Either cs a
noError :: forall cs e a. Either (cs, e) a -> Either cs a
noError = ((cs, e) -> Either cs a)
-> (a -> Either cs a) -> Either (cs, e) a -> Either cs a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (cs -> Either cs a
forall a b. a -> Either a b
Left (cs -> Either cs a) -> ((cs, e) -> cs) -> (cs, e) -> Either cs a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (cs, e) -> cs
forall a b. (a, b) -> a
fst) a -> Either cs a
forall a b. b -> Either a b
Right

backupStorageData :: HasCallStack => Env es -> IO I.StorageData
backupStorageData :: forall (es :: [(Type -> Type) -> Type -> Type]).
HasCallStack =>
Env es -> IO StorageData
backupStorageData Env es
env = HasCallStack => StorageData -> IO StorageData
StorageData -> IO StorageData
I.copyStorageData (StorageData -> IO StorageData)
-> (Storage -> StorageData) -> Storage -> IO StorageData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Storage -> StorageData
I.stData (Storage -> IO StorageData) -> IO Storage -> IO StorageData
forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<< IORef' Storage -> IO Storage
forall a. IORef' a -> IO a
readIORef' (Env es -> IORef' Storage
forall (es :: [(Type -> Type) -> Type -> Type]).
Env es -> IORef' Storage
I.envStorage Env es
env)