module XmlParser.Attoparsec where
import Data.Attoparsec.Text
import qualified Data.Text as Text
import XmlParser.Prelude hiding (takeWhile)
parseStripped :: Parser a -> Text -> Either Text a
parseStripped :: Parser a -> Text -> Either Text a
parseStripped Parser a
p = (String -> Text) -> Either String a -> Either Text a
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first String -> Text
forall a. IsString a => String -> a
fromString (Either String a -> Either Text a)
-> (Text -> Either String a) -> Text -> Either Text a
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Parser a -> Text -> Either String a
forall a. Parser a -> Text -> Either String a
parseOnly (Parser a -> Parser a
forall a. Parser a -> Parser a
stripped Parser a
p)
where
stripped :: Parser a -> Parser a
stripped :: Parser a -> Parser a
stripped Parser a
p = Parser ()
skipSpace Parser () -> Parser a -> Parser a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser a
p Parser a -> Parser () -> Parser a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
skipSpace Parser a -> Parser () -> Parser a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
forall t. Chunk t => Parser t ()
endOfInput
qName :: Parser (Maybe Text, Text)
qName :: Parser (Maybe Text, Text)
qName =
do
Text
a <- Parser Text
ncName
[Parser (Maybe Text, Text)] -> Parser (Maybe Text, Text)
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum
[ do
Char -> Parser Char
char Char
':'
Text
b <- Parser Text
ncName
(Maybe Text, Text) -> Parser (Maybe Text, Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
a, Text
b),
(Maybe Text, Text) -> Parser (Maybe Text, Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Text
forall a. Maybe a
Nothing, Text
a)
]
{-# NOINLINE ncName #-}
ncName :: Parser Text
ncName :: Parser Text
ncName =
do
Char
a <- (Char -> Bool) -> Parser Char
satisfy Char -> Bool
nameStartCharPredicate
Text
b <- (Char -> Bool) -> Parser Text
takeWhile Char -> Bool
nameCharPredicate
Text -> Parser Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Char -> Text -> Text
Text.cons Char
a Text
b)
where
nameStartCharPredicate :: Char -> Bool
nameStartCharPredicate Char
x =
Char
x Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'A' Bool -> Bool -> Bool
&& Char
x Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'Z'
Bool -> Bool -> Bool
|| Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_'
Bool -> Bool -> Bool
|| Char
x Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'a' Bool -> Bool -> Bool
&& Char
x Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'z'
Bool -> Bool -> Bool
|| Char
x Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'\xC0' Bool -> Bool -> Bool
&& Char
x Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\xD6'
Bool -> Bool -> Bool
|| Char
x Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'\xD8' Bool -> Bool -> Bool
&& Char
x Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\xF6'
Bool -> Bool -> Bool
|| Char
x Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'\xF8' Bool -> Bool -> Bool
&& Char
x Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x2FF'
Bool -> Bool -> Bool
|| Char
x Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'\x370' Bool -> Bool -> Bool
&& Char
x Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x37D'
Bool -> Bool -> Bool
|| Char
x Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'\x37F' Bool -> Bool -> Bool
&& Char
x Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x1FFF'
Bool -> Bool -> Bool
|| Char
x Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'\x200C' Bool -> Bool -> Bool
&& Char
x Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x200D'
Bool -> Bool -> Bool
|| Char
x Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'\x2070' Bool -> Bool -> Bool
&& Char
x Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x218F'
Bool -> Bool -> Bool
|| Char
x Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'\x2C00' Bool -> Bool -> Bool
&& Char
x Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x2FEF'
Bool -> Bool -> Bool
|| Char
x Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'\x3001' Bool -> Bool -> Bool
&& Char
x Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\xD7FF'
Bool -> Bool -> Bool
|| Char
x Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'\xF900' Bool -> Bool -> Bool
&& Char
x Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\xFDCF'
Bool -> Bool -> Bool
|| Char
x Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'\xFDF0' Bool -> Bool -> Bool
&& Char
x Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\xFFFD'
Bool -> Bool -> Bool
|| Char
x Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'\x10000' Bool -> Bool -> Bool
&& Char
x Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\xEFFFF'
nameCharPredicate :: Char -> Bool
nameCharPredicate Char
x =
Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'-' Bool -> Bool -> Bool
|| Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'.'
Bool -> Bool -> Bool
|| Char
x Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'0' Bool -> Bool -> Bool
&& Char
x Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'9'
Bool -> Bool -> Bool
|| Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\xB7'
Bool -> Bool -> Bool
|| Char
x Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'\x0300' Bool -> Bool -> Bool
&& Char
x Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x036F'
Bool -> Bool -> Bool
|| Char
x Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'\x203F' Bool -> Bool -> Bool
&& Char
x Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x2040'
Bool -> Bool -> Bool
|| Char -> Bool
nameStartCharPredicate Char
x