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

{- |
   Module     : Text.XML.HXT.Arrow.GeneralEntitySubstitution
   Copyright  : Copyright (C) 2005 Uwe Schmidt
   License    : MIT

   Maintainer : Uwe Schmidt (uwe@fh-wedel.de)
   Stability  : experimental
   Portability: portable

   general entity substitution

-}

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

module Text.XML.HXT.Arrow.GeneralEntitySubstitution
    ( processGeneralEntities )
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 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
    -- or OccursInAttributeValue                                -- not used during substitution but during validation
    -- or ReferenceInDTD                                        -- not used: syntax check detects errors

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

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

-- |
-- substitution of general entities
--
-- input: a complete document tree including root node

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           -- don't change sequence of cases
                            , 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                       -- the absolute URL, not the relative in attr: k_system
          )
        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                    -- parse the default value
                           forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>                                          -- substitute entities
                           forall (a :: * -> * -> *). ArrowXml a => a String XmlTree
mkText                                       -- and convert value into a 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 :: * -> * -> *).
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                             -- get the entity name and the env
                       forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>                                      -- and compute the arrow to be applied
                       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] []         -- uri must be an absolute uri
                                           forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>                                  -- abs uri is computed during parameter entity handling
                                           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                              -- reading entity succeeded
                    forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>                                           -- with content stored in a text node
                    (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"

                                                                        -- XML 1.0 chapter 4.4.2
    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)

                                                                        -- XML 1.0 chapter 4.4.3
    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
                                                                        -- XML 1.0 chapter 4.4.4
    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)

                                                                        -- XML 1.0 chapter 4.4.5
    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)
                                                                        -- XML 1.0 chapter 4.4.7
    bypassed            :: GEArrow XmlTree XmlTree
    bypassed :: IOSLA (XIOState GEEnv) XmlTree XmlTree
bypassed
        = forall (a :: * -> * -> *) b. ArrowList a => a b b
this

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