content: -- ------------------------------------------------------------
  
  {- |
     Module     : Text.XML.HXT.Parser.DTDProcessing
     Copyright  : Copyright (C) 2005 Uwe Schmidt
     License    : MIT
  
     Maintainer : Uwe Schmidt (uwe@fh-wedel.de)
     Stability  : experimental
     Portability: portable
  
     DTD processing function for
     including external parts of a DTD
     parameter entity substitution and general entity substitution
  
  -}
  
  -- ------------------------------------------------------------
  
  module Text.XML.HXT.Parser.DTDProcessing
      ( getWellformedDoc
      , checkWellformedDoc
      , processDTD
      , processGeneralEntities
      )
  where
  
  import Text.XML.HXT.DOM.XmlTree
  
  import Text.XML.HXT.Parser.XmlOutput
      ( traceTree
      , traceSource
      , traceMsg
      )
  
  import Text.XML.HXT.Parser.XmlParser
      ( parseXmlDoc
      , parseXmlDTDPart
      , parseXmlAttrValue
      , parseXmlGeneralEntityValue
      )
  
  import Text.XML.HXT.Parser.XmlDTDParser
      ( parseXmlDTDdecl
      , parseXmlDTDdeclPart
      , parseXmlDTDEntityValue
      )
  
  import Text.XML.HXT.Parser.XmlInput
      ( getXmlContents
      , getXmlEntityContents
      , runInLocalURIContext
      , runInNewURIContext
      , getBaseURI
      , setBaseURI
      , getAbsolutURI
      , isStandaloneDocument
      )
  
  import Text.XML.HXT.DOM.EditFilters
      ( transfCharRef
      , transfAllCharRef
      )
  
  import Text.XML.HXT.DOM.XmlState
  
  import Data.Maybe
  
  import qualified Data.Map as M
      ( Map
      , empty
      , lookup
      , insert
      -- , foldWithKey
      )
  
  -- ------------------------------------------------------------
  --
  -- the "main" building blocks
  
  -- |
  -- monadic filter for reading, parsing and checking a wellformed document.
  -- the input tree must consist of a root node with a source attribute
  -- in its attribute list.
  --
  -- All attributes from the document root are copied into the system state,
  -- and may be queried by the monadic filters, e.g. trace options.
  --
  -- Result is the single element list containing the well-formed document tree
  -- or, in case of errors, the document root with an empty list as children
  -- and attributes 'a_status' and 'a_module' for error level and the module,
  -- where the error occured.
  --
  -- this is a shortcut for 'getXmlContents' .\>\> 'checkWellformedDoc'
  --
  -- example for a main program:
  --
  -- @
  -- main =
  --   run\' \$
  --   do
  --   res  \<- getWellformedDoc \$ newDocument \"myfile.xml\"
  --   ...
  -- @
  
  getWellformedDoc        :: XmlStateFilter state
  getWellformedDoc
      = setSystemParams
        .>>
        getXmlContents
        .>>
        checkWellformedDoc
  
  -- |
  -- parses a text node with 'parseXmlDoc', processes the DTD and general entities
  -- and transforms all char references into characters
  
  checkWellformedDoc              :: XmlStateFilter state
  checkWellformedDoc
      = parseXmlDoc
        .>>
        processDTD
        .>>
        processGeneralEntities
        .>>
        liftMf transfAllCharRef
  
  -- ------------------------------------------------------------
  --
  
  type RecList            = [String]
  
  type DTDState res       = XState PeEnv res
  
  type DTDStateFilter     = XmlTree -> DTDState XmlTrees
  
  data DTDPart            = Internal
                          | External
                            deriving (Eq)
  
  -- ------------------------------------------------------------
  
  type PeEnv              = M.Map String XmlTree
  
  emptyPeEnv      :: PeEnv
  emptyPeEnv      = M.empty
  
  lookupPeEnv     :: String -> PeEnv -> Maybe XmlTree
  lookupPeEnv     = M.lookup
  
  addPeEntry      :: String -> XmlTree -> PeEnv -> PeEnv
  addPeEntry      = M.insert
  
  -- ------------------------------------------------------------
  
  -- |
  -- a filter for DTD processing
  --
  -- inclusion of external parts of DTD,
  -- parameter entity substitution
  -- conditional section evaluation
  --
  -- input tree must represent a complete document including root node
  
  processDTD              :: XmlStateFilter a
  processDTD
      = runInLocalURIContext
           ( processRoot
             .>>
             traceTree
             .>>
             traceSource
           )
        `whenM` ( isRoot .> getChildren )
        where
  
        processRoot       :: XmlStateFilter a
        processRoot t
            = do
              sequence_ . map (\ (a, ts) -> setSysParamTree a ts) . toTreel . getAttrl $ t
              setSysParam a_standalone ""
              ( traceMsg 1 ("processDTD: process parameter entities")
                .>>
                liftMf (modifyChildren addDoctype)
                .>>
                processChildrenM substParamEntities
                .>>
                checkResult "in XML DTD processing"
                ) `whenM` statusOk
                $ t
  
        -- Adds an empty DOCTYPE node to document. Needed for documents without a DTD.
        -- Otherwise processor can not substitute predefined entities. If an xml declaration
        -- is present, the node is inserted after this node.
        addDoctype :: XmlSFilter
        addDoctype docChilds
            = if null doctype
              then if null xmlDecl
                   then [mkXDTDTree DOCTYPE [] []] ++ docChilds
                   else (head docChilds) : [mkXDTDTree DOCTYPE [] []] ++ (tail docChilds)
              else docChilds
              where
              doctype = isDoctype $$ docChilds
              xmlDecl = isPi t_xml $$ isXPi $$ docChilds
  
  
  substParamEntities      :: XmlStateFilter a
  substParamEntities
      = processParamEntities
        `whenM`
        isDoctype
        where
  
        processParamEntities      :: XmlStateFilter a
        processParamEntities t'
            = do
              (dtdPre, envPre) <- processPredef
  
              -- process internal part of DTD with initial empty env for parameter entities
              (dtdInt, envInt) <- processInt envPre t'
  
              -- process external part of DTD with resulting env from internal DTD
              dtdExt <- runInLocalURIContext (processExt envInt) t'
  
              -- merge predefined, internal and external part
              trace 2 "substParamEntities: merge internal and external DTD parts"
              return (replaceChildren (foldl1 mergeDTDs [dtdPre, dtdInt, dtdExt]) t')
  
        processPredef
            = do
              trace 2 "substParamEntities: substitute predefined entities"
              chain' emptyPeEnv (substParamEntity Internal $$< predefDTDPart)
  
        processInt env' n'
            = do
              trace 2 "substParamEntities: substitute parameter entities in internal DTD part"
              chain' env' (substParamEntity Internal $$< getChildren n')
  
        processExt env' n'
            = do
              trace 2 "substParamEntities: process external part of DTD"
              extDtd <- processExternalDTD n'
              trace 2 "substParamEntities: substitute parameter entities in external DTD part"
              chain env' ( (substParamEntity External) $$< extDtd)
  
  -- ------------------------------------------------------------
  -- |
  -- substitute parameter entities
  -- result is the input tree with the list of text nodes as children or an error message
  
  substPEref'     :: DTDPart -> PeEnv -> XmlFilter
  
  substPEref' loc env n@(NTree (XDTD PEREF al) _)
      | isInternalRef     = xerr ("a parameter entity reference of " ++ peName' ++ " occurs in the internal subset of the DTD")
  
      | isUndefinedRef    = xerr ("parameter entity " ++ peName' ++ " not found (forward reference?)")
  
      | null baseUri      = [setChildren peContent n]
  
      | otherwise         = [(NTree (XDTD PEREF ((a_url,baseUri):al)) peContent)]
      where
      peName              = lookup1 a_peref al
      peName'             = show peName
      peVal               = lookupPeEnv peName env
      isInternalRef       = loc == Internal
      isUndefinedRef      = isNothing peVal
  
      (NTree (XDTD PENTITY peAl) peContent) = fromJust peVal
      baseUri             = lookup1 a_url peAl
  
      -- peContent                = getChildren $ fromJust peVal
  
  substPEref' _ _ n
      = [n]
  
  -- ------------------------------------------------------------
  
  {-
  dumpPE  :: DTDStateFilter
  dumpPE t
      = do
        env <- getState
        ( traceMsg 2 ("dumpPE: parameter entity environment\n" ++ M.foldWithKey showPE "" env)
          .>>
          thisM ) t
      where
      showPE k v b = k ++ "\t" ++ show v ++ "\n" ++ b
  -}
  
  traceDTD        :: String -> XmlStateFilter a
  traceDTD msg    = traceMsg 4 msg .>> traceTree
  
  -- ------------------------------------------------------------
  
  getExternalParamEntityValue     :: DTDStateFilter
  getExternalParamEntityValue n@(NTree (XDTD PENTITY al) _cl)
      = do
        rl <- ( getXmlEntityContents
                .>>
                liftMf getChildren
              )
              $ newDocument' ((a_source, sysVal) : al)
        base <- getBaseURI
        if null rl
           then issueErr ("illegal external parameter entity value for entity %" ++ peName ++";") n
           else thisM (NTree (XDTD PENTITY ((a_url, base) : al)) rl)
      where
      sysVal = lookup1 k_system al
      peName = lookup1 a_name   al
  
  getExternalParamEntityValue n
      = error ("getExternalParamEntityValue: illegal argument: " ++ show n)
  
  -- ------------------------------------------------------------
  
  -- |
  -- the dtd parameter entity substitution filter
  
  substParamEntity        :: DTDPart -> DTDStateFilter
  
  substParamEntity loc n@(NTree xn _cs)
      | isDTDElemNode ENTITY xn                                   -- ENITITY and parameter ENTITY decl
          = traceDTD ("ENTITY declaration before DTD declaration parsing")
            .>>
            processChildrenM (substPeRefsInDTDdecl [])
            .>>
            liftF parseXmlDTDdecl
            .>>
            substRefsInEntityValue
            .>>
            processEntityDecl
            .>>
            traceDTD ("ENTITY declaration after DTD declaration parsing")
            $ n
  
      | isDTDElemNode PEREF xn                                    -- parameter entity ref in DTD
          = substPeRefsInDTDpart [] n
  
      | isDTDElemNode ELEMENT xn                                  -- ELEMENT, ATTLIST, NOTATION
        ||
        isDTDElemNode ATTLIST xn
        ||
        isDTDElemNode NOTATION xn
          = traceDTD  "DTD declaration before PE substitution"
            .>>
            processChildrenM (substPeRefsInDTDdecl [])
            .>>
            liftF parseXmlDTDdecl
            .>>
            traceDTD "DTD declaration after DTD declaration parsing"
            $ n
  
      | isDTDElemNode CONDSECT xn                                 -- conditional section
        &&
        loc == Internal
            = issueErr "conditional sections in internal part of the DTD is not allowed" n
              >> return []
  
      | isDTDElemNode CONDSECT xn                                 -- conditional section
        &&
        loc == External
            = let
              (XDTD _ al) = xn
              content     = mkXTextTree (lookup1 a_value al)
              in
              traceDTD "substParamEntity: process conditional section"
              .>>
              processChildrenM (substPeRefsInCondSect [])
              .>>
              liftF parseXmlDTDdecl
              .>>
              evalCond content
              $ n
  
      | isXCmtNode xn                                             -- remove comments
          = noneM n
  
      | otherwise                                                 -- default: keep things unchanged (should not occur)
          = thisM n
      where
  
      processEntityDecl   :: DTDStateFilter
      processEntityDecl n'@(NTree (XDTD ENTITY al) cs)    = if isExtern
            then ( do
                   url <- getAbsolutURI sysVal                    -- add the absolute URI
                   return [NTree (XDTD ENTITY ((a_url, url) : al)) cs]
                 )
            else liftMf (substChildren (xmlTreesToText . getChildren)) n'
          where
          isExtern = hasEntry k_system al
          sysVal   = lookup1  k_system al
  
      processEntityDecl n'@(NTree (XDTD PENTITY al) _)
          = do
            env <- getState
            if (isJust . lookupPeEnv peName) $ env
               then
               issueWarn ("parameter entity " ++ show peName ++ " already defined") n
               else
               ( ifM isExternalParameterEntity
                     ( runInLocalURIContext getExternalParamEntityValue )
                     ( liftMf (substChildren (xmlTreesToText . getChildren)) )
                 .>>
                 addPE peName
               ) n'
            where
            peName = lookup1 a_name al
  
      processEntityDecl n'
          = error ("processEntityDecl called with wrong argument" ++ show n')
  
      addPE       :: String -> DTDStateFilter
      addPE name t
          = do
            trace 2 ("substParamEntity: add entity to env: " ++ xshow [t])
            _ <- changeState $ addPeEntry name t
            return []
  
      substPEref  :: DTDStateFilter
      substPEref n'
          = do
            env <- getState
            liftF (substPEref' loc env) $ n'
  
      substPeRefsInValue  :: [String] -> DTDStateFilter
      substPeRefsInValue recList n'@(NTree (XDTD PEREF al) _cl)
          = ( if peName `elem` recList
              then issueErr ("recursive call of parameter entity " ++ show peName ++ " in entity value")
              else ( substPEref
                     .>>
                     liftF parseXmlDTDEntityValue
                     .>>
                     liftF transfCharRef
                     .>>
                     ( substPeRefsInValue (peName : recList)
                       `whenM`
                       isPeRef
                     )
                   )
            ) $ n'
          where
          peName = lookup1 a_peref al
  
      substPeRefsInValue _ n'
          = thisM n'
  
      substRefsInEntityValue      :: DTDStateFilter
      substRefsInEntityValue n'@(NTree (XDTD decl al) _cl)
          | decl `elem` [ENTITY, PENTITY]
              = ( if hasEntry k_system al
                  then thisM                                                      -- externals not yet handled ??? really
                  else processChildrenM ( liftF transfCharRef
                                          .>>
                                          substPeRefsInValue []
                                        )
                ) n'
      substRefsInEntityValue  n'
          = error ("substRefsInEntityValue called with wrong argument" ++ show n')
  
      runInPeContext      :: DTDStateFilter -> DTDStateFilter
      runInPeContext f n'@(NTree (XDTD PEREF al) _)
          | null base
              = f n'
          | otherwise
              = runInNewURIContext base f n'
          where
          base = lookup1 a_url al
  
      runInPeContext f n'
          = f n'
  
      substPeRefsInDTDdecl        :: [String] -> DTDStateFilter
      substPeRefsInDTDdecl recList n'@(NTree (XDTD PEREF al) _cl)
          = ( if peName `elem` recList
              then issueErr ("recursive call of parameter entity " ++ show peName ++ " in DTD declaration")
              else ( substPEref
                     .>>
                     traceDTD "substPeRefsInDTDdecl: parseXmlDTDdeclPart"
                     .>>
                     ( runInPeContext
                       ( liftF ( parseXmlDTDdeclPart )
                         .>>
                         traceDTD "substPeRefsInDTDdecl: after parseXmlDTDdeclPart"
                         .>>
                         processChildrenM ( substPeRefsInDTDdecl (peName : recList) )
                       )
                       `whenM`
                       isPeRef
                     )
                   )
            ) $ n'
          where
          peName = lookup1 a_peref al
  
      substPeRefsInDTDdecl _ n'
          = thisM n'
  
      substPeRefsInDTDpart        :: [String] -> DTDStateFilter
      substPeRefsInDTDpart recList n'@(NTree (XDTD PEREF al) _cl)
          = ( if peName `elem` recList
              then issueErr ("recursive call of parameter entity " ++ show peName ++ " in DTD part")
              else ( substPEref
                     .>>
                     traceDTD "substPeRefsInDTDpart: parseXmlDTDPart"
                     .>>
                     runInPeContext
                     ( liftF (getChildren .> parseXmlDTDPart ("parameter entity " ++ show peName))
                       .>>
                       traceDTD "substPeRefsInDTDdecl: after parseXmlDTDPart"
                       .>>
                       substParamEntity loc -- cyclic check not yet done (peName : recList)
                     )
                   )
            ) $ n'
          where
          peName = lookup1 a_peref al
  
      substPeRefsInDTDpart _ n'
          = thisM n'
  
      substPeRefsInCondSect       :: [String] -> DTDStateFilter
      substPeRefsInCondSect recList n'@(NTree (XDTD PEREF al) _cl)
          = ( if peName `elem` recList
              then issueErr ("recursive call of parameter entity " ++ show peName ++ " in conditional section")
              else ( substPEref
                     .>>
                     traceDTD "substPeRefsInCondSect: parseXmlDTDdeclPart"
                     .>>
                     ( runInPeContext
                       ( liftF ( parseXmlDTDdeclPart )
                         .>>
                         traceDTD "substPeRefsInCondSect: after parseXmlDTDdeclPart"
                         .>>
                         processChildrenM ( substPeRefsInCondSect (peName : recList) )
                       )
                       `whenM`
                       isPeRef
                     )
                   )
            ) $ n'
          where
          peName = lookup1 a_peref al
  
      substPeRefsInCondSect _ n'
          = thisM n'
  
  
  evalCond :: XmlTree -> DTDStateFilter
  evalCond content (NTree n _)
      | c == k_include
          = liftF (parseXmlDTDPart "conditional section")
            .>>
            traceDTD "evalCond: DTD part"
            .>>
            substParamEntity External
            $ content
      | otherwise
          = return []
      where
      c = textOfXNode n
  
  -- ------------------------------------------------------------
  
  processExternalDTD      :: XmlStateFilter a
  processExternalDTD n@(NTree (XDTD DOCTYPE al) _dtd)
      | null sysVal
          = return []
      | otherwise
          = do
            _ <- checkStandalone
            dtdContent <- ( getXmlEntityContents
                            .>>
                            traceMsg 2 ("processExternalDTD: parsing DTD part for " ++ show sysVal)
                            .>>
                            liftMf getChildren
                            .>>
                            liftF (parseXmlDTDPart sysVal)
                          )
                         $ newDocument sysVal
            trace 2 "processExternalDTD: parsing DTD part done"
            _ <- traceTree $ mkRootTree [] dtdContent
            return dtdContent
      where
      sysVal              = lookup1 k_system al
      checkStandalone     = do
                            _isAlone <- isStandaloneDocument
                            if False -- isAlone
                               then issueErr ("external DTD " ++ show sysVal ++ " specified for standalone document") n
                               else return []
  
  processExternalDTD  _
      = return []
  
  -- ------------------------------------------------------------
  -- |
  -- merge the external and the internal part of a DTD into one internal part.
  -- parameter entity substitution should be made before applying this filter
  -- internal definitions shadow external ones
  --
  --
  -- preliminary: no real merge is done
  
  mergeDTDs       :: XmlTrees -> XmlTrees -> XmlTrees
  mergeDTDs dtdInt dtdExt
      = dtdInt ++ (mergeDTDentry dtdInt $$ dtdExt)
  
  mergeDTDentry   :: XmlTrees -> XmlFilter
  mergeDTDentry dtdPart
      = none `when` found
        where
        filterList = map filterDTDNode dtdPart    -- construct the list of filters
        found      = cat filterList               -- concatenate the filters (set union)
  
  
  filterDTDNode   :: XmlTree -> XmlFilter
  
  filterDTDNode (NTree (XDTD dtdElem al) _)
      | dtdElem `elem` [ELEMENT, NOTATION, ENTITY]
          = filterElement
            where
            filterElement n@(NTree (XDTD dtdElem' al') _cl')
                | dtdElem == dtdElem' &&
                  lookup a_name al' == lookup a_name al
                    = [n]
                | otherwise
                    = []
            filterElement _
                = []
  
  filterDTDNode (NTree (XDTD ATTLIST al) _)
      = filterAttlist
        where
        filterAttlist n@(NTree (XDTD ATTLIST al') _cl')
            | lookup a_name  al' == lookup a_name  al &&
              lookup a_value al' == lookup a_value al
                  = [n]
        filterAttlist _
            = []
  
  filterDTDNode _
      =  none
  
  -- ------------------------------------------------------------
  
  predefinedEntities      :: String
  predefinedEntities
      = concat [ "<!ENTITY lt   '&#38;#60;'>"
               , "<!ENTITY gt   '&#62;'>"
               , "<!ENTITY amp  '&#38;#38;'>"
               , "<!ENTITY apos '&#39;'>"
               , "<!ENTITY quot '&#34;'>"
               ]
  
  predefDTDPart           :: XmlTrees
  predefDTDPart
      = parseXmlDTDPart "predefined entities" $ mkXTextTree predefinedEntities
  
  -- ------------------------------------------------------------
  --
  -- 4.4 XML Processor Treatment of General Entities and References
  
  data GeContext
      = ReferenceInContent
      | ReferenceInAttributeValue
      | ReferenceInEntityValue
      -- or OccursInAttributeValue                                -- not used during substitution but during validation
      -- or ReferenceInDTD                                        -- not used: syntax check detects errors
  
  type GeFct              = GeContext -> RecList -> GeStateFilter
  
  type GeState res        = XState GeEnv res
  
  type GeStateFilter      = XmlTree -> GeState XmlTrees
  
  -- ------------------------------------------------------------
  
  newtype GeEnv   = GeEnv (M.Map String GeFct)
  
  emptyGeEnv      :: GeEnv
  emptyGeEnv      = GeEnv M.empty
  
  lookupGeEnv             :: String -> GeEnv -> Maybe GeFct
  lookupGeEnv k (GeEnv env)
      = M.lookup k env
  
  addGeEntry      :: String -> GeFct -> GeEnv -> GeEnv
  addGeEntry k a (GeEnv env)
      = GeEnv $ M.insert k a env
  
  -- ------------------------------------------------------------
  
  -- |
  -- substitution of general entities
  --
  -- input: a complete document tree including root node
  
  processGeneralEntities  :: XmlStateFilter a
  processGeneralEntities
      = ( traceMsg 1 "processGeneralEntities: collect and substitute general entities"
          .>>
          processEntities
          .>>
          checkResult "in general entity processing"
          .>>
          traceTree
          .>>
          traceSource
        )
        `whenM` statusOk
        where
        processEntities t'
            = do
              res <- chain initialEnv (processGeneralEntity ReferenceInContent [] $$< getChildren t')
              return $ replaceChildren res t'
              where
              initialEnv = emptyGeEnv
  
  -- ------------------------------------------------------------
  
  processGeneralEntity    :: GeContext -> RecList -> GeStateFilter
  processGeneralEntity cx rl n@(NTree (XDTD DOCTYPE _) dtdPart)
      = do
        res <- processGeneralEntity cx rl $$< dtdPart
        return $ replaceChildren res n
  
  processGeneralEntity cx rl n@(NTree (XDTD ENTITY al) cl)
      | isIntern
          = do
            trace 2 ("processGeneralEnity: general entity definition for " ++ show name)
            value <- liftF (parseXmlGeneralEntityValue ("general internal entity " ++ show name)) $ mkXTextTree (xshow cl)
            res   <- processGeneralEntity ReferenceInEntityValue (name:rl) $$< value
            insertEntity name (substInternal res)
      | isExtern
          = do
            baseUri <- getBaseURI
            insertEntity name (substExternalParsed1Time baseUri)
  
      | isUnparsed
          = do
            trace 2 ("processGeneralEnity: unparsed entity definition for " ++ show name)
            insertEntity name (substUnparsed [])
      where
      isUnparsed  = not isIntern && not isExtern
      isExtern    = not isIntern && not (hasEntry k_ndata al)
      isIntern    = not (hasEntry k_system al)
  
      name        = lookup1 a_name   al
      -- sysVal   = lookup1 k_system al
      url         = lookup1 a_url    al           -- a_url contains absolut url for k_system
      context     = addEntry a_source url al
  
      processExternalEntityContents       :: XmlTrees -> GeState XmlTrees
      processExternalEntityContents cl'
          | null cl'                                              -- reading content did not succeed
              = return []
          | null txt'                                             -- something weird in entity content
              = do
                _ <- issueErr ("illegal external parsed entity value for entity " ++ show name) n
                return []
          | otherwise                                             -- o.k.: parse the contents
              = do
                res' <- liftF (parseXmlGeneralEntityValue ("external parsed entity " ++ show name)) $$< txt'
                _ <- ( traceSource
                       .>>
                       traceTree ) $ mkRootTree (fromAttrl context) res'
                return res'
          where
          txt' = (getChildren .> isXText) $$ cl'
  
      insertEntity        :: String -> GeFct -> GeState XmlTrees
      insertEntity name' fct'
          = do
            geEnv' <- getState
            case lookupGeEnv name' geEnv' of
              Just _fct
                  -> do
                     _ <- issueWarn ("entity " ++ show name ++ " already defined, repeated definition ignored") n
                     return []
              Nothing
                  -> do
                     _ <- changeState $ addGeEntry name' fct'
                     return $ this n
  
      -- --------
      --
      -- 4.4 XML Processor Treatment of Entities and References
  
      substInternal       :: XmlTrees -> GeContext -> RecList -> GeStateFilter
      substInternal nl ReferenceInContent rl' _n'
          = included nl rl'
  
      substInternal nl ReferenceInAttributeValue rl' _n'
          = includedInLiteral nl rl'
  
      substInternal _nl ReferenceInEntityValue _rl n'
          = bypassed n'
  
      -- --------
  
      substExternalParsed1Time    :: String -> GeContext -> RecList -> GeStateFilter
      substExternalParsed1Time baseUri' cx' rl' n'
          = do
            trace 2 ("substExternalParsed1Time: read and parse external parsed entity " ++ show name)
            res  <- runInLocalURIContext getContents' $ newDocument' context
            _ <- changeState $ addGeEntry name (substExternalParsed res)
            substExternalParsed res cx' rl' n'
            where
            getContents'  :: GeStateFilter
            getContents' t''
                = do
                  setBaseURI baseUri'
                  rs' <- getXmlEntityContents t''
                  processExternalEntityContents rs'
  
  
      substExternalParsed :: XmlTrees -> GeContext -> RecList -> GeStateFilter
      substExternalParsed  nl ReferenceInContent rl' _n'
          = includedIfValidating nl rl'
  
      substExternalParsed _nl ReferenceInAttributeValue _rl _n'
          = forbidden "external parsed general" "in attribute value"
  
      substExternalParsed _nl ReferenceInEntityValue _rl n'
          = bypassed n'
  
      -- --------
  
      substUnparsed       :: XmlTrees -> GeContext -> RecList -> GeStateFilter
      substUnparsed _nl ReferenceInContent _rl _n'
          = forbidden "unparsed" "content"
      substUnparsed _nl ReferenceInAttributeValue _rl _n'
          = forbidden "unparsed" "attribute value"
      substUnparsed _nl ReferenceInEntityValue _rl _n'
          = forbidden "unparsed" "entity value"
  
      -- --------
                                                          -- see XML 1.0 chapter:
  
      included nl rl'                                     -- 4.4.2
          = processGeneralEntity cx (name:rl') $$< nl
  
      includedIfValidating                                -- 4.4.3
          = included
  
      includedInLiteral                                   -- 4.4.5
          = included
  
      bypassed n'                                         -- 4.4.7
          = return $ this n'
  
      forbidden msg' cx'                                  -- 4.4.4
          = do
            _ <- issueErr ("reference of " ++ msg' ++ show name ++ " forbidden in " ++ cx') n
            return []
  
                                                          -- normalize default value in ATTLIST
  processGeneralEntity _cx rl n@(NTree (XDTD ATTLIST al) _cl)
      | hasDefaultValue
          = do
            res <- ( liftF (parseXmlAttrValue "default value of attribute ")
                     .>>
                     substGeneralEntityInAValue rl
                   ) $ mkXTextTree defaultValue
            return $ addDTDAttr a_default (xshow res) n
      | otherwise
          = return $ this n
      where
      hasDefaultValue = hasEntry  a_default al
      defaultValue    = lookup1   a_default al
  
  processGeneralEntity cx rl n@(NTree (XEntityRef name) _)
      = do
        trace 2 ("processGeneralEnity: entity reference for entity " ++ show name)
        trace 3 ("recursion list = " ++ show rl)
        geEnv <- getState
        case lookupGeEnv name geEnv of
          Just fct
            -> if name `elem` rl
               then do
                    _ <- issueErr ("recursive substitution of general entity reference " ++ show ref ++ " not processed") n
                    return nl
               else do
                    fct cx rl n
          Nothing
            -> do
               _ <- issueErr ("general entity reference " ++ show ref ++ " not processed, no definition found, (forward reference?)") n
               return nl
        where
        nl  = this n
        ref = xshow nl
  
  
  processGeneralEntity cx rl n@(NTree (XTag _tagName al) cl)
      = do
        al' <- substGeneralEntityInAttr rl $$< al
        cl' <- processGeneralEntity cx rl  $$< cl
        return $ (replaceAttrl al' .> replaceChildren cl') n
  
  processGeneralEntity _cx _rl n
      = return $ this n
  
  -- ------------------------------------------------------------
  
  substGeneralEntityInAttr        :: RecList -> XmlTree -> GeState XmlTrees
  substGeneralEntityInAttr rl a@(NTree (XAttr _) aValue)
      = do
        nv <- substGeneralEntityInAValue rl $$< aValue
        return (replaceChildren nv a)
  
  substGeneralEntityInAttr _ _
      = return []
  
  substGeneralEntityInAValue      :: RecList -> GeStateFilter
  substGeneralEntityInAValue rl
      = ( processGeneralEntity ReferenceInAttributeValue rl
          `whenM`
          isXEntityRef
        )
        .>>
        liftMf ( ( modifyText normalizeWhiteSpace `when` isXText)
                .>
                (transfCharRef `when` isXCharRef)
              )
        where
        normalizeWhiteSpace
            = map ( \c -> if c `elem` "\n\t\r" then ' ' else c )
  
  -- ------------------------------------------------------------
  
  
  