    {-# LANGUAGE DeriveDataTypeable #-}

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

    {- |
       Module     : Text.XML.HXT.DOM.QualifiedName
       Copyright  : Copyright (C) 2011 Uwe Schmidt
       License    : MIT

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

       The types and functions for qualified names

    -}

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

    module Text.XML.HXT.DOM.QualifiedName
        ( QName
        , XName(unXN)
        , NsEnv

        , mkQName
        , mkName
        , mkNsName
        , mkSNsName
        , mkPrefixLocalPart

        , equivQName
        , equivUri
        , equalQNameBy

        , namePrefix
        , localPart
        , namespaceUri

        , newXName
        , nullXName
        , isNullXName
        , newQName

        , mkQName'
        , namePrefix'
        , localPart'
        , namespaceUri'

        , setNamePrefix'
        , setLocalPart'
        , setNamespaceUri'

        , qualifiedName
        , qualifiedName'
        , universalName
        , universalUri
        , buildUniversalName

        , normalizeNsUri

        , setNamespace                      -- namespace related functions
        , isNCName
        , isWellformedQualifiedName
        , isWellformedQName
        , isWellformedNSDecl
        , isWellformedNameSpaceName
        , isNameSpaceName
        , isDeclaredNamespace

        , xmlNamespaceXName
        , xmlXName
        , xmlnsNamespaceXName
        , xmlnsXName
        , xmlnsQN

        , toNsEnv
        )

    where

    {-
    import           Debug.Trace
     -}

    import           Control.Arrow                     ((***))

    import           Control.DeepSeq
    import           Control.FlatSeq

    import           Data.AssocList
    import           Data.Binary
    import           Data.Char                         (toLower)
    import           Data.IORef
    import           Data.List                         (isPrefixOf)
    import qualified Data.Map                          as M
    import           Data.Typeable

    import           System.IO.Unsafe                  (unsafePerformIO)

    import           Text.XML.HXT.DOM.XmlKeywords      (a_xml, a_xmlns,
                                                        xmlNamespace,
                                                        xmlnsNamespace)

    import           Data.Char.Properties.XMLCharProps (isXmlNCNameChar,
                                                        isXmlNCNameStartChar)

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

    -- | XML names are represented by Strings, but these strings do not mix up with normal strings.
    -- Names are always reduced to normal form, and they are stored internally in a name cache
    -- for sharing equal names by the same data structure

    data XName                      = XN { XName -> Int
    _idXN :: !Int        -- for optimization of equality test, see Eq instance
                                         ,  XName -> String
    unXN ::   String
                                         }
                                      deriving (Typeable)

    instance Eq XName where
        (XN Int
    id1 String
    _) == :: XName -> XName -> Bool
    == (XN Int
    id2 String
    _)    = Int
    id1 Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    id2

    instance Ord XName where
        compare :: XName -> XName -> Ordering
    compare (XN Int
    _ String
    n1) (XN Int
    _ String
    n2) = String -> String -> Ordering
    forall a. Ord a => a -> a -> Ordering
    compare String
    n1 String
    n2
    {-
    instance Read XName where
        readsPrec p str             = [ (newXName x, y) | (x, y) <- readsPrec p str ]

    instance Show XName where
        show (XN _ s)               = show s
    -}
    instance NFData XName where
        rnf :: XName -> ()
    rnf (XN Int
    _ String
    s)                = String -> ()
    forall a. NFData a => a -> ()
    rnf String
    s

    instance WNFData XName where
        rwnf :: XName -> ()
    rwnf (XN Int
    _ String
    s)               = String -> ()
    forall a. NFData a => a -> ()
    rnf String
    s

    instance Binary XName where
        put :: XName -> Put
    put (XN Int
    _ String
    s)                = String -> Put
    forall t. Binary t => t -> Put
    put String
    s
        get :: Get XName
    get                         = do
                                      String
    s <- Get String
    forall t. Binary t => Get t
    get
                                      XName -> Get XName
    forall a. a -> Get a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (XName -> Get XName) -> XName -> Get XName
    forall a b. (a -> b) -> a -> b
    $! String -> XName
    newXName String
    s

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

    -- |
    -- Type for the namespace association list, used when propagating namespaces by
    -- modifying the 'QName' values in a tree

    type NsEnv              = AssocList XName XName

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

    -- |
    -- Namespace support for element and attribute names.
    --
    -- A qualified name consists of a name prefix, a local name
    -- and a namespace uri.
    -- All modules, which are not namespace aware, use only the 'localPart' component.
    -- When dealing with namespaces, the document tree must be processed by 'Text.XML.HXT.Arrow.Namespace.propagateNamespaces'
    -- to split names of structure \"prefix:localPart\" and label the name with the apropriate namespace uri

    data QName      = QN { QName -> XName
    localPart'    :: !XName
                         , QName -> XName
    namePrefix'   :: !XName
                         , QName -> XName
    namespaceUri' :: !XName
                         }
                 deriving (Typeable)

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

    -- | Two QNames are equal if (1. case) namespaces are both empty and the qualified names
    -- (prefix:localpart) are the same or (2. case) namespaces are set and namespaces and
    -- local parts are equal

    instance Eq QName where
        (QN XName
    lp1 XName
    px1 XName
    ns1) == :: QName -> QName -> Bool
    == (QN XName
    lp2 XName
    px2 XName
    ns2)
            | XName
    ns1 XName -> XName -> Bool
    forall a. Eq a => a -> a -> Bool
    /= XName
    ns2            = Bool
    False                 -- namespaces are set and differ
            | Bool -> Bool
    not (XName -> Bool
    isNullXName XName
    ns1) = XName
    lp1 XName -> XName -> Bool
    forall a. Eq a => a -> a -> Bool
    == XName
    lp2            -- namespaces are set and are equal: local parts must be equal
            | Bool
    otherwise             = XName
    lp1 XName -> XName -> Bool
    forall a. Eq a => a -> a -> Bool
    == XName
    lp2            -- no namespaces are set: local parts must be equal
                                      Bool -> Bool -> Bool
    &&                    -- and prefixes are not set or they are equal
                                      XName
    px1 XName -> XName -> Bool
    forall a. Eq a => a -> a -> Bool
    == XName
    px2

    instance Ord QName where
      compare :: QName -> QName -> Ordering
    compare (QN XName
    lp1 XName
    px1 XName
    ns1) (QN XName
    lp2 XName
    px2 XName
    ns2)
          | XName -> Bool
    isNullXName XName
    ns1 Bool -> Bool -> Bool
    && XName -> Bool
    isNullXName XName
    ns2              -- no namespaces set: px is significant
              = (XName, XName) -> (XName, XName) -> Ordering
    forall a. Ord a => a -> a -> Ordering
    compare (XName
    px1, XName
    lp1) (XName
    px2, XName
    lp2)
          | Bool
    otherwise                                       -- namespace aware cmp: ns is significant, px is irrelevant
              = (XName, XName) -> (XName, XName) -> Ordering
    forall a. Ord a => a -> a -> Ordering
    compare (XName
    lp1, XName
    ns1) (XName
    lp2, XName
    ns2)

    instance NFData  QName where
        rnf :: QName -> ()
    rnf QName
    x = QName -> () -> ()
    forall a b. a -> b -> b
    seq QName
    x ()

    instance WNFData QName

    instance Show QName where
        show :: QName -> String
    show = QName -> String
    showQN

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

    instance Binary QName where
        put :: QName -> Put
    put (QN XName
    lp XName
    px XName
    ns)   = String -> Put
    forall t. Binary t => t -> Put
    put (XName -> String
    unXN XName
    px) Put -> Put -> Put
    forall a b. PutM a -> PutM b -> PutM b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >>
                              String -> Put
    forall t. Binary t => t -> Put
    put (XName -> String
    unXN XName
    lp) Put -> Put -> Put
    forall a b. PutM a -> PutM b -> PutM b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >>
                              String -> Put
    forall t. Binary t => t -> Put
    put (XName -> String
    unXN XName
    ns)
        get :: Get QName
    get                 = do
                              String
    px <- Get String
    forall t. Binary t => Get t
    get
                              String
    lp <- Get String
    forall t. Binary t => Get t
    get
                              String
    ns <- Get String
    forall t. Binary t => Get t
    get
                              QName -> Get QName
    forall a. a -> Get a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (QName -> Get QName) -> QName -> Get QName
    forall a b. (a -> b) -> a -> b
    $! String -> String -> String -> QName
    newNsName String
    lp String
    px String
    ns
                              --     ^^
                              -- strict apply !!!
                              -- build the QNames strict, else the name sharing optimization will not be in effect

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

    isNullXName             :: XName -> Bool
    isNullXName :: XName -> Bool
    isNullXName             = (XName -> XName -> Bool
    forall a. Eq a => a -> a -> Bool
    == XName
    nullXName)
    {-# INLINE isNullXName #-}

    namePrefix              :: QName -> String
    namePrefix :: QName -> String
    namePrefix              = XName -> String
    unXN (XName -> String) -> (QName -> XName) -> QName -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . QName -> XName
    namePrefix'
    {-# INLINE namePrefix #-}

    localPart               :: QName -> String
    localPart :: QName -> String
    localPart               = XName -> String
    unXN (XName -> String) -> (QName -> XName) -> QName -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . QName -> XName
    localPart'
    {-# INLINE localPart #-}

    namespaceUri            :: QName -> String
    namespaceUri :: QName -> String
    namespaceUri            = XName -> String
    unXN (XName -> String) -> (QName -> XName) -> QName -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . QName -> XName
    namespaceUri'
    {-# INLINE namespaceUri #-}

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

    -- | set name prefix

    setNamespaceUri'                        :: XName -> QName -> QName
    setNamespaceUri' :: XName -> QName -> QName
    setNamespaceUri' XName
    ns (QN XName
    lp XName
    px XName
    _ns)      = XName -> XName -> XName -> QName
    newQName XName
    lp XName
    px XName
    ns

    -- | set local part

    setLocalPart'                           :: XName -> QName -> QName
    setLocalPart' :: XName -> QName -> QName
    setLocalPart' XName
    lp (QN XName
    _lp XName
    px XName
    ns)         = XName -> XName -> XName -> QName
    newQName XName
    lp XName
    px XName
    ns

    -- | set name prefix

    setNamePrefix'                          :: XName -> QName -> QName
    setNamePrefix' :: XName -> QName -> QName
    setNamePrefix' XName
    px (QN XName
    lp XName
    _px XName
    ns)        = XName -> XName -> XName -> QName
    newQName XName
    lp XName
    px XName
    ns

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

    -- |
    -- builds the full name \"prefix:localPart\", if prefix is not null, else the local part is the result

    qualifiedName                   :: QName -> String
    qualifiedName :: QName -> String
    qualifiedName (QN XName
    lp XName
    px XName
    _ns)
        | XName -> Bool
    isNullXName XName
    px            = XName -> String
    unXN XName
    lp
        | Bool
    otherwise                 = XName -> String
    unXN XName
    px String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ (Char
    ':' Char -> ShowS
    forall a. a -> [a] -> [a]
    : XName -> String
    unXN XName
    lp)

    -- | functional list version of qualifiedName used in xshow

    qualifiedName'                   :: QName -> String -> String
    qualifiedName' :: QName -> ShowS
    qualifiedName' (QN XName
    lp XName
    px XName
    _ns)
        | XName -> Bool
    isNullXName XName
    px            = (XName -> String
    unXN XName
    lp String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++)
        | Bool
    otherwise                 = (XName -> String
    unXN XName
    px String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++) ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Char
    ':' Char -> ShowS
    forall a. a -> [a] -> [a]
    :) ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (XName -> String
    unXN XName
    lp String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++)

    -- |
    -- builds the \"universal\" name, that is the namespace uri surrounded with \"{\" and \"}\" followed by the local part
    -- (specialisation of 'buildUniversalName')

    universalName                   :: QName -> String
    universalName :: QName -> String
    universalName                   = (String -> ShowS) -> QName -> String
    buildUniversalName (\ String
    ns String
    lp -> Char
    '{' Char -> ShowS
    forall a. a -> [a] -> [a]
    : String
    ns String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Char
    '}' Char -> ShowS
    forall a. a -> [a] -> [a]
    : String
    lp)

    -- |
    -- builds an \"universal\" uri, that is the namespace uri followed by the local part. This is usefull for RDF applications,
    -- where the subject, predicate and object often are concatenated from namespace uri and local part
    -- (specialisation of 'buildUniversalName')

    universalUri                    :: QName -> String
    universalUri :: QName -> String
    universalUri                    = (String -> ShowS) -> QName -> String
    buildUniversalName String -> ShowS
    forall a. [a] -> [a] -> [a]
    (++)

    -- |
    -- builds a string from the namespace uri and the local part. If the namespace uri is empty, the local part is returned, else
    -- namespace uri and local part are combined with the combining function given by the first parameter

    buildUniversalName              :: (String -> String -> String) -> QName -> String
    buildUniversalName :: (String -> ShowS) -> QName -> String
    buildUniversalName String -> ShowS
    bf n :: QName
    n@(QN XName
    _lp XName
    _px XName
    ns)
        | XName -> Bool
    isNullXName XName
    ns            = QName -> String
    localPart QName
    n
        | Bool
    otherwise                 = XName -> String
    unXN XName
    ns String -> ShowS
    `bf` QName -> String
    localPart QName
    n

    showQN                          :: QName -> String
    showQN :: QName -> String
    showQN QName
    n
        | String -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null String
    ns                   = ShowS
    forall a. Show a => a -> String
    show ShowS -> ShowS
    forall a b. (a -> b) -> a -> b
    $ QName -> String
    qualifiedName QName
    n
        | Bool
    otherwise                 = ShowS
    forall a. Show a => a -> String
    show ShowS -> ShowS
    forall a b. (a -> b) -> a -> b
    $ String
    "{" String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    ns String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    "}" String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ QName -> String
    qualifiedName QName
    n
        where
        ns :: String
    ns = QName -> String
    namespaceUri QName
    n

    -- ------------------------------------------------------------
    --
    -- internal XName functions

    mkQName'                        :: XName -> XName -> XName -> QName
    mkQName' :: XName -> XName -> XName -> QName
    mkQName' XName
    px XName
    lp XName
    ns               = XName -> XName -> XName -> QName
    newQName XName
    lp XName
    px XName
    ns
    {-# DEPRECATED mkQName' "use newQName instead with lp px ns param seq " #-}

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

    -- |
    -- constructs a simple name, with prefix and localPart but without a namespace uri.
    --
    -- see also 'mkQName', 'mkName'

    mkPrefixLocalPart               :: String -> String -> QName
    mkPrefixLocalPart :: String -> String -> QName
    mkPrefixLocalPart String
    px String
    lp
        | String -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null String
    px                   = String -> QName
    newLpName String
    lp
        | Bool
    otherwise                 = String -> String -> QName
    newPxName String
    lp String
    px

    -- |
    -- constructs a simple, namespace unaware name.
    -- If the name is in @prefix:localpart@ form and the prefix is not empty
    -- the name is split internally into
    -- a prefix and a local part.

    mkName                          :: String -> QName
    mkName :: String -> QName
    mkName String
    n
        | (Char
    ':' Char -> String -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` String
    n)
          Bool -> Bool -> Bool
    &&
          Bool -> Bool
    not (String -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null String
    px)                     -- more restrictive: isWellformedQualifiedName n
                                    = String -> String -> QName
    newPxName String
    lp String
    px
        | Bool
    otherwise                 = String -> QName
    newLpName String
    n
        where
        (String
    px, (Char
    _ : String
    lp)) = (Char -> Bool) -> String -> (String, String)
    forall a. (a -> Bool) -> [a] -> ([a], [a])
    span (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Char
    ':') String
    n

    -- |
    -- constructs a complete qualified name with 'namePrefix', 'localPart' and 'namespaceUri'.
    -- This function can be used to build not wellformed prefix:localpart names.
    -- The XPath module uses wildcard names like @xxx:*@. These must be build with 'mkQName'
    -- and not with mkName.

    mkQName                         :: String -> String -> String -> QName
    mkQName :: String -> String -> String -> QName
    mkQName String
    px String
    lp String
    ns
        | String -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null String
    ns                   = String -> String -> QName
    mkPrefixLocalPart String
    px String
    lp
        | Bool
    otherwise                 = String -> String -> String -> QName
    newNsName String
    lp String
    px String
    ns

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

    -- |
    -- old name for 'mkName'

    mkSNsName                       :: String -> QName
    mkSNsName :: String -> QName
    mkSNsName                       = String -> QName
    mkName
    {-# DEPRECATED mkSNsName "use mkName instead" #-}

    -- |
    -- constructs a simple, namespace aware name, with prefix:localPart as first parameter,
    -- namspace uri as second.
    --
    -- see also 'mkName', 'mkPrefixLocalPart'

    {-
    mkNsName                          :: String -> String -> QName
    mkNsName n ns                     = trace ("mkNsName: " ++ show n ++ " " ++ show ns) (mkNsName' n ns)
    -}

    mkNsName                          :: String -> String -> QName
    mkNsName :: String -> String -> QName
    mkNsName String
    n String
    ns
        | String -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null String
    ns                   = QName
    qn
        | Bool
    otherwise                 = XName -> QName -> QName
    setNamespaceUri' XName
    ns' QName
    qn
        where
        qn :: QName
    qn                          = String -> QName
    mkName String
    n
        ns' :: XName
    ns'                         = String -> XName
    newXName String
    ns

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

    -- | Equivalent QNames are defined as follows: The URIs are normalized before comparison.
    -- Comparison is done with 'equalQNameBy' and 'equivUri'

    equivQName                      :: QName -> QName -> Bool
    equivQName :: QName -> QName -> Bool
    equivQName                      = (String -> String -> Bool) -> QName -> QName -> Bool
    equalQNameBy String -> String -> Bool
    equivUri

    -- | Comparison of normalized namespace URIs using 'normalizeNsUri'

    equivUri                        :: String -> String -> Bool
    equivUri :: String -> String -> Bool
    equivUri String
    x String
    y                    = ShowS
    normalizeNsUri String
    x String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    == ShowS
    normalizeNsUri String
    y

    -- | Sometimes a weaker equality relation than 'equalQName' is appropriate, e.g no case significance in names, ...
    -- a name normalization function can be applied to the strings before comparing. Called by 'equalQName' and
    -- 'equivQName'

    equalQNameBy                    :: (String -> String -> Bool) -> QName -> QName -> Bool
    equalQNameBy :: (String -> String -> Bool) -> QName -> QName -> Bool
    equalQNameBy String -> String -> Bool
    equiv QName
    q1 QName
    q2        = QName -> String
    localPart QName
    q1 String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    == QName -> String
    localPart QName
    q2
                                      Bool -> Bool -> Bool
    &&
                                      (QName -> String
    namespaceUri QName
    q1 String -> String -> Bool
    `equiv` QName -> String
    namespaceUri QName
    q2)

    -- |  Normalization of URIs: Normalization is done by conversion into lowercase letters. A trailing \"\/\" is ignored

    normalizeNsUri                  :: String -> String
    normalizeNsUri :: ShowS
    normalizeNsUri                  = (Char -> Char) -> ShowS
    forall a b. (a -> b) -> [a] -> [b]
    map Char -> Char
    toLower ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ShowS
    stripSlash
        where
        stripSlash :: ShowS
    stripSlash String
    ""               = String
    ""
        stripSlash String
    s
            | String -> Char
    forall a. HasCallStack => [a] -> a
    last String
    s Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    '/'         = ShowS
    forall a. HasCallStack => [a] -> [a]
    init String
    s
            | Bool
    otherwise             = String
    s

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

    -- Namespace predicates

    -- |
    -- Compute the name prefix and the namespace uri for a qualified name.
    --
    -- This function does not test whether the name is a wellformed qualified name.
    -- see Namespaces in XML Rule [6] to [8]. Error checking is done with separate functions,
    -- see 'isWellformedQName' and 'isWellformedQualifiedName' for error checking.

    setNamespace                    :: NsEnv -> QName -> QName
    setNamespace :: NsEnv -> QName -> QName
    setNamespace NsEnv
    env n :: QName
    n@(QN XName
    lp XName
    px XName
    _ns)
                                    = QName -> (XName -> QName) -> Maybe XName -> QName
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe QName
    n (\ XName
    ns -> XName -> XName -> XName -> QName
    newQName XName
    lp XName
    px XName
    ns) (Maybe XName -> QName) -> (NsEnv -> Maybe XName) -> NsEnv -> QName
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . XName -> NsEnv -> Maybe XName
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    lookup XName
    px (NsEnv -> QName) -> NsEnv -> QName
    forall a b. (a -> b) -> a -> b
    $ NsEnv
    env

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

    -- |
    -- test for wellformed NCName, rule [4] XML Namespaces

    isNCName                        :: String -> Bool
    isNCName :: String -> Bool
    isNCName []                     = Bool
    False
    isNCName String
    n                      = [Bool] -> Bool
    forall (t :: * -> *). Foldable t => t Bool -> Bool
    and ( ((Char -> Bool) -> Char -> Bool)
    -> [Char -> Bool] -> String -> [Bool]
    forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
    zipWith (Char -> Bool) -> Char -> Bool
    forall a b. (a -> b) -> a -> b
    ($)
                                            (Char -> Bool
    isXmlNCNameStartChar (Char -> Bool) -> [Char -> Bool] -> [Char -> Bool]
    forall a. a -> [a] -> [a]
    : (Char -> Bool) -> [Char -> Bool]
    forall a. a -> [a]
    repeat Char -> Bool
    isXmlNCNameChar)
                                            String
    n
                                          )

    -- |
    -- test for wellformed QName, rule [6] XML Namespaces
    -- predicate is used in filter 'valdateNamespaces'.

    isWellformedQualifiedName       :: String -> Bool
    isWellformedQualifiedName :: String -> Bool
    isWellformedQualifiedName String
    s
        | String -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null String
    lp                   = String -> Bool
    isNCName String
    px
        | Bool
    otherwise                 = String -> Bool
    isNCName String
    px Bool -> Bool -> Bool
    && String -> Bool
    isNCName (ShowS
    forall a. HasCallStack => [a] -> [a]
    tail String
    lp)
        where
        (String
    px, String
    lp)                    = (Char -> Bool) -> String -> (String, String)
    forall a. (a -> Bool) -> [a] -> ([a], [a])
    span (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Char
    ':') String
    s

    -- |
    -- test for wellformed QName values.
    -- A QName is wellformed, if the local part is a NCName, the namePrefix, if not empty, is also a NCName.
    -- predicate is used in filter 'valdateNamespaces'.

    isWellformedQName               :: QName -> Bool
    isWellformedQName :: QName -> Bool
    isWellformedQName (QN XName
    lp XName
    px XName
    _ns)
                                    = (String -> Bool
    isNCName (String -> Bool) -> (XName -> String) -> XName -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . XName -> String
    unXN) XName
    lp                          -- rule [8] XML Namespaces
                                      Bool -> Bool -> Bool
    &&
                                      ( XName -> Bool
    isNullXName XName
    px
                                        Bool -> Bool -> Bool
    ||
                                        (String -> Bool
    isNCName (String -> Bool) -> (XName -> String) -> XName -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . XName -> String
    unXN) XName
    px                        -- rule [7] XML Namespaces
                                      )

    -- |
    -- test whether an attribute name is a namesapce declaration name.
    -- If this is not the case True is the result, else
    -- the name must be a well formed namespace name:
    -- All namespace prefixes starting with \"xml\" are reserved for XML related definitions.
    -- predicate is used in filter 'valdateNamespaces'.

    isWellformedNSDecl              :: QName -> Bool
    isWellformedNSDecl :: QName -> Bool
    isWellformedNSDecl QName
    n
                                    = Bool -> Bool
    not (QName -> Bool
    isNameSpaceName QName
    n)
                                      Bool -> Bool -> Bool
    ||
                                      QName -> Bool
    isWellformedNameSpaceName QName
    n

    -- |
    -- test for a namespace name to be well formed

    isWellformedNameSpaceName       :: QName -> Bool
    isWellformedNameSpaceName :: QName -> Bool
    isWellformedNameSpaceName n :: QName
    n@(QN XName
    lp XName
    px XName
    _ns)
        | XName -> Bool
    isNullXName XName
    px            = XName
    lp XName -> XName -> Bool
    forall a. Eq a => a -> a -> Bool
    == XName
    xmlnsXName
        | Bool
    otherwise                 = XName
    px XName -> XName -> Bool
    forall a. Eq a => a -> a -> Bool
    == XName
    xmlnsXName
                                      Bool -> Bool -> Bool
    &&
                                      Bool -> Bool
    not (String -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null String
    lp')
                                      Bool -> Bool -> Bool
    &&
                                      Bool -> Bool
    not (String
    a_xml String -> String -> Bool
    forall a. Eq a => [a] -> [a] -> Bool
    `isPrefixOf` String
    lp')
        where
        lp' :: String
    lp'                         = QName -> String
    localPart QName
    n

    -- |
    -- test whether a name is a namespace declaration attribute name

    isNameSpaceName                         :: QName -> Bool
    isNameSpaceName :: QName -> Bool
    isNameSpaceName (QN XName
    lp XName
    px XName
    _ns)
        | XName -> Bool
    isNullXName XName
    px                    = XName
    lp XName -> XName -> Bool
    forall a. Eq a => a -> a -> Bool
    == XName
    xmlnsXName
        | Bool
    otherwise                         = XName
    px XName -> XName -> Bool
    forall a. Eq a => a -> a -> Bool
    == XName
    xmlnsXName

    -- |
    --
    -- predicate is used in filter 'valdateNamespaces'.

    isDeclaredNamespace                     :: QName -> Bool
    isDeclaredNamespace :: QName -> Bool
    isDeclaredNamespace (QN XName
    _lp XName
    px XName
    ns)
        | XName -> Bool
    isNullXName XName
    px                    = Bool
    True                          -- no namespace used
        | XName
    px XName -> XName -> Bool
    forall a. Eq a => a -> a -> Bool
    == XName
    xmlnsXName                  = XName
    ns XName -> XName -> Bool
    forall a. Eq a => a -> a -> Bool
    == XName
    xmlnsNamespaceXName     -- "xmlns" has a predefined namespace uri
        | XName
    px XName -> XName -> Bool
    forall a. Eq a => a -> a -> Bool
    == XName
    xmlXName                    = XName
    ns XName -> XName -> Bool
    forall a. Eq a => a -> a -> Bool
    == XName
    xmlNamespaceXName       -- "xml" has a predefiend namespace"
        | Bool
    otherwise                         = Bool -> Bool
    not (XName -> Bool
    isNullXName XName
    ns)          -- namespace values are not empty

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

    toNsEnv                         :: AssocList String String -> NsEnv
    toNsEnv :: AssocList String String -> NsEnv
    toNsEnv                         = ((String, String) -> (XName, XName))
    -> AssocList String String -> NsEnv
    forall a b. (a -> b) -> [a] -> [b]
    map (String -> XName
    newXName (String -> XName)
    -> (String -> XName) -> (String, String) -> (XName, XName)
    forall b c b' c'. (b -> c) -> (b' -> c') -> (b, b') -> (c, c')
    forall (a :: * -> * -> *) b c b' c'.
    Arrow a =>
    a b c -> a b' c' -> a (b, b') (c, c')
    *** String -> XName
    newXName)

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

    -- the name and string cache

    data NameCache          = NC { NameCache -> Int
    _newXN   :: !Int                                       -- next free name id
                                 , NameCache -> Map String XName
    _xnCache :: !(M.Map String XName)
                                 , NameCache -> Map (XName, XName, XName) QName
    _qnCache :: !(M.Map (XName, XName, XName) QName)       -- we need another type than QName
                                 }                                                          -- for the key because of the unusable
                                                                                            -- Eq instance of QName
    type ChangeNameCache r  = NameCache -> (NameCache, r)

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

    -- | the internal cache for QNames (and name strings)

    theNameCache            :: IORef NameCache
    theNameCache :: IORef NameCache
    theNameCache            = IO (IORef NameCache) -> IORef NameCache
    forall a. IO a -> a
    unsafePerformIO (NameCache -> IO (IORef NameCache)
    forall a. a -> IO (IORef a)
    newIORef (NameCache -> IO (IORef NameCache))
    -> NameCache -> IO (IORef NameCache)
    forall a b. (a -> b) -> a -> b
    $ NameCache
    initialCache)
    {-# NOINLINE theNameCache #-}

    initialXNames           :: [XName]

    nullXName
     , xmlnsNamespaceXName
     , xmlnsXName
     , xmlNamespaceXName
     , xmlXName             :: XName

    initialXNames :: [XName]
    initialXNames@[
       XName
    nullXName
     , XName
    xmlnsNamespaceXName
     , XName
    xmlnsXName
     , XName
    xmlNamespaceXName
     , XName
    xmlXName
     ]                      = (Int -> String -> XName) -> [Int] -> [String] -> [XName]
    forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
    zipWith Int -> String -> XName
    XN [Int
    0..] ([String] -> [XName]) -> [String] -> [XName]
    forall a b. (a -> b) -> a -> b
    $
                              [ String
    ""
                              , String
    xmlnsNamespace
                              , String
    a_xmlns
                              , String
    xmlNamespace
                              , String
    a_xml
                              ]

    initialQNames           :: [QName]

    xmlnsQN                 :: QName

    initialQNames :: [QName]
    initialQNames@[QName
    xmlnsQN] = [XName -> XName -> XName -> QName
    QN XName
    xmlnsXName XName
    nullXName XName
    xmlnsNamespaceXName]

    initialCache            :: NameCache
    initialCache :: NameCache
    initialCache            = Int
    -> Map String XName -> Map (XName, XName, XName) QName -> NameCache
    NC
                              ([XName] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [XName]
    initialXNames)
                              ([(String, XName)] -> Map String XName
    forall k a. Ord k => [(k, a)] -> Map k a
    M.fromList ([(String, XName)] -> Map String XName)
    -> [(String, XName)] -> Map String XName
    forall a b. (a -> b) -> a -> b
    $ (XName -> (String, XName)) -> [XName] -> [(String, XName)]
    forall a b. (a -> b) -> [a] -> [b]
    map (\ XName
    xn -> (XName -> String
    unXN XName
    xn, XName
    xn)) [XName]
    initialXNames)
                              ([((XName, XName, XName), QName)] -> Map (XName, XName, XName) QName
    forall k a. Ord k => [(k, a)] -> Map k a
    M.fromList ([((XName, XName, XName), QName)]
     -> Map (XName, XName, XName) QName)
    -> [((XName, XName, XName), QName)]
    -> Map (XName, XName, XName) QName
    forall a b. (a -> b) -> a -> b
    $ (QName -> ((XName, XName, XName), QName))
    -> [QName] -> [((XName, XName, XName), QName)]
    forall a b. (a -> b) -> [a] -> [b]
    map (\ qn :: QName
    qn@(QN XName
    lp XName
    px XName
    ns) -> ((XName
    lp, XName
    px, XName
    ns), QName
    qn)) [QName]
    initialQNames)

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

    changeNameCache         :: NFData r => ChangeNameCache r -> r
    changeNameCache :: forall r. NFData r => ChangeNameCache r -> r
    changeNameCache ChangeNameCache r
    action  = IO r -> r
    forall a. IO a -> a
    unsafePerformIO IO r
    changeNameCache'
        where
        action' :: ChangeNameCache r
    action' NameCache
    c =
          let r :: (NameCache, r)
    r = ChangeNameCache r
    action NameCache
    c
          in
           (NameCache, r) -> NameCache
    forall a b. (a, b) -> a
    fst (NameCache, r)
    r NameCache -> (NameCache, r) -> (NameCache, r)
    forall a b. a -> b -> b
    `seq` (NameCache, r)
    r    -- eval name cache to whnf

        changeNameCache' :: IO r
    changeNameCache' =
          do
          -- putStrLn "modify cache"
          r
    res <- IORef NameCache -> ChangeNameCache r -> IO r
    forall a b. IORef a -> (a -> (a, b)) -> IO b
    atomicModifyIORef IORef NameCache
    theNameCache ChangeNameCache r
    action'
          -- putStrLn "cache modified"
          r -> IO r
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return r
    res

    {-# NOINLINE changeNameCache #-}

    newXName'               :: String -> ChangeNameCache XName
    newXName' :: String -> ChangeNameCache XName
    newXName' String
    n c :: NameCache
    c@(NC Int
    nxn Map String XName
    xm Map (XName, XName, XName) QName
    qm)
                            = case String -> Map String XName -> Maybe XName
    forall k a. Ord k => k -> Map k a -> Maybe a
    M.lookup String
    n Map String XName
    xm of
                              Just XName
    xn       -> (NameCache
    c, XName
    xn)
                              Maybe XName
    Nothing       -> let nxn' :: Int
    nxn' = Int
    nxn Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1 in
                                               let xn :: XName
    xn   = (Int -> String -> XName
    XN Int
    nxn String
    n) in
                                               let xm' :: Map String XName
    xm'  = String -> XName -> Map String XName -> Map String XName
    forall k a. Ord k => k -> a -> Map k a -> Map k a
    M.insert String
    n XName
    xn Map String XName
    xm in
                                               -- trace ("newXName: XN " ++ show nxn ++ " " ++ show n) $
                                               XName -> ()
    forall a. NFData a => a -> ()
    rnf XName
    xn () -> (NameCache, XName) -> (NameCache, XName)
    forall a b. a -> b -> b
    `seq` (Int
    -> Map String XName -> Map (XName, XName, XName) QName -> NameCache
    NC Int
    nxn' Map String XName
    xm' Map (XName, XName, XName) QName
    qm, XName
    xn)

    newQName'               :: XName -> XName -> XName -> ChangeNameCache QName
    newQName' :: XName -> XName -> XName -> ChangeNameCache QName
    newQName' XName
    lp XName
    px XName
    ns c :: NameCache
    c@(NC Int
    nxn Map String XName
    xm Map (XName, XName, XName) QName
    qm)
                            = case (XName, XName, XName)
    -> Map (XName, XName, XName) QName -> Maybe QName
    forall k a. Ord k => k -> Map k a -> Maybe a
    M.lookup (XName, XName, XName)
    q' Map (XName, XName, XName) QName
    qm of
                              Just QName
    qn       -> -- trace ("oldQName: " ++ show qn) $                 -- log evaluation sequence
                                               (NameCache
    c, QName
    qn)
                              Maybe QName
    Nothing       -> let qm' :: Map (XName, XName, XName) QName
    qm'  = (XName, XName, XName)
    -> QName
    -> Map (XName, XName, XName) QName
    -> Map (XName, XName, XName) QName
    forall k a. Ord k => k -> a -> Map k a -> Map k a
    M.insert (XName, XName, XName)
    q' QName
    q Map (XName, XName, XName) QName
    qm in
                                               -- trace ("newQName: " ++ show q) $                  -- log insertion of a new QName
                                               QName
    q QName -> (NameCache, QName) -> (NameCache, QName)
    forall a b. a -> b -> b
    `seq` (Int
    -> Map String XName -> Map (XName, XName, XName) QName -> NameCache
    NC Int
    nxn Map String XName
    xm Map (XName, XName, XName) QName
    qm', QName
    q)
        where
        q' :: (XName, XName, XName)
    q'                  = (XName
    lp, XName
    px, XName
    ns)
        q :: QName
    q                   = XName -> XName -> XName -> QName
    QN XName
    lp XName
    px XName
    ns

    andThen                 :: ChangeNameCache r1 ->
                               (r1 -> ChangeNameCache r2) -> ChangeNameCache r2
    andThen :: forall r1 r2.
    ChangeNameCache r1
    -> (r1 -> ChangeNameCache r2) -> ChangeNameCache r2
    andThen ChangeNameCache r1
    a1 r1 -> ChangeNameCache r2
    a2 NameCache
    c0        = let (NameCache
    c1, r1
    r1) = ChangeNameCache r1
    a1 NameCache
    c0 in
                              (r1 -> ChangeNameCache r2
    a2 r1
    r1) NameCache
    c1

    newXName                :: String -> XName
    newXName :: String -> XName
    newXName String
    n              = ChangeNameCache XName -> XName
    forall r. NFData r => ChangeNameCache r -> r
    changeNameCache (ChangeNameCache XName -> XName) -> ChangeNameCache XName -> XName
    forall a b. (a -> b) -> a -> b
    $
                              String -> ChangeNameCache XName
    newXName' String
    n

    newQName                :: XName -> XName -> XName -> QName
    newQName :: XName -> XName -> XName -> QName
    newQName XName
    lp XName
    px XName
    ns       = XName
    lp XName -> QName -> QName
    forall a b. a -> b -> b
    `seq` XName
    px XName -> QName -> QName
    forall a b. a -> b -> b
    `seq` XName
    ns XName -> QName -> QName
    forall a b. a -> b -> b
    `seq`            -- XNames must be evaluated, else MVar blocks
                              ( ChangeNameCache QName -> QName
    forall r. NFData r => ChangeNameCache r -> r
    changeNameCache (ChangeNameCache QName -> QName) -> ChangeNameCache QName -> QName
    forall a b. (a -> b) -> a -> b
    $
                                XName -> XName -> XName -> ChangeNameCache QName
    newQName' XName
    lp XName
    px XName
    ns
                              )

    newLpName               :: String -> QName
    newLpName :: String -> QName
    newLpName String
    lp            = ChangeNameCache QName -> QName
    forall r. NFData r => ChangeNameCache r -> r
    changeNameCache (ChangeNameCache QName -> QName) -> ChangeNameCache QName -> QName
    forall a b. (a -> b) -> a -> b
    $
                              String -> ChangeNameCache XName
    newXName' String
    lp ChangeNameCache XName
    -> (XName -> ChangeNameCache QName) -> ChangeNameCache QName
    forall r1 r2.
    ChangeNameCache r1
    -> (r1 -> ChangeNameCache r2) -> ChangeNameCache r2
    `andThen` \ XName
    lp' ->
                              XName -> XName -> XName -> ChangeNameCache QName
    newQName' XName
    lp' XName
    nullXName XName
    nullXName

    newPxName               :: String -> String -> QName
    newPxName :: String -> String -> QName
    newPxName String
    lp String
    px         = ChangeNameCache QName -> QName
    forall r. NFData r => ChangeNameCache r -> r
    changeNameCache (ChangeNameCache QName -> QName) -> ChangeNameCache QName -> QName
    forall a b. (a -> b) -> a -> b
    $
                              String -> ChangeNameCache XName
    newXName' String
    lp ChangeNameCache XName
    -> (XName -> ChangeNameCache QName) -> ChangeNameCache QName
    forall r1 r2.
    ChangeNameCache r1
    -> (r1 -> ChangeNameCache r2) -> ChangeNameCache r2
    `andThen` \ XName
    lp' ->
                              String -> ChangeNameCache XName
    newXName' String
    px ChangeNameCache XName
    -> (XName -> ChangeNameCache QName) -> ChangeNameCache QName
    forall r1 r2.
    ChangeNameCache r1
    -> (r1 -> ChangeNameCache r2) -> ChangeNameCache r2
    `andThen` \ XName
    px' ->
                              XName -> XName -> XName -> ChangeNameCache QName
    newQName' XName
    lp' XName
    px' XName
    nullXName

    newNsName               :: String -> String -> String -> QName
    newNsName :: String -> String -> String -> QName
    newNsName String
    lp String
    px String
    ns      = ChangeNameCache QName -> QName
    forall r. NFData r => ChangeNameCache r -> r
    changeNameCache (ChangeNameCache QName -> QName) -> ChangeNameCache QName -> QName
    forall a b. (a -> b) -> a -> b
    $
                              String -> ChangeNameCache XName
    newXName' String
    lp ChangeNameCache XName
    -> (XName -> ChangeNameCache QName) -> ChangeNameCache QName
    forall r1 r2.
    ChangeNameCache r1
    -> (r1 -> ChangeNameCache r2) -> ChangeNameCache r2
    `andThen` \ XName
    lp' ->
                              String -> ChangeNameCache XName
    newXName' String
    px ChangeNameCache XName
    -> (XName -> ChangeNameCache QName) -> ChangeNameCache QName
    forall r1 r2.
    ChangeNameCache r1
    -> (r1 -> ChangeNameCache r2) -> ChangeNameCache r2
    `andThen` \ XName
    px' ->
                              String -> ChangeNameCache XName
    newXName' String
    ns ChangeNameCache XName
    -> (XName -> ChangeNameCache QName) -> ChangeNameCache QName
    forall r1 r2.
    ChangeNameCache r1
    -> (r1 -> ChangeNameCache r2) -> ChangeNameCache r2
    `andThen` \ XName
    ns' ->
                              XName -> XName -> XName -> ChangeNameCache QName
    newQName' XName
    lp' XName
    px' XName
    ns'

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