{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}

module Data.Cond
    ( CondT(..), Cond

    -- * Executing CondT
    , runCondT, runCond, applyCondT, applyCond

    -- * Promotions
    , guardM, guard_, guardM_, apply, consider

    -- * Boolean logic
    , matches, if_, when_, unless_, or_, and_, not_

    -- * Basic conditionals
    , ignore, norecurse, prune

    -- * Helper functions
    , recurse, test

    -- * Isomorphism with a stateful EitherT
    , CondEitherT(..), fromCondT, toCondT
    ) where

import Control.Applicative (Alternative (..), liftA2, optional)
import Control.Arrow (first)
import GHC.Stack (HasCallStack)
import Control.Monad hiding (mapM_, sequence_)
import Control.Monad.Base (MonadBase (..))
import Control.Monad.Catch (MonadCatch (..), MonadMask (..), MonadThrow (..), ExitCase (..))
import Control.Monad.Morph (MFunctor, hoist)
import Control.Monad.Reader.Class (MonadReader (..), asks)
import Control.Monad.State.Class (MonadState (..), gets)
import Control.Monad.IO.Class (MonadIO (..))
import Control.Monad.Trans (MonadTrans (..))
import Control.Monad.Trans.Control (MonadBaseControl (..))
import Control.Monad.Trans.Either (EitherT, left, runEitherT)
import Control.Monad.Trans.State (StateT (..), withStateT, evalStateT)
import Data.Foldable (asum)
import Data.Functor.Identity (Identity (..))
import Data.Maybe (fromMaybe, isJust)


-- | 'Result' is an enriched 'Maybe' type which also specifies whether
--   recursion should occur from the given input, and if so, how such
--   recursion should be performed.
data Result a m b = Ignore
                  | Keep b
                  | RecurseOnly (Maybe (CondT a m b))
                  | KeepAndRecurse b (Maybe (CondT a m b))

instance Show b => Show (Result a m b) where
    show :: Result a m b -> String
show Result a m b
Ignore               = String
"Ignore"
    show (Keep b
a)             = String
"Keep " String -> ShowS
forall a. [a] -> [a] -> [a]
++ b -> String
forall a. Show a => a -> String
show b
a
    show (RecurseOnly Maybe (CondT a m b)
_)      = String
"RecurseOnly"
    show (KeepAndRecurse b
a Maybe (CondT a m b)
_) = String
"KeepAndRecurse " String -> ShowS
forall a. [a] -> [a] -> [a]
++ b -> String
forall a. Show a => a -> String
show b
a

instance Monad m => Functor (Result a m) where
    fmap :: forall a b. (a -> b) -> Result a m a -> Result a m b
fmap a -> b
_ Result a m a
Ignore               = Result a m b
forall a (m :: * -> *) b. Result a m b
Ignore
    fmap a -> b
f (Keep a
a)             = b -> Result a m b
forall a (m :: * -> *) b. b -> Result a m b
Keep (a -> b
f a
a)
    fmap a -> b
f (RecurseOnly Maybe (CondT a m a)
l)      = Maybe (CondT a m b) -> Result a m b
forall a (m :: * -> *) b. Maybe (CondT a m b) -> Result a m b
RecurseOnly ((CondT a m a -> CondT a m b)
-> Maybe (CondT a m a) -> Maybe (CondT a m b)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM ((a -> b) -> CondT a m a -> CondT a m b
forall a b. (a -> b) -> CondT a m a -> CondT a m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f) Maybe (CondT a m a)
l)
    fmap a -> b
f (KeepAndRecurse a
a Maybe (CondT a m a)
l) = b -> Maybe (CondT a m b) -> Result a m b
forall a (m :: * -> *) b. b -> Maybe (CondT a m b) -> Result a m b
KeepAndRecurse (a -> b
f a
a) ((CondT a m a -> CondT a m b)
-> Maybe (CondT a m a) -> Maybe (CondT a m b)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM ((a -> b) -> CondT a m a -> CondT a m b
forall a b. (a -> b) -> CondT a m a -> CondT a m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f) Maybe (CondT a m a)
l)
    {-# INLINE fmap #-}

instance MFunctor (Result a) where
    hoist :: forall (m :: * -> *) (n :: * -> *) b.
Monad m =>
(forall a. m a -> n a) -> Result a m b -> Result a n b
hoist forall a. m a -> n a
_ Result a m b
Ignore                 = Result a n b
forall a (m :: * -> *) b. Result a m b
Ignore
    hoist forall a. m a -> n a
_ (Keep b
a)               = b -> Result a n b
forall a (m :: * -> *) b. b -> Result a m b
Keep b
a
    hoist forall a. m a -> n a
nat (RecurseOnly Maybe (CondT a m b)
l)      = Maybe (CondT a n b) -> Result a n b
forall a (m :: * -> *) b. Maybe (CondT a m b) -> Result a m b
RecurseOnly ((CondT a m b -> CondT a n b)
-> Maybe (CondT a m b) -> Maybe (CondT a n b)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((forall a. m a -> n a) -> CondT a m b -> CondT a n b
forall {k} (t :: (* -> *) -> k -> *) (m :: * -> *) (n :: * -> *)
       (b :: k).
(MFunctor t, Monad m) =>
(forall a. m a -> n a) -> t m b -> t n b
forall (m :: * -> *) (n :: * -> *) b.
Monad m =>
(forall a. m a -> n a) -> CondT a m b -> CondT a n b
hoist m a -> n a
forall a. m a -> n a
nat) Maybe (CondT a m b)
l)
    hoist forall a. m a -> n a
nat (KeepAndRecurse b
a Maybe (CondT a m b)
l) = b -> Maybe (CondT a n b) -> Result a n b
forall a (m :: * -> *) b. b -> Maybe (CondT a m b) -> Result a m b
KeepAndRecurse b
a ((CondT a m b -> CondT a n b)
-> Maybe (CondT a m b) -> Maybe (CondT a n b)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((forall a. m a -> n a) -> CondT a m b -> CondT a n b
forall {k} (t :: (* -> *) -> k -> *) (m :: * -> *) (n :: * -> *)
       (b :: k).
(MFunctor t, Monad m) =>
(forall a. m a -> n a) -> t m b -> t n b
forall (m :: * -> *) (n :: * -> *) b.
Monad m =>
(forall a. m a -> n a) -> CondT a m b -> CondT a n b
hoist m a -> n a
forall a. m a -> n a
nat) Maybe (CondT a m b)
l)
    {-# INLINE hoist #-}

instance Semigroup (Result a m b) where
    Result a m b
Ignore        <> :: Result a m b -> Result a m b -> Result a m b
<> Result a m b
_                  = Result a m b
forall a (m :: * -> *) b. Result a m b
Ignore
    Result a m b
_             <> Result a m b
Ignore             = Result a m b
forall a (m :: * -> *) b. Result a m b
Ignore
    RecurseOnly Maybe (CondT a m b)
_ <> Keep b
_             = Result a m b
forall a (m :: * -> *) b. Result a m b
Ignore
    RecurseOnly Maybe (CondT a m b)
_ <> KeepAndRecurse b
_ Maybe (CondT a m b)
m = Maybe (CondT a m b) -> Result a m b
forall a (m :: * -> *) b. Maybe (CondT a m b) -> Result a m b
RecurseOnly Maybe (CondT a m b)
m
    RecurseOnly Maybe (CondT a m b)
m <> Result a m b
_                  = Maybe (CondT a m b) -> Result a m b
forall a (m :: * -> *) b. Maybe (CondT a m b) -> Result a m b
RecurseOnly Maybe (CondT a m b)
m
    Keep b
_        <> RecurseOnly Maybe (CondT a m b)
_      = Result a m b
forall a (m :: * -> *) b. Result a m b
Ignore
    Result a m b
_             <> RecurseOnly Maybe (CondT a m b)
m      = Maybe (CondT a m b) -> Result a m b
forall a (m :: * -> *) b. Maybe (CondT a m b) -> Result a m b
RecurseOnly Maybe (CondT a m b)
m
    Result a m b
_             <> Keep b
b             = b -> Result a m b
forall a (m :: * -> *) b. b -> Result a m b
Keep b
b
    Keep b
_        <> KeepAndRecurse b
b Maybe (CondT a m b)
_ = b -> Result a m b
forall a (m :: * -> *) b. b -> Result a m b
Keep b
b
    Result a m b
_             <> KeepAndRecurse b
b Maybe (CondT a m b)
m = b -> Maybe (CondT a m b) -> Result a m b
forall a (m :: * -> *) b. b -> Maybe (CondT a m b) -> Result a m b
KeepAndRecurse b
b Maybe (CondT a m b)
m
    {-# INLINE (<>) #-}

instance Monoid b => Monoid (Result a m b) where
    mempty :: Result a m b
mempty  = b -> Maybe (CondT a m b) -> Result a m b
forall a (m :: * -> *) b. b -> Maybe (CondT a m b) -> Result a m b
KeepAndRecurse b
forall a. Monoid a => a
mempty Maybe (CondT a m b)
forall a. Maybe a
Nothing
    {-# INLINE mempty #-}
    mappend :: Result a m b -> Result a m b -> Result a m b
mappend = Result a m b -> Result a m b -> Result a m b
forall a. Semigroup a => a -> a -> a
(<>)
    {-# INLINE mappend #-}

getResult :: Result a m b -> (Maybe b, Maybe (CondT a m b))
getResult :: forall a (m :: * -> *) b.
Result a m b -> (Maybe b, Maybe (CondT a m b))
getResult Result a m b
Ignore               = (Maybe b
forall a. Maybe a
Nothing, Maybe (CondT a m b)
forall a. Maybe a
Nothing)
getResult (Keep b
b)             = (b -> Maybe b
forall a. a -> Maybe a
Just b
b, Maybe (CondT a m b)
forall a. Maybe a
Nothing)
getResult (RecurseOnly Maybe (CondT a m b)
c)      = (Maybe b
forall a. Maybe a
Nothing, Maybe (CondT a m b)
c)
getResult (KeepAndRecurse b
b Maybe (CondT a m b)
c) = (b -> Maybe b
forall a. a -> Maybe a
Just b
b, Maybe (CondT a m b)
c)

setRecursion :: CondT a m b -> Result a m b -> Result a m b
setRecursion :: forall a (m :: * -> *) b.
CondT a m b -> Result a m b -> Result a m b
setRecursion CondT a m b
_ Result a m b
Ignore               = Result a m b
forall a (m :: * -> *) b. Result a m b
Ignore
setRecursion CondT a m b
_ (Keep b
b)             = b -> Result a m b
forall a (m :: * -> *) b. b -> Result a m b
Keep b
b
setRecursion CondT a m b
c (RecurseOnly Maybe (CondT a m b)
_)      = Maybe (CondT a m b) -> Result a m b
forall a (m :: * -> *) b. Maybe (CondT a m b) -> Result a m b
RecurseOnly (CondT a m b -> Maybe (CondT a m b)
forall a. a -> Maybe a
Just CondT a m b
c)
setRecursion CondT a m b
c (KeepAndRecurse b
b Maybe (CondT a m b)
_) = b -> Maybe (CondT a m b) -> Result a m b
forall a (m :: * -> *) b. b -> Maybe (CondT a m b) -> Result a m b
KeepAndRecurse b
b (CondT a m b -> Maybe (CondT a m b)
forall a. a -> Maybe a
Just CondT a m b
c)

accept' :: b -> Result a m b
accept' :: forall b a (m :: * -> *). b -> Result a m b
accept' = (b -> Maybe (CondT a m b) -> Result a m b)
-> Maybe (CondT a m b) -> b -> Result a m b
forall a b c. (a -> b -> c) -> b -> a -> c
flip b -> Maybe (CondT a m b) -> Result a m b
forall a (m :: * -> *) b. b -> Maybe (CondT a m b) -> Result a m b
KeepAndRecurse Maybe (CondT a m b)
forall a. Maybe a
Nothing

recurse' :: Result a m b
recurse' :: forall a (m :: * -> *) b. Result a m b
recurse' = Maybe (CondT a m b) -> Result a m b
forall a (m :: * -> *) b. Maybe (CondT a m b) -> Result a m b
RecurseOnly Maybe (CondT a m b)
forall a. Maybe a
Nothing

-- | Convert from a 'Maybe' value to its corresponding 'Result'.
--
-- >>> maybeToResult Nothing :: Result () Identity ()
-- RecurseOnly
-- >>> maybeToResult (Just ()) :: Result () Identity ()
-- KeepAndRecurse ()
maybeToResult :: Maybe a -> Result r m a
maybeToResult :: forall a r (m :: * -> *). Maybe a -> Result r m a
maybeToResult Maybe a
Nothing  = Result r m a
forall a (m :: * -> *) b. Result a m b
recurse'
maybeToResult (Just a
a) = a -> Result r m a
forall b a (m :: * -> *). b -> Result a m b
accept' a
a

maybeFromResult :: Result r m a -> Maybe a
maybeFromResult :: forall r (m :: * -> *) a. Result r m a -> Maybe a
maybeFromResult Result r m a
Ignore               = Maybe a
forall a. Maybe a
Nothing
maybeFromResult (Keep a
a)             = a -> Maybe a
forall a. a -> Maybe a
Just a
a
maybeFromResult (RecurseOnly Maybe (CondT r m a)
_)      = Maybe a
forall a. Maybe a
Nothing
maybeFromResult (KeepAndRecurse a
a Maybe (CondT r m a)
_) = a -> Maybe a
forall a. a -> Maybe a
Just a
a

-- | 'CondT' is a kind of @StateT a (MaybeT m) b@, which uses a special
--   'Result' type instead of 'Maybe' to express whether recursion should be
--   performed from the item under consideration.  This is used to build
--   predicates that can guide recursive traversals.
--
-- Several different types may be promoted to 'CondT':
--
--   [@Bool@]                  Using 'guard'
--
--   [@m Bool@]                Using 'guardM'
--
--   [@a -> Bool@]              Using 'guard_'
--
--   [@a -> m Bool@]            Using 'guardM_'
--
--   [@a -> m (Maybe b)@]       Using 'apply'
--
--   [@a -> m (Maybe (b, a))@]  Using 'consider'
--
-- Here is a trivial example:
--
-- @
-- flip runCondT 42 $ do
--   guard_ even
--   liftIO $ putStrLn "42 must be even to reach here"
--   guard_ odd \<|\> guard_ even
--   guard_ (== 42)
-- @
--
-- If 'CondT' is executed using 'runCondT', it return a @Maybe b@ if the
-- predicate matched.  It can also be run with 'applyCondT', which does case
-- analysis on the 'Result', specifying how recursion should be performed from
-- the given 'a' value.
newtype CondT a m b = CondT { forall a (m :: * -> *) b. CondT a m b -> StateT a m (Result a m b)
getCondT :: StateT a m (Result a m b) }

type Cond a = CondT a Identity

instance Show (CondT a m b) where
    show :: CondT a m b -> String
show CondT a m b
_ = String
"CondT"

instance (Monad m, Semigroup b) => Semigroup (CondT a m b) where
    <> :: CondT a m b -> CondT a m b -> CondT a m b
(<>) = (b -> b -> b) -> CondT a m b -> CondT a m b -> CondT a m b
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 b -> b -> b
forall a. Semigroup a => a -> a -> a
(<>)
    {-# INLINE (<>) #-}

instance (Monad m, Monoid b) => Monoid (CondT a m b) where
    mempty :: CondT a m b
mempty  = StateT a m (Result a m b) -> CondT a m b
forall a (m :: * -> *) b. StateT a m (Result a m b) -> CondT a m b
CondT (StateT a m (Result a m b) -> CondT a m b)
-> StateT a m (Result a m b) -> CondT a m b
forall a b. (a -> b) -> a -> b
$ Result a m b -> StateT a m (Result a m b)
forall a. a -> StateT a m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Result a m b -> StateT a m (Result a m b))
-> Result a m b -> StateT a m (Result a m b)
forall a b. (a -> b) -> a -> b
$ b -> Result a m b
forall b a (m :: * -> *). b -> Result a m b
accept' b
forall a. Monoid a => a
mempty
    {-# INLINE mempty #-}

instance Monad m => Functor (CondT a m) where
    fmap :: forall a b. (a -> b) -> CondT a m a -> CondT a m b
fmap a -> b
f (CondT StateT a m (Result a m a)
g) = StateT a m (Result a m b) -> CondT a m b
forall a (m :: * -> *) b. StateT a m (Result a m b) -> CondT a m b
CondT ((Result a m a -> Result a m b)
-> StateT a m (Result a m a) -> StateT a m (Result a m b)
forall a b. (a -> b) -> StateT a m a -> StateT a m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> b) -> Result a m a -> Result a m b
forall a b. (a -> b) -> Result a m a -> Result a m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f) StateT a m (Result a m a)
g)
    {-# INLINE fmap #-}

instance Monad m => Applicative (CondT a m) where
    pure :: forall a. a -> CondT a m a
pure  = StateT a m (Result a m a) -> CondT a m a
forall a (m :: * -> *) b. StateT a m (Result a m b) -> CondT a m b
CondT (StateT a m (Result a m a) -> CondT a m a)
-> (a -> StateT a m (Result a m a)) -> a -> CondT a m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Result a m a -> StateT a m (Result a m a)
forall a. a -> StateT a m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Result a m a -> StateT a m (Result a m a))
-> (a -> Result a m a) -> a -> StateT a m (Result a m a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Result a m a
forall b a (m :: * -> *). b -> Result a m b
accept' -- pure
    {-# INLINE pure #-}
    <*> :: forall a b. CondT a m (a -> b) -> CondT a m a -> CondT a m b
(<*>) = CondT a m (a -> b) -> CondT a m a -> CondT a m b
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap
    {-# INLINE (<*>) #-}

instance Monad m => Monad (CondT a m) where
    -- return = CondT . pure . accept'
    -- {-# INLINE return #-}
    CondT StateT a m (Result a m a)
f >>= :: forall a b. CondT a m a -> (a -> CondT a m b) -> CondT a m b
>>= a -> CondT a m b
k = StateT a m (Result a m b) -> CondT a m b
forall a (m :: * -> *) b. StateT a m (Result a m b) -> CondT a m b
CondT (StateT a m (Result a m b) -> CondT a m b)
-> StateT a m (Result a m b) -> CondT a m b
forall a b. (a -> b) -> a -> b
$ do
        Result a m a
r <- StateT a m (Result a m a)
f
        case Result a m a
r of
            Result a m a
Ignore -> Result a m b -> StateT a m (Result a m b)
forall a. a -> StateT a m a
forall (m :: * -> *) a. Monad m => a -> m a
return Result a m b
forall a (m :: * -> *) b. Result a m b
Ignore
            Keep a
b -> do
                Result a m b
n <- CondT a m b -> StateT a m (Result a m b)
forall a (m :: * -> *) b. CondT a m b -> StateT a m (Result a m b)
getCondT (a -> CondT a m b
k a
b)
                Result a m b -> StateT a m (Result a m b)
forall a. a -> StateT a m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Result a m b -> StateT a m (Result a m b))
-> Result a m b -> StateT a m (Result a m b)
forall a b. (a -> b) -> a -> b
$ case Result a m b
n of
                    RecurseOnly Maybe (CondT a m b)
_      -> Result a m b
forall a (m :: * -> *) b. Result a m b
Ignore
                    KeepAndRecurse b
c Maybe (CondT a m b)
_ -> b -> Result a m b
forall a (m :: * -> *) b. b -> Result a m b
Keep b
c
                    Result a m b
_                  -> Result a m b
n
            RecurseOnly Maybe (CondT a m a)
l -> Result a m b -> StateT a m (Result a m b)
forall a. a -> StateT a m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Result a m b -> StateT a m (Result a m b))
-> Result a m b -> StateT a m (Result a m b)
forall a b. (a -> b) -> a -> b
$ Maybe (CondT a m b) -> Result a m b
forall a (m :: * -> *) b. Maybe (CondT a m b) -> Result a m b
RecurseOnly ((CondT a m a -> CondT a m b)
-> Maybe (CondT a m a) -> Maybe (CondT a m b)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (CondT a m a -> (a -> CondT a m b) -> CondT a m b
forall a b. CondT a m a -> (a -> CondT a m b) -> CondT a m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> CondT a m b
k) Maybe (CondT a m a)
l)
            KeepAndRecurse a
b Maybe (CondT a m a)
_ -> CondT a m b -> StateT a m (Result a m b)
forall a (m :: * -> *) b. CondT a m b -> StateT a m (Result a m b)
getCondT (a -> CondT a m b
k a
b)

instance MonadFail m => MonadFail (CondT a m) where
    fail :: forall a. String -> CondT a m a
fail String
_ = CondT a m a
forall a. CondT a m a
forall (m :: * -> *) a. MonadPlus m => m a
mzero
    {-# INLINE fail #-}

instance Monad m => MonadReader a (CondT a m) where
    ask :: CondT a m a
ask               = StateT a m (Result a m a) -> CondT a m a
forall a (m :: * -> *) b. StateT a m (Result a m b) -> CondT a m b
CondT (StateT a m (Result a m a) -> CondT a m a)
-> StateT a m (Result a m a) -> CondT a m a
forall a b. (a -> b) -> a -> b
$ (a -> Result a m a) -> StateT a m (Result a m a)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets a -> Result a m a
forall b a (m :: * -> *). b -> Result a m b
accept'
    {-# INLINE ask #-}
    local :: forall a. (a -> a) -> CondT a m a -> CondT a m a
local a -> a
f (CondT StateT a m (Result a m a)
m) = StateT a m (Result a m a) -> CondT a m a
forall a (m :: * -> *) b. StateT a m (Result a m b) -> CondT a m b
CondT (StateT a m (Result a m a) -> CondT a m a)
-> StateT a m (Result a m a) -> CondT a m a
forall a b. (a -> b) -> a -> b
$ (a -> a) -> StateT a m (Result a m a) -> StateT a m (Result a m a)
forall s (m :: * -> *) a. (s -> s) -> StateT s m a -> StateT s m a
withStateT a -> a
f StateT a m (Result a m a)
m
    {-# INLINE local #-}
    reader :: forall a. (a -> a) -> CondT a m a
reader a -> a
f          = (a -> a) -> CondT a m a -> CondT a m a
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM a -> a
f CondT a m a
forall r (m :: * -> *). MonadReader r m => m r
ask
    {-# INLINE reader #-}

instance Monad m => MonadState a (CondT a m) where
    get :: CondT a m a
get     = StateT a m (Result a m a) -> CondT a m a
forall a (m :: * -> *) b. StateT a m (Result a m b) -> CondT a m b
CondT (StateT a m (Result a m a) -> CondT a m a)
-> StateT a m (Result a m a) -> CondT a m a
forall a b. (a -> b) -> a -> b
$ (a -> Result a m a) -> StateT a m (Result a m a)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets a -> Result a m a
forall b a (m :: * -> *). b -> Result a m b
accept'
    {-# INLINE get #-}
    put :: a -> CondT a m ()
put a
s   = StateT a m (Result a m ()) -> CondT a m ()
forall a (m :: * -> *) b. StateT a m (Result a m b) -> CondT a m b
CondT (StateT a m (Result a m ()) -> CondT a m ())
-> StateT a m (Result a m ()) -> CondT a m ()
forall a b. (a -> b) -> a -> b
$ (() -> Result a m ())
-> StateT a m () -> StateT a m (Result a m ())
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM () -> Result a m ()
forall b a (m :: * -> *). b -> Result a m b
accept' (StateT a m () -> StateT a m (Result a m ()))
-> StateT a m () -> StateT a m (Result a m ())
forall a b. (a -> b) -> a -> b
$ a -> StateT a m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put a
s
    {-# INLINE put #-}
    state :: forall a. (a -> (a, a)) -> CondT a m a
state a -> (a, a)
f = StateT a m (Result a m a) -> CondT a m a
forall a (m :: * -> *) b. StateT a m (Result a m b) -> CondT a m b
CondT (StateT a m (Result a m a) -> CondT a m a)
-> StateT a m (Result a m a) -> CondT a m a
forall a b. (a -> b) -> a -> b
$ (a -> (Result a m a, a)) -> StateT a m (Result a m a)
forall a. (a -> (a, a)) -> StateT a m a
forall s (m :: * -> *) a. MonadState s m => (s -> (a, s)) -> m a
state (((a, a) -> (Result a m a, a))
-> (a -> (a, a)) -> a -> (Result a m a, a)
forall a b. (a -> b) -> (a -> a) -> a -> b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> Result a m a) -> (a, a) -> (Result a m a, a)
forall b c d. (b -> c) -> (b, d) -> (c, d)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first a -> Result a m a
forall b a (m :: * -> *). b -> Result a m b
accept') a -> (a, a)
f)
    {-# INLINE state #-}

instance Monad m => Alternative (CondT a m) where
    empty :: forall a. CondT a m a
empty = StateT a m (Result a m a) -> CondT a m a
forall a (m :: * -> *) b. StateT a m (Result a m b) -> CondT a m b
CondT (StateT a m (Result a m a) -> CondT a m a)
-> StateT a m (Result a m a) -> CondT a m a
forall a b. (a -> b) -> a -> b
$ Result a m a -> StateT a m (Result a m a)
forall a. a -> StateT a m a
forall (m :: * -> *) a. Monad m => a -> m a
return Result a m a
forall a (m :: * -> *) b. Result a m b
recurse'
    {-# INLINE empty #-}
    CondT StateT a m (Result a m a)
f <|> :: forall a. CondT a m a -> CondT a m a -> CondT a m a
<|> CondT StateT a m (Result a m a)
g = StateT a m (Result a m a) -> CondT a m a
forall a (m :: * -> *) b. StateT a m (Result a m b) -> CondT a m b
CondT (StateT a m (Result a m a) -> CondT a m a)
-> StateT a m (Result a m a) -> CondT a m a
forall a b. (a -> b) -> a -> b
$ do
        Result a m a
r <- StateT a m (Result a m a)
f
        case Result a m a
r of
            x :: Result a m a
x@(Keep a
_) -> Result a m a -> StateT a m (Result a m a)
forall a. a -> StateT a m a
forall (m :: * -> *) a. Monad m => a -> m a
return Result a m a
x
            x :: Result a m a
x@(KeepAndRecurse a
_ Maybe (CondT a m a)
_) -> Result a m a -> StateT a m (Result a m a)
forall a. a -> StateT a m a
forall (m :: * -> *) a. Monad m => a -> m a
return Result a m a
x
            Result a m a
_ -> StateT a m (Result a m a)
g
    {-# INLINE (<|>) #-}

instance Monad m => MonadPlus (CondT a m) where
    mzero :: forall a. CondT a m a
mzero = CondT a m a
forall a. CondT a m a
forall (f :: * -> *) a. Alternative f => f a
empty
    {-# INLINE mzero #-}
    mplus :: forall a. CondT a m a -> CondT a m a -> CondT a m a
mplus = CondT a m a -> CondT a m a -> CondT a m a
forall a. CondT a m a -> CondT a m a -> CondT a m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>)
    {-# INLINE mplus #-}

instance MonadThrow m => MonadThrow (CondT a m) where
    throwM :: forall e a. (HasCallStack, Exception e) => e -> CondT a m a
throwM = StateT a m (Result a m a) -> CondT a m a
forall a (m :: * -> *) b. StateT a m (Result a m b) -> CondT a m b
CondT (StateT a m (Result a m a) -> CondT a m a)
-> (e -> StateT a m (Result a m a)) -> e -> CondT a m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> StateT a m (Result a m a)
forall e a. (HasCallStack, Exception e) => e -> StateT a m a
forall (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> m a
throwM
    {-# INLINE throwM #-}

instance MonadCatch m => MonadCatch (CondT a m) where
    catch :: forall e a.
(HasCallStack, Exception e) =>
CondT a m a -> (e -> CondT a m a) -> CondT a m a
catch (CondT StateT a m (Result a m a)
m) e -> CondT a m a
c = StateT a m (Result a m a) -> CondT a m a
forall a (m :: * -> *) b. StateT a m (Result a m b) -> CondT a m b
CondT (StateT a m (Result a m a) -> CondT a m a)
-> StateT a m (Result a m a) -> CondT a m a
forall a b. (a -> b) -> a -> b
$ StateT a m (Result a m a)
m StateT a m (Result a m a)
-> (e -> StateT a m (Result a m a)) -> StateT a m (Result a m a)
forall e a.
(HasCallStack, Exception e) =>
StateT a m a -> (e -> StateT a m a) -> StateT a m a
forall (m :: * -> *) e a.
(MonadCatch m, HasCallStack, Exception e) =>
m a -> (e -> m a) -> m a
`catch` \e
e -> CondT a m a -> StateT a m (Result a m a)
forall a (m :: * -> *) b. CondT a m b -> StateT a m (Result a m b)
getCondT (e -> CondT a m a
c e
e)

instance MonadMask m => MonadMask (CondT aa m) where
    mask :: forall b.
HasCallStack =>
((forall a. CondT aa m a -> CondT aa m a) -> CondT aa m b)
-> CondT aa m b
mask (forall a. CondT aa m a -> CondT aa m a) -> CondT aa m b
a = StateT aa m (Result aa m b) -> CondT aa m b
forall a (m :: * -> *) b. StateT a m (Result a m b) -> CondT a m b
CondT (StateT aa m (Result aa m b) -> CondT aa m b)
-> StateT aa m (Result aa m b) -> CondT aa m b
forall a b. (a -> b) -> a -> b
$ ((forall a. StateT aa m a -> StateT aa m a)
 -> StateT aa m (Result aa m b))
-> StateT aa m (Result aa m b)
forall b.
HasCallStack =>
((forall a. StateT aa m a -> StateT aa m a) -> StateT aa m b)
-> StateT aa m b
forall (m :: * -> *) b.
(MonadMask m, HasCallStack) =>
((forall a. m a -> m a) -> m b) -> m b
mask (((forall a. StateT aa m a -> StateT aa m a)
  -> StateT aa m (Result aa m b))
 -> StateT aa m (Result aa m b))
-> ((forall a. StateT aa m a -> StateT aa m a)
    -> StateT aa m (Result aa m b))
-> StateT aa m (Result aa m b)
forall a b. (a -> b) -> a -> b
$ \forall a. StateT aa m a -> StateT aa m a
u -> CondT aa m b -> StateT aa m (Result aa m b)
forall a (m :: * -> *) b. CondT a m b -> StateT a m (Result a m b)
getCondT ((forall a. CondT aa m a -> CondT aa m a) -> CondT aa m b
a ((forall a. CondT aa m a -> CondT aa m a) -> CondT aa m b)
-> (forall a. CondT aa m a -> CondT aa m a) -> CondT aa m b
forall a b. (a -> b) -> a -> b
$ (StateT aa m (Result aa m a) -> StateT aa m (Result aa m a))
-> CondT aa m a -> CondT aa m a
forall {a} {m :: * -> *} {b} {a} {m :: * -> *} {b}.
(StateT a m (Result a m b) -> StateT a m (Result a m b))
-> CondT a m b -> CondT a m b
q StateT aa m (Result aa m a) -> StateT aa m (Result aa m a)
forall a. StateT aa m a -> StateT aa m a
u)
      where q :: (StateT a m (Result a m b) -> StateT a m (Result a m b))
-> CondT a m b -> CondT a m b
q StateT a m (Result a m b) -> StateT a m (Result a m b)
u = StateT a m (Result a m b) -> CondT a m b
forall a (m :: * -> *) b. StateT a m (Result a m b) -> CondT a m b
CondT (StateT a m (Result a m b) -> CondT a m b)
-> (CondT a m b -> StateT a m (Result a m b))
-> CondT a m b
-> CondT a m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateT a m (Result a m b) -> StateT a m (Result a m b)
u (StateT a m (Result a m b) -> StateT a m (Result a m b))
-> (CondT a m b -> StateT a m (Result a m b))
-> CondT a m b
-> StateT a m (Result a m b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CondT a m b -> StateT a m (Result a m b)
forall a (m :: * -> *) b. CondT a m b -> StateT a m (Result a m b)
getCondT

    uninterruptibleMask :: forall b.
HasCallStack =>
((forall a. CondT aa m a -> CondT aa m a) -> CondT aa m b)
-> CondT aa m b
uninterruptibleMask (forall a. CondT aa m a -> CondT aa m a) -> CondT aa m b
a =
        StateT aa m (Result aa m b) -> CondT aa m b
forall a (m :: * -> *) b. StateT a m (Result a m b) -> CondT a m b
CondT (StateT aa m (Result aa m b) -> CondT aa m b)
-> StateT aa m (Result aa m b) -> CondT aa m b
forall a b. (a -> b) -> a -> b
$ ((forall a. StateT aa m a -> StateT aa m a)
 -> StateT aa m (Result aa m b))
-> StateT aa m (Result aa m b)
forall b.
HasCallStack =>
((forall a. StateT aa m a -> StateT aa m a) -> StateT aa m b)
-> StateT aa m b
forall (m :: * -> *) b.
(MonadMask m, HasCallStack) =>
((forall a. m a -> m a) -> m b) -> m b
uninterruptibleMask (((forall a. StateT aa m a -> StateT aa m a)
  -> StateT aa m (Result aa m b))
 -> StateT aa m (Result aa m b))
-> ((forall a. StateT aa m a -> StateT aa m a)
    -> StateT aa m (Result aa m b))
-> StateT aa m (Result aa m b)
forall a b. (a -> b) -> a -> b
$ \forall a. StateT aa m a -> StateT aa m a
u -> CondT aa m b -> StateT aa m (Result aa m b)
forall a (m :: * -> *) b. CondT a m b -> StateT a m (Result a m b)
getCondT ((forall a. CondT aa m a -> CondT aa m a) -> CondT aa m b
a ((forall a. CondT aa m a -> CondT aa m a) -> CondT aa m b)
-> (forall a. CondT aa m a -> CondT aa m a) -> CondT aa m b
forall a b. (a -> b) -> a -> b
$ (StateT aa m (Result aa m a) -> StateT aa m (Result aa m a))
-> CondT aa m a -> CondT aa m a
forall {a} {m :: * -> *} {b} {a} {m :: * -> *} {b}.
(StateT a m (Result a m b) -> StateT a m (Result a m b))
-> CondT a m b -> CondT a m b
q StateT aa m (Result aa m a) -> StateT aa m (Result aa m a)
forall a. StateT aa m a -> StateT aa m a
u)
      where q :: (StateT a m (Result a m b) -> StateT a m (Result a m b))
-> CondT a m b -> CondT a m b
q StateT a m (Result a m b) -> StateT a m (Result a m b)
u = StateT a m (Result a m b) -> CondT a m b
forall a (m :: * -> *) b. StateT a m (Result a m b) -> CondT a m b
CondT (StateT a m (Result a m b) -> CondT a m b)
-> (CondT a m b -> StateT a m (Result a m b))
-> CondT a m b
-> CondT a m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateT a m (Result a m b) -> StateT a m (Result a m b)
u (StateT a m (Result a m b) -> StateT a m (Result a m b))
-> (CondT a m b -> StateT a m (Result a m b))
-> CondT a m b
-> StateT a m (Result a m b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CondT a m b -> StateT a m (Result a m b)
forall a (m :: * -> *) b. CondT a m b -> StateT a m (Result a m b)
getCondT
    generalBracket :: forall a b c. HasCallStack =>
      CondT aa m a ->
      (a -> ExitCase b -> CondT aa m c) ->
      (a -> CondT aa m b) ->
      CondT aa m (b, c)
    generalBracket :: forall a b c.
HasCallStack =>
CondT aa m a
-> (a -> ExitCase b -> CondT aa m c)
-> (a -> CondT aa m b)
-> CondT aa m (b, c)
generalBracket CondT aa m a
acquire a -> ExitCase b -> CondT aa m c
release a -> CondT aa m b
use = StateT aa m (Result aa m (b, c)) -> CondT aa m (b, c)
forall a (m :: * -> *) b. StateT a m (Result a m b) -> CondT a m b
CondT StateT aa m (Result aa m (b, c))
go
      where
        arg1 :: StateT aa m (Result aa m a)
        arg1 :: StateT aa m (Result aa m a)
arg1 = CondT aa m a -> StateT aa m (Result aa m a)
forall a (m :: * -> *) b. CondT a m b -> StateT a m (Result a m b)
getCondT CondT aa m a
acquire
        arg2 :: (Result aa m a) -> ExitCase (Result aa m b) -> StateT aa m (Result aa m c)
        arg2 :: Result aa m a
-> ExitCase (Result aa m b) -> StateT aa m (Result aa m c)
arg2 Result aa m a
a ExitCase (Result aa m b)
b = case Result aa m a
a of
          Result aa m a
Ignore -> Result aa m c -> StateT aa m (Result aa m c)
forall a. a -> StateT aa m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Result aa m c
forall a (m :: * -> *) b. Result a m b
Ignore
          Keep a
a' ->
            case ExitCase (Result aa m b)
b of
              ExitCaseSuccess Result aa m b
b' ->
                case Result aa m b
b' of
                  Result aa m b
Ignore -> CondT aa m c -> StateT aa m (Result aa m c)
forall a (m :: * -> *) b. CondT a m b -> StateT a m (Result a m b)
getCondT (CondT aa m c -> StateT aa m (Result aa m c))
-> CondT aa m c -> StateT aa m (Result aa m c)
forall a b. (a -> b) -> a -> b
$ a -> ExitCase b -> CondT aa m c
release a
a' ExitCase b
forall a. ExitCase a
ExitCaseAbort
                  Keep b
b'' -> CondT aa m c -> StateT aa m (Result aa m c)
forall a (m :: * -> *) b. CondT a m b -> StateT a m (Result a m b)
getCondT (CondT aa m c -> StateT aa m (Result aa m c))
-> CondT aa m c -> StateT aa m (Result aa m c)
forall a b. (a -> b) -> a -> b
$ a -> ExitCase b -> CondT aa m c
release a
a' (b -> ExitCase b
forall a. a -> ExitCase a
ExitCaseSuccess b
b'')
                  RecurseOnly Maybe (CondT aa m b)
_mb -> CondT aa m c -> StateT aa m (Result aa m c)
forall a (m :: * -> *) b. CondT a m b -> StateT a m (Result a m b)
getCondT (CondT aa m c -> StateT aa m (Result aa m c))
-> CondT aa m c -> StateT aa m (Result aa m c)
forall a b. (a -> b) -> a -> b
$ a -> ExitCase b -> CondT aa m c
release a
a' ExitCase b
forall a. ExitCase a
ExitCaseAbort -- set mb?
                  KeepAndRecurse b
b'' Maybe (CondT aa m b)
_mb -> CondT aa m c -> StateT aa m (Result aa m c)
forall a (m :: * -> *) b. CondT a m b -> StateT a m (Result a m b)
getCondT (CondT aa m c -> StateT aa m (Result aa m c))
-> CondT aa m c -> StateT aa m (Result aa m c)
forall a b. (a -> b) -> a -> b
$ a -> ExitCase b -> CondT aa m c
release a
a' (b -> ExitCase b
forall a. a -> ExitCase a
ExitCaseSuccess b
b'') -- set mb?
              ExitCaseException SomeException
se -> CondT aa m c -> StateT aa m (Result aa m c)
forall a (m :: * -> *) b. CondT a m b -> StateT a m (Result a m b)
getCondT (CondT aa m c -> StateT aa m (Result aa m c))
-> CondT aa m c -> StateT aa m (Result aa m c)
forall a b. (a -> b) -> a -> b
$ a -> ExitCase b -> CondT aa m c
release a
a' (SomeException -> ExitCase b
forall a. SomeException -> ExitCase a
ExitCaseException SomeException
se)
              ExitCase (Result aa m b)
ExitCaseAbort -> CondT aa m c -> StateT aa m (Result aa m c)
forall a (m :: * -> *) b. CondT a m b -> StateT a m (Result a m b)
getCondT (CondT aa m c -> StateT aa m (Result aa m c))
-> CondT aa m c -> StateT aa m (Result aa m c)
forall a b. (a -> b) -> a -> b
$ a -> ExitCase b -> CondT aa m c
release a
a' ExitCase b
forall a. ExitCase a
ExitCaseAbort
          RecurseOnly Maybe (CondT aa m a)
_ma ->
            Result aa m c -> StateT aa m (Result aa m c)
forall a. a -> StateT aa m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Result aa m c
forall a (m :: * -> *) b. Result a m b
Ignore
          KeepAndRecurse a
a' Maybe (CondT aa m a)
_ma ->
            case ExitCase (Result aa m b)
b of
              ExitCaseSuccess Result aa m b
b' ->
                case Result aa m b
b' of
                  Result aa m b
Ignore -> CondT aa m c -> StateT aa m (Result aa m c)
forall a (m :: * -> *) b. CondT a m b -> StateT a m (Result a m b)
getCondT (CondT aa m c -> StateT aa m (Result aa m c))
-> CondT aa m c -> StateT aa m (Result aa m c)
forall a b. (a -> b) -> a -> b
$ a -> ExitCase b -> CondT aa m c
release a
a' ExitCase b
forall a. ExitCase a
ExitCaseAbort
                  Keep b
b'' -> CondT aa m c -> StateT aa m (Result aa m c)
forall a (m :: * -> *) b. CondT a m b -> StateT a m (Result a m b)
getCondT (CondT aa m c -> StateT aa m (Result aa m c))
-> CondT aa m c -> StateT aa m (Result aa m c)
forall a b. (a -> b) -> a -> b
$ a -> ExitCase b -> CondT aa m c
release a
a' (b -> ExitCase b
forall a. a -> ExitCase a
ExitCaseSuccess b
b'')
                  RecurseOnly Maybe (CondT aa m b)
_mb -> CondT aa m c -> StateT aa m (Result aa m c)
forall a (m :: * -> *) b. CondT a m b -> StateT a m (Result a m b)
getCondT (CondT aa m c -> StateT aa m (Result aa m c))
-> CondT aa m c -> StateT aa m (Result aa m c)
forall a b. (a -> b) -> a -> b
$ a -> ExitCase b -> CondT aa m c
release a
a' ExitCase b
forall a. ExitCase a
ExitCaseAbort -- set mb?
                  KeepAndRecurse b
b'' Maybe (CondT aa m b)
_mb -> CondT aa m c -> StateT aa m (Result aa m c)
forall a (m :: * -> *) b. CondT a m b -> StateT a m (Result a m b)
getCondT (CondT aa m c -> StateT aa m (Result aa m c))
-> CondT aa m c -> StateT aa m (Result aa m c)
forall a b. (a -> b) -> a -> b
$ a -> ExitCase b -> CondT aa m c
release a
a' (b -> ExitCase b
forall a. a -> ExitCase a
ExitCaseSuccess b
b'') -- set mb?
              ExitCaseException SomeException
se -> CondT aa m c -> StateT aa m (Result aa m c)
forall a (m :: * -> *) b. CondT a m b -> StateT a m (Result a m b)
getCondT (CondT aa m c -> StateT aa m (Result aa m c))
-> CondT aa m c -> StateT aa m (Result aa m c)
forall a b. (a -> b) -> a -> b
$ a -> ExitCase b -> CondT aa m c
release a
a' (SomeException -> ExitCase b
forall a. SomeException -> ExitCase a
ExitCaseException SomeException
se)
              ExitCase (Result aa m b)
ExitCaseAbort -> CondT aa m c -> StateT aa m (Result aa m c)
forall a (m :: * -> *) b. CondT a m b -> StateT a m (Result a m b)
getCondT (CondT aa m c -> StateT aa m (Result aa m c))
-> CondT aa m c -> StateT aa m (Result aa m c)
forall a b. (a -> b) -> a -> b
$ a -> ExitCase b -> CondT aa m c
release a
a' ExitCase b
forall a. ExitCase a
ExitCaseAbort

        arg3 :: (Result aa m a) -> StateT aa m (Result aa m b)
        arg3 :: Result aa m a -> StateT aa m (Result aa m b)
arg3 Result aa m a
a = CondT aa m b -> StateT aa m (Result aa m b)
forall a (m :: * -> *) b. CondT a m b -> StateT a m (Result a m b)
getCondT (StateT aa m (Result aa m a) -> CondT aa m a
forall a (m :: * -> *) b. StateT a m (Result a m b) -> CondT a m b
CondT (Result aa m a -> StateT aa m (Result aa m a)
forall a. a -> StateT aa m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Result aa m a
a) CondT aa m a -> (a -> CondT aa m b) -> CondT aa m b
forall a b. CondT aa m a -> (a -> CondT aa m b) -> CondT aa m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> CondT aa m b
use)

        go :: StateT aa m (Result aa m (b, c))
go = do
          StateT aa m (Result aa m a)
-> (Result aa m a
    -> ExitCase (Result aa m b) -> StateT aa m (Result aa m c))
-> (Result aa m a -> StateT aa m (Result aa m b))
-> StateT aa m (Result aa m b, Result aa m c)
forall a b c.
HasCallStack =>
StateT aa m a
-> (a -> ExitCase b -> StateT aa m c)
-> (a -> StateT aa m b)
-> StateT aa m (b, c)
forall (m :: * -> *) a b c.
(MonadMask m, HasCallStack) =>
m a -> (a -> ExitCase b -> m c) -> (a -> m b) -> m (b, c)
generalBracket StateT aa m (Result aa m a)
arg1 Result aa m a
-> ExitCase (Result aa m b) -> StateT aa m (Result aa m c)
arg2 Result aa m a -> StateT aa m (Result aa m b)
arg3 StateT aa m (Result aa m b, Result aa m c)
-> ((Result aa m b, Result aa m c)
    -> StateT aa m (Result aa m (b, c)))
-> StateT aa m (Result aa m (b, c))
forall a b. StateT aa m a -> (a -> StateT aa m b) -> StateT aa m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
            -- anyway looks like a total nonsense - i give up
            (Keep b
b, Keep c
c) -> Result aa m (b, c) -> StateT aa m (Result aa m (b, c))
forall a. a -> StateT aa m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Result aa m (b, c) -> StateT aa m (Result aa m (b, c)))
-> Result aa m (b, c) -> StateT aa m (Result aa m (b, c))
forall a b. (a -> b) -> a -> b
$ (b, c) -> Result aa m (b, c)
forall a (m :: * -> *) b. b -> Result a m b
Keep (b
b, c
c)
            (RecurseOnly Maybe (CondT aa m b)
mb, RecurseOnly Maybe (CondT aa m c)
mc) -> Result aa m (b, c) -> StateT aa m (Result aa m (b, c))
forall a. a -> StateT aa m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Result aa m (b, c) -> StateT aa m (Result aa m (b, c)))
-> Result aa m (b, c) -> StateT aa m (Result aa m (b, c))
forall a b. (a -> b) -> a -> b
$ Maybe (CondT aa m (b, c)) -> Result aa m (b, c)
forall a (m :: * -> *) b. Maybe (CondT a m b) -> Result a m b
RecurseOnly ((b -> c -> (b, c))
-> CondT aa m b -> CondT aa m c -> CondT aa m (b, c)
forall a b c.
(a -> b -> c) -> CondT aa m a -> CondT aa m b -> CondT aa m c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (,) (CondT aa m b -> CondT aa m c -> CondT aa m (b, c))
-> Maybe (CondT aa m b)
-> Maybe (CondT aa m c -> CondT aa m (b, c))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (CondT aa m b)
mb Maybe (CondT aa m c -> CondT aa m (b, c))
-> Maybe (CondT aa m c) -> Maybe (CondT aa m (b, c))
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe (CondT aa m c)
mc)
            (KeepAndRecurse b
b Maybe (CondT aa m b)
mb, KeepAndRecurse c
c Maybe (CondT aa m c)
mc) ->
              Result aa m (b, c) -> StateT aa m (Result aa m (b, c))
forall a. a -> StateT aa m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Result aa m (b, c) -> StateT aa m (Result aa m (b, c)))
-> Result aa m (b, c) -> StateT aa m (Result aa m (b, c))
forall a b. (a -> b) -> a -> b
$ (b, c) -> Maybe (CondT aa m (b, c)) -> Result aa m (b, c)
forall a (m :: * -> *) b. b -> Maybe (CondT a m b) -> Result a m b
KeepAndRecurse (b
b, c
c) ((b -> c -> (b, c))
-> CondT aa m b -> CondT aa m c -> CondT aa m (b, c)
forall a b c.
(a -> b -> c) -> CondT aa m a -> CondT aa m b -> CondT aa m c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (,) (CondT aa m b -> CondT aa m c -> CondT aa m (b, c))
-> Maybe (CondT aa m b)
-> Maybe (CondT aa m c -> CondT aa m (b, c))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (CondT aa m b)
mb Maybe (CondT aa m c -> CondT aa m (b, c))
-> Maybe (CondT aa m c) -> Maybe (CondT aa m (b, c))
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe (CondT aa m c)
mc)
            (Keep b
b, KeepAndRecurse c
c Maybe (CondT aa m c)
_) -> Result aa m (b, c) -> StateT aa m (Result aa m (b, c))
forall a. a -> StateT aa m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Result aa m (b, c) -> StateT aa m (Result aa m (b, c)))
-> Result aa m (b, c) -> StateT aa m (Result aa m (b, c))
forall a b. (a -> b) -> a -> b
$ (b, c) -> Result aa m (b, c)
forall a (m :: * -> *) b. b -> Result a m b
Keep (b
b, c
c)
            (KeepAndRecurse b
b Maybe (CondT aa m b)
_, Keep c
c) -> Result aa m (b, c) -> StateT aa m (Result aa m (b, c))
forall a. a -> StateT aa m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Result aa m (b, c) -> StateT aa m (Result aa m (b, c)))
-> Result aa m (b, c) -> StateT aa m (Result aa m (b, c))
forall a b. (a -> b) -> a -> b
$ (b, c) -> Result aa m (b, c)
forall a (m :: * -> *) b. b -> Result a m b
Keep (b
b, c
c)
            (KeepAndRecurse b
_ Maybe (CondT aa m b)
mb, RecurseOnly Maybe (CondT aa m c)
mc) -> Result aa m (b, c) -> StateT aa m (Result aa m (b, c))
forall a. a -> StateT aa m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Result aa m (b, c) -> StateT aa m (Result aa m (b, c)))
-> Result aa m (b, c) -> StateT aa m (Result aa m (b, c))
forall a b. (a -> b) -> a -> b
$ Maybe (CondT aa m (b, c)) -> Result aa m (b, c)
forall a (m :: * -> *) b. Maybe (CondT a m b) -> Result a m b
RecurseOnly ((b -> c -> (b, c))
-> CondT aa m b -> CondT aa m c -> CondT aa m (b, c)
forall a b c.
(a -> b -> c) -> CondT aa m a -> CondT aa m b -> CondT aa m c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (,) (CondT aa m b -> CondT aa m c -> CondT aa m (b, c))
-> Maybe (CondT aa m b)
-> Maybe (CondT aa m c -> CondT aa m (b, c))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (CondT aa m b)
mb Maybe (CondT aa m c -> CondT aa m (b, c))
-> Maybe (CondT aa m c) -> Maybe (CondT aa m (b, c))
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe (CondT aa m c)
mc)
            (RecurseOnly Maybe (CondT aa m b)
mb, KeepAndRecurse c
_ Maybe (CondT aa m c)
mc) -> Result aa m (b, c) -> StateT aa m (Result aa m (b, c))
forall a. a -> StateT aa m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Result aa m (b, c) -> StateT aa m (Result aa m (b, c)))
-> Result aa m (b, c) -> StateT aa m (Result aa m (b, c))
forall a b. (a -> b) -> a -> b
$ Maybe (CondT aa m (b, c)) -> Result aa m (b, c)
forall a (m :: * -> *) b. Maybe (CondT a m b) -> Result a m b
RecurseOnly ((b -> c -> (b, c))
-> CondT aa m b -> CondT aa m c -> CondT aa m (b, c)
forall a b c.
(a -> b -> c) -> CondT aa m a -> CondT aa m b -> CondT aa m c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (,) (CondT aa m b -> CondT aa m c -> CondT aa m (b, c))
-> Maybe (CondT aa m b)
-> Maybe (CondT aa m c -> CondT aa m (b, c))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (CondT aa m b)
mb Maybe (CondT aa m c -> CondT aa m (b, c))
-> Maybe (CondT aa m c) -> Maybe (CondT aa m (b, c))
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe (CondT aa m c)
mc)
            (Result aa m b, Result aa m c)
_ -> Result aa m (b, c) -> StateT aa m (Result aa m (b, c))
forall a. a -> StateT aa m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Result aa m (b, c)
forall a (m :: * -> *) b. Result a m b
Ignore

instance MonadBase b m => MonadBase b (CondT a m) where
    liftBase :: forall α. b α -> CondT a m α
liftBase b α
m = StateT a m (Result a m α) -> CondT a m α
forall a (m :: * -> *) b. StateT a m (Result a m b) -> CondT a m b
CondT (StateT a m (Result a m α) -> CondT a m α)
-> StateT a m (Result a m α) -> CondT a m α
forall a b. (a -> b) -> a -> b
$ (α -> Result a m α) -> StateT a m α -> StateT a m (Result a m α)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM α -> Result a m α
forall b a (m :: * -> *). b -> Result a m b
accept' (StateT a m α -> StateT a m (Result a m α))
-> StateT a m α -> StateT a m (Result a m α)
forall a b. (a -> b) -> a -> b
$ b α -> StateT a m α
forall α. b α -> StateT a m α
forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase b α
m
    {-# INLINE liftBase #-}

instance MonadIO m => MonadIO (CondT a m) where
    liftIO :: forall a. IO a -> CondT a m a
liftIO IO a
m = StateT a m (Result a m a) -> CondT a m a
forall a (m :: * -> *) b. StateT a m (Result a m b) -> CondT a m b
CondT (StateT a m (Result a m a) -> CondT a m a)
-> StateT a m (Result a m a) -> CondT a m a
forall a b. (a -> b) -> a -> b
$ (a -> Result a m a) -> StateT a m a -> StateT a m (Result a m a)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM a -> Result a m a
forall b a (m :: * -> *). b -> Result a m b
accept' (StateT a m a -> StateT a m (Result a m a))
-> StateT a m a -> StateT a m (Result a m a)
forall a b. (a -> b) -> a -> b
$ IO a -> StateT a m a
forall a. IO a -> StateT a m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO a
m
    {-# INLINE liftIO #-}

instance MonadTrans (CondT a) where
    lift :: forall (m :: * -> *) a. Monad m => m a -> CondT a m a
lift m a
m = StateT a m (Result a m a) -> CondT a m a
forall a (m :: * -> *) b. StateT a m (Result a m b) -> CondT a m b
CondT (StateT a m (Result a m a) -> CondT a m a)
-> StateT a m (Result a m a) -> CondT a m a
forall a b. (a -> b) -> a -> b
$ (a -> Result a m a) -> StateT a m a -> StateT a m (Result a m a)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM a -> Result a m a
forall b a (m :: * -> *). b -> Result a m b
accept' (StateT a m a -> StateT a m (Result a m a))
-> StateT a m a -> StateT a m (Result a m a)
forall a b. (a -> b) -> a -> b
$ m a -> StateT a m a
forall (m :: * -> *) a. Monad m => m a -> StateT a m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m a
m
    {-# INLINE lift #-}

instance MonadBaseControl b m => MonadBaseControl b (CondT r m) where
    type StM (CondT r m) a = StM m (Result r m a, r)
    liftBaseWith :: forall a. (RunInBase (CondT r m) b -> b a) -> CondT r m a
liftBaseWith RunInBase (CondT r m) b -> b a
f = StateT r m (Result r m a) -> CondT r m a
forall a (m :: * -> *) b. StateT a m (Result a m b) -> CondT a m b
CondT (StateT r m (Result r m a) -> CondT r m a)
-> StateT r m (Result r m a) -> CondT r m a
forall a b. (a -> b) -> a -> b
$ (r -> m (Result r m a, r)) -> StateT r m (Result r m a)
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
StateT ((r -> m (Result r m a, r)) -> StateT r m (Result r m a))
-> (r -> m (Result r m a, r)) -> StateT r m (Result r m a)
forall a b. (a -> b) -> a -> b
$ \r
s ->
        (a -> (Result r m a, r)) -> m a -> m (Result r m a, r)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (\a
x -> (a -> Result r m a
forall b a (m :: * -> *). b -> Result a m b
accept' a
x, r
s)) (m a -> m (Result r m a, r)) -> m a -> m (Result r m a, r)
forall a b. (a -> b) -> a -> b
$ (RunInBase m b -> b a) -> m a
forall a. (RunInBase m b -> b a) -> m a
forall (b :: * -> *) (m :: * -> *) a.
MonadBaseControl b m =>
(RunInBase m b -> b a) -> m a
liftBaseWith ((RunInBase m b -> b a) -> m a) -> (RunInBase m b -> b a) -> m a
forall a b. (a -> b) -> a -> b
$ \RunInBase m b
runInBase -> RunInBase (CondT r m) b -> b a
f (RunInBase (CondT r m) b -> b a) -> RunInBase (CondT r m) b -> b a
forall a b. (a -> b) -> a -> b
$ \CondT r m a
k ->
            m (Result r m a, r) -> b (StM m (Result r m a, r))
RunInBase m b
runInBase (m (Result r m a, r) -> b (StM m (Result r m a, r)))
-> m (Result r m a, r) -> b (StM m (Result r m a, r))
forall a b. (a -> b) -> a -> b
$ StateT r m (Result r m a) -> r -> m (Result r m a, r)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT (CondT r m a -> StateT r m (Result r m a)
forall a (m :: * -> *) b. CondT a m b -> StateT a m (Result a m b)
getCondT CondT r m a
k) r
s
    restoreM :: forall a. StM (CondT r m) a -> CondT r m a
restoreM = StateT r m (Result r m a) -> CondT r m a
forall a (m :: * -> *) b. StateT a m (Result a m b) -> CondT a m b
CondT (StateT r m (Result r m a) -> CondT r m a)
-> (StM m (Result r m a, r) -> StateT r m (Result r m a))
-> StM m (Result r m a, r)
-> CondT r m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (r -> m (Result r m a, r)) -> StateT r m (Result r m a)
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
StateT ((r -> m (Result r m a, r)) -> StateT r m (Result r m a))
-> (StM m (Result r m a, r) -> r -> m (Result r m a, r))
-> StM m (Result r m a, r)
-> StateT r m (Result r m a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m (Result r m a, r) -> r -> m (Result r m a, r)
forall a b. a -> b -> a
const (m (Result r m a, r) -> r -> m (Result r m a, r))
-> (StM m (Result r m a, r) -> m (Result r m a, r))
-> StM m (Result r m a, r)
-> r
-> m (Result r m a, r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StM m (Result r m a, r) -> m (Result r m a, r)
forall a. StM m a -> m a
forall (b :: * -> *) (m :: * -> *) a.
MonadBaseControl b m =>
StM m a -> m a
restoreM
    {-# INLINE liftBaseWith #-}
    {-# INLINE restoreM #-}

instance MFunctor (CondT a) where
    hoist :: forall (m :: * -> *) (n :: * -> *) b.
Monad m =>
(forall a. m a -> n a) -> CondT a m b -> CondT a n b
hoist forall a. m a -> n a
nat (CondT StateT a m (Result a m b)
m) = StateT a n (Result a n b) -> CondT a n b
forall a (m :: * -> *) b. StateT a m (Result a m b) -> CondT a m b
CondT (StateT a n (Result a n b) -> CondT a n b)
-> StateT a n (Result a n b) -> CondT a n b
forall a b. (a -> b) -> a -> b
$ (forall a. m a -> n a)
-> StateT a m (Result a n b) -> StateT a n (Result a n b)
forall {k} (t :: (* -> *) -> k -> *) (m :: * -> *) (n :: * -> *)
       (b :: k).
(MFunctor t, Monad m) =>
(forall a. m a -> n a) -> t m b -> t n b
forall (m :: * -> *) (n :: * -> *) b.
Monad m =>
(forall a. m a -> n a) -> StateT a m b -> StateT a n b
hoist m a -> n a
forall a. m a -> n a
nat ((Result a m b -> Result a n b)
-> StateT a m (Result a m b) -> StateT a m (Result a n b)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM ((forall a. m a -> n a) -> Result a m b -> Result a n b
forall {k} (t :: (* -> *) -> k -> *) (m :: * -> *) (n :: * -> *)
       (b :: k).
(MFunctor t, Monad m) =>
(forall a. m a -> n a) -> t m b -> t n b
forall (m :: * -> *) (n :: * -> *) b.
Monad m =>
(forall a. m a -> n a) -> Result a m b -> Result a n b
hoist m a -> n a
forall a. m a -> n a
nat) StateT a m (Result a m b)
m)
    {-# INLINE hoist #-}

runCondT :: Monad m => CondT a m b -> a -> m (Maybe b)
runCondT :: forall (m :: * -> *) a b.
Monad m =>
CondT a m b -> a -> m (Maybe b)
runCondT (CondT StateT a m (Result a m b)
f) a
a = Result a m b -> Maybe b
forall r (m :: * -> *) a. Result r m a -> Maybe a
maybeFromResult (Result a m b -> Maybe b) -> m (Result a m b) -> m (Maybe b)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` StateT a m (Result a m b) -> a -> m (Result a m b)
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT StateT a m (Result a m b)
f a
a
{-# INLINE runCondT #-}

runCond :: Cond a b -> a -> Maybe b
runCond :: forall a b. Cond a b -> a -> Maybe b
runCond = (Identity (Maybe b) -> Maybe b
forall a. Identity a -> a
runIdentity (Identity (Maybe b) -> Maybe b)
-> (a -> Identity (Maybe b)) -> a -> Maybe b
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) ((a -> Identity (Maybe b)) -> a -> Maybe b)
-> (Cond a b -> a -> Identity (Maybe b))
-> Cond a b
-> a
-> Maybe b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Cond a b -> a -> Identity (Maybe b)
forall (m :: * -> *) a b.
Monad m =>
CondT a m b -> a -> m (Maybe b)
runCondT
{-# INLINE runCond #-}

-- | Case analysis of applying a condition to an input value.  The result is a
--   pair whose first part is a pair of Maybes specifying if the input matched
--   and if recursion is expected from this value, and whose second part is
--   the (possibly) mutated input value.
applyCondT :: Monad m
           => a
           -> CondT a m b
           -> m ((Maybe b, Maybe (CondT a m b)), a)
applyCondT :: forall (m :: * -> *) a b.
Monad m =>
a -> CondT a m b -> m ((Maybe b, Maybe (CondT a m b)), a)
applyCondT a
a CondT a m b
cond = do
    -- Apply a condition to the input value, determining the result and the
    -- mutated value.
    (Result a m b
r, a
a') <- StateT a m (Result a m b) -> a -> m (Result a m b, a)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT (CondT a m b -> StateT a m (Result a m b)
forall a (m :: * -> *) b. CondT a m b -> StateT a m (Result a m b)
getCondT CondT a m b
cond) a
a

    -- Convert from the 'Result' to a pair of Maybes: one to specify if the
    -- predicate succeeded, and the other to specify if recursion should be
    -- performed.  If there is no sub-recursion specified, return 'cond'.
    ((Maybe b, Maybe (CondT a m b)), a)
-> m ((Maybe b, Maybe (CondT a m b)), a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ((Maybe (CondT a m b) -> Maybe (CondT a m b))
-> (Maybe b, Maybe (CondT a m b)) -> (Maybe b, Maybe (CondT a m b))
forall a b. (a -> b) -> (Maybe b, a) -> (Maybe b, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (CondT a m b -> Maybe (CondT a m b)
forall a. a -> Maybe a
Just (CondT a m b -> Maybe (CondT a m b))
-> (Maybe (CondT a m b) -> CondT a m b)
-> Maybe (CondT a m b)
-> Maybe (CondT a m b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CondT a m b -> Maybe (CondT a m b) -> CondT a m b
forall a. a -> Maybe a -> a
fromMaybe CondT a m b
cond) (Result a m b -> (Maybe b, Maybe (CondT a m b))
forall a (m :: * -> *) b.
Result a m b -> (Maybe b, Maybe (CondT a m b))
getResult Result a m b
r), a
a')
{-# INLINE applyCondT #-}

-- | Case analysis of applying a pure condition to an input value.  The result
--   is a pair whose first part is a pair of Maybes specifying if the input
--   matched and if recursion is expected from this value, and whose second
--   part is the (possibly) mutated input value.
applyCond :: a -> Cond a b -> ((Maybe b, Maybe (Cond a b)), a)
applyCond :: forall a b. a -> Cond a b -> ((Maybe b, Maybe (Cond a b)), a)
applyCond a
a Cond a b
cond = (Result a Identity b -> (Maybe b, Maybe (Cond a b)))
-> (Result a Identity b, a) -> ((Maybe b, Maybe (Cond a b)), a)
forall b c d. (b -> c) -> (b, d) -> (c, d)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first ((Maybe (Cond a b) -> Maybe (Cond a b))
-> (Maybe b, Maybe (Cond a b)) -> (Maybe b, Maybe (Cond a b))
forall a b. (a -> b) -> (Maybe b, a) -> (Maybe b, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Cond a b -> Maybe (Cond a b)
forall a. a -> Maybe a
Just (Cond a b -> Maybe (Cond a b))
-> (Maybe (Cond a b) -> Cond a b)
-> Maybe (Cond a b)
-> Maybe (Cond a b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Cond a b -> Maybe (Cond a b) -> Cond a b
forall a. a -> Maybe a -> a
fromMaybe Cond a b
cond) ((Maybe b, Maybe (Cond a b)) -> (Maybe b, Maybe (Cond a b)))
-> (Result a Identity b -> (Maybe b, Maybe (Cond a b)))
-> Result a Identity b
-> (Maybe b, Maybe (Cond a b))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Result a Identity b -> (Maybe b, Maybe (Cond a b))
forall a (m :: * -> *) b.
Result a m b -> (Maybe b, Maybe (CondT a m b))
getResult)
                       (Identity (Result a Identity b, a) -> (Result a Identity b, a)
forall a. Identity a -> a
runIdentity (StateT a Identity (Result a Identity b)
-> a -> Identity (Result a Identity b, a)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT (Cond a b -> StateT a Identity (Result a Identity b)
forall a (m :: * -> *) b. CondT a m b -> StateT a m (Result a m b)
getCondT Cond a b
cond) a
a))
{-# INLINE applyCond #-}

guardM :: Monad m => m Bool -> CondT a m ()
guardM :: forall (m :: * -> *) a. Monad m => m Bool -> CondT a m ()
guardM m Bool
m = m Bool -> CondT a m Bool
forall (m :: * -> *) a. Monad m => m a -> CondT a m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m Bool
m CondT a m Bool -> (Bool -> CondT a m ()) -> CondT a m ()
forall a b. CondT a m a -> (a -> CondT a m b) -> CondT a m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Bool -> CondT a m ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard
{-# INLINE guardM #-}

guard_ :: Monad m => (a -> Bool) -> CondT a m ()
guard_ :: forall (m :: * -> *) a. Monad m => (a -> Bool) -> CondT a m ()
guard_ a -> Bool
f = (a -> Bool) -> CondT a m Bool
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks a -> Bool
f CondT a m Bool -> (Bool -> CondT a m ()) -> CondT a m ()
forall a b. CondT a m a -> (a -> CondT a m b) -> CondT a m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Bool -> CondT a m ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard
{-# INLINE guard_ #-}

guardM_ :: Monad m => (a -> m Bool) -> CondT a m ()
guardM_ :: forall (m :: * -> *) a. Monad m => (a -> m Bool) -> CondT a m ()
guardM_ a -> m Bool
f = CondT a m a
forall r (m :: * -> *). MonadReader r m => m r
ask CondT a m a -> (a -> CondT a m Bool) -> CondT a m Bool
forall a b. CondT a m a -> (a -> CondT a m b) -> CondT a m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= m Bool -> CondT a m Bool
forall (m :: * -> *) a. Monad m => m a -> CondT a m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m Bool -> CondT a m Bool) -> (a -> m Bool) -> a -> CondT a m Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> m Bool
f CondT a m Bool -> (Bool -> CondT a m ()) -> CondT a m ()
forall a b. CondT a m a -> (a -> CondT a m b) -> CondT a m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Bool -> CondT a m ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard
{-# INLINE guardM_ #-}

apply :: Monad m => (a -> m (Maybe b)) -> CondT a m b
apply :: forall (m :: * -> *) a b.
Monad m =>
(a -> m (Maybe b)) -> CondT a m b
apply a -> m (Maybe b)
f = StateT a m (Result a m b) -> CondT a m b
forall a (m :: * -> *) b. StateT a m (Result a m b) -> CondT a m b
CondT (StateT a m (Result a m b) -> CondT a m b)
-> StateT a m (Result a m b) -> CondT a m b
forall a b. (a -> b) -> a -> b
$ StateT a m a
forall s (m :: * -> *). MonadState s m => m s
get StateT a m a
-> (a -> StateT a m (Result a m b)) -> StateT a m (Result a m b)
forall a b. StateT a m a -> (a -> StateT a m b) -> StateT a m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Maybe b -> Result a m b)
-> StateT a m (Maybe b) -> StateT a m (Result a m b)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Maybe b -> Result a m b
forall a r (m :: * -> *). Maybe a -> Result r m a
maybeToResult (StateT a m (Maybe b) -> StateT a m (Result a m b))
-> (a -> StateT a m (Maybe b)) -> a -> StateT a m (Result a m b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m (Maybe b) -> StateT a m (Maybe b)
forall (m :: * -> *) a. Monad m => m a -> StateT a m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Maybe b) -> StateT a m (Maybe b))
-> (a -> m (Maybe b)) -> a -> StateT a m (Maybe b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> m (Maybe b)
f
{-# INLINE apply #-}

consider :: Monad m => (a -> m (Maybe (b, a))) -> CondT a m b
consider :: forall (m :: * -> *) a b.
Monad m =>
(a -> m (Maybe (b, a))) -> CondT a m b
consider a -> m (Maybe (b, a))
f = StateT a m (Result a m b) -> CondT a m b
forall a (m :: * -> *) b. StateT a m (Result a m b) -> CondT a m b
CondT (StateT a m (Result a m b) -> CondT a m b)
-> StateT a m (Result a m b) -> CondT a m b
forall a b. (a -> b) -> a -> b
$ do
    Maybe (b, a)
mres <- m (Maybe (b, a)) -> StateT a m (Maybe (b, a))
forall (m :: * -> *) a. Monad m => m a -> StateT a m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Maybe (b, a)) -> StateT a m (Maybe (b, a)))
-> (a -> m (Maybe (b, a))) -> a -> StateT a m (Maybe (b, a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> m (Maybe (b, a))
f (a -> StateT a m (Maybe (b, a)))
-> StateT a m a -> StateT a m (Maybe (b, a))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< StateT a m a
forall s (m :: * -> *). MonadState s m => m s
get
    case Maybe (b, a)
mres of
        Maybe (b, a)
Nothing      -> Result a m b -> StateT a m (Result a m b)
forall a. a -> StateT a m a
forall (m :: * -> *) a. Monad m => a -> m a
return Result a m b
forall a (m :: * -> *) b. Result a m b
Ignore
        Just (b
b, a
a') -> a -> StateT a m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put a
a' StateT a m ()
-> StateT a m (Result a m b) -> StateT a m (Result a m b)
forall a b. StateT a m a -> StateT a m b -> StateT a m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Result a m b -> StateT a m (Result a m b)
forall a. a -> StateT a m a
forall (m :: * -> *) a. Monad m => a -> m a
return (b -> Result a m b
forall b a (m :: * -> *). b -> Result a m b
accept' b
b)
{-# INLINE consider #-}

-- | Return True or False depending on whether the given condition matches or
--   not.  This differs from simply stating the condition in that it itself
--   always succeeds.
--
-- >>> flip runCond "foo.hs" $ matches (guard =<< asks (== "foo.hs"))
-- Just True
-- >>> flip runCond "foo.hs" $ matches (guard =<< asks (== "foo.hi"))
-- Just False
matches :: Monad m => CondT a m b -> CondT a m Bool
matches :: forall (m :: * -> *) a b. Monad m => CondT a m b -> CondT a m Bool
matches = (Maybe b -> Bool) -> CondT a m (Maybe b) -> CondT a m Bool
forall a b. (a -> b) -> CondT a m a -> CondT a m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe b -> Bool
forall a. Maybe a -> Bool
isJust (CondT a m (Maybe b) -> CondT a m Bool)
-> (CondT a m b -> CondT a m (Maybe b))
-> CondT a m b
-> CondT a m Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CondT a m b -> CondT a m (Maybe b)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional
{-# INLINE matches #-}

-- | A variant of ifM which branches on whether the condition succeeds or not.
--   Note that @if_ x@ is equivalent to @ifM (matches x)@, and is provided
--   solely for convenience.
--
-- >>> let good = guard_ (== "foo.hs") :: Cond String ()
-- >>> let bad  = guard_ (== "foo.hi") :: Cond String ()
-- >>> flip runCond "foo.hs" $ if_ good (return "Success") (return "Failure")
-- Just "Success"
-- >>> flip runCond "foo.hs" $ if_ bad (return "Success") (return "Failure")
-- Just "Failure"
if_ :: Monad m => CondT a m r -> CondT a m b -> CondT a m b -> CondT a m b
if_ :: forall (m :: * -> *) a r b.
Monad m =>
CondT a m r -> CondT a m b -> CondT a m b -> CondT a m b
if_ CondT a m r
c CondT a m b
x CondT a m b
y =
    StateT a m (Result a m b) -> CondT a m b
forall a (m :: * -> *) b. StateT a m (Result a m b) -> CondT a m b
CondT (StateT a m (Result a m b) -> CondT a m b)
-> StateT a m (Result a m b) -> CondT a m b
forall a b. (a -> b) -> a -> b
$ CondT a m b -> StateT a m (Result a m b)
forall a (m :: * -> *) b. CondT a m b -> StateT a m (Result a m b)
getCondT (CondT a m b -> StateT a m (Result a m b))
-> (Result a m r -> CondT a m b)
-> Result a m r
-> StateT a m (Result a m b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CondT a m b -> (r -> CondT a m b) -> Maybe r -> CondT a m b
forall b a. b -> (a -> b) -> Maybe a -> b
maybe CondT a m b
y (CondT a m b -> r -> CondT a m b
forall a b. a -> b -> a
const CondT a m b
x) (Maybe r -> CondT a m b)
-> (Result a m r -> Maybe r) -> Result a m r -> CondT a m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Result a m r -> Maybe r
forall r (m :: * -> *) a. Result r m a -> Maybe a
maybeFromResult (Result a m r -> StateT a m (Result a m b))
-> StateT a m (Result a m r) -> StateT a m (Result a m b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< CondT a m r -> StateT a m (Result a m r)
forall a (m :: * -> *) b. CondT a m b -> StateT a m (Result a m b)
getCondT CondT a m r
c
{-# INLINE if_ #-}

-- | 'when_' is just like 'when', except that it executes the body if the
--   condition passes, rather than based on a Bool value.
--
-- >>> let good = guard_ (== "foo.hs") :: Cond String ()
-- >>> let bad  = guard_ (== "foo.hi") :: Cond String ()
-- >>> flip runCond "foo.hs" $ when_ good ignore
-- Nothing
-- >>> flip runCond "foo.hs" $ when_ bad ignore
-- Just ()
when_ :: Monad m => CondT a m r -> CondT a m () -> CondT a m ()
when_ :: forall (m :: * -> *) a r.
Monad m =>
CondT a m r -> CondT a m () -> CondT a m ()
when_ CondT a m r
c CondT a m ()
x = CondT a m r -> CondT a m () -> CondT a m () -> CondT a m ()
forall (m :: * -> *) a r b.
Monad m =>
CondT a m r -> CondT a m b -> CondT a m b -> CondT a m b
if_ CondT a m r
c (CondT a m () -> CondT a m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void CondT a m ()
x) (() -> CondT a m ()
forall a. a -> CondT a m a
forall (m :: * -> *) a. Monad m => a -> m a
return ())
{-# INLINE when_ #-}

-- | 'when_' is just like 'when', except that it executes the body if the
--   condition fails, rather than based on a Bool value.
--
-- >>> let good = guard_ (== "foo.hs") :: Cond String ()
-- >>> let bad  = guard_ (== "foo.hi") :: Cond String ()
-- >>> flip runCond "foo.hs" $ unless_ bad ignore
-- Nothing
-- >>> flip runCond "foo.hs" $ unless_ good ignore
-- Just ()
unless_ :: Monad m => CondT a m r -> CondT a m () -> CondT a m ()
unless_ :: forall (m :: * -> *) a r.
Monad m =>
CondT a m r -> CondT a m () -> CondT a m ()
unless_ CondT a m r
c = CondT a m r -> CondT a m () -> CondT a m () -> CondT a m ()
forall (m :: * -> *) a r b.
Monad m =>
CondT a m r -> CondT a m b -> CondT a m b -> CondT a m b
if_ CondT a m r
c (() -> CondT a m ()
forall a. a -> CondT a m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()) (CondT a m () -> CondT a m ())
-> (CondT a m () -> CondT a m ()) -> CondT a m () -> CondT a m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CondT a m () -> CondT a m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void
{-# INLINE unless_ #-}

-- | Check whether at least one of the given conditions is true.  This is a
--   synonym for 'Data.Foldable.asum'.
--
-- >>> let good = guard_ (== "foo.hs") :: Cond String ()
-- >>> let bad  = guard_ (== "foo.hi") :: Cond String ()
-- >>> flip runCond "foo.hs" $ or_ [bad, good]
-- Just ()
-- >>> flip runCond "foo.hs" $ or_ [bad]
-- Nothing
or_ :: Monad m => [CondT a m b] -> CondT a m b
or_ :: forall (m :: * -> *) a b. Monad m => [CondT a m b] -> CondT a m b
or_ = [CondT a m b] -> CondT a m b
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum
{-# INLINE or_ #-}

-- | Check that all of the given conditions are true.  This is a synonym for
--   'Data.Foldable.sequence_'.
--
-- >>> let good = guard_ (== "foo.hs") :: Cond String ()
-- >>> let bad  = guard_ (== "foo.hi") :: Cond String ()
-- >>> flip runCond "foo.hs" $ and_ [bad, good]
-- Nothing
-- >>> flip runCond "foo.hs" $ and_ [good]
-- Just ()
and_ :: Monad m => [CondT a m b] -> CondT a m ()
and_ :: forall (m :: * -> *) a b. Monad m => [CondT a m b] -> CondT a m ()
and_ = [CondT a m b] -> CondT a m ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_
{-# INLINE and_ #-}

-- | 'not_' inverts the meaning of the given predicate.
--
-- >>> let good = guard_ (== "foo.hs") :: Cond String ()
-- >>> let bad  = guard_ (== "foo.hi") :: Cond String ()
-- >>> flip runCond "foo.hs" $ not_ bad >> return "Success"
-- Just "Success"
-- >>> flip runCond "foo.hs" $ not_ good >> return "Shouldn't reach here"
-- Nothing
not_ :: Monad m => CondT a m b -> CondT a m ()
not_ :: forall (m :: * -> *) a b. Monad m => CondT a m b -> CondT a m ()
not_ CondT a m b
c = CondT a m b -> CondT a m () -> CondT a m ()
forall (m :: * -> *) a r.
Monad m =>
CondT a m r -> CondT a m () -> CondT a m ()
when_ CondT a m b
c CondT a m ()
forall (m :: * -> *) a b. Monad m => CondT a m b
ignore
{-# INLINE not_ #-}

-- | 'ignore' ignores the current entry, but allows recursion into its
--   descendents.  This is the same as 'mzero'.
ignore :: Monad m => CondT a m b
ignore :: forall (m :: * -> *) a b. Monad m => CondT a m b
ignore = CondT a m b
forall a. CondT a m a
forall (m :: * -> *) a. MonadPlus m => m a
mzero
{-# INLINE ignore #-}

-- | 'norecurse' prevents recursion into the current entry's descendents, but
--   does not ignore the entry itself.
norecurse :: Monad m => CondT a m ()
norecurse :: forall (m :: * -> *) a. Monad m => CondT a m ()
norecurse = StateT a m (Result a m ()) -> CondT a m ()
forall a (m :: * -> *) b. StateT a m (Result a m b) -> CondT a m b
CondT (StateT a m (Result a m ()) -> CondT a m ())
-> StateT a m (Result a m ()) -> CondT a m ()
forall a b. (a -> b) -> a -> b
$ Result a m () -> StateT a m (Result a m ())
forall a. a -> StateT a m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Result a m () -> StateT a m (Result a m ()))
-> Result a m () -> StateT a m (Result a m ())
forall a b. (a -> b) -> a -> b
$ () -> Result a m ()
forall a (m :: * -> *) b. b -> Result a m b
Keep ()
{-# INLINE norecurse #-}

-- | 'prune' is a synonym for both ignoring an entry and its descendents. It
--   is the same as @ignore >> norecurse@.
prune :: Monad m => CondT a m b
prune :: forall (m :: * -> *) a b. Monad m => CondT a m b
prune = StateT a m (Result a m b) -> CondT a m b
forall a (m :: * -> *) b. StateT a m (Result a m b) -> CondT a m b
CondT (StateT a m (Result a m b) -> CondT a m b)
-> StateT a m (Result a m b) -> CondT a m b
forall a b. (a -> b) -> a -> b
$ Result a m b -> StateT a m (Result a m b)
forall a. a -> StateT a m a
forall (m :: * -> *) a. Monad m => a -> m a
return Result a m b
forall a (m :: * -> *) b. Result a m b
Ignore
{-# INLINE prune #-}

-- | 'recurse' changes the recursion predicate for any child elements.  For
--   example, the following file-finding predicate looks for all @*.hs@ files,
--   but under any @.git@ directory looks only for a file named @config@:
--
-- @
-- if_ (name_ \".git\" \>\> directory)
--     (ignore \>\> recurse (name_ \"config\"))
--     (glob \"*.hs\")
-- @
--
-- NOTE: If this code had used @recurse (glob \"*.hs\"))@ instead in the else
-- case, it would have meant that @.git@ is only looked for at the top-level
-- of the search (i.e., the top-most element).
recurse :: Monad m => CondT a m b -> CondT a m b
recurse :: forall (m :: * -> *) a b. Monad m => CondT a m b -> CondT a m b
recurse CondT a m b
c = StateT a m (Result a m b) -> CondT a m b
forall a (m :: * -> *) b. StateT a m (Result a m b) -> CondT a m b
CondT (StateT a m (Result a m b) -> CondT a m b)
-> StateT a m (Result a m b) -> CondT a m b
forall a b. (a -> b) -> a -> b
$ CondT a m b -> Result a m b -> Result a m b
forall a (m :: * -> *) b.
CondT a m b -> Result a m b -> Result a m b
setRecursion CondT a m b
c (Result a m b -> Result a m b)
-> StateT a m (Result a m b) -> StateT a m (Result a m b)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` CondT a m b -> StateT a m (Result a m b)
forall a (m :: * -> *) b. CondT a m b -> StateT a m (Result a m b)
getCondT CondT a m b
c
{-# INLINE recurse #-}

-- | A specialized variant of 'runCondT' that simply returns True or False.
--
-- >>> let good = guard_ (== "foo.hs") :: Cond String ()
-- >>> let bad  = guard_ (== "foo.hi") :: Cond String ()
-- >>> runIdentity $ test "foo.hs" $ not_ bad >> return "Success"
-- True
-- >>> runIdentity $ test "foo.hs" $ not_ good >> return "Shouldn't reach here"
-- False
test :: Monad m => a -> CondT a m b -> m Bool
test :: forall (m :: * -> *) a b. Monad m => a -> CondT a m b -> m Bool
test = ((Maybe b -> Bool) -> m (Maybe b) -> m Bool
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Maybe b -> Bool
forall a. Maybe a -> Bool
isJust (m (Maybe b) -> m Bool)
-> (CondT a m b -> m (Maybe b)) -> CondT a m b -> m Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) ((CondT a m b -> m (Maybe b)) -> CondT a m b -> m Bool)
-> (a -> CondT a m b -> m (Maybe b)) -> a -> CondT a m b -> m Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CondT a m b -> a -> m (Maybe b))
-> a -> CondT a m b -> m (Maybe b)
forall a b c. (a -> b -> c) -> b -> a -> c
flip CondT a m b -> a -> m (Maybe b)
forall (m :: * -> *) a b.
Monad m =>
CondT a m b -> a -> m (Maybe b)
runCondT
{-# INLINE test #-}

-- | This type is for documentation only, and shows the isomorphism between
--   'CondT' and 'CondEitherT'.  The reason for using 'Result' is that it
--   makes meaning of the constructors more explicit.
newtype CondEitherT a m b = CondEitherT
    (StateT a (EitherT (Maybe (Maybe (CondEitherT a m b))) m)
         (b, Maybe (Maybe (CondEitherT a m b))))

-- | Witness one half of the isomorphism from 'CondT' to 'CondEitherT'.
fromCondT :: Monad m => CondT a m b -> CondEitherT a m b
fromCondT :: forall (m :: * -> *) a b.
Monad m =>
CondT a m b -> CondEitherT a m b
fromCondT (CondT StateT a m (Result a m b)
f) = StateT
  a
  (EitherT (Maybe (Maybe (CondEitherT a m b))) m)
  (b, Maybe (Maybe (CondEitherT a m b)))
-> CondEitherT a m b
forall a (m :: * -> *) b.
StateT
  a
  (EitherT (Maybe (Maybe (CondEitherT a m b))) m)
  (b, Maybe (Maybe (CondEitherT a m b)))
-> CondEitherT a m b
CondEitherT (StateT
   a
   (EitherT (Maybe (Maybe (CondEitherT a m b))) m)
   (b, Maybe (Maybe (CondEitherT a m b)))
 -> CondEitherT a m b)
-> StateT
     a
     (EitherT (Maybe (Maybe (CondEitherT a m b))) m)
     (b, Maybe (Maybe (CondEitherT a m b)))
-> CondEitherT a m b
forall a b. (a -> b) -> a -> b
$ do
    a
s <- StateT a (EitherT (Maybe (Maybe (CondEitherT a m b))) m) a
forall s (m :: * -> *). MonadState s m => m s
get
    (Result a m b
r, a
s') <- EitherT (Maybe (Maybe (CondEitherT a m b))) m (Result a m b, a)
-> StateT
     a (EitherT (Maybe (Maybe (CondEitherT a m b))) m) (Result a m b, a)
forall (m :: * -> *) a. Monad m => m a -> StateT a m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (EitherT (Maybe (Maybe (CondEitherT a m b))) m (Result a m b, a)
 -> StateT
      a
      (EitherT (Maybe (Maybe (CondEitherT a m b))) m)
      (Result a m b, a))
-> EitherT (Maybe (Maybe (CondEitherT a m b))) m (Result a m b, a)
-> StateT
     a (EitherT (Maybe (Maybe (CondEitherT a m b))) m) (Result a m b, a)
forall a b. (a -> b) -> a -> b
$ m (Result a m b, a)
-> EitherT (Maybe (Maybe (CondEitherT a m b))) m (Result a m b, a)
forall (m :: * -> *) a.
Monad m =>
m a -> ExceptT (Maybe (Maybe (CondEitherT a m b))) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Result a m b, a)
 -> EitherT (Maybe (Maybe (CondEitherT a m b))) m (Result a m b, a))
-> m (Result a m b, a)
-> EitherT (Maybe (Maybe (CondEitherT a m b))) m (Result a m b, a)
forall a b. (a -> b) -> a -> b
$ StateT a m (Result a m b) -> a -> m (Result a m b, a)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT StateT a m (Result a m b)
f a
s
    case Result a m b
r of
        Result a m b
Ignore             -> EitherT
  (Maybe (Maybe (CondEitherT a m b)))
  m
  (b, Maybe (Maybe (CondEitherT a m b)))
-> StateT
     a
     (EitherT (Maybe (Maybe (CondEitherT a m b))) m)
     (b, Maybe (Maybe (CondEitherT a m b)))
forall (m :: * -> *) a. Monad m => m a -> StateT a m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (EitherT
   (Maybe (Maybe (CondEitherT a m b)))
   m
   (b, Maybe (Maybe (CondEitherT a m b)))
 -> StateT
      a
      (EitherT (Maybe (Maybe (CondEitherT a m b))) m)
      (b, Maybe (Maybe (CondEitherT a m b))))
-> EitherT
     (Maybe (Maybe (CondEitherT a m b)))
     m
     (b, Maybe (Maybe (CondEitherT a m b)))
-> StateT
     a
     (EitherT (Maybe (Maybe (CondEitherT a m b))) m)
     (b, Maybe (Maybe (CondEitherT a m b)))
forall a b. (a -> b) -> a -> b
$ Maybe (Maybe (CondEitherT a m b))
-> EitherT
     (Maybe (Maybe (CondEitherT a m b)))
     m
     (b, Maybe (Maybe (CondEitherT a m b)))
forall (m :: * -> *) x a. Monad m => x -> EitherT x m a
left Maybe (Maybe (CondEitherT a m b))
forall a. Maybe a
Nothing
        Keep b
a             -> a -> StateT a (EitherT (Maybe (Maybe (CondEitherT a m b))) m) ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put a
s' StateT a (EitherT (Maybe (Maybe (CondEitherT a m b))) m) ()
-> StateT
     a
     (EitherT (Maybe (Maybe (CondEitherT a m b))) m)
     (b, Maybe (Maybe (CondEitherT a m b)))
-> StateT
     a
     (EitherT (Maybe (Maybe (CondEitherT a m b))) m)
     (b, Maybe (Maybe (CondEitherT a m b)))
forall a b.
StateT a (EitherT (Maybe (Maybe (CondEitherT a m b))) m) a
-> StateT a (EitherT (Maybe (Maybe (CondEitherT a m b))) m) b
-> StateT a (EitherT (Maybe (Maybe (CondEitherT a m b))) m) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (b, Maybe (Maybe (CondEitherT a m b)))
-> StateT
     a
     (EitherT (Maybe (Maybe (CondEitherT a m b))) m)
     (b, Maybe (Maybe (CondEitherT a m b)))
forall a.
a -> StateT a (EitherT (Maybe (Maybe (CondEitherT a m b))) m) a
forall (m :: * -> *) a. Monad m => a -> m a
return (b
a, Maybe (Maybe (CondEitherT a m b))
forall a. Maybe a
Nothing)
        RecurseOnly Maybe (CondT a m b)
m      -> EitherT
  (Maybe (Maybe (CondEitherT a m b)))
  m
  (b, Maybe (Maybe (CondEitherT a m b)))
-> StateT
     a
     (EitherT (Maybe (Maybe (CondEitherT a m b))) m)
     (b, Maybe (Maybe (CondEitherT a m b)))
forall (m :: * -> *) a. Monad m => m a -> StateT a m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (EitherT
   (Maybe (Maybe (CondEitherT a m b)))
   m
   (b, Maybe (Maybe (CondEitherT a m b)))
 -> StateT
      a
      (EitherT (Maybe (Maybe (CondEitherT a m b))) m)
      (b, Maybe (Maybe (CondEitherT a m b))))
-> EitherT
     (Maybe (Maybe (CondEitherT a m b)))
     m
     (b, Maybe (Maybe (CondEitherT a m b)))
-> StateT
     a
     (EitherT (Maybe (Maybe (CondEitherT a m b))) m)
     (b, Maybe (Maybe (CondEitherT a m b)))
forall a b. (a -> b) -> a -> b
$ Maybe (Maybe (CondEitherT a m b))
-> EitherT
     (Maybe (Maybe (CondEitherT a m b)))
     m
     (b, Maybe (Maybe (CondEitherT a m b)))
forall (m :: * -> *) x a. Monad m => x -> EitherT x m a
left (Maybe (CondEitherT a m b) -> Maybe (Maybe (CondEitherT a m b))
forall a. a -> Maybe a
Just ((CondT a m b -> CondEitherT a m b)
-> Maybe (CondT a m b) -> Maybe (CondEitherT a m b)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CondT a m b -> CondEitherT a m b
forall (m :: * -> *) a b.
Monad m =>
CondT a m b -> CondEitherT a m b
fromCondT Maybe (CondT a m b)
m))
        KeepAndRecurse b
a Maybe (CondT a m b)
m -> a -> StateT a (EitherT (Maybe (Maybe (CondEitherT a m b))) m) ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put a
s' StateT a (EitherT (Maybe (Maybe (CondEitherT a m b))) m) ()
-> StateT
     a
     (EitherT (Maybe (Maybe (CondEitherT a m b))) m)
     (b, Maybe (Maybe (CondEitherT a m b)))
-> StateT
     a
     (EitherT (Maybe (Maybe (CondEitherT a m b))) m)
     (b, Maybe (Maybe (CondEitherT a m b)))
forall a b.
StateT a (EitherT (Maybe (Maybe (CondEitherT a m b))) m) a
-> StateT a (EitherT (Maybe (Maybe (CondEitherT a m b))) m) b
-> StateT a (EitherT (Maybe (Maybe (CondEitherT a m b))) m) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (b, Maybe (Maybe (CondEitherT a m b)))
-> StateT
     a
     (EitherT (Maybe (Maybe (CondEitherT a m b))) m)
     (b, Maybe (Maybe (CondEitherT a m b)))
forall a.
a -> StateT a (EitherT (Maybe (Maybe (CondEitherT a m b))) m) a
forall (m :: * -> *) a. Monad m => a -> m a
return (b
a, Maybe (CondEitherT a m b) -> Maybe (Maybe (CondEitherT a m b))
forall a. a -> Maybe a
Just ((CondT a m b -> CondEitherT a m b)
-> Maybe (CondT a m b) -> Maybe (CondEitherT a m b)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CondT a m b -> CondEitherT a m b
forall (m :: * -> *) a b.
Monad m =>
CondT a m b -> CondEitherT a m b
fromCondT Maybe (CondT a m b)
m))

-- | Witness the other half of the isomorphism from 'CondEitherT' to 'CondT'.
toCondT :: Monad m => CondEitherT a m b -> CondT a m b
toCondT :: forall (m :: * -> *) a b.
Monad m =>
CondEitherT a m b -> CondT a m b
toCondT (CondEitherT StateT
  a
  (EitherT (Maybe (Maybe (CondEitherT a m b))) m)
  (b, Maybe (Maybe (CondEitherT a m b)))
f) = StateT a m (Result a m b) -> CondT a m b
forall a (m :: * -> *) b. StateT a m (Result a m b) -> CondT a m b
CondT (StateT a m (Result a m b) -> CondT a m b)
-> StateT a m (Result a m b) -> CondT a m b
forall a b. (a -> b) -> a -> b
$ do
    a
s <- StateT a m a
forall s (m :: * -> *). MonadState s m => m s
get
    Either
  (Maybe (Maybe (CondEitherT a m b)))
  ((b, Maybe (Maybe (CondEitherT a m b))), a)
eres <- m (Either
     (Maybe (Maybe (CondEitherT a m b)))
     ((b, Maybe (Maybe (CondEitherT a m b))), a))
-> StateT
     a
     m
     (Either
        (Maybe (Maybe (CondEitherT a m b)))
        ((b, Maybe (Maybe (CondEitherT a m b))), a))
forall (m :: * -> *) a. Monad m => m a -> StateT a m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Either
      (Maybe (Maybe (CondEitherT a m b)))
      ((b, Maybe (Maybe (CondEitherT a m b))), a))
 -> StateT
      a
      m
      (Either
         (Maybe (Maybe (CondEitherT a m b)))
         ((b, Maybe (Maybe (CondEitherT a m b))), a)))
-> m (Either
        (Maybe (Maybe (CondEitherT a m b)))
        ((b, Maybe (Maybe (CondEitherT a m b))), a))
-> StateT
     a
     m
     (Either
        (Maybe (Maybe (CondEitherT a m b)))
        ((b, Maybe (Maybe (CondEitherT a m b))), a))
forall a b. (a -> b) -> a -> b
$ EitherT
  (Maybe (Maybe (CondEitherT a m b)))
  m
  ((b, Maybe (Maybe (CondEitherT a m b))), a)
-> m (Either
        (Maybe (Maybe (CondEitherT a m b)))
        ((b, Maybe (Maybe (CondEitherT a m b))), a))
forall x (m :: * -> *) a. EitherT x m a -> m (Either x a)
runEitherT (EitherT
   (Maybe (Maybe (CondEitherT a m b)))
   m
   ((b, Maybe (Maybe (CondEitherT a m b))), a)
 -> m (Either
         (Maybe (Maybe (CondEitherT a m b)))
         ((b, Maybe (Maybe (CondEitherT a m b))), a)))
-> EitherT
     (Maybe (Maybe (CondEitherT a m b)))
     m
     ((b, Maybe (Maybe (CondEitherT a m b))), a)
-> m (Either
        (Maybe (Maybe (CondEitherT a m b)))
        ((b, Maybe (Maybe (CondEitherT a m b))), a))
forall a b. (a -> b) -> a -> b
$ StateT
  a
  (EitherT (Maybe (Maybe (CondEitherT a m b))) m)
  (b, Maybe (Maybe (CondEitherT a m b)))
-> a
-> EitherT
     (Maybe (Maybe (CondEitherT a m b)))
     m
     ((b, Maybe (Maybe (CondEitherT a m b))), a)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT StateT
  a
  (EitherT (Maybe (Maybe (CondEitherT a m b))) m)
  (b, Maybe (Maybe (CondEitherT a m b)))
f a
s
    case Either
  (Maybe (Maybe (CondEitherT a m b)))
  ((b, Maybe (Maybe (CondEitherT a m b))), a)
eres of
        Left Maybe (Maybe (CondEitherT a m b))
Nothing             -> Result a m b -> StateT a m (Result a m b)
forall a. a -> StateT a m a
forall (m :: * -> *) a. Monad m => a -> m a
return Result a m b
forall a (m :: * -> *) b. Result a m b
Ignore
        Right ((b
a, Maybe (Maybe (CondEitherT a m b))
Nothing), a
s') -> a -> StateT a m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put a
s' StateT a m ()
-> StateT a m (Result a m b) -> StateT a m (Result a m b)
forall a b. StateT a m a -> StateT a m b -> StateT a m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Result a m b -> StateT a m (Result a m b)
forall a. a -> StateT a m a
forall (m :: * -> *) a. Monad m => a -> m a
return (b -> Result a m b
forall a (m :: * -> *) b. b -> Result a m b
Keep b
a)
        Left (Just Maybe (CondEitherT a m b)
m)            -> Result a m b -> StateT a m (Result a m b)
forall a. a -> StateT a m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Result a m b -> StateT a m (Result a m b))
-> Result a m b -> StateT a m (Result a m b)
forall a b. (a -> b) -> a -> b
$ Maybe (CondT a m b) -> Result a m b
forall a (m :: * -> *) b. Maybe (CondT a m b) -> Result a m b
RecurseOnly ((CondEitherT a m b -> CondT a m b)
-> Maybe (CondEitherT a m b) -> Maybe (CondT a m b)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CondEitherT a m b -> CondT a m b
forall (m :: * -> *) a b.
Monad m =>
CondEitherT a m b -> CondT a m b
toCondT Maybe (CondEitherT a m b)
m)
        Right ((b
a, Just Maybe (CondEitherT a m b)
m), a
s')  ->
            a -> StateT a m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put a
s' StateT a m ()
-> StateT a m (Result a m b) -> StateT a m (Result a m b)
forall a b. StateT a m a -> StateT a m b -> StateT a m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Result a m b -> StateT a m (Result a m b)
forall a. a -> StateT a m a
forall (m :: * -> *) a. Monad m => a -> m a
return (b -> Maybe (CondT a m b) -> Result a m b
forall a (m :: * -> *) b. b -> Maybe (CondT a m b) -> Result a m b
KeepAndRecurse b
a ((CondEitherT a m b -> CondT a m b)
-> Maybe (CondEitherT a m b) -> Maybe (CondT a m b)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CondEitherT a m b -> CondT a m b
forall (m :: * -> *) a b.
Monad m =>
CondEitherT a m b -> CondT a m b
toCondT Maybe (CondEitherT a m b)
m))