-- | Low-level parsers for doctype's internal subset:
--
-- - parsed tokens are small and may overlap; it is not possible to tokenize doctype internal-subset in a stateless way
-- - parsers are reversible: all formatting details are retained (e.g. whitespacing)
--
-- All documentation examples assume the following setup:
--
-- > :set -XOverloadedStrings
-- > import Data.Attoparsec.ByteString
module Data.XML.InternalSubset.Parser.Low
  ( module Data.XML.Parser.Low.Name
  , module Data.XML.Parser.Low.Reference
  , module Data.XML.InternalSubset.Parser.Low
  ) where

import           Control.Applicative
import           Control.Monad
import           Data.Text                     (Text)
import qualified Data.Text                     as Text
import           Data.XML.Parser.Low.Name
import           Data.XML.Parser.Low.Reference
import           Text.Parser.Char
import           Text.Parser.Combinators

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

-- | <https://www.w3.org/TR/REC-xml/#NT-EntityValue>
data EntityValue = ValueText Text | ValueParameterEntityRef ParameterEntityRef | ValueReference Reference
  deriving (EntityValue -> EntityValue -> Bool
(EntityValue -> EntityValue -> Bool)
-> (EntityValue -> EntityValue -> Bool) -> Eq EntityValue
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EntityValue -> EntityValue -> Bool
$c/= :: EntityValue -> EntityValue -> Bool
== :: EntityValue -> EntityValue -> Bool
$c== :: EntityValue -> EntityValue -> Bool
Eq, Eq EntityValue
Eq EntityValue
-> (EntityValue -> EntityValue -> Ordering)
-> (EntityValue -> EntityValue -> Bool)
-> (EntityValue -> EntityValue -> Bool)
-> (EntityValue -> EntityValue -> Bool)
-> (EntityValue -> EntityValue -> Bool)
-> (EntityValue -> EntityValue -> EntityValue)
-> (EntityValue -> EntityValue -> EntityValue)
-> Ord EntityValue
EntityValue -> EntityValue -> Bool
EntityValue -> EntityValue -> Ordering
EntityValue -> EntityValue -> EntityValue
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 :: EntityValue -> EntityValue -> EntityValue
$cmin :: EntityValue -> EntityValue -> EntityValue
max :: EntityValue -> EntityValue -> EntityValue
$cmax :: EntityValue -> EntityValue -> EntityValue
>= :: EntityValue -> EntityValue -> Bool
$c>= :: EntityValue -> EntityValue -> Bool
> :: EntityValue -> EntityValue -> Bool
$c> :: EntityValue -> EntityValue -> Bool
<= :: EntityValue -> EntityValue -> Bool
$c<= :: EntityValue -> EntityValue -> Bool
< :: EntityValue -> EntityValue -> Bool
$c< :: EntityValue -> EntityValue -> Bool
compare :: EntityValue -> EntityValue -> Ordering
$ccompare :: EntityValue -> EntityValue -> Ordering
$cp1Ord :: Eq EntityValue
Ord, ReadPrec [EntityValue]
ReadPrec EntityValue
Int -> ReadS EntityValue
ReadS [EntityValue]
(Int -> ReadS EntityValue)
-> ReadS [EntityValue]
-> ReadPrec EntityValue
-> ReadPrec [EntityValue]
-> Read EntityValue
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [EntityValue]
$creadListPrec :: ReadPrec [EntityValue]
readPrec :: ReadPrec EntityValue
$creadPrec :: ReadPrec EntityValue
readList :: ReadS [EntityValue]
$creadList :: ReadS [EntityValue]
readsPrec :: Int -> ReadS EntityValue
$creadsPrec :: Int -> ReadS EntityValue
Read, Int -> EntityValue -> ShowS
[EntityValue] -> ShowS
EntityValue -> String
(Int -> EntityValue -> ShowS)
-> (EntityValue -> String)
-> ([EntityValue] -> ShowS)
-> Show EntityValue
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EntityValue] -> ShowS
$cshowList :: [EntityValue] -> ShowS
show :: EntityValue -> String
$cshow :: EntityValue -> String
showsPrec :: Int -> EntityValue -> ShowS
$cshowsPrec :: Int -> EntityValue -> ShowS
Show)

-- | Parameter entity reference
newtype ParameterEntityRef = ParameterEntityRef Text
  deriving (ParameterEntityRef -> ParameterEntityRef -> Bool
(ParameterEntityRef -> ParameterEntityRef -> Bool)
-> (ParameterEntityRef -> ParameterEntityRef -> Bool)
-> Eq ParameterEntityRef
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ParameterEntityRef -> ParameterEntityRef -> Bool
$c/= :: ParameterEntityRef -> ParameterEntityRef -> Bool
== :: ParameterEntityRef -> ParameterEntityRef -> Bool
$c== :: ParameterEntityRef -> ParameterEntityRef -> Bool
Eq, Eq ParameterEntityRef
Eq ParameterEntityRef
-> (ParameterEntityRef -> ParameterEntityRef -> Ordering)
-> (ParameterEntityRef -> ParameterEntityRef -> Bool)
-> (ParameterEntityRef -> ParameterEntityRef -> Bool)
-> (ParameterEntityRef -> ParameterEntityRef -> Bool)
-> (ParameterEntityRef -> ParameterEntityRef -> Bool)
-> (ParameterEntityRef -> ParameterEntityRef -> ParameterEntityRef)
-> (ParameterEntityRef -> ParameterEntityRef -> ParameterEntityRef)
-> Ord ParameterEntityRef
ParameterEntityRef -> ParameterEntityRef -> Bool
ParameterEntityRef -> ParameterEntityRef -> Ordering
ParameterEntityRef -> ParameterEntityRef -> ParameterEntityRef
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 :: ParameterEntityRef -> ParameterEntityRef -> ParameterEntityRef
$cmin :: ParameterEntityRef -> ParameterEntityRef -> ParameterEntityRef
max :: ParameterEntityRef -> ParameterEntityRef -> ParameterEntityRef
$cmax :: ParameterEntityRef -> ParameterEntityRef -> ParameterEntityRef
>= :: ParameterEntityRef -> ParameterEntityRef -> Bool
$c>= :: ParameterEntityRef -> ParameterEntityRef -> Bool
> :: ParameterEntityRef -> ParameterEntityRef -> Bool
$c> :: ParameterEntityRef -> ParameterEntityRef -> Bool
<= :: ParameterEntityRef -> ParameterEntityRef -> Bool
$c<= :: ParameterEntityRef -> ParameterEntityRef -> Bool
< :: ParameterEntityRef -> ParameterEntityRef -> Bool
$c< :: ParameterEntityRef -> ParameterEntityRef -> Bool
compare :: ParameterEntityRef -> ParameterEntityRef -> Ordering
$ccompare :: ParameterEntityRef -> ParameterEntityRef -> Ordering
$cp1Ord :: Eq ParameterEntityRef
Ord, ReadPrec [ParameterEntityRef]
ReadPrec ParameterEntityRef
Int -> ReadS ParameterEntityRef
ReadS [ParameterEntityRef]
(Int -> ReadS ParameterEntityRef)
-> ReadS [ParameterEntityRef]
-> ReadPrec ParameterEntityRef
-> ReadPrec [ParameterEntityRef]
-> Read ParameterEntityRef
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ParameterEntityRef]
$creadListPrec :: ReadPrec [ParameterEntityRef]
readPrec :: ReadPrec ParameterEntityRef
$creadPrec :: ReadPrec ParameterEntityRef
readList :: ReadS [ParameterEntityRef]
$creadList :: ReadS [ParameterEntityRef]
readsPrec :: Int -> ReadS ParameterEntityRef
$creadsPrec :: Int -> ReadS ParameterEntityRef
Read, Int -> ParameterEntityRef -> ShowS
[ParameterEntityRef] -> ShowS
ParameterEntityRef -> String
(Int -> ParameterEntityRef -> ShowS)
-> (ParameterEntityRef -> String)
-> ([ParameterEntityRef] -> ShowS)
-> Show ParameterEntityRef
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ParameterEntityRef] -> ShowS
$cshowList :: [ParameterEntityRef] -> ShowS
show :: ParameterEntityRef -> String
$cshow :: ParameterEntityRef -> String
showsPrec :: Int -> ParameterEntityRef -> ShowS
$cshowsPrec :: Int -> ParameterEntityRef -> ShowS
Show)

-- | @<!ENTITY@
tokenEntityOpen :: CharParsing m => m ()
tokenEntityOpen :: m ()
tokenEntityOpen = m String -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m String -> m ()) -> m String -> m ()
forall a b. (a -> b) -> a -> b
$ String -> m String
forall (m :: * -> *). CharParsing m => String -> m String
string String
"<!ENTITY"

-- | @<!ELEMENT@
tokenElementTypeOpen :: CharParsing m => m ()
tokenElementTypeOpen :: m ()
tokenElementTypeOpen = m String -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m String -> m ()) -> m String -> m ()
forall a b. (a -> b) -> a -> b
$ String -> m String
forall (m :: * -> *). CharParsing m => String -> m String
string String
"<!ELEMENT"

-- | @EMPTY@
tokenElementTypeContentEmpty :: CharParsing m => m ()
tokenElementTypeContentEmpty :: m ()
tokenElementTypeContentEmpty = m String -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m String -> m ()) -> m String -> m ()
forall a b. (a -> b) -> a -> b
$ String -> m String
forall (m :: * -> *). CharParsing m => String -> m String
string String
"EMPTY"

-- | @ANY@
tokenElementTypeContentAny :: CharParsing m => m ()
tokenElementTypeContentAny :: m ()
tokenElementTypeContentAny = m String -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m String -> m ()) -> m String -> m ()
forall a b. (a -> b) -> a -> b
$ String -> m String
forall (m :: * -> *). CharParsing m => String -> m String
string String
"ANY"

-- | @<!ATTLIST@
tokenAttributeListOpen :: CharParsing m => m ()
tokenAttributeListOpen :: m ()
tokenAttributeListOpen = m String -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m String -> m ()) -> m String -> m ()
forall a b. (a -> b) -> a -> b
$ String -> m String
forall (m :: * -> *). CharParsing m => String -> m String
string String
"<!ATTLIST"

-- | @%@
tokenPercent :: CharParsing m => m ()
tokenPercent :: m ()
tokenPercent = m Char -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m Char -> m ()) -> m Char -> m ()
forall a b. (a -> b) -> a -> b
$ Char -> m Char
forall (m :: * -> *). CharParsing m => Char -> m Char
char Char
'%'

-- | @<!NOTATION@
tokenNotationOpen :: CharParsing m => m ()
tokenNotationOpen :: m ()
tokenNotationOpen = m String -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m String -> m ()) -> m String -> m ()
forall a b. (a -> b) -> a -> b
$ String -> m String
forall (m :: * -> *). CharParsing m => String -> m String
string String
"<!NOTATION"

-- | @PUBLIC@
tokenPublic :: CharParsing m => m ()
tokenPublic :: m ()
tokenPublic = m String -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m String -> m ()) -> m String -> m ()
forall a b. (a -> b) -> a -> b
$ String -> m String
forall (m :: * -> *). CharParsing m => String -> m String
string String
"PUBLIC"

-- | <https://www.w3.org/TR/REC-xml/#NT-PEReference>
--
-- >>> parseOnly tokenParameterEntityRef "%foo;"
-- Right (ParameterEntityRef "foo")
tokenParameterEntityRef :: CharParsing m => Monad m => m ParameterEntityRef
tokenParameterEntityRef :: m ParameterEntityRef
tokenParameterEntityRef = Text -> ParameterEntityRef
ParameterEntityRef (Text -> ParameterEntityRef) -> m Text -> m ParameterEntityRef
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> m Char
forall (m :: * -> *). CharParsing m => Char -> m Char
char Char
'%' m Char -> m Text -> m Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> m Text
forall (m :: * -> *). (CharParsing m, Monad m) => m Text
tokenName 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
';')

-- | <https://www.w3.org/TR/REC-xml/#NT-EntityValue>
tokenEntityValue :: CharParsing m => Monad m => String -> m EntityValue
tokenEntityValue :: String -> m EntityValue
tokenEntityValue String
forbiddenChars = (Text -> EntityValue
ValueText (Text -> EntityValue) -> (String -> Text) -> String -> EntityValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack (String -> EntityValue) -> m String -> m EntityValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Char -> m String
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some (String -> m Char
forall (m :: * -> *). CharParsing m => String -> m Char
noneOf (String -> m Char) -> String -> m Char
forall a b. (a -> b) -> a -> b
$ Char
'%'Char -> ShowS
forall a. a -> [a] -> [a]
:Char
'&'Char -> ShowS
forall a. a -> [a] -> [a]
:String
forbiddenChars))
  m EntityValue -> m EntityValue -> m EntityValue
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (ParameterEntityRef -> EntityValue
ValueParameterEntityRef (ParameterEntityRef -> EntityValue)
-> m ParameterEntityRef -> m EntityValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m ParameterEntityRef
forall (m :: * -> *).
(CharParsing m, Monad m) =>
m ParameterEntityRef
tokenParameterEntityRef)
  m EntityValue -> m EntityValue -> m EntityValue
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Reference -> EntityValue
ValueReference (Reference -> EntityValue) -> m Reference -> m EntityValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Reference
forall (m :: * -> *). (CharParsing m, Monad m) => m Reference
tokenReference)