module XmlParser.NamespaceRegistry
( NamespaceRegistry,
new,
lookup,
resolveElementName,
resolveAttributeName,
interpretAttribute,
interpretAttributes,
)
where
import qualified Data.Attoparsec.Text as Attoparsec
import qualified Data.HashMap.Strict as HashMap
import qualified Data.Map.Strict as Map
import qualified Text.XML as Xml
import qualified XmlParser.Attoparsec as Attoparsec
import XmlParser.Prelude hiding (insert, lookup)
data NamespaceRegistry
= NamespaceRegistry
(HashMap Text Text)
(Maybe Text)
new :: NamespaceRegistry
new :: NamespaceRegistry
new = HashMap Text Text -> Maybe Text -> NamespaceRegistry
NamespaceRegistry HashMap Text Text
forall k v. HashMap k v
HashMap.empty Maybe Text
forall a. Maybe a
Nothing
lookup :: Text -> NamespaceRegistry -> Maybe Text
lookup :: Text -> NamespaceRegistry -> Maybe Text
lookup Text
ns (NamespaceRegistry HashMap Text Text
nsMap Maybe Text
_) =
Text -> HashMap Text Text -> Maybe Text
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Text
ns HashMap Text Text
nsMap
resolveElementName :: Xml.Name -> NamespaceRegistry -> Maybe (Maybe Text, Text)
resolveElementName :: Name -> NamespaceRegistry -> Maybe (Maybe Text, Text)
resolveElementName = Bool -> Name -> NamespaceRegistry -> Maybe (Maybe Text, Text)
resolveName Bool
True
resolveAttributeName :: Xml.Name -> NamespaceRegistry -> Maybe (Maybe Text, Text)
resolveAttributeName :: Name -> NamespaceRegistry -> Maybe (Maybe Text, Text)
resolveAttributeName = Bool -> Name -> NamespaceRegistry -> Maybe (Maybe Text, Text)
resolveName Bool
False
resolveName :: Bool -> Xml.Name -> NamespaceRegistry -> Maybe (Maybe Text, Text)
resolveName :: Bool -> Name -> NamespaceRegistry -> Maybe (Maybe Text, Text)
resolveName Bool
useDef (Xml.Name Text
localName Maybe Text
uri Maybe Text
ns) (NamespaceRegistry HashMap Text Text
map Maybe Text
def) =
case Maybe Text
uri of
Just Text
uri -> (Maybe Text, Text) -> Maybe (Maybe Text, Text)
forall a. a -> Maybe a
Just (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
uri, Text
localName)
Maybe Text
Nothing -> case Maybe Text
ns of
Just Text
ns -> case Text -> HashMap Text Text -> Maybe Text
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Text
ns HashMap Text Text
map of
Just Text
uri -> (Maybe Text, Text) -> Maybe (Maybe Text, Text)
forall a. a -> Maybe a
Just (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
uri, Text
localName)
Maybe Text
Nothing -> Maybe (Maybe Text, Text)
forall a. Maybe a
Nothing
Maybe Text
Nothing ->
case Parser (Maybe Text, Text)
-> Text -> Either String (Maybe Text, Text)
forall a. Parser a -> Text -> Either String a
Attoparsec.parseOnly Parser (Maybe Text, Text)
Attoparsec.qName Text
localName of
Right (Maybe Text
ns, Text
localName) -> case Maybe Text
ns of
Just Text
ns -> case Text -> HashMap Text Text -> Maybe Text
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Text
ns HashMap Text Text
map of
Just Text
uri -> (Maybe Text, Text) -> Maybe (Maybe Text, Text)
forall a. a -> Maybe a
Just (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
uri, Text
localName)
Maybe Text
Nothing -> Maybe (Maybe Text, Text)
forall a. Maybe a
Nothing
Maybe Text
Nothing ->
(Maybe Text, Text) -> Maybe (Maybe Text, Text)
forall a. a -> Maybe a
Just (if Bool
useDef then Maybe Text
def else Maybe Text
forall a. Maybe a
Nothing, Text
localName)
Either String (Maybe Text, Text)
_ -> Maybe (Maybe Text, Text)
forall a. Maybe a
Nothing
insert :: Text -> Text -> NamespaceRegistry -> NamespaceRegistry
insert :: Text -> Text -> NamespaceRegistry -> NamespaceRegistry
insert Text
alias Text
uri (NamespaceRegistry HashMap Text Text
map Maybe Text
def) =
HashMap Text Text -> Maybe Text -> NamespaceRegistry
NamespaceRegistry (Text -> Text -> HashMap Text Text -> HashMap Text Text
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HashMap.insert Text
alias Text
uri HashMap Text Text
map) Maybe Text
def
setDefault :: Text -> NamespaceRegistry -> NamespaceRegistry
setDefault :: Text -> NamespaceRegistry -> NamespaceRegistry
setDefault Text
uri (NamespaceRegistry HashMap Text Text
map Maybe Text
_) =
HashMap Text Text -> Maybe Text -> NamespaceRegistry
NamespaceRegistry HashMap Text Text
map (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
uri)
interpretAttribute :: Xml.Name -> Text -> NamespaceRegistry -> NamespaceRegistry
interpretAttribute :: Name -> Text -> NamespaceRegistry -> NamespaceRegistry
interpretAttribute (Xml.Name Text
localName Maybe Text
namespace Maybe Text
prefix) Text
uri =
case Maybe Text
namespace of
Maybe Text
Nothing -> case Maybe Text
prefix of
Maybe Text
Nothing -> case Parser (Maybe Text, Text)
-> Text -> Either String (Maybe Text, Text)
forall a. Parser a -> Text -> Either String a
Attoparsec.parseOnly Parser (Maybe Text, Text)
Attoparsec.qName Text
localName of
Right (Just Text
"xmlns", Text
name) -> Text -> Text -> NamespaceRegistry -> NamespaceRegistry
insert Text
name Text
uri
Right (Maybe Text
Nothing, Text
"xmlns") -> Text -> NamespaceRegistry -> NamespaceRegistry
setDefault Text
uri
Either String (Maybe Text, Text)
_ -> NamespaceRegistry -> NamespaceRegistry
forall k (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id
Maybe Text
_ -> NamespaceRegistry -> NamespaceRegistry
forall k (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id
Maybe Text
_ -> NamespaceRegistry -> NamespaceRegistry
forall k (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id
interpretAttributes :: Map Xml.Name Text -> NamespaceRegistry -> NamespaceRegistry
interpretAttributes :: Map Name Text -> NamespaceRegistry -> NamespaceRegistry
interpretAttributes Map Name Text
attributes NamespaceRegistry
x =
(NamespaceRegistry -> Name -> Text -> NamespaceRegistry)
-> NamespaceRegistry -> Map Name Text -> NamespaceRegistry
forall a k b. (a -> k -> b -> a) -> a -> Map k b -> a
Map.foldlWithKey' (\NamespaceRegistry
x Name
name Text
value -> Name -> Text -> NamespaceRegistry -> NamespaceRegistry
interpretAttribute Name
name Text
value NamespaceRegistry
x) NamespaceRegistry
x Map Name Text
attributes