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

{- |
   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
(DTDPart -> DTDPart -> Bool)
-> (DTDPart -> DTDPart -> Bool) -> Eq DTDPart
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 Map String XmlTree
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)
    = String -> Map String XmlTree -> Maybe XmlTree
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 (Map String XmlTree -> PEEnv) -> Map String XmlTree -> PEEnv
forall a b. (a -> b) -> a -> b
$ String -> XmlTree -> Map String XmlTree -> Map String XmlTree
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
    = (IOSLA (XIOState PEEnv) String String
forall (a :: * -> * -> *) b. ArrowList a => a b b
this IOSLA (XIOState PEEnv) String String
-> IOSLA (XIOState PEEnv) String PEEnv
-> IOSLA (XIOState PEEnv) String (String, PEEnv)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& IOSLA (XIOState PEEnv) String PEEnv
forall s b. IOStateArrow s b s
getUserState)
      IOSLA (XIOState PEEnv) String (String, PEEnv)
-> IOSLA (XIOState PEEnv) (String, PEEnv) XmlTree
-> DTDStateArrow String XmlTree
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
      ((String, PEEnv) -> [XmlTree])
-> IOSLA (XIOState PEEnv) (String, PEEnv) XmlTree
forall (a :: * -> * -> *) b c. ArrowList a => (b -> [c]) -> a b c
arrL (\ (String
n, PEEnv
env) -> Maybe XmlTree -> [XmlTree]
forall a. Maybe a -> [a]
maybeToList (Maybe XmlTree -> [XmlTree])
-> (PEEnv -> Maybe XmlTree) -> PEEnv -> [XmlTree]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> PEEnv -> Maybe XmlTree
lookupPeEnv String
n (PEEnv -> [XmlTree]) -> PEEnv -> [XmlTree]
forall a b. (a -> b) -> a -> b
$ PEEnv
env)

addPe           :: String -> DTDStateArrow XmlTree XmlTree
addPe :: String -> DTDStateArrow XmlTree XmlTree
addPe String
n
    = Int -> String -> DTDStateArrow XmlTree XmlTree
forall s b. Int -> String -> IOStateArrow s b b
traceMsg Int
2 (String
"substParamEntity: add entity " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" to env")
      DTDStateArrow XmlTree XmlTree
-> DTDStateArrow XmlTree XmlTree -> DTDStateArrow XmlTree XmlTree
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
      (XmlTree -> PEEnv -> PEEnv) -> DTDStateArrow XmlTree XmlTree
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 :: IOStateArrow s XmlTree XmlTree
processDTD
    = IOStateArrow s XmlTree XmlTree -> IOStateArrow s XmlTree XmlTree
forall s b c. IOStateArrow s b c -> IOStateArrow s b c
runInLocalURIContext
         ( IOStateArrow s XmlTree XmlTree
forall s. IOStateArrow s XmlTree XmlTree
processRoot
           IOStateArrow s XmlTree XmlTree
-> IOStateArrow s XmlTree XmlTree -> IOStateArrow s XmlTree XmlTree
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
           IOStateArrow s XmlTree XmlTree
forall s. IOStateArrow s XmlTree XmlTree
traceTree
           IOStateArrow s XmlTree XmlTree
-> IOStateArrow s XmlTree XmlTree -> IOStateArrow s XmlTree XmlTree
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
           IOStateArrow s XmlTree XmlTree
forall s. IOStateArrow s XmlTree XmlTree
traceSource
         )
      IOStateArrow s XmlTree XmlTree
-> IOStateArrow s XmlTree XmlTree -> IOStateArrow s XmlTree XmlTree
forall (a :: * -> * -> *) b c. ArrowIf a => a b b -> a b c -> a b b
`when` ( IOStateArrow s XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isRoot IOStateArrow s XmlTree XmlTree
-> IOStateArrow s XmlTree XmlTree -> IOStateArrow s XmlTree XmlTree
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> IOStateArrow s XmlTree XmlTree
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b)
getChildren )
      where

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

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

      processParamEntities      :: DTDStateArrow XmlTree XmlTree
      processParamEntities :: DTDStateArrow XmlTree XmlTree
processParamEntities
          = [XmlTree]
-> [XmlTree] -> [XmlTree] -> DTDStateArrow XmlTree XmlTree
forall (a :: * -> * -> *).
ArrowTree a =>
[XmlTree] -> [XmlTree] -> [XmlTree] -> a XmlTree XmlTree
mergeEntities ([XmlTree]
 -> [XmlTree] -> [XmlTree] -> DTDStateArrow XmlTree XmlTree)
-> IOSLA
     (XIOState PEEnv) XmlTree ([XmlTree], ([XmlTree], [XmlTree]))
-> DTDStateArrow XmlTree XmlTree
forall (a :: * -> * -> *) c1 c2 c3 b d.
ArrowList a =>
(c1 -> c2 -> c3 -> a b d) -> a b (c1, (c2, c3)) -> a b d
$<<< ( DTDStateArrow XmlTree XmlTree
-> IOSLA (XIOState PEEnv) XmlTree [XmlTree]
forall (a :: * -> * -> *) b c. ArrowList a => a b c -> a b [c]
listA DTDStateArrow XmlTree XmlTree
processPredef
                                 IOSLA (XIOState PEEnv) XmlTree [XmlTree]
-> IOSLA (XIOState PEEnv) XmlTree ([XmlTree], [XmlTree])
-> IOSLA
     (XIOState PEEnv) XmlTree ([XmlTree], ([XmlTree], [XmlTree]))
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&&
                                 DTDStateArrow XmlTree XmlTree
-> IOSLA (XIOState PEEnv) XmlTree [XmlTree]
forall (a :: * -> * -> *) b c. ArrowList a => a b c -> a b [c]
listA DTDStateArrow XmlTree XmlTree
processInt
                                 IOSLA (XIOState PEEnv) XmlTree [XmlTree]
-> IOSLA (XIOState PEEnv) XmlTree [XmlTree]
-> IOSLA (XIOState PEEnv) XmlTree ([XmlTree], [XmlTree])
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&&
                                 DTDStateArrow XmlTree XmlTree
-> IOSLA (XIOState PEEnv) XmlTree [XmlTree]
forall (a :: * -> * -> *) b c. ArrowList a => a b c -> a b [c]
listA (DTDStateArrow XmlTree XmlTree -> DTDStateArrow XmlTree XmlTree
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
              =  a XmlTree XmlTree -> a XmlTree XmlTree
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b) -> a (t b) (t b)
replaceChildren ((XmlTree -> [XmlTree]) -> a XmlTree XmlTree
forall (a :: * -> * -> *) b c. ArrowList a => (b -> [c]) -> a b c
arrL ((XmlTree -> [XmlTree]) -> a XmlTree XmlTree)
-> (XmlTree -> [XmlTree]) -> a XmlTree XmlTree
forall a b. (a -> b) -> a -> b
$ [XmlTree] -> XmlTree -> [XmlTree]
forall a b. a -> b -> a
const ([XmlTree] -> XmlTree -> [XmlTree])
-> [XmlTree] -> XmlTree -> [XmlTree]
forall a b. (a -> b) -> a -> b
$ ([XmlTree] -> [XmlTree] -> [XmlTree]) -> [[XmlTree]] -> [XmlTree]
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   DTDStateArrow XmlTree XmlTree
-> DTDStateArrow XmlTree XmlTree -> DTDStateArrow XmlTree XmlTree
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
              = DTDStateArrow XmlTree XmlTree
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b)
getChildren     DTDStateArrow XmlTree XmlTree
-> DTDStateArrow XmlTree XmlTree -> DTDStateArrow XmlTree XmlTree
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 DTDStateArrow XmlTree XmlTree
-> DTDStateArrow XmlTree XmlTree -> DTDStateArrow XmlTree XmlTree
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 [XmlTree] -> [XmlTree] -> [XmlTree]
forall a. [a] -> [a] -> [a]
++ ((XmlTree -> Bool) -> [XmlTree] -> [XmlTree]
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 ((XmlTree -> Bool) -> [XmlTree] -> Bool
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
              = Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
False (Maybe Bool -> Bool) -> Maybe Bool -> Bool
forall a b. (a -> b) -> a -> b
$
                do
                DTDElem
dp1 <- XmlTree -> Maybe DTDElem
forall a. XmlNode a => a -> Maybe DTDElem
XN.getDTDPart XmlTree
t1
                DTDElem
dp2 <- XmlTree -> Maybe DTDElem
forall a. XmlNode a => a -> Maybe DTDElem
XN.getDTDPart XmlTree
t2
                Attributes
al1 <- XmlTree -> Maybe Attributes
forall a. XmlNode a => a -> Maybe Attributes
XN.getDTDAttrl XmlTree
t1
                Attributes
al2 <- XmlTree -> Maybe Attributes
forall a. XmlNode a => a -> Maybe Attributes
XN.getDTDAttrl XmlTree
t2
                Bool -> Maybe Bool
forall (m :: * -> *) a. Monad m => a -> m a
return ( DTDElem
dp1 DTDElem -> DTDElem -> Bool
forall a. Eq a => a -> a -> Bool
== DTDElem
dp2
                         Bool -> Bool -> Bool
&&
                         ( DTDElem
dp1 DTDElem -> [DTDElem] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [DTDElem
ELEMENT, DTDElem
NOTATION, DTDElem
ENTITY, DTDElem
ATTLIST] )
                         Bool -> Bool -> Bool
&&
                         ( String -> Attributes -> Maybe String
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
a_name Attributes
al1 Maybe String -> Maybe String -> Bool
forall a. Eq a => a -> a -> Bool
== String -> Attributes -> Maybe String
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
a_name Attributes
al2 )
                         Bool -> Bool -> Bool
&&
                         ( DTDElem
dp1 DTDElem -> DTDElem -> Bool
forall a. Eq a => a -> a -> Bool
/= DTDElem
ATTLIST
                           Bool -> Bool -> Bool
||
                           String -> Attributes -> Maybe String
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
a_value Attributes
al1 Maybe String -> Maybe String -> Bool
forall a. Eq a => a -> a -> Bool
== String -> Attributes -> Maybe String
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
    = [IfThen
   (DTDStateArrow XmlTree XmlTree) (DTDStateArrow XmlTree XmlTree)]
-> DTDStateArrow XmlTree XmlTree
forall (a :: * -> * -> *) b c d.
ArrowIf a =>
[IfThen (a b c) (a b d)] -> a b d
choiceA
      [ DTDStateArrow XmlTree XmlTree
forall (a :: * -> * -> *). ArrowDTD a => a XmlTree XmlTree
isDTDEntity     DTDStateArrow XmlTree XmlTree
-> DTDStateArrow XmlTree XmlTree
-> IfThen
     (DTDStateArrow XmlTree XmlTree) (DTDStateArrow XmlTree XmlTree)
forall a b. a -> b -> IfThen a b
:-> ( String -> DTDStateArrow XmlTree XmlTree
traceDTD String
"ENTITY declaration before DTD declaration parsing"
                              DTDStateArrow XmlTree XmlTree
-> DTDStateArrow XmlTree XmlTree -> DTDStateArrow XmlTree XmlTree
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
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)
                              DTDStateArrow XmlTree XmlTree
-> DTDStateArrow XmlTree XmlTree -> DTDStateArrow XmlTree XmlTree
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
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
parseXmlDTDdecl
                              DTDStateArrow XmlTree XmlTree
-> DTDStateArrow XmlTree XmlTree -> DTDStateArrow XmlTree XmlTree
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
                              DTDStateArrow XmlTree XmlTree
-> DTDStateArrow XmlTree XmlTree -> DTDStateArrow XmlTree XmlTree
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"
                              DTDStateArrow XmlTree XmlTree
-> DTDStateArrow XmlTree XmlTree -> DTDStateArrow XmlTree XmlTree
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
                              DTDStateArrow XmlTree XmlTree
-> DTDStateArrow XmlTree XmlTree -> DTDStateArrow XmlTree XmlTree
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"
                            )
      , ( DTDStateArrow XmlTree XmlTree
forall (a :: * -> * -> *). ArrowDTD a => a XmlTree XmlTree
isDTDElement
          DTDStateArrow XmlTree XmlTree
-> DTDStateArrow XmlTree XmlTree -> DTDStateArrow XmlTree XmlTree
forall (a :: * -> * -> *) b c.
ArrowPlus a =>
a b c -> a b c -> a b c
<+>
          DTDStateArrow XmlTree XmlTree
forall (a :: * -> * -> *). ArrowDTD a => a XmlTree XmlTree
isDTDAttlist
          DTDStateArrow XmlTree XmlTree
-> DTDStateArrow XmlTree XmlTree -> DTDStateArrow XmlTree XmlTree
forall (a :: * -> * -> *) b c.
ArrowPlus a =>
a b c -> a b c -> a b c
<+>
          DTDStateArrow XmlTree XmlTree
forall (a :: * -> * -> *). ArrowDTD a => a XmlTree XmlTree
isDTDNotation
        )               DTDStateArrow XmlTree XmlTree
-> DTDStateArrow XmlTree XmlTree
-> IfThen
     (DTDStateArrow XmlTree XmlTree) (DTDStateArrow XmlTree XmlTree)
forall a b. a -> b -> IfThen a b
:-> ( String -> DTDStateArrow XmlTree XmlTree
traceDTD String
"DTD declaration before PE substitution"
                              DTDStateArrow XmlTree XmlTree
-> DTDStateArrow XmlTree XmlTree -> DTDStateArrow XmlTree XmlTree
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
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)
                              DTDStateArrow XmlTree XmlTree
-> DTDStateArrow XmlTree XmlTree -> DTDStateArrow XmlTree XmlTree
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
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
parseXmlDTDdecl
                              DTDStateArrow XmlTree XmlTree
-> DTDStateArrow XmlTree XmlTree -> DTDStateArrow XmlTree XmlTree
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"
                            )
      , DTDStateArrow XmlTree XmlTree
forall (a :: * -> * -> *). ArrowDTD a => a XmlTree XmlTree
isDTDPERef      DTDStateArrow XmlTree XmlTree
-> DTDStateArrow XmlTree XmlTree
-> IfThen
     (DTDStateArrow XmlTree XmlTree) (DTDStateArrow XmlTree XmlTree)
forall a b. a -> b -> IfThen a b
:-> RecList -> DTDStateArrow XmlTree XmlTree
substPeRefsInDTDpart RecList
recList

      , DTDStateArrow XmlTree XmlTree
forall (a :: * -> * -> *). ArrowDTD a => a XmlTree XmlTree
isDTDCondSect   DTDStateArrow XmlTree XmlTree
-> DTDStateArrow XmlTree XmlTree
-> IfThen
     (DTDStateArrow XmlTree XmlTree) (DTDStateArrow XmlTree XmlTree)
forall a b. a -> b -> IfThen a b
:-> ( if DTDPart
loc DTDPart -> DTDPart -> Bool
forall a. Eq a => a -> a -> Bool
== DTDPart
Internal
                              then String -> DTDStateArrow XmlTree XmlTree
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 (String -> DTDStateArrow XmlTree XmlTree)
-> IOSLA (XIOState PEEnv) XmlTree String
-> DTDStateArrow XmlTree XmlTree
forall (a :: * -> * -> *) c b d.
ArrowList a =>
(c -> a b d) -> a b c -> a b d
$< String -> IOSLA (XIOState PEEnv) XmlTree String
forall (a :: * -> * -> *). ArrowDTD a => String -> a XmlTree String
getDTDAttrValue String
a_value
                            )
      , DTDStateArrow XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isCmt           DTDStateArrow XmlTree XmlTree
-> DTDStateArrow XmlTree XmlTree
-> IfThen
     (DTDStateArrow XmlTree XmlTree) (DTDStateArrow XmlTree XmlTree)
forall a b. a -> b -> IfThen a b
:-> DTDStateArrow XmlTree XmlTree
forall (a :: * -> * -> *) b c. ArrowList a => a b c
none
      , DTDStateArrow XmlTree XmlTree
forall (a :: * -> * -> *) b. ArrowList a => a b b
this            DTDStateArrow XmlTree XmlTree
-> DTDStateArrow XmlTree XmlTree
-> IfThen
     (DTDStateArrow XmlTree XmlTree) (DTDStateArrow XmlTree XmlTree)
forall a b. a -> b -> IfThen a b
:-> DTDStateArrow XmlTree XmlTree
forall (a :: * -> * -> *) b. ArrowList a => a b b
this
      ]
    where
    processEntityDecl           :: DTDStateArrow XmlTree XmlTree
    processEntityDecl :: DTDStateArrow XmlTree XmlTree
processEntityDecl
        = [IfThen
   (DTDStateArrow XmlTree XmlTree) (DTDStateArrow XmlTree XmlTree)]
-> DTDStateArrow XmlTree XmlTree
forall (a :: * -> * -> *) b c d.
ArrowIf a =>
[IfThen (a b c) (a b d)] -> a b d
choiceA
          [ DTDStateArrow XmlTree XmlTree
forall (a :: * -> * -> *). ArrowDTD a => a XmlTree XmlTree
isDTDEntity DTDStateArrow XmlTree XmlTree
-> DTDStateArrow XmlTree XmlTree
-> IfThen
     (DTDStateArrow XmlTree XmlTree) (DTDStateArrow XmlTree XmlTree)
forall a b. a -> b -> IfThen a b
:-> ( DTDStateArrow XmlTree XmlTree
-> DTDStateArrow XmlTree XmlTree
-> DTDStateArrow XmlTree XmlTree
-> DTDStateArrow XmlTree XmlTree
forall (a :: * -> * -> *) b c d.
ArrowIf a =>
a b c -> a b d -> a b d -> a b d
ifA (String -> DTDStateArrow XmlTree XmlTree
forall (a :: * -> * -> *).
ArrowDTD a =>
String -> a XmlTree XmlTree
hasDTDAttr String
k_system)
                              DTDStateArrow XmlTree XmlTree
processExternalEntity
                              DTDStateArrow XmlTree XmlTree
processInternalEntity
                            )
          , DTDStateArrow XmlTree XmlTree
forall (a :: * -> * -> *). ArrowDTD a => a XmlTree XmlTree
isDTDPEntity
                        DTDStateArrow XmlTree XmlTree
-> DTDStateArrow XmlTree XmlTree
-> IfThen
     (DTDStateArrow XmlTree XmlTree) (DTDStateArrow XmlTree XmlTree)
forall a b. a -> b -> IfThen a b
:-> ( String -> DTDStateArrow XmlTree XmlTree
processParamEntity (String -> DTDStateArrow XmlTree XmlTree)
-> IOSLA (XIOState PEEnv) XmlTree String
-> DTDStateArrow XmlTree XmlTree
forall (a :: * -> * -> *) c b d.
ArrowList a =>
(c -> a b d) -> a b c -> a b d
$< String -> IOSLA (XIOState PEEnv) XmlTree String
forall (a :: * -> * -> *). ArrowDTD a => String -> a XmlTree String
getDTDAttrValue String
a_name )
          , DTDStateArrow XmlTree XmlTree
forall (a :: * -> * -> *) b. ArrowList a => a b b
this        DTDStateArrow XmlTree XmlTree
-> DTDStateArrow XmlTree XmlTree
-> IfThen
     (DTDStateArrow XmlTree XmlTree) (DTDStateArrow XmlTree XmlTree)
forall a b. a -> b -> IfThen a b
:-> DTDStateArrow XmlTree XmlTree
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
            = String -> String -> DTDStateArrow XmlTree XmlTree
forall (a :: * -> * -> *).
ArrowDTD a =>
String -> String -> a XmlTree XmlTree
setDTDAttrValue String
a_url (String -> DTDStateArrow XmlTree XmlTree)
-> IOSLA (XIOState PEEnv) XmlTree String
-> DTDStateArrow XmlTree XmlTree
forall (a :: * -> * -> *) c b d.
ArrowList a =>
(c -> a b d) -> a b c -> a b d
$< ( String -> IOSLA (XIOState PEEnv) XmlTree String
forall (a :: * -> * -> *). ArrowDTD a => String -> a XmlTree String
getDTDAttrValue String
k_system IOSLA (XIOState PEEnv) XmlTree String
-> IOSLA (XIOState PEEnv) String String
-> IOSLA (XIOState PEEnv) XmlTree String
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> IOSLA (XIOState PEEnv) String String
forall s. IOStateArrow s String String
mkAbsURI )

        processInternalEntity   :: DTDStateArrow XmlTree XmlTree
        processInternalEntity :: DTDStateArrow XmlTree XmlTree
processInternalEntity
            = DTDStateArrow XmlTree XmlTree
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
            = DTDStateArrow XmlTree XmlTree
-> DTDStateArrow XmlTree XmlTree
-> DTDStateArrow XmlTree XmlTree
-> DTDStateArrow XmlTree XmlTree
forall (a :: * -> * -> *) b c d.
ArrowIf a =>
a b c -> a b d -> a b d -> a b d
ifA (String -> IOSLA (XIOState PEEnv) XmlTree String
forall (a :: * -> * -> *) c b. ArrowList a => c -> a b c
constA String
peName IOSLA (XIOState PEEnv) XmlTree String
-> DTDStateArrow String XmlTree -> DTDStateArrow XmlTree XmlTree
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)
              ( String -> DTDStateArrow XmlTree XmlTree
forall s b. String -> IOStateArrow s b b
issueWarn (String
"parameter entity " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
peName String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" already defined")
                DTDStateArrow XmlTree XmlTree
-> DTDStateArrow XmlTree XmlTree -> DTDStateArrow XmlTree XmlTree
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
forall (a :: * -> * -> *) b c. ArrowList a => a b c
none                                                    -- second def must be ignored
              )
              ( ( DTDStateArrow XmlTree XmlTree
-> DTDStateArrow XmlTree XmlTree
-> DTDStateArrow XmlTree XmlTree
-> DTDStateArrow XmlTree XmlTree
forall (a :: * -> * -> *) b c d.
ArrowIf a =>
a b c -> a b d -> a b d -> a b d
ifA ( String -> DTDStateArrow XmlTree XmlTree
forall (a :: * -> * -> *).
ArrowDTD a =>
String -> a XmlTree XmlTree
hasDTDAttr String
k_system )                           -- is external param entity ?
                  ( String -> String -> DTDStateArrow XmlTree XmlTree
forall (a :: * -> * -> *).
ArrowDTD a =>
String -> String -> a XmlTree XmlTree
setDTDAttrValue String
a_url (String -> DTDStateArrow XmlTree XmlTree)
-> IOSLA (XIOState PEEnv) XmlTree String
-> DTDStateArrow XmlTree XmlTree
forall (a :: * -> * -> *) c b d.
ArrowList a =>
(c -> a b d) -> a b c -> a b d
$<                            -- store absolut url
                    ( String -> IOSLA (XIOState PEEnv) XmlTree String
forall (a :: * -> * -> *). ArrowDTD a => String -> a XmlTree String
getDTDAttrValue String
k_system IOSLA (XIOState PEEnv) XmlTree String
-> IOSLA (XIOState PEEnv) String String
-> IOSLA (XIOState PEEnv) XmlTree String
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> IOSLA (XIOState PEEnv) String String
forall s. IOStateArrow s String String
mkAbsURI )
                  )
                  -- this is too early, pe may be not referenced and file may be not there
                  -- ( runInLocalURIContext getExternalParamEntityValue )
                  ( DTDStateArrow XmlTree XmlTree
forall (a :: * -> * -> *) b. ArrowList a => a b b
this )                                              -- everything is already done in substPeRefsInEntityValue
                )
                DTDStateArrow XmlTree XmlTree
-> DTDStateArrow XmlTree XmlTree -> DTDStateArrow XmlTree XmlTree
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
        = [IfThen
   (DTDStateArrow XmlTree XmlTree) (DTDStateArrow XmlTree XmlTree)]
-> DTDStateArrow XmlTree XmlTree
forall (a :: * -> * -> *) b c d.
ArrowIf a =>
[IfThen (a b c) (a b d)] -> a b d
choiceA
          [ DTDStateArrow XmlTree XmlTree
forall b. IOSLA (XIOState PEEnv) b b
isUndefinedRef      DTDStateArrow XmlTree XmlTree
-> DTDStateArrow XmlTree XmlTree
-> IfThen
     (DTDStateArrow XmlTree XmlTree) (DTDStateArrow XmlTree XmlTree)
forall a b. a -> b -> IfThen a b
:-> String -> DTDStateArrow XmlTree XmlTree
forall s b. String -> IOStateArrow s b b
issueErr (String
"parameter entity " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
pn String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" not found (forward reference?)")
          , DTDStateArrow XmlTree XmlTree
forall b c. IOSLA (XIOState PEEnv) b c
isInternalRef       DTDStateArrow XmlTree XmlTree
-> DTDStateArrow XmlTree XmlTree
-> IfThen
     (DTDStateArrow XmlTree XmlTree) (DTDStateArrow XmlTree XmlTree)
forall a b. a -> b -> IfThen a b
:-> String -> DTDStateArrow XmlTree XmlTree
forall s b. String -> IOStateArrow s b b
issueErr (String
"a parameter entity reference of " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
pn String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" occurs in the internal subset of the DTD")
          , DTDStateArrow XmlTree XmlTree
forall b. IOSLA (XIOState PEEnv) b b
isUnreadExternalRef DTDStateArrow XmlTree XmlTree
-> DTDStateArrow XmlTree XmlTree
-> IfThen
     (DTDStateArrow XmlTree XmlTree) (DTDStateArrow XmlTree XmlTree)
forall a b. a -> b -> IfThen a b
:-> ( DTDStateArrow XmlTree XmlTree -> DTDStateArrow XmlTree XmlTree
forall (a :: * -> * -> *) b c. ArrowList a => a b c -> a b b
perform
                                      ( DTDStateArrow XmlTree XmlTree
forall a. IOSLA (XIOState PEEnv) a XmlTree
peVal                           -- load the external pe value
                                        DTDStateArrow XmlTree XmlTree
-> DTDStateArrow XmlTree XmlTree -> DTDStateArrow XmlTree XmlTree
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
                                        DTDStateArrow XmlTree XmlTree
-> DTDStateArrow XmlTree XmlTree -> DTDStateArrow XmlTree XmlTree
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
                                      )
                                      DTDStateArrow XmlTree XmlTree
-> DTDStateArrow XmlTree XmlTree -> DTDStateArrow XmlTree XmlTree
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
                                    )
          , DTDStateArrow XmlTree XmlTree
forall (a :: * -> * -> *) b. ArrowList a => a b b
this                DTDStateArrow XmlTree XmlTree
-> DTDStateArrow XmlTree XmlTree
-> IfThen
     (DTDStateArrow XmlTree XmlTree) (DTDStateArrow XmlTree XmlTree)
forall a b. a -> b -> IfThen a b
:-> DTDStateArrow XmlTree XmlTree
substPE
          ]
          DTDStateArrow XmlTree XmlTree
-> DTDStateArrow XmlTree XmlTree -> DTDStateArrow XmlTree XmlTree
forall (a :: * -> * -> *) b c. ArrowIf a => a b b -> a b c -> a b b
`when`
          DTDStateArrow XmlTree XmlTree
forall (a :: * -> * -> *). ArrowDTD a => a XmlTree XmlTree
isDTDPERef
        where
        peVal :: IOSLA (XIOState PEEnv) a XmlTree
peVal                   = String -> IOSLA (XIOState PEEnv) a String
forall (a :: * -> * -> *) c b. ArrowList a => c -> a b c
constA String
pn IOSLA (XIOState PEEnv) a String
-> DTDStateArrow String XmlTree -> IOSLA (XIOState PEEnv) a XmlTree
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     = ( IOSLA (XIOState PEEnv) d XmlTree
forall a. IOSLA (XIOState PEEnv) a XmlTree
peVal
                                    IOSLA (XIOState PEEnv) d XmlTree
-> IOSLA (XIOState PEEnv) XmlTree String
-> IOSLA (XIOState PEEnv) d String
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
                                    String -> IOSLA (XIOState PEEnv) XmlTree String
forall (a :: * -> * -> *). ArrowDTD a => String -> a XmlTree String
getDTDAttrValue String
a_url
                                    IOSLA (XIOState PEEnv) XmlTree String
-> IOSLA (XIOState PEEnv) String String
-> IOSLA (XIOState PEEnv) XmlTree String
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
                                    (String -> Bool) -> IOSLA (XIOState PEEnv) String String
forall (a :: * -> * -> *) b. ArrowList a => (b -> Bool) -> a b b
isA (Bool -> Bool
not (Bool -> Bool) -> (String -> Bool) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null)
                                  )
                                  IOSLA (XIOState PEEnv) d String
-> IOSLA (XIOState PEEnv) d d -> IOSLA (XIOState PEEnv) d d
forall (a :: * -> * -> *) b c d.
ArrowIf a =>
a b c -> a b d -> a b d
`guards`
                                  IOSLA (XIOState PEEnv) d d
forall (a :: * -> * -> *) b. ArrowList a => a b b
this

        isInternalRef :: IOSLA (XIOState PEEnv) b c
isInternalRef   = IOSLA (XIOState PEEnv) b c
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  = IOSLA (XIOState PEEnv) b XmlTree -> IOSLA (XIOState PEEnv) b b
forall (a :: * -> * -> *) b c. ArrowIf a => a b c -> a b b
neg IOSLA (XIOState PEEnv) b XmlTree
forall a. IOSLA (XIOState PEEnv) a XmlTree
peVal
        substPE :: DTDStateArrow XmlTree XmlTree
substPE         = DTDStateArrow XmlTree XmlTree -> DTDStateArrow XmlTree XmlTree
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b) -> a (t b) (t b)
replaceChildren (DTDStateArrow XmlTree XmlTree
forall a. IOSLA (XIOState PEEnv) a XmlTree
peVal DTDStateArrow XmlTree XmlTree
-> DTDStateArrow XmlTree XmlTree -> DTDStateArrow XmlTree XmlTree
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
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
        = ( ( DTDStateArrow XmlTree XmlTree -> DTDStateArrow XmlTree XmlTree
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b) -> a (t b) (t b)
replaceChildren
              ( DTDStateArrow XmlTree XmlTree
-> IOSLA (XIOState PEEnv) XmlTree String
forall (a :: * -> * -> *) n.
ArrowXml a =>
a n XmlTree -> a n String
xshow ( DTDStateArrow XmlTree XmlTree
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b)
getChildren                                     -- substitute char entites
                        DTDStateArrow XmlTree XmlTree
-> DTDStateArrow XmlTree XmlTree -> DTDStateArrow XmlTree XmlTree
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
                        DTDStateArrow XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
transfCharRef                                   -- combine all pieces to a single string
                        DTDStateArrow XmlTree XmlTree
-> DTDStateArrow XmlTree XmlTree -> DTDStateArrow XmlTree XmlTree
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 []
                      )
                IOSLA (XIOState PEEnv) XmlTree String
-> DTDStateArrow String XmlTree -> DTDStateArrow XmlTree XmlTree
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
forall (a :: * -> * -> *). ArrowXml a => a String XmlTree
mkText
              )
            )
            DTDStateArrow XmlTree XmlTree
-> DTDStateArrow XmlTree XmlTree -> DTDStateArrow XmlTree XmlTree
forall (a :: * -> * -> *) b c. ArrowIf a => a b b -> a b c -> a b b
`whenNot`
            String -> DTDStateArrow XmlTree XmlTree
forall (a :: * -> * -> *).
ArrowDTD a =>
String -> a XmlTree XmlTree
hasDTDAttr String
k_system                                         -- only apply for internal entities
          )
          DTDStateArrow XmlTree XmlTree
-> DTDStateArrow XmlTree XmlTree -> DTDStateArrow XmlTree XmlTree
forall (a :: * -> * -> *) b c. ArrowIf a => a b b -> a b c -> a b b
`when`
          ( DTDStateArrow XmlTree XmlTree
forall (a :: * -> * -> *). ArrowDTD a => a XmlTree XmlTree
isDTDEntity DTDStateArrow XmlTree XmlTree
-> DTDStateArrow XmlTree XmlTree -> DTDStateArrow XmlTree XmlTree
forall (a :: * -> * -> *) b c.
ArrowPlus a =>
a b c -> a b c -> a b c
<+> DTDStateArrow XmlTree XmlTree
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
              DTDStateArrow XmlTree XmlTree
-> DTDStateArrow XmlTree XmlTree -> DTDStateArrow XmlTree XmlTree
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"
              DTDStateArrow XmlTree XmlTree
-> DTDStateArrow XmlTree XmlTree -> DTDStateArrow XmlTree XmlTree
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 ( DTDStateArrow XmlTree XmlTree
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b)
getChildren
                                 DTDStateArrow XmlTree XmlTree
-> DTDStateArrow XmlTree XmlTree -> DTDStateArrow XmlTree XmlTree
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
                                 ( (String -> IOSLA (XIOState PEEnv) XmlTree String
forall (a :: * -> * -> *) c b. ArrowList a => c -> a b c
constA (String
"parameter entity: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
pn)) IOSLA (XIOState PEEnv) XmlTree String
-> DTDStateArrow XmlTree XmlTree
-> IOSLA (XIOState PEEnv) XmlTree (String, XmlTree)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& DTDStateArrow XmlTree XmlTree
forall (a :: * -> * -> *) b. ArrowList a => a b b
this )
                                 IOSLA (XIOState PEEnv) XmlTree (String, XmlTree)
-> IOSLA (XIOState PEEnv) (String, XmlTree) XmlTree
-> DTDStateArrow XmlTree XmlTree
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
                                 IOSLA (XIOState PEEnv) (String, XmlTree) XmlTree
forall (a :: * -> * -> *).
ArrowXml a =>
a (String, XmlTree) XmlTree
parseXmlDTDPart
                                 IOSLA (XIOState PEEnv) (String, XmlTree) XmlTree
-> DTDStateArrow XmlTree XmlTree
-> IOSLA (XIOState PEEnv) (String, XmlTree) XmlTree
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"
                                 DTDStateArrow XmlTree XmlTree
-> DTDStateArrow XmlTree XmlTree -> DTDStateArrow XmlTree XmlTree
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 String -> RecList -> RecList
forall a. a -> [a] -> [a]
: RecList
recl)
                               )
                DTDStateArrow XmlTree XmlTree
-> DTDStateArrow XmlTree XmlTree -> DTDStateArrow XmlTree XmlTree
forall (a :: * -> * -> *) b c. ArrowIf a => a b b -> a b c -> a b b
`when`
                DTDStateArrow XmlTree XmlTree
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
              DTDStateArrow XmlTree XmlTree
-> DTDStateArrow XmlTree XmlTree -> DTDStateArrow XmlTree XmlTree
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"
              DTDStateArrow XmlTree XmlTree
-> DTDStateArrow XmlTree XmlTree -> DTDStateArrow XmlTree XmlTree
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 ( DTDStateArrow XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
parseXmlDTDdeclPart
                                 DTDStateArrow XmlTree XmlTree
-> DTDStateArrow XmlTree XmlTree -> DTDStateArrow XmlTree XmlTree
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"
                                 DTDStateArrow XmlTree XmlTree
-> DTDStateArrow XmlTree XmlTree -> DTDStateArrow XmlTree XmlTree
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
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 String -> RecList -> RecList
forall a. a -> [a] -> [a]
: RecList
recl) )
                               )
                DTDStateArrow XmlTree XmlTree
-> DTDStateArrow XmlTree XmlTree -> DTDStateArrow XmlTree XmlTree
forall (a :: * -> * -> *) b c. ArrowIf a => a b b -> a b c -> a b b
`when`
                DTDStateArrow XmlTree XmlTree
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
              DTDStateArrow XmlTree XmlTree
-> DTDStateArrow XmlTree XmlTree -> DTDStateArrow XmlTree XmlTree
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
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
parseXmlDTDEntityValue
              DTDStateArrow XmlTree XmlTree
-> DTDStateArrow XmlTree XmlTree -> DTDStateArrow XmlTree XmlTree
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 String -> RecList -> RecList
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
              DTDStateArrow XmlTree XmlTree
-> DTDStateArrow XmlTree XmlTree -> DTDStateArrow XmlTree XmlTree
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"
              DTDStateArrow XmlTree XmlTree
-> DTDStateArrow XmlTree XmlTree -> DTDStateArrow XmlTree XmlTree
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 ( DTDStateArrow XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
parseXmlDTDdeclPart
                               DTDStateArrow XmlTree XmlTree
-> DTDStateArrow XmlTree XmlTree -> DTDStateArrow XmlTree XmlTree
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"
                               DTDStateArrow XmlTree XmlTree
-> DTDStateArrow XmlTree XmlTree -> DTDStateArrow XmlTree XmlTree
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
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 String -> RecList -> RecList
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  (String -> DTDStateArrow XmlTree XmlTree)
-> IOSLA (XIOState PEEnv) XmlTree String
-> DTDStateArrow XmlTree XmlTree
forall (a :: * -> * -> *) c b d.
ArrowList a =>
(c -> a b d) -> a b c -> a b d
$< String -> IOSLA (XIOState PEEnv) XmlTree String
forall (a :: * -> * -> *). ArrowDTD a => String -> a XmlTree String
getDTDAttrValue String
a_peref )
          DTDStateArrow XmlTree XmlTree
-> DTDStateArrow XmlTree XmlTree -> DTDStateArrow XmlTree XmlTree
forall (a :: * -> * -> *) b c. ArrowIf a => a b b -> a b c -> a b b
`when`
          DTDStateArrow XmlTree XmlTree
forall (a :: * -> * -> *). ArrowDTD a => a XmlTree XmlTree
isDTDPERef
        where
        recusiveSubst :: String -> DTDStateArrow XmlTree XmlTree
recusiveSubst String
name
            | String
name String -> RecList -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` RecList
rl
                = String -> DTDStateArrow XmlTree XmlTree
forall s b. String -> IOStateArrow s b b
issueErr (String
"recursive call of parameter entity " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
name String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" in " String -> String -> String
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 (String -> DTDStateArrow XmlTree XmlTree)
-> IOSLA (XIOState PEEnv) XmlTree String
-> DTDStateArrow XmlTree XmlTree
forall (a :: * -> * -> *) c b d.
ArrowList a =>
(c -> a b d) -> a b c -> a b d
$< String -> IOSLA (XIOState PEEnv) XmlTree String
forall (a :: * -> * -> *). ArrowDTD a => String -> a XmlTree String
getDTDAttrValue String
a_url )
          DTDStateArrow XmlTree XmlTree
-> DTDStateArrow XmlTree XmlTree -> DTDStateArrow XmlTree XmlTree
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
            = DTDStateArrow XmlTree XmlTree -> DTDStateArrow XmlTree XmlTree
forall s b c. IOStateArrow s b c -> IOStateArrow s b c
runInLocalURIContext
              ( IOSLA (XIOState PEEnv) XmlTree String
-> DTDStateArrow XmlTree XmlTree
forall (a :: * -> * -> *) b c. ArrowList a => a b c -> a b b
perform (String -> IOSLA (XIOState PEEnv) XmlTree String
forall (a :: * -> * -> *) c b. ArrowList a => c -> a b c
constA String
base IOSLA (XIOState PEEnv) XmlTree String
-> IOSLA (XIOState PEEnv) String String
-> IOSLA (XIOState PEEnv) XmlTree String
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> IOSLA (XIOState PEEnv) String String
forall s. IOStateArrow s String String
setBaseURI)
                DTDStateArrow XmlTree XmlTree
-> DTDStateArrow XmlTree XmlTree -> DTDStateArrow XmlTree XmlTree
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"
          DTDStateArrow XmlTree XmlTree
-> DTDStateArrow XmlTree XmlTree -> DTDStateArrow XmlTree XmlTree
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
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b) -> a (t b) (t b)
processChildren (RecList -> DTDStateArrow XmlTree XmlTree
substPeRefsInCondSect [])
          DTDStateArrow XmlTree XmlTree
-> DTDStateArrow XmlTree XmlTree -> DTDStateArrow XmlTree XmlTree
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
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
parseXmlDTDdecl
          DTDStateArrow XmlTree XmlTree
-> DTDStateArrow XmlTree XmlTree -> DTDStateArrow XmlTree XmlTree
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
          ( (String -> Bool) -> DTDStateArrow XmlTree XmlTree
forall (a :: * -> * -> *).
ArrowXml a =>
(String -> Bool) -> a XmlTree XmlTree
hasText (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
k_include)
            DTDStateArrow XmlTree XmlTree
-> DTDStateArrow XmlTree XmlTree -> DTDStateArrow XmlTree XmlTree
forall (a :: * -> * -> *) b c d.
ArrowIf a =>
a b c -> a b d -> a b d
`guards`
            ( ( String -> IOSLA (XIOState PEEnv) XmlTree String
forall (a :: * -> * -> *) c b. ArrowList a => c -> a b c
constA String
"conditional section" IOSLA (XIOState PEEnv) XmlTree String
-> DTDStateArrow XmlTree XmlTree
-> IOSLA (XIOState PEEnv) XmlTree (String, XmlTree)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& String -> DTDStateArrow XmlTree XmlTree
forall (a :: * -> * -> *) n. ArrowXml a => String -> a n XmlTree
txt String
content )
              IOSLA (XIOState PEEnv) XmlTree (String, XmlTree)
-> IOSLA (XIOState PEEnv) (String, XmlTree) XmlTree
-> DTDStateArrow XmlTree XmlTree
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
              IOSLA (XIOState PEEnv) (String, XmlTree) XmlTree
forall (a :: * -> * -> *).
ArrowXml a =>
a (String, XmlTree) XmlTree
parseXmlDTDPart
              IOSLA (XIOState PEEnv) (String, XmlTree) XmlTree
-> DTDStateArrow XmlTree XmlTree
-> IOSLA (XIOState PEEnv) (String, XmlTree) XmlTree
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
              Int -> String -> DTDStateArrow XmlTree XmlTree
forall s b. Int -> String -> IOStateArrow s b b
traceMsg Int
2 String
"evalCond: include DTD part"
              DTDStateArrow XmlTree XmlTree
-> DTDStateArrow XmlTree XmlTree -> DTDStateArrow XmlTree XmlTree
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
    = ( String -> IOSLA (XIOState PEEnv) XmlTree String
forall (a :: * -> * -> *) c b. ArrowList a => c -> a b c
constA String
"predefined entities"
        IOSLA (XIOState PEEnv) XmlTree String
-> DTDStateArrow XmlTree XmlTree
-> IOSLA (XIOState PEEnv) XmlTree (String, XmlTree)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&&
        ( String -> IOSLA (XIOState PEEnv) XmlTree String
forall (a :: * -> * -> *) c b. ArrowList a => c -> a b c
constA String
predefinedEntities IOSLA (XIOState PEEnv) XmlTree String
-> DTDStateArrow String XmlTree -> DTDStateArrow XmlTree XmlTree
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
forall (a :: * -> * -> *). ArrowXml a => a String XmlTree
mkText)
      )
      IOSLA (XIOState PEEnv) XmlTree (String, XmlTree)
-> IOSLA (XIOState PEEnv) (String, XmlTree) XmlTree
-> DTDStateArrow XmlTree XmlTree
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
      IOSLA (XIOState PEEnv) (String, XmlTree) XmlTree
forall (a :: * -> * -> *).
ArrowXml a =>
a (String, XmlTree) XmlTree
parseXmlDTDPart
    where
    predefinedEntities  :: String
    predefinedEntities :: String
predefinedEntities
        = RecList -> String
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
    = DTDStateArrow XmlTree XmlTree
forall (a :: * -> * -> *). ArrowDTD a => a XmlTree XmlTree
isDTDDoctype
      DTDStateArrow XmlTree XmlTree
-> DTDStateArrow XmlTree XmlTree -> DTDStateArrow XmlTree XmlTree
forall (a :: * -> * -> *) b c d.
ArrowIf a =>
a b c -> a b d -> a b d
`guards`
      ( String -> DTDStateArrow XmlTree XmlTree
forall (a :: * -> * -> *).
ArrowDTD a =>
String -> a XmlTree XmlTree
hasDTDAttr String
k_system
        DTDStateArrow XmlTree XmlTree
-> DTDStateArrow XmlTree XmlTree -> DTDStateArrow XmlTree XmlTree
forall (a :: * -> * -> *) b c d.
ArrowIf a =>
a b c -> a b d -> a b d
`guards`
        ( String -> DTDStateArrow XmlTree XmlTree
getExternalDTDPart (String -> DTDStateArrow XmlTree XmlTree)
-> IOSLA (XIOState PEEnv) XmlTree String
-> DTDStateArrow XmlTree XmlTree
forall (a :: * -> * -> *) c b d.
ArrowList a =>
(c -> a b d) -> a b c -> a b d
$< String -> IOSLA (XIOState PEEnv) XmlTree String
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
    = [DTDStateArrow XmlTree XmlTree]
-> [DTDStateArrow XmlTree XmlTree] -> DTDStateArrow XmlTree XmlTree
forall (a :: * -> * -> *) n.
ArrowXml a =>
[a n XmlTree] -> [a n XmlTree] -> a n XmlTree
root [String -> String -> DTDStateArrow XmlTree XmlTree
forall (a :: * -> * -> *) n.
ArrowXml a =>
String -> String -> a n XmlTree
sattr String
a_source String
src] []
      DTDStateArrow XmlTree XmlTree
-> DTDStateArrow XmlTree XmlTree -> DTDStateArrow XmlTree XmlTree
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
forall s. IOStateArrow s XmlTree XmlTree
getXmlEntityContents
      DTDStateArrow XmlTree XmlTree
-> DTDStateArrow XmlTree XmlTree -> DTDStateArrow XmlTree XmlTree
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
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b) -> a (t b) (t b)
replaceChildren ( ( String -> IOSLA (XIOState PEEnv) XmlTree String
forall (a :: * -> * -> *) c b. ArrowList a => c -> a b c
constA String
src IOSLA (XIOState PEEnv) XmlTree String
-> DTDStateArrow XmlTree XmlTree
-> IOSLA (XIOState PEEnv) XmlTree (String, XmlTree)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& DTDStateArrow XmlTree XmlTree
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b)
getChildren )
                        IOSLA (XIOState PEEnv) XmlTree (String, XmlTree)
-> IOSLA (XIOState PEEnv) (String, XmlTree) XmlTree
-> DTDStateArrow XmlTree XmlTree
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
                        IOSLA (XIOState PEEnv) (String, XmlTree) XmlTree
forall (a :: * -> * -> *).
ArrowXml a =>
a (String, XmlTree) XmlTree
parseXmlDTDPart
                      )
      DTDStateArrow XmlTree XmlTree
-> DTDStateArrow XmlTree XmlTree -> DTDStateArrow XmlTree XmlTree
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
forall s. String -> IOStateArrow s XmlTree XmlTree
traceDoc String
"processExternalDTD: parsing DTD part done"
      DTDStateArrow XmlTree XmlTree
-> DTDStateArrow XmlTree XmlTree -> DTDStateArrow XmlTree XmlTree
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
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
    = DTDStateArrow XmlTree XmlTree
forall (a :: * -> * -> *). ArrowDTD a => a XmlTree XmlTree
isDTDPEntity
      DTDStateArrow XmlTree XmlTree
-> DTDStateArrow XmlTree XmlTree -> DTDStateArrow XmlTree XmlTree
forall (a :: * -> * -> *) b c d.
ArrowIf a =>
a b c -> a b d -> a b d
`guards`
      ( [XmlTree] -> DTDStateArrow XmlTree XmlTree
setEntityValue ([XmlTree] -> DTDStateArrow XmlTree XmlTree)
-> IOSLA (XIOState PEEnv) XmlTree [XmlTree]
-> DTDStateArrow XmlTree XmlTree
forall (a :: * -> * -> *) c b d.
ArrowList a =>
(c -> a b d) -> a b c -> a b d
$< ( DTDStateArrow XmlTree XmlTree
-> IOSLA (XIOState PEEnv) XmlTree [XmlTree]
forall (a :: * -> * -> *) b c. ArrowList a => a b c -> a b [c]
listA ( String -> DTDStateArrow XmlTree XmlTree
getEntityValue (String -> DTDStateArrow XmlTree XmlTree)
-> IOSLA (XIOState PEEnv) XmlTree String
-> DTDStateArrow XmlTree XmlTree
forall (a :: * -> * -> *) c b d.
ArrowList a =>
(c -> a b d) -> a b c -> a b d
$< String -> IOSLA (XIOState PEEnv) XmlTree String
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
        = [DTDStateArrow XmlTree XmlTree]
-> [DTDStateArrow XmlTree XmlTree] -> DTDStateArrow XmlTree XmlTree
forall (a :: * -> * -> *) n.
ArrowXml a =>
[a n XmlTree] -> [a n XmlTree] -> a n XmlTree
root [String -> String -> DTDStateArrow XmlTree XmlTree
forall (a :: * -> * -> *) n.
ArrowXml a =>
String -> String -> a n XmlTree
sattr String
a_source String
url] []
          DTDStateArrow XmlTree XmlTree
-> DTDStateArrow XmlTree XmlTree -> DTDStateArrow XmlTree XmlTree
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
forall s b c. IOStateArrow s b c -> IOStateArrow s b c
runInLocalURIContext DTDStateArrow XmlTree XmlTree
forall s. IOStateArrow s XmlTree XmlTree
getXmlEntityContents
          DTDStateArrow XmlTree XmlTree
-> DTDStateArrow XmlTree XmlTree -> DTDStateArrow XmlTree XmlTree
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
          Int -> String -> DTDStateArrow XmlTree XmlTree
forall s b. Int -> String -> IOStateArrow s b b
traceMsg Int
2 (String
"getExternalParamEntityValue: contents read for " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
pn String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" from " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
url)
          DTDStateArrow XmlTree XmlTree
-> DTDStateArrow XmlTree XmlTree -> DTDStateArrow XmlTree XmlTree
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
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
        | [XmlTree] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [XmlTree]
res
            = String -> DTDStateArrow XmlTree XmlTree
forall s b. String -> IOStateArrow s b b
issueErr (String
"illegal external parameter entity value for entity %" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
pn String -> String -> String
forall a. [a] -> [a] -> [a]
++String
";")
        | Bool
otherwise
            = DTDStateArrow XmlTree XmlTree -> DTDStateArrow XmlTree XmlTree
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b) -> a (t b) (t b)
replaceChildren ([XmlTree] -> DTDStateArrow XmlTree XmlTree
forall (a :: * -> * -> *) c b. ArrowList a => [c] -> a b c
constL [XmlTree]
res)
              DTDStateArrow XmlTree XmlTree
-> DTDStateArrow XmlTree XmlTree -> DTDStateArrow XmlTree XmlTree
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
              String -> String -> DTDStateArrow XmlTree XmlTree
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    = Int -> String -> DTDStateArrow XmlTree XmlTree
forall s b. Int -> String -> IOStateArrow s b b
traceMsg Int
3 String
msg DTDStateArrow XmlTree XmlTree
-> DTDStateArrow XmlTree XmlTree -> DTDStateArrow XmlTree XmlTree
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
forall s. IOStateArrow s XmlTree XmlTree
traceTree

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