module Options.Applicative.Internal
( P
, MonadP(..)
, ParseError(..)
, uncons
, hoistMaybe
, hoistEither
, runReadM
, withReadM
, runP
, Completion
, runCompletion
, contextNames
, ListT
, takeListT
, runListT
, hoistList
, NondetT
, cut
, (<!>)
, disamb
) where
import Control.Applicative
import Prelude
import Control.Monad (MonadPlus(..), liftM, ap, guard)
import Control.Monad.Trans.Class (MonadTrans, lift)
import Control.Monad.Trans.Except
(runExcept, runExceptT, withExcept, ExceptT(..), throwE)
import Control.Monad.Trans.Reader
(mapReaderT, runReader, runReaderT, Reader, ReaderT, ask)
import Control.Monad.Trans.State (StateT, get, put, modify, evalStateT, runStateT)
import Options.Applicative.Types
class (Alternative m, MonadPlus m) => MonadP m where
enterContext :: String -> ParserInfo a -> m ()
exitContext :: m ()
getPrefs :: m ParserPrefs
missingArgP :: ParseError -> Completer -> m a
errorP :: ParseError -> m a
exitP :: IsCmdStart -> ArgPolicy -> Parser b -> Maybe a -> m a
newtype P a = P (ExceptT ParseError (StateT [Context] (Reader ParserPrefs)) a)
instance Functor P where
fmap :: forall a b. (a -> b) -> P a -> P b
fmap a -> b
f (P ExceptT ParseError (StateT [Context] (Reader ParserPrefs)) a
m) = forall a.
ExceptT ParseError (StateT [Context] (Reader ParserPrefs)) a -> P a
P forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f ExceptT ParseError (StateT [Context] (Reader ParserPrefs)) a
m
instance Applicative P where
pure :: forall a. a -> P a
pure a
a = forall a.
ExceptT ParseError (StateT [Context] (Reader ParserPrefs)) a -> P a
P forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a
P ExceptT ParseError (StateT [Context] (Reader ParserPrefs)) (a -> b)
f <*> :: forall a b. P (a -> b) -> P a -> P b
<*> P ExceptT ParseError (StateT [Context] (Reader ParserPrefs)) a
a = forall a.
ExceptT ParseError (StateT [Context] (Reader ParserPrefs)) a -> P a
P forall a b. (a -> b) -> a -> b
$ ExceptT ParseError (StateT [Context] (Reader ParserPrefs)) (a -> b)
f forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ExceptT ParseError (StateT [Context] (Reader ParserPrefs)) a
a
instance Alternative P where
empty :: forall a. P a
empty = forall a.
ExceptT ParseError (StateT [Context] (Reader ParserPrefs)) a -> P a
P forall (f :: * -> *) a. Alternative f => f a
empty
P ExceptT ParseError (StateT [Context] (Reader ParserPrefs)) a
x <|> :: forall a. P a -> P a -> P a
<|> P ExceptT ParseError (StateT [Context] (Reader ParserPrefs)) a
y = forall a.
ExceptT ParseError (StateT [Context] (Reader ParserPrefs)) a -> P a
P forall a b. (a -> b) -> a -> b
$ ExceptT ParseError (StateT [Context] (Reader ParserPrefs)) a
x forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ExceptT ParseError (StateT [Context] (Reader ParserPrefs)) a
y
instance Monad P where
return :: forall a. a -> P a
return = forall (f :: * -> *) a. Applicative f => a -> f a
pure
P ExceptT ParseError (StateT [Context] (Reader ParserPrefs)) a
x >>= :: forall a b. P a -> (a -> P b) -> P b
>>= a -> P b
k = forall a.
ExceptT ParseError (StateT [Context] (Reader ParserPrefs)) a -> P a
P forall a b. (a -> b) -> a -> b
$ ExceptT ParseError (StateT [Context] (Reader ParserPrefs)) a
x forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \a
a -> case a -> P b
k a
a of P ExceptT ParseError (StateT [Context] (Reader ParserPrefs)) b
y -> ExceptT ParseError (StateT [Context] (Reader ParserPrefs)) b
y
instance MonadPlus P where
mzero :: forall a. P a
mzero = forall a.
ExceptT ParseError (StateT [Context] (Reader ParserPrefs)) a -> P a
P forall (m :: * -> *) a. MonadPlus m => m a
mzero
mplus :: forall a. P a -> P a -> P a
mplus (P ExceptT ParseError (StateT [Context] (Reader ParserPrefs)) a
x) (P ExceptT ParseError (StateT [Context] (Reader ParserPrefs)) a
y) = forall a.
ExceptT ParseError (StateT [Context] (Reader ParserPrefs)) a -> P a
P forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
mplus ExceptT ParseError (StateT [Context] (Reader ParserPrefs)) a
x ExceptT ParseError (StateT [Context] (Reader ParserPrefs)) a
y
contextNames :: [Context] -> [String]
contextNames :: [Context] -> [String]
contextNames [Context]
ns =
let go :: Context -> String
go (Context String
n ParserInfo a
_) = String
n
in forall a. [a] -> [a]
reverse forall a b. (a -> b) -> a -> b
$ Context -> String
go forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Context]
ns
instance MonadP P where
enterContext :: forall a. String -> ParserInfo a -> P ()
enterContext String
name ParserInfo a
pinfo = forall a.
ExceptT ParseError (StateT [Context] (Reader ParserPrefs)) a -> P a
P forall a b. (a -> b) -> a -> b
$ forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
modify forall a b. (a -> b) -> a -> b
$ (:) forall a b. (a -> b) -> a -> b
$ forall a. String -> ParserInfo a -> Context
Context String
name ParserInfo a
pinfo
exitContext :: P ()
exitContext = forall a.
ExceptT ParseError (StateT [Context] (Reader ParserPrefs)) a -> P a
P forall a b. (a -> b) -> a -> b
$ forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
modify forall a b. (a -> b) -> a -> b
$ forall a. Int -> [a] -> [a]
drop Int
1
getPrefs :: P ParserPrefs
getPrefs = forall a.
ExceptT ParseError (StateT [Context] (Reader ParserPrefs)) a -> P a
P forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) r. Monad m => ReaderT r m r
ask
missingArgP :: forall a. ParseError -> Completer -> P a
missingArgP ParseError
e Completer
_ = forall (m :: * -> *) a. MonadP m => ParseError -> m a
errorP ParseError
e
exitP :: forall b a. IsCmdStart -> ArgPolicy -> Parser b -> Maybe a -> P a
exitP IsCmdStart
i ArgPolicy
_ Parser b
p = forall a.
ExceptT ParseError (StateT [Context] (Reader ParserPrefs)) a -> P a
P forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE forall b c a. (b -> c) -> (a -> b) -> a -> c
. IsCmdStart -> SomeParser -> ParseError
MissingError IsCmdStart
i forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Parser a -> SomeParser
SomeParser forall a b. (a -> b) -> a -> b
$ Parser b
p) forall (m :: * -> *) a. Monad m => a -> m a
return
errorP :: forall a. ParseError -> P a
errorP = forall a.
ExceptT ParseError (StateT [Context] (Reader ParserPrefs)) a -> P a
P forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE
hoistMaybe :: MonadPlus m => Maybe a -> m a
hoistMaybe :: forall (m :: * -> *) a. MonadPlus m => Maybe a -> m a
hoistMaybe = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall (m :: * -> *) a. MonadPlus m => m a
mzero forall (m :: * -> *) a. Monad m => a -> m a
return
hoistEither :: MonadP m => Either ParseError a -> m a
hoistEither :: forall (m :: * -> *) a. MonadP m => Either ParseError a -> m a
hoistEither = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall (m :: * -> *) a. MonadP m => ParseError -> m a
errorP forall (m :: * -> *) a. Monad m => a -> m a
return
runP :: P a -> ParserPrefs -> (Either ParseError a, [Context])
runP :: forall a. P a -> ParserPrefs -> (Either ParseError a, [Context])
runP (P ExceptT ParseError (StateT [Context] (Reader ParserPrefs)) a
p) = forall r a. Reader r a -> r -> a
runReader forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT [] forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT forall a b. (a -> b) -> a -> b
$ ExceptT ParseError (StateT [Context] (Reader ParserPrefs)) a
p
uncons :: [a] -> Maybe (a, [a])
uncons :: forall a. [a] -> Maybe (a, [a])
uncons [] = forall a. Maybe a
Nothing
uncons (a
x : [a]
xs) = forall a. a -> Maybe a
Just (a
x, [a]
xs)
runReadM :: MonadP m => ReadM a -> String -> m a
runReadM :: forall (m :: * -> *) a. MonadP m => ReadM a -> String -> m a
runReadM (ReadM ReaderT String (Except ParseError) a
r) String
s = forall (m :: * -> *) a. MonadP m => Either ParseError a -> m a
hoistEither forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e a. Except e a -> Either e a
runExcept forall a b. (a -> b) -> a -> b
$ forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT String (Except ParseError) a
r String
s
withReadM :: (String -> String) -> ReadM a -> ReadM a
withReadM :: forall a. (String -> String) -> ReadM a -> ReadM a
withReadM String -> String
f = forall a. ReaderT String (Except ParseError) a -> ReadM a
ReadM forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a (n :: * -> *) b r.
(m a -> n b) -> ReaderT r m a -> ReaderT r n b
mapReaderT (forall e e' a. (e -> e') -> Except e a -> Except e' a
withExcept ParseError -> ParseError
f') forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ReadM a -> ReaderT String (Except ParseError) a
unReadM
where
f' :: ParseError -> ParseError
f' (ErrorMsg String
err) = String -> ParseError
ErrorMsg (String -> String
f String
err)
f' ParseError
e = ParseError
e
data ComplResult a
= ComplParser SomeParser ArgPolicy
| ComplOption Completer
| ComplResult a
instance Functor ComplResult where
fmap :: forall a b. (a -> b) -> ComplResult a -> ComplResult b
fmap = forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM
instance Applicative ComplResult where
pure :: forall a. a -> ComplResult a
pure = forall a. a -> ComplResult a
ComplResult
<*> :: forall a b. ComplResult (a -> b) -> ComplResult a -> ComplResult b
(<*>) = forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap
instance Monad ComplResult where
return :: forall a. a -> ComplResult a
return = forall (f :: * -> *) a. Applicative f => a -> f a
pure
ComplResult a
m >>= :: forall a b. ComplResult a -> (a -> ComplResult b) -> ComplResult b
>>= a -> ComplResult b
f = case ComplResult a
m of
ComplResult a
r -> a -> ComplResult b
f a
r
ComplParser SomeParser
p ArgPolicy
a -> forall a. SomeParser -> ArgPolicy -> ComplResult a
ComplParser SomeParser
p ArgPolicy
a
ComplOption Completer
c -> forall a. Completer -> ComplResult a
ComplOption Completer
c
newtype Completion a =
Completion (ExceptT ParseError (ReaderT ParserPrefs ComplResult) a)
instance Functor Completion where
fmap :: forall a b. (a -> b) -> Completion a -> Completion b
fmap a -> b
f (Completion ExceptT ParseError (ReaderT ParserPrefs ComplResult) a
m) = forall a.
ExceptT ParseError (ReaderT ParserPrefs ComplResult) a
-> Completion a
Completion forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f ExceptT ParseError (ReaderT ParserPrefs ComplResult) a
m
instance Applicative Completion where
pure :: forall a. a -> Completion a
pure a
a = forall a.
ExceptT ParseError (ReaderT ParserPrefs ComplResult) a
-> Completion a
Completion forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a
Completion ExceptT ParseError (ReaderT ParserPrefs ComplResult) (a -> b)
f <*> :: forall a b. Completion (a -> b) -> Completion a -> Completion b
<*> Completion ExceptT ParseError (ReaderT ParserPrefs ComplResult) a
a = forall a.
ExceptT ParseError (ReaderT ParserPrefs ComplResult) a
-> Completion a
Completion forall a b. (a -> b) -> a -> b
$ ExceptT ParseError (ReaderT ParserPrefs ComplResult) (a -> b)
f forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ExceptT ParseError (ReaderT ParserPrefs ComplResult) a
a
instance Alternative Completion where
empty :: forall a. Completion a
empty = forall a.
ExceptT ParseError (ReaderT ParserPrefs ComplResult) a
-> Completion a
Completion forall (f :: * -> *) a. Alternative f => f a
empty
Completion ExceptT ParseError (ReaderT ParserPrefs ComplResult) a
x <|> :: forall a. Completion a -> Completion a -> Completion a
<|> Completion ExceptT ParseError (ReaderT ParserPrefs ComplResult) a
y = forall a.
ExceptT ParseError (ReaderT ParserPrefs ComplResult) a
-> Completion a
Completion forall a b. (a -> b) -> a -> b
$ ExceptT ParseError (ReaderT ParserPrefs ComplResult) a
x forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ExceptT ParseError (ReaderT ParserPrefs ComplResult) a
y
instance Monad Completion where
return :: forall a. a -> Completion a
return = forall (f :: * -> *) a. Applicative f => a -> f a
pure
Completion ExceptT ParseError (ReaderT ParserPrefs ComplResult) a
x >>= :: forall a b. Completion a -> (a -> Completion b) -> Completion b
>>= a -> Completion b
k = forall a.
ExceptT ParseError (ReaderT ParserPrefs ComplResult) a
-> Completion a
Completion forall a b. (a -> b) -> a -> b
$ ExceptT ParseError (ReaderT ParserPrefs ComplResult) a
x forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \a
a -> case a -> Completion b
k a
a of Completion ExceptT ParseError (ReaderT ParserPrefs ComplResult) b
y -> ExceptT ParseError (ReaderT ParserPrefs ComplResult) b
y
instance MonadPlus Completion where
mzero :: forall a. Completion a
mzero = forall a.
ExceptT ParseError (ReaderT ParserPrefs ComplResult) a
-> Completion a
Completion forall (m :: * -> *) a. MonadPlus m => m a
mzero
mplus :: forall a. Completion a -> Completion a -> Completion a
mplus (Completion ExceptT ParseError (ReaderT ParserPrefs ComplResult) a
x) (Completion ExceptT ParseError (ReaderT ParserPrefs ComplResult) a
y) = forall a.
ExceptT ParseError (ReaderT ParserPrefs ComplResult) a
-> Completion a
Completion forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
mplus ExceptT ParseError (ReaderT ParserPrefs ComplResult) a
x ExceptT ParseError (ReaderT ParserPrefs ComplResult) a
y
instance MonadP Completion where
enterContext :: forall a. String -> ParserInfo a -> Completion ()
enterContext String
_ ParserInfo a
_ = forall (m :: * -> *) a. Monad m => a -> m a
return ()
exitContext :: Completion ()
exitContext = forall (m :: * -> *) a. Monad m => a -> m a
return ()
getPrefs :: Completion ParserPrefs
getPrefs = forall a.
ExceptT ParseError (ReaderT ParserPrefs ComplResult) a
-> Completion a
Completion forall a b. (a -> b) -> a -> b
$ forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (m :: * -> *) r. Monad m => ReaderT r m r
ask
missingArgP :: forall a. ParseError -> Completer -> Completion a
missingArgP ParseError
_ = forall a.
ExceptT ParseError (ReaderT ParserPrefs ComplResult) a
-> Completion a
Completion forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Completer -> ComplResult a
ComplOption
exitP :: forall b a.
IsCmdStart -> ArgPolicy -> Parser b -> Maybe a -> Completion a
exitP IsCmdStart
_ ArgPolicy
a Parser b
p Maybe a
_ = forall a.
ExceptT ParseError (ReaderT ParserPrefs ComplResult) a
-> Completion a
Completion forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. SomeParser -> ArgPolicy -> ComplResult a
ComplParser (forall a. Parser a -> SomeParser
SomeParser Parser b
p) ArgPolicy
a
errorP :: forall a. ParseError -> Completion a
errorP = forall a.
ExceptT ParseError (ReaderT ParserPrefs ComplResult) a
-> Completion a
Completion forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE
runCompletion :: Completion r -> ParserPrefs -> Maybe (Either (SomeParser, ArgPolicy) Completer)
runCompletion :: forall r.
Completion r
-> ParserPrefs -> Maybe (Either (SomeParser, ArgPolicy) Completer)
runCompletion (Completion ExceptT ParseError (ReaderT ParserPrefs ComplResult) r
c) ParserPrefs
prefs = case forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT ExceptT ParseError (ReaderT ParserPrefs ComplResult) r
c) ParserPrefs
prefs of
ComplResult Either ParseError r
_ -> forall a. Maybe a
Nothing
ComplParser SomeParser
p' ArgPolicy
a' -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left (SomeParser
p', ArgPolicy
a')
ComplOption Completer
compl -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right Completer
compl
newtype ListT m a = ListT
{ forall (m :: * -> *) a. ListT m a -> m (TStep a (ListT m a))
stepListT :: m (TStep a (ListT m a)) }
data TStep a x
= TNil
| TCons a x
bimapTStep :: (a -> b) -> (x -> y) -> TStep a x -> TStep b y
bimapTStep :: forall a b x y. (a -> b) -> (x -> y) -> TStep a x -> TStep b y
bimapTStep a -> b
_ x -> y
_ TStep a x
TNil = forall a x. TStep a x
TNil
bimapTStep a -> b
f x -> y
g (TCons a
a x
x) = forall a x. a -> x -> TStep a x
TCons (a -> b
f a
a) (x -> y
g x
x)
takeListT :: Monad m => Int -> ListT m a -> ListT m a
takeListT :: forall (m :: * -> *) a. Monad m => Int -> ListT m a -> ListT m a
takeListT Int
0 = forall a b. a -> b -> a
const forall (m :: * -> *) a. MonadPlus m => m a
mzero
takeListT Int
n = forall (m :: * -> *) a. m (TStep a (ListT m a)) -> ListT m a
ListT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (forall a b x y. (a -> b) -> (x -> y) -> TStep a x -> TStep b y
bimapTStep forall a. a -> a
id (forall (m :: * -> *) a. Monad m => Int -> ListT m a -> ListT m a
takeListT (Int
n forall a. Num a => a -> a -> a
- Int
1))) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. ListT m a -> m (TStep a (ListT m a))
stepListT
runListT :: Monad m => ListT m a -> m [a]
runListT :: forall (m :: * -> *) a. Monad m => ListT m a -> m [a]
runListT ListT m a
xs = do
TStep a (ListT m a)
s <- forall (m :: * -> *) a. ListT m a -> m (TStep a (ListT m a))
stepListT ListT m a
xs
case TStep a (ListT m a)
s of
TStep a (ListT m a)
TNil -> forall (m :: * -> *) a. Monad m => a -> m a
return []
TCons a
x ListT m a
xt -> forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (a
x forall a. a -> [a] -> [a]
:) (forall (m :: * -> *) a. Monad m => ListT m a -> m [a]
runListT ListT m a
xt)
instance Monad m => Functor (ListT m) where
fmap :: forall a b. (a -> b) -> ListT m a -> ListT m b
fmap a -> b
f = forall (m :: * -> *) a. m (TStep a (ListT m a)) -> ListT m a
ListT
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (forall a b x y. (a -> b) -> (x -> y) -> TStep a x -> TStep b y
bimapTStep a -> b
f (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. ListT m a -> m (TStep a (ListT m a))
stepListT
instance Monad m => Applicative (ListT m) where
pure :: forall a. a -> ListT m a
pure a
a = forall (m :: * -> *) a. m (TStep a (ListT m a)) -> ListT m a
ListT (forall (m :: * -> *) a. Monad m => a -> m a
return (forall a x. a -> x -> TStep a x
TCons a
a forall (m :: * -> *) a. MonadPlus m => m a
mzero))
<*> :: forall a b. ListT m (a -> b) -> ListT m a -> ListT m b
(<*>) = forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap
instance Monad m => Monad (ListT m) where
return :: forall a. a -> ListT m a
return = forall (f :: * -> *) a. Applicative f => a -> f a
pure
ListT m a
xs >>= :: forall a b. ListT m a -> (a -> ListT m b) -> ListT m b
>>= a -> ListT m b
f = forall (m :: * -> *) a. m (TStep a (ListT m a)) -> ListT m a
ListT forall a b. (a -> b) -> a -> b
$ do
TStep a (ListT m a)
s <- forall (m :: * -> *) a. ListT m a -> m (TStep a (ListT m a))
stepListT ListT m a
xs
case TStep a (ListT m a)
s of
TStep a (ListT m a)
TNil -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a x. TStep a x
TNil
TCons a
x ListT m a
xt -> forall (m :: * -> *) a. ListT m a -> m (TStep a (ListT m a))
stepListT forall a b. (a -> b) -> a -> b
$ a -> ListT m b
f a
x forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` (ListT m a
xt forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> ListT m b
f)
instance Monad m => Alternative (ListT m) where
empty :: forall a. ListT m a
empty = forall (m :: * -> *) a. MonadPlus m => m a
mzero
<|> :: forall a. ListT m a -> ListT m a -> ListT m a
(<|>) = forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
mplus
instance MonadTrans ListT where
lift :: forall (m :: * -> *) a. Monad m => m a -> ListT m a
lift = forall (m :: * -> *) a. m (TStep a (ListT m a)) -> ListT m a
ListT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (forall a x. a -> x -> TStep a x
`TCons` forall (m :: * -> *) a. MonadPlus m => m a
mzero)
instance Monad m => MonadPlus (ListT m) where
mzero :: forall a. ListT m a
mzero = forall (m :: * -> *) a. m (TStep a (ListT m a)) -> ListT m a
ListT (forall (m :: * -> *) a. Monad m => a -> m a
return forall a x. TStep a x
TNil)
mplus :: forall a. ListT m a -> ListT m a -> ListT m a
mplus ListT m a
xs ListT m a
ys = forall (m :: * -> *) a. m (TStep a (ListT m a)) -> ListT m a
ListT forall a b. (a -> b) -> a -> b
$ do
TStep a (ListT m a)
s <- forall (m :: * -> *) a. ListT m a -> m (TStep a (ListT m a))
stepListT ListT m a
xs
case TStep a (ListT m a)
s of
TStep a (ListT m a)
TNil -> forall (m :: * -> *) a. ListT m a -> m (TStep a (ListT m a))
stepListT ListT m a
ys
TCons a
x ListT m a
xt -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a x. a -> x -> TStep a x
TCons a
x (ListT m a
xt forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` ListT m a
ys)
newtype NondetT m a = NondetT
{ forall (m :: * -> *) a. NondetT m a -> ListT (StateT Bool m) a
runNondetT :: ListT (StateT Bool m) a }
instance Monad m => Functor (NondetT m) where
fmap :: forall a b. (a -> b) -> NondetT m a -> NondetT m b
fmap a -> b
f = forall (m :: * -> *) a. ListT (StateT Bool m) a -> NondetT m a
NondetT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. NondetT m a -> ListT (StateT Bool m) a
runNondetT
instance Monad m => Applicative (NondetT m) where
pure :: forall a. a -> NondetT m a
pure = forall (m :: * -> *) a. ListT (StateT Bool m) a -> NondetT m a
NondetT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Applicative f => a -> f a
pure
NondetT ListT (StateT Bool m) (a -> b)
m1 <*> :: forall a b. NondetT m (a -> b) -> NondetT m a -> NondetT m b
<*> NondetT ListT (StateT Bool m) a
m2 = forall (m :: * -> *) a. ListT (StateT Bool m) a -> NondetT m a
NondetT (ListT (StateT Bool m) (a -> b)
m1 forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ListT (StateT Bool m) a
m2)
instance Monad m => Monad (NondetT m) where
return :: forall a. a -> NondetT m a
return = forall (f :: * -> *) a. Applicative f => a -> f a
pure
NondetT ListT (StateT Bool m) a
m1 >>= :: forall a b. NondetT m a -> (a -> NondetT m b) -> NondetT m b
>>= a -> NondetT m b
f = forall (m :: * -> *) a. ListT (StateT Bool m) a -> NondetT m a
NondetT forall a b. (a -> b) -> a -> b
$ ListT (StateT Bool m) a
m1 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a. NondetT m a -> ListT (StateT Bool m) a
runNondetT forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> NondetT m b
f
instance Monad m => MonadPlus (NondetT m) where
mzero :: forall a. NondetT m a
mzero = forall (m :: * -> *) a. ListT (StateT Bool m) a -> NondetT m a
NondetT forall (m :: * -> *) a. MonadPlus m => m a
mzero
NondetT ListT (StateT Bool m) a
m1 mplus :: forall a. NondetT m a -> NondetT m a -> NondetT m a
`mplus` NondetT ListT (StateT Bool m) a
m2 = forall (m :: * -> *) a. ListT (StateT Bool m) a -> NondetT m a
NondetT (ListT (StateT Bool m) a
m1 forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` ListT (StateT Bool m) a
m2)
instance Monad m => Alternative (NondetT m) where
empty :: forall a. NondetT m a
empty = forall (m :: * -> *) a. MonadPlus m => m a
mzero
<|> :: forall a. NondetT m a -> NondetT m a -> NondetT m a
(<|>) = forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
mplus
instance MonadTrans NondetT where
lift :: forall (m :: * -> *) a. Monad m => m a -> NondetT m a
lift = forall (m :: * -> *) a. ListT (StateT Bool m) a -> NondetT m a
NondetT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift
(<!>) :: Monad m => NondetT m a -> NondetT m a -> NondetT m a
<!> :: forall (m :: * -> *) a.
Monad m =>
NondetT m a -> NondetT m a -> NondetT m a
(<!>) NondetT m a
m1 NondetT m a
m2 = forall (m :: * -> *) a. ListT (StateT Bool m) a -> NondetT m a
NondetT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
mplus (forall (m :: * -> *) a. NondetT m a -> ListT (StateT Bool m) a
runNondetT NondetT m a
m1) forall a b. (a -> b) -> a -> b
$ do
Bool
s <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (m :: * -> *) s. Monad m => StateT s m s
get
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Bool
not Bool
s)
forall (m :: * -> *) a. NondetT m a -> ListT (StateT Bool m) a
runNondetT NondetT m a
m2
cut :: Monad m => NondetT m ()
cut :: forall (m :: * -> *). Monad m => NondetT m ()
cut = forall (m :: * -> *) a. ListT (StateT Bool m) a -> NondetT m a
NondetT forall a b. (a -> b) -> a -> b
$ forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put Bool
True)
disamb :: Monad m => Bool -> NondetT m a -> m (Maybe a)
disamb :: forall (m :: * -> *) a.
Monad m =>
Bool -> NondetT m a -> m (Maybe a)
disamb Bool
allow_amb NondetT m a
xs = do
[a]
xs' <- (forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
`evalStateT` Bool
False)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. Monad m => ListT m a -> m [a]
runListT
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. Monad m => Int -> ListT m a -> ListT m a
takeListT (if Bool
allow_amb then Int
1 else Int
2)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. NondetT m a -> ListT (StateT Bool m) a
runNondetT forall a b. (a -> b) -> a -> b
$ NondetT m a
xs
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case [a]
xs' of
[a
x] -> forall a. a -> Maybe a
Just a
x
[a]
_ -> forall a. Maybe a
Nothing
hoistList :: Alternative m => [a] -> m a
hoistList :: forall (m :: * -> *) a. Alternative m => [a] -> m a
hoistList = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall {f :: * -> *} {a}. Alternative f => a -> f a -> f a
cons forall (f :: * -> *) a. Alternative f => f a
empty
where
cons :: a -> f a -> f a
cons a
x f a
xs = forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> f a
xs