{-# 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
  | XmlElementTypeComment
  | XmlElementTypeCData
  | XmlElementTypeMeta Text

parseXmlString :: (P.Parser t Word8) => T.Parser t Text
parseXmlString :: 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 (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 (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 :: Parser t XmlElementType
parseXmlElement = Parser t XmlElementType
comment Parser t XmlElementType
-> Parser t XmlElementType -> Parser t XmlElementType
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 (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser t XmlElementType
doc Parser t XmlElementType
-> Parser t XmlElementType -> Parser t XmlElementType
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 (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 (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 :: 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 (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 :: 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