{-# LANGUAGE OverloadedStrings #-}
-- | All documentation examples assume the following setup:
--
-- > :set -XOverloadedStrings
-- > import Data.Attoparsec.ByteString
module Data.XML.Parser.Low.Name
  ( QName(..)
  , tokenQualifiedName
  , tokenNCName
  , tokenName
  ) where

import           Control.Applicative
import           Data.Char
import           Data.Maybe
import           Data.String
import           Data.Text               (Text)
import qualified Data.Text               as Text
import           Text.Parser.Char

-- $setup
-- >>> :set -XOverloadedStrings
-- >>> import Data.Attoparsec.ByteString

-- | A qualified name.
--
-- <https://www.w3.org/TR/xml-names/#dt-qualname>
data QName = QName
  { QName -> Text
namePrefix :: Text
  , QName -> Text
nameLocal :: Text
  } deriving (QName -> QName -> Bool
(QName -> QName -> Bool) -> (QName -> QName -> Bool) -> Eq QName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: QName -> QName -> Bool
$c/= :: QName -> QName -> Bool
== :: QName -> QName -> Bool
$c== :: QName -> QName -> Bool
Eq, Eq QName
Eq QName
-> (QName -> QName -> Ordering)
-> (QName -> QName -> Bool)
-> (QName -> QName -> Bool)
-> (QName -> QName -> Bool)
-> (QName -> QName -> Bool)
-> (QName -> QName -> QName)
-> (QName -> QName -> QName)
-> Ord QName
QName -> QName -> Bool
QName -> QName -> Ordering
QName -> QName -> QName
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: QName -> QName -> QName
$cmin :: QName -> QName -> QName
max :: QName -> QName -> QName
$cmax :: QName -> QName -> QName
>= :: QName -> QName -> Bool
$c>= :: QName -> QName -> Bool
> :: QName -> QName -> Bool
$c> :: QName -> QName -> Bool
<= :: QName -> QName -> Bool
$c<= :: QName -> QName -> Bool
< :: QName -> QName -> Bool
$c< :: QName -> QName -> Bool
compare :: QName -> QName -> Ordering
$ccompare :: QName -> QName -> Ordering
$cp1Ord :: Eq QName
Ord, ReadPrec [QName]
ReadPrec QName
Int -> ReadS QName
ReadS [QName]
(Int -> ReadS QName)
-> ReadS [QName]
-> ReadPrec QName
-> ReadPrec [QName]
-> Read QName
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [QName]
$creadListPrec :: ReadPrec [QName]
readPrec :: ReadPrec QName
$creadPrec :: ReadPrec QName
readList :: ReadS [QName]
$creadList :: ReadS [QName]
readsPrec :: Int -> ReadS QName
$creadsPrec :: Int -> ReadS QName
Read, Int -> QName -> ShowS
[QName] -> ShowS
QName -> String
(Int -> QName -> ShowS)
-> (QName -> String) -> ([QName] -> ShowS) -> Show QName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [QName] -> ShowS
$cshowList :: [QName] -> ShowS
show :: QName -> String
$cshow :: QName -> String
showsPrec :: Int -> QName -> ShowS
$cshowsPrec :: Int -> QName -> ShowS
Show)

-- | Build a qualified name in a concise way. Prefix is assumed to be empty.
--
-- >>> "foo" :: QName
-- QName {namePrefix = "", nameLocal = "foo"}
instance IsString QName where
  fromString :: String -> QName
fromString String
s = Text -> Text -> QName
QName Text
forall a. Monoid a => a
mempty (Text -> QName) -> Text -> QName
forall a b. (a -> b) -> a -> b
$ String -> Text
Text.pack String
s

-- | <https://www.w3.org/TR/xml-names/#NT-QName>
--
-- >>> parseOnly tokenQualifiedName "price"
-- Right (QName {namePrefix = "", nameLocal = "price"})
-- >>> parseOnly tokenQualifiedName "edi:price"
-- Right (QName {namePrefix = "edi", nameLocal = "price"})
tokenQualifiedName :: CharParsing m => Monad m => m QName
tokenQualifiedName :: m QName
tokenQualifiedName = do
  Maybe Text
prefix <- m Text -> m (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (m Text -> m (Maybe Text)) -> m Text -> m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ m Text
forall (m :: * -> *). (CharParsing m, Monad m) => m Text
tokenNCName m Text -> m Char -> m Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> m Char
forall (m :: * -> *). CharParsing m => Char -> m Char
char Char
':'
  Text
value <- m Text
forall (m :: * -> *). (CharParsing m, Monad m) => m Text
tokenNCName
  QName -> m QName
forall (m :: * -> *) a. Monad m => a -> m a
return (QName -> m QName) -> QName -> m QName
forall a b. (a -> b) -> a -> b
$ Text -> Text -> QName
QName (Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
forall a. Monoid a => a
mempty Maybe Text
prefix) Text
value

-- | <https://www.w3.org/TR/REC-xml/#NT-NameStartChar>
isNameStartChar :: Char -> Bool
isNameStartChar :: Char -> Bool
isNameStartChar Char
':' = Bool
True
isNameStartChar Char
'_' = Bool
True
isNameStartChar Char
c
  | Char -> Bool
isLetter Char
c = Bool
True
  | Char -> Int
forall a. Enum a => a -> Int
fromEnum Char
c Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0xC0 Bool -> Bool -> Bool
&& Char -> Int
forall a. Enum a => a -> Int
fromEnum Char
c Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0xD6 = Bool
True
  | Char -> Int
forall a. Enum a => a -> Int
fromEnum Char
c Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0xD8 Bool -> Bool -> Bool
&& Char -> Int
forall a. Enum a => a -> Int
fromEnum Char
c Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0xF6 = Bool
True
  | Char -> Int
forall a. Enum a => a -> Int
fromEnum Char
c Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0xF8 Bool -> Bool -> Bool
&& Char -> Int
forall a. Enum a => a -> Int
fromEnum Char
c Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0x2FF = Bool
True
  | Char -> Int
forall a. Enum a => a -> Int
fromEnum Char
c Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0x370 Bool -> Bool -> Bool
&& Char -> Int
forall a. Enum a => a -> Int
fromEnum Char
c Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0x37D = Bool
True
  | Char -> Int
forall a. Enum a => a -> Int
fromEnum Char
c Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0x37F Bool -> Bool -> Bool
&& Char -> Int
forall a. Enum a => a -> Int
fromEnum Char
c Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0x1FFF = Bool
True
  | Char -> Int
forall a. Enum a => a -> Int
fromEnum Char
c Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0x200C Bool -> Bool -> Bool
&& Char -> Int
forall a. Enum a => a -> Int
fromEnum Char
c Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0x200D = Bool
True
  | Char -> Int
forall a. Enum a => a -> Int
fromEnum Char
c Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0x2070 Bool -> Bool -> Bool
&& Char -> Int
forall a. Enum a => a -> Int
fromEnum Char
c Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0x218F = Bool
True
  | Char -> Int
forall a. Enum a => a -> Int
fromEnum Char
c Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0x2C00 Bool -> Bool -> Bool
&& Char -> Int
forall a. Enum a => a -> Int
fromEnum Char
c Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0x2FEF = Bool
True
  | Char -> Int
forall a. Enum a => a -> Int
fromEnum Char
c Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0x3001 Bool -> Bool -> Bool
&& Char -> Int
forall a. Enum a => a -> Int
fromEnum Char
c Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0xD7FF = Bool
True
  | Char -> Int
forall a. Enum a => a -> Int
fromEnum Char
c Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0xF900 Bool -> Bool -> Bool
&& Char -> Int
forall a. Enum a => a -> Int
fromEnum Char
c Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0xFDCF = Bool
True
  | Char -> Int
forall a. Enum a => a -> Int
fromEnum Char
c Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0xFDF0 Bool -> Bool -> Bool
&& Char -> Int
forall a. Enum a => a -> Int
fromEnum Char
c Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0xFFFD = Bool
True
  | Char -> Int
forall a. Enum a => a -> Int
fromEnum Char
c Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0x10000 Bool -> Bool -> Bool
&& Char -> Int
forall a. Enum a => a -> Int
fromEnum Char
c Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0xEFFFF = Bool
True
  | Bool
otherwise = Bool
False

-- | <https://www.w3.org/TR/REC-xml/#NT-NameChar>
isNameChar :: Char -> Bool
isNameChar :: Char -> Bool
isNameChar Char
'-' = Bool
True
isNameChar Char
'.' = Bool
True
isNameChar Char
c
  | Char -> Bool
isDigit Char
c = Bool
True
  | Char -> Bool
isNameStartChar Char
c = Bool
True
  | Char -> Int
forall a. Enum a => a -> Int
fromEnum Char
c Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0xB7 = Bool
True
  | Char -> Int
forall a. Enum a => a -> Int
fromEnum Char
c Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0x0300 Bool -> Bool -> Bool
&& Char -> Int
forall a. Enum a => a -> Int
fromEnum Char
c Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0x036F = Bool
True
  | Char -> Int
forall a. Enum a => a -> Int
fromEnum Char
c Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0x203F Bool -> Bool -> Bool
&& Char -> Int
forall a. Enum a => a -> Int
fromEnum Char
c Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0x2040 = Bool
True
  | Bool
otherwise = Bool
False

-- | <https://www.w3.org/TR/xml-names/#NT-NCName>
--
-- >>> parseOnly tokenNCName "price"
-- Right "price"
-- >>> parse tokenNCName "edi:price"
-- Done ":price" "edi"
tokenNCName :: CharParsing m => Monad m => m Text
tokenNCName :: m Text
tokenNCName = String -> Text
Text.pack (String -> Text) -> m String -> m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
  Char
c <- (Char -> Bool) -> m Char
forall (m :: * -> *). CharParsing m => (Char -> Bool) -> m Char
satisfy (\Char
c -> Char -> Bool
isNameStartChar Char
c Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
':')
  String
t <- m Char -> m String
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (m Char -> m String) -> m Char -> m String
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> m Char
forall (m :: * -> *). CharParsing m => (Char -> Bool) -> m Char
satisfy (\Char
c -> Char -> Bool
isNameChar Char
c Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
':')
  String -> m String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> m String) -> String -> m String
forall a b. (a -> b) -> a -> b
$ Char
c Char -> ShowS
forall a. a -> [a] -> [a]
: String
t

-- | <https://www.w3.org/TR/REC-xml/#NT-Name>
--
-- >>> parseOnly tokenName "price"
-- Right "price"
-- >>> parseOnly tokenName "edi:price"
-- Right "edi:price"
tokenName :: CharParsing m => Monad m => m Text
tokenName :: m Text
tokenName = String -> Text
Text.pack (String -> Text) -> m String -> m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
  Char
c <- (Char -> Bool) -> m Char
forall (m :: * -> *). CharParsing m => (Char -> Bool) -> m Char
satisfy Char -> Bool
isNameStartChar
  String
t <- m Char -> m String
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (m Char -> m String) -> m Char -> m String
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> m Char
forall (m :: * -> *). CharParsing m => (Char -> Bool) -> m Char
satisfy Char -> Bool
isNameChar
  String -> m String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> m String) -> String -> m String
forall a b. (a -> b) -> a -> b
$ Char
c Char -> ShowS
forall a. a -> [a] -> [a]
: String
t