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 =
  {-
  Ref (from https://en.wikipedia.org/wiki/QName):

      QName            ::=   PrefixedName | UnprefixedName
      PrefixedName     ::=   Prefix ':' LocalPart
      UnprefixedName   ::=   LocalPart
      Prefix           ::=   NCName
      LocalPart        ::=   NCName
  -}
  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 =
  {-
  Ref (from https://en.wikipedia.org/wiki/QName):

      NCName           ::=   Name - (Char* ':' Char*)  (* An XML Name, minus the ":" *)
      Name             ::=   NameStartChar (NameChar)*
      NameStartChar    ::=   ":" | [A-Z] | "_" | [a-z] | [#xC0-#xD6] | [#xD8-#xF6]
                             | [#xF8-#x2FF] | [#x370-#x37D] | [#x37F-#x1FFF]
                             | [#x200C-#x200D] | [#x2070-#x218F] | [#x2C00-#x2FEF]
                             | [#x3001-#xD7FF] | [#xF900-#xFDCF] | [#xFDF0-#xFFFD]
                             | [#x10000-#xEFFFF]
      NameChar         ::=   NameStartChar | "-" | "." | [0-9]
                             | #xB7 | [#x0300-#x036F] | [#x203F-#x2040]
      Char             ::=   (* any Unicode char, excluding surrogate blocks FFFE and FFFF. *)
                             #x9 | #xA | #xD | [#x20-#xD7FF]
                             | [#xE000-#xFFFD] | [#x10000-#x10FFFF]
  -}
  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