{-# LANGUAGE GADTs #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# OPTIONS_GHC -fspec-constr -fspec-constr-count=8 #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Distribution.Compat.CharParsing
-- Copyright   :  (c) Edward Kmett 2011
-- License     :  BSD3
--
-- Maintainer  :  ekmett@gmail.com
-- Stability   :  experimental
-- Portability :  non-portable
--
-- Parsers for character streams
--
-- Originally in @parsers@ package.
--
-----------------------------------------------------------------------------
module Distribution.Compat.CharParsing
  (
  -- * Combinators
    oneOf        -- :: CharParsing m => [Char] -> m Char
  , noneOf       -- :: CharParsing m => [Char] -> m Char
  , spaces       -- :: CharParsing m => m ()
  , space        -- :: CharParsing m => m Char
  , newline      -- :: CharParsing m => m Char
  , tab          -- :: CharParsing m => m Char
  , upper        -- :: CharParsing m => m Char
  , lower        -- :: CharParsing m => m Char
  , alphaNum     -- :: CharParsing m => m Char
  , letter       -- :: CharParsing m => m Char
  , digit        -- :: CharParsing m => m Char
  , hexDigit     -- :: CharParsing m => m Char
  , octDigit     -- :: CharParsing m => m Char
  , satisfyRange -- :: CharParsing m => Char -> Char -> m Char
  -- * Class
  , CharParsing(..)
  -- * Cabal additions
  , integral
  , munch1
  , munch
  , skipSpaces1
  , module Distribution.Compat.Parsing
  ) where

import Prelude ()
import Distribution.Compat.Prelude

import Control.Monad.Trans.Class (lift)
import Control.Monad.Trans.State.Lazy as Lazy
import Control.Monad.Trans.State.Strict as Strict
import Control.Monad.Trans.Writer.Lazy as Lazy
import Control.Monad.Trans.Writer.Strict as Strict
import Control.Monad.Trans.RWS.Lazy as Lazy
import Control.Monad.Trans.RWS.Strict as Strict
import Control.Monad.Trans.Reader (ReaderT (..))
import Control.Monad.Trans.Identity (IdentityT (..))
import Data.Char
import Data.Text (Text, unpack)

import qualified Text.Parsec as Parsec

import Distribution.Compat.Parsing

-- | @oneOf cs@ succeeds if the current character is in the supplied
-- list of characters @cs@. Returns the parsed character. See also
-- 'satisfy'.
--
-- >   vowel  = oneOf "aeiou"
oneOf :: CharParsing m => [Char] -> m Char
oneOf :: [Char] -> m Char
oneOf [Char]
xs = (Char -> Bool) -> m Char
forall (m :: * -> *). CharParsing m => (Char -> Bool) -> m Char
Evidence bound by a type signature of the constraint type CharParsing m
satisfy (\Char
c -> Char
c Char -> [Char] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
External instance of the constraint type Eq Char
External instance of the constraint type Foldable []
`elem` [Char]
xs)
{-# INLINE oneOf #-}

-- | As the dual of 'oneOf', @noneOf cs@ succeeds if the current
-- character is /not/ in the supplied list of characters @cs@. Returns the
-- parsed character.
--
-- >  consonant = noneOf "aeiou"
noneOf :: CharParsing m => [Char] -> m Char
noneOf :: [Char] -> m Char
noneOf [Char]
xs = (Char -> Bool) -> m Char
forall (m :: * -> *). CharParsing m => (Char -> Bool) -> m Char
Evidence bound by a type signature of the constraint type CharParsing m
satisfy (\Char
c -> Char
c Char -> [Char] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
External instance of the constraint type Eq Char
External instance of the constraint type Foldable []
`notElem` [Char]
xs)
{-# INLINE noneOf #-}

-- | Skips /zero/ or more white space characters. See also 'skipMany'.
spaces :: CharParsing m => m ()
spaces :: m ()
spaces = m Char -> m ()
forall (m :: * -> *) a. Parsing m => m a -> m ()
Evidence bound by a superclass of: CharParsing of the constraint type forall (m :: * -> *). CharParsing m => Parsing m
Evidence bound by a type signature of the constraint type CharParsing m
skipMany m Char
forall (m :: * -> *). CharParsing m => m Char
Evidence bound by a type signature of the constraint type CharParsing m
space m () -> [Char] -> m ()
forall (m :: * -> *) a. Parsing m => m a -> [Char] -> m a
Evidence bound by a superclass of: CharParsing of the constraint type forall (m :: * -> *). CharParsing m => Parsing m
Evidence bound by a type signature of the constraint type CharParsing m
<?> [Char]
"white space"
{-# INLINE spaces #-}

-- | Parses a white space character (any character which satisfies 'isSpace')
-- Returns the parsed character.
space :: CharParsing m => m Char
space :: m Char
space = (Char -> Bool) -> m Char
forall (m :: * -> *). CharParsing m => (Char -> Bool) -> m Char
Evidence bound by a type signature of the constraint type CharParsing m
satisfy Char -> Bool
isSpace m Char -> [Char] -> m Char
forall (m :: * -> *) a. Parsing m => m a -> [Char] -> m a
Evidence bound by a superclass of: CharParsing of the constraint type forall (m :: * -> *). CharParsing m => Parsing m
Evidence bound by a type signature of the constraint type CharParsing m
<?> [Char]
"space"
{-# INLINE space #-}

-- | Parses a newline character (\'\\n\'). Returns a newline character.
newline :: CharParsing m => m Char
newline :: m Char
newline = Char -> m Char
forall (m :: * -> *). CharParsing m => Char -> m Char
Evidence bound by a type signature of the constraint type CharParsing m
char Char
'\n' m Char -> [Char] -> m Char
forall (m :: * -> *) a. Parsing m => m a -> [Char] -> m a
Evidence bound by a superclass of: CharParsing of the constraint type forall (m :: * -> *). CharParsing m => Parsing m
Evidence bound by a type signature of the constraint type CharParsing m
<?> [Char]
"new-line"
{-# INLINE newline #-}

-- | Parses a tab character (\'\\t\'). Returns a tab character.
tab :: CharParsing m => m Char
tab :: m Char
tab = Char -> m Char
forall (m :: * -> *). CharParsing m => Char -> m Char
Evidence bound by a type signature of the constraint type CharParsing m
char Char
'\t' m Char -> [Char] -> m Char
forall (m :: * -> *) a. Parsing m => m a -> [Char] -> m a
Evidence bound by a superclass of: CharParsing of the constraint type forall (m :: * -> *). CharParsing m => Parsing m
Evidence bound by a type signature of the constraint type CharParsing m
<?> [Char]
"tab"
{-# INLINE tab #-}

-- | Parses an upper case letter. Returns the parsed character.
upper :: CharParsing m => m Char
upper :: m Char
upper = (Char -> Bool) -> m Char
forall (m :: * -> *). CharParsing m => (Char -> Bool) -> m Char
Evidence bound by a type signature of the constraint type CharParsing m
satisfy Char -> Bool
isUpper m Char -> [Char] -> m Char
forall (m :: * -> *) a. Parsing m => m a -> [Char] -> m a
Evidence bound by a superclass of: CharParsing of the constraint type forall (m :: * -> *). CharParsing m => Parsing m
Evidence bound by a type signature of the constraint type CharParsing m
<?> [Char]
"uppercase letter"
{-# INLINE upper #-}

-- | Parses a lower case character. Returns the parsed character.
lower :: CharParsing m => m Char
lower :: m Char
lower = (Char -> Bool) -> m Char
forall (m :: * -> *). CharParsing m => (Char -> Bool) -> m Char
Evidence bound by a type signature of the constraint type CharParsing m
satisfy Char -> Bool
isLower m Char -> [Char] -> m Char
forall (m :: * -> *) a. Parsing m => m a -> [Char] -> m a
Evidence bound by a superclass of: CharParsing of the constraint type forall (m :: * -> *). CharParsing m => Parsing m
Evidence bound by a type signature of the constraint type CharParsing m
<?> [Char]
"lowercase letter"
{-# INLINE lower #-}

-- | Parses a letter or digit. Returns the parsed character.
alphaNum :: CharParsing m => m Char
alphaNum :: m Char
alphaNum = (Char -> Bool) -> m Char
forall (m :: * -> *). CharParsing m => (Char -> Bool) -> m Char
Evidence bound by a type signature of the constraint type CharParsing m
satisfy Char -> Bool
isAlphaNum m Char -> [Char] -> m Char
forall (m :: * -> *) a. Parsing m => m a -> [Char] -> m a
Evidence bound by a superclass of: CharParsing of the constraint type forall (m :: * -> *). CharParsing m => Parsing m
Evidence bound by a type signature of the constraint type CharParsing m
<?> [Char]
"letter or digit"
{-# INLINE alphaNum #-}

-- | Parses a letter (an upper case or lower case character). Returns the
-- parsed character.
letter :: CharParsing m => m Char
letter :: m Char
letter = (Char -> Bool) -> m Char
forall (m :: * -> *). CharParsing m => (Char -> Bool) -> m Char
Evidence bound by a type signature of the constraint type CharParsing m
satisfy Char -> Bool
isAlpha m Char -> [Char] -> m Char
forall (m :: * -> *) a. Parsing m => m a -> [Char] -> m a
Evidence bound by a superclass of: CharParsing of the constraint type forall (m :: * -> *). CharParsing m => Parsing m
Evidence bound by a type signature of the constraint type CharParsing m
<?> [Char]
"letter"
{-# INLINE letter #-}

-- | Parses a digit. Returns the parsed character.
digit :: CharParsing m => m Char
digit :: m Char
digit = (Char -> Bool) -> m Char
forall (m :: * -> *). CharParsing m => (Char -> Bool) -> m Char
Evidence bound by a type signature of the constraint type CharParsing m
satisfy Char -> Bool
isDigit m Char -> [Char] -> m Char
forall (m :: * -> *) a. Parsing m => m a -> [Char] -> m a
Evidence bound by a superclass of: CharParsing of the constraint type forall (m :: * -> *). CharParsing m => Parsing m
Evidence bound by a type signature of the constraint type CharParsing m
<?> [Char]
"digit"
{-# INLINE digit #-}

-- | Parses a hexadecimal digit (a digit or a letter between \'a\' and
-- \'f\' or \'A\' and \'F\'). Returns the parsed character.
hexDigit :: CharParsing m => m Char
hexDigit :: m Char
hexDigit = (Char -> Bool) -> m Char
forall (m :: * -> *). CharParsing m => (Char -> Bool) -> m Char
Evidence bound by a type signature of the constraint type CharParsing m
satisfy Char -> Bool
isHexDigit m Char -> [Char] -> m Char
forall (m :: * -> *) a. Parsing m => m a -> [Char] -> m a
Evidence bound by a superclass of: CharParsing of the constraint type forall (m :: * -> *). CharParsing m => Parsing m
Evidence bound by a type signature of the constraint type CharParsing m
<?> [Char]
"hexadecimal digit"
{-# INLINE hexDigit #-}

-- | Parses an octal digit (a character between \'0\' and \'7\'). Returns
-- the parsed character.
octDigit :: CharParsing m => m Char
octDigit :: m Char
octDigit = (Char -> Bool) -> m Char
forall (m :: * -> *). CharParsing m => (Char -> Bool) -> m Char
Evidence bound by a type signature of the constraint type CharParsing m
satisfy Char -> Bool
isOctDigit m Char -> [Char] -> m Char
forall (m :: * -> *) a. Parsing m => m a -> [Char] -> m a
Evidence bound by a superclass of: CharParsing of the constraint type forall (m :: * -> *). CharParsing m => Parsing m
Evidence bound by a type signature of the constraint type CharParsing m
<?> [Char]
"octal digit"
{-# INLINE octDigit #-}

satisfyRange :: CharParsing m => Char -> Char -> m Char
satisfyRange :: Char -> Char -> m Char
satisfyRange Char
a Char
z = (Char -> Bool) -> m Char
forall (m :: * -> *). CharParsing m => (Char -> Bool) -> m Char
Evidence bound by a type signature of the constraint type CharParsing m
satisfy (\Char
c -> Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Char
>= Char
a Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Char
<= Char
z)
{-# INLINE satisfyRange #-}

-- | Additional functionality needed to parse character streams.
class Parsing m => CharParsing m where
  -- | Parse a single character of the input, with UTF-8 decoding
  satisfy :: (Char -> Bool) -> m Char

  -- | @char c@ parses a single character @c@. Returns the parsed
  -- character (i.e. @c@).
  --
  -- /e.g./
  --
  -- @semiColon = 'char' ';'@
  char :: Char -> m Char
  char Char
c = (Char -> Bool) -> m Char
forall (m :: * -> *). CharParsing m => (Char -> Bool) -> m Char
Evidence bound by a type signature of the constraint type CharParsing m
satisfy (Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
External instance of the constraint type Eq Char
==) m Char -> [Char] -> m Char
forall (m :: * -> *) a. Parsing m => m a -> [Char] -> m a
Evidence bound by a superclass of: CharParsing of the constraint type forall (m :: * -> *). CharParsing m => Parsing m
Evidence bound by a type signature of the constraint type CharParsing m
<?> [Char] -> [Char]
forall a. Show a => a -> [Char]
External instance of the constraint type forall a. Show a => Show [a]
External instance of the constraint type Show Char
show [Char
c]
  {-# INLINE char #-}

  -- | @notChar c@ parses any single character other than @c@. Returns the parsed
  -- character.
  notChar :: Char -> m Char
  notChar Char
c = (Char -> Bool) -> m Char
forall (m :: * -> *). CharParsing m => (Char -> Bool) -> m Char
Evidence bound by a type signature of the constraint type CharParsing m
satisfy (Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
External instance of the constraint type Eq Char
/=)
  {-# INLINE notChar #-}

  -- | This parser succeeds for any character. Returns the parsed character.
  anyChar :: m Char
  anyChar = (Char -> Bool) -> m Char
forall (m :: * -> *). CharParsing m => (Char -> Bool) -> m Char
Evidence bound by a type signature of the constraint type CharParsing m
satisfy (Bool -> Char -> Bool
forall a b. a -> b -> a
const Bool
True)
  {-# INLINE anyChar #-}

  -- | @string s@ parses a sequence of characters given by @s@. Returns
  -- the parsed string (i.e. @s@).
  --
  -- >  divOrMod    =   string "div"
  -- >              <|> string "mod"
  string :: String -> m String
  string [Char]
s = [Char]
s [Char] -> m () -> m [Char]
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
External instance of the constraint type forall (f :: * -> *). Applicative f => Functor f
External instance of the constraint type forall (f :: * -> *). Alternative f => Applicative f
External instance of the constraint type forall (m :: * -> *). Parsing m => Alternative m
Evidence bound by a superclass of: CharParsing of the constraint type forall (m :: * -> *). CharParsing m => Parsing m
Evidence bound by a type signature of the constraint type CharParsing m
<$ m () -> m ()
forall (m :: * -> *) a. Parsing m => m a -> m a
Evidence bound by a superclass of: CharParsing of the constraint type forall (m :: * -> *). CharParsing m => Parsing m
Evidence bound by a type signature of the constraint type CharParsing m
try ((Char -> m Char) -> [Char] -> m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
External instance of the constraint type forall (f :: * -> *). Alternative f => Applicative f
External instance of the constraint type forall (m :: * -> *). Parsing m => Alternative m
Evidence bound by a superclass of: CharParsing of the constraint type forall (m :: * -> *). CharParsing m => Parsing m
Evidence bound by a type signature of the constraint type CharParsing m
External instance of the constraint type Foldable []
traverse_ Char -> m Char
forall (m :: * -> *). CharParsing m => Char -> m Char
Evidence bound by a type signature of the constraint type CharParsing m
char [Char]
s) m [Char] -> [Char] -> m [Char]
forall (m :: * -> *) a. Parsing m => m a -> [Char] -> m a
Evidence bound by a superclass of: CharParsing of the constraint type forall (m :: * -> *). CharParsing m => Parsing m
Evidence bound by a type signature of the constraint type CharParsing m
<?> [Char] -> [Char]
forall a. Show a => a -> [Char]
External instance of the constraint type forall a. Show a => Show [a]
External instance of the constraint type Show Char
show [Char]
s
  {-# INLINE string #-}

  -- | @text t@ parses a sequence of characters determined by the text @t@ Returns
  -- the parsed text fragment (i.e. @t@).
  --
  -- Using @OverloadedStrings@:
  --
  -- >  divOrMod    =   text "div"
  -- >              <|> text "mod"
  text :: Text -> m Text
  text Text
t = Text
t Text -> m [Char] -> m Text
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
External instance of the constraint type forall (f :: * -> *). Applicative f => Functor f
External instance of the constraint type forall (f :: * -> *). Alternative f => Applicative f
External instance of the constraint type forall (m :: * -> *). Parsing m => Alternative m
Evidence bound by a superclass of: CharParsing of the constraint type forall (m :: * -> *). CharParsing m => Parsing m
Evidence bound by a type signature of the constraint type CharParsing m
<$ [Char] -> m [Char]
forall (m :: * -> *). CharParsing m => [Char] -> m [Char]
Evidence bound by a type signature of the constraint type CharParsing m
string (Text -> [Char]
unpack Text
t)
  {-# INLINE text #-}

instance (CharParsing m, MonadPlus m) => CharParsing (Lazy.StateT s m) where
  satisfy :: (Char -> Bool) -> StateT s m Char
satisfy = m Char -> StateT s m Char
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
External instance of the constraint type forall (m :: * -> *). MonadPlus m => Monad m
Evidence bound by a type signature of the constraint type MonadPlus m
External instance of the constraint type forall s. MonadTrans (StateT s)
lift (m Char -> StateT s m Char)
-> ((Char -> Bool) -> m Char) -> (Char -> Bool) -> StateT s m Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> m Char
forall (m :: * -> *). CharParsing m => (Char -> Bool) -> m Char
Evidence bound by a type signature of the constraint type CharParsing m
satisfy
  {-# INLINE satisfy #-}
  char :: Char -> StateT s m Char
char    = m Char -> StateT s m Char
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
External instance of the constraint type forall (m :: * -> *). MonadPlus m => Monad m
Evidence bound by a type signature of the constraint type MonadPlus m
External instance of the constraint type forall s. MonadTrans (StateT s)
lift (m Char -> StateT s m Char)
-> (Char -> m Char) -> Char -> StateT s m Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> m Char
forall (m :: * -> *). CharParsing m => Char -> m Char
Evidence bound by a type signature of the constraint type CharParsing m
char
  {-# INLINE char #-}
  notChar :: Char -> StateT s m Char
notChar = m Char -> StateT s m Char
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
External instance of the constraint type forall (m :: * -> *). MonadPlus m => Monad m
Evidence bound by a type signature of the constraint type MonadPlus m
External instance of the constraint type forall s. MonadTrans (StateT s)
lift (m Char -> StateT s m Char)
-> (Char -> m Char) -> Char -> StateT s m Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> m Char
forall (m :: * -> *). CharParsing m => Char -> m Char
Evidence bound by a type signature of the constraint type CharParsing m
notChar
  {-# INLINE notChar #-}
  anyChar :: StateT s m Char
anyChar = m Char -> StateT s m Char
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
External instance of the constraint type forall (m :: * -> *). MonadPlus m => Monad m
Evidence bound by a type signature of the constraint type MonadPlus m
External instance of the constraint type forall s. MonadTrans (StateT s)
lift m Char
forall (m :: * -> *). CharParsing m => m Char
Evidence bound by a type signature of the constraint type CharParsing m
anyChar
  {-# INLINE anyChar #-}
  string :: [Char] -> StateT s m [Char]
string  = m [Char] -> StateT s m [Char]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
External instance of the constraint type forall (m :: * -> *). MonadPlus m => Monad m
Evidence bound by a type signature of the constraint type MonadPlus m
External instance of the constraint type forall s. MonadTrans (StateT s)
lift (m [Char] -> StateT s m [Char])
-> ([Char] -> m [Char]) -> [Char] -> StateT s m [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> m [Char]
forall (m :: * -> *). CharParsing m => [Char] -> m [Char]
Evidence bound by a type signature of the constraint type CharParsing m
string
  {-# INLINE string #-}
  text :: Text -> StateT s m Text
text = m Text -> StateT s m Text
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
External instance of the constraint type forall (m :: * -> *). MonadPlus m => Monad m
Evidence bound by a type signature of the constraint type MonadPlus m
External instance of the constraint type forall s. MonadTrans (StateT s)
lift (m Text -> StateT s m Text)
-> (Text -> m Text) -> Text -> StateT s m Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> m Text
forall (m :: * -> *). CharParsing m => Text -> m Text
Evidence bound by a type signature of the constraint type CharParsing m
text
  {-# INLINE text #-}

instance (CharParsing m, MonadPlus m) => CharParsing (Strict.StateT s m) where
  satisfy :: (Char -> Bool) -> StateT s m Char
satisfy = m Char -> StateT s m Char
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
External instance of the constraint type forall (m :: * -> *). MonadPlus m => Monad m
Evidence bound by a type signature of the constraint type MonadPlus m
External instance of the constraint type forall s. MonadTrans (StateT s)
lift (m Char -> StateT s m Char)
-> ((Char -> Bool) -> m Char) -> (Char -> Bool) -> StateT s m Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> m Char
forall (m :: * -> *). CharParsing m => (Char -> Bool) -> m Char
Evidence bound by a type signature of the constraint type CharParsing m
satisfy
  {-# INLINE satisfy #-}
  char :: Char -> StateT s m Char
char    = m Char -> StateT s m Char
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
External instance of the constraint type forall (m :: * -> *). MonadPlus m => Monad m
Evidence bound by a type signature of the constraint type MonadPlus m
External instance of the constraint type forall s. MonadTrans (StateT s)
lift (m Char -> StateT s m Char)
-> (Char -> m Char) -> Char -> StateT s m Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> m Char
forall (m :: * -> *). CharParsing m => Char -> m Char
Evidence bound by a type signature of the constraint type CharParsing m
char
  {-# INLINE char #-}
  notChar :: Char -> StateT s m Char
notChar = m Char -> StateT s m Char
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
External instance of the constraint type forall (m :: * -> *). MonadPlus m => Monad m
Evidence bound by a type signature of the constraint type MonadPlus m
External instance of the constraint type forall s. MonadTrans (StateT s)
lift (m Char -> StateT s m Char)
-> (Char -> m Char) -> Char -> StateT s m Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> m Char
forall (m :: * -> *). CharParsing m => Char -> m Char
Evidence bound by a type signature of the constraint type CharParsing m
notChar
  {-# INLINE notChar #-}
  anyChar :: StateT s m Char
anyChar = m Char -> StateT s m Char
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
External instance of the constraint type forall (m :: * -> *). MonadPlus m => Monad m
Evidence bound by a type signature of the constraint type MonadPlus m
External instance of the constraint type forall s. MonadTrans (StateT s)
lift m Char
forall (m :: * -> *). CharParsing m => m Char
Evidence bound by a type signature of the constraint type CharParsing m
anyChar
  {-# INLINE anyChar #-}
  string :: [Char] -> StateT s m [Char]
string  = m [Char] -> StateT s m [Char]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
External instance of the constraint type forall (m :: * -> *). MonadPlus m => Monad m
Evidence bound by a type signature of the constraint type MonadPlus m
External instance of the constraint type forall s. MonadTrans (StateT s)
lift (m [Char] -> StateT s m [Char])
-> ([Char] -> m [Char]) -> [Char] -> StateT s m [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> m [Char]
forall (m :: * -> *). CharParsing m => [Char] -> m [Char]
Evidence bound by a type signature of the constraint type CharParsing m
string
  {-# INLINE string #-}
  text :: Text -> StateT s m Text
text = m Text -> StateT s m Text
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
External instance of the constraint type forall (m :: * -> *). MonadPlus m => Monad m
Evidence bound by a type signature of the constraint type MonadPlus m
External instance of the constraint type forall s. MonadTrans (StateT s)
lift (m Text -> StateT s m Text)
-> (Text -> m Text) -> Text -> StateT s m Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> m Text
forall (m :: * -> *). CharParsing m => Text -> m Text
Evidence bound by a type signature of the constraint type CharParsing m
text
  {-# INLINE text #-}

instance (CharParsing m, MonadPlus m) => CharParsing (ReaderT e m) where
  satisfy :: (Char -> Bool) -> ReaderT e m Char
satisfy = m Char -> ReaderT e m Char
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
External instance of the constraint type forall (m :: * -> *). MonadPlus m => Monad m
Evidence bound by a type signature of the constraint type MonadPlus m
External instance of the constraint type forall r. MonadTrans (ReaderT r)
lift (m Char -> ReaderT e m Char)
-> ((Char -> Bool) -> m Char) -> (Char -> Bool) -> ReaderT e m Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> m Char
forall (m :: * -> *). CharParsing m => (Char -> Bool) -> m Char
Evidence bound by a type signature of the constraint type CharParsing m
satisfy
  {-# INLINE satisfy #-}
  char :: Char -> ReaderT e m Char
char    = m Char -> ReaderT e m Char
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
External instance of the constraint type forall (m :: * -> *). MonadPlus m => Monad m
Evidence bound by a type signature of the constraint type MonadPlus m
External instance of the constraint type forall r. MonadTrans (ReaderT r)
lift (m Char -> ReaderT e m Char)
-> (Char -> m Char) -> Char -> ReaderT e m Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> m Char
forall (m :: * -> *). CharParsing m => Char -> m Char
Evidence bound by a type signature of the constraint type CharParsing m
char
  {-# INLINE char #-}
  notChar :: Char -> ReaderT e m Char
notChar = m Char -> ReaderT e m Char
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
External instance of the constraint type forall (m :: * -> *). MonadPlus m => Monad m
Evidence bound by a type signature of the constraint type MonadPlus m
External instance of the constraint type forall r. MonadTrans (ReaderT r)
lift (m Char -> ReaderT e m Char)
-> (Char -> m Char) -> Char -> ReaderT e m Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> m Char
forall (m :: * -> *). CharParsing m => Char -> m Char
Evidence bound by a type signature of the constraint type CharParsing m
notChar
  {-# INLINE notChar #-}
  anyChar :: ReaderT e m Char
anyChar = m Char -> ReaderT e m Char
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
External instance of the constraint type forall (m :: * -> *). MonadPlus m => Monad m
Evidence bound by a type signature of the constraint type MonadPlus m
External instance of the constraint type forall r. MonadTrans (ReaderT r)
lift m Char
forall (m :: * -> *). CharParsing m => m Char
Evidence bound by a type signature of the constraint type CharParsing m
anyChar
  {-# INLINE anyChar #-}
  string :: [Char] -> ReaderT e m [Char]
string  = m [Char] -> ReaderT e m [Char]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
External instance of the constraint type forall (m :: * -> *). MonadPlus m => Monad m
Evidence bound by a type signature of the constraint type MonadPlus m
External instance of the constraint type forall r. MonadTrans (ReaderT r)
lift (m [Char] -> ReaderT e m [Char])
-> ([Char] -> m [Char]) -> [Char] -> ReaderT e m [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> m [Char]
forall (m :: * -> *). CharParsing m => [Char] -> m [Char]
Evidence bound by a type signature of the constraint type CharParsing m
string
  {-# INLINE string #-}
  text :: Text -> ReaderT e m Text
text = m Text -> ReaderT e m Text
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
External instance of the constraint type forall (m :: * -> *). MonadPlus m => Monad m
Evidence bound by a type signature of the constraint type MonadPlus m
External instance of the constraint type forall r. MonadTrans (ReaderT r)
lift (m Text -> ReaderT e m Text)
-> (Text -> m Text) -> Text -> ReaderT e m Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> m Text
forall (m :: * -> *). CharParsing m => Text -> m Text
Evidence bound by a type signature of the constraint type CharParsing m
text
  {-# INLINE text #-}

instance (CharParsing m, MonadPlus m, Monoid w) => CharParsing (Strict.WriterT w m) where
  satisfy :: (Char -> Bool) -> WriterT w m Char
satisfy = m Char -> WriterT w m Char
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
External instance of the constraint type forall (m :: * -> *). MonadPlus m => Monad m
Evidence bound by a type signature of the constraint type MonadPlus m
External instance of the constraint type forall w. Monoid w => MonadTrans (WriterT w)
Evidence bound by a type signature of the constraint type Monoid w
lift (m Char -> WriterT w m Char)
-> ((Char -> Bool) -> m Char) -> (Char -> Bool) -> WriterT w m Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> m Char
forall (m :: * -> *). CharParsing m => (Char -> Bool) -> m Char
Evidence bound by a type signature of the constraint type CharParsing m
satisfy
  {-# INLINE satisfy #-}
  char :: Char -> WriterT w m Char
char    = m Char -> WriterT w m Char
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
External instance of the constraint type forall (m :: * -> *). MonadPlus m => Monad m
Evidence bound by a type signature of the constraint type MonadPlus m
External instance of the constraint type forall w. Monoid w => MonadTrans (WriterT w)
Evidence bound by a type signature of the constraint type Monoid w
lift (m Char -> WriterT w m Char)
-> (Char -> m Char) -> Char -> WriterT w m Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> m Char
forall (m :: * -> *). CharParsing m => Char -> m Char
Evidence bound by a type signature of the constraint type CharParsing m
char
  {-# INLINE char #-}
  notChar :: Char -> WriterT w m Char
notChar = m Char -> WriterT w m Char
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
External instance of the constraint type forall (m :: * -> *). MonadPlus m => Monad m
Evidence bound by a type signature of the constraint type MonadPlus m
External instance of the constraint type forall w. Monoid w => MonadTrans (WriterT w)
Evidence bound by a type signature of the constraint type Monoid w
lift (m Char -> WriterT w m Char)
-> (Char -> m Char) -> Char -> WriterT w m Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> m Char
forall (m :: * -> *). CharParsing m => Char -> m Char
Evidence bound by a type signature of the constraint type CharParsing m
notChar
  {-# INLINE notChar #-}
  anyChar :: WriterT w m Char
anyChar = m Char -> WriterT w m Char
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
External instance of the constraint type forall (m :: * -> *). MonadPlus m => Monad m
Evidence bound by a type signature of the constraint type MonadPlus m
External instance of the constraint type forall w. Monoid w => MonadTrans (WriterT w)
Evidence bound by a type signature of the constraint type Monoid w
lift m Char
forall (m :: * -> *). CharParsing m => m Char
Evidence bound by a type signature of the constraint type CharParsing m
anyChar
  {-# INLINE anyChar #-}
  string :: [Char] -> WriterT w m [Char]
string  = m [Char] -> WriterT w m [Char]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
External instance of the constraint type forall (m :: * -> *). MonadPlus m => Monad m
Evidence bound by a type signature of the constraint type MonadPlus m
External instance of the constraint type forall w. Monoid w => MonadTrans (WriterT w)
Evidence bound by a type signature of the constraint type Monoid w
lift (m [Char] -> WriterT w m [Char])
-> ([Char] -> m [Char]) -> [Char] -> WriterT w m [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> m [Char]
forall (m :: * -> *). CharParsing m => [Char] -> m [Char]
Evidence bound by a type signature of the constraint type CharParsing m
string
  {-# INLINE string #-}
  text :: Text -> WriterT w m Text
text = m Text -> WriterT w m Text
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
External instance of the constraint type forall (m :: * -> *). MonadPlus m => Monad m
Evidence bound by a type signature of the constraint type MonadPlus m
External instance of the constraint type forall w. Monoid w => MonadTrans (WriterT w)
Evidence bound by a type signature of the constraint type Monoid w
lift (m Text -> WriterT w m Text)
-> (Text -> m Text) -> Text -> WriterT w m Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> m Text
forall (m :: * -> *). CharParsing m => Text -> m Text
Evidence bound by a type signature of the constraint type CharParsing m
text
  {-# INLINE text #-}

instance (CharParsing m, MonadPlus m, Monoid w) => CharParsing (Lazy.WriterT w m) where
  satisfy :: (Char -> Bool) -> WriterT w m Char
satisfy = m Char -> WriterT w m Char
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
External instance of the constraint type forall (m :: * -> *). MonadPlus m => Monad m
Evidence bound by a type signature of the constraint type MonadPlus m
External instance of the constraint type forall w. Monoid w => MonadTrans (WriterT w)
Evidence bound by a type signature of the constraint type Monoid w
lift (m Char -> WriterT w m Char)
-> ((Char -> Bool) -> m Char) -> (Char -> Bool) -> WriterT w m Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> m Char
forall (m :: * -> *). CharParsing m => (Char -> Bool) -> m Char
Evidence bound by a type signature of the constraint type CharParsing m
satisfy
  {-# INLINE satisfy #-}
  char :: Char -> WriterT w m Char
char    = m Char -> WriterT w m Char
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
External instance of the constraint type forall (m :: * -> *). MonadPlus m => Monad m
Evidence bound by a type signature of the constraint type MonadPlus m
External instance of the constraint type forall w. Monoid w => MonadTrans (WriterT w)
Evidence bound by a type signature of the constraint type Monoid w
lift (m Char -> WriterT w m Char)
-> (Char -> m Char) -> Char -> WriterT w m Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> m Char
forall (m :: * -> *). CharParsing m => Char -> m Char
Evidence bound by a type signature of the constraint type CharParsing m
char
  {-# INLINE char #-}
  notChar :: Char -> WriterT w m Char
notChar = m Char -> WriterT w m Char
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
External instance of the constraint type forall (m :: * -> *). MonadPlus m => Monad m
Evidence bound by a type signature of the constraint type MonadPlus m
External instance of the constraint type forall w. Monoid w => MonadTrans (WriterT w)
Evidence bound by a type signature of the constraint type Monoid w
lift (m Char -> WriterT w m Char)
-> (Char -> m Char) -> Char -> WriterT w m Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> m Char
forall (m :: * -> *). CharParsing m => Char -> m Char
Evidence bound by a type signature of the constraint type CharParsing m
notChar
  {-# INLINE notChar #-}
  anyChar :: WriterT w m Char
anyChar = m Char -> WriterT w m Char
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
External instance of the constraint type forall (m :: * -> *). MonadPlus m => Monad m
Evidence bound by a type signature of the constraint type MonadPlus m
External instance of the constraint type forall w. Monoid w => MonadTrans (WriterT w)
Evidence bound by a type signature of the constraint type Monoid w
lift m Char
forall (m :: * -> *). CharParsing m => m Char
Evidence bound by a type signature of the constraint type CharParsing m
anyChar
  {-# INLINE anyChar #-}
  string :: [Char] -> WriterT w m [Char]
string  = m [Char] -> WriterT w m [Char]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
External instance of the constraint type forall (m :: * -> *). MonadPlus m => Monad m
Evidence bound by a type signature of the constraint type MonadPlus m
External instance of the constraint type forall w. Monoid w => MonadTrans (WriterT w)
Evidence bound by a type signature of the constraint type Monoid w
lift (m [Char] -> WriterT w m [Char])
-> ([Char] -> m [Char]) -> [Char] -> WriterT w m [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> m [Char]
forall (m :: * -> *). CharParsing m => [Char] -> m [Char]
Evidence bound by a type signature of the constraint type CharParsing m
string
  {-# INLINE string #-}
  text :: Text -> WriterT w m Text
text = m Text -> WriterT w m Text
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
External instance of the constraint type forall (m :: * -> *). MonadPlus m => Monad m
Evidence bound by a type signature of the constraint type MonadPlus m
External instance of the constraint type forall w. Monoid w => MonadTrans (WriterT w)
Evidence bound by a type signature of the constraint type Monoid w
lift (m Text -> WriterT w m Text)
-> (Text -> m Text) -> Text -> WriterT w m Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> m Text
forall (m :: * -> *). CharParsing m => Text -> m Text
Evidence bound by a type signature of the constraint type CharParsing m
text
  {-# INLINE text #-}

instance (CharParsing m, MonadPlus m, Monoid w) => CharParsing (Lazy.RWST r w s m) where
  satisfy :: (Char -> Bool) -> RWST r w s m Char
satisfy = m Char -> RWST r w s m Char
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
External instance of the constraint type forall (m :: * -> *). MonadPlus m => Monad m
Evidence bound by a type signature of the constraint type MonadPlus m
External instance of the constraint type forall w r s. Monoid w => MonadTrans (RWST r w s)
Evidence bound by a type signature of the constraint type Monoid w
lift (m Char -> RWST r w s m Char)
-> ((Char -> Bool) -> m Char)
-> (Char -> Bool)
-> RWST r w s m Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> m Char
forall (m :: * -> *). CharParsing m => (Char -> Bool) -> m Char
Evidence bound by a type signature of the constraint type CharParsing m
satisfy
  {-# INLINE satisfy #-}
  char :: Char -> RWST r w s m Char
char    = m Char -> RWST r w s m Char
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
External instance of the constraint type forall (m :: * -> *). MonadPlus m => Monad m
Evidence bound by a type signature of the constraint type MonadPlus m
External instance of the constraint type forall w r s. Monoid w => MonadTrans (RWST r w s)
Evidence bound by a type signature of the constraint type Monoid w
lift (m Char -> RWST r w s m Char)
-> (Char -> m Char) -> Char -> RWST r w s m Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> m Char
forall (m :: * -> *). CharParsing m => Char -> m Char
Evidence bound by a type signature of the constraint type CharParsing m
char
  {-# INLINE char #-}
  notChar :: Char -> RWST r w s m Char
notChar = m Char -> RWST r w s m Char
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
External instance of the constraint type forall (m :: * -> *). MonadPlus m => Monad m
Evidence bound by a type signature of the constraint type MonadPlus m
External instance of the constraint type forall w r s. Monoid w => MonadTrans (RWST r w s)
Evidence bound by a type signature of the constraint type Monoid w
lift (m Char -> RWST r w s m Char)
-> (Char -> m Char) -> Char -> RWST r w s m Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> m Char
forall (m :: * -> *). CharParsing m => Char -> m Char
Evidence bound by a type signature of the constraint type CharParsing m
notChar
  {-# INLINE notChar #-}
  anyChar :: RWST r w s m Char
anyChar = m Char -> RWST r w s m Char
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
External instance of the constraint type forall (m :: * -> *). MonadPlus m => Monad m
Evidence bound by a type signature of the constraint type MonadPlus m
External instance of the constraint type forall w r s. Monoid w => MonadTrans (RWST r w s)
Evidence bound by a type signature of the constraint type Monoid w
lift m Char
forall (m :: * -> *). CharParsing m => m Char
Evidence bound by a type signature of the constraint type CharParsing m
anyChar
  {-# INLINE anyChar #-}
  string :: [Char] -> RWST r w s m [Char]
string  = m [Char] -> RWST r w s m [Char]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
External instance of the constraint type forall (m :: * -> *). MonadPlus m => Monad m
Evidence bound by a type signature of the constraint type MonadPlus m
External instance of the constraint type forall w r s. Monoid w => MonadTrans (RWST r w s)
Evidence bound by a type signature of the constraint type Monoid w
lift (m [Char] -> RWST r w s m [Char])
-> ([Char] -> m [Char]) -> [Char] -> RWST r w s m [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> m [Char]
forall (m :: * -> *). CharParsing m => [Char] -> m [Char]
Evidence bound by a type signature of the constraint type CharParsing m
string
  {-# INLINE string #-}
  text :: Text -> RWST r w s m Text
text = m Text -> RWST r w s m Text
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
External instance of the constraint type forall (m :: * -> *). MonadPlus m => Monad m
Evidence bound by a type signature of the constraint type MonadPlus m
External instance of the constraint type forall w r s. Monoid w => MonadTrans (RWST r w s)
Evidence bound by a type signature of the constraint type Monoid w
lift (m Text -> RWST r w s m Text)
-> (Text -> m Text) -> Text -> RWST r w s m Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> m Text
forall (m :: * -> *). CharParsing m => Text -> m Text
Evidence bound by a type signature of the constraint type CharParsing m
text
  {-# INLINE text #-}

instance (CharParsing m, MonadPlus m, Monoid w) => CharParsing (Strict.RWST r w s m) where
  satisfy :: (Char -> Bool) -> RWST r w s m Char
satisfy = m Char -> RWST r w s m Char
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
External instance of the constraint type forall (m :: * -> *). MonadPlus m => Monad m
Evidence bound by a type signature of the constraint type MonadPlus m
External instance of the constraint type forall w r s. Monoid w => MonadTrans (RWST r w s)
Evidence bound by a type signature of the constraint type Monoid w
lift (m Char -> RWST r w s m Char)
-> ((Char -> Bool) -> m Char)
-> (Char -> Bool)
-> RWST r w s m Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> m Char
forall (m :: * -> *). CharParsing m => (Char -> Bool) -> m Char
Evidence bound by a type signature of the constraint type CharParsing m
satisfy
  {-# INLINE satisfy #-}
  char :: Char -> RWST r w s m Char
char    = m Char -> RWST r w s m Char
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
External instance of the constraint type forall (m :: * -> *). MonadPlus m => Monad m
Evidence bound by a type signature of the constraint type MonadPlus m
External instance of the constraint type forall w r s. Monoid w => MonadTrans (RWST r w s)
Evidence bound by a type signature of the constraint type Monoid w
lift (m Char -> RWST r w s m Char)
-> (Char -> m Char) -> Char -> RWST r w s m Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> m Char
forall (m :: * -> *). CharParsing m => Char -> m Char
Evidence bound by a type signature of the constraint type CharParsing m
char
  {-# INLINE char #-}
  notChar :: Char -> RWST r w s m Char
notChar = m Char -> RWST r w s m Char
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
External instance of the constraint type forall (m :: * -> *). MonadPlus m => Monad m
Evidence bound by a type signature of the constraint type MonadPlus m
External instance of the constraint type forall w r s. Monoid w => MonadTrans (RWST r w s)
Evidence bound by a type signature of the constraint type Monoid w
lift (m Char -> RWST r w s m Char)
-> (Char -> m Char) -> Char -> RWST r w s m Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> m Char
forall (m :: * -> *). CharParsing m => Char -> m Char
Evidence bound by a type signature of the constraint type CharParsing m
notChar
  {-# INLINE notChar #-}
  anyChar :: RWST r w s m Char
anyChar = m Char -> RWST r w s m Char
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
External instance of the constraint type forall (m :: * -> *). MonadPlus m => Monad m
Evidence bound by a type signature of the constraint type MonadPlus m
External instance of the constraint type forall w r s. Monoid w => MonadTrans (RWST r w s)
Evidence bound by a type signature of the constraint type Monoid w
lift m Char
forall (m :: * -> *). CharParsing m => m Char
Evidence bound by a type signature of the constraint type CharParsing m
anyChar
  {-# INLINE anyChar #-}
  string :: [Char] -> RWST r w s m [Char]
string  = m [Char] -> RWST r w s m [Char]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
External instance of the constraint type forall (m :: * -> *). MonadPlus m => Monad m
Evidence bound by a type signature of the constraint type MonadPlus m
External instance of the constraint type forall w r s. Monoid w => MonadTrans (RWST r w s)
Evidence bound by a type signature of the constraint type Monoid w
lift (m [Char] -> RWST r w s m [Char])
-> ([Char] -> m [Char]) -> [Char] -> RWST r w s m [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> m [Char]
forall (m :: * -> *). CharParsing m => [Char] -> m [Char]
Evidence bound by a type signature of the constraint type CharParsing m
string
  {-# INLINE string #-}
  text :: Text -> RWST r w s m Text
text = m Text -> RWST r w s m Text
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
External instance of the constraint type forall (m :: * -> *). MonadPlus m => Monad m
Evidence bound by a type signature of the constraint type MonadPlus m
External instance of the constraint type forall w r s. Monoid w => MonadTrans (RWST r w s)
Evidence bound by a type signature of the constraint type Monoid w
lift (m Text -> RWST r w s m Text)
-> (Text -> m Text) -> Text -> RWST r w s m Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> m Text
forall (m :: * -> *). CharParsing m => Text -> m Text
Evidence bound by a type signature of the constraint type CharParsing m
text
  {-# INLINE text #-}

instance (CharParsing m, MonadPlus m) => CharParsing (IdentityT m) where
  satisfy :: (Char -> Bool) -> IdentityT m Char
satisfy = m Char -> IdentityT m Char
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
External instance of the constraint type forall (m :: * -> *). MonadPlus m => Monad m
Evidence bound by a type signature of the constraint type MonadPlus m
External instance of the constraint type MonadTrans IdentityT
lift (m Char -> IdentityT m Char)
-> ((Char -> Bool) -> m Char) -> (Char -> Bool) -> IdentityT m Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> m Char
forall (m :: * -> *). CharParsing m => (Char -> Bool) -> m Char
Evidence bound by a type signature of the constraint type CharParsing m
satisfy
  {-# INLINE satisfy #-}
  char :: Char -> IdentityT m Char
char    = m Char -> IdentityT m Char
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
External instance of the constraint type forall (m :: * -> *). MonadPlus m => Monad m
Evidence bound by a type signature of the constraint type MonadPlus m
External instance of the constraint type MonadTrans IdentityT
lift (m Char -> IdentityT m Char)
-> (Char -> m Char) -> Char -> IdentityT m Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> m Char
forall (m :: * -> *). CharParsing m => Char -> m Char
Evidence bound by a type signature of the constraint type CharParsing m
char
  {-# INLINE char #-}
  notChar :: Char -> IdentityT m Char
notChar = m Char -> IdentityT m Char
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
External instance of the constraint type forall (m :: * -> *). MonadPlus m => Monad m
Evidence bound by a type signature of the constraint type MonadPlus m
External instance of the constraint type MonadTrans IdentityT
lift (m Char -> IdentityT m Char)
-> (Char -> m Char) -> Char -> IdentityT m Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> m Char
forall (m :: * -> *). CharParsing m => Char -> m Char
Evidence bound by a type signature of the constraint type CharParsing m
notChar
  {-# INLINE notChar #-}
  anyChar :: IdentityT m Char
anyChar = m Char -> IdentityT m Char
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
External instance of the constraint type forall (m :: * -> *). MonadPlus m => Monad m
Evidence bound by a type signature of the constraint type MonadPlus m
External instance of the constraint type MonadTrans IdentityT
lift m Char
forall (m :: * -> *). CharParsing m => m Char
Evidence bound by a type signature of the constraint type CharParsing m
anyChar
  {-# INLINE anyChar #-}
  string :: [Char] -> IdentityT m [Char]
string  = m [Char] -> IdentityT m [Char]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
External instance of the constraint type forall (m :: * -> *). MonadPlus m => Monad m
Evidence bound by a type signature of the constraint type MonadPlus m
External instance of the constraint type MonadTrans IdentityT
lift (m [Char] -> IdentityT m [Char])
-> ([Char] -> m [Char]) -> [Char] -> IdentityT m [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> m [Char]
forall (m :: * -> *). CharParsing m => [Char] -> m [Char]
Evidence bound by a type signature of the constraint type CharParsing m
string
  {-# INLINE string #-}
  text :: Text -> IdentityT m Text
text = m Text -> IdentityT m Text
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
External instance of the constraint type forall (m :: * -> *). MonadPlus m => Monad m
Evidence bound by a type signature of the constraint type MonadPlus m
External instance of the constraint type MonadTrans IdentityT
lift (m Text -> IdentityT m Text)
-> (Text -> m Text) -> Text -> IdentityT m Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> m Text
forall (m :: * -> *). CharParsing m => Text -> m Text
Evidence bound by a type signature of the constraint type CharParsing m
text
  {-# INLINE text #-}

instance Parsec.Stream s m Char => CharParsing (Parsec.ParsecT s u m) where
  satisfy :: (Char -> Bool) -> ParsecT s u m Char
satisfy   = (Char -> Bool) -> ParsecT s u m Char
forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
Evidence bound by a type signature of the constraint type Stream s m Char
Parsec.satisfy
  char :: Char -> ParsecT s u m Char
char      = Char -> ParsecT s u m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
Evidence bound by a type signature of the constraint type Stream s m Char
Parsec.char
  notChar :: Char -> ParsecT s u m Char
notChar Char
c = (Char -> Bool) -> ParsecT s u m Char
forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
Evidence bound by a type signature of the constraint type Stream s m Char
Parsec.satisfy (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
External instance of the constraint type Eq Char
/= Char
c)
  anyChar :: ParsecT s u m Char
anyChar   = ParsecT s u m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
Evidence bound by a type signature of the constraint type Stream s m Char
Parsec.anyChar
  string :: [Char] -> ParsecT s u m [Char]
string    = [Char] -> ParsecT s u m [Char]
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
Evidence bound by a type signature of the constraint type Stream s m Char
Parsec.string

-------------------------------------------------------------------------------
-- Our additions
-------------------------------------------------------------------------------

integral :: (CharParsing m, Integral a) => m a
integral :: m a
integral = [a] -> a
toNumber ([a] -> a) -> m [a] -> m a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
External instance of the constraint type forall (f :: * -> *). Applicative f => Functor f
External instance of the constraint type forall (f :: * -> *). Alternative f => Applicative f
External instance of the constraint type forall (m :: * -> *). Parsing m => Alternative m
Evidence bound by a superclass of: CharParsing of the constraint type forall (m :: * -> *). CharParsing m => Parsing m
Evidence bound by a type signature of the constraint type CharParsing m
<$> m a -> m [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
External instance of the constraint type forall (m :: * -> *). Parsing m => Alternative m
Evidence bound by a superclass of: CharParsing of the constraint type forall (m :: * -> *). CharParsing m => Parsing m
Evidence bound by a type signature of the constraint type CharParsing m
some m a
d m a -> [Char] -> m a
forall (m :: * -> *) a. Parsing m => m a -> [Char] -> m a
Evidence bound by a superclass of: CharParsing of the constraint type forall (m :: * -> *). CharParsing m => Parsing m
Evidence bound by a type signature of the constraint type CharParsing m
<?> [Char]
"integral"
  where
    toNumber :: [a] -> a
toNumber = (a -> a -> a) -> a -> [a] -> a
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
External instance of the constraint type Foldable []
foldl' (\a
a a
b -> a
a a -> a -> a
forall a. Num a => a -> a -> a
External instance of the constraint type forall a. Real a => Num a
External instance of the constraint type forall a. Integral a => Real a
Evidence bound by a type signature of the constraint type Integral a
* a
10 a -> a -> a
forall a. Num a => a -> a -> a
External instance of the constraint type forall a. Real a => Num a
External instance of the constraint type forall a. Integral a => Real a
Evidence bound by a type signature of the constraint type Integral a
+ a
b) a
0
    d :: m a
d = Char -> a
forall {p}. Num p => Char -> p
External instance of the constraint type forall a. Real a => Num a
External instance of the constraint type forall a. Integral a => Real a
Evidence bound by a type signature of the constraint type Integral a
f (Char -> a) -> m Char -> m a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
External instance of the constraint type forall (f :: * -> *). Applicative f => Functor f
External instance of the constraint type forall (f :: * -> *). Alternative f => Applicative f
External instance of the constraint type forall (m :: * -> *). Parsing m => Alternative m
Evidence bound by a superclass of: CharParsing of the constraint type forall (m :: * -> *). CharParsing m => Parsing m
Evidence bound by a type signature of the constraint type CharParsing m
<$> Char -> Char -> m Char
forall (m :: * -> *). CharParsing m => Char -> Char -> m Char
Evidence bound by a type signature of the constraint type CharParsing m
satisfyRange Char
'0' Char
'9'
    f :: Char -> p
f Char
'0' = p
0
    f Char
'1' = p
1
    f Char
'2' = p
2
    f Char
'3' = p
3
    f Char
'4' = p
4
    f Char
'5' = p
5
    f Char
'6' = p
6
    f Char
'7' = p
7
    f Char
'8' = p
8
    f Char
'9' = p
9
    f Char
_   = [Char] -> p
forall a. HasCallStack => [Char] -> a
error [Char]
"panic! integral"
{-# INLINE integral #-}

-- | Greedily munch characters while predicate holds.
-- Require at least one character.
munch1 :: CharParsing m => (Char -> Bool) -> m String
munch1 :: (Char -> Bool) -> m [Char]
munch1 = m Char -> m [Char]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
External instance of the constraint type forall (m :: * -> *). Parsing m => Alternative m
Evidence bound by a superclass of: CharParsing of the constraint type forall (m :: * -> *). CharParsing m => Parsing m
Evidence bound by a type signature of the constraint type CharParsing m
some (m Char -> m [Char])
-> ((Char -> Bool) -> m Char) -> (Char -> Bool) -> m [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> m Char
forall (m :: * -> *). CharParsing m => (Char -> Bool) -> m Char
Evidence bound by a type signature of the constraint type CharParsing m
satisfy
{-# INLINE munch1 #-}

-- | Greedely munch characters while predicate holds.
-- Always succeeds.
munch :: CharParsing m => (Char -> Bool) -> m String
munch :: (Char -> Bool) -> m [Char]
munch = m Char -> m [Char]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
External instance of the constraint type forall (m :: * -> *). Parsing m => Alternative m
Evidence bound by a superclass of: CharParsing of the constraint type forall (m :: * -> *). CharParsing m => Parsing m
Evidence bound by a type signature of the constraint type CharParsing m
many (m Char -> m [Char])
-> ((Char -> Bool) -> m Char) -> (Char -> Bool) -> m [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> m Char
forall (m :: * -> *). CharParsing m => (Char -> Bool) -> m Char
Evidence bound by a type signature of the constraint type CharParsing m
satisfy
{-# INLINE munch #-}

skipSpaces1 :: CharParsing m => m ()
skipSpaces1 :: m ()
skipSpaces1 = m Char -> m ()
forall (m :: * -> *) a. Parsing m => m a -> m ()
Evidence bound by a superclass of: CharParsing of the constraint type forall (m :: * -> *). CharParsing m => Parsing m
Evidence bound by a type signature of the constraint type CharParsing m
skipSome m Char
forall (m :: * -> *). CharParsing m => m Char
Evidence bound by a type signature of the constraint type CharParsing m
space
{-# INLINE skipSpaces1 #-}