udbus-model 0.2.0 → 0.2.1
raw patch · 3 files changed
+33/−32 lines, 3 filesdep +xmldep −HaXml
Dependencies added: xml
Dependencies removed: HaXml
Files
- Network/DBus/Model/Parse.hs +29/−30
- Network/DBus/Model/Types.hs +2/−0
- udbus-model.cabal +2/−2
Network/DBus/Model/Parse.hs view
@@ -11,33 +11,36 @@ import Control.Applicative -import qualified Text.XML.HaXml as X---import Text.XML.HaXml (o)---import qualified Network.DBus as DBus+import Text.XML.Light import qualified Network.DBus.Actions as DBus (unserializeSignature) import Network.DBus.Model.Types import qualified Data.ByteString.Char8 as BC import Data.List (partition)-import Data.Maybe (catMaybes) fromXML :: String -> Maybe Model-fromXML s = Model <$> mapM parseInterface (childElems "interface" root)- where X.Document _ _ root _ = X.xmlParse "" s+fromXML s = el >>= parseNode+ where el = parseXMLDoc s -parseInterface :: X.Element i -> Maybe Interface+tpNS = Just "tp"++parseNode :: Element -> Maybe Model+parseNode e = Model <$> mapM parseInterface (childElems "interface" e)+ <*> attr "name" e+ <*> pure (attrFQ (Just "xmlns") "tp" e)+ parseInterface e = Interface <$> parseName e <*> mapM parseMethod (childElems "method" e) <*> mapM parseSignal (childElems "signal" e) <*> mapM parseProperty (childElems "property" e)- <*> mapM parseEnumeration (childElems "tp:enum" e)- <*> mapM parseFlags (childElems "tp:flags" e)- <*> mapM parseStruct (childElems "tp:struct" e)+ <*> mapM parseEnumeration (childElemsFQ tpNS "enum" e)+ <*> mapM parseFlags (childElemsFQ tpNS "flags" e)+ <*> mapM parseStruct (childElemsFQ tpNS "struct" e) parseStruct e = Struct <$> parseName e- <*> mapM parseMember (childElems "tp:member" e)+ <*> mapM parseMember (childElemsFQ tpNS "member" e) parseMember e = Member <$> parseName e@@ -48,7 +51,7 @@ parseEnumeration e = Enumeration <$> parseName e <*> parseType e- <*> mapM parseEnumValue (childElems "tp:enumvalue" e)+ <*> mapM parseEnumValue (childElemsFQ tpNS "enumvalue" e) parseEnumValue e = EnumValue <$> attr "suffix" e@@ -58,7 +61,7 @@ Flags <$> parseName e <*> attr "value-prefix" e <*> parseType e- <*> mapM parseFlag (childElems "flag" e)+ <*> mapM parseFlag (childElemsFQ tpNS "flag" e) <*> parseDoc e parseFlag e =@@ -113,32 +116,28 @@ parse "readwrite" = Just ReadWrite parse _ = Nothing -parseRawType e = attrFQ (Just $ X.Namespace "tp" "") "type" e+parseRawType e = attrFQ tpNS "type" e parseName e = attr "name" e -parseDoc :: X.Element i -> Maybe (Maybe Doc)-parseDoc e = pure $ case childElems "tp:docstring" e of- [(X.Elem _ _ [X.CString _ cd _])] -> Just cd- _ -> Nothing+parseDoc e = pure $ case childElemsFQ tpNS "docstring" e of+ [el] -> case elContent el of+ [Text t] -> Just $ cdData t+ z -> error (show z)+ _ -> Nothing ------------------------------------------------------ -- XML helpers -childElemsWith :: X.CFilter i -> X.Element i -> [X.Element i]-childElemsWith elemFilter (X.Elem _ _ contents) =- catMaybes . map select . concatMap elemFilter $ contents- where- select (X.CElem e _) = Just e- select _ = Nothing+childElemsFQ :: Maybe String -> String -> Element -> [Element]+childElemsFQ ns name el = filterChildren ((qnameEqNoUrl ns name) . elName) el -childElems :: String -> X.Element i -> [X.Element i]-childElems name = childElemsWith (X.tag name)+childElems name el = childElemsFQ Nothing name el -attrFQ :: Maybe X.Namespace -> String -> X.Element i -> Maybe String-attrFQ ns name (X.Elem _ attrs _) = show <$> lookup el attrs- where el = maybe (X.N name) (\n -> X.QN n name) ns+attrFQ :: Maybe String -> String -> Element -> Maybe String+attrFQ ns name el = lookupAttrBy (qnameEqNoUrl ns name) $ elAttribs el -attr :: String -> X.Element i -> Maybe String attr = attrFQ Nothing +qnameEqNoUrl :: Maybe String -> String -> QName -> Bool+qnameEqNoUrl pre n qn = qName qn == n && qPrefix qn == pre
Network/DBus/Model/Types.hs view
@@ -31,6 +31,8 @@ -- | The whole XML model data Model = Model { interfaces :: [Interface]+ , nodeName :: String+ , nodeXmlns :: Maybe String } deriving (Show,Eq) -- | An DBus XML interface containing methods, signals and properties
udbus-model.cabal view
@@ -1,5 +1,5 @@ Name: udbus-model-Version: 0.2.0+Version: 0.2.1 Description: Model API for udbus introspection and definitions License: BSD3 License-file: LICENSE@@ -20,7 +20,7 @@ Library Build-Depends: base >= 3 && < 5 , bytestring- , HaXml+ , xml , udbus >= 0.2.0 Exposed-modules: Network.DBus.Model Other-modules: Network.DBus.Model.Types