{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TypeSynonymInstances #-}

-- | Deterministic parsers can be restricted to succeed with a single parsing result.

module Text.Parser.Deterministic where

import Control.Applicative (Applicative ((<*>), pure), Alternative ((<|>), many, some), liftA2, optional)
import Control.Arrow (first)
import Control.Monad (MonadPlus, void)
import Control.Monad.Trans.Identity (IdentityT(..))
import Control.Monad.Trans.Reader (ReaderT(..), mapReaderT)
import qualified Control.Monad.Trans.Writer.Lazy as Lazy (WriterT(WriterT))
import qualified Control.Monad.Trans.Writer.Strict as Strict (WriterT(WriterT))
import qualified Control.Monad.Trans.State.Lazy as Lazy (StateT(StateT))
import qualified Control.Monad.Trans.State.Strict as Strict (StateT(StateT))
import qualified Control.Monad.Trans.RWS.Lazy as Lazy (RWST(RWST))
import qualified Control.Monad.Trans.RWS.Strict as Strict (RWST(RWST))
import Data.Functor ((<$>))
import qualified Data.List as List
import Data.Monoid (Monoid, mappend, mempty)
import Data.String (IsString (fromString))
import Text.ParserCombinators.ReadP (ReadP)
import qualified Text.ParserCombinators.ReadP as ReadP

import Text.Parser.Char (CharParsing)
import Text.Parser.Combinators (Parsing, count, eof, notFollowedBy, try, unexpected)
import Text.Parser.LookAhead (LookAheadParsing, lookAhead)
import qualified Text.Parser.Char as Char

import Text.Parser.Internal (mapLazyWriterT, mapStrictWriterT,
                             mapLazyStateT, mapStrictStateT,
                             mapLazyRWST, mapStrictRWST)
import Text.Parser.Wrapper (Lazy(..), Strict(..))

#ifdef MIN_VERSION_attoparsec
import Data.ByteString (ByteString)
import Data.Text (Text)
import qualified Data.ByteString as ByteString
import qualified Data.ByteString.Char8 as ByteString.Char8
import qualified Data.Text as Text

import qualified Data.Attoparsec.ByteString as Attoparsec
import qualified Data.Attoparsec.ByteString.Char8 as Attoparsec.Char8
import qualified Data.Attoparsec.Text as Attoparsec.Text
#endif

#ifdef MIN_VERSION_binary
import Data.ByteString (ByteString)
import qualified Data.ByteString as ByteString
import qualified Data.ByteString.Lazy as Lazy

import qualified Data.Binary.Get as Binary
#endif

-- | Combinator methods for constructing deterministic parsers, /i.e./, parsers that can succeed with only a single
-- result.
class Parsing m => DeterministicParsing m where
   -- | Left-biased choice: if the left alternative succeeds, the right one is never tried.
   infixl 3 <<|>
   (<<|>) :: m a -> m a -> m a
   -- | Like 'optional', but never succeeds with @Nothing@ if the argument parser can succeed.
   takeOptional :: m a -> m (Maybe a)
   -- | Like 'many', but always consuming the longest matching sequence of input.
   takeMany :: m a -> m [a]
   -- | Like 'some', but always consuming the longest matching sequence of input.
   takeSome :: m a -> m [a]
   -- | Like 'Text.Parser.Input.concatMany', but always consuming the longest matching sequence of input.
   concatAll :: Monoid a => m a -> m a
   -- | Like 'Text.Parser.Combinators.skipMany', but always consuming the longest matching sequence of input.
   skipAll :: m a -> m ()

   m a
p <<|> m a
q = m a -> m a
forall (m :: * -> *) a. Parsing m => m a -> m a
try m a
p m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> m () -> m ()
forall (m :: * -> *) a. (Parsing m, Show a) => m a -> m ()
notFollowedBy (m a -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void m a
p) m () -> m a -> m a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> m a
q
   takeOptional m a
p = a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> m a -> m (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m a
p m (Maybe a) -> m (Maybe a) -> m (Maybe a)
forall (m :: * -> *) a. DeterministicParsing m => m a -> m a -> m a
<<|> Maybe a -> m (Maybe a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
forall a. Maybe a
Nothing
   takeMany m a
p = m a -> m [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many m a
p m [a] -> m () -> m [a]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* m () -> m ()
forall (m :: * -> *) a. (Parsing m, Show a) => m a -> m ()
notFollowedBy (m a -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void m a
p)
   takeSome m a
p = m a -> m [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some m a
p m [a] -> m () -> m [a]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* m () -> m ()
forall (m :: * -> *) a. (Parsing m, Show a) => m a -> m ()
notFollowedBy (m a -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void m a
p)
   concatAll m a
p = m a
go
      where go :: m a
go = (a -> a -> a) -> m a -> m a -> m a
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> a -> a
forall a. Monoid a => a -> a -> a
mappend m a
p m a
go m a -> m a -> m a
forall (m :: * -> *) a. DeterministicParsing m => m a -> m a -> m a
<<|> a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
forall a. Monoid a => a
mempty
   skipAll m a
p = m a
p m a -> m () -> m ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> m a -> m ()
forall (m :: * -> *) a. DeterministicParsing m => m a -> m ()
skipAll m a
p m () -> m () -> m ()
forall (m :: * -> *) a. DeterministicParsing m => m a -> m a -> m a
<<|> () -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

instance DeterministicParsing ReadP where
  <<|> :: ReadP a -> ReadP a -> ReadP a
(<<|>) = ReadP a -> ReadP a -> ReadP a
forall a. ReadP a -> ReadP a -> ReadP a
(ReadP.<++)

instance (Monad m, DeterministicParsing m) => DeterministicParsing (IdentityT m) where
  IdentityT m a
p <<|> :: IdentityT m a -> IdentityT m a -> IdentityT m a
<<|> IdentityT m a
q = m a -> IdentityT m a
forall k (f :: k -> *) (a :: k). f a -> IdentityT f a
IdentityT (m a
p m a -> m a -> m a
forall (m :: * -> *) a. DeterministicParsing m => m a -> m a -> m a
<<|> m a
q)
  takeOptional :: IdentityT m a -> IdentityT m (Maybe a)
takeOptional (IdentityT m a
p) = m (Maybe a) -> IdentityT m (Maybe a)
forall k (f :: k -> *) (a :: k). f a -> IdentityT f a
IdentityT (m a -> m (Maybe a)
forall (m :: * -> *) a.
DeterministicParsing m =>
m a -> m (Maybe a)
takeOptional m a
p)
  takeMany :: IdentityT m a -> IdentityT m [a]
takeMany (IdentityT m a
p) = m [a] -> IdentityT m [a]
forall k (f :: k -> *) (a :: k). f a -> IdentityT f a
IdentityT (m a -> m [a]
forall (m :: * -> *) a. DeterministicParsing m => m a -> m [a]
takeMany m a
p)
  takeSome :: IdentityT m a -> IdentityT m [a]
takeSome (IdentityT m a
p) = m [a] -> IdentityT m [a]
forall k (f :: k -> *) (a :: k). f a -> IdentityT f a
IdentityT (m a -> m [a]
forall (m :: * -> *) a. DeterministicParsing m => m a -> m [a]
takeSome m a
p)
  concatAll :: IdentityT m a -> IdentityT m a
concatAll (IdentityT m a
p) = m a -> IdentityT m a
forall k (f :: k -> *) (a :: k). f a -> IdentityT f a
IdentityT (m a -> m a
forall (m :: * -> *) a.
(DeterministicParsing m, Monoid a) =>
m a -> m a
concatAll m a
p)
  skipAll :: IdentityT m a -> IdentityT m ()
skipAll (IdentityT m a
p) = m () -> IdentityT m ()
forall k (f :: k -> *) (a :: k). f a -> IdentityT f a
IdentityT (m a -> m ()
forall (m :: * -> *) a. DeterministicParsing m => m a -> m ()
skipAll m a
p)

instance (MonadPlus m, DeterministicParsing m) => DeterministicParsing (ReaderT e m) where
  ReaderT e -> m a
p <<|> :: ReaderT e m a -> ReaderT e m a -> ReaderT e m a
<<|> ReaderT e -> m a
q = (e -> m a) -> ReaderT e m a
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT (\e
a-> e -> m a
p e
a m a -> m a -> m a
forall (m :: * -> *) a. DeterministicParsing m => m a -> m a -> m a
<<|> e -> m a
q e
a)
  takeOptional :: ReaderT e m a -> ReaderT e m (Maybe a)
takeOptional = (m a -> m (Maybe a)) -> ReaderT e m a -> ReaderT e m (Maybe a)
forall (m :: * -> *) a (n :: * -> *) b r.
(m a -> n b) -> ReaderT r m a -> ReaderT r n b
mapReaderT m a -> m (Maybe a)
forall (m :: * -> *) a.
DeterministicParsing m =>
m a -> m (Maybe a)
takeOptional
  takeMany :: ReaderT e m a -> ReaderT e m [a]
takeMany = (m a -> m [a]) -> ReaderT e m a -> ReaderT e m [a]
forall (m :: * -> *) a (n :: * -> *) b r.
(m a -> n b) -> ReaderT r m a -> ReaderT r n b
mapReaderT m a -> m [a]
forall (m :: * -> *) a. DeterministicParsing m => m a -> m [a]
takeMany
  takeSome :: ReaderT e m a -> ReaderT e m [a]
takeSome = (m a -> m [a]) -> ReaderT e m a -> ReaderT e m [a]
forall (m :: * -> *) a (n :: * -> *) b r.
(m a -> n b) -> ReaderT r m a -> ReaderT r n b
mapReaderT m a -> m [a]
forall (m :: * -> *) a. DeterministicParsing m => m a -> m [a]
takeSome
  concatAll :: ReaderT e m a -> ReaderT e m a
concatAll = (m a -> m a) -> ReaderT e m a -> ReaderT e m a
forall (m :: * -> *) a (n :: * -> *) b r.
(m a -> n b) -> ReaderT r m a -> ReaderT r n b
mapReaderT m a -> m a
forall (m :: * -> *) a.
(DeterministicParsing m, Monoid a) =>
m a -> m a
concatAll
  skipAll :: ReaderT e m a -> ReaderT e m ()
skipAll = (m a -> m ()) -> ReaderT e m a -> ReaderT e m ()
forall (m :: * -> *) a (n :: * -> *) b r.
(m a -> n b) -> ReaderT r m a -> ReaderT r n b
mapReaderT m a -> m ()
forall (m :: * -> *) a. DeterministicParsing m => m a -> m ()
skipAll

instance (MonadPlus m, DeterministicParsing m, Monoid w) => DeterministicParsing (Lazy.WriterT w m) where
  Lazy.WriterT m (a, w)
p <<|> :: WriterT w m a -> WriterT w m a -> WriterT w m a
<<|> Lazy.WriterT m (a, w)
q = m (a, w) -> WriterT w m a
forall w (m :: * -> *) a. m (a, w) -> WriterT w m a
Lazy.WriterT (m (a, w)
p m (a, w) -> m (a, w) -> m (a, w)
forall (m :: * -> *) a. DeterministicParsing m => m a -> m a -> m a
<<|> m (a, w)
q)
  takeOptional :: WriterT w m a -> WriterT w m (Maybe a)
takeOptional = (m a -> m (Maybe a)) -> WriterT w m a -> WriterT w m (Maybe a)
forall (m :: * -> *) a b w.
Applicative m =>
(m a -> m b) -> WriterT w m a -> WriterT w m b
mapLazyWriterT m a -> m (Maybe a)
forall (m :: * -> *) a.
DeterministicParsing m =>
m a -> m (Maybe a)
takeOptional
  takeMany :: WriterT w m a -> WriterT w m [a]
takeMany = (m a -> m [a]) -> WriterT w m a -> WriterT w m [a]
forall (m :: * -> *) a b w.
Applicative m =>
(m a -> m b) -> WriterT w m a -> WriterT w m b
mapLazyWriterT m a -> m [a]
forall (m :: * -> *) a. DeterministicParsing m => m a -> m [a]
takeMany
  takeSome :: WriterT w m a -> WriterT w m [a]
takeSome = (m a -> m [a]) -> WriterT w m a -> WriterT w m [a]
forall (m :: * -> *) a b w.
Applicative m =>
(m a -> m b) -> WriterT w m a -> WriterT w m b
mapLazyWriterT m a -> m [a]
forall (m :: * -> *) a. DeterministicParsing m => m a -> m [a]
takeSome
  concatAll :: WriterT w m a -> WriterT w m a
concatAll = (m a -> m a) -> WriterT w m a -> WriterT w m a
forall (m :: * -> *) a b w.
Applicative m =>
(m a -> m b) -> WriterT w m a -> WriterT w m b
mapLazyWriterT m a -> m a
forall (m :: * -> *) a.
(DeterministicParsing m, Monoid a) =>
m a -> m a
concatAll
  skipAll :: WriterT w m a -> WriterT w m ()
skipAll = (m a -> m ()) -> WriterT w m a -> WriterT w m ()
forall (m :: * -> *) a b w.
Applicative m =>
(m a -> m b) -> WriterT w m a -> WriterT w m b
mapLazyWriterT m a -> m ()
forall (m :: * -> *) a. DeterministicParsing m => m a -> m ()
skipAll

instance (MonadPlus m, DeterministicParsing m, Monoid w) => DeterministicParsing (Strict.WriterT w m) where
  Strict.WriterT m (a, w)
p <<|> :: WriterT w m a -> WriterT w m a -> WriterT w m a
<<|> Strict.WriterT m (a, w)
q = m (a, w) -> WriterT w m a
forall w (m :: * -> *) a. m (a, w) -> WriterT w m a
Strict.WriterT (m (a, w)
p m (a, w) -> m (a, w) -> m (a, w)
forall (m :: * -> *) a. DeterministicParsing m => m a -> m a -> m a
<<|> m (a, w)
q)
  takeOptional :: WriterT w m a -> WriterT w m (Maybe a)
takeOptional = (m a -> m (Maybe a)) -> WriterT w m a -> WriterT w m (Maybe a)
forall (m :: * -> *) a b w.
Applicative m =>
(m a -> m b) -> WriterT w m a -> WriterT w m b
mapStrictWriterT m a -> m (Maybe a)
forall (m :: * -> *) a.
DeterministicParsing m =>
m a -> m (Maybe a)
takeOptional
  takeMany :: WriterT w m a -> WriterT w m [a]
takeMany = (m a -> m [a]) -> WriterT w m a -> WriterT w m [a]
forall (m :: * -> *) a b w.
Applicative m =>
(m a -> m b) -> WriterT w m a -> WriterT w m b
mapStrictWriterT m a -> m [a]
forall (m :: * -> *) a. DeterministicParsing m => m a -> m [a]
takeMany
  takeSome :: WriterT w m a -> WriterT w m [a]
takeSome = (m a -> m [a]) -> WriterT w m a -> WriterT w m [a]
forall (m :: * -> *) a b w.
Applicative m =>
(m a -> m b) -> WriterT w m a -> WriterT w m b
mapStrictWriterT m a -> m [a]
forall (m :: * -> *) a. DeterministicParsing m => m a -> m [a]
takeSome
  concatAll :: WriterT w m a -> WriterT w m a
concatAll = (m a -> m a) -> WriterT w m a -> WriterT w m a
forall (m :: * -> *) a b w.
Applicative m =>
(m a -> m b) -> WriterT w m a -> WriterT w m b
mapStrictWriterT m a -> m a
forall (m :: * -> *) a.
(DeterministicParsing m, Monoid a) =>
m a -> m a
concatAll
  skipAll :: WriterT w m a -> WriterT w m ()
skipAll = (m a -> m ()) -> WriterT w m a -> WriterT w m ()
forall (m :: * -> *) a b w.
Applicative m =>
(m a -> m b) -> WriterT w m a -> WriterT w m b
mapStrictWriterT m a -> m ()
forall (m :: * -> *) a. DeterministicParsing m => m a -> m ()
skipAll

instance (MonadPlus m, DeterministicParsing m, Monoid w) => DeterministicParsing (Lazy.StateT w m) where
  Lazy.StateT w -> m (a, w)
p <<|> :: StateT w m a -> StateT w m a -> StateT w m a
<<|> Lazy.StateT w -> m (a, w)
q = (w -> m (a, w)) -> StateT w m a
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
Lazy.StateT (\w
s-> w -> m (a, w)
p w
s m (a, w) -> m (a, w) -> m (a, w)
forall (m :: * -> *) a. DeterministicParsing m => m a -> m a -> m a
<<|> w -> m (a, w)
q w
s)
  takeOptional :: StateT w m a -> StateT w m (Maybe a)
takeOptional = (m a -> m (Maybe a)) -> StateT w m a -> StateT w m (Maybe a)
forall (m :: * -> *) a b w.
Applicative m =>
(m a -> m b) -> StateT w m a -> StateT w m b
mapLazyStateT m a -> m (Maybe a)
forall (m :: * -> *) a.
DeterministicParsing m =>
m a -> m (Maybe a)
takeOptional
  takeMany :: StateT w m a -> StateT w m [a]
takeMany = (m a -> m [a]) -> StateT w m a -> StateT w m [a]
forall (m :: * -> *) a b w.
Applicative m =>
(m a -> m b) -> StateT w m a -> StateT w m b
mapLazyStateT m a -> m [a]
forall (m :: * -> *) a. DeterministicParsing m => m a -> m [a]
takeMany
  takeSome :: StateT w m a -> StateT w m [a]
takeSome = (m a -> m [a]) -> StateT w m a -> StateT w m [a]
forall (m :: * -> *) a b w.
Applicative m =>
(m a -> m b) -> StateT w m a -> StateT w m b
mapLazyStateT m a -> m [a]
forall (m :: * -> *) a. DeterministicParsing m => m a -> m [a]
takeSome
  concatAll :: StateT w m a -> StateT w m a
concatAll = (m a -> m a) -> StateT w m a -> StateT w m a
forall (m :: * -> *) a b w.
Applicative m =>
(m a -> m b) -> StateT w m a -> StateT w m b
mapLazyStateT m a -> m a
forall (m :: * -> *) a.
(DeterministicParsing m, Monoid a) =>
m a -> m a
concatAll
  skipAll :: StateT w m a -> StateT w m ()
skipAll = (m a -> m ()) -> StateT w m a -> StateT w m ()
forall (m :: * -> *) a b w.
Applicative m =>
(m a -> m b) -> StateT w m a -> StateT w m b
mapLazyStateT m a -> m ()
forall (m :: * -> *) a. DeterministicParsing m => m a -> m ()
skipAll

instance (MonadPlus m, DeterministicParsing m, Monoid w) => DeterministicParsing (Strict.StateT w m) where
  Strict.StateT w -> m (a, w)
p <<|> :: StateT w m a -> StateT w m a -> StateT w m a
<<|> Strict.StateT w -> m (a, w)
q = (w -> m (a, w)) -> StateT w m a
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
Strict.StateT (\w
s-> w -> m (a, w)
p w
s m (a, w) -> m (a, w) -> m (a, w)
forall (m :: * -> *) a. DeterministicParsing m => m a -> m a -> m a
<<|> w -> m (a, w)
q w
s)
  takeOptional :: StateT w m a -> StateT w m (Maybe a)
takeOptional = (m a -> m (Maybe a)) -> StateT w m a -> StateT w m (Maybe a)
forall (m :: * -> *) a b s.
Applicative m =>
(m a -> m b) -> StateT s m a -> StateT s m b
mapStrictStateT m a -> m (Maybe a)
forall (m :: * -> *) a.
DeterministicParsing m =>
m a -> m (Maybe a)
takeOptional
  takeMany :: StateT w m a -> StateT w m [a]
takeMany = (m a -> m [a]) -> StateT w m a -> StateT w m [a]
forall (m :: * -> *) a b s.
Applicative m =>
(m a -> m b) -> StateT s m a -> StateT s m b
mapStrictStateT m a -> m [a]
forall (m :: * -> *) a. DeterministicParsing m => m a -> m [a]
takeMany
  takeSome :: StateT w m a -> StateT w m [a]
takeSome = (m a -> m [a]) -> StateT w m a -> StateT w m [a]
forall (m :: * -> *) a b s.
Applicative m =>
(m a -> m b) -> StateT s m a -> StateT s m b
mapStrictStateT m a -> m [a]
forall (m :: * -> *) a. DeterministicParsing m => m a -> m [a]
takeSome
  concatAll :: StateT w m a -> StateT w m a
concatAll = (m a -> m a) -> StateT w m a -> StateT w m a
forall (m :: * -> *) a b s.
Applicative m =>
(m a -> m b) -> StateT s m a -> StateT s m b
mapStrictStateT m a -> m a
forall (m :: * -> *) a.
(DeterministicParsing m, Monoid a) =>
m a -> m a
concatAll
  skipAll :: StateT w m a -> StateT w m ()
skipAll = (m a -> m ()) -> StateT w m a -> StateT w m ()
forall (m :: * -> *) a b s.
Applicative m =>
(m a -> m b) -> StateT s m a -> StateT s m b
mapStrictStateT m a -> m ()
forall (m :: * -> *) a. DeterministicParsing m => m a -> m ()
skipAll

instance (MonadPlus m, DeterministicParsing m, Monoid w) => DeterministicParsing (Lazy.RWST r w s m) where
  Lazy.RWST r -> s -> m (a, s, w)
p <<|> :: RWST r w s m a -> RWST r w s m a -> RWST r w s m a
<<|> Lazy.RWST r -> s -> m (a, s, w)
q = (r -> s -> m (a, s, w)) -> RWST r w s m a
forall r w s (m :: * -> *) a.
(r -> s -> m (a, s, w)) -> RWST r w s m a
Lazy.RWST (\r
r s
s-> r -> s -> m (a, s, w)
p r
r s
s m (a, s, w) -> m (a, s, w) -> m (a, s, w)
forall (m :: * -> *) a. DeterministicParsing m => m a -> m a -> m a
<<|> r -> s -> m (a, s, w)
q r
r s
s)
  takeOptional :: RWST r w s m a -> RWST r w s m (Maybe a)
takeOptional = (m a -> m (Maybe a)) -> RWST r w s m a -> RWST r w s m (Maybe a)
forall (m :: * -> *) a b r w s.
Applicative m =>
(m a -> m b) -> RWST r w s m a -> RWST r w s m b
mapLazyRWST m a -> m (Maybe a)
forall (m :: * -> *) a.
DeterministicParsing m =>
m a -> m (Maybe a)
takeOptional
  takeMany :: RWST r w s m a -> RWST r w s m [a]
takeMany = (m a -> m [a]) -> RWST r w s m a -> RWST r w s m [a]
forall (m :: * -> *) a b r w s.
Applicative m =>
(m a -> m b) -> RWST r w s m a -> RWST r w s m b
mapLazyRWST m a -> m [a]
forall (m :: * -> *) a. DeterministicParsing m => m a -> m [a]
takeMany
  takeSome :: RWST r w s m a -> RWST r w s m [a]
takeSome = (m a -> m [a]) -> RWST r w s m a -> RWST r w s m [a]
forall (m :: * -> *) a b r w s.
Applicative m =>
(m a -> m b) -> RWST r w s m a -> RWST r w s m b
mapLazyRWST m a -> m [a]
forall (m :: * -> *) a. DeterministicParsing m => m a -> m [a]
takeSome
  concatAll :: RWST r w s m a -> RWST r w s m a
concatAll = (m a -> m a) -> RWST r w s m a -> RWST r w s m a
forall (m :: * -> *) a b r w s.
Applicative m =>
(m a -> m b) -> RWST r w s m a -> RWST r w s m b
mapLazyRWST m a -> m a
forall (m :: * -> *) a.
(DeterministicParsing m, Monoid a) =>
m a -> m a
concatAll
  skipAll :: RWST r w s m a -> RWST r w s m ()
skipAll = (m a -> m ()) -> RWST r w s m a -> RWST r w s m ()
forall (m :: * -> *) a b r w s.
Applicative m =>
(m a -> m b) -> RWST r w s m a -> RWST r w s m b
mapLazyRWST m a -> m ()
forall (m :: * -> *) a. DeterministicParsing m => m a -> m ()
skipAll

instance (MonadPlus m, DeterministicParsing m, Monoid w) => DeterministicParsing (Strict.RWST r w s m) where
  Strict.RWST r -> s -> m (a, s, w)
p <<|> :: RWST r w s m a -> RWST r w s m a -> RWST r w s m a
<<|> Strict.RWST r -> s -> m (a, s, w)
q = (r -> s -> m (a, s, w)) -> RWST r w s m a
forall r w s (m :: * -> *) a.
(r -> s -> m (a, s, w)) -> RWST r w s m a
Strict.RWST (\r
r s
s-> r -> s -> m (a, s, w)
p r
r s
s m (a, s, w) -> m (a, s, w) -> m (a, s, w)
forall (m :: * -> *) a. DeterministicParsing m => m a -> m a -> m a
<<|> r -> s -> m (a, s, w)
q r
r s
s)
  takeOptional :: RWST r w s m a -> RWST r w s m (Maybe a)
takeOptional = (m a -> m (Maybe a)) -> RWST r w s m a -> RWST r w s m (Maybe a)
forall (m :: * -> *) a b r w s.
Applicative m =>
(m a -> m b) -> RWST r w s m a -> RWST r w s m b
mapStrictRWST m a -> m (Maybe a)
forall (m :: * -> *) a.
DeterministicParsing m =>
m a -> m (Maybe a)
takeOptional
  takeMany :: RWST r w s m a -> RWST r w s m [a]
takeMany = (m a -> m [a]) -> RWST r w s m a -> RWST r w s m [a]
forall (m :: * -> *) a b r w s.
Applicative m =>
(m a -> m b) -> RWST r w s m a -> RWST r w s m b
mapStrictRWST m a -> m [a]
forall (m :: * -> *) a. DeterministicParsing m => m a -> m [a]
takeMany
  takeSome :: RWST r w s m a -> RWST r w s m [a]
takeSome = (m a -> m [a]) -> RWST r w s m a -> RWST r w s m [a]
forall (m :: * -> *) a b r w s.
Applicative m =>
(m a -> m b) -> RWST r w s m a -> RWST r w s m b
mapStrictRWST m a -> m [a]
forall (m :: * -> *) a. DeterministicParsing m => m a -> m [a]
takeSome
  concatAll :: RWST r w s m a -> RWST r w s m a
concatAll = (m a -> m a) -> RWST r w s m a -> RWST r w s m a
forall (m :: * -> *) a b r w s.
Applicative m =>
(m a -> m b) -> RWST r w s m a -> RWST r w s m b
mapStrictRWST m a -> m a
forall (m :: * -> *) a.
(DeterministicParsing m, Monoid a) =>
m a -> m a
concatAll
  skipAll :: RWST r w s m a -> RWST r w s m ()
skipAll = (m a -> m ()) -> RWST r w s m a -> RWST r w s m ()
forall (m :: * -> *) a b r w s.
Applicative m =>
(m a -> m b) -> RWST r w s m a -> RWST r w s m b
mapStrictRWST m a -> m ()
forall (m :: * -> *) a. DeterministicParsing m => m a -> m ()
skipAll

#ifdef MIN_VERSION_attoparsec
instance DeterministicParsing Attoparsec.Parser where
  <<|> :: Parser a -> Parser a -> Parser a
(<<|>) = Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>)
  takeOptional :: Parser a -> Parser (Maybe a)
takeOptional = Parser a -> Parser (Maybe a)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional
  takeMany :: Parser a -> Parser [a]
takeMany = Parser a -> Parser [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many
  takeSome :: Parser a -> Parser [a]
takeSome = Parser a -> Parser [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some
  skipAll :: Parser a -> Parser ()
skipAll = Parser a -> Parser ()
forall (f :: * -> *) a. Alternative f => f a -> f ()
Attoparsec.skipMany

instance DeterministicParsing Attoparsec.Text.Parser where
  <<|> :: Parser a -> Parser a -> Parser a
(<<|>) = Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>)
  takeOptional :: Parser a -> Parser (Maybe a)
takeOptional = Parser a -> Parser (Maybe a)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional
  takeMany :: Parser a -> Parser [a]
takeMany = Parser a -> Parser [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many
  takeSome :: Parser a -> Parser [a]
takeSome = Parser a -> Parser [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some
  skipAll :: Parser a -> Parser ()
skipAll = Parser a -> Parser ()
forall (f :: * -> *) a. Alternative f => f a -> f ()
Attoparsec.Text.skipMany
#endif

#ifdef MIN_VERSION_binary
instance DeterministicParsing (Lazy Binary.Get) where
  <<|> :: Lazy Get a -> Lazy Get a -> Lazy Get a
(<<|>) = Lazy Get a -> Lazy Get a -> Lazy Get a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>)
  takeOptional :: Lazy Get a -> Lazy Get (Maybe a)
takeOptional = Lazy Get a -> Lazy Get (Maybe a)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional
  takeMany :: Lazy Get a -> Lazy Get [a]
takeMany = Lazy Get a -> Lazy Get [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many
  takeSome :: Lazy Get a -> Lazy Get [a]
takeSome = Lazy Get a -> Lazy Get [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some

instance DeterministicParsing (Strict Binary.Get) where
  <<|> :: Strict Get a -> Strict Get a -> Strict Get a
(<<|>) = Strict Get a -> Strict Get a -> Strict Get a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>)
  takeOptional :: Strict Get a -> Strict Get (Maybe a)
takeOptional = Strict Get a -> Strict Get (Maybe a)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional
  takeMany :: Strict Get a -> Strict Get [a]
takeMany = Strict Get a -> Strict Get [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many
  takeSome :: Strict Get a -> Strict Get [a]
takeSome = Strict Get a -> Strict Get [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some
#endif