module XmlParser.NameMap
( NameMap,
fromNodes,
fromAttributes,
empty,
insert,
fetch,
extractNames,
)
where
import qualified Data.HashMap.Strict as HashMap
import qualified Data.Map.Strict as Map
import qualified Text.XML as Xml
import qualified XmlParser.NamespaceRegistry as NamespaceRegistry
import XmlParser.Prelude hiding (empty, fromList, insert, toList)
import qualified XmlParser.TupleHashMap as TupleHashMap
data NameMap a
= NameMap
(TupleHashMap.TupleHashMap Text Text [a])
(HashMap Text [a])
fromNodes :: NamespaceRegistry.NamespaceRegistry -> [Xml.Node] -> NameMap Xml.Element
fromNodes :: NamespaceRegistry -> [Node] -> NameMap Element
fromNodes NamespaceRegistry
nreg =
(Name -> Maybe (Maybe Text, Text))
-> [(Name, Element)] -> NameMap Element
forall a.
(Name -> Maybe (Maybe Text, Text)) -> [(Name, a)] -> NameMap a
fromReverseList ((Name -> NamespaceRegistry -> Maybe (Maybe Text, Text))
-> NamespaceRegistry -> Name -> Maybe (Maybe Text, Text)
forall a b c. (a -> b -> c) -> b -> a -> c
flip Name -> NamespaceRegistry -> Maybe (Maybe Text, Text)
NamespaceRegistry.resolveElementName NamespaceRegistry
nreg) ([(Name, Element)] -> NameMap Element)
-> ([Node] -> [(Name, Element)]) -> [Node] -> NameMap Element
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ([(Name, Element)] -> Node -> [(Name, Element)])
-> [(Name, Element)] -> [Node] -> [(Name, Element)]
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' [(Name, Element)] -> Node -> [(Name, Element)]
appendIfElement []
where
appendIfElement :: [(Name, Element)] -> Node -> [(Name, Element)]
appendIfElement [(Name, Element)]
list = \case
Xml.NodeElement Element
element -> (Element -> Name
Xml.elementName Element
element, Element
element) (Name, Element) -> [(Name, Element)] -> [(Name, Element)]
forall a. a -> [a] -> [a]
: [(Name, Element)]
list
Node
_ -> [(Name, Element)]
list
fromAttributes :: NamespaceRegistry.NamespaceRegistry -> Map Xml.Name Text -> NameMap Text
fromAttributes :: NamespaceRegistry -> Map Name Text -> NameMap Text
fromAttributes NamespaceRegistry
nreg =
(Name -> Maybe (Maybe Text, Text))
-> [(Name, Text)] -> NameMap Text
forall a.
(Name -> Maybe (Maybe Text, Text)) -> [(Name, a)] -> NameMap a
fromList ((Name -> NamespaceRegistry -> Maybe (Maybe Text, Text))
-> NamespaceRegistry -> Name -> Maybe (Maybe Text, Text)
forall a b c. (a -> b -> c) -> b -> a -> c
flip Name -> NamespaceRegistry -> Maybe (Maybe Text, Text)
NamespaceRegistry.resolveAttributeName NamespaceRegistry
nreg) ([(Name, Text)] -> NameMap Text)
-> (Map Name Text -> [(Name, Text)])
-> Map Name Text
-> NameMap Text
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Map Name Text -> [(Name, Text)]
forall k a. Map k a -> [(k, a)]
Map.toList
fromList :: (Xml.Name -> Maybe (Maybe Text, Text)) -> [(Xml.Name, a)] -> NameMap a
fromList :: (Name -> Maybe (Maybe Text, Text)) -> [(Name, a)] -> NameMap a
fromList Name -> Maybe (Maybe Text, Text)
resolve =
(Name -> Maybe (Maybe Text, Text)) -> [(Name, a)] -> NameMap a
forall a.
(Name -> Maybe (Maybe Text, Text)) -> [(Name, a)] -> NameMap a
fromReverseList Name -> Maybe (Maybe Text, Text)
resolve ([(Name, a)] -> NameMap a)
-> ([(Name, a)] -> [(Name, a)]) -> [(Name, a)] -> NameMap a
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. [(Name, a)] -> [(Name, a)]
forall a. [a] -> [a]
reverse
fromReverseList :: (Xml.Name -> Maybe (Maybe Text, Text)) -> [(Xml.Name, a)] -> NameMap a
fromReverseList :: (Name -> Maybe (Maybe Text, Text)) -> [(Name, a)] -> NameMap a
fromReverseList Name -> Maybe (Maybe Text, Text)
resolve [(Name, a)]
list =
((Name, a)
-> (TupleHashMap Text Text [a] -> HashMap Text [a] -> NameMap a)
-> TupleHashMap Text Text [a]
-> HashMap Text [a]
-> NameMap a)
-> (TupleHashMap Text Text [a] -> HashMap Text [a] -> NameMap a)
-> [(Name, a)]
-> TupleHashMap Text Text [a]
-> HashMap Text [a]
-> NameMap a
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Name, a)
-> (TupleHashMap Text Text [a] -> HashMap Text [a] -> NameMap a)
-> TupleHashMap Text Text [a]
-> HashMap Text [a]
-> NameMap a
step TupleHashMap Text Text [a] -> HashMap Text [a] -> NameMap a
forall a.
TupleHashMap Text Text [a] -> HashMap Text [a] -> NameMap a
NameMap [(Name, a)]
list TupleHashMap Text Text [a]
forall k1 k2 v. TupleHashMap k1 k2 v
TupleHashMap.empty HashMap Text [a]
forall k v. HashMap k v
HashMap.empty
where
step :: (Name, a)
-> (TupleHashMap Text Text [a] -> HashMap Text [a] -> NameMap a)
-> TupleHashMap Text Text [a]
-> HashMap Text [a]
-> NameMap a
step (Name
name, a
contents) TupleHashMap Text Text [a] -> HashMap Text [a] -> NameMap a
next !TupleHashMap Text Text [a]
map1 !HashMap Text [a]
map2 =
case Name -> Maybe (Maybe Text, Text)
resolve Name
name of
Maybe (Maybe Text, Text)
Nothing -> TupleHashMap Text Text [a] -> HashMap Text [a] -> NameMap a
next TupleHashMap Text Text [a]
map1 HashMap Text [a]
map2
Just (Maybe Text
ns, Text
name) ->
case Maybe Text
ns of
Just Text
ns -> TupleHashMap Text Text [a] -> HashMap Text [a] -> NameMap a
next (Text
-> Text
-> [a]
-> TupleHashMap Text Text [a]
-> TupleHashMap Text Text [a]
forall v k1 k2.
(Semigroup v, KeyConstraints k1 k2) =>
k1 -> k2 -> v -> TupleHashMap k1 k2 v -> TupleHashMap k1 k2 v
TupleHashMap.insertSemigroup Text
ns Text
name [a
contents] TupleHashMap Text Text [a]
map1) HashMap Text [a]
map2
Maybe Text
Nothing -> TupleHashMap Text Text [a] -> HashMap Text [a] -> NameMap a
next TupleHashMap Text Text [a]
map1 (([a] -> [a] -> [a])
-> Text -> [a] -> HashMap Text [a] -> HashMap Text [a]
forall k v.
(Eq k, Hashable k) =>
(v -> v -> v) -> k -> v -> HashMap k v -> HashMap k v
HashMap.insertWith [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
(++) Text
name [a
contents] HashMap Text [a]
map2)
empty :: NameMap a
empty :: NameMap a
empty =
TupleHashMap Text Text [a] -> HashMap Text [a] -> NameMap a
forall a.
TupleHashMap Text Text [a] -> HashMap Text [a] -> NameMap a
NameMap TupleHashMap Text Text [a]
forall k1 k2 v. TupleHashMap k1 k2 v
TupleHashMap.empty HashMap Text [a]
forall k v. HashMap k v
HashMap.empty
insert :: Maybe Text -> Text -> a -> NameMap a -> NameMap a
insert :: Maybe Text -> Text -> a -> NameMap a -> NameMap a
insert Maybe Text
ns Text
name a
contents (NameMap TupleHashMap Text Text [a]
map1 HashMap Text [a]
map2) =
case Maybe Text
ns of
Just Text
ns ->
TupleHashMap Text Text [a] -> HashMap Text [a] -> NameMap a
forall a.
TupleHashMap Text Text [a] -> HashMap Text [a] -> NameMap a
NameMap (Text
-> Text
-> [a]
-> TupleHashMap Text Text [a]
-> TupleHashMap Text Text [a]
forall v k1 k2.
(Semigroup v, KeyConstraints k1 k2) =>
k1 -> k2 -> v -> TupleHashMap k1 k2 v -> TupleHashMap k1 k2 v
TupleHashMap.insertSemigroup Text
ns Text
name [a
contents] TupleHashMap Text Text [a]
map1) HashMap Text [a]
map2
Maybe Text
Nothing ->
TupleHashMap Text Text [a] -> HashMap Text [a] -> NameMap a
forall a.
TupleHashMap Text Text [a] -> HashMap Text [a] -> NameMap a
NameMap TupleHashMap Text Text [a]
map1 (([a] -> [a] -> [a])
-> Text -> [a] -> HashMap Text [a] -> HashMap Text [a]
forall k v.
(Eq k, Hashable k) =>
(v -> v -> v) -> k -> v -> HashMap k v -> HashMap k v
HashMap.insertWith [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
(++) Text
name [a
contents] HashMap Text [a]
map2)
fetch :: Maybe Text -> Text -> NameMap a -> Maybe (a, NameMap a)
fetch :: Maybe Text -> Text -> NameMap a -> Maybe (a, NameMap a)
fetch Maybe Text
ns Text
name (NameMap TupleHashMap Text Text [a]
map1 HashMap Text [a]
map2) =
case Maybe Text
ns of
Just Text
ns ->
(Maybe [a] -> Compose Maybe ((,) a) (Maybe [a]))
-> Text
-> Text
-> TupleHashMap Text Text [a]
-> Compose Maybe ((,) a) (TupleHashMap Text Text [a])
forall (f :: * -> *) k1 k2 v.
(Functor f, KeyConstraints k1 k2) =>
(Maybe v -> f (Maybe v))
-> k1 -> k2 -> TupleHashMap k1 k2 v -> f (TupleHashMap k1 k2 v)
TupleHashMap.alterF
( \case
Just [a]
list ->
case [a]
list of
a
head : [a]
tail -> case [a]
tail of
[] -> Maybe (a, Maybe [a]) -> Compose Maybe ((,) a) (Maybe [a])
forall k k1 (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose ((a, Maybe [a]) -> Maybe (a, Maybe [a])
forall a. a -> Maybe a
Just (a
head, Maybe [a]
forall a. Maybe a
Nothing))
[a]
_ -> Maybe (a, Maybe [a]) -> Compose Maybe ((,) a) (Maybe [a])
forall k k1 (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose ((a, Maybe [a]) -> Maybe (a, Maybe [a])
forall a. a -> Maybe a
Just (a
head, [a] -> Maybe [a]
forall a. a -> Maybe a
Just [a]
tail))
[a]
_ -> Maybe (a, Maybe [a]) -> Compose Maybe ((,) a) (Maybe [a])
forall k k1 (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose Maybe (a, Maybe [a])
forall a. Maybe a
Nothing
Maybe [a]
Nothing ->
Maybe (a, Maybe [a]) -> Compose Maybe ((,) a) (Maybe [a])
forall k k1 (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose Maybe (a, Maybe [a])
forall a. Maybe a
Nothing
)
Text
ns
Text
name
TupleHashMap Text Text [a]
map1
Compose Maybe ((,) a) (TupleHashMap Text Text [a])
-> (Compose Maybe ((,) a) (TupleHashMap Text Text [a])
-> Maybe (a, TupleHashMap Text Text [a]))
-> Maybe (a, TupleHashMap Text Text [a])
forall a b. a -> (a -> b) -> b
& Compose Maybe ((,) a) (TupleHashMap Text Text [a])
-> Maybe (a, TupleHashMap Text Text [a])
forall k1 (f :: k1 -> *) k2 (g :: k2 -> k1) (a :: k2).
Compose f g a -> f (g a)
getCompose
Maybe (a, TupleHashMap Text Text [a])
-> (Maybe (a, TupleHashMap Text Text [a]) -> Maybe (a, NameMap a))
-> Maybe (a, NameMap a)
forall a b. a -> (a -> b) -> b
& ((a, TupleHashMap Text Text [a]) -> (a, NameMap a))
-> Maybe (a, TupleHashMap Text Text [a]) -> Maybe (a, NameMap a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((TupleHashMap Text Text [a] -> NameMap a)
-> (a, TupleHashMap Text Text [a]) -> (a, NameMap a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((TupleHashMap Text Text [a] -> HashMap Text [a] -> NameMap a)
-> HashMap Text [a] -> TupleHashMap Text Text [a] -> NameMap a
forall a b c. (a -> b -> c) -> b -> a -> c
flip TupleHashMap Text Text [a] -> HashMap Text [a] -> NameMap a
forall a.
TupleHashMap Text Text [a] -> HashMap Text [a] -> NameMap a
NameMap HashMap Text [a]
map2))
Maybe Text
Nothing ->
(Maybe [a] -> Compose Maybe ((,) a) (Maybe [a]))
-> Text
-> HashMap Text [a]
-> Compose Maybe ((,) a) (HashMap Text [a])
forall (f :: * -> *) k v.
(Functor f, Eq k, Hashable k) =>
(Maybe v -> f (Maybe v)) -> k -> HashMap k v -> f (HashMap k v)
HashMap.alterF
( \case
Just [a]
list ->
case [a]
list of
a
head : [a]
tail -> case [a]
tail of
[] -> Maybe (a, Maybe [a]) -> Compose Maybe ((,) a) (Maybe [a])
forall k k1 (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose ((a, Maybe [a]) -> Maybe (a, Maybe [a])
forall a. a -> Maybe a
Just (a
head, Maybe [a]
forall a. Maybe a
Nothing))
[a]
_ -> Maybe (a, Maybe [a]) -> Compose Maybe ((,) a) (Maybe [a])
forall k k1 (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose ((a, Maybe [a]) -> Maybe (a, Maybe [a])
forall a. a -> Maybe a
Just (a
head, [a] -> Maybe [a]
forall a. a -> Maybe a
Just [a]
tail))
[a]
_ -> Maybe (a, Maybe [a]) -> Compose Maybe ((,) a) (Maybe [a])
forall k k1 (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose Maybe (a, Maybe [a])
forall a. Maybe a
Nothing
Maybe [a]
Nothing ->
Maybe (a, Maybe [a]) -> Compose Maybe ((,) a) (Maybe [a])
forall k k1 (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose Maybe (a, Maybe [a])
forall a. Maybe a
Nothing
)
Text
name
HashMap Text [a]
map2
Compose Maybe ((,) a) (HashMap Text [a])
-> (Compose Maybe ((,) a) (HashMap Text [a])
-> Maybe (a, HashMap Text [a]))
-> Maybe (a, HashMap Text [a])
forall a b. a -> (a -> b) -> b
& Compose Maybe ((,) a) (HashMap Text [a])
-> Maybe (a, HashMap Text [a])
forall k1 (f :: k1 -> *) k2 (g :: k2 -> k1) (a :: k2).
Compose f g a -> f (g a)
getCompose
Maybe (a, HashMap Text [a])
-> (Maybe (a, HashMap Text [a]) -> Maybe (a, NameMap a))
-> Maybe (a, NameMap a)
forall a b. a -> (a -> b) -> b
& ((a, HashMap Text [a]) -> (a, NameMap a))
-> Maybe (a, HashMap Text [a]) -> Maybe (a, NameMap a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((HashMap Text [a] -> NameMap a)
-> (a, HashMap Text [a]) -> (a, NameMap a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (TupleHashMap Text Text [a] -> HashMap Text [a] -> NameMap a
forall a.
TupleHashMap Text Text [a] -> HashMap Text [a] -> NameMap a
NameMap TupleHashMap Text Text [a]
map1))
extractNames :: NameMap a -> [(Maybe Text, Text)]
(NameMap TupleHashMap Text Text [a]
map1 HashMap Text [a]
map2) =
((Text, Text, [a]) -> (Maybe Text, Text))
-> [(Text, Text, [a])] -> [(Maybe Text, Text)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Text
a, Text
b, [a]
_) -> (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
a, Text
b)) (TupleHashMap Text Text [a] -> [(Text, Text, [a])]
forall k1 k2 b. TupleHashMap k1 k2 b -> [(k1, k2, b)]
TupleHashMap.toList TupleHashMap Text Text [a]
map1)
[(Maybe Text, Text)]
-> [(Maybe Text, Text)] -> [(Maybe Text, Text)]
forall a. Semigroup a => a -> a -> a
<> ((Text, [a]) -> (Maybe Text, Text))
-> [(Text, [a])] -> [(Maybe Text, Text)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Maybe Text
forall a. Maybe a
Nothing,) (Text -> (Maybe Text, Text))
-> ((Text, [a]) -> Text) -> (Text, [a]) -> (Maybe Text, Text)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Text, [a]) -> Text
forall a b. (a, b) -> a
fst) (HashMap Text [a] -> [(Text, [a])]
forall k v. HashMap k v -> [(k, v)]
HashMap.toList HashMap Text [a]
map2)