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

{- |
   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 Map String GESubstArrow
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)
    = String -> Map String GESubstArrow -> Maybe GESubstArrow
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 (Map String GESubstArrow -> GEEnv)
-> Map String GESubstArrow -> GEEnv
forall a b. (a -> b) -> a -> b
$ String
-> GESubstArrow
-> Map String GESubstArrow
-> Map String GESubstArrow
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
    = ( Int -> String -> IOStateArrow s XmlTree XmlTree
forall s b. Int -> String -> IOStateArrow s b b
traceMsg Int
1 String
"processGeneralEntities: collect and substitute general entities"
        IOStateArrow s XmlTree XmlTree
-> IOStateArrow s XmlTree XmlTree -> IOStateArrow s XmlTree XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
        GEEnv
-> IOStateArrow GEEnv XmlTree XmlTree
-> IOStateArrow s XmlTree XmlTree
forall s1 b c s0. s1 -> IOStateArrow s1 b c -> IOStateArrow s0 b c
withOtherUserState GEEnv
emptyGeEnv (IOStateArrow GEEnv XmlTree XmlTree
-> IOStateArrow GEEnv XmlTree XmlTree
forall (t :: * -> *) b.
Tree t =>
IOSLA (XIOState GEEnv) (t b) (t b)
-> IOSLA (XIOState GEEnv) (t b) (t b)
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b) -> a (t b) (t b)
processChildren (GESubstArrow
processGeneralEntity GEContext
ReferenceInContent []))
        IOStateArrow s XmlTree XmlTree
-> IOStateArrow s XmlTree XmlTree -> IOStateArrow s XmlTree XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
        String -> IOStateArrow s XmlTree XmlTree
forall s. String -> IOStateArrow s XmlTree XmlTree
setDocumentStatusFromSystemState String
"in general entity processing"
        IOStateArrow s XmlTree XmlTree
-> IOStateArrow s XmlTree XmlTree -> IOStateArrow s XmlTree XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
        IOStateArrow s XmlTree XmlTree
forall s. IOStateArrow s XmlTree XmlTree
traceTree
        IOStateArrow s XmlTree XmlTree
-> IOStateArrow s XmlTree XmlTree -> IOStateArrow s XmlTree XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
        IOStateArrow s XmlTree XmlTree
forall s. IOStateArrow s XmlTree XmlTree
traceSource
      )
      IOStateArrow s XmlTree XmlTree
-> IOStateArrow s XmlTree XmlTree -> IOStateArrow s XmlTree XmlTree
forall b c.
IOSLA (XIOState s) b b
-> IOSLA (XIOState s) b c -> IOSLA (XIOState s) b b
forall (a :: * -> * -> *) b c. ArrowIf a => a b b -> a b c -> a b b
`when`
      IOStateArrow s XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
documentStatusOk


processGeneralEntity    :: GESubstArrow
processGeneralEntity :: GESubstArrow
processGeneralEntity GEContext
context RecList
recl
    = [IfThen
   (IOStateArrow GEEnv XmlTree XmlTree)
   (IOStateArrow GEEnv XmlTree XmlTree)]
-> IOStateArrow GEEnv XmlTree XmlTree
forall b c d.
[IfThen (IOSLA (XIOState GEEnv) b c) (IOSLA (XIOState GEEnv) b d)]
-> IOSLA (XIOState GEEnv) b d
forall (a :: * -> * -> *) b c d.
ArrowIf a =>
[IfThen (a b c) (a b d)] -> a b d
choiceA [ IOStateArrow GEEnv XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isElem          IOStateArrow GEEnv XmlTree XmlTree
-> IOStateArrow GEEnv XmlTree XmlTree
-> IfThen
     (IOStateArrow GEEnv XmlTree XmlTree)
     (IOStateArrow GEEnv XmlTree XmlTree)
forall a b. a -> b -> IfThen a b
:-> ( IOStateArrow GEEnv XmlTree XmlTree
-> IOStateArrow GEEnv XmlTree XmlTree
forall (a :: * -> * -> *).
ArrowXml a =>
a XmlTree XmlTree -> a XmlTree XmlTree
processAttrl (IOStateArrow GEEnv XmlTree XmlTree
-> IOStateArrow GEEnv XmlTree XmlTree
forall (t :: * -> *) b.
Tree t =>
IOSLA (XIOState GEEnv) (t b) (t b)
-> IOSLA (XIOState GEEnv) (t b) (t b)
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b) -> a (t b) (t b)
processChildren IOStateArrow GEEnv XmlTree XmlTree
substEntitiesInAttrValue)
                                      IOStateArrow GEEnv XmlTree XmlTree
-> IOStateArrow GEEnv XmlTree XmlTree
-> IOStateArrow GEEnv XmlTree XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
                                      IOStateArrow GEEnv XmlTree XmlTree
-> IOStateArrow GEEnv XmlTree XmlTree
forall (t :: * -> *) b.
Tree t =>
IOSLA (XIOState GEEnv) (t b) (t b)
-> IOSLA (XIOState GEEnv) (t b) (t 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)
                                    )
              , IOStateArrow GEEnv XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isEntityRef     IOStateArrow GEEnv XmlTree XmlTree
-> IOStateArrow GEEnv XmlTree XmlTree
-> IfThen
     (IOStateArrow GEEnv XmlTree XmlTree)
     (IOStateArrow GEEnv XmlTree XmlTree)
forall a b. a -> b -> IfThen a b
:-> IOStateArrow GEEnv XmlTree XmlTree
substEntityRef
              , IOStateArrow GEEnv XmlTree XmlTree
forall (a :: * -> * -> *). ArrowDTD a => a XmlTree XmlTree
isDTDDoctype    IOStateArrow GEEnv XmlTree XmlTree
-> IOStateArrow GEEnv XmlTree XmlTree
-> IfThen
     (IOStateArrow GEEnv XmlTree XmlTree)
     (IOStateArrow GEEnv XmlTree XmlTree)
forall a b. a -> b -> IfThen a b
:-> IOStateArrow GEEnv XmlTree XmlTree
-> IOStateArrow GEEnv XmlTree XmlTree
forall (t :: * -> *) b.
Tree t =>
IOSLA (XIOState GEEnv) (t b) (t b)
-> IOSLA (XIOState GEEnv) (t b) (t 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)
              , IOStateArrow GEEnv XmlTree XmlTree
forall (a :: * -> * -> *). ArrowDTD a => a XmlTree XmlTree
isDTDEntity     IOStateArrow GEEnv XmlTree XmlTree
-> IOStateArrow GEEnv XmlTree XmlTree
-> IfThen
     (IOStateArrow GEEnv XmlTree XmlTree)
     (IOStateArrow GEEnv XmlTree XmlTree)
forall a b. a -> b -> IfThen a b
:-> IOStateArrow GEEnv XmlTree XmlTree
addEntityDecl
              , IOStateArrow GEEnv XmlTree XmlTree
forall (a :: * -> * -> *). ArrowDTD a => a XmlTree XmlTree
isDTDAttlist    IOStateArrow GEEnv XmlTree XmlTree
-> IOStateArrow GEEnv XmlTree XmlTree
-> IfThen
     (IOStateArrow GEEnv XmlTree XmlTree)
     (IOStateArrow GEEnv XmlTree XmlTree)
forall a b. a -> b -> IfThen a b
:-> IOStateArrow GEEnv XmlTree XmlTree
substEntitiesInAttrDefaultValue
              , IOStateArrow GEEnv XmlTree XmlTree
forall b. IOSLA (XIOState GEEnv) b b
forall (a :: * -> * -> *) b. ArrowList a => a b b
this            IOStateArrow GEEnv XmlTree XmlTree
-> IOStateArrow GEEnv XmlTree XmlTree
-> IfThen
     (IOStateArrow GEEnv XmlTree XmlTree)
     (IOStateArrow GEEnv XmlTree XmlTree)
forall a b. a -> b -> IfThen a b
:-> IOStateArrow GEEnv XmlTree XmlTree
forall b. IOSLA (XIOState GEEnv) b b
forall (a :: * -> * -> *) b. ArrowList a => a b b
this
              ]
    where
    addEntityDecl       :: GEArrow XmlTree XmlTree
    addEntityDecl :: IOStateArrow GEEnv XmlTree XmlTree
addEntityDecl
        = IOSLA (XIOState GEEnv) XmlTree Any
-> IOStateArrow GEEnv XmlTree XmlTree
forall b c.
IOSLA (XIOState GEEnv) b c -> IOSLA (XIOState GEEnv) b b
forall (a :: * -> * -> *) b c. ArrowList a => a b c -> a b b
perform ( [IfThen
   (IOStateArrow GEEnv XmlTree XmlTree)
   (IOSLA (XIOState GEEnv) XmlTree Any)]
-> IOSLA (XIOState GEEnv) XmlTree Any
forall b c d.
[IfThen (IOSLA (XIOState GEEnv) b c) (IOSLA (XIOState GEEnv) b d)]
-> IOSLA (XIOState GEEnv) b d
forall (a :: * -> * -> *) b c d.
ArrowIf a =>
[IfThen (a b c) (a b d)] -> a b d
choiceA [ IOStateArrow GEEnv XmlTree XmlTree
isIntern          IOStateArrow GEEnv XmlTree XmlTree
-> IOSLA (XIOState GEEnv) XmlTree Any
-> IfThen
     (IOStateArrow GEEnv XmlTree XmlTree)
     (IOSLA (XIOState GEEnv) XmlTree Any)
forall a b. a -> b -> IfThen a b
:-> IOSLA (XIOState GEEnv) XmlTree Any
forall b. GEArrow XmlTree b
addInternalEntity           -- don't change sequence of cases
                            , IOStateArrow GEEnv XmlTree XmlTree
isExtern          IOStateArrow GEEnv XmlTree XmlTree
-> IOSLA (XIOState GEEnv) XmlTree Any
-> IfThen
     (IOStateArrow GEEnv XmlTree XmlTree)
     (IOSLA (XIOState GEEnv) XmlTree Any)
forall a b. a -> b -> IfThen a b
:-> IOSLA (XIOState GEEnv) XmlTree Any
forall b. GEArrow XmlTree b
addExternalEntity
                            , IOStateArrow GEEnv XmlTree XmlTree
forall b. IOSLA (XIOState GEEnv) b b
isUnparsed        IOStateArrow GEEnv XmlTree XmlTree
-> IOSLA (XIOState GEEnv) XmlTree Any
-> IfThen
     (IOStateArrow GEEnv XmlTree XmlTree)
     (IOSLA (XIOState GEEnv) XmlTree Any)
forall a b. a -> b -> IfThen a b
:-> IOSLA (XIOState GEEnv) XmlTree Any
forall b. GEArrow XmlTree b
addUnparsedEntity
                            ]
                  )
        where
        isIntern :: IOStateArrow GEEnv XmlTree XmlTree
isIntern        = IOStateArrow GEEnv XmlTree XmlTree
forall b c. IOSLA (XIOState GEEnv) b c
forall (a :: * -> * -> *) b c. ArrowList a => a b c
none IOStateArrow GEEnv XmlTree XmlTree
-> IOStateArrow GEEnv XmlTree XmlTree
-> IOStateArrow GEEnv XmlTree XmlTree
forall b c.
IOSLA (XIOState GEEnv) b b
-> IOSLA (XIOState GEEnv) b c -> IOSLA (XIOState GEEnv) b b
forall (a :: * -> * -> *) b c. ArrowIf a => a b b -> a b c -> a b b
`when` String -> IOStateArrow GEEnv XmlTree XmlTree
forall (a :: * -> * -> *).
ArrowDTD a =>
String -> a XmlTree XmlTree
hasDTDAttr String
k_system
        isExtern :: IOStateArrow GEEnv XmlTree XmlTree
isExtern        = IOStateArrow GEEnv XmlTree XmlTree
forall b c. IOSLA (XIOState GEEnv) b c
forall (a :: * -> * -> *) b c. ArrowList a => a b c
none IOStateArrow GEEnv XmlTree XmlTree
-> IOStateArrow GEEnv XmlTree XmlTree
-> IOStateArrow GEEnv XmlTree XmlTree
forall b c.
IOSLA (XIOState GEEnv) b b
-> IOSLA (XIOState GEEnv) b c -> IOSLA (XIOState GEEnv) b b
forall (a :: * -> * -> *) b c. ArrowIf a => a b b -> a b c -> a b b
`when` String -> IOStateArrow GEEnv XmlTree XmlTree
forall (a :: * -> * -> *).
ArrowDTD a =>
String -> a XmlTree XmlTree
hasDTDAttr String
k_ndata
        isUnparsed :: IOSLA (XIOState GEEnv) b b
isUnparsed      = IOSLA (XIOState GEEnv) b b
forall b. IOSLA (XIOState GEEnv) b b
forall (a :: * -> * -> *) b. ArrowList a => a b b
this

    addInternalEntity   :: GEArrow XmlTree b
    addInternalEntity :: forall b. GEArrow XmlTree b
addInternalEntity
        = String -> String -> IOSLA (XIOState GEEnv) XmlTree b
forall {b} {c}. String -> String -> IOSLA (XIOState GEEnv) b c
insertInternal (String -> String -> IOSLA (XIOState GEEnv) XmlTree b)
-> IOSLA (XIOState GEEnv) XmlTree (String, String)
-> IOSLA (XIOState GEEnv) XmlTree b
forall c1 c2 b d.
(c1 -> c2 -> IOSLA (XIOState GEEnv) b d)
-> IOSLA (XIOState GEEnv) b (c1, c2) -> IOSLA (XIOState GEEnv) b d
forall (a :: * -> * -> *) c1 c2 b d.
ArrowList a =>
(c1 -> c2 -> a b d) -> a b (c1, c2) -> a b d
$<<
          ( ( String -> IOSLA (XIOState GEEnv) XmlTree String
forall (a :: * -> * -> *). ArrowDTD a => String -> a XmlTree String
getDTDAttrValue String
a_name
              IOSLA (XIOState GEEnv) XmlTree String
-> IOSLA (XIOState GEEnv) String String
-> IOSLA (XIOState GEEnv) XmlTree String
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
              Int -> (String -> String) -> IOSLA (XIOState GEEnv) String String
forall b s. Int -> (b -> String) -> IOStateArrow s b b
traceValue Int
2 ((String
"processGeneralEntity: general entity definition for " String -> String -> String
forall a. [a] -> [a] -> [a]
++) (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
forall a. Show a => a -> String
show)
            )
            IOSLA (XIOState GEEnv) XmlTree String
-> IOSLA (XIOState GEEnv) XmlTree String
-> IOSLA (XIOState GEEnv) XmlTree (String, String)
forall b c c'.
IOSLA (XIOState GEEnv) b c
-> IOSLA (XIOState GEEnv) b c' -> IOSLA (XIOState GEEnv) b (c, c')
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&&
            IOStateArrow GEEnv XmlTree XmlTree
-> IOSLA (XIOState GEEnv) XmlTree String
forall n.
IOSLA (XIOState GEEnv) n XmlTree -> IOSLA (XIOState GEEnv) n String
forall (a :: * -> * -> *) n.
ArrowXml a =>
a n XmlTree -> a n String
xshow (IOStateArrow GEEnv XmlTree XmlTree
forall (t :: * -> *) b.
Tree t =>
IOSLA (XIOState GEEnv) (t b) (t b)
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b)
getChildren IOStateArrow GEEnv XmlTree XmlTree
-> IOStateArrow GEEnv XmlTree XmlTree
-> IOStateArrow GEEnv XmlTree XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> IOStateArrow GEEnv XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isText)
          )
        where
        insertInternal :: String -> String -> IOSLA (XIOState GEEnv) b c
insertInternal String
entity String
contents
            = (String -> GESubstArrow) -> String -> GEArrow b b
forall b. (String -> GESubstArrow) -> String -> GEArrow b b
insertEntity (String -> String -> GESubstArrow
substInternal String
contents) String
entity
              GEArrow b b
-> IOSLA (XIOState GEEnv) b c -> IOSLA (XIOState GEEnv) b c
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) b c
forall b c. IOSLA (XIOState GEEnv) b c
forall (a :: * -> * -> *) b c. ArrowList a => a b c
none

    addExternalEntity   :: GEArrow XmlTree b
    addExternalEntity :: forall b. GEArrow XmlTree b
addExternalEntity
        = String -> String -> IOSLA (XIOState GEEnv) XmlTree b
forall {b} {c}. String -> String -> IOSLA (XIOState GEEnv) b c
insertExternal (String -> String -> IOSLA (XIOState GEEnv) XmlTree b)
-> IOSLA (XIOState GEEnv) XmlTree (String, String)
-> IOSLA (XIOState GEEnv) XmlTree b
forall c1 c2 b d.
(c1 -> c2 -> IOSLA (XIOState GEEnv) b d)
-> IOSLA (XIOState GEEnv) b (c1, c2) -> IOSLA (XIOState GEEnv) b d
forall (a :: * -> * -> *) c1 c2 b d.
ArrowList a =>
(c1 -> c2 -> a b d) -> a b (c1, c2) -> a b d
$<<
          ( ( String -> IOSLA (XIOState GEEnv) XmlTree String
forall (a :: * -> * -> *). ArrowDTD a => String -> a XmlTree String
getDTDAttrValue String
a_name
              IOSLA (XIOState GEEnv) XmlTree String
-> IOSLA (XIOState GEEnv) String String
-> IOSLA (XIOState GEEnv) XmlTree String
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
              Int -> (String -> String) -> IOSLA (XIOState GEEnv) String String
forall b s. Int -> (b -> String) -> IOStateArrow s b b
traceValue Int
2 ((String
"processGeneralEntity: external entity definition for " String -> String -> String
forall a. [a] -> [a] -> [a]
++) (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
forall a. Show a => a -> String
show)
            )
            IOSLA (XIOState GEEnv) XmlTree String
-> IOSLA (XIOState GEEnv) XmlTree String
-> IOSLA (XIOState GEEnv) XmlTree (String, String)
forall b c c'.
IOSLA (XIOState GEEnv) b c
-> IOSLA (XIOState GEEnv) b c' -> IOSLA (XIOState GEEnv) b (c, c')
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&&
            String -> IOSLA (XIOState GEEnv) XmlTree String
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
            = (String -> GESubstArrow) -> String -> GEArrow b b
forall b. (String -> GESubstArrow) -> String -> GEArrow b b
insertEntity (String -> String -> GESubstArrow
substExternalParsed1Time String
uri) String
entity
              GEArrow b b
-> IOSLA (XIOState GEEnv) b c -> IOSLA (XIOState GEEnv) b c
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) b c
forall b c. IOSLA (XIOState GEEnv) b c
forall (a :: * -> * -> *) b c. ArrowList a => a b c
none

    addUnparsedEntity   :: GEArrow XmlTree b
    addUnparsedEntity :: forall b. GEArrow XmlTree b
addUnparsedEntity
        = String -> IOSLA (XIOState GEEnv) XmlTree String
forall (a :: * -> * -> *). ArrowDTD a => String -> a XmlTree String
getDTDAttrValue String
a_name
          IOSLA (XIOState GEEnv) XmlTree String
-> IOSLA (XIOState GEEnv) String b
-> IOSLA (XIOState GEEnv) XmlTree b
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
          Int -> (String -> String) -> IOSLA (XIOState GEEnv) String String
forall b s. Int -> (b -> String) -> IOStateArrow s b b
traceValue Int
2 ((String
"processGeneralEntity: unparsed entity definition for " String -> String -> String
forall a. [a] -> [a] -> [a]
++) (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
forall a. Show a => a -> String
show)
          IOSLA (XIOState GEEnv) String String
-> IOSLA (XIOState GEEnv) String b
-> IOSLA (XIOState GEEnv) String b
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) String (IOSLA (XIOState GEEnv) String String)
-> IOSLA (XIOState GEEnv) String String
forall b c.
IOSLA (XIOState GEEnv) b (IOSLA (XIOState GEEnv) b c)
-> IOSLA (XIOState GEEnv) b c
forall (a :: * -> * -> *) b c. ArrowList a => a b (a b c) -> a b c
applyA ((String -> IOSLA (XIOState GEEnv) String String)
-> IOSLA
     (XIOState GEEnv) String (IOSLA (XIOState GEEnv) String String)
forall b c. (b -> c) -> IOSLA (XIOState GEEnv) b c
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr ((String -> GESubstArrow)
-> String -> IOSLA (XIOState GEEnv) String String
forall b. (String -> GESubstArrow) -> String -> GEArrow b b
insertEntity String -> GESubstArrow
substUnparsed))
          IOSLA (XIOState GEEnv) String String
-> IOSLA (XIOState GEEnv) String b
-> IOSLA (XIOState GEEnv) String b
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) String b
forall b c. IOSLA (XIOState GEEnv) b 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
        = ( IOStateArrow GEEnv b GEEnv
forall s b. IOStateArrow s b s
getUserState
            IOStateArrow GEEnv b GEEnv
-> IOSLA (XIOState GEEnv) GEEnv GEEnv -> IOStateArrow GEEnv b GEEnv
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) GEEnv (IOSLA (XIOState GEEnv) GEEnv GEEnv)
-> IOSLA (XIOState GEEnv) GEEnv GEEnv
forall b c.
IOSLA (XIOState GEEnv) b (IOSLA (XIOState GEEnv) b c)
-> IOSLA (XIOState GEEnv) b c
forall (a :: * -> * -> *) b c. ArrowList a => a b (a b c) -> a b c
applyA ((GEEnv -> IOSLA (XIOState GEEnv) GEEnv GEEnv)
-> IOSLA
     (XIOState GEEnv) GEEnv (IOSLA (XIOState GEEnv) GEEnv GEEnv)
forall b c. (b -> c) -> IOSLA (XIOState GEEnv) b c
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr GEEnv -> IOSLA (XIOState GEEnv) GEEnv GEEnv
forall {s} {b}. GEEnv -> IOSLA (XIOState s) b b
checkDefined)
          )
          IOStateArrow GEEnv b GEEnv
-> IOSLA (XIOState GEEnv) b b -> IOSLA (XIOState GEEnv) b b
forall b c d.
IOSLA (XIOState GEEnv) b c
-> IOSLA (XIOState GEEnv) b d -> IOSLA (XIOState GEEnv) b d
forall (a :: * -> * -> *) b c d.
ArrowIf a =>
a b c -> a b d -> a b d
`guards`
          (String -> GESubstArrow) -> String -> IOSLA (XIOState GEEnv) b b
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
            = IOSLA (XIOState s) b b
-> (GESubstArrow -> IOSLA (XIOState s) b b)
-> Maybe GESubstArrow
-> IOSLA (XIOState s) b b
forall b a. b -> (a -> b) -> Maybe a -> b
maybe IOSLA (XIOState s) b b
forall {b}. IOSLA (XIOState s) b b
ok GESubstArrow -> IOSLA (XIOState s) b b
forall {p} {s} {b} {c}. p -> IOSLA (XIOState s) b c
alreadyDefined (Maybe GESubstArrow -> IOSLA (XIOState s) b b)
-> (GEEnv -> Maybe GESubstArrow) -> GEEnv -> IOSLA (XIOState s) b b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> GEEnv -> Maybe GESubstArrow
lookupGeEnv String
entity (GEEnv -> IOSLA (XIOState s) b b)
-> GEEnv -> IOSLA (XIOState s) b b
forall a b. (a -> b) -> a -> b
$ GEEnv
geEnv
            where
            ok :: IOSLA (XIOState s) b b
ok  = IOSLA (XIOState s) b b
forall {b}. IOSLA (XIOState s) b b
forall (a :: * -> * -> *) b. ArrowList a => a b b
this
            alreadyDefined :: p -> IOSLA (XIOState s) b c
alreadyDefined p
_
                = String -> IOStateArrow s b b
forall s b. String -> IOStateArrow s b b
issueWarn (String
"entity " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
entity String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" already defined, repeated definition ignored")
                  IOStateArrow s b b
-> IOSLA (XIOState s) b c -> IOSLA (XIOState s) b c
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
                  IOSLA (XIOState s) b c
forall b c. IOSLA (XIOState s) b 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
        = (b -> GEEnv -> GEEnv) -> IOStateArrow GEEnv b b
forall b s. (b -> s -> s) -> IOStateArrow s b b
changeUserState b -> GEEnv -> GEEnv
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 :: IOStateArrow GEEnv XmlTree XmlTree
substEntitiesInAttrDefaultValue
        = IOSLA (XIOState GEEnv) XmlTree (IOStateArrow GEEnv XmlTree XmlTree)
-> IOStateArrow GEEnv XmlTree XmlTree
forall b c.
IOSLA (XIOState GEEnv) b (IOSLA (XIOState GEEnv) b c)
-> IOSLA (XIOState GEEnv) b c
forall (a :: * -> * -> *) b c. ArrowList a => a b (a b c) -> a b c
applyA ( IOStateArrow GEEnv XmlTree XmlTree
-> IOSLA (XIOState GEEnv) XmlTree String
forall n.
IOSLA (XIOState GEEnv) n XmlTree -> IOSLA (XIOState GEEnv) n String
forall (a :: * -> * -> *) n.
ArrowXml a =>
a n XmlTree -> a n String
xshow ( String -> IOSLA (XIOState GEEnv) XmlTree String
forall (a :: * -> * -> *). ArrowDTD a => String -> a XmlTree String
getDTDAttrValue String
a_default                    -- parse the default value
                           IOSLA (XIOState GEEnv) XmlTree String
-> IOSLA (XIOState GEEnv) String XmlTree
-> IOStateArrow GEEnv XmlTree XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>                                          -- substitute entities
                           IOSLA (XIOState GEEnv) String XmlTree
forall (a :: * -> * -> *). ArrowXml a => a String XmlTree
mkText                                       -- and convert value into a string
                           IOSLA (XIOState GEEnv) String XmlTree
-> IOStateArrow GEEnv XmlTree XmlTree
-> IOSLA (XIOState GEEnv) String XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
                           String -> IOStateArrow GEEnv XmlTree XmlTree
forall (a :: * -> * -> *).
ArrowXml a =>
String -> a XmlTree XmlTree
parseXmlEntityValueAsAttrValue String
"default value of attribute"
                           IOStateArrow GEEnv XmlTree XmlTree
-> IOStateArrow GEEnv XmlTree XmlTree
-> IOStateArrow GEEnv XmlTree XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>                                         
                           IOStateArrow GEEnv XmlTree XmlTree
forall s. IOStateArrow s XmlTree XmlTree
filterErrorMsg
                           IOStateArrow GEEnv XmlTree XmlTree
-> IOStateArrow GEEnv XmlTree XmlTree
-> IOStateArrow GEEnv XmlTree XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
                           IOStateArrow GEEnv XmlTree XmlTree
substEntitiesInAttrValue
                         )
                   IOSLA (XIOState GEEnv) XmlTree String
-> IOSLA
     (XIOState GEEnv) String (IOStateArrow GEEnv XmlTree XmlTree)
-> IOSLA
     (XIOState GEEnv) XmlTree (IOStateArrow GEEnv XmlTree XmlTree)
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> (String -> IOStateArrow GEEnv XmlTree XmlTree)
-> IOSLA
     (XIOState GEEnv) String (IOStateArrow GEEnv XmlTree XmlTree)
forall b c. (b -> c) -> IOSLA (XIOState GEEnv) b c
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (String -> String -> IOStateArrow GEEnv XmlTree XmlTree
forall (a :: * -> * -> *).
ArrowDTD a =>
String -> String -> a XmlTree XmlTree
setDTDAttrValue String
a_default)
                 )
          IOStateArrow GEEnv XmlTree XmlTree
-> IOStateArrow GEEnv XmlTree XmlTree
-> IOStateArrow GEEnv XmlTree XmlTree
forall b c.
IOSLA (XIOState GEEnv) b b
-> IOSLA (XIOState GEEnv) b c -> IOSLA (XIOState GEEnv) b b
forall (a :: * -> * -> *) b c. ArrowIf a => a b b -> a b c -> a b b
`when` String -> IOStateArrow GEEnv XmlTree XmlTree
forall (a :: * -> * -> *).
ArrowDTD a =>
String -> a XmlTree XmlTree
hasDTDAttr String
a_default

    substEntitiesInAttrValue    :: GEArrow XmlTree XmlTree
    substEntitiesInAttrValue :: IOStateArrow GEEnv XmlTree XmlTree
substEntitiesInAttrValue
        = ( GESubstArrow
processGeneralEntity GEContext
ReferenceInAttributeValue RecList
recl
            IOStateArrow GEEnv XmlTree XmlTree
-> IOStateArrow GEEnv XmlTree XmlTree
-> IOStateArrow GEEnv XmlTree XmlTree
forall b c.
IOSLA (XIOState GEEnv) b b
-> IOSLA (XIOState GEEnv) b c -> IOSLA (XIOState GEEnv) b b
forall (a :: * -> * -> *) b c. ArrowIf a => a b b -> a b c -> a b b
`when`
            IOStateArrow GEEnv XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isEntityRef
          )
          IOStateArrow GEEnv XmlTree XmlTree
-> IOStateArrow GEEnv XmlTree XmlTree
-> IOStateArrow GEEnv XmlTree XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
          (String -> String) -> IOStateArrow GEEnv XmlTree XmlTree
forall (a :: * -> * -> *).
ArrowXml a =>
(String -> String) -> a XmlTree XmlTree
changeText String -> String
normalizeWhiteSpace
          IOStateArrow GEEnv XmlTree XmlTree
-> IOStateArrow GEEnv XmlTree XmlTree
-> IOStateArrow GEEnv XmlTree XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
          IOStateArrow GEEnv XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
transfCharRef
        where
        normalizeWhiteSpace :: String -> String
normalizeWhiteSpace = (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map ( \Char
c -> if Char
c Char -> String -> Bool
forall a. Eq a => a -> [a] -> Bool
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 :: IOStateArrow GEEnv XmlTree XmlTree
substEntityRef
        = IOSLA (XIOState GEEnv) XmlTree (IOStateArrow GEEnv XmlTree XmlTree)
-> IOStateArrow GEEnv XmlTree XmlTree
forall b c.
IOSLA (XIOState GEEnv) b (IOSLA (XIOState GEEnv) b c)
-> IOSLA (XIOState GEEnv) b c
forall (a :: * -> * -> *) b c. ArrowList a => a b (a b c) -> a b c
applyA ( ( ( IOSLA (XIOState GEEnv) XmlTree String
forall (a :: * -> * -> *). ArrowXml a => a XmlTree String
getEntityRef                             -- get the entity name and the env
                       IOSLA (XIOState GEEnv) XmlTree String
-> IOSLA (XIOState GEEnv) String String
-> IOSLA (XIOState GEEnv) XmlTree String
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
                       Int -> (String -> String) -> IOSLA (XIOState GEEnv) String String
forall b s. Int -> (b -> String) -> IOStateArrow s b b
traceValue Int
2 ((String
"processGeneralEntity: entity reference for entity " String -> String -> String
forall a. [a] -> [a] -> [a]
++) (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
forall a. Show a => a -> String
show)
                       IOSLA (XIOState GEEnv) String String
-> IOSLA (XIOState GEEnv) String String
-> IOSLA (XIOState GEEnv) String String
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
                       Int -> String -> IOSLA (XIOState GEEnv) String String
forall s b. Int -> String -> IOStateArrow s b b
traceMsg Int
3 (String
"recursion list = " String -> String -> String
forall a. [a] -> [a] -> [a]
++ RecList -> String
forall a. Show a => a -> String
show RecList
recl)
                     )
                     IOSLA (XIOState GEEnv) XmlTree String
-> IOSLA (XIOState GEEnv) XmlTree GEEnv
-> IOSLA (XIOState GEEnv) XmlTree (String, GEEnv)
forall b c c'.
IOSLA (XIOState GEEnv) b c
-> IOSLA (XIOState GEEnv) b c' -> IOSLA (XIOState GEEnv) b (c, c')
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&&
                     IOSLA (XIOState GEEnv) XmlTree GEEnv
forall s b. IOStateArrow s b s
getUserState
                   ) IOSLA (XIOState GEEnv) XmlTree (String, GEEnv)
-> IOSLA
     (XIOState GEEnv)
     (String, GEEnv)
     (IOStateArrow GEEnv XmlTree XmlTree)
-> IOSLA
     (XIOState GEEnv) XmlTree (IOStateArrow GEEnv XmlTree XmlTree)
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
                   (String -> GEEnv -> IOStateArrow GEEnv XmlTree XmlTree)
-> IOSLA
     (XIOState GEEnv)
     (String, GEEnv)
     (IOStateArrow GEEnv XmlTree XmlTree)
forall b1 b2 c.
(b1 -> b2 -> c) -> IOSLA (XIOState GEEnv) (b1, b2) c
forall (a :: * -> * -> *) b1 b2 c.
ArrowList a =>
(b1 -> b2 -> c) -> a (b1, b2) c
arr2 String -> GEEnv -> IOStateArrow GEEnv XmlTree XmlTree
substA
                 )
          where
          substA        :: String -> GEEnv -> GEArrow XmlTree XmlTree
          substA :: String -> GEEnv -> IOStateArrow GEEnv XmlTree XmlTree
substA String
entity GEEnv
geEnv
              = IOStateArrow GEEnv XmlTree XmlTree
-> (GESubstArrow -> IOStateArrow GEEnv XmlTree XmlTree)
-> Maybe GESubstArrow
-> IOStateArrow GEEnv XmlTree XmlTree
forall b a. b -> (a -> b) -> Maybe a -> b
maybe IOStateArrow GEEnv XmlTree XmlTree
forall {s} {b}. IOStateArrow s b b
entityNotFound GESubstArrow -> IOStateArrow GEEnv XmlTree XmlTree
forall {s} {b}.
(GEContext -> RecList -> IOStateArrow s b b) -> IOStateArrow s b b
entityFound (Maybe GESubstArrow -> IOStateArrow GEEnv XmlTree XmlTree)
-> (GEEnv -> Maybe GESubstArrow)
-> GEEnv
-> IOStateArrow GEEnv XmlTree XmlTree
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> GEEnv -> Maybe GESubstArrow
lookupGeEnv String
entity (GEEnv -> IOStateArrow GEEnv XmlTree XmlTree)
-> GEEnv -> IOStateArrow GEEnv XmlTree XmlTree
forall a b. (a -> b) -> a -> b
$ GEEnv
geEnv
              where
              errMsg :: String -> IOStateArrow s b b
errMsg String
msg
                  = String -> IOStateArrow s b b
forall s b. String -> IOStateArrow s b b
issueErr String
msg

              entityNotFound :: IOStateArrow s b b
entityNotFound
                  = String -> IOStateArrow s b b
forall s b. String -> IOStateArrow s b b
errMsg (String
"general entity reference \"&" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
entity String -> String -> String
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 String -> RecList -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` RecList
recl
                      = String -> IOStateArrow s b b
forall s b. String -> IOStateArrow s b b
errMsg (String
"general entity reference \"&" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
entity String -> String -> String
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
        = IOSLA (XIOState GEEnv) XmlTree String
-> IOStateArrow GEEnv XmlTree XmlTree
forall b c.
IOSLA (XIOState GEEnv) b c -> IOSLA (XIOState GEEnv) b b
forall (a :: * -> * -> *) b c. ArrowList a => a b c -> a b b
perform ( Int -> String -> IOStateArrow GEEnv XmlTree XmlTree
forall s b. Int -> String -> IOStateArrow s b b
traceMsg Int
2 (String
"substExternalParsed1Time: read and parse external parsed entity " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
entity)
                    IOStateArrow GEEnv XmlTree XmlTree
-> IOSLA (XIOState GEEnv) XmlTree String
-> IOSLA (XIOState GEEnv) XmlTree String
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
                    IOSLA (XIOState GEEnv) XmlTree String
-> IOSLA (XIOState GEEnv) XmlTree String
forall s b c. IOStateArrow s b c -> IOStateArrow s b c
runInLocalURIContext ( [IOStateArrow GEEnv XmlTree XmlTree]
-> [IOStateArrow GEEnv XmlTree XmlTree]
-> IOStateArrow GEEnv XmlTree XmlTree
forall n.
[IOSLA (XIOState GEEnv) n XmlTree]
-> [IOSLA (XIOState GEEnv) n XmlTree]
-> IOSLA (XIOState GEEnv) n XmlTree
forall (a :: * -> * -> *) n.
ArrowXml a =>
[a n XmlTree] -> [a n XmlTree] -> a n XmlTree
root [String -> String -> IOStateArrow GEEnv XmlTree XmlTree
forall n. String -> String -> IOSLA (XIOState GEEnv) n XmlTree
forall (a :: * -> * -> *) n.
ArrowXml a =>
String -> String -> a n XmlTree
sattr String
a_source String
uri] []         -- uri must be an absolute uri
                                           IOStateArrow GEEnv XmlTree XmlTree
-> IOSLA (XIOState GEEnv) XmlTree String
-> IOSLA (XIOState GEEnv) XmlTree String
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
                                           IOStateArrow GEEnv XmlTree XmlTree
forall s. IOStateArrow s XmlTree XmlTree
getXmlEntityContents
                                           IOStateArrow GEEnv XmlTree XmlTree
-> IOSLA (XIOState GEEnv) XmlTree String
-> IOSLA (XIOState GEEnv) XmlTree String
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
                                           IOSLA (XIOState GEEnv) XmlTree String
forall s. IOStateArrow s XmlTree String
processExternalEntityContents
                                         )
                    IOSLA (XIOState GEEnv) XmlTree String
-> IOSLA (XIOState GEEnv) String String
-> IOSLA (XIOState GEEnv) XmlTree String
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
                    IOSLA
  (XIOState GEEnv) String (IOSLA (XIOState GEEnv) String String)
-> IOSLA (XIOState GEEnv) String String
forall b c.
IOSLA (XIOState GEEnv) b (IOSLA (XIOState GEEnv) b c)
-> IOSLA (XIOState GEEnv) b c
forall (a :: * -> * -> *) b c. ArrowList a => a b (a b c) -> a b c
applyA ( (String -> IOSLA (XIOState GEEnv) String String)
-> IOSLA
     (XIOState GEEnv) String (IOSLA (XIOState GEEnv) String String)
forall b c. (b -> c) -> IOSLA (XIOState GEEnv) b c
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr ((String -> IOSLA (XIOState GEEnv) String String)
 -> IOSLA
      (XIOState GEEnv) String (IOSLA (XIOState GEEnv) String String))
-> (String -> IOSLA (XIOState GEEnv) String String)
-> IOSLA
     (XIOState GEEnv) String (IOSLA (XIOState GEEnv) String String)
forall a b. (a -> b) -> a -> b
$ \ String
s -> (String -> GESubstArrow)
-> String -> IOSLA (XIOState GEEnv) String String
forall b. (String -> GESubstArrow) -> String -> GEArrow b b
addEntity (String -> String -> GESubstArrow
substExternalParsed String
s) String
entity )
                  )
          IOStateArrow GEEnv XmlTree XmlTree
-> IOStateArrow GEEnv XmlTree XmlTree
-> IOStateArrow GEEnv XmlTree XmlTree
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
            = ( ( ( IOSLA (XIOState s) XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
documentStatusOk                              -- reading entity succeeded
                    IOSLA (XIOState s) XmlTree XmlTree
-> IOSLA (XIOState s) XmlTree XmlTree
-> IOSLA (XIOState s) XmlTree XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>                                           -- with content stored in a text node
                    (IOSLA (XIOState s) XmlTree XmlTree
forall (t :: * -> *) b. Tree t => IOSLA (XIOState s) (t b) (t b)
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b)
getChildren IOSLA (XIOState s) XmlTree XmlTree
-> IOSLA (XIOState s) XmlTree XmlTree
-> IOSLA (XIOState s) XmlTree XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> IOSLA (XIOState s) XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isText)
                  )
                  IOSLA (XIOState s) XmlTree XmlTree
-> IOSLA (XIOState s) XmlTree XmlTree
-> IOSLA (XIOState s) XmlTree XmlTree
forall b c d.
IOSLA (XIOState s) b c
-> IOSLA (XIOState s) b d -> IOSLA (XIOState s) b d
forall (a :: * -> * -> *) b c d.
ArrowIf a =>
a b c -> a b d -> a b d
`guards`
                  IOSLA (XIOState s) XmlTree XmlTree
forall b. IOSLA (XIOState s) b b
forall (a :: * -> * -> *) b. ArrowList a => a b b
this
                )
                IOSLA (XIOState s) XmlTree XmlTree
-> IOSLA (XIOState s) XmlTree XmlTree
-> IOSLA (XIOState s) XmlTree XmlTree
forall b c.
IOSLA (XIOState s) b c
-> IOSLA (XIOState s) b c -> IOSLA (XIOState s) b c
forall (a :: * -> * -> *) b c. ArrowIf a => a b c -> a b c -> a b c
`orElse`
                String -> IOSLA (XIOState s) XmlTree XmlTree
forall s b. String -> IOStateArrow s b b
issueErr (String
"illegal value for external parsed entity " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
entity)
              )
              IOSLA (XIOState s) XmlTree XmlTree
-> IOSLA (XIOState s) XmlTree String
-> IOSLA (XIOState s) XmlTree String
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
              IOSLA (XIOState s) XmlTree XmlTree
-> IOSLA (XIOState s) XmlTree String
forall n.
IOSLA (XIOState s) n XmlTree -> IOSLA (XIOState s) n String
forall (a :: * -> * -> *) n.
ArrowXml a =>
a n XmlTree -> a n String
xshow (IOSLA (XIOState s) XmlTree XmlTree
forall (t :: * -> *) b. Tree t => IOSLA (XIOState s) (t b) (t b)
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b)
getChildren IOSLA (XIOState s) XmlTree XmlTree
-> IOSLA (XIOState s) XmlTree XmlTree
-> IOSLA (XIOState s) XmlTree XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> IOSLA (XIOState s) XmlTree XmlTree
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 -> IOStateArrow GEEnv XmlTree XmlTree
includedIfValidating String
s RecList
rl String
entity
    substExternalParsed String
_ String
entity GEContext
ReferenceInAttributeValue RecList
_
                                                        = String -> String -> String -> IOStateArrow GEEnv XmlTree XmlTree
forbidden String
entity String
"external parsed general" String
"in attribute value"
    substExternalParsed String
_ String
_      GEContext
ReferenceInEntityValue RecList
_
                                                        = IOStateArrow GEEnv XmlTree XmlTree
bypassed

    substInternal                                       :: String -> String -> GESubstArrow
    substInternal :: String -> String -> GESubstArrow
substInternal String
s String
entity GEContext
ReferenceInContent RecList
rl        = String -> RecList -> String -> IOStateArrow GEEnv XmlTree XmlTree
included          String
s RecList
rl String
entity
    substInternal String
s String
entity GEContext
ReferenceInAttributeValue RecList
rl = String -> RecList -> String -> IOStateArrow GEEnv XmlTree XmlTree
includedInLiteral String
s RecList
rl String
entity
    substInternal String
_ String
_      GEContext
ReferenceInEntityValue RecList
_     = IOStateArrow GEEnv XmlTree XmlTree
bypassed

    substUnparsed                                       :: String -> GESubstArrow
    substUnparsed :: String -> GESubstArrow
substUnparsed String
entity GEContext
ReferenceInContent        RecList
_    = String -> String -> String -> IOStateArrow GEEnv XmlTree XmlTree
forbidden String
entity String
"unparsed" String
"content"
    substUnparsed String
entity GEContext
ReferenceInAttributeValue RecList
_    = String -> String -> String -> IOStateArrow GEEnv XmlTree XmlTree
forbidden String
entity String
"unparsed" String
"attribute value"
    substUnparsed String
entity GEContext
ReferenceInEntityValue    RecList
_    = String -> String -> String -> IOStateArrow 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 -> IOStateArrow GEEnv XmlTree XmlTree
included String
s RecList
rl String
entity
        = Int -> String -> IOStateArrow GEEnv XmlTree XmlTree
forall s b. Int -> String -> IOStateArrow s b b
traceMsg Int
3 (String
"substituting general entity " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
entity String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" with value " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
s)
          IOStateArrow GEEnv XmlTree XmlTree
-> IOStateArrow GEEnv XmlTree XmlTree
-> IOStateArrow GEEnv XmlTree XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
          String -> IOStateArrow GEEnv XmlTree XmlTree
forall n. String -> IOSLA (XIOState GEEnv) n XmlTree
forall (a :: * -> * -> *) n. ArrowXml a => String -> a n XmlTree
txt String
s
          IOStateArrow GEEnv XmlTree XmlTree
-> IOStateArrow GEEnv XmlTree XmlTree
-> IOStateArrow GEEnv XmlTree XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
          String -> IOStateArrow GEEnv XmlTree XmlTree
forall (a :: * -> * -> *).
ArrowXml a =>
String -> a XmlTree XmlTree
parseXmlEntityValueAsContent (String
"substituting general entity " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
entity String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" in contents")
          IOStateArrow GEEnv XmlTree XmlTree
-> IOStateArrow GEEnv XmlTree XmlTree
-> IOStateArrow GEEnv XmlTree XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
          IOStateArrow GEEnv XmlTree XmlTree
forall s. IOStateArrow s XmlTree XmlTree
filterErrorMsg
          IOStateArrow GEEnv XmlTree XmlTree
-> IOStateArrow GEEnv XmlTree XmlTree
-> IOStateArrow GEEnv XmlTree XmlTree
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 String -> RecList -> RecList
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 -> IOStateArrow GEEnv XmlTree XmlTree
includedIfValidating
        = String -> RecList -> String -> IOStateArrow GEEnv XmlTree XmlTree
included
                                                                        -- XML 1.0 chapter 4.4.4
    forbidden           :: String -> String -> String -> GEArrow XmlTree XmlTree
    forbidden :: String -> String -> String -> IOStateArrow GEEnv XmlTree XmlTree
forbidden String
entity String
msg String
cx
        = String -> IOStateArrow GEEnv XmlTree XmlTree
forall s b. String -> IOStateArrow s b b
issueErr (String
"reference of " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
msg String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
entity String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" forbidden in " String -> String -> String
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 -> IOStateArrow GEEnv XmlTree XmlTree
includedInLiteral String
s RecList
rl String
entity
        = String -> IOStateArrow GEEnv XmlTree XmlTree
forall n. String -> IOSLA (XIOState GEEnv) n XmlTree
forall (a :: * -> * -> *) n. ArrowXml a => String -> a n XmlTree
txt String
s
          IOStateArrow GEEnv XmlTree XmlTree
-> IOStateArrow GEEnv XmlTree XmlTree
-> IOStateArrow GEEnv XmlTree XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
          String -> IOStateArrow GEEnv XmlTree XmlTree
forall (a :: * -> * -> *).
ArrowXml a =>
String -> a XmlTree XmlTree
parseXmlEntityValueAsAttrValue (String
"substituting general entity " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
entity String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" in attribute value")
          IOStateArrow GEEnv XmlTree XmlTree
-> IOStateArrow GEEnv XmlTree XmlTree
-> IOStateArrow GEEnv XmlTree XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
          IOStateArrow GEEnv XmlTree XmlTree
forall s. IOStateArrow s XmlTree XmlTree
filterErrorMsg
          IOStateArrow GEEnv XmlTree XmlTree
-> IOStateArrow GEEnv XmlTree XmlTree
-> IOStateArrow GEEnv XmlTree XmlTree
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 String -> RecList -> RecList
forall a. a -> [a] -> [a]
: RecList
rl)
                                                                        -- XML 1.0 chapter 4.4.7
    bypassed            :: GEArrow XmlTree XmlTree
    bypassed :: IOStateArrow GEEnv XmlTree XmlTree
bypassed
        = IOStateArrow GEEnv XmlTree XmlTree
forall b. IOSLA (XIOState GEEnv) b b
forall (a :: * -> * -> *) b. ArrowList a => a b b
this

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