-- |
-- interface to the HXT XML and DTD parsers
--
-- version: $Id: ParserInterface.hs,v 1.1 2006/05/01 18:56:24 hxml Exp $

module Text.XML.HXT.Arrow.ParserInterface
    ( module Text.XML.HXT.Arrow.ParserInterface )
where

import Control.Arrow
import Control.Arrow.ArrowList
import Control.Arrow.ArrowIf
import Control.Arrow.ArrowTree
import Control.Arrow.ListArrow

import Text.XML.HXT.Parser.XmlEntities  ( xmlEntities   )
import Text.XML.HXT.Parser.XhtmlEntities( xhtmlEntities )

import Text.XML.HXT.DOM.Interface
import Text.XML.HXT.Arrow.XmlArrow

import qualified Text.XML.HXT.Parser.TagSoup             as TS
import qualified Text.XML.HXT.Parser.HtmlParsec          as HP
import qualified Text.XML.HXT.Parser.XmlParsec           as XP
import qualified Text.XML.HXT.Parser.XmlDTDParser        as DP
import qualified Text.XML.HXT.DTDValidation.Validation   as VA

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

parseXmlDoc                     :: ArrowXml a => a (String, String) XmlTree
parseXmlDoc                     =  arr2L XP.parseXmlDocument

parseXmlDTDPart                 :: ArrowXml a => a (String, XmlTree) XmlTree
parseXmlDTDPart                 =  arr2L XP.parseXmlDTDPart

parseXmlContent                 :: ArrowXml a => a String XmlTree
parseXmlContent                 =  arrL XP.xread

parseXmlEntityEncodingSpec
  , parseXmlDocEncodingSpec
  , removeEncodingSpec          :: ArrowXml a => a XmlTree XmlTree

parseXmlDocEncodingSpec         =  arrL XP.parseXmlDocEncodingSpec
parseXmlEntityEncodingSpec      =  arrL XP.parseXmlEntityEncodingSpec

removeEncodingSpec              =  arrL XP.removeEncodingSpec

parseXmlDTDdeclPart             :: ArrowXml a => a XmlTree XmlTree
parseXmlDTDdeclPart             =  arrL DP.parseXmlDTDdeclPart

parseXmlDTDdecl                 :: ArrowXml a => a XmlTree XmlTree
parseXmlDTDdecl                 =  arrL DP.parseXmlDTDdecl

parseXmlDTDEntityValue          :: ArrowXml a => a XmlTree XmlTree
parseXmlDTDEntityValue          =  arrL DP.parseXmlDTDEntityValue

parseXmlAttrValue               :: ArrowXml a => String -> a XmlTree XmlTree
parseXmlAttrValue context       =  arrL (XP.parseXmlAttrValue context)

parseXmlGeneralEntityValue      :: ArrowXml a => String -> a XmlTree XmlTree
parseXmlGeneralEntityValue context
                                =  arrL (XP.parseXmlGeneralEntityValue context)

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

parseHtmlDoc                    :: ArrowList a => a (String, String) XmlTree
parseHtmlDoc                    = arr2L HP.parseHtmlDocument

parseHtmlContent                :: ArrowList a => a String XmlTree
parseHtmlContent                = arrL  HP.parseHtmlContent

parseHtmlTagSoup                :: ArrowList a => Bool -> Bool -> Bool -> Bool -> Bool -> a (String, String) XmlTree
parseHtmlTagSoup withNamespaces withWarnings preserveCmt removeWS asHtml
                                = arr2L (TS.parseHtmlTagSoup withNamespaces withWarnings preserveCmt removeWS asHtml)

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

validateDoc                     :: ArrowList a => a XmlTree XmlTree
validateDoc                     = fromLA ( VA.validate
                                           `when`
                                           VA.getDTDSubset      -- validate only when DTD decl is present
                                         )

transformDoc                    :: ArrowList a => a XmlTree XmlTree
transformDoc                    = fromLA VA.transform

-- old stuff
-- validateDoc                  = arrL VA.validate
-- transformDoc                 = arrL VA.transform

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

-- | substitution of all predefined XHTMT entities for none ASCII chars
--
-- This arrow recurses through a whole XML tree and substitutes all
-- entity refs within text nodes and attribute values by a text node
-- containing of a single char corresponding to this entity.
--
-- Unknown entity refs remain unchanged

substHtmlEntityRefs             :: ArrowList a => a XmlTree XmlTree
substHtmlEntityRefs             = substEntityRefs xhtmlEntities


-- | substitution of the five predefined XMT entities, works like 'substHtmlEntityRefs'

substXmlEntityRefs              :: ArrowList a => a XmlTree XmlTree
substXmlEntityRefs              = substEntityRefs xmlEntities

-- | the entity substitution arrow called from 'substXmlEntityRefs' and 'substHtmlEntityRefs'

substEntityRefs         :: ArrowList a => [(String, Int)] -> a XmlTree XmlTree
substEntityRefs entities
    = fromLA substEntities
    where
    substEntities               :: LA XmlTree XmlTree
    substEntities
        = choiceA
          [ isEntityRef :-> ( substEntity $< getEntityRef )
          , isElem      :-> ( processAttrl (processChildren substEntities)
                              >>>
                              processChildren substEntities
                            )
          , this        :-> this
          ]
        where
        substEntity en
            = case (lookup en entities) of
              Just i
                  -> txt [toEnum i]     -- constA i >>> mkCharRef
              Nothing
                  -> this


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