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

{- |
   Module     : Text.XML.HXT.Arrow.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

   Implemtation completely done with arrows

-}

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

module Text.XML.HXT.Arrow.DTDProcessing
    ( processDTD
    )
where

import Control.Arrow                            -- arrow classes
import Control.Arrow.ArrowList
import Control.Arrow.ArrowIf
import Control.Arrow.ArrowTree

import           Text.XML.HXT.DOM.Interface
import qualified Text.XML.HXT.DOM.XmlNode as XN

import Text.XML.HXT.Arrow.XmlArrow
import Text.XML.HXT.Arrow.XmlState

import Text.XML.HXT.Arrow.ParserInterface
    ( parseXmlDTDdecl
    , parseXmlDTDdeclPart
    , parseXmlDTDEntityValue
    , parseXmlDTDPart
    )

import Text.XML.HXT.Arrow.Edit
    ( transfCharRef
    )

import Text.XML.HXT.Arrow.DocumentInput
    ( getXmlEntityContents
    )

import Data.Maybe

import qualified Data.Map as M
    ( Map
    , empty
    , lookup
    , insert
    )

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

data DTDPart            = Internal
                        | External
                          deriving (DTDPart -> DTDPart -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DTDPart -> DTDPart -> Bool
$c/= :: DTDPart -> DTDPart -> Bool
== :: DTDPart -> DTDPart -> Bool
$c== :: DTDPart -> DTDPart -> Bool
Eq)

type RecList            = [String]

type DTDStateArrow b c  = IOStateArrow PEEnv b c

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

newtype PEEnv           = PEEnv (M.Map String XmlTree)

emptyPeEnv      :: PEEnv
emptyPeEnv :: PEEnv
emptyPeEnv      = Map String XmlTree -> PEEnv
PEEnv forall k a. Map k a
M.empty

lookupPeEnv     :: String -> PEEnv -> Maybe XmlTree
lookupPeEnv :: String -> PEEnv -> Maybe XmlTree
lookupPeEnv String
k (PEEnv Map String XmlTree
env)
    = forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup String
k Map String XmlTree
env

addPeEntry      :: String -> XmlTree -> PEEnv -> PEEnv
addPeEntry :: String -> XmlTree -> PEEnv -> PEEnv
addPeEntry String
k XmlTree
a (PEEnv Map String XmlTree
env)
    = Map String XmlTree -> PEEnv
PEEnv forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert String
k XmlTree
a Map String XmlTree
env

getPeValue      :: DTDStateArrow String XmlTree
getPeValue :: DTDStateArrow String XmlTree
getPeValue
    = (forall (a :: * -> * -> *) b. ArrowList a => a b b
this forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& forall s b. IOStateArrow s b s
getUserState)
      forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
      forall (a :: * -> * -> *) b c. ArrowList a => (b -> [c]) -> a b c
arrL (\ (String
n, PEEnv
env) -> forall a. Maybe a -> [a]
maybeToList forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> PEEnv -> Maybe XmlTree
lookupPeEnv String
n forall a b. (a -> b) -> a -> b
$ PEEnv
env)

addPe           :: String -> DTDStateArrow XmlTree XmlTree
addPe :: String -> DTDStateArrow XmlTree XmlTree
addPe String
n
    = forall s b. Int -> String -> IOStateArrow s b b
traceMsg Int
2 (String
"substParamEntity: add entity " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show String
n forall a. [a] -> [a] -> [a]
++ String
" to env")
      forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
      forall b s. (b -> s -> s) -> IOStateArrow s b b
changeUserState XmlTree -> PEEnv -> PEEnv
ins
    where
    ins :: XmlTree -> PEEnv -> PEEnv
ins XmlTree
t PEEnv
peEnv = String -> XmlTree -> PEEnv -> PEEnv
addPeEntry String
n XmlTree
t PEEnv
peEnv

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

-- |
-- 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              :: IOStateArrow s XmlTree XmlTree
processDTD :: forall s. IOStateArrow s XmlTree XmlTree
processDTD
    = forall s b c. IOStateArrow s b c -> IOStateArrow s b c
runInLocalURIContext
         ( forall s. IOStateArrow s XmlTree XmlTree
processRoot
           forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
           forall s. IOStateArrow s XmlTree XmlTree
traceTree
           forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
           forall s. IOStateArrow s XmlTree XmlTree
traceSource
         )
      forall (a :: * -> * -> *) b c. ArrowIf a => a b b -> a b c -> a b b
`when` ( forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isRoot forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b)
getChildren )
      where

      processRoot       :: IOStateArrow s XmlTree XmlTree
      processRoot :: forall s. IOStateArrow s XmlTree XmlTree
processRoot
          = ( forall s b. Int -> String -> IOStateArrow s b b
traceMsg Int
1 (String
"processDTD: process parameter entities")
              forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
              forall s b. String -> String -> IOStateArrow s b b
setSysAttrString String
a_standalone String
""
              forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
              forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b) -> a (t b) (t b)
processChildren forall s. IOStateArrow s XmlTree XmlTree
substParamEntities
              forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
              forall s. String -> IOStateArrow s XmlTree XmlTree
setDocumentStatusFromSystemState String
"in XML DTD processing"
              forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
              forall s b. Int -> String -> IOStateArrow s b b
traceMsg Int
1 (String
"processDTD: parameter entities processed")
            )
            forall (a :: * -> * -> *) b c. ArrowIf a => a b b -> a b c -> a b b
`when`
            forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
documentStatusOk

substParamEntities      :: IOStateArrow s XmlTree XmlTree
substParamEntities :: forall s. IOStateArrow s XmlTree XmlTree
substParamEntities
    = forall s1 b c s0. s1 -> IOStateArrow s1 b c -> IOStateArrow s0 b c
withOtherUserState PEEnv
emptyPeEnv DTDStateArrow XmlTree XmlTree
processParamEntities
      forall (a :: * -> * -> *) b c. ArrowIf a => a b b -> a b c -> a b b
`when`
      forall (a :: * -> * -> *). ArrowDTD a => a XmlTree XmlTree
isDTDDoctype
      where

      processParamEntities      :: DTDStateArrow XmlTree XmlTree
      processParamEntities :: DTDStateArrow XmlTree XmlTree
processParamEntities
          = forall {a :: * -> * -> *}.
ArrowTree a =>
[XmlTree] -> [XmlTree] -> [XmlTree] -> a XmlTree XmlTree
mergeEntities forall (a :: * -> * -> *) c1 c2 c3 b d.
ArrowList a =>
(c1 -> c2 -> c3 -> a b d) -> a b (c1, (c2, c3)) -> a b d
$<<< ( forall (a :: * -> * -> *) b c. ArrowList a => a b c -> a b [c]
listA DTDStateArrow XmlTree XmlTree
processPredef
                                 forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&&
                                 forall (a :: * -> * -> *) b c. ArrowList a => a b c -> a b [c]
listA DTDStateArrow XmlTree XmlTree
processInt
                                 forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&&
                                 forall (a :: * -> * -> *) b c. ArrowList a => a b c -> a b [c]
listA (forall s b c. IOStateArrow s b c -> IOStateArrow s b c
runInLocalURIContext DTDStateArrow XmlTree XmlTree
processExt)
                               )
          where
          mergeEntities :: [XmlTree] -> [XmlTree] -> [XmlTree] -> a XmlTree XmlTree
mergeEntities [XmlTree]
dtdPre [XmlTree]
dtdInt [XmlTree]
dtdExt
              =  forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b) -> a (t b) (t b)
replaceChildren (forall (a :: * -> * -> *) b c. ArrowList a => (b -> [c]) -> a b c
arrL forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 [XmlTree] -> [XmlTree] -> [XmlTree]
mergeDTDs [[XmlTree]
dtdPre, [XmlTree]
dtdInt, [XmlTree]
dtdExt])

          processPredef :: DTDStateArrow XmlTree XmlTree
processPredef
              = DTDStateArrow XmlTree XmlTree
predefDTDPart   forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> DTDPart -> RecList -> DTDStateArrow XmlTree XmlTree
substParamEntity DTDPart
Internal []

          processInt :: DTDStateArrow XmlTree XmlTree
processInt
              = forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b)
getChildren     forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> DTDPart -> RecList -> DTDStateArrow XmlTree XmlTree
substParamEntity DTDPart
Internal []

          processExt :: DTDStateArrow XmlTree XmlTree
processExt
              = DTDStateArrow XmlTree XmlTree
externalDTDPart forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> DTDPart -> RecList -> DTDStateArrow XmlTree XmlTree
substParamEntity DTDPart
External []

          mergeDTDs     :: XmlTrees -> XmlTrees -> XmlTrees
          mergeDTDs :: [XmlTree] -> [XmlTree] -> [XmlTree]
mergeDTDs [XmlTree]
dtdInt [XmlTree]
dtdExt
              = [XmlTree]
dtdInt forall a. [a] -> [a] -> [a]
++ (forall a. (a -> Bool) -> [a] -> [a]
filter ([XmlTree] -> XmlTree -> Bool
filterDTDNodes [XmlTree]
dtdInt) [XmlTree]
dtdExt)

          filterDTDNodes        :: XmlTrees -> XmlTree -> Bool
          filterDTDNodes :: [XmlTree] -> XmlTree -> Bool
filterDTDNodes [XmlTree]
dtdPart XmlTree
t
              = Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (XmlTree -> XmlTree -> Bool
filterDTDNode XmlTree
t) [XmlTree]
dtdPart)

          filterDTDNode :: XmlTree -> XmlTree -> Bool

          filterDTDNode :: XmlTree -> XmlTree -> Bool
filterDTDNode XmlTree
t1 XmlTree
t2
              = forall a. a -> Maybe a -> a
fromMaybe Bool
False forall a b. (a -> b) -> a -> b
$
                do
                DTDElem
dp1 <- forall a. XmlNode a => a -> Maybe DTDElem
XN.getDTDPart XmlTree
t1
                DTDElem
dp2 <- forall a. XmlNode a => a -> Maybe DTDElem
XN.getDTDPart XmlTree
t2
                Attributes
al1 <- forall a. XmlNode a => a -> Maybe Attributes
XN.getDTDAttrl XmlTree
t1
                Attributes
al2 <- forall a. XmlNode a => a -> Maybe Attributes
XN.getDTDAttrl XmlTree
t2
                forall (m :: * -> *) a. Monad m => a -> m a
return ( DTDElem
dp1 forall a. Eq a => a -> a -> Bool
== DTDElem
dp2
                         Bool -> Bool -> Bool
&&
                         ( DTDElem
dp1 forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [DTDElem
ELEMENT, DTDElem
NOTATION, DTDElem
ENTITY, DTDElem
ATTLIST] )
                         Bool -> Bool -> Bool
&&
                         ( forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
a_name Attributes
al1 forall a. Eq a => a -> a -> Bool
== forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
a_name Attributes
al2 )
                         Bool -> Bool -> Bool
&&
                         ( DTDElem
dp1 forall a. Eq a => a -> a -> Bool
/= DTDElem
ATTLIST
                           Bool -> Bool -> Bool
||
                           forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
a_value Attributes
al1 forall a. Eq a => a -> a -> Bool
== forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
a_value Attributes
al2
                         )
                       )

substParamEntity        :: DTDPart -> RecList -> DTDStateArrow XmlTree XmlTree
substParamEntity :: DTDPart -> RecList -> DTDStateArrow XmlTree XmlTree
substParamEntity DTDPart
loc RecList
recList
    = forall (a :: * -> * -> *) b c d.
ArrowIf a =>
[IfThen (a b c) (a b d)] -> a b d
choiceA
      [ forall (a :: * -> * -> *). ArrowDTD a => a XmlTree XmlTree
isDTDEntity     forall a b. a -> b -> IfThen a b
:-> ( String -> DTDStateArrow XmlTree XmlTree
traceDTD String
"ENTITY declaration before DTD declaration parsing"
                              forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
                              forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b) -> a (t b) (t b)
processChildren (RecList -> DTDStateArrow XmlTree XmlTree
substPeRefsInDTDdecl RecList
recList)
                              forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
                              forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
parseXmlDTDdecl
                              forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
                              DTDStateArrow XmlTree XmlTree
substPeRefsInEntityValue
                              forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
                              String -> DTDStateArrow XmlTree XmlTree
traceDTD String
"ENTITY declaration after PE substitution"
                              forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
                              DTDStateArrow XmlTree XmlTree
processEntityDecl
                              forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
                              String -> DTDStateArrow XmlTree XmlTree
traceDTD String
"ENTITY declaration after DTD declaration parsing"
                            )
      , ( forall (a :: * -> * -> *). ArrowDTD a => a XmlTree XmlTree
isDTDElement
          forall (a :: * -> * -> *) b c.
ArrowPlus a =>
a b c -> a b c -> a b c
<+>
          forall (a :: * -> * -> *). ArrowDTD a => a XmlTree XmlTree
isDTDAttlist
          forall (a :: * -> * -> *) b c.
ArrowPlus a =>
a b c -> a b c -> a b c
<+>
          forall (a :: * -> * -> *). ArrowDTD a => a XmlTree XmlTree
isDTDNotation
        )               forall a b. a -> b -> IfThen a b
:-> ( String -> DTDStateArrow XmlTree XmlTree
traceDTD String
"DTD declaration before PE substitution"
                              forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
                              forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b) -> a (t b) (t b)
processChildren (RecList -> DTDStateArrow XmlTree XmlTree
substPeRefsInDTDdecl RecList
recList)
                              forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
                              forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
parseXmlDTDdecl
                              forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
                              String -> DTDStateArrow XmlTree XmlTree
traceDTD String
"DTD declaration after DTD declaration parsing"
                            )
      , forall (a :: * -> * -> *). ArrowDTD a => a XmlTree XmlTree
isDTDPERef      forall a b. a -> b -> IfThen a b
:-> RecList -> DTDStateArrow XmlTree XmlTree
substPeRefsInDTDpart RecList
recList

      , forall (a :: * -> * -> *). ArrowDTD a => a XmlTree XmlTree
isDTDCondSect   forall a b. a -> b -> IfThen a b
:-> ( if DTDPart
loc forall a. Eq a => a -> a -> Bool
== DTDPart
Internal
                              then forall s b. String -> IOStateArrow s b b
issueErr String
"conditional sections in internal part of the DTD is not allowed"
                              else String -> DTDStateArrow XmlTree XmlTree
evalCondSect forall (a :: * -> * -> *) c b d.
ArrowList a =>
(c -> a b d) -> a b c -> a b d
$< forall (a :: * -> * -> *). ArrowDTD a => String -> a XmlTree String
getDTDAttrValue String
a_value
                            )
      , forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isCmt           forall a b. a -> b -> IfThen a b
:-> forall (a :: * -> * -> *) b c. ArrowList a => a b c
none
      , forall (a :: * -> * -> *) b. ArrowList a => a b b
this            forall a b. a -> b -> IfThen a b
:-> forall (a :: * -> * -> *) b. ArrowList a => a b b
this
      ]
    where
    processEntityDecl           :: DTDStateArrow XmlTree XmlTree
    processEntityDecl :: DTDStateArrow XmlTree XmlTree
processEntityDecl
        = forall (a :: * -> * -> *) b c d.
ArrowIf a =>
[IfThen (a b c) (a b d)] -> a b d
choiceA
          [ forall (a :: * -> * -> *). ArrowDTD a => a XmlTree XmlTree
isDTDEntity forall a b. a -> b -> IfThen a b
:-> ( forall (a :: * -> * -> *) b c d.
ArrowIf a =>
a b c -> a b d -> a b d -> a b d
ifA (forall (a :: * -> * -> *).
ArrowDTD a =>
String -> a XmlTree XmlTree
hasDTDAttr String
k_system)
                              DTDStateArrow XmlTree XmlTree
processExternalEntity
                              DTDStateArrow XmlTree XmlTree
processInternalEntity
                            )
          , forall (a :: * -> * -> *). ArrowDTD a => a XmlTree XmlTree
isDTDPEntity
                        forall a b. a -> b -> IfThen a b
:-> ( String -> DTDStateArrow XmlTree XmlTree
processParamEntity forall (a :: * -> * -> *) c b d.
ArrowList a =>
(c -> a b d) -> a b c -> a b d
$< forall (a :: * -> * -> *). ArrowDTD a => String -> a XmlTree String
getDTDAttrValue String
a_name )
          , forall (a :: * -> * -> *) b. ArrowList a => a b b
this        forall a b. a -> b -> IfThen a b
:-> forall (a :: * -> * -> *) b c. ArrowList a => a b c
none
          ]
        where
        processExternalEntity   :: DTDStateArrow XmlTree XmlTree        -- processing external entities is delayed until first usage
        processExternalEntity :: DTDStateArrow XmlTree XmlTree
processExternalEntity                                           -- only the current base uri must be remembered
            = forall (a :: * -> * -> *).
ArrowDTD a =>
String -> String -> a XmlTree XmlTree
setDTDAttrValue String
a_url forall (a :: * -> * -> *) c b d.
ArrowList a =>
(c -> a b d) -> a b c -> a b d
$< ( forall (a :: * -> * -> *). ArrowDTD a => String -> a XmlTree String
getDTDAttrValue String
k_system forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall s. IOStateArrow s String String
mkAbsURI )

        processInternalEntity   :: DTDStateArrow XmlTree XmlTree
        processInternalEntity :: DTDStateArrow XmlTree XmlTree
processInternalEntity
            = forall (a :: * -> * -> *) b. ArrowList a => a b b
this                                                      -- everything is already done in substPeRefsInEntityValue

        processParamEntity      :: String -> DTDStateArrow XmlTree XmlTree
        processParamEntity :: String -> DTDStateArrow XmlTree XmlTree
processParamEntity String
peName
            = forall (a :: * -> * -> *) b c d.
ArrowIf a =>
a b c -> a b d -> a b d -> a b d
ifA (forall (a :: * -> * -> *) c b. ArrowList a => c -> a b c
constA String
peName forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> DTDStateArrow String XmlTree
getPeValue)
              ( forall s b. String -> IOStateArrow s b b
issueWarn (String
"parameter entity " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show String
peName forall a. [a] -> [a] -> [a]
++ String
" already defined")
                forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
                forall (a :: * -> * -> *) b c. ArrowList a => a b c
none                                                    -- second def must be ignored
              )
              ( ( forall (a :: * -> * -> *) b c d.
ArrowIf a =>
a b c -> a b d -> a b d -> a b d
ifA ( forall (a :: * -> * -> *).
ArrowDTD a =>
String -> a XmlTree XmlTree
hasDTDAttr String
k_system )                           -- is external param entity ?
                  ( forall (a :: * -> * -> *).
ArrowDTD a =>
String -> String -> a XmlTree XmlTree
setDTDAttrValue String
a_url forall (a :: * -> * -> *) c b d.
ArrowList a =>
(c -> a b d) -> a b c -> a b d
$<                            -- store absolut url
                    ( forall (a :: * -> * -> *). ArrowDTD a => String -> a XmlTree String
getDTDAttrValue String
k_system forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall s. IOStateArrow s String String
mkAbsURI )
                  )
                  -- this is too early, pe may be not referenced and file may be not there
                  -- ( runInLocalURIContext getExternalParamEntityValue )
                  ( forall (a :: * -> * -> *) b. ArrowList a => a b b
this )                                              -- everything is already done in substPeRefsInEntityValue
                )
                forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
                String -> DTDStateArrow XmlTree XmlTree
addPe String
peName
              )

    substPERef                  :: String -> DTDStateArrow XmlTree XmlTree
    substPERef :: String -> DTDStateArrow XmlTree XmlTree
substPERef String
pn
        = forall (a :: * -> * -> *) b c d.
ArrowIf a =>
[IfThen (a b c) (a b d)] -> a b d
choiceA
          [ forall {b}. IOSLA (XIOState PEEnv) b b
isUndefinedRef      forall a b. a -> b -> IfThen a b
:-> forall s b. String -> IOStateArrow s b b
issueErr (String
"parameter entity " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show String
pn forall a. [a] -> [a] -> [a]
++ String
" not found (forward reference?)")
          , forall {b} {c}. IOSLA (XIOState PEEnv) b c
isInternalRef       forall a b. a -> b -> IfThen a b
:-> forall s b. String -> IOStateArrow s b b
issueErr (String
"a parameter entity reference of " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show String
pn forall a. [a] -> [a] -> [a]
++ String
" occurs in the internal subset of the DTD")
          , forall {b}. IOSLA (XIOState PEEnv) b b
isUnreadExternalRef forall a b. a -> b -> IfThen a b
:-> ( forall (a :: * -> * -> *) b c. ArrowList a => a b c -> a b b
perform
                                      ( forall {a}. IOSLA (XIOState PEEnv) a XmlTree
peVal                           -- load the external pe value
                                        forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>                             -- update the pe env
                                        String -> DTDStateArrow XmlTree XmlTree
getExternalParamEntityValue String
pn  -- and try again
                                        forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
                                        String -> DTDStateArrow XmlTree XmlTree
addPe String
pn
                                      )
                                      forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
                                      String -> DTDStateArrow XmlTree XmlTree
substPERef String
pn
                                    )
          , forall (a :: * -> * -> *) b. ArrowList a => a b b
this                forall a b. a -> b -> IfThen a b
:-> DTDStateArrow XmlTree XmlTree
substPE
          ]
          forall (a :: * -> * -> *) b c. ArrowIf a => a b b -> a b c -> a b b
`when`
          forall (a :: * -> * -> *). ArrowDTD a => a XmlTree XmlTree
isDTDPERef
        where
        peVal :: IOSLA (XIOState PEEnv) a XmlTree
peVal                   = forall (a :: * -> * -> *) c b. ArrowList a => c -> a b c
constA String
pn forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> DTDStateArrow String XmlTree
getPeValue

        isUnreadExternalRef :: IOSLA (XIOState PEEnv) d d
isUnreadExternalRef     = ( forall {a}. IOSLA (XIOState PEEnv) a XmlTree
peVal
                                    forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
                                    forall (a :: * -> * -> *). ArrowDTD a => String -> a XmlTree String
getDTDAttrValue String
a_url
                                    forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
                                    forall (a :: * -> * -> *) b. ArrowList a => (b -> Bool) -> a b b
isA (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Bool
null)
                                  )
                                  forall (a :: * -> * -> *) b c d.
ArrowIf a =>
a b c -> a b d -> a b d
`guards`
                                  forall (a :: * -> * -> *) b. ArrowList a => a b b
this

        isInternalRef :: IOSLA (XIOState PEEnv) b c
isInternalRef   = forall (a :: * -> * -> *) b c. ArrowList a => a b c
none -- isA (const (loc == Internal))         -- TODO: check this restriction, it seams rather meaningless
        isUndefinedRef :: IOSLA (XIOState PEEnv) b b
isUndefinedRef  = forall (a :: * -> * -> *) b c. ArrowIf a => a b c -> a b b
neg forall {a}. IOSLA (XIOState PEEnv) a XmlTree
peVal
        substPE :: DTDStateArrow XmlTree XmlTree
substPE         = forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b) -> a (t b) (t b)
replaceChildren (forall {a}. IOSLA (XIOState PEEnv) a XmlTree
peVal forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b)
getChildren)       -- store PE value in children component

    substPeRefsInEntityValue      :: DTDStateArrow XmlTree XmlTree
    substPeRefsInEntityValue :: DTDStateArrow XmlTree XmlTree
substPeRefsInEntityValue
        = ( ( forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b) -> a (t b) (t b)
replaceChildren
              ( forall (a :: * -> * -> *) n.
ArrowXml a =>
a n XmlTree -> a n String
xshow ( forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b)
getChildren                                     -- substitute char entites
                        forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>                                             -- and parameter references
                        forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
transfCharRef                                   -- combine all pieces to a single string
                        forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>                                             -- as the new entity value
                        RecList -> DTDStateArrow XmlTree XmlTree
substPeRefsInValue []
                      )
                forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
                forall (a :: * -> * -> *). ArrowXml a => a String XmlTree
mkText
              )
            )
            forall (a :: * -> * -> *) b c. ArrowIf a => a b b -> a b c -> a b b
`whenNot`
            forall (a :: * -> * -> *).
ArrowDTD a =>
String -> a XmlTree XmlTree
hasDTDAttr String
k_system                                         -- only apply for internal entities
          )
          forall (a :: * -> * -> *) b c. ArrowIf a => a b b -> a b c -> a b b
`when`
          ( forall (a :: * -> * -> *). ArrowDTD a => a XmlTree XmlTree
isDTDEntity forall (a :: * -> * -> *) b c.
ArrowPlus a =>
a b c -> a b c -> a b c
<+> forall (a :: * -> * -> *). ArrowDTD a => a XmlTree XmlTree
isDTDPEntity )                              -- only apply for entity declarations

    substPeRefsInDTDpart        :: RecList -> DTDStateArrow XmlTree XmlTree
    substPeRefsInDTDpart :: RecList -> DTDStateArrow XmlTree XmlTree
substPeRefsInDTDpart RecList
rl
        = String
-> RecList
-> (RecList -> String -> DTDStateArrow XmlTree XmlTree)
-> DTDStateArrow XmlTree XmlTree
recursionCheck String
"DTD part" RecList
rl RecList -> String -> DTDStateArrow XmlTree XmlTree
subst
        where
        subst   :: RecList -> String -> DTDStateArrow XmlTree XmlTree
        subst :: RecList -> String -> DTDStateArrow XmlTree XmlTree
subst RecList
recl String
pn
            = String -> DTDStateArrow XmlTree XmlTree
substPERef String
pn
              forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
              String -> DTDStateArrow XmlTree XmlTree
traceDTD String
"substPeRefsInDTDdecl: before parseXmlDTDPart"
              forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
              ( DTDStateArrow XmlTree XmlTree -> DTDStateArrow XmlTree XmlTree
runInPeContext ( forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b)
getChildren
                                 forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
                                 ( (forall (a :: * -> * -> *) c b. ArrowList a => c -> a b c
constA (String
"parameter entity: " forall a. [a] -> [a] -> [a]
++ String
pn)) forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& forall (a :: * -> * -> *) b. ArrowList a => a b b
this )
                                 forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
                                 forall (a :: * -> * -> *).
ArrowXml a =>
a (String, XmlTree) XmlTree
parseXmlDTDPart
                                 forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
                                 String -> DTDStateArrow XmlTree XmlTree
traceDTD String
"substPeRefsInDTDpart: after parseXmlDTDPart"
                                 forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
                                 DTDPart -> RecList -> DTDStateArrow XmlTree XmlTree
substParamEntity DTDPart
loc (String
pn forall a. a -> [a] -> [a]
: RecList
recl)
                               )
                forall (a :: * -> * -> *) b c. ArrowIf a => a b b -> a b c -> a b b
`when`
                forall (a :: * -> * -> *). ArrowDTD a => a XmlTree XmlTree
isDTDPERef
              )

    substPeRefsInDTDdecl        :: RecList -> DTDStateArrow XmlTree XmlTree
    substPeRefsInDTDdecl :: RecList -> DTDStateArrow XmlTree XmlTree
substPeRefsInDTDdecl RecList
rl
        = String
-> RecList
-> (RecList -> String -> DTDStateArrow XmlTree XmlTree)
-> DTDStateArrow XmlTree XmlTree
recursionCheck String
"DTD declaration" RecList
rl RecList -> String -> DTDStateArrow XmlTree XmlTree
subst
        where
        subst   :: RecList -> String -> DTDStateArrow XmlTree XmlTree
        subst :: RecList -> String -> DTDStateArrow XmlTree XmlTree
subst RecList
recl String
pn
            = String -> DTDStateArrow XmlTree XmlTree
substPERef String
pn
              forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
              String -> DTDStateArrow XmlTree XmlTree
traceDTD String
"substPeRefsInDTDdecl: before parseXmlDTDdeclPart"
              forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
              ( DTDStateArrow XmlTree XmlTree -> DTDStateArrow XmlTree XmlTree
runInPeContext ( forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
parseXmlDTDdeclPart
                                 forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
                                 String -> DTDStateArrow XmlTree XmlTree
traceDTD String
"substPeRefsInDTDdecl: after parseXmlDTDdeclPart"
                                 forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
                                 forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b) -> a (t b) (t b)
processChildren ( RecList -> DTDStateArrow XmlTree XmlTree
substPeRefsInDTDdecl (String
pn forall a. a -> [a] -> [a]
: RecList
recl) )
                               )
                forall (a :: * -> * -> *) b c. ArrowIf a => a b b -> a b c -> a b b
`when`
                forall (a :: * -> * -> *). ArrowDTD a => a XmlTree XmlTree
isDTDPERef
              )

    substPeRefsInValue          :: RecList -> DTDStateArrow XmlTree XmlTree
    substPeRefsInValue :: RecList -> DTDStateArrow XmlTree XmlTree
substPeRefsInValue RecList
rl
        = String
-> RecList
-> (RecList -> String -> DTDStateArrow XmlTree XmlTree)
-> DTDStateArrow XmlTree XmlTree
recursionCheck String
"entity value" RecList
rl RecList -> String -> DTDStateArrow XmlTree XmlTree
subst
        where
        subst   :: RecList -> String -> DTDStateArrow XmlTree XmlTree
        subst :: RecList -> String -> DTDStateArrow XmlTree XmlTree
subst RecList
recl String
pn
            = String -> DTDStateArrow XmlTree XmlTree
substPERef String
pn
              forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
              forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
parseXmlDTDEntityValue
              forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
              -- transfCharRef             this must be done somewhere else
              -- >>>
              RecList -> DTDStateArrow XmlTree XmlTree
substPeRefsInValue (String
pn forall a. a -> [a] -> [a]
: RecList
recl)

    substPeRefsInCondSect       :: RecList -> DTDStateArrow XmlTree XmlTree
    substPeRefsInCondSect :: RecList -> DTDStateArrow XmlTree XmlTree
substPeRefsInCondSect RecList
rl
        = String
-> RecList
-> (RecList -> String -> DTDStateArrow XmlTree XmlTree)
-> DTDStateArrow XmlTree XmlTree
recursionCheck String
"conditional section" RecList
rl RecList -> String -> DTDStateArrow XmlTree XmlTree
subst
        where
        subst   :: RecList -> String -> DTDStateArrow XmlTree XmlTree
        subst :: RecList -> String -> DTDStateArrow XmlTree XmlTree
subst RecList
recl String
pn
            = String -> DTDStateArrow XmlTree XmlTree
substPERef String
pn
              forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
              String -> DTDStateArrow XmlTree XmlTree
traceDTD String
"substPeRefsInCondSect: parseXmlDTDdeclPart"
              forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
              DTDStateArrow XmlTree XmlTree -> DTDStateArrow XmlTree XmlTree
runInPeContext ( forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
parseXmlDTDdeclPart
                               forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
                               String -> DTDStateArrow XmlTree XmlTree
traceDTD String
"substPeRefsInCondSect: after parseXmlDTDdeclPart"
                               forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
                               forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b) -> a (t b) (t b)
processChildren ( RecList -> DTDStateArrow XmlTree XmlTree
substPeRefsInCondSect (String
pn forall a. a -> [a] -> [a]
: RecList
recl) )
                             )

    recursionCheck      :: String -> RecList -> (RecList -> String -> DTDStateArrow XmlTree XmlTree) -> DTDStateArrow XmlTree XmlTree
    recursionCheck :: String
-> RecList
-> (RecList -> String -> DTDStateArrow XmlTree XmlTree)
-> DTDStateArrow XmlTree XmlTree
recursionCheck String
wher RecList
rl RecList -> String -> DTDStateArrow XmlTree XmlTree
subst
        = ( String -> DTDStateArrow XmlTree XmlTree
recusiveSubst  forall (a :: * -> * -> *) c b d.
ArrowList a =>
(c -> a b d) -> a b c -> a b d
$< forall (a :: * -> * -> *). ArrowDTD a => String -> a XmlTree String
getDTDAttrValue String
a_peref )
          forall (a :: * -> * -> *) b c. ArrowIf a => a b b -> a b c -> a b b
`when`
          forall (a :: * -> * -> *). ArrowDTD a => a XmlTree XmlTree
isDTDPERef
        where
        recusiveSubst :: String -> DTDStateArrow XmlTree XmlTree
recusiveSubst String
name
            | String
name forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` RecList
rl
                = forall s b. String -> IOStateArrow s b b
issueErr (String
"recursive call of parameter entity " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show String
name forall a. [a] -> [a] -> [a]
++ String
" in " forall a. [a] -> [a] -> [a]
++ String
wher)
            | Bool
otherwise
                = RecList -> String -> DTDStateArrow XmlTree XmlTree
subst RecList
rl String
name

    runInPeContext      :: DTDStateArrow XmlTree XmlTree -> DTDStateArrow XmlTree XmlTree
    runInPeContext :: DTDStateArrow XmlTree XmlTree -> DTDStateArrow XmlTree XmlTree
runInPeContext DTDStateArrow XmlTree XmlTree
f
        = ( String -> DTDStateArrow XmlTree XmlTree
runWithNewBase forall (a :: * -> * -> *) c b d.
ArrowList a =>
(c -> a b d) -> a b c -> a b d
$< forall (a :: * -> * -> *). ArrowDTD a => String -> a XmlTree String
getDTDAttrValue String
a_url )
          forall (a :: * -> * -> *) b c. ArrowIf a => a b c -> a b c -> a b c
`orElse`
          DTDStateArrow XmlTree XmlTree
f
        where
        runWithNewBase :: String -> DTDStateArrow XmlTree XmlTree
runWithNewBase String
base
            = forall s b c. IOStateArrow s b c -> IOStateArrow s b c
runInLocalURIContext
              ( forall (a :: * -> * -> *) b c. ArrowList a => a b c -> a b b
perform (forall (a :: * -> * -> *) c b. ArrowList a => c -> a b c
constA String
base forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall s. IOStateArrow s String String
setBaseURI)
                forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
                DTDStateArrow XmlTree XmlTree
f
              )

    evalCondSect        :: String ->  DTDStateArrow XmlTree XmlTree
    evalCondSect :: String -> DTDStateArrow XmlTree XmlTree
evalCondSect String
content
        = String -> DTDStateArrow XmlTree XmlTree
traceDTD String
"evalCondSect: process conditional section"
          forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
          forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b) -> a (t b) (t b)
processChildren (RecList -> DTDStateArrow XmlTree XmlTree
substPeRefsInCondSect [])
          forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
          forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
parseXmlDTDdecl
          forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
          ( forall (a :: * -> * -> *).
ArrowXml a =>
(String -> Bool) -> a XmlTree XmlTree
hasText (forall a. Eq a => a -> a -> Bool
== String
k_include)
            forall (a :: * -> * -> *) b c d.
ArrowIf a =>
a b c -> a b d -> a b d
`guards`
            ( ( forall (a :: * -> * -> *) c b. ArrowList a => c -> a b c
constA String
"conditional section" forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& forall (a :: * -> * -> *) n. ArrowXml a => String -> a n XmlTree
txt String
content )
              forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
              forall (a :: * -> * -> *).
ArrowXml a =>
a (String, XmlTree) XmlTree
parseXmlDTDPart
              forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
              forall s b. Int -> String -> IOStateArrow s b b
traceMsg Int
2 String
"evalCond: include DTD part"
              forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
              DTDPart -> RecList -> DTDStateArrow XmlTree XmlTree
substParamEntity DTDPart
External RecList
recList
            )
          )

predefDTDPart           :: DTDStateArrow XmlTree XmlTree
predefDTDPart :: DTDStateArrow XmlTree XmlTree
predefDTDPart
    = ( forall (a :: * -> * -> *) c b. ArrowList a => c -> a b c
constA String
"predefined entities"
        forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&&
        ( forall (a :: * -> * -> *) c b. ArrowList a => c -> a b c
constA String
predefinedEntities forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall (a :: * -> * -> *). ArrowXml a => a String XmlTree
mkText)
      )
      forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
      forall (a :: * -> * -> *).
ArrowXml a =>
a (String, XmlTree) XmlTree
parseXmlDTDPart
    where
    predefinedEntities  :: String
    predefinedEntities :: String
predefinedEntities
        = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ String
"<!ENTITY lt   '&#38;#60;'>"
                 , String
"<!ENTITY gt   '&#62;'>"
                 , String
"<!ENTITY amp  '&#38;#38;'>"
                 , String
"<!ENTITY apos '&#39;'>"
                 , String
"<!ENTITY quot '&#34;'>"
                 ]

externalDTDPart         :: DTDStateArrow XmlTree XmlTree
externalDTDPart :: DTDStateArrow XmlTree XmlTree
externalDTDPart
    = forall (a :: * -> * -> *). ArrowDTD a => a XmlTree XmlTree
isDTDDoctype
      forall (a :: * -> * -> *) b c d.
ArrowIf a =>
a b c -> a b d -> a b d
`guards`
      ( forall (a :: * -> * -> *).
ArrowDTD a =>
String -> a XmlTree XmlTree
hasDTDAttr String
k_system
        forall (a :: * -> * -> *) b c d.
ArrowIf a =>
a b c -> a b d -> a b d
`guards`
        ( String -> DTDStateArrow XmlTree XmlTree
getExternalDTDPart forall (a :: * -> * -> *) c b d.
ArrowList a =>
(c -> a b d) -> a b c -> a b d
$< forall (a :: * -> * -> *). ArrowDTD a => String -> a XmlTree String
getDTDAttrValue String
k_system )
      )

getExternalDTDPart      :: String -> DTDStateArrow XmlTree XmlTree
getExternalDTDPart :: String -> DTDStateArrow XmlTree XmlTree
getExternalDTDPart String
src
    = forall (a :: * -> * -> *) n.
ArrowXml a =>
[a n XmlTree] -> [a n XmlTree] -> a n XmlTree
root [forall (a :: * -> * -> *) n.
ArrowXml a =>
String -> String -> a n XmlTree
sattr String
a_source String
src] []
      forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
      forall s. IOStateArrow s XmlTree XmlTree
getXmlEntityContents
      forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
      forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b) -> a (t b) (t b)
replaceChildren ( ( forall (a :: * -> * -> *) c b. ArrowList a => c -> a b c
constA String
src forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b)
getChildren )
                        forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
                        forall (a :: * -> * -> *).
ArrowXml a =>
a (String, XmlTree) XmlTree
parseXmlDTDPart
                      )
      forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
      forall s. String -> IOStateArrow s XmlTree XmlTree
traceDoc String
"processExternalDTD: parsing DTD part done"
      forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
      forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b)
getChildren

getExternalParamEntityValue     :: String -> DTDStateArrow XmlTree XmlTree
getExternalParamEntityValue :: String -> DTDStateArrow XmlTree XmlTree
getExternalParamEntityValue String
pn
    = forall (a :: * -> * -> *). ArrowDTD a => a XmlTree XmlTree
isDTDPEntity
      forall (a :: * -> * -> *) b c d.
ArrowIf a =>
a b c -> a b d -> a b d
`guards`
      ( [XmlTree] -> DTDStateArrow XmlTree XmlTree
setEntityValue forall (a :: * -> * -> *) c b d.
ArrowList a =>
(c -> a b d) -> a b c -> a b d
$< ( forall (a :: * -> * -> *) b c. ArrowList a => a b c -> a b [c]
listA ( String -> DTDStateArrow XmlTree XmlTree
getEntityValue forall (a :: * -> * -> *) c b d.
ArrowList a =>
(c -> a b d) -> a b c -> a b d
$< forall (a :: * -> * -> *). ArrowDTD a => String -> a XmlTree String
getDTDAttrValue String
a_url ) ) )
    where
    getEntityValue      :: String -> DTDStateArrow XmlTree XmlTree
    getEntityValue :: String -> DTDStateArrow XmlTree XmlTree
getEntityValue String
url
        = forall (a :: * -> * -> *) n.
ArrowXml a =>
[a n XmlTree] -> [a n XmlTree] -> a n XmlTree
root [forall (a :: * -> * -> *) n.
ArrowXml a =>
String -> String -> a n XmlTree
sattr String
a_source String
url] []
          forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
          forall s b c. IOStateArrow s b c -> IOStateArrow s b c
runInLocalURIContext forall s. IOStateArrow s XmlTree XmlTree
getXmlEntityContents
          forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
          forall s b. Int -> String -> IOStateArrow s b b
traceMsg Int
2 (String
"getExternalParamEntityValue: contents read for " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show String
pn forall a. [a] -> [a] -> [a]
++ String
" from " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show String
url)
          forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
          forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b)
getChildren

    setEntityValue      :: XmlTrees -> DTDStateArrow XmlTree XmlTree
    setEntityValue :: [XmlTree] -> DTDStateArrow XmlTree XmlTree
setEntityValue [XmlTree]
res
        | forall (t :: * -> *) a. Foldable t => t a -> Bool
null [XmlTree]
res
            = forall s b. String -> IOStateArrow s b b
issueErr (String
"illegal external parameter entity value for entity %" forall a. [a] -> [a] -> [a]
++ String
pn forall a. [a] -> [a] -> [a]
++String
";")
        | Bool
otherwise
            = forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b) -> a (t b) (t b)
replaceChildren (forall (a :: * -> * -> *) c b. ArrowList a => [c] -> a b c
constL [XmlTree]
res)
              forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
              forall (a :: * -> * -> *).
ArrowDTD a =>
String -> String -> a XmlTree XmlTree
setDTDAttrValue String
a_url String
""                          -- mark entity as read

traceDTD        :: String -> DTDStateArrow XmlTree XmlTree
traceDTD :: String -> DTDStateArrow XmlTree XmlTree
traceDTD String
msg    = forall s b. Int -> String -> IOStateArrow s b b
traceMsg Int
3 String
msg forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall s. IOStateArrow s XmlTree XmlTree
traceTree

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