module Text.XML.HXT.Arrow.DTDProcessing
( processDTD
)
where
import Control.Arrow
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
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
processExternalEntity :: DTDStateArrow XmlTree XmlTree
processExternalEntity
= 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
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
)
( ( 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 )
( 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 )
)
( 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
>>>
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
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
getExternalParamEntityValue 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
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
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)
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
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
transfCharRef
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
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
)
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 )
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
>>>
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 '&#60;'>"
, String
"<!ENTITY gt '>'>"
, String
"<!ENTITY amp '&#38;'>"
, String
"<!ENTITY apos '''>"
, String
"<!ENTITY quot '"'>"
]
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
""
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