-- | Document type declaration parsers.
--
-- <https://www.w3.org/TR/REC-xml/#dt-doctype>
--
-- All documentation examples assume the following setup:
--
-- > :set -XOverloadedStrings
-- > import Data.Attoparsec.ByteString
module Data.XML.Parser.Mid.Doctype
  ( Doctype(..)
  , doctype
  ) where

import           Control.Applicative
import           Data.Maybe
import           Data.Text                           (Text)
import qualified Data.Text                           as Text
import           Data.XML.InternalSubset.Parser.High
import           Data.XML.Parser.Low
import           Data.XML.Parser.Mid.ExternalID
import           Text.Parser.Char
import           Text.Parser.Combinators

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

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


-- | <https://www.w3.org/TR/REC-xml/#NT-doctypedecl>
--
-- >>> parseOnly doctype "<!DOCTYPE greeting SYSTEM 'hello.dtd'>"
-- Right (Doctype "greeting" (Just (SystemID "hello.dtd")) (InternalSubset {_elementTypes = [], _attributeLists = [], _generalEntities = [], _parameterEntities = [], _notations = [], _instructions = []}))
-- >>> parseOnly doctype "<!DOCTYPE foo [ <!ENTITY x '&lt;'> ]>"
-- Right (Doctype "foo" Nothing (InternalSubset {_elementTypes = [], _attributeLists = [], _generalEntities = [GeneralEntity "x" [ContentReference (EntityRef "lt")]], _parameterEntities = [], _notations = [], _instructions = []}))
doctype :: CharParsing m => Monad m => m Doctype
doctype :: m Doctype
doctype = do
  m ()
forall (m :: * -> *). CharParsing m => m ()
tokenDoctypeOpen
  m String
forall (m :: * -> *). CharParsing m => m String
tokenWhitespace
  Text
name <- m Text
forall (m :: * -> *). (CharParsing m, Monad m) => m Text
tokenName
  Maybe ExternalID
externalID <- m ExternalID -> m (Maybe ExternalID)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (m ExternalID -> m (Maybe ExternalID))
-> m ExternalID -> m (Maybe ExternalID)
forall a b. (a -> b) -> a -> b
$ m String
forall (m :: * -> *). CharParsing m => m String
tokenWhitespace m String -> m ExternalID -> m ExternalID
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> m ExternalID
forall (m :: * -> *). (CharParsing m, Monad m) => m ExternalID
externalID
  m String -> m (Maybe String)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional m String
forall (m :: * -> *). CharParsing m => m String
tokenWhitespace
  InternalSubset
entities <- InternalSubset -> Maybe InternalSubset -> InternalSubset
forall a. a -> Maybe a -> a
fromMaybe InternalSubset
emptyInternalSubset (Maybe InternalSubset -> InternalSubset)
-> m (Maybe InternalSubset) -> m InternalSubset
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m InternalSubset -> m (Maybe InternalSubset)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional
    (m (Maybe String) -> m Char -> m InternalSubset -> m InternalSubset
forall (m :: * -> *) bra ket a.
Applicative m =>
m bra -> m ket -> m a -> m a
between (Char -> m Char
forall (m :: * -> *). CharParsing m => Char -> m Char
char Char
'[' m Char -> m (Maybe String) -> m (Maybe String)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> m String -> m (Maybe String)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional m String
forall (m :: * -> *). CharParsing m => m String
tokenWhitespace) (m String -> m (Maybe String)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional m String
forall (m :: * -> *). CharParsing m => m String
tokenWhitespace m (Maybe String) -> m Char -> m Char
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> m Char
forall (m :: * -> *). CharParsing m => Char -> m Char
char Char
']')
      m InternalSubset
forall (m :: * -> *). (CharParsing m, Monad m) => m InternalSubset
internalSubset)
  m ()
forall (m :: * -> *). CharParsing m => m ()
tokenElementClose
  Doctype -> m Doctype
forall (m :: * -> *) a. Monad m => a -> m a
return (Doctype -> m Doctype) -> Doctype -> m Doctype
forall a b. (a -> b) -> a -> b
$ Text -> Maybe ExternalID -> InternalSubset -> Doctype
Doctype Text
name Maybe ExternalID
externalID InternalSubset
entities