{-# Language FlexibleContexts #-}
{-# Language OverloadedStrings #-}
module Ipe.ParserPrimitives( runP, runP'
, pMany, pMany1, pChoice
, pChar, pSpace, pWhiteSpace, pInteger
, pNatural, pPaddedNatural
, (<*><>) , (<*><)
, (<***>) , (<***) , (***>)
, pMaybe , pCount , pSepBy
, Parser, ParseError
, pNotFollowedBy
) where
import Text.Parsec(try)
import Text.Parsec(ParsecT, Stream)
import Text.Parsec.Text
import Text.ParserCombinators.Parsec hiding (Parser,try)
import qualified Data.Text as T
runP' :: Parser a -> T.Text -> (a, T.Text)
runP' :: Parser a -> Text -> (a, Text)
runP' Parser a
p Text
s = case Parser a -> Text -> Either ParseError (a, Text)
forall a. Parser a -> Text -> Either ParseError (a, Text)
runP Parser a
p Text
s of
Left ParseError
e -> [Char] -> (a, Text)
forall a. HasCallStack => [Char] -> a
error ([Char] -> (a, Text)) -> [Char] -> (a, Text)
forall a b. (a -> b) -> a -> b
$ ParseError -> [Char]
forall a. Show a => a -> [Char]
show ParseError
e
Right (a, Text)
x -> (a, Text)
x
runP :: Parser a -> T.Text -> Either ParseError (a,T.Text)
runP :: Parser a -> Text -> Either ParseError (a, Text)
runP Parser a
p = Parsec Text () (a, Text)
-> [Char] -> Text -> Either ParseError (a, Text)
forall s t a.
Stream s Identity t =>
Parsec s () a -> [Char] -> s -> Either ParseError a
parse ((,) (a -> Text -> (a, Text))
-> Parser a -> ParsecT Text () Identity (Text -> (a, Text))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser a
p ParsecT Text () Identity (Text -> (a, Text))
-> ParsecT Text () Identity Text -> Parsec Text () (a, Text)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Text () Identity Text
forall (m :: * -> *) s u. Monad m => ParsecT s u m s
getInput) [Char]
""
pMany :: Parser a -> Parser [a]
pMany :: Parser a -> Parser [a]
pMany = Parser a -> Parser [a]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many
pMany1 :: Parser a -> Parser [a]
pMany1 :: Parser a -> Parser [a]
pMany1 = Parser a -> Parser [a]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1
pChoice :: [Parser a] -> Parser a
pChoice :: [Parser a] -> Parser a
pChoice = [Parser a] -> Parser a
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice ([Parser a] -> Parser a)
-> ([Parser a] -> [Parser a]) -> [Parser a] -> Parser a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Parser a -> Parser a) -> [Parser a] -> [Parser a]
forall a b. (a -> b) -> [a] -> [b]
map Parser a -> Parser a
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try
pNatural :: Parser Integer
pNatural :: Parser Integer
pNatural = [Char] -> Integer
forall a. Read a => [Char] -> a
read ([Char] -> Integer)
-> ParsecT Text () Identity [Char] -> Parser Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Char -> ParsecT Text () Identity [Char]
forall a. Parser a -> Parser [a]
pMany1 Parser Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit
pPaddedNatural :: Parser (Int, Integer)
pPaddedNatural :: Parser (Int, Integer)
pPaddedNatural = (\[Char]
s -> ([Char] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char]
s, [Char] -> Integer
forall a. Read a => [Char] -> a
read [Char]
s)) ([Char] -> (Int, Integer))
-> ParsecT Text () Identity [Char] -> Parser (Int, Integer)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Char -> ParsecT Text () Identity [Char]
forall a. Parser a -> Parser [a]
pMany1 Parser Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit
pInteger :: Parser Integer
pInteger :: Parser Integer
pInteger = Parser Integer
pNatural
Parser Integer -> Parser Integer -> Parser Integer
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
Integer -> Integer
forall a. Num a => a -> a
negate (Integer -> Integer) -> Parser Integer -> Parser Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Parser Char
pChar Char
'-' Parser Char -> Parser Integer -> Parser Integer
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Integer
pNatural)
pChar :: Char -> Parser Char
pChar :: Char -> Parser Char
pChar = Char -> Parser Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char
pSpace :: Parser Char
pSpace :: Parser Char
pSpace = Char -> Parser Char
pChar Char
' '
pWhiteSpace :: Parser [Char]
pWhiteSpace :: ParsecT Text () Identity [Char]
pWhiteSpace = Parser Char -> ParsecT Text () Identity [Char]
forall a. Parser a -> Parser [a]
pMany1 (Parser Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
space Parser Char -> Parser Char -> Parser Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parser Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
newline)
pMaybe :: Parser a -> Parser (Maybe a)
pMaybe :: Parser a -> Parser (Maybe a)
pMaybe = Parser a -> Parser (Maybe a)
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m (Maybe a)
optionMaybe
pCount :: Int -> Parser a -> Parser [a]
pCount :: Int -> Parser a -> Parser [a]
pCount = Int -> Parser a -> Parser [a]
forall s (m :: * -> *) t u a.
Stream s m t =>
Int -> ParsecT s u m a -> ParsecT s u m [a]
count
pSepBy :: Parser a -> Parser b -> Parser [a]
pSepBy :: Parser a -> Parser b -> Parser [a]
pSepBy = Parser a -> Parser b -> Parser [a]
forall s (m :: * -> *) t u a sep.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
sepBy
pNotFollowedBy :: Parser a -> Parser b -> Parser a
Parser a
p pNotFollowedBy :: Parser a -> Parser b -> Parser a
`pNotFollowedBy` Parser b
q = do { a
x <- Parser a
p ; Parser b -> ParsecT Text () Identity ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy' Parser b
q ; a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return a
x }
where
notFollowedBy' :: ParsecT s u m a -> ParsecT s u m ()
notFollowedBy' ParsecT s u m a
z = ParsecT s u m () -> ParsecT s u m ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (do{ a
_ <- ParsecT s u m a -> ParsecT s u m a
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try ParsecT s u m a
z; [Char] -> ParsecT s u m ()
forall s (m :: * -> *) t u a.
Stream s m t =>
[Char] -> ParsecT s u m a
unexpected [Char]
"not followed by" }
ParsecT s u m () -> ParsecT s u m () -> ParsecT s u m ()
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> () -> ParsecT s u m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
)
infix 1 <*><>, <*><
(<*><>) :: (Reversable s, Stream s m t)
=> ParsecT s u m (a -> b) -> ParsecT s u m a -> ParsecT s u m b
ParsecT s u m (a -> b)
p <*><> :: ParsecT s u m (a -> b) -> ParsecT s u m a -> ParsecT s u m b
<*><> ParsecT s u m a
q = do
ParsecT s u m ()
forall s (m :: * -> *) t u.
(Reversable s, Stream s m t) =>
ParsecT s u m ()
rev
a
x <- ParsecT s u m a
q
ParsecT s u m ()
forall s (m :: * -> *) t u.
(Reversable s, Stream s m t) =>
ParsecT s u m ()
rev
a -> b
f <- ParsecT s u m (a -> b)
p
b -> ParsecT s u m b
forall (m :: * -> *) a. Monad m => a -> m a
return (b -> ParsecT s u m b) -> b -> ParsecT s u m b
forall a b. (a -> b) -> a -> b
$ a -> b
f a
x
(<*><) :: (Stream s m t, Reversable s)
=> ParsecT s u m b -> ParsecT s u m a -> ParsecT s u m b
ParsecT s u m b
p <*>< :: ParsecT s u m b -> ParsecT s u m a -> ParsecT s u m b
<*>< ParsecT s u m a
q = b -> a -> b
forall a b. a -> b -> a
const (b -> a -> b) -> ParsecT s u m b -> ParsecT s u m (a -> b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT s u m b
p ParsecT s u m (a -> b) -> ParsecT s u m a -> ParsecT s u m b
forall s (m :: * -> *) t u a b.
(Reversable s, Stream s m t) =>
ParsecT s u m (a -> b) -> ParsecT s u m a -> ParsecT s u m b
<*><> ParsecT s u m a
q
rev :: (Reversable s, Stream s m t) => ParsecT s u m ()
rev :: ParsecT s u m ()
rev = ParsecT s u m s
forall (m :: * -> *) s u. Monad m => ParsecT s u m s
getInput ParsecT s u m s -> (s -> ParsecT s u m ()) -> ParsecT s u m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (s -> ParsecT s u m ()
forall (m :: * -> *) s u. Monad m => s -> ParsecT s u m ()
setInput (s -> ParsecT s u m ()) -> (s -> s) -> s -> ParsecT s u m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> s
forall s. Reversable s => s -> s
reverseS)
infixr 2 <***>, ***>, <***
(<***>) :: Monad m => m (t -> b) -> m t -> m b
m (t -> b)
p <***> :: m (t -> b) -> m t -> m b
<***> m t
q = do
t
x <- m t
q
t -> b
f <- m (t -> b)
p
b -> m b
forall (m :: * -> *) a. Monad m => a -> m a
return (b -> m b) -> b -> m b
forall a b. (a -> b) -> a -> b
$ t -> b
f t
x
(***>) :: Monad m => m a -> m b -> m b
m a
p ***> :: m a -> m b -> m b
***> m b
q = (\a
_ b
s -> b
s) (a -> b -> b) -> m a -> m (b -> b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m a
p m (b -> b) -> m b -> m b
forall (m :: * -> *) t b. Monad m => m (t -> b) -> m t -> m b
<***> m b
q
(<***) :: Monad m => m b -> m t -> m b
m b
p <*** :: m b -> m t -> m b
<*** m t
q = (\b
s t
_ -> b
s) (b -> t -> b) -> m b -> m (t -> b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m b
p m (t -> b) -> m t -> m b
forall (m :: * -> *) t b. Monad m => m (t -> b) -> m t -> m b
<***> m t
q
class Reversable s where
reverseS :: s -> s
instance Reversable [c] where
reverseS :: [c] -> [c]
reverseS = [c] -> [c]
forall c. [c] -> [c]
reverse
instance Reversable T.Text where
reverseS :: Text -> Text
reverseS = Text -> Text
T.reverse