{-# LANGUAGE FlexibleContexts #-}
module Text.XML.Expat.Internal.Namespaced
      ( NName (..)
      , NAttributes
      , mkNName
      , mkAnNName
      , toNamespaced
      , fromNamespaced
      , xmlnsUri
      , xmlns
      ) where

import Text.XML.Expat.Internal.NodeClass
import Text.XML.Expat.Internal.Qualified
import Text.XML.Expat.SAX
import Control.DeepSeq
import qualified Data.Map as M
import qualified Data.Maybe as DM
import qualified Data.List as L

-- | A namespace-qualified tag.
--
-- NName has two components, a local part and an optional namespace. The local part is the
-- name of the tag. The namespace is the URI identifying collections of declared tags.
-- Tags with the same local part but from different namespaces are distinct. Unqualified tags
-- are those with no namespace. They are in the default namespace, and all uses of an
-- unqualified tag are equivalent.
data NName text =
    NName {
        forall text. NName text -> Maybe text
nnNamespace :: Maybe text,
        forall text. NName text -> text
nnLocalPart :: !text
    }
    deriving (NName text -> NName text -> Bool
(NName text -> NName text -> Bool)
-> (NName text -> NName text -> Bool) -> Eq (NName text)
forall text. Eq text => NName text -> NName text -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall text. Eq text => NName text -> NName text -> Bool
== :: NName text -> NName text -> Bool
$c/= :: forall text. Eq text => NName text -> NName text -> Bool
/= :: NName text -> NName text -> Bool
Eq,Int -> NName text -> ShowS
[NName text] -> ShowS
NName text -> String
(Int -> NName text -> ShowS)
-> (NName text -> String)
-> ([NName text] -> ShowS)
-> Show (NName text)
forall text. Show text => Int -> NName text -> ShowS
forall text. Show text => [NName text] -> ShowS
forall text. Show text => NName text -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall text. Show text => Int -> NName text -> ShowS
showsPrec :: Int -> NName text -> ShowS
$cshow :: forall text. Show text => NName text -> String
show :: NName text -> String
$cshowList :: forall text. Show text => [NName text] -> ShowS
showList :: [NName text] -> ShowS
Show)

instance NFData text => NFData (NName text) where
    rnf :: NName text -> ()
rnf (NName Maybe text
ns text
loc) = (Maybe text, text) -> ()
forall a. NFData a => a -> ()
rnf (Maybe text
ns, text
loc)

-- | Type shortcut for attributes with namespaced names
type NAttributes text = Attributes (NName text) text

-- | Make a new NName from a prefix and localPart.
mkNName :: text -> text -> NName text
mkNName :: forall text. text -> text -> NName text
mkNName text
prefix text
localPart = Maybe text -> text -> NName text
forall text. Maybe text -> text -> NName text
NName (text -> Maybe text
forall a. a -> Maybe a
Just text
prefix) text
localPart

-- | Make a new NName with no prefix.
mkAnNName :: text -> NName text
mkAnNName :: forall text. text -> NName text
mkAnNName text
localPart = Maybe text -> text -> NName text
forall text. Maybe text -> text -> NName text
NName Maybe text
forall a. Maybe a
Nothing text
localPart

type NsPrefixMap text = M.Map (Maybe text) (Maybe text)
type PrefixNsMap text = M.Map (Maybe text) (Maybe text)

xmlUri :: (GenericXMLString text) => text
xmlUri :: forall text. GenericXMLString text => text
xmlUri = String -> text
forall s. GenericXMLString s => String -> s
gxFromString String
"http://www.w3.org/XML/1998/namespace"
xml :: (GenericXMLString text) => text
xml :: forall text. GenericXMLString text => text
xml = String -> text
forall s. GenericXMLString s => String -> s
gxFromString String
"xml"

xmlnsUri :: (GenericXMLString text) => text
xmlnsUri :: forall text. GenericXMLString text => text
xmlnsUri = String -> text
forall s. GenericXMLString s => String -> s
gxFromString String
"http://www.w3.org/2000/xmlns/"
xmlns :: (GenericXMLString text) => text
xmlns :: forall text. GenericXMLString text => text
xmlns = String -> text
forall s. GenericXMLString s => String -> s
gxFromString String
"xmlns"

baseNsBindings :: (GenericXMLString text, Ord text)
               => NsPrefixMap text
baseNsBindings :: forall text. (GenericXMLString text, Ord text) => NsPrefixMap text
baseNsBindings = [(Maybe text, Maybe text)] -> Map (Maybe text) (Maybe text)
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
  [ (Maybe text
forall a. Maybe a
Nothing, Maybe text
forall a. Maybe a
Nothing) 
  , (text -> Maybe text
forall a. a -> Maybe a
Just text
forall text. GenericXMLString text => text
xml, text -> Maybe text
forall a. a -> Maybe a
Just text
forall text. GenericXMLString text => text
xmlUri)
  , (text -> Maybe text
forall a. a -> Maybe a
Just text
forall text. GenericXMLString text => text
xmlns, text -> Maybe text
forall a. a -> Maybe a
Just text
forall text. GenericXMLString text => text
xmlnsUri)
  ]

basePfBindings :: (GenericXMLString text, Ord text)
               => PrefixNsMap text
basePfBindings :: forall text. (GenericXMLString text, Ord text) => NsPrefixMap text
basePfBindings = [(Maybe text, Maybe text)] -> Map (Maybe text) (Maybe text)
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
   [ (Maybe text
forall a. Maybe a
Nothing, Maybe text
forall a. Maybe a
Nothing)
   , (text -> Maybe text
forall a. a -> Maybe a
Just text
forall text. GenericXMLString text => text
xmlUri, text -> Maybe text
forall a. a -> Maybe a
Just text
forall text. GenericXMLString text => text
xml)
   , (text -> Maybe text
forall a. a -> Maybe a
Just text
forall text. GenericXMLString text => text
xmlnsUri, text -> Maybe text
forall a. a -> Maybe a
Just text
forall text. GenericXMLString text => text
xmlns)
   ]

toNamespaced :: (NodeClass n c, GenericXMLString text, Ord text, Show text)
               => n c (QName text) text -> n c (NName text) text
toNamespaced :: forall (n :: (* -> *) -> * -> * -> *) (c :: * -> *) text.
(NodeClass n c, GenericXMLString text, Ord text, Show text) =>
n c (QName text) text -> n c (NName text) text
toNamespaced = NsPrefixMap text -> n c (QName text) text -> n c (NName text) text
forall (n :: (* -> *) -> * -> * -> *) (c :: * -> *) text.
(NodeClass n c, GenericXMLString text, Ord text, Show text) =>
NsPrefixMap text -> n c (QName text) text -> n c (NName text) text
nodeWithNamespaces NsPrefixMap text
forall text. (GenericXMLString text, Ord text) => NsPrefixMap text
baseNsBindings

nodeWithNamespaces :: (NodeClass n c, GenericXMLString text, Ord text, Show text)
                   => NsPrefixMap text -> n c (QName text) text -> n c (NName text) text
nodeWithNamespaces :: forall (n :: (* -> *) -> * -> * -> *) (c :: * -> *) text.
(NodeClass n c, GenericXMLString text, Ord text, Show text) =>
NsPrefixMap text -> n c (QName text) text -> n c (NName text) text
nodeWithNamespaces NsPrefixMap text
bindings = ((QName text, [(QName text, text)], c (n c (QName text) text))
 -> (NName text, [(NName text, text)], c (n c (NName text) text)))
-> n c (QName text) text -> n c (NName text) text
forall tag text tag'.
((tag, [(tag, text)], c (n c tag text))
 -> (tag', [(tag', text)], c (n c tag' text)))
-> n c tag text -> n c tag' text
forall (n :: (* -> *) -> * -> * -> *) (c :: * -> *) tag text tag'.
NodeClass n c =>
((tag, [(tag, text)], c (n c tag text))
 -> (tag', [(tag', text)], c (n c tag' text)))
-> n c tag text -> n c tag' text
modifyElement (QName text, [(QName text, text)], c (n c (QName text) text))
-> (NName text, [(NName text, text)], c (n c (NName text) text))
forall {n :: (* -> *) -> * -> * -> *} {c :: * -> *} {f :: * -> *}.
(NodeClass n c, Functor f) =>
(QName text, [(QName text, text)], f (n c (QName text) text))
-> (NName text, [(NName text, text)], f (n c (NName text) text))
namespaceify
  where
    namespaceify :: (QName text, [(QName text, text)], f (n c (QName text) text))
-> (NName text, [(NName text, text)], f (n c (NName text) text))
namespaceify (QName text
qname, [(QName text, text)]
qattrs, f (n c (QName text) text)
qchildren) = (NName text
nname, [(NName text, text)]
nattrs, f (n c (NName text) text)
nchildren)
      where
        for :: [a] -> (a -> b) -> [b]
for = ((a -> b) -> [a] -> [b]) -> [a] -> (a -> b) -> [b]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (a -> b) -> [a] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map
        ffor :: f a -> (a -> b) -> f b
ffor = ((a -> b) -> f a -> f b) -> f a -> (a -> b) -> f b
forall a b c. (a -> b -> c) -> b -> a -> c
flip (a -> b) -> f a -> f b
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
        ([(QName text, text)]
nsAtts, [(QName text, text)]
otherAtts) = ((QName text, text) -> Bool)
-> [(QName text, text)]
-> ([(QName text, text)], [(QName text, text)])
forall a. (a -> Bool) -> [a] -> ([a], [a])
L.partition ((Maybe text -> Maybe text -> Bool
forall a. Eq a => a -> a -> Bool
== text -> Maybe text
forall a. a -> Maybe a
Just text
forall text. GenericXMLString text => text
xmlns) (Maybe text -> Bool)
-> ((QName text, text) -> Maybe text) -> (QName text, text) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QName text -> Maybe text
forall text. QName text -> Maybe text
qnPrefix (QName text -> Maybe text)
-> ((QName text, text) -> QName text)
-> (QName text, text)
-> Maybe text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (QName text, text) -> QName text
forall a b. (a, b) -> a
fst) [(QName text, text)]
qattrs
        ([(QName text, text)]
dfAtt, [(QName text, text)]
normalAtts) = ((QName text, text) -> Bool)
-> [(QName text, text)]
-> ([(QName text, text)], [(QName text, text)])
forall a. (a -> Bool) -> [a] -> ([a], [a])
L.partition ((QName text -> QName text -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe text -> text -> QName text
forall text. Maybe text -> text -> QName text
QName Maybe text
forall a. Maybe a
Nothing text
forall text. GenericXMLString text => text
xmlns) (QName text -> Bool)
-> ((QName text, text) -> QName text) -> (QName text, text) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (QName text, text) -> QName text
forall a b. (a, b) -> a
fst) [(QName text, text)]
otherAtts
        nsMap :: NsPrefixMap text
nsMap  = [(Maybe text, Maybe text)] -> NsPrefixMap text
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(Maybe text, Maybe text)] -> NsPrefixMap text)
-> [(Maybe text, Maybe text)] -> NsPrefixMap text
forall a b. (a -> b) -> a -> b
$ [(QName text, text)]
-> ((QName text, text) -> (Maybe text, Maybe text))
-> [(Maybe text, Maybe text)]
forall {a} {b}. [a] -> (a -> b) -> [b]
for [(QName text, text)]
nsAtts (((QName text, text) -> (Maybe text, Maybe text))
 -> [(Maybe text, Maybe text)])
-> ((QName text, text) -> (Maybe text, Maybe text))
-> [(Maybe text, Maybe text)]
forall a b. (a -> b) -> a -> b
$ \((QName Maybe text
_ text
lp), text
uri) -> (text -> Maybe text
forall a. a -> Maybe a
Just text
lp, text -> Maybe text
forall a. a -> Maybe a
Just text
uri)
        -- fixme: when snd q is null, use Nothing
        dfMap :: NsPrefixMap text
dfMap  = [(Maybe text, Maybe text)] -> NsPrefixMap text
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(Maybe text, Maybe text)] -> NsPrefixMap text)
-> [(Maybe text, Maybe text)] -> NsPrefixMap text
forall a b. (a -> b) -> a -> b
$ [(QName text, text)]
-> ((QName text, text) -> (Maybe text, Maybe text))
-> [(Maybe text, Maybe text)]
forall {a} {b}. [a] -> (a -> b) -> [b]
for [(QName text, text)]
dfAtt (((QName text, text) -> (Maybe text, Maybe text))
 -> [(Maybe text, Maybe text)])
-> ((QName text, text) -> (Maybe text, Maybe text))
-> [(Maybe text, Maybe text)]
forall a b. (a -> b) -> a -> b
$ \(QName text, text)
q -> (Maybe text
forall a. Maybe a
Nothing, text -> Maybe text
forall a. a -> Maybe a
Just (text -> Maybe text) -> text -> Maybe text
forall a b. (a -> b) -> a -> b
$ (QName text, text) -> text
forall a b. (a, b) -> b
snd (QName text, text)
q)
        chldBs :: NsPrefixMap text
chldBs = [NsPrefixMap text] -> NsPrefixMap text
forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
f (Map k a) -> Map k a
M.unions [NsPrefixMap text
dfMap, NsPrefixMap text
nsMap, NsPrefixMap text
bindings]
    
        trans :: Map (Maybe text) (Maybe text) -> QName text -> NName text
trans Map (Maybe text) (Maybe text)
bs (QName Maybe text
pref text
qual) = case Maybe text
pref Maybe text -> Map (Maybe text) (Maybe text) -> Maybe (Maybe text)
forall k a. Ord k => k -> Map k a -> Maybe a
`M.lookup` Map (Maybe text) (Maybe text)
bs of
          Maybe (Maybe text)
Nothing -> String -> NName text
forall a. HasCallStack => String -> a
error 
                  (String -> NName text) -> String -> NName text
forall a b. (a -> b) -> a -> b
$  String
"Namespace prefix referenced but never bound: '"
                  String -> ShowS
forall a. [a] -> [a] -> [a]
++ (text -> String
forall a. Show a => a -> String
show (text -> String) -> (Maybe text -> text) -> Maybe text -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe text -> text
forall a. HasCallStack => Maybe a -> a
DM.fromJust) Maybe text
pref
                  String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"'"
          Just Maybe text
mUri -> Maybe text -> text -> NName text
forall text. Maybe text -> text -> NName text
NName Maybe text
mUri text
qual
        nname :: NName text
nname       = NsPrefixMap text -> QName text -> NName text
forall {text}.
(Ord text, Show text) =>
Map (Maybe text) (Maybe text) -> QName text -> NName text
trans NsPrefixMap text
chldBs QName text
qname
    
        -- attributes with no prefix are in the same namespace as the element
        attBs :: NsPrefixMap text
attBs = Maybe text -> Maybe text -> NsPrefixMap text -> NsPrefixMap text
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Maybe text
forall a. Maybe a
Nothing (NName text -> Maybe text
forall text. NName text -> Maybe text
nnNamespace NName text
nname) NsPrefixMap text
chldBs
    
        transAt :: (QName text, b) -> (NName text, b)
transAt (QName text
qn, b
v) = (NsPrefixMap text -> QName text -> NName text
forall {text}.
(Ord text, Show text) =>
Map (Maybe text) (Maybe text) -> QName text -> NName text
trans NsPrefixMap text
attBs QName text
qn, b
v)
    
        nNsAtts :: [(NName text, text)]
nNsAtts     = ((QName text, text) -> (NName text, text))
-> [(QName text, text)] -> [(NName text, text)]
forall a b. (a -> b) -> [a] -> [b]
map (QName text, text) -> (NName text, text)
forall {b}. (QName text, b) -> (NName text, b)
transAt [(QName text, text)]
nsAtts
        nDfAtt :: [(NName text, text)]
nDfAtt      = ((QName text, text) -> (NName text, text))
-> [(QName text, text)] -> [(NName text, text)]
forall a b. (a -> b) -> [a] -> [b]
map (QName text, text) -> (NName text, text)
forall {b}. (QName text, b) -> (NName text, b)
transAt [(QName text, text)]
dfAtt
        nNormalAtts :: [(NName text, text)]
nNormalAtts = ((QName text, text) -> (NName text, text))
-> [(QName text, text)] -> [(NName text, text)]
forall a b. (a -> b) -> [a] -> [b]
map (QName text, text) -> (NName text, text)
forall {b}. (QName text, b) -> (NName text, b)
transAt [(QName text, text)]
normalAtts
        nattrs :: [(NName text, text)]
nattrs      = [[(NName text, text)]] -> [(NName text, text)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[(NName text, text)]
nNsAtts, [(NName text, text)]
nDfAtt, [(NName text, text)]
nNormalAtts]

        nchildren :: f (n c (NName text) text)
nchildren   = f (n c (QName text) text)
-> (n c (QName text) text -> n c (NName text) text)
-> f (n c (NName text) text)
forall {a} {b}. f a -> (a -> b) -> f b
ffor f (n c (QName text) text)
qchildren ((n c (QName text) text -> n c (NName text) text)
 -> f (n c (NName text) text))
-> (n c (QName text) text -> n c (NName text) text)
-> f (n c (NName text) text)
forall a b. (a -> b) -> a -> b
$ NsPrefixMap text -> n c (QName text) text -> n c (NName text) text
forall (n :: (* -> *) -> * -> * -> *) (c :: * -> *) text.
(NodeClass n c, GenericXMLString text, Ord text, Show text) =>
NsPrefixMap text -> n c (QName text) text -> n c (NName text) text
nodeWithNamespaces NsPrefixMap text
chldBs

fromNamespaced :: (NodeClass n c, GenericXMLString text, Ord text, Functor c) =>
                  n c (NName text) text -> n c (QName text) text
fromNamespaced :: forall (n :: (* -> *) -> * -> * -> *) (c :: * -> *) text.
(NodeClass n c, GenericXMLString text, Ord text, Functor c) =>
n c (NName text) text -> n c (QName text) text
fromNamespaced = Int
-> PrefixNsMap text
-> n c (NName text) text
-> n c (QName text) text
forall (n :: (* -> *) -> * -> * -> *) (c :: * -> *) text.
(NodeClass n c, GenericXMLString text, Ord text, Functor c) =>
Int
-> PrefixNsMap text
-> n c (NName text) text
-> n c (QName text) text
nodeWithQualifiers Int
1 PrefixNsMap text
forall text. (GenericXMLString text, Ord text) => NsPrefixMap text
basePfBindings

nodeWithQualifiers :: (NodeClass n c, GenericXMLString text, Ord text, Functor c) =>
                      Int
                   -> PrefixNsMap text
                   -> n c (NName text) text
                   -> n c (QName text) text
nodeWithQualifiers :: forall (n :: (* -> *) -> * -> * -> *) (c :: * -> *) text.
(NodeClass n c, GenericXMLString text, Ord text, Functor c) =>
Int
-> PrefixNsMap text
-> n c (NName text) text
-> n c (QName text) text
nodeWithQualifiers Int
cntr PrefixNsMap text
bindings = ((NName text, [(NName text, text)], c (n c (NName text) text))
 -> (QName text, [(QName text, text)], c (n c (QName text) text)))
-> n c (NName text) text -> n c (QName text) text
forall tag text tag'.
((tag, [(tag, text)], c (n c tag text))
 -> (tag', [(tag', text)], c (n c tag' text)))
-> n c tag text -> n c tag' text
forall (n :: (* -> *) -> * -> * -> *) (c :: * -> *) tag text tag'.
NodeClass n c =>
((tag, [(tag, text)], c (n c tag text))
 -> (tag', [(tag', text)], c (n c tag' text)))
-> n c tag text -> n c tag' text
modifyElement (NName text, [(NName text, text)], c (n c (NName text) text))
-> (QName text, [(QName text, text)], c (n c (QName text) text))
forall {n :: (* -> *) -> * -> * -> *} {c :: * -> *} {f :: * -> *}.
(NodeClass n c, Functor f) =>
(NName text, [(NName text, text)], f (n c (NName text) text))
-> (QName text, [(QName text, text)], f (n c (QName text) text))
namespaceify
  where
    namespaceify :: (NName text, [(NName text, text)], f (n c (NName text) text))
-> (QName text, [(QName text, text)], f (n c (QName text) text))
namespaceify (NName text
nname, [(NName text, text)]
nattrs, f (n c (NName text) text)
nchildren) = (QName text
qname, [(QName text, text)]
qattrs, f (n c (QName text) text)
qchildren) 
      where
        for :: [a] -> (a -> b) -> [b]
for = ((a -> b) -> [a] -> [b]) -> [a] -> (a -> b) -> [b]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (a -> b) -> [a] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map
        ffor :: f a -> (a -> b) -> f b
ffor = ((a -> b) -> f a -> f b) -> f a -> (a -> b) -> f b
forall a b c. (a -> b -> c) -> b -> a -> c
flip (a -> b) -> f a -> f b
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
        ([(NName text, text)]
nsAtts, [(NName text, text)]
otherAtts) = ((NName text, text) -> Bool)
-> [(NName text, text)]
-> ([(NName text, text)], [(NName text, text)])
forall a. (a -> Bool) -> [a] -> ([a], [a])
L.partition ((Maybe text -> Maybe text -> Bool
forall a. Eq a => a -> a -> Bool
== text -> Maybe text
forall a. a -> Maybe a
Just text
forall text. GenericXMLString text => text
xmlnsUri) (Maybe text -> Bool)
-> ((NName text, text) -> Maybe text) -> (NName text, text) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NName text -> Maybe text
forall text. NName text -> Maybe text
nnNamespace (NName text -> Maybe text)
-> ((NName text, text) -> NName text)
-> (NName text, text)
-> Maybe text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NName text, text) -> NName text
forall a b. (a, b) -> a
fst) [(NName text, text)]
nattrs
        ([(NName text, text)]
dfAtt, [(NName text, text)]
normalAtts) = ((NName text, text) -> Bool)
-> [(NName text, text)]
-> ([(NName text, text)], [(NName text, text)])
forall a. (a -> Bool) -> [a] -> ([a], [a])
L.partition ((NName text -> NName text -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe text -> text -> NName text
forall text. Maybe text -> text -> NName text
NName Maybe text
forall a. Maybe a
Nothing text
forall text. GenericXMLString text => text
xmlns) (NName text -> Bool)
-> ((NName text, text) -> NName text) -> (NName text, text) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NName text, text) -> NName text
forall a b. (a, b) -> a
fst) [(NName text, text)]
otherAtts
        nsMap :: PrefixNsMap text
nsMap = [(Maybe text, Maybe text)] -> PrefixNsMap text
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(Maybe text, Maybe text)] -> PrefixNsMap text)
-> [(Maybe text, Maybe text)] -> PrefixNsMap text
forall a b. (a -> b) -> a -> b
$ [(NName text, text)]
-> ((NName text, text) -> (Maybe text, Maybe text))
-> [(Maybe text, Maybe text)]
forall {a} {b}. [a] -> (a -> b) -> [b]
for [(NName text, text)]
nsAtts (((NName text, text) -> (Maybe text, Maybe text))
 -> [(Maybe text, Maybe text)])
-> ((NName text, text) -> (Maybe text, Maybe text))
-> [(Maybe text, Maybe text)]
forall a b. (a -> b) -> a -> b
$ \((NName Maybe text
_ text
lp), text
uri) -> (text -> Maybe text
forall a. a -> Maybe a
Just text
uri, text -> Maybe text
forall a. a -> Maybe a
Just text
lp)
        dfMap :: PrefixNsMap text
dfMap = [(Maybe text, Maybe text)] -> PrefixNsMap text
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(Maybe text, Maybe text)] -> PrefixNsMap text)
-> [(Maybe text, Maybe text)] -> PrefixNsMap text
forall a b. (a -> b) -> a -> b
$ [(NName text, text)]
-> ((NName text, text) -> (Maybe text, Maybe text))
-> [(Maybe text, Maybe text)]
forall {a} {b}. [a] -> (a -> b) -> [b]
for [(NName text, text)]
dfAtt  (((NName text, text) -> (Maybe text, Maybe text))
 -> [(Maybe text, Maybe text)])
-> ((NName text, text) -> (Maybe text, Maybe text))
-> [(Maybe text, Maybe text)]
forall a b. (a -> b) -> a -> b
$ \(NName text
_, text
uri) -> (text -> Maybe text
forall a. a -> Maybe a
Just text
uri, text -> Maybe text
forall a. a -> Maybe a
Just text
forall text. GenericXMLString text => text
xmlns)
        chldBs :: PrefixNsMap text
chldBs = [PrefixNsMap text] -> PrefixNsMap text
forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
f (Map k a) -> Map k a
M.unions [PrefixNsMap text
dfMap, PrefixNsMap text
nsMap, PrefixNsMap text
bindings]
    
        trans :: (a, Map (Maybe text) (Maybe text), [(NName text, text)])
-> NName text
-> ((a, Map (Maybe text) (Maybe text), [(NName text, text)]),
    QName text)
trans (a
i, Map (Maybe text) (Maybe text)
bs, [(NName text, text)]
as) (NName Maybe text
nspace text
qual) =
          case Maybe text
nspace Maybe text -> Map (Maybe text) (Maybe text) -> Maybe (Maybe text)
forall k a. Ord k => k -> Map k a -> Maybe a
`M.lookup` Map (Maybe text) (Maybe text)
bs of
               Maybe (Maybe text)
Nothing -> let
                            pfx :: text
pfx = String -> text
forall s. GenericXMLString s => String -> s
gxFromString (String -> text) -> String -> text
forall a b. (a -> b) -> a -> b
$ String
"ns" String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
i
                            bsN :: Map (Maybe text) (Maybe text)
bsN = Maybe text
-> Maybe text
-> Map (Maybe text) (Maybe text)
-> Map (Maybe text) (Maybe text)
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Maybe text
nspace (text -> Maybe text
forall a. a -> Maybe a
Just text
pfx) Map (Maybe text) (Maybe text)
bs
                            asN :: [(NName text, text)]
asN = (Maybe text -> text -> NName text
forall text. Maybe text -> text -> NName text
NName (text -> Maybe text
forall a. a -> Maybe a
Just text
forall text. GenericXMLString text => text
xmlnsUri) text
pfx, Maybe text -> text
forall a. HasCallStack => Maybe a -> a
DM.fromJust Maybe text
nspace) (NName text, text) -> [(NName text, text)] -> [(NName text, text)]
forall a. a -> [a] -> [a]
: [(NName text, text)]
as
                          in (a, Map (Maybe text) (Maybe text), [(NName text, text)])
-> NName text
-> ((a, Map (Maybe text) (Maybe text), [(NName text, text)]),
    QName text)
trans (a
ia -> a -> a
forall a. Num a => a -> a -> a
+a
1, Map (Maybe text) (Maybe text)
bsN, [(NName text, text)]
asN) (Maybe text -> text -> NName text
forall text. Maybe text -> text -> NName text
NName Maybe text
nspace text
qual)
               Just Maybe text
pfx -> ((a
i, Map (Maybe text) (Maybe text)
bs, [(NName text, text)]
as), Maybe text -> text -> QName text
forall text. Maybe text -> text -> QName text
QName Maybe text
pfx text
qual)
        transAt :: (a, Map (Maybe text) (Maybe text), [(NName text, text)])
-> (NName text, b)
-> ((a, Map (Maybe text) (Maybe text), [(NName text, text)]),
    (QName text, b))
transAt (a, Map (Maybe text) (Maybe text), [(NName text, text)])
ibs (NName text
nn, b
v) = let ((a, Map (Maybe text) (Maybe text), [(NName text, text)])
ibs', QName text
qn) = (a, Map (Maybe text) (Maybe text), [(NName text, text)])
-> NName text
-> ((a, Map (Maybe text) (Maybe text), [(NName text, text)]),
    QName text)
forall {a} {text}.
(Num a, Show a, Ord text, GenericXMLString text) =>
(a, Map (Maybe text) (Maybe text), [(NName text, text)])
-> NName text
-> ((a, Map (Maybe text) (Maybe text), [(NName text, text)]),
    QName text)
trans (a, Map (Maybe text) (Maybe text), [(NName text, text)])
ibs NName text
nn
                              in  ((a, Map (Maybe text) (Maybe text), [(NName text, text)])
ibs', (QName text
qn, b
v))
    
        ((Int
i', PrefixNsMap text
bs', [(NName text, text)]
as'), QName text
qname) = (Int, PrefixNsMap text, [(NName text, text)])
-> NName text
-> ((Int, PrefixNsMap text, [(NName text, text)]), QName text)
forall {a} {text}.
(Num a, Show a, Ord text, GenericXMLString text) =>
(a, Map (Maybe text) (Maybe text), [(NName text, text)])
-> NName text
-> ((a, Map (Maybe text) (Maybe text), [(NName text, text)]),
    QName text)
trans (Int
cntr, PrefixNsMap text
chldBs, []) NName text
nname
    
        ((Int
i'',   PrefixNsMap text
bs'',   [(NName text, text)]
as''),   [(QName text, text)]
qNsAtts)     = ((Int, PrefixNsMap text, [(NName text, text)])
 -> (NName text, text)
 -> ((Int, PrefixNsMap text, [(NName text, text)]),
     (QName text, text)))
-> (Int, PrefixNsMap text, [(NName text, text)])
-> [(NName text, text)]
-> ((Int, PrefixNsMap text, [(NName text, text)]),
    [(QName text, text)])
forall (t :: * -> *) s a b.
Traversable t =>
(s -> a -> (s, b)) -> s -> t a -> (s, t b)
L.mapAccumL (Int, PrefixNsMap text, [(NName text, text)])
-> (NName text, text)
-> ((Int, PrefixNsMap text, [(NName text, text)]),
    (QName text, text))
forall {a} {text} {b}.
(Num a, Show a, Ord text, GenericXMLString text) =>
(a, Map (Maybe text) (Maybe text), [(NName text, text)])
-> (NName text, b)
-> ((a, Map (Maybe text) (Maybe text), [(NName text, text)]),
    (QName text, b))
transAt (Int
i',    PrefixNsMap text
bs',    [(NName text, text)]
as')    [(NName text, text)]
nsAtts
        ((Int
i''',  PrefixNsMap text
bs''',  [(NName text, text)]
as'''),  [(QName text, text)]
qDfAtt)      = ((Int, PrefixNsMap text, [(NName text, text)])
 -> (NName text, text)
 -> ((Int, PrefixNsMap text, [(NName text, text)]),
     (QName text, text)))
-> (Int, PrefixNsMap text, [(NName text, text)])
-> [(NName text, text)]
-> ((Int, PrefixNsMap text, [(NName text, text)]),
    [(QName text, text)])
forall (t :: * -> *) s a b.
Traversable t =>
(s -> a -> (s, b)) -> s -> t a -> (s, t b)
L.mapAccumL (Int, PrefixNsMap text, [(NName text, text)])
-> (NName text, text)
-> ((Int, PrefixNsMap text, [(NName text, text)]),
    (QName text, text))
forall {a} {text} {b}.
(Num a, Show a, Ord text, GenericXMLString text) =>
(a, Map (Maybe text) (Maybe text), [(NName text, text)])
-> (NName text, b)
-> ((a, Map (Maybe text) (Maybe text), [(NName text, text)]),
    (QName text, b))
transAt (Int
i'',   PrefixNsMap text
bs'',   [(NName text, text)]
as'')   [(NName text, text)]
dfAtt
        ((Int
i'''', PrefixNsMap text
bs'''', [(NName text, text)]
as''''), [(QName text, text)]
qNormalAtts) = ((Int, PrefixNsMap text, [(NName text, text)])
 -> (NName text, text)
 -> ((Int, PrefixNsMap text, [(NName text, text)]),
     (QName text, text)))
-> (Int, PrefixNsMap text, [(NName text, text)])
-> [(NName text, text)]
-> ((Int, PrefixNsMap text, [(NName text, text)]),
    [(QName text, text)])
forall (t :: * -> *) s a b.
Traversable t =>
(s -> a -> (s, b)) -> s -> t a -> (s, t b)
L.mapAccumL (Int, PrefixNsMap text, [(NName text, text)])
-> (NName text, text)
-> ((Int, PrefixNsMap text, [(NName text, text)]),
    (QName text, text))
forall {a} {text} {b}.
(Num a, Show a, Ord text, GenericXMLString text) =>
(a, Map (Maybe text) (Maybe text), [(NName text, text)])
-> (NName text, b)
-> ((a, Map (Maybe text) (Maybe text), [(NName text, text)]),
    (QName text, b))
transAt (Int
i''',  PrefixNsMap text
bs''',  [(NName text, text)]
as''')  [(NName text, text)]
normalAtts
        ((Int, PrefixNsMap text, [(NName text, text)])
_,                       [(QName text, text)]
qas)         = ((Int, PrefixNsMap text, [(NName text, text)])
 -> (NName text, text)
 -> ((Int, PrefixNsMap text, [(NName text, text)]),
     (QName text, text)))
-> (Int, PrefixNsMap text, [(NName text, text)])
-> [(NName text, text)]
-> ((Int, PrefixNsMap text, [(NName text, text)]),
    [(QName text, text)])
forall (t :: * -> *) s a b.
Traversable t =>
(s -> a -> (s, b)) -> s -> t a -> (s, t b)
L.mapAccumL (Int, PrefixNsMap text, [(NName text, text)])
-> (NName text, text)
-> ((Int, PrefixNsMap text, [(NName text, text)]),
    (QName text, text))
forall {a} {text} {b}.
(Num a, Show a, Ord text, GenericXMLString text) =>
(a, Map (Maybe text) (Maybe text), [(NName text, text)])
-> (NName text, b)
-> ((a, Map (Maybe text) (Maybe text), [(NName text, text)]),
    (QName text, b))
transAt (Int
i'''', PrefixNsMap text
bs'''', [(NName text, text)]
as'''') [(NName text, text)]
as''''
        qattrs :: [(QName text, text)]
qattrs = [[(QName text, text)]] -> [(QName text, text)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[(QName text, text)]
qNsAtts, [(QName text, text)]
qDfAtt, [(QName text, text)]
qNormalAtts, [(QName text, text)]
qas]
    
        qchildren :: f (n c (QName text) text)
qchildren = f (n c (NName text) text)
-> (n c (NName text) text -> n c (QName text) text)
-> f (n c (QName text) text)
forall {a} {b}. f a -> (a -> b) -> f b
ffor f (n c (NName text) text)
nchildren ((n c (NName text) text -> n c (QName text) text)
 -> f (n c (QName text) text))
-> (n c (NName text) text -> n c (QName text) text)
-> f (n c (QName text) text)
forall a b. (a -> b) -> a -> b
$ Int
-> PrefixNsMap text
-> n c (NName text) text
-> n c (QName text) text
forall (n :: (* -> *) -> * -> * -> *) (c :: * -> *) text.
(NodeClass n c, GenericXMLString text, Ord text, Functor c) =>
Int
-> PrefixNsMap text
-> n c (NName text) text
-> n c (QName text) text
nodeWithQualifiers Int
i'''' PrefixNsMap text
bs''''