{-# LANGUAGE GeneralizedNewtypeDeriving #-}

-- | Newtype wrappers for parsers

module Text.Parser.Wrapper where

import Control.Applicative (Applicative, Alternative)
import Control.Monad (MonadPlus)
import Text.Parser.Combinators (Parsing)
import Text.Parser.LookAhead (LookAheadParsing)
import Text.Parser.Char (CharParsing)
import Text.Parser.Token (TokenParsing)

-- | Wrapper that signifies lazy 'Data.ByteString.Lazy.ByteString' inputs
newtype Lazy   f a = Lazy{Lazy f a -> f a
getLazy :: f a} deriving (Lazy f a -> Lazy f a -> Bool
(Lazy f a -> Lazy f a -> Bool)
-> (Lazy f a -> Lazy f a -> Bool) -> Eq (Lazy f a)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (f :: * -> *) a. Eq (f a) => Lazy f a -> Lazy f a -> Bool
/= :: Lazy f a -> Lazy f a -> Bool
$c/= :: forall (f :: * -> *) a. Eq (f a) => Lazy f a -> Lazy f a -> Bool
== :: Lazy f a -> Lazy f a -> Bool
$c== :: forall (f :: * -> *) a. Eq (f a) => Lazy f a -> Lazy f a -> Bool
Eq, Eq (Lazy f a)
Eq (Lazy f a)
-> (Lazy f a -> Lazy f a -> Ordering)
-> (Lazy f a -> Lazy f a -> Bool)
-> (Lazy f a -> Lazy f a -> Bool)
-> (Lazy f a -> Lazy f a -> Bool)
-> (Lazy f a -> Lazy f a -> Bool)
-> (Lazy f a -> Lazy f a -> Lazy f a)
-> (Lazy f a -> Lazy f a -> Lazy f a)
-> Ord (Lazy f a)
Lazy f a -> Lazy f a -> Bool
Lazy f a -> Lazy f a -> Ordering
Lazy f a -> Lazy f a -> Lazy f a
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall (f :: * -> *) a. Ord (f a) => Eq (Lazy f a)
forall (f :: * -> *) a. Ord (f a) => Lazy f a -> Lazy f a -> Bool
forall (f :: * -> *) a.
Ord (f a) =>
Lazy f a -> Lazy f a -> Ordering
forall (f :: * -> *) a.
Ord (f a) =>
Lazy f a -> Lazy f a -> Lazy f a
min :: Lazy f a -> Lazy f a -> Lazy f a
$cmin :: forall (f :: * -> *) a.
Ord (f a) =>
Lazy f a -> Lazy f a -> Lazy f a
max :: Lazy f a -> Lazy f a -> Lazy f a
$cmax :: forall (f :: * -> *) a.
Ord (f a) =>
Lazy f a -> Lazy f a -> Lazy f a
>= :: Lazy f a -> Lazy f a -> Bool
$c>= :: forall (f :: * -> *) a. Ord (f a) => Lazy f a -> Lazy f a -> Bool
> :: Lazy f a -> Lazy f a -> Bool
$c> :: forall (f :: * -> *) a. Ord (f a) => Lazy f a -> Lazy f a -> Bool
<= :: Lazy f a -> Lazy f a -> Bool
$c<= :: forall (f :: * -> *) a. Ord (f a) => Lazy f a -> Lazy f a -> Bool
< :: Lazy f a -> Lazy f a -> Bool
$c< :: forall (f :: * -> *) a. Ord (f a) => Lazy f a -> Lazy f a -> Bool
compare :: Lazy f a -> Lazy f a -> Ordering
$ccompare :: forall (f :: * -> *) a.
Ord (f a) =>
Lazy f a -> Lazy f a -> Ordering
$cp1Ord :: forall (f :: * -> *) a. Ord (f a) => Eq (Lazy f a)
Ord, ReadPrec [Lazy f a]
ReadPrec (Lazy f a)
Int -> ReadS (Lazy f a)
ReadS [Lazy f a]
(Int -> ReadS (Lazy f a))
-> ReadS [Lazy f a]
-> ReadPrec (Lazy f a)
-> ReadPrec [Lazy f a]
-> Read (Lazy f a)
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
forall (f :: * -> *) a. Read (f a) => ReadPrec [Lazy f a]
forall (f :: * -> *) a. Read (f a) => ReadPrec (Lazy f a)
forall (f :: * -> *) a. Read (f a) => Int -> ReadS (Lazy f a)
forall (f :: * -> *) a. Read (f a) => ReadS [Lazy f a]
readListPrec :: ReadPrec [Lazy f a]
$creadListPrec :: forall (f :: * -> *) a. Read (f a) => ReadPrec [Lazy f a]
readPrec :: ReadPrec (Lazy f a)
$creadPrec :: forall (f :: * -> *) a. Read (f a) => ReadPrec (Lazy f a)
readList :: ReadS [Lazy f a]
$creadList :: forall (f :: * -> *) a. Read (f a) => ReadS [Lazy f a]
readsPrec :: Int -> ReadS (Lazy f a)
$creadsPrec :: forall (f :: * -> *) a. Read (f a) => Int -> ReadS (Lazy f a)
Read, Int -> Lazy f a -> ShowS
[Lazy f a] -> ShowS
Lazy f a -> String
(Int -> Lazy f a -> ShowS)
-> (Lazy f a -> String) -> ([Lazy f a] -> ShowS) -> Show (Lazy f a)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (f :: * -> *) a. Show (f a) => Int -> Lazy f a -> ShowS
forall (f :: * -> *) a. Show (f a) => [Lazy f a] -> ShowS
forall (f :: * -> *) a. Show (f a) => Lazy f a -> String
showList :: [Lazy f a] -> ShowS
$cshowList :: forall (f :: * -> *) a. Show (f a) => [Lazy f a] -> ShowS
show :: Lazy f a -> String
$cshow :: forall (f :: * -> *) a. Show (f a) => Lazy f a -> String
showsPrec :: Int -> Lazy f a -> ShowS
$cshowsPrec :: forall (f :: * -> *) a. Show (f a) => Int -> Lazy f a -> ShowS
Show,
                                                    a -> Lazy f b -> Lazy f a
(a -> b) -> Lazy f a -> Lazy f b
(forall a b. (a -> b) -> Lazy f a -> Lazy f b)
-> (forall a b. a -> Lazy f b -> Lazy f a) -> Functor (Lazy f)
forall a b. a -> Lazy f b -> Lazy f a
forall a b. (a -> b) -> Lazy f a -> Lazy f b
forall (f :: * -> *) a b. Functor f => a -> Lazy f b -> Lazy f a
forall (f :: * -> *) a b.
Functor f =>
(a -> b) -> Lazy f a -> Lazy f b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Lazy f b -> Lazy f a
$c<$ :: forall (f :: * -> *) a b. Functor f => a -> Lazy f b -> Lazy f a
fmap :: (a -> b) -> Lazy f a -> Lazy f b
$cfmap :: forall (f :: * -> *) a b.
Functor f =>
(a -> b) -> Lazy f a -> Lazy f b
Functor, Functor (Lazy f)
a -> Lazy f a
Functor (Lazy f)
-> (forall a. a -> Lazy f a)
-> (forall a b. Lazy f (a -> b) -> Lazy f a -> Lazy f b)
-> (forall a b c.
    (a -> b -> c) -> Lazy f a -> Lazy f b -> Lazy f c)
-> (forall a b. Lazy f a -> Lazy f b -> Lazy f b)
-> (forall a b. Lazy f a -> Lazy f b -> Lazy f a)
-> Applicative (Lazy f)
Lazy f a -> Lazy f b -> Lazy f b
Lazy f a -> Lazy f b -> Lazy f a
Lazy f (a -> b) -> Lazy f a -> Lazy f b
(a -> b -> c) -> Lazy f a -> Lazy f b -> Lazy f c
forall a. a -> Lazy f a
forall a b. Lazy f a -> Lazy f b -> Lazy f a
forall a b. Lazy f a -> Lazy f b -> Lazy f b
forall a b. Lazy f (a -> b) -> Lazy f a -> Lazy f b
forall a b c. (a -> b -> c) -> Lazy f a -> Lazy f b -> Lazy f c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
forall (f :: * -> *). Applicative f => Functor (Lazy f)
forall (f :: * -> *) a. Applicative f => a -> Lazy f a
forall (f :: * -> *) a b.
Applicative f =>
Lazy f a -> Lazy f b -> Lazy f a
forall (f :: * -> *) a b.
Applicative f =>
Lazy f a -> Lazy f b -> Lazy f b
forall (f :: * -> *) a b.
Applicative f =>
Lazy f (a -> b) -> Lazy f a -> Lazy f b
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> Lazy f a -> Lazy f b -> Lazy f c
<* :: Lazy f a -> Lazy f b -> Lazy f a
$c<* :: forall (f :: * -> *) a b.
Applicative f =>
Lazy f a -> Lazy f b -> Lazy f a
*> :: Lazy f a -> Lazy f b -> Lazy f b
$c*> :: forall (f :: * -> *) a b.
Applicative f =>
Lazy f a -> Lazy f b -> Lazy f b
liftA2 :: (a -> b -> c) -> Lazy f a -> Lazy f b -> Lazy f c
$cliftA2 :: forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> Lazy f a -> Lazy f b -> Lazy f c
<*> :: Lazy f (a -> b) -> Lazy f a -> Lazy f b
$c<*> :: forall (f :: * -> *) a b.
Applicative f =>
Lazy f (a -> b) -> Lazy f a -> Lazy f b
pure :: a -> Lazy f a
$cpure :: forall (f :: * -> *) a. Applicative f => a -> Lazy f a
$cp1Applicative :: forall (f :: * -> *). Applicative f => Functor (Lazy f)
Applicative, Applicative (Lazy f)
Lazy f a
Applicative (Lazy f)
-> (forall a. Lazy f a)
-> (forall a. Lazy f a -> Lazy f a -> Lazy f a)
-> (forall a. Lazy f a -> Lazy f [a])
-> (forall a. Lazy f a -> Lazy f [a])
-> Alternative (Lazy f)
Lazy f a -> Lazy f a -> Lazy f a
Lazy f a -> Lazy f [a]
Lazy f a -> Lazy f [a]
forall a. Lazy f a
forall a. Lazy f a -> Lazy f [a]
forall a. Lazy f a -> Lazy f a -> Lazy f a
forall (f :: * -> *).
Applicative f
-> (forall a. f a)
-> (forall a. f a -> f a -> f a)
-> (forall a. f a -> f [a])
-> (forall a. f a -> f [a])
-> Alternative f
forall (f :: * -> *). Alternative f => Applicative (Lazy f)
forall (f :: * -> *) a. Alternative f => Lazy f a
forall (f :: * -> *) a. Alternative f => Lazy f a -> Lazy f [a]
forall (f :: * -> *) a.
Alternative f =>
Lazy f a -> Lazy f a -> Lazy f a
many :: Lazy f a -> Lazy f [a]
$cmany :: forall (f :: * -> *) a. Alternative f => Lazy f a -> Lazy f [a]
some :: Lazy f a -> Lazy f [a]
$csome :: forall (f :: * -> *) a. Alternative f => Lazy f a -> Lazy f [a]
<|> :: Lazy f a -> Lazy f a -> Lazy f a
$c<|> :: forall (f :: * -> *) a.
Alternative f =>
Lazy f a -> Lazy f a -> Lazy f a
empty :: Lazy f a
$cempty :: forall (f :: * -> *) a. Alternative f => Lazy f a
$cp1Alternative :: forall (f :: * -> *). Alternative f => Applicative (Lazy f)
Alternative,
                                                    Applicative (Lazy f)
a -> Lazy f a
Applicative (Lazy f)
-> (forall a b. Lazy f a -> (a -> Lazy f b) -> Lazy f b)
-> (forall a b. Lazy f a -> Lazy f b -> Lazy f b)
-> (forall a. a -> Lazy f a)
-> Monad (Lazy f)
Lazy f a -> (a -> Lazy f b) -> Lazy f b
Lazy f a -> Lazy f b -> Lazy f b
forall a. a -> Lazy f a
forall a b. Lazy f a -> Lazy f b -> Lazy f b
forall a b. Lazy f a -> (a -> Lazy f b) -> Lazy f b
forall (f :: * -> *). Monad f => Applicative (Lazy f)
forall (f :: * -> *) a. Monad f => a -> Lazy f a
forall (f :: * -> *) a b.
Monad f =>
Lazy f a -> Lazy f b -> Lazy f b
forall (f :: * -> *) a b.
Monad f =>
Lazy f a -> (a -> Lazy f b) -> Lazy f b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: a -> Lazy f a
$creturn :: forall (f :: * -> *) a. Monad f => a -> Lazy f a
>> :: Lazy f a -> Lazy f b -> Lazy f b
$c>> :: forall (f :: * -> *) a b.
Monad f =>
Lazy f a -> Lazy f b -> Lazy f b
>>= :: Lazy f a -> (a -> Lazy f b) -> Lazy f b
$c>>= :: forall (f :: * -> *) a b.
Monad f =>
Lazy f a -> (a -> Lazy f b) -> Lazy f b
$cp1Monad :: forall (f :: * -> *). Monad f => Applicative (Lazy f)
Monad, Monad (Lazy f)
Alternative (Lazy f)
Lazy f a
Alternative (Lazy f)
-> Monad (Lazy f)
-> (forall a. Lazy f a)
-> (forall a. Lazy f a -> Lazy f a -> Lazy f a)
-> MonadPlus (Lazy f)
Lazy f a -> Lazy f a -> Lazy f a
forall a. Lazy f a
forall a. Lazy f a -> Lazy f a -> Lazy f a
forall (m :: * -> *).
Alternative m
-> Monad m
-> (forall a. m a)
-> (forall a. m a -> m a -> m a)
-> MonadPlus m
forall (f :: * -> *). MonadPlus f => Monad (Lazy f)
forall (f :: * -> *). MonadPlus f => Alternative (Lazy f)
forall (f :: * -> *) a. MonadPlus f => Lazy f a
forall (f :: * -> *) a.
MonadPlus f =>
Lazy f a -> Lazy f a -> Lazy f a
mplus :: Lazy f a -> Lazy f a -> Lazy f a
$cmplus :: forall (f :: * -> *) a.
MonadPlus f =>
Lazy f a -> Lazy f a -> Lazy f a
mzero :: Lazy f a
$cmzero :: forall (f :: * -> *) a. MonadPlus f => Lazy f a
$cp2MonadPlus :: forall (f :: * -> *). MonadPlus f => Monad (Lazy f)
$cp1MonadPlus :: forall (f :: * -> *). MonadPlus f => Alternative (Lazy f)
MonadPlus,
                                                    Alternative (Lazy f)
Lazy f ()
String -> Lazy f a
Alternative (Lazy f)
-> (forall a. Lazy f a -> Lazy f a)
-> (forall a. Lazy f a -> String -> Lazy f a)
-> (forall a. Lazy f a -> Lazy f ())
-> (forall a. Lazy f a -> Lazy f ())
-> (forall a. String -> Lazy f a)
-> Lazy f ()
-> (forall a. Show a => Lazy f a -> Lazy f ())
-> Parsing (Lazy f)
Lazy f a -> Lazy f a
Lazy f a -> String -> Lazy f a
Lazy f a -> Lazy f ()
Lazy f a -> Lazy f ()
Lazy f a -> Lazy f ()
forall a. Show a => Lazy f a -> Lazy f ()
forall a. String -> Lazy f a
forall a. Lazy f a -> Lazy f a
forall a. Lazy f a -> Lazy f ()
forall a. Lazy f a -> String -> Lazy f a
forall (m :: * -> *).
Alternative m
-> (forall a. m a -> m a)
-> (forall a. m a -> String -> m a)
-> (forall a. m a -> m ())
-> (forall a. m a -> m ())
-> (forall a. String -> m a)
-> m ()
-> (forall a. Show a => m a -> m ())
-> Parsing m
forall (f :: * -> *). Parsing f => Alternative (Lazy f)
forall (f :: * -> *). Parsing f => Lazy f ()
forall (f :: * -> *) a.
(Parsing f, Show a) =>
Lazy f a -> Lazy f ()
forall (f :: * -> *) a. Parsing f => String -> Lazy f a
forall (f :: * -> *) a. Parsing f => Lazy f a -> Lazy f a
forall (f :: * -> *) a. Parsing f => Lazy f a -> Lazy f ()
forall (f :: * -> *) a. Parsing f => Lazy f a -> String -> Lazy f a
notFollowedBy :: Lazy f a -> Lazy f ()
$cnotFollowedBy :: forall (f :: * -> *) a.
(Parsing f, Show a) =>
Lazy f a -> Lazy f ()
eof :: Lazy f ()
$ceof :: forall (f :: * -> *). Parsing f => Lazy f ()
unexpected :: String -> Lazy f a
$cunexpected :: forall (f :: * -> *) a. Parsing f => String -> Lazy f a
skipSome :: Lazy f a -> Lazy f ()
$cskipSome :: forall (f :: * -> *) a. Parsing f => Lazy f a -> Lazy f ()
skipMany :: Lazy f a -> Lazy f ()
$cskipMany :: forall (f :: * -> *) a. Parsing f => Lazy f a -> Lazy f ()
<?> :: Lazy f a -> String -> Lazy f a
$c<?> :: forall (f :: * -> *) a. Parsing f => Lazy f a -> String -> Lazy f a
try :: Lazy f a -> Lazy f a
$ctry :: forall (f :: * -> *) a. Parsing f => Lazy f a -> Lazy f a
$cp1Parsing :: forall (f :: * -> *). Parsing f => Alternative (Lazy f)
Parsing, Parsing (Lazy f)
Parsing (Lazy f)
-> (forall a. Lazy f a -> Lazy f a) -> LookAheadParsing (Lazy f)
Lazy f a -> Lazy f a
forall a. Lazy f a -> Lazy f a
forall (f :: * -> *). LookAheadParsing f => Parsing (Lazy f)
forall (f :: * -> *) a. LookAheadParsing f => Lazy f a -> Lazy f a
forall (m :: * -> *).
Parsing m -> (forall a. m a -> m a) -> LookAheadParsing m
lookAhead :: Lazy f a -> Lazy f a
$clookAhead :: forall (f :: * -> *) a. LookAheadParsing f => Lazy f a -> Lazy f a
$cp1LookAheadParsing :: forall (f :: * -> *). LookAheadParsing f => Parsing (Lazy f)
LookAheadParsing, Parsing (Lazy f)
Lazy f Char
Char -> Lazy f Char
String -> Lazy f String
Text -> Lazy f Text
Parsing (Lazy f)
-> ((Char -> Bool) -> Lazy f Char)
-> (Char -> Lazy f Char)
-> (Char -> Lazy f Char)
-> Lazy f Char
-> (String -> Lazy f String)
-> (Text -> Lazy f Text)
-> CharParsing (Lazy f)
(Char -> Bool) -> Lazy f Char
forall (f :: * -> *). CharParsing f => Parsing (Lazy f)
forall (f :: * -> *). CharParsing f => Lazy f Char
forall (f :: * -> *). CharParsing f => Char -> Lazy f Char
forall (f :: * -> *). CharParsing f => String -> Lazy f String
forall (f :: * -> *). CharParsing f => Text -> Lazy f Text
forall (f :: * -> *).
CharParsing f =>
(Char -> Bool) -> Lazy f Char
forall (m :: * -> *).
Parsing m
-> ((Char -> Bool) -> m Char)
-> (Char -> m Char)
-> (Char -> m Char)
-> m Char
-> (String -> m String)
-> (Text -> m Text)
-> CharParsing m
text :: Text -> Lazy f Text
$ctext :: forall (f :: * -> *). CharParsing f => Text -> Lazy f Text
string :: String -> Lazy f String
$cstring :: forall (f :: * -> *). CharParsing f => String -> Lazy f String
anyChar :: Lazy f Char
$canyChar :: forall (f :: * -> *). CharParsing f => Lazy f Char
notChar :: Char -> Lazy f Char
$cnotChar :: forall (f :: * -> *). CharParsing f => Char -> Lazy f Char
char :: Char -> Lazy f Char
$cchar :: forall (f :: * -> *). CharParsing f => Char -> Lazy f Char
satisfy :: (Char -> Bool) -> Lazy f Char
$csatisfy :: forall (f :: * -> *).
CharParsing f =>
(Char -> Bool) -> Lazy f Char
$cp1CharParsing :: forall (f :: * -> *). CharParsing f => Parsing (Lazy f)
CharParsing, CharParsing (Lazy f)
Lazy f Char
Lazy f ()
Highlight -> Lazy f a -> Lazy f a
CharParsing (Lazy f)
-> Lazy f ()
-> (forall a. Lazy f a -> Lazy f a)
-> Lazy f Char
-> (forall a. Highlight -> Lazy f a -> Lazy f a)
-> (forall a. Lazy f a -> Lazy f a)
-> TokenParsing (Lazy f)
Lazy f a -> Lazy f a
Lazy f a -> Lazy f a
forall a. Highlight -> Lazy f a -> Lazy f a
forall a. Lazy f a -> Lazy f a
forall (f :: * -> *). TokenParsing f => CharParsing (Lazy f)
forall (f :: * -> *). TokenParsing f => Lazy f Char
forall (f :: * -> *). TokenParsing f => Lazy f ()
forall (f :: * -> *) a.
TokenParsing f =>
Highlight -> Lazy f a -> Lazy f a
forall (f :: * -> *) a. TokenParsing f => Lazy f a -> Lazy f a
forall (m :: * -> *).
CharParsing m
-> m ()
-> (forall a. m a -> m a)
-> m Char
-> (forall a. Highlight -> m a -> m a)
-> (forall a. m a -> m a)
-> TokenParsing m
token :: Lazy f a -> Lazy f a
$ctoken :: forall (f :: * -> *) a. TokenParsing f => Lazy f a -> Lazy f a
highlight :: Highlight -> Lazy f a -> Lazy f a
$chighlight :: forall (f :: * -> *) a.
TokenParsing f =>
Highlight -> Lazy f a -> Lazy f a
semi :: Lazy f Char
$csemi :: forall (f :: * -> *). TokenParsing f => Lazy f Char
nesting :: Lazy f a -> Lazy f a
$cnesting :: forall (f :: * -> *) a. TokenParsing f => Lazy f a -> Lazy f a
someSpace :: Lazy f ()
$csomeSpace :: forall (f :: * -> *). TokenParsing f => Lazy f ()
$cp1TokenParsing :: forall (f :: * -> *). TokenParsing f => CharParsing (Lazy f)
TokenParsing)
-- | Wrapper that signifies strict 'Data.ByteString.ByteString' inputs
newtype Strict f a = Strict{Strict f a -> f a
getStrict :: f a} deriving (Strict f a -> Strict f a -> Bool
(Strict f a -> Strict f a -> Bool)
-> (Strict f a -> Strict f a -> Bool) -> Eq (Strict f a)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (f :: * -> *) a.
Eq (f a) =>
Strict f a -> Strict f a -> Bool
/= :: Strict f a -> Strict f a -> Bool
$c/= :: forall (f :: * -> *) a.
Eq (f a) =>
Strict f a -> Strict f a -> Bool
== :: Strict f a -> Strict f a -> Bool
$c== :: forall (f :: * -> *) a.
Eq (f a) =>
Strict f a -> Strict f a -> Bool
Eq, Eq (Strict f a)
Eq (Strict f a)
-> (Strict f a -> Strict f a -> Ordering)
-> (Strict f a -> Strict f a -> Bool)
-> (Strict f a -> Strict f a -> Bool)
-> (Strict f a -> Strict f a -> Bool)
-> (Strict f a -> Strict f a -> Bool)
-> (Strict f a -> Strict f a -> Strict f a)
-> (Strict f a -> Strict f a -> Strict f a)
-> Ord (Strict f a)
Strict f a -> Strict f a -> Bool
Strict f a -> Strict f a -> Ordering
Strict f a -> Strict f a -> Strict f a
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall (f :: * -> *) a. Ord (f a) => Eq (Strict f a)
forall (f :: * -> *) a.
Ord (f a) =>
Strict f a -> Strict f a -> Bool
forall (f :: * -> *) a.
Ord (f a) =>
Strict f a -> Strict f a -> Ordering
forall (f :: * -> *) a.
Ord (f a) =>
Strict f a -> Strict f a -> Strict f a
min :: Strict f a -> Strict f a -> Strict f a
$cmin :: forall (f :: * -> *) a.
Ord (f a) =>
Strict f a -> Strict f a -> Strict f a
max :: Strict f a -> Strict f a -> Strict f a
$cmax :: forall (f :: * -> *) a.
Ord (f a) =>
Strict f a -> Strict f a -> Strict f a
>= :: Strict f a -> Strict f a -> Bool
$c>= :: forall (f :: * -> *) a.
Ord (f a) =>
Strict f a -> Strict f a -> Bool
> :: Strict f a -> Strict f a -> Bool
$c> :: forall (f :: * -> *) a.
Ord (f a) =>
Strict f a -> Strict f a -> Bool
<= :: Strict f a -> Strict f a -> Bool
$c<= :: forall (f :: * -> *) a.
Ord (f a) =>
Strict f a -> Strict f a -> Bool
< :: Strict f a -> Strict f a -> Bool
$c< :: forall (f :: * -> *) a.
Ord (f a) =>
Strict f a -> Strict f a -> Bool
compare :: Strict f a -> Strict f a -> Ordering
$ccompare :: forall (f :: * -> *) a.
Ord (f a) =>
Strict f a -> Strict f a -> Ordering
$cp1Ord :: forall (f :: * -> *) a. Ord (f a) => Eq (Strict f a)
Ord, ReadPrec [Strict f a]
ReadPrec (Strict f a)
Int -> ReadS (Strict f a)
ReadS [Strict f a]
(Int -> ReadS (Strict f a))
-> ReadS [Strict f a]
-> ReadPrec (Strict f a)
-> ReadPrec [Strict f a]
-> Read (Strict f a)
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
forall (f :: * -> *) a. Read (f a) => ReadPrec [Strict f a]
forall (f :: * -> *) a. Read (f a) => ReadPrec (Strict f a)
forall (f :: * -> *) a. Read (f a) => Int -> ReadS (Strict f a)
forall (f :: * -> *) a. Read (f a) => ReadS [Strict f a]
readListPrec :: ReadPrec [Strict f a]
$creadListPrec :: forall (f :: * -> *) a. Read (f a) => ReadPrec [Strict f a]
readPrec :: ReadPrec (Strict f a)
$creadPrec :: forall (f :: * -> *) a. Read (f a) => ReadPrec (Strict f a)
readList :: ReadS [Strict f a]
$creadList :: forall (f :: * -> *) a. Read (f a) => ReadS [Strict f a]
readsPrec :: Int -> ReadS (Strict f a)
$creadsPrec :: forall (f :: * -> *) a. Read (f a) => Int -> ReadS (Strict f a)
Read, Int -> Strict f a -> ShowS
[Strict f a] -> ShowS
Strict f a -> String
(Int -> Strict f a -> ShowS)
-> (Strict f a -> String)
-> ([Strict f a] -> ShowS)
-> Show (Strict f a)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (f :: * -> *) a. Show (f a) => Int -> Strict f a -> ShowS
forall (f :: * -> *) a. Show (f a) => [Strict f a] -> ShowS
forall (f :: * -> *) a. Show (f a) => Strict f a -> String
showList :: [Strict f a] -> ShowS
$cshowList :: forall (f :: * -> *) a. Show (f a) => [Strict f a] -> ShowS
show :: Strict f a -> String
$cshow :: forall (f :: * -> *) a. Show (f a) => Strict f a -> String
showsPrec :: Int -> Strict f a -> ShowS
$cshowsPrec :: forall (f :: * -> *) a. Show (f a) => Int -> Strict f a -> ShowS
Show,
                                                        a -> Strict f b -> Strict f a
(a -> b) -> Strict f a -> Strict f b
(forall a b. (a -> b) -> Strict f a -> Strict f b)
-> (forall a b. a -> Strict f b -> Strict f a)
-> Functor (Strict f)
forall a b. a -> Strict f b -> Strict f a
forall a b. (a -> b) -> Strict f a -> Strict f b
forall (f :: * -> *) a b.
Functor f =>
a -> Strict f b -> Strict f a
forall (f :: * -> *) a b.
Functor f =>
(a -> b) -> Strict f a -> Strict f b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Strict f b -> Strict f a
$c<$ :: forall (f :: * -> *) a b.
Functor f =>
a -> Strict f b -> Strict f a
fmap :: (a -> b) -> Strict f a -> Strict f b
$cfmap :: forall (f :: * -> *) a b.
Functor f =>
(a -> b) -> Strict f a -> Strict f b
Functor, Functor (Strict f)
a -> Strict f a
Functor (Strict f)
-> (forall a. a -> Strict f a)
-> (forall a b. Strict f (a -> b) -> Strict f a -> Strict f b)
-> (forall a b c.
    (a -> b -> c) -> Strict f a -> Strict f b -> Strict f c)
-> (forall a b. Strict f a -> Strict f b -> Strict f b)
-> (forall a b. Strict f a -> Strict f b -> Strict f a)
-> Applicative (Strict f)
Strict f a -> Strict f b -> Strict f b
Strict f a -> Strict f b -> Strict f a
Strict f (a -> b) -> Strict f a -> Strict f b
(a -> b -> c) -> Strict f a -> Strict f b -> Strict f c
forall a. a -> Strict f a
forall a b. Strict f a -> Strict f b -> Strict f a
forall a b. Strict f a -> Strict f b -> Strict f b
forall a b. Strict f (a -> b) -> Strict f a -> Strict f b
forall a b c.
(a -> b -> c) -> Strict f a -> Strict f b -> Strict f c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
forall (f :: * -> *). Applicative f => Functor (Strict f)
forall (f :: * -> *) a. Applicative f => a -> Strict f a
forall (f :: * -> *) a b.
Applicative f =>
Strict f a -> Strict f b -> Strict f a
forall (f :: * -> *) a b.
Applicative f =>
Strict f a -> Strict f b -> Strict f b
forall (f :: * -> *) a b.
Applicative f =>
Strict f (a -> b) -> Strict f a -> Strict f b
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> Strict f a -> Strict f b -> Strict f c
<* :: Strict f a -> Strict f b -> Strict f a
$c<* :: forall (f :: * -> *) a b.
Applicative f =>
Strict f a -> Strict f b -> Strict f a
*> :: Strict f a -> Strict f b -> Strict f b
$c*> :: forall (f :: * -> *) a b.
Applicative f =>
Strict f a -> Strict f b -> Strict f b
liftA2 :: (a -> b -> c) -> Strict f a -> Strict f b -> Strict f c
$cliftA2 :: forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> Strict f a -> Strict f b -> Strict f c
<*> :: Strict f (a -> b) -> Strict f a -> Strict f b
$c<*> :: forall (f :: * -> *) a b.
Applicative f =>
Strict f (a -> b) -> Strict f a -> Strict f b
pure :: a -> Strict f a
$cpure :: forall (f :: * -> *) a. Applicative f => a -> Strict f a
$cp1Applicative :: forall (f :: * -> *). Applicative f => Functor (Strict f)
Applicative, Applicative (Strict f)
Strict f a
Applicative (Strict f)
-> (forall a. Strict f a)
-> (forall a. Strict f a -> Strict f a -> Strict f a)
-> (forall a. Strict f a -> Strict f [a])
-> (forall a. Strict f a -> Strict f [a])
-> Alternative (Strict f)
Strict f a -> Strict f a -> Strict f a
Strict f a -> Strict f [a]
Strict f a -> Strict f [a]
forall a. Strict f a
forall a. Strict f a -> Strict f [a]
forall a. Strict f a -> Strict f a -> Strict f a
forall (f :: * -> *).
Applicative f
-> (forall a. f a)
-> (forall a. f a -> f a -> f a)
-> (forall a. f a -> f [a])
-> (forall a. f a -> f [a])
-> Alternative f
forall (f :: * -> *). Alternative f => Applicative (Strict f)
forall (f :: * -> *) a. Alternative f => Strict f a
forall (f :: * -> *) a. Alternative f => Strict f a -> Strict f [a]
forall (f :: * -> *) a.
Alternative f =>
Strict f a -> Strict f a -> Strict f a
many :: Strict f a -> Strict f [a]
$cmany :: forall (f :: * -> *) a. Alternative f => Strict f a -> Strict f [a]
some :: Strict f a -> Strict f [a]
$csome :: forall (f :: * -> *) a. Alternative f => Strict f a -> Strict f [a]
<|> :: Strict f a -> Strict f a -> Strict f a
$c<|> :: forall (f :: * -> *) a.
Alternative f =>
Strict f a -> Strict f a -> Strict f a
empty :: Strict f a
$cempty :: forall (f :: * -> *) a. Alternative f => Strict f a
$cp1Alternative :: forall (f :: * -> *). Alternative f => Applicative (Strict f)
Alternative,
                                                        Applicative (Strict f)
a -> Strict f a
Applicative (Strict f)
-> (forall a b. Strict f a -> (a -> Strict f b) -> Strict f b)
-> (forall a b. Strict f a -> Strict f b -> Strict f b)
-> (forall a. a -> Strict f a)
-> Monad (Strict f)
Strict f a -> (a -> Strict f b) -> Strict f b
Strict f a -> Strict f b -> Strict f b
forall a. a -> Strict f a
forall a b. Strict f a -> Strict f b -> Strict f b
forall a b. Strict f a -> (a -> Strict f b) -> Strict f b
forall (f :: * -> *). Monad f => Applicative (Strict f)
forall (f :: * -> *) a. Monad f => a -> Strict f a
forall (f :: * -> *) a b.
Monad f =>
Strict f a -> Strict f b -> Strict f b
forall (f :: * -> *) a b.
Monad f =>
Strict f a -> (a -> Strict f b) -> Strict f b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: a -> Strict f a
$creturn :: forall (f :: * -> *) a. Monad f => a -> Strict f a
>> :: Strict f a -> Strict f b -> Strict f b
$c>> :: forall (f :: * -> *) a b.
Monad f =>
Strict f a -> Strict f b -> Strict f b
>>= :: Strict f a -> (a -> Strict f b) -> Strict f b
$c>>= :: forall (f :: * -> *) a b.
Monad f =>
Strict f a -> (a -> Strict f b) -> Strict f b
$cp1Monad :: forall (f :: * -> *). Monad f => Applicative (Strict f)
Monad, Monad (Strict f)
Alternative (Strict f)
Strict f a
Alternative (Strict f)
-> Monad (Strict f)
-> (forall a. Strict f a)
-> (forall a. Strict f a -> Strict f a -> Strict f a)
-> MonadPlus (Strict f)
Strict f a -> Strict f a -> Strict f a
forall a. Strict f a
forall a. Strict f a -> Strict f a -> Strict f a
forall (m :: * -> *).
Alternative m
-> Monad m
-> (forall a. m a)
-> (forall a. m a -> m a -> m a)
-> MonadPlus m
forall (f :: * -> *). MonadPlus f => Monad (Strict f)
forall (f :: * -> *). MonadPlus f => Alternative (Strict f)
forall (f :: * -> *) a. MonadPlus f => Strict f a
forall (f :: * -> *) a.
MonadPlus f =>
Strict f a -> Strict f a -> Strict f a
mplus :: Strict f a -> Strict f a -> Strict f a
$cmplus :: forall (f :: * -> *) a.
MonadPlus f =>
Strict f a -> Strict f a -> Strict f a
mzero :: Strict f a
$cmzero :: forall (f :: * -> *) a. MonadPlus f => Strict f a
$cp2MonadPlus :: forall (f :: * -> *). MonadPlus f => Monad (Strict f)
$cp1MonadPlus :: forall (f :: * -> *). MonadPlus f => Alternative (Strict f)
MonadPlus,
                                                        Alternative (Strict f)
Strict f ()
String -> Strict f a
Alternative (Strict f)
-> (forall a. Strict f a -> Strict f a)
-> (forall a. Strict f a -> String -> Strict f a)
-> (forall a. Strict f a -> Strict f ())
-> (forall a. Strict f a -> Strict f ())
-> (forall a. String -> Strict f a)
-> Strict f ()
-> (forall a. Show a => Strict f a -> Strict f ())
-> Parsing (Strict f)
Strict f a -> Strict f a
Strict f a -> String -> Strict f a
Strict f a -> Strict f ()
Strict f a -> Strict f ()
Strict f a -> Strict f ()
forall a. Show a => Strict f a -> Strict f ()
forall a. String -> Strict f a
forall a. Strict f a -> Strict f a
forall a. Strict f a -> Strict f ()
forall a. Strict f a -> String -> Strict f a
forall (m :: * -> *).
Alternative m
-> (forall a. m a -> m a)
-> (forall a. m a -> String -> m a)
-> (forall a. m a -> m ())
-> (forall a. m a -> m ())
-> (forall a. String -> m a)
-> m ()
-> (forall a. Show a => m a -> m ())
-> Parsing m
forall (f :: * -> *). Parsing f => Alternative (Strict f)
forall (f :: * -> *). Parsing f => Strict f ()
forall (f :: * -> *) a.
(Parsing f, Show a) =>
Strict f a -> Strict f ()
forall (f :: * -> *) a. Parsing f => String -> Strict f a
forall (f :: * -> *) a. Parsing f => Strict f a -> Strict f a
forall (f :: * -> *) a. Parsing f => Strict f a -> Strict f ()
forall (f :: * -> *) a.
Parsing f =>
Strict f a -> String -> Strict f a
notFollowedBy :: Strict f a -> Strict f ()
$cnotFollowedBy :: forall (f :: * -> *) a.
(Parsing f, Show a) =>
Strict f a -> Strict f ()
eof :: Strict f ()
$ceof :: forall (f :: * -> *). Parsing f => Strict f ()
unexpected :: String -> Strict f a
$cunexpected :: forall (f :: * -> *) a. Parsing f => String -> Strict f a
skipSome :: Strict f a -> Strict f ()
$cskipSome :: forall (f :: * -> *) a. Parsing f => Strict f a -> Strict f ()
skipMany :: Strict f a -> Strict f ()
$cskipMany :: forall (f :: * -> *) a. Parsing f => Strict f a -> Strict f ()
<?> :: Strict f a -> String -> Strict f a
$c<?> :: forall (f :: * -> *) a.
Parsing f =>
Strict f a -> String -> Strict f a
try :: Strict f a -> Strict f a
$ctry :: forall (f :: * -> *) a. Parsing f => Strict f a -> Strict f a
$cp1Parsing :: forall (f :: * -> *). Parsing f => Alternative (Strict f)
Parsing, Parsing (Strict f)
Parsing (Strict f)
-> (forall a. Strict f a -> Strict f a)
-> LookAheadParsing (Strict f)
Strict f a -> Strict f a
forall a. Strict f a -> Strict f a
forall (f :: * -> *). LookAheadParsing f => Parsing (Strict f)
forall (f :: * -> *) a.
LookAheadParsing f =>
Strict f a -> Strict f a
forall (m :: * -> *).
Parsing m -> (forall a. m a -> m a) -> LookAheadParsing m
lookAhead :: Strict f a -> Strict f a
$clookAhead :: forall (f :: * -> *) a.
LookAheadParsing f =>
Strict f a -> Strict f a
$cp1LookAheadParsing :: forall (f :: * -> *). LookAheadParsing f => Parsing (Strict f)
LookAheadParsing, Parsing (Strict f)
Strict f Char
Char -> Strict f Char
String -> Strict f String
Text -> Strict f Text
Parsing (Strict f)
-> ((Char -> Bool) -> Strict f Char)
-> (Char -> Strict f Char)
-> (Char -> Strict f Char)
-> Strict f Char
-> (String -> Strict f String)
-> (Text -> Strict f Text)
-> CharParsing (Strict f)
(Char -> Bool) -> Strict f Char
forall (f :: * -> *). CharParsing f => Parsing (Strict f)
forall (f :: * -> *). CharParsing f => Strict f Char
forall (f :: * -> *). CharParsing f => Char -> Strict f Char
forall (f :: * -> *). CharParsing f => String -> Strict f String
forall (f :: * -> *). CharParsing f => Text -> Strict f Text
forall (f :: * -> *).
CharParsing f =>
(Char -> Bool) -> Strict f Char
forall (m :: * -> *).
Parsing m
-> ((Char -> Bool) -> m Char)
-> (Char -> m Char)
-> (Char -> m Char)
-> m Char
-> (String -> m String)
-> (Text -> m Text)
-> CharParsing m
text :: Text -> Strict f Text
$ctext :: forall (f :: * -> *). CharParsing f => Text -> Strict f Text
string :: String -> Strict f String
$cstring :: forall (f :: * -> *). CharParsing f => String -> Strict f String
anyChar :: Strict f Char
$canyChar :: forall (f :: * -> *). CharParsing f => Strict f Char
notChar :: Char -> Strict f Char
$cnotChar :: forall (f :: * -> *). CharParsing f => Char -> Strict f Char
char :: Char -> Strict f Char
$cchar :: forall (f :: * -> *). CharParsing f => Char -> Strict f Char
satisfy :: (Char -> Bool) -> Strict f Char
$csatisfy :: forall (f :: * -> *).
CharParsing f =>
(Char -> Bool) -> Strict f Char
$cp1CharParsing :: forall (f :: * -> *). CharParsing f => Parsing (Strict f)
CharParsing, CharParsing (Strict f)
Strict f Char
Strict f ()
Highlight -> Strict f a -> Strict f a
CharParsing (Strict f)
-> Strict f ()
-> (forall a. Strict f a -> Strict f a)
-> Strict f Char
-> (forall a. Highlight -> Strict f a -> Strict f a)
-> (forall a. Strict f a -> Strict f a)
-> TokenParsing (Strict f)
Strict f a -> Strict f a
Strict f a -> Strict f a
forall a. Highlight -> Strict f a -> Strict f a
forall a. Strict f a -> Strict f a
forall (f :: * -> *). TokenParsing f => CharParsing (Strict f)
forall (f :: * -> *). TokenParsing f => Strict f Char
forall (f :: * -> *). TokenParsing f => Strict f ()
forall (f :: * -> *) a.
TokenParsing f =>
Highlight -> Strict f a -> Strict f a
forall (f :: * -> *) a. TokenParsing f => Strict f a -> Strict f a
forall (m :: * -> *).
CharParsing m
-> m ()
-> (forall a. m a -> m a)
-> m Char
-> (forall a. Highlight -> m a -> m a)
-> (forall a. m a -> m a)
-> TokenParsing m
token :: Strict f a -> Strict f a
$ctoken :: forall (f :: * -> *) a. TokenParsing f => Strict f a -> Strict f a
highlight :: Highlight -> Strict f a -> Strict f a
$chighlight :: forall (f :: * -> *) a.
TokenParsing f =>
Highlight -> Strict f a -> Strict f a
semi :: Strict f Char
$csemi :: forall (f :: * -> *). TokenParsing f => Strict f Char
nesting :: Strict f a -> Strict f a
$cnesting :: forall (f :: * -> *) a. TokenParsing f => Strict f a -> Strict f a
someSpace :: Strict f ()
$csomeSpace :: forall (f :: * -> *). TokenParsing f => Strict f ()
$cp1TokenParsing :: forall (f :: * -> *). TokenParsing f => CharParsing (Strict f)
TokenParsing)