module Text.XML.HXT.Arrow.GeneralEntitySubstitution
( processGeneralEntities )
where
import Control.Arrow
import Control.Arrow.ArrowList
import Control.Arrow.ArrowIf
import Control.Arrow.ArrowTree
import Text.XML.HXT.DOM.Interface
import Text.XML.HXT.Arrow.XmlArrow
import Text.XML.HXT.Arrow.XmlState
import Text.XML.HXT.Arrow.ParserInterface
( parseXmlEntityValueAsAttrValue
, parseXmlEntityValueAsContent
)
import Text.XML.HXT.Arrow.Edit
( transfCharRef
)
import Text.XML.HXT.Arrow.DocumentInput
( getXmlEntityContents
)
import qualified Data.Map as M
( Map
, empty
, lookup
, insert
)
data GEContext
= ReferenceInContent
| ReferenceInAttributeValue
| ReferenceInEntityValue
type GESubstArrow = GEContext -> RecList -> GEArrow XmlTree XmlTree
type GEArrow b c = IOStateArrow GEEnv b c
type RecList = [String]
newtype GEEnv = GEEnv (M.Map String GESubstArrow)
emptyGeEnv :: GEEnv
emptyGeEnv :: GEEnv
emptyGeEnv = Map String GESubstArrow -> GEEnv
GEEnv forall k a. Map k a
M.empty
lookupGeEnv :: String -> GEEnv -> Maybe GESubstArrow
lookupGeEnv :: String -> GEEnv -> Maybe GESubstArrow
lookupGeEnv String
k (GEEnv Map String GESubstArrow
env)
= forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup String
k Map String GESubstArrow
env
addGeEntry :: String -> GESubstArrow -> GEEnv -> GEEnv
addGeEntry :: String -> GESubstArrow -> GEEnv -> GEEnv
addGeEntry String
k GESubstArrow
a (GEEnv Map String GESubstArrow
env)
= Map String GESubstArrow -> GEEnv
GEEnv forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert String
k GESubstArrow
a Map String GESubstArrow
env
processGeneralEntities :: IOStateArrow s XmlTree XmlTree
processGeneralEntities :: forall s. IOStateArrow s XmlTree XmlTree
processGeneralEntities
= ( forall s b. Int -> String -> IOStateArrow s b b
traceMsg Int
1 String
"processGeneralEntities: collect and substitute general entities"
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
forall s1 b c s0. s1 -> IOStateArrow s1 b c -> IOStateArrow s0 b c
withOtherUserState GEEnv
emptyGeEnv (forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b) -> a (t b) (t b)
processChildren (GESubstArrow
processGeneralEntity GEContext
ReferenceInContent []))
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 general entity 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. 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
documentStatusOk
processGeneralEntity :: GESubstArrow
processGeneralEntity :: GESubstArrow
processGeneralEntity GEContext
context RecList
recl
= forall (a :: * -> * -> *) b c d.
ArrowIf a =>
[IfThen (a b c) (a b d)] -> a b d
choiceA [ forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isElem forall a b. a -> b -> IfThen a b
:-> ( forall (a :: * -> * -> *).
ArrowXml a =>
a XmlTree XmlTree -> a XmlTree XmlTree
processAttrl (forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b) -> a (t b) (t b)
processChildren IOSLA (XIOState GEEnv) XmlTree XmlTree
substEntitiesInAttrValue)
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 (GESubstArrow
processGeneralEntity GEContext
context RecList
recl)
)
, forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isEntityRef forall a b. a -> b -> IfThen a b
:-> IOSLA (XIOState GEEnv) XmlTree XmlTree
substEntityRef
, forall (a :: * -> * -> *). ArrowDTD a => a XmlTree XmlTree
isDTDDoctype forall a b. a -> b -> IfThen a b
:-> forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b) -> a (t b) (t b)
processChildren (GESubstArrow
processGeneralEntity GEContext
context RecList
recl)
, forall (a :: * -> * -> *). ArrowDTD a => a XmlTree XmlTree
isDTDEntity forall a b. a -> b -> IfThen a b
:-> IOSLA (XIOState GEEnv) XmlTree XmlTree
addEntityDecl
, forall (a :: * -> * -> *). ArrowDTD a => a XmlTree XmlTree
isDTDAttlist forall a b. a -> b -> IfThen a b
:-> IOSLA (XIOState GEEnv) XmlTree XmlTree
substEntitiesInAttrDefaultValue
, 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
addEntityDecl :: GEArrow XmlTree XmlTree
addEntityDecl :: IOSLA (XIOState GEEnv) XmlTree XmlTree
addEntityDecl
= forall (a :: * -> * -> *) b c. ArrowList a => a b c -> a b b
perform ( forall (a :: * -> * -> *) b c d.
ArrowIf a =>
[IfThen (a b c) (a b d)] -> a b d
choiceA [ IOSLA (XIOState GEEnv) XmlTree XmlTree
isIntern forall a b. a -> b -> IfThen a b
:-> forall b. GEArrow XmlTree b
addInternalEntity
, IOSLA (XIOState GEEnv) XmlTree XmlTree
isExtern forall a b. a -> b -> IfThen a b
:-> forall b. GEArrow XmlTree b
addExternalEntity
, forall {b}. IOSLA (XIOState GEEnv) b b
isUnparsed forall a b. a -> b -> IfThen a b
:-> forall b. GEArrow XmlTree b
addUnparsedEntity
]
)
where
isIntern :: IOSLA (XIOState GEEnv) XmlTree XmlTree
isIntern = forall (a :: * -> * -> *) b c. ArrowList a => a b c
none forall (a :: * -> * -> *) b c. ArrowIf a => a b b -> a b c -> a b b
`when` forall (a :: * -> * -> *).
ArrowDTD a =>
String -> a XmlTree XmlTree
hasDTDAttr String
k_system
isExtern :: IOSLA (XIOState GEEnv) XmlTree XmlTree
isExtern = forall (a :: * -> * -> *) b c. ArrowList a => a b c
none forall (a :: * -> * -> *) b c. ArrowIf a => a b b -> a b c -> a b b
`when` forall (a :: * -> * -> *).
ArrowDTD a =>
String -> a XmlTree XmlTree
hasDTDAttr String
k_ndata
isUnparsed :: IOSLA (XIOState GEEnv) b b
isUnparsed = forall (a :: * -> * -> *) b. ArrowList a => a b b
this
addInternalEntity :: GEArrow XmlTree b
addInternalEntity :: forall b. GEArrow XmlTree b
addInternalEntity
= forall {b} {c}. String -> String -> IOSLA (XIOState GEEnv) b c
insertInternal forall (a :: * -> * -> *) c1 c2 b d.
ArrowList a =>
(c1 -> c2 -> a b d) -> a b (c1, c2) -> a b d
$<<
( ( forall (a :: * -> * -> *). ArrowDTD a => String -> a XmlTree String
getDTDAttrValue String
a_name
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. Int -> (b -> String) -> IOStateArrow s b b
traceValue Int
2 ((String
"processGeneralEntity: general entity definition for " forall a. [a] -> [a] -> [a]
++) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show)
)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&&
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
isText)
)
where
insertInternal :: String -> String -> IOSLA (XIOState GEEnv) b c
insertInternal String
entity String
contents
= forall b. (String -> GESubstArrow) -> String -> GEArrow b b
insertEntity (String -> String -> GESubstArrow
substInternal String
contents) String
entity
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
addExternalEntity :: GEArrow XmlTree b
addExternalEntity :: forall b. GEArrow XmlTree b
addExternalEntity
= forall {b} {c}. String -> String -> IOSLA (XIOState GEEnv) b c
insertExternal forall (a :: * -> * -> *) c1 c2 b d.
ArrowList a =>
(c1 -> c2 -> a b d) -> a b (c1, c2) -> a b d
$<<
( ( forall (a :: * -> * -> *). ArrowDTD a => String -> a XmlTree String
getDTDAttrValue String
a_name
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. Int -> (b -> String) -> IOStateArrow s b b
traceValue Int
2 ((String
"processGeneralEntity: external entity definition for " forall a. [a] -> [a] -> [a]
++) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show)
)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&&
forall (a :: * -> * -> *). ArrowDTD a => String -> a XmlTree String
getDTDAttrValue String
a_url
)
where
insertExternal :: String -> String -> IOSLA (XIOState GEEnv) b c
insertExternal String
entity String
uri
= forall b. (String -> GESubstArrow) -> String -> GEArrow b b
insertEntity (String -> String -> GESubstArrow
substExternalParsed1Time String
uri) String
entity
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
addUnparsedEntity :: GEArrow XmlTree b
addUnparsedEntity :: forall b. GEArrow XmlTree b
addUnparsedEntity
= forall (a :: * -> * -> *). ArrowDTD a => String -> a XmlTree String
getDTDAttrValue String
a_name
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. Int -> (b -> String) -> IOStateArrow s b b
traceValue Int
2 ((String
"processGeneralEntity: unparsed entity definition for " forall a. [a] -> [a] -> [a]
++) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show)
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 (a b c) -> a b c
applyA (forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (forall b. (String -> GESubstArrow) -> String -> GEArrow b b
insertEntity String -> GESubstArrow
substUnparsed))
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
insertEntity :: (String -> GESubstArrow) -> String -> GEArrow b b
insertEntity :: forall b. (String -> GESubstArrow) -> String -> GEArrow b b
insertEntity String -> GESubstArrow
fct String
entity
= ( 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 => a b (a b c) -> a b c
applyA (forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr forall {s} {b}. GEEnv -> IOSLA (XIOState s) b b
checkDefined)
)
forall (a :: * -> * -> *) b c d.
ArrowIf a =>
a b c -> a b d -> a b d
`guards`
forall b. (String -> GESubstArrow) -> String -> GEArrow b b
addEntity String -> GESubstArrow
fct String
entity
where
checkDefined :: GEEnv -> IOSLA (XIOState s) b b
checkDefined GEEnv
geEnv
= forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall {b}. IOSLA (XIOState s) b b
ok forall {p} {s} {b} {c}. p -> IOSLA (XIOState s) b c
alreadyDefined forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> GEEnv -> Maybe GESubstArrow
lookupGeEnv String
entity forall a b. (a -> b) -> a -> b
$ GEEnv
geEnv
where
ok :: IOSLA (XIOState s) b b
ok = forall (a :: * -> * -> *) b. ArrowList a => a b b
this
alreadyDefined :: p -> IOSLA (XIOState s) b c
alreadyDefined p
_
= forall s b. String -> IOStateArrow s b b
issueWarn (String
"entity " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show String
entity forall a. [a] -> [a] -> [a]
++ String
" already defined, repeated definition ignored")
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
addEntity :: (String -> GESubstArrow) -> String -> GEArrow b b
addEntity :: forall b. (String -> GESubstArrow) -> String -> GEArrow b b
addEntity String -> GESubstArrow
fct String
entity
= forall b s. (b -> s -> s) -> IOStateArrow s b b
changeUserState forall {p}. p -> GEEnv -> GEEnv
ins
where
ins :: p -> GEEnv -> GEEnv
ins p
_ GEEnv
geEnv = String -> GESubstArrow -> GEEnv -> GEEnv
addGeEntry String
entity (String -> GESubstArrow
fct String
entity) GEEnv
geEnv
substEntitiesInAttrDefaultValue :: GEArrow XmlTree XmlTree
substEntitiesInAttrDefaultValue :: IOSLA (XIOState GEEnv) XmlTree XmlTree
substEntitiesInAttrDefaultValue
= forall (a :: * -> * -> *) b c. ArrowList a => a b (a b c) -> a b c
applyA ( forall (a :: * -> * -> *) n.
ArrowXml a =>
a n XmlTree -> a n String
xshow ( forall (a :: * -> * -> *). ArrowDTD a => String -> a XmlTree String
getDTDAttrValue String
a_default
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 =>
String -> a XmlTree XmlTree
parseXmlEntityValueAsAttrValue String
"default value of attribute"
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
filterErrorMsg
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
IOSLA (XIOState GEEnv) XmlTree XmlTree
substEntitiesInAttrValue
)
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. Arrow a => (b -> c) -> a b c
arr (forall (a :: * -> * -> *).
ArrowDTD a =>
String -> String -> a XmlTree XmlTree
setDTDAttrValue String
a_default)
)
forall (a :: * -> * -> *) b c. ArrowIf a => a b b -> a b c -> a b b
`when` forall (a :: * -> * -> *).
ArrowDTD a =>
String -> a XmlTree XmlTree
hasDTDAttr String
a_default
substEntitiesInAttrValue :: GEArrow XmlTree XmlTree
substEntitiesInAttrValue :: IOSLA (XIOState GEEnv) XmlTree XmlTree
substEntitiesInAttrValue
= ( GESubstArrow
processGeneralEntity GEContext
ReferenceInAttributeValue RecList
recl
forall (a :: * -> * -> *) b c. ArrowIf a => a b b -> a b c -> a b b
`when`
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isEntityRef
)
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 -> String) -> a XmlTree XmlTree
changeText String -> String
normalizeWhiteSpace
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
where
normalizeWhiteSpace :: String -> String
normalizeWhiteSpace = forall a b. (a -> b) -> [a] -> [b]
map ( \Char
c -> if Char
c forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
"\n\t\r" then Char
' ' else Char
c )
substEntityRef :: GEArrow XmlTree XmlTree
substEntityRef :: IOSLA (XIOState GEEnv) XmlTree XmlTree
substEntityRef
= forall (a :: * -> * -> *) b c. ArrowList a => a b (a b c) -> a b c
applyA ( ( ( forall (a :: * -> * -> *). ArrowXml a => a XmlTree String
getEntityRef
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. Int -> (b -> String) -> IOStateArrow s b b
traceValue Int
2 ((String
"processGeneralEntity: entity reference for entity " forall a. [a] -> [a] -> [a]
++) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show)
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
3 (String
"recursion list = " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show RecList
recl)
)
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 :: * -> * -> *) b1 b2 c.
ArrowList a =>
(b1 -> b2 -> c) -> a (b1, b2) c
arr2 String -> GEEnv -> IOSLA (XIOState GEEnv) XmlTree XmlTree
substA
)
where
substA :: String -> GEEnv -> GEArrow XmlTree XmlTree
substA :: String -> GEEnv -> IOSLA (XIOState GEEnv) XmlTree XmlTree
substA String
entity GEEnv
geEnv
= forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall {s} {b}. IOStateArrow s b b
entityNotFound forall {s} {b}.
(GEContext -> RecList -> IOStateArrow s b b) -> IOStateArrow s b b
entityFound forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> GEEnv -> Maybe GESubstArrow
lookupGeEnv String
entity forall a b. (a -> b) -> a -> b
$ GEEnv
geEnv
where
errMsg :: String -> IOStateArrow s b b
errMsg String
msg
= forall s b. String -> IOStateArrow s b b
issueErr String
msg
entityNotFound :: IOStateArrow s b b
entityNotFound
= forall s b. String -> IOStateArrow s b b
errMsg (String
"general entity reference \"&" forall a. [a] -> [a] -> [a]
++ String
entity forall a. [a] -> [a] -> [a]
++ String
";\" not processed, no definition found, (forward reference?)")
entityFound :: (GEContext -> RecList -> IOStateArrow s b b) -> IOStateArrow s b b
entityFound GEContext -> RecList -> IOStateArrow s b b
fct
| String
entity forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` RecList
recl
= forall s b. String -> IOStateArrow s b b
errMsg (String
"general entity reference \"&" forall a. [a] -> [a] -> [a]
++ String
entity forall a. [a] -> [a] -> [a]
++ String
";\" not processed, cyclic definition")
| Bool
otherwise
= GEContext -> RecList -> IOStateArrow s b b
fct GEContext
context RecList
recl
substExternalParsed1Time :: String -> String -> GESubstArrow
substExternalParsed1Time :: String -> String -> GESubstArrow
substExternalParsed1Time String
uri String
entity GEContext
cx RecList
rl
= forall (a :: * -> * -> *) b c. ArrowList a => a b c -> a b b
perform ( forall s b. Int -> String -> IOStateArrow s b b
traceMsg Int
2 (String
"substExternalParsed1Time: read and parse external parsed entity " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show String
entity)
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 (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
uri] []
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 s. IOStateArrow s XmlTree String
processExternalEntityContents
)
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 (a b c) -> a b c
applyA ( forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr forall a b. (a -> b) -> a -> b
$ \ String
s -> forall b. (String -> GESubstArrow) -> String -> GEArrow b b
addEntity (String -> String -> GESubstArrow
substExternalParsed String
s) String
entity )
)
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
GESubstArrow
processGeneralEntity GEContext
cx RecList
rl
where
processExternalEntityContents :: IOStateArrow s XmlTree String
processExternalEntityContents :: forall s. IOStateArrow s XmlTree String
processExternalEntityContents
= ( ( ( forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
documentStatusOk
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 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
isText)
)
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
)
forall (a :: * -> * -> *) b c. ArrowIf a => a b c -> a b c -> a b c
`orElse`
forall s b. String -> IOStateArrow s b b
issueErr (String
"illegal value for external parsed entity " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show String
entity)
)
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
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
isText)
substExternalParsed :: String -> String -> GESubstArrow
substExternalParsed :: String -> String -> GESubstArrow
substExternalParsed String
s String
entity GEContext
ReferenceInContent RecList
rl = String
-> RecList -> String -> IOSLA (XIOState GEEnv) XmlTree XmlTree
includedIfValidating String
s RecList
rl String
entity
substExternalParsed String
_ String
entity GEContext
ReferenceInAttributeValue RecList
_
= String
-> String -> String -> IOSLA (XIOState GEEnv) XmlTree XmlTree
forbidden String
entity String
"external parsed general" String
"in attribute value"
substExternalParsed String
_ String
_ GEContext
ReferenceInEntityValue RecList
_
= IOSLA (XIOState GEEnv) XmlTree XmlTree
bypassed
substInternal :: String -> String -> GESubstArrow
substInternal :: String -> String -> GESubstArrow
substInternal String
s String
entity GEContext
ReferenceInContent RecList
rl = String
-> RecList -> String -> IOSLA (XIOState GEEnv) XmlTree XmlTree
included String
s RecList
rl String
entity
substInternal String
s String
entity GEContext
ReferenceInAttributeValue RecList
rl = String
-> RecList -> String -> IOSLA (XIOState GEEnv) XmlTree XmlTree
includedInLiteral String
s RecList
rl String
entity
substInternal String
_ String
_ GEContext
ReferenceInEntityValue RecList
_ = IOSLA (XIOState GEEnv) XmlTree XmlTree
bypassed
substUnparsed :: String -> GESubstArrow
substUnparsed :: String -> GESubstArrow
substUnparsed String
entity GEContext
ReferenceInContent RecList
_ = String
-> String -> String -> IOSLA (XIOState GEEnv) XmlTree XmlTree
forbidden String
entity String
"unparsed" String
"content"
substUnparsed String
entity GEContext
ReferenceInAttributeValue RecList
_ = String
-> String -> String -> IOSLA (XIOState GEEnv) XmlTree XmlTree
forbidden String
entity String
"unparsed" String
"attribute value"
substUnparsed String
entity GEContext
ReferenceInEntityValue RecList
_ = String
-> String -> String -> IOSLA (XIOState GEEnv) XmlTree XmlTree
forbidden String
entity String
"unparsed" String
"entity value"
included :: String -> RecList -> String -> GEArrow XmlTree XmlTree
included :: String
-> RecList -> String -> IOSLA (XIOState GEEnv) XmlTree XmlTree
included String
s RecList
rl String
entity
= forall s b. Int -> String -> IOStateArrow s b b
traceMsg Int
3 (String
"substituting general entity " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show String
entity forall a. [a] -> [a] -> [a]
++ String
" with value " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show String
s)
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
forall (a :: * -> * -> *) n. ArrowXml a => String -> a n XmlTree
txt String
s
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 -> a XmlTree XmlTree
parseXmlEntityValueAsContent (String
"substituting general entity " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show String
entity forall a. [a] -> [a] -> [a]
++ String
" in contents")
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
filterErrorMsg
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
GESubstArrow
processGeneralEntity GEContext
context (String
entity forall a. a -> [a] -> [a]
: RecList
rl)
includedIfValidating :: String -> RecList -> String -> GEArrow XmlTree XmlTree
includedIfValidating :: String
-> RecList -> String -> IOSLA (XIOState GEEnv) XmlTree XmlTree
includedIfValidating
= String
-> RecList -> String -> IOSLA (XIOState GEEnv) XmlTree XmlTree
included
forbidden :: String -> String -> String -> GEArrow XmlTree XmlTree
forbidden :: String
-> String -> String -> IOSLA (XIOState GEEnv) XmlTree XmlTree
forbidden String
entity String
msg String
cx
= forall s b. String -> IOStateArrow s b b
issueErr (String
"reference of " forall a. [a] -> [a] -> [a]
++ String
msg forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show String
entity forall a. [a] -> [a] -> [a]
++ String
" forbidden in " forall a. [a] -> [a] -> [a]
++ String
cx)
includedInLiteral :: String -> RecList -> String -> GEArrow XmlTree XmlTree
includedInLiteral :: String
-> RecList -> String -> IOSLA (XIOState GEEnv) XmlTree XmlTree
includedInLiteral String
s RecList
rl String
entity
= forall (a :: * -> * -> *) n. ArrowXml a => String -> a n XmlTree
txt String
s
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 -> a XmlTree XmlTree
parseXmlEntityValueAsAttrValue (String
"substituting general entity " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show String
entity forall a. [a] -> [a] -> [a]
++ String
" in attribute value")
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
filterErrorMsg
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
GESubstArrow
processGeneralEntity GEContext
context (String
entity forall a. a -> [a] -> [a]
: RecList
rl)
bypassed :: GEArrow XmlTree XmlTree
bypassed :: IOSLA (XIOState GEEnv) XmlTree XmlTree
bypassed
= forall (a :: * -> * -> *) b. ArrowList a => a b b
this