module OpcXmlDaClient.XmlBuilder
(
elementXml,
Element,
element,
Node,
elementNode,
contentNode,
astNode,
Content,
textContent,
qNameContent,
QName,
namespacedQName,
unnamespacedQName,
)
where
import qualified Data.ByteString.Lazy as Lbs
import qualified Data.Map.Strict as Map
import OpcXmlDaClient.Base.Prelude
import qualified OpcXmlDaClient.XmlBuilder.Identified as Identified
import qualified Text.XML as Xml
elementXml :: Element -> ByteString
elementXml :: Element -> ByteString
elementXml (Element Namespaced Element
namespacedElement) =
case Namespaced Element -> (Element, [(Text, Text)])
forall a. Namespaced a -> (a, [(Text, Text)])
runNamespaced Namespaced Element
namespacedElement of
(Element
element, [(Text, Text)]
namespaces) ->
let document :: Document
document = Prologue -> Element -> [Miscellaneous] -> Document
Xml.Document ([Miscellaneous] -> Maybe Doctype -> [Miscellaneous] -> Prologue
Xml.Prologue [] Maybe Doctype
forall a. Maybe a
Nothing []) Element
element []
renderingSettings :: RenderSettings
renderingSettings = RenderSettings
forall a. Default a => a
def {rsNamespaces :: [(Text, Text)]
Xml.rsNamespaces = ((Text, Text) -> (Text, Text)) -> [(Text, Text)] -> [(Text, Text)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text, Text) -> (Text, Text)
forall a b. (a, b) -> (b, a)
swap [(Text, Text)]
namespaces}
in ByteString -> ByteString
Lbs.toStrict (RenderSettings -> Document -> ByteString
Xml.renderLBS RenderSettings
renderingSettings Document
document)
newtype Element = Element (Namespaced Xml.Element)
element :: QName -> [(QName, Content)] -> [Node] -> Element
element :: QName -> [(QName, Content)] -> [Node] -> Element
element (QName Namespaced Name
qName) [(QName, Content)]
attrList [Node]
nodeList =
Namespaced Element -> Element
Element (Namespaced Element -> Element) -> Namespaced Element -> Element
forall a b. (a -> b) -> a -> b
$
Name -> Map Name Text -> [Node] -> Element
Xml.Element
(Name -> Map Name Text -> [Node] -> Element)
-> Namespaced Name
-> Identified Text Text (Map Name Text -> [Node] -> Element)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Namespaced Name
qName
Identified Text Text (Map Name Text -> [Node] -> Element)
-> Identified Text Text (Map Name Text)
-> Identified Text Text ([Node] -> Element)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ([(Name, Text)] -> Map Name Text)
-> Identified Text Text [(Name, Text)]
-> Identified Text Text (Map Name Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [(Name, Text)] -> Map Name Text
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList (((QName, Content) -> Identified Text Text (Name, Text))
-> [(QName, Content)] -> Identified Text Text [(Name, Text)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (QName, Content) -> Identified Text Text (Name, Text)
attr [(QName, Content)]
attrList)
Identified Text Text ([Node] -> Element)
-> Identified Text Text [Node] -> Namespaced Element
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Node -> Identified Text Text Node)
-> [Node] -> Identified Text Text [Node]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Node -> Identified Text Text Node
runNode [Node]
nodeList
where
attr :: (QName, Content) -> Identified Text Text (Name, Text)
attr (QName Namespaced Name
name, Content Namespaced Text
content) =
(,) (Name -> Text -> (Name, Text))
-> Namespaced Name -> Identified Text Text (Text -> (Name, Text))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Namespaced Name
name Identified Text Text (Text -> (Name, Text))
-> Namespaced Text -> Identified Text Text (Name, Text)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Namespaced Text
content
newtype Node = Node {Node -> Identified Text Text Node
runNode :: Namespaced Xml.Node}
elementNode :: Element -> Node
elementNode :: Element -> Node
elementNode (Element Namespaced Element
a) = Identified Text Text Node -> Node
Node ((Element -> Node)
-> Namespaced Element -> Identified Text Text Node
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Element -> Node
Xml.NodeElement Namespaced Element
a)
contentNode :: Content -> Node
contentNode :: Content -> Node
contentNode (Content Namespaced Text
a) = Identified Text Text Node -> Node
Node ((Text -> Node) -> Namespaced Text -> Identified Text Text Node
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Node
Xml.NodeContent Namespaced Text
a)
astNode :: Xml.Node -> Node
astNode :: Node -> Node
astNode = Identified Text Text Node -> Node
Node (Identified Text Text Node -> Node)
-> (Node -> Identified Text Text Node) -> Node -> Node
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Node -> Identified Text Text Node
forall (f :: * -> *) a. Applicative f => a -> f a
pure
newtype Content = Content (Namespaced Text)
instance IsString Content where
fromString :: String -> Content
fromString = Text -> Content
textContent (Text -> Content) -> (String -> Text) -> String -> Content
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. String -> Text
forall a. IsString a => String -> a
fromString
textContent :: Text -> Content
textContent :: Text -> Content
textContent Text
text =
Namespaced Text -> Content
Content (Text -> Namespaced Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
text)
qNameContent :: QName -> Content
qNameContent :: QName -> Content
qNameContent (QName Namespaced Name
qName) =
Namespaced Text -> Content
Content ((Name -> Text) -> Namespaced Name -> Namespaced Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Name -> Text
renderName Namespaced Name
qName)
where
renderName :: Name -> Text
renderName (Xml.Name Text
name Maybe Text
_ Maybe Text
prefix) =
Text -> (Text -> Text) -> Maybe Text -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
name (\Text
prefix -> Text
prefix Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
":" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name) Maybe Text
prefix
newtype QName = QName (Namespaced Xml.Name)
instance IsString QName where
fromString :: String -> QName
fromString = Text -> QName
unnamespacedQName (Text -> QName) -> (String -> Text) -> String -> QName
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. String -> Text
forall a. IsString a => String -> a
fromString
namespacedQName ::
Text ->
Text ->
QName
namespacedQName :: Text -> Text -> QName
namespacedQName Text
uri Text
name =
Namespaced Name -> QName
QName (Text -> (Text -> Name) -> Namespaced Name
forall k v a. k -> (v -> a) -> Identified k v a
Identified.identifying Text
uri (\Text
prefix -> Text -> Maybe Text -> Maybe Text -> Name
Xml.Name Text
name (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
uri) (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
prefix)))
unnamespacedQName :: Text -> QName
unnamespacedQName :: Text -> QName
unnamespacedQName Text
name =
Namespaced Name -> QName
QName (Name -> Namespaced Name
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Maybe Text -> Maybe Text -> Name
Xml.Name Text
name Maybe Text
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing))
type Namespaced = Identified.Identified Text Text
runNamespaced :: Namespaced a -> (a, [(Text, Text)])
runNamespaced :: Namespaced a -> (a, [(Text, Text)])
runNamespaced Namespaced a
identified =
Namespaced a -> (Int -> Text) -> (a, [(Text, Text)])
forall k v a.
(Hashable k, Eq k) =>
Identified k v a -> (Int -> v) -> (a, [(k, v)])
Identified.run Namespaced a
identified Int -> Text
forall a a. (Semigroup a, IsString a, Show a, Enum a) => a -> a
alias
where
alias :: a -> a
alias a
x = a
"ns" a -> a -> a
forall a. Semigroup a => a -> a -> a
<> String -> a
forall a. IsString a => String -> a
fromString (a -> String
forall a. Show a => a -> String
show (a -> a
forall a. Enum a => a -> a
succ a
x))