-- ------------------------------------------------------------

{- |
   Module     : Text.XML.HXT.Parser.XmlDTDTokenParser
   Copyright  : Copyright (C) 2005 Uwe Schmidt
   License    : MIT

   Maintainer : Uwe Schmidt (uwe@fh-wedel.de)
   Stability  : experimental
   Portability: portable

   Parsec parser for tokenizing DTD declarations for ELEMENT, ATTLIST, ENTITY and NOTATION

-}

-- ------------------------------------------------------------

module Text.XML.HXT.Parser.XmlDTDTokenParser where

import           Text.ParserCombinators.Parsec

import           Text.XML.HXT.DOM.Interface
import           Text.XML.HXT.DOM.XmlNode               ( mkDTDElem'
                                                        , mkText'
                                                        )
import qualified Text.XML.HXT.Parser.XmlTokenParser     as XT
import           Text.XML.HXT.Parser.XmlCharParser      ( XParser )

-- ------------------------------------------------------------
--
-- DTD declaration tokenizer

dtdDeclTokenizer        :: XParser s XmlTree
dtdDeclTokenizer :: XParser s XmlTree
dtdDeclTokenizer
    = do
      (DTDElem
dcl, Attributes
al) <- XParser s (DTDElem, Attributes)
forall s. XParser s (DTDElem, Attributes)
dtdDeclStart
      [XmlTree]
content <- XParser s XmlTree -> ParsecT [Char] (XPState s) Identity [XmlTree]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 XParser s XmlTree
forall s. XParser s XmlTree
dtdToken
      XParser s ()
forall s. XParser s ()
dtdDeclEnd
      XmlTree -> XParser s XmlTree
forall (m :: * -> *) a. Monad m => a -> m a
return (XmlTree -> XParser s XmlTree) -> XmlTree -> XParser s XmlTree
forall a b. (a -> b) -> a -> b
$ DTDElem -> Attributes -> [XmlTree] -> XmlTree
mkDTDElem' DTDElem
dcl Attributes
al [XmlTree]
content

dtdDeclStart :: XParser s (DTDElem, Attributes)
dtdDeclStart :: XParser s (DTDElem, Attributes)
dtdDeclStart
    = (XParser s (DTDElem, Attributes)
 -> XParser s (DTDElem, Attributes)
 -> XParser s (DTDElem, Attributes))
-> [XParser s (DTDElem, Attributes)]
-> XParser s (DTDElem, Attributes)
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 XParser s (DTDElem, Attributes)
-> XParser s (DTDElem, Attributes)
-> XParser s (DTDElem, Attributes)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
(<|>) ([XParser s (DTDElem, Attributes)]
 -> XParser s (DTDElem, Attributes))
-> [XParser s (DTDElem, Attributes)]
-> XParser s (DTDElem, Attributes)
forall a b. (a -> b) -> a -> b
$
      (([Char], DTDElem) -> XParser s (DTDElem, Attributes))
-> [([Char], DTDElem)] -> [XParser s (DTDElem, Attributes)]
forall a b. (a -> b) -> [a] -> [b]
map (([Char] -> DTDElem -> XParser s (DTDElem, Attributes))
-> ([Char], DTDElem) -> XParser s (DTDElem, Attributes)
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry [Char] -> DTDElem -> XParser s (DTDElem, Attributes)
forall s. [Char] -> DTDElem -> XParser s (DTDElem, Attributes)
dtdStart) ([([Char], DTDElem)] -> [XParser s (DTDElem, Attributes)])
-> [([Char], DTDElem)] -> [XParser s (DTDElem, Attributes)]
forall a b. (a -> b) -> a -> b
$
              [ ([Char]
"ELEMENT",  DTDElem
ELEMENT )
              , ([Char]
"ATTLIST",  DTDElem
ATTLIST )
              , ([Char]
"ENTITY",   DTDElem
ENTITY  )
              , ([Char]
"NOTATION", DTDElem
NOTATION)
              ]
    where
    dtdStart    :: String -> DTDElem -> XParser s (DTDElem, Attributes)
    dtdStart :: [Char] -> DTDElem -> XParser s (DTDElem, Attributes)
dtdStart [Char]
dcl DTDElem
element
        = XParser s (DTDElem, Attributes) -> XParser s (DTDElem, Attributes)
forall tok st a. GenParser tok st a -> GenParser tok st a
try ( do
                [Char]
_ <- [Char] -> ParsecT [Char] (XPState s) Identity [Char]
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
"<!"
                [Char]
_ <- [Char] -> ParsecT [Char] (XPState s) Identity [Char]
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
dcl
                SourcePos
pos <- ParsecT [Char] (XPState s) Identity SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
                (DTDElem, Attributes) -> XParser s (DTDElem, Attributes)
forall (m :: * -> *) a. Monad m => a -> m a
return (DTDElem
element, [ ([Char]
a_source, SourcePos -> [Char]
sourceName SourcePos
pos)
                                 , ([Char]
a_line,   Line -> [Char]
forall a. Show a => a -> [Char]
show (SourcePos -> Line
sourceLine SourcePos
pos))
                                 , ([Char]
a_column, Line -> [Char]
forall a. Show a => a -> [Char]
show (SourcePos -> Line
sourceColumn SourcePos
pos))
                                 ]
                       )
              )

dtdDeclEnd      :: XParser s ()
dtdDeclEnd :: XParser s ()
dtdDeclEnd
    = do
      ()
_ <- XParser s ()
forall s. XParser s ()
XT.gt
      () -> XParser s ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

dtdToken        :: XParser s XmlTree
dtdToken :: XParser s XmlTree
dtdToken
    = XParser s XmlTree
forall s. XParser s XmlTree
dtdChars
      XParser s XmlTree -> XParser s XmlTree -> XParser s XmlTree
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
      XParser s XmlTree
forall s. XParser s XmlTree
entityValue
      XParser s XmlTree -> XParser s XmlTree -> XParser s XmlTree
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
      XParser s XmlTree -> XParser s XmlTree
forall tok st a. GenParser tok st a -> GenParser tok st a
try XParser s XmlTree
forall s. XParser s XmlTree
peReference           -- first try parameter entity ref %xxx;
      XParser s XmlTree -> XParser s XmlTree -> XParser s XmlTree
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
      XParser s XmlTree
forall s. XParser s XmlTree
percent                   -- else % may be indicator for parameter entity declaration
      XParser s XmlTree -> [Char] -> XParser s XmlTree
forall s u (m :: * -> *) a.
ParsecT s u m a -> [Char] -> ParsecT s u m a
<?> [Char]
"DTD token"

peReference     :: XParser s XmlTree
peReference :: XParser s XmlTree
peReference
    = do
      [Char]
r <- XParser s [Char]
forall s. XParser s [Char]
XT.peReference
      XmlTree -> XParser s XmlTree
forall (m :: * -> *) a. Monad m => a -> m a
return (XmlTree -> XParser s XmlTree) -> XmlTree -> XParser s XmlTree
forall a b. (a -> b) -> a -> b
$! (DTDElem -> Attributes -> [XmlTree] -> XmlTree
mkDTDElem' DTDElem
PEREF [([Char]
a_peref, [Char]
r)] [])

entityValue       :: XParser s XmlTree
entityValue :: XParser s XmlTree
entityValue
    = do
      [Char]
v <- XParser s [Char]
forall s. XParser s [Char]
XT.entityValue
      XmlTree -> XParser s XmlTree
forall (m :: * -> *) a. Monad m => a -> m a
return (XmlTree -> XParser s XmlTree) -> XmlTree -> XParser s XmlTree
forall a b. (a -> b) -> a -> b
$ [Char] -> XmlTree
mkText' [Char]
v

dtdChars        :: XParser s XmlTree
dtdChars :: XParser s XmlTree
dtdChars
    = do
      [Char]
v <- ParsecT [Char] (XPState s) Identity Char
-> ParsecT [Char] (XPState s) Identity [Char]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 ([Char] -> ParsecT [Char] (XPState s) Identity Char
forall s. [Char] -> XParser s Char
XT.singleChar [Char]
"%\"'<>[]")             -- everything except string constants, < and >, [ and ] (for cond sections)
      XmlTree -> XParser s XmlTree
forall (m :: * -> *) a. Monad m => a -> m a
return (XmlTree -> XParser s XmlTree) -> XmlTree -> XParser s XmlTree
forall a b. (a -> b) -> a -> b
$ [Char] -> XmlTree
mkText' [Char]
v                                -- all illegal chars will be detected later during declaration parsing

percent         :: XParser s XmlTree
percent :: XParser s XmlTree
percent
    = do
      Char
c <- Char -> ParsecT [Char] (XPState s) Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'%'
      XmlTree -> XParser s XmlTree
forall (m :: * -> *) a. Monad m => a -> m a
return (XmlTree -> XParser s XmlTree) -> XmlTree -> XParser s XmlTree
forall a b. (a -> b) -> a -> b
$ [Char] -> XmlTree
mkText' [Char
c]

-- ------------------------------------------------------------