{-# 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
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 NAttributes text = Attributes (NName text) text
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
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)
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
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''''