{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
module HaskellWorks.Data.Xml.Grammar where
import Control.Applicative
import Data.Char
import Data.String
import Data.Text (Text)
import Data.Word
import HaskellWorks.Data.Parser
import qualified Data.Attoparsec.Types as T
import qualified Data.Text as T
import qualified HaskellWorks.Data.Parser as P
data XmlElementType
= XmlElementTypeDocument
| XmlElementTypeElement Text
|
| XmlElementTypeCData
| XmlElementTypeMeta Text
parseXmlString :: (P.Parser t Word8) => T.Parser t Text
parseXmlString :: forall t. Parser t Word8 => Parser t Text
parseXmlString = do
Char
q <- (Char -> Bool) -> Parser t Char
forall t e. Parser t e => (Char -> Bool) -> Parser t Char
satisfyChar (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
'"') Parser t Char -> Parser t Char -> Parser t Char
forall a. Parser t a -> Parser t a -> Parser t a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Char -> Bool) -> Parser t Char
forall t e. Parser t e => (Char -> Bool) -> Parser t Char
satisfyChar (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
'\'')
String -> Text
T.pack (String -> Text) -> Parser t String -> Parser t Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser t Char -> Parser t String
forall a. Parser t a -> Parser t [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many ((Char -> Bool) -> Parser t Char
forall t e. Parser t e => (Char -> Bool) -> Parser t Char
satisfyChar (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
q))
parseXmlElement :: (P.Parser t Word8, IsString t) => T.Parser t XmlElementType
parseXmlElement :: forall t. (Parser t Word8, IsString t) => Parser t XmlElementType
parseXmlElement = Parser t XmlElementType
comment Parser t XmlElementType
-> Parser t XmlElementType -> Parser t XmlElementType
forall a. Parser t a -> Parser t a -> Parser t a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser t XmlElementType
cdata Parser t XmlElementType
-> Parser t XmlElementType -> Parser t XmlElementType
forall a. Parser t a -> Parser t a -> Parser t a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser t XmlElementType
doc Parser t XmlElementType
-> Parser t XmlElementType -> Parser t XmlElementType
forall a. Parser t a -> Parser t a -> Parser t a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser t XmlElementType
meta Parser t XmlElementType
-> Parser t XmlElementType -> Parser t XmlElementType
forall a. Parser t a -> Parser t a -> Parser t a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser t XmlElementType
element
where
comment :: Parser t XmlElementType
comment = XmlElementType -> t -> XmlElementType
forall a b. a -> b -> a
const XmlElementType
XmlElementTypeComment (t -> XmlElementType) -> Parser t t -> Parser t XmlElementType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> t -> Parser t t
forall t e. Parser t e => t -> Parser t t
string t
"!--"
cdata :: Parser t XmlElementType
cdata = XmlElementType -> t -> XmlElementType
forall a b. a -> b -> a
const XmlElementType
XmlElementTypeCData (t -> XmlElementType) -> Parser t t -> Parser t XmlElementType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> t -> Parser t t
forall t e. Parser t e => t -> Parser t t
string t
"![CDATA["
meta :: Parser t XmlElementType
meta = Text -> XmlElementType
XmlElementTypeMeta (Text -> XmlElementType)
-> Parser t Text -> Parser t XmlElementType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (t -> Parser t t
forall t e. Parser t e => t -> Parser t t
string t
"!" Parser t t -> Parser t Text -> Parser t Text
forall a b. Parser t a -> Parser t b -> Parser t b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser t Text
forall t. Parser t Word8 => Parser t Text
parseXmlToken)
doc :: Parser t XmlElementType
doc = XmlElementType -> t -> XmlElementType
forall a b. a -> b -> a
const XmlElementType
XmlElementTypeDocument (t -> XmlElementType) -> Parser t t -> Parser t XmlElementType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> t -> Parser t t
forall t e. Parser t e => t -> Parser t t
string t
"?xml"
element :: Parser t XmlElementType
element = Text -> XmlElementType
XmlElementTypeElement (Text -> XmlElementType)
-> Parser t Text -> Parser t XmlElementType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser t Text
forall t. Parser t Word8 => Parser t Text
parseXmlToken
parseXmlToken :: (P.Parser t Word8) => T.Parser t Text
parseXmlToken :: forall t. Parser t Word8 => Parser t Text
parseXmlToken = String -> Text
T.pack (String -> Text) -> Parser t String -> Parser t Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser t Char -> Parser t String
forall a. Parser t a -> Parser t [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many ((Char -> Bool) -> Parser t Char
forall t e. Parser t e => (Char -> Bool) -> Parser t Char
satisfyChar Char -> Bool
isNameChar Parser t Char -> String -> Parser t Char
forall t e. Parser t e => Parser t Char -> String -> Parser t Char
<?> String
"invalid string character")
parseXmlAttributeName :: (P.Parser t Word8) => T.Parser t Text
parseXmlAttributeName :: forall t. Parser t Word8 => Parser t Text
parseXmlAttributeName = Parser t Text
forall t. Parser t Word8 => Parser t Text
parseXmlToken
isNameStartChar :: Char -> Bool
isNameStartChar :: Char -> Bool
isNameStartChar Char
w =
let iw :: Int
iw = Char -> Int
ord Char
w
in Char
w Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_' Bool -> Bool -> Bool
|| Char
w Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
':' Bool -> Bool -> Bool
|| Char -> Bool
isAlpha Char
w
Bool -> Bool -> Bool
|| (Int
iw Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0xc0 Bool -> Bool -> Bool
&& Int
iw Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0xd6)
Bool -> Bool -> Bool
|| (Int
iw Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0xd8 Bool -> Bool -> Bool
&& Int
iw Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0xf6)
Bool -> Bool -> Bool
|| (Int
iw Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0xf8 Bool -> Bool -> Bool
&& Int
iw Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0xff)
isNameChar :: Char -> Bool
isNameChar :: Char -> Bool
isNameChar Char
w = Char -> Bool
isNameStartChar Char
w Bool -> Bool -> Bool
|| Char
w Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'-' Bool -> Bool -> Bool
|| Char
w Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'.'
Bool -> Bool -> Bool
|| Char -> Int
ord Char
w Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0xb7 Bool -> Bool -> Bool
|| Char -> Bool
isNumber Char
w