d-bus 0.1.5 → 0.1.6

raw patch · 6 files changed

+56/−42 lines, 6 filesdep ~binaryPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: binary

API changes (from Hackage documentation)

Files

• d-bus.cabal +3/−3
• src/DBus/Introspect.hs +20/−20
• src/DBus/Property.hs +5/−2
• src/DBus/Scaffold.hs +17/−11
• src/DBus/Types.hs +1/−0
• src/DBus/Wire.hs +10/−6

@@ -1,5 +1,5 @@ name:                d-bus-version:             0.1.5+version:             0.1.6 synopsis:            Permissively licensed D-Bus client library description:         This library uses modern extensions to the Haskell type system                      (including GADTs, DataKinds and TypeFamilies) and the@@ -9,7 +9,7 @@ license-file:        LICENSE author:              Philipp Balzarek maintainer:          p.balzarek@googlemail.com-copyright:           2013 Philipp Balzarek+copyright:           2013-2017 Philipp Balzarek category:            Network, Desktop build-type:          Simple cabal-version:       >=1.10@@ -41,7 +41,7 @@   build-depends:     async >= 2.0                    , attoparsec >= 0.12                    , base >= 4 && <5-                   , binary >= 0.7+                   , binary >= 0.8.1.0                    , blaze-builder >= 0.3                    , bytestring >= 0.10                    , conduit >= 1.1

@@ -65,7 +65,7 @@ propertyAccessToText Write = "write" propertyAccessToText ReadWrite = "readwrite" -data IArgument = IArgument { iArgumentName :: Text+data IArgument = IArgument { iArgumentName :: Maybe Text                            , iArgumentType :: DBusType                            , iArgumentDirection :: Maybe IDirection                            } deriving (Eq, Show, Data, Typeable)@@ -118,7 +118,7 @@ xpArgument = xpWrap (\(name, tp, dir) -> IArgument name tp dir)                     (\(IArgument name tp dir) -> (name, tp, dir)) $                  xpElemAttrs "arg"-                     (xp3Tuple (xpAttribute "name" xpText)+                     (xp3Tuple (xpAttribute' "name" xpText)                                (xpAttribute "type" xpSignature)                                (xpAttribute' "direction" xpDirection)                      )@@ -207,13 +207,13 @@     toArgs m@(Method _ _ argDs resDs) =         let (args, res) = methodSignature m             (ts, rs) = argDescriptions argDs resDs-        in zipWith (\n t -> IArgument n t (Just In)) ts args-           ++ zipWith ((\r t -> IArgument r t (Just Out))) rs res+        in zipWith (\n t -> IArgument (Just n) t (Just In)) ts args+           ++ zipWith ((\r t -> IArgument (Just  r) t (Just Out))) rs res   introspectSignalArgument :: DBusType -> Text -> IArgument introspectSignalArgument tp name =-    IArgument { iArgumentName = name+    IArgument { iArgumentName = Just name               , iArgumentType = tp               , iArgumentDirection = Nothing               }@@ -288,31 +288,31 @@                iMethodName = "Get"              , iMethodArguments =                  [ IArgument {-                       iArgumentName = "interface_name"+                       iArgumentName = Just "interface_name"                        , iArgumentType = DBusSimpleType TypeString                        , iArgumentDirection = Just In}                  , IArgument {-                       iArgumentName = "property_name"+                       iArgumentName = Just "property_name"                      , iArgumentType = DBusSimpleType TypeString                      , iArgumentDirection = Just In}-                          , IArgument {-                                iArgumentName = "value"-                              , iArgumentType = TypeVariant-                              , iArgumentDirection = Just Out }]-                      , iMethodAnnotations = []}+                 , IArgument {+                     iArgumentName = Just "value"+                     , iArgumentType = TypeVariant+                     , iArgumentDirection = Just Out }]+             , iMethodAnnotations = []}           , IMethod{                 iMethodName = "Set"               , iMethodArguments =                   [ IArgument {-                         iArgumentName = "interface_name"+                         iArgumentName = Just "interface_name"                        , iArgumentType = DBusSimpleType TypeString                        , iArgumentDirection = Just In }                   , IArgument {-                         iArgumentName = "property_name"+                         iArgumentName = Just "property_name"                        , iArgumentType = DBusSimpleType TypeString                        , iArgumentDirection = Just In }                   , IArgument {-                         iArgumentName = "value"+                         iArgumentName = Just "value"                         , iArgumentType = TypeVariant                         , iArgumentDirection = Just In}]               , iMethodAnnotations = [] }@@ -320,11 +320,11 @@                 iMethodName = "GetAll"               , iMethodArguments =                   [ IArgument {-                         iArgumentName = "interface_name"+                         iArgumentName = Just "interface_name"                        , iArgumentType = DBusSimpleType TypeString                        , iArgumentDirection = Just In }                   , IArgument {-                         iArgumentName = "props"+                         iArgumentName = Just "props"                        , iArgumentType = TypeDict TypeString TypeVariant                        , iArgumentDirection = Just Out }]               , iMethodAnnotations = [] }]@@ -332,15 +332,15 @@               [ ISignal { iSignalName = "PropertiesChanged"                         , iSignalArguments =                             [ IArgument {-                                   iArgumentName = "interface_name"+                                   iArgumentName = Just "interface_name"                                  , iArgumentType = DBusSimpleType TypeString                                  , iArgumentDirection = Nothing}                             , IArgument {-                                   iArgumentName = "changed_properties"+                                   iArgumentName = Just "changed_properties"                                  , iArgumentType = TypeDict TypeString TypeVariant                                  , iArgumentDirection = Nothing}                             , IArgument {-                                   iArgumentName = "invalidated_properties"+                                   iArgumentName = Just "invalidated_properties"                                  , iArgumentType =                                      TypeArray (DBusSimpleType TypeString)                                  , iArgumentDirection = Nothing}]

@@ -47,13 +47,16 @@     let prop = Property { propertyPath = path                         , propertyInterface = iface                         , propertyName = name-                        , propertySet = doSet <$> set+                        , propertySet = doSet prop <$> set                         , propertyGet = fmap toRep <$> get                         , propertyEmitsChangedSignal = pecs                         }     in prop   where-    doSet f v = f =<< fromRepHelper v+    doSet prop f v = do+      x <- fromRepHelper v+      propertyChanged prop x+      f x     fromRepHelper x = case fromRep x of         Nothing -> methodError argTypeMismatch         Just r -> return r

@@ -64,9 +64,9 @@ makeDbusEndpoints :: DBusEndpointOptions -> ObjectPath -> FilePath -> Q [Dec] makeDbusEndpoints conf root xmlFile = do -- @TODO: root   node <- readIntrospectXml xmlFile-  let methods = nodeMethodDescriptions "" node-      propDs = nodePropertyDescriptions "" node-      sigDs = nodeSignals "" node+  let methods = nodeMethodDescriptions node+      propDs = nodePropertyDescriptions node+      sigDs = nodeSignals node       downcase [] = []       downcase (x:xs) = toLower x : xs   mfs <- fmap catMaybes . forM methods $ \smd ->@@ -125,8 +125,9 @@             in mapIInterfaces f subPath n     in ifaceMembers ++ subNodeMembers -nodeMethodDescriptions :: Text -> INode -> [SomeMethodDescription]-nodeMethodDescriptions = mapIInterfaces interfacMethodDescriptions+nodeMethodDescriptions :: INode -> [SomeMethodDescription]+nodeMethodDescriptions node =+  mapIInterfaces interfacMethodDescriptions (fromMaybe "" $ nodeName node) node  interfacPropertyDescriptions :: Text -> IInterface -> [PropertyDescription] interfacPropertyDescriptions path iface =@@ -146,9 +147,10 @@                               , pdType :: DBusType                               } -nodePropertyDescriptions :: Text -> INode -> [PropertyDescription]-nodePropertyDescriptions = mapIInterfaces interfacPropertyDescriptions-+nodePropertyDescriptions :: INode -> [PropertyDescription]+nodePropertyDescriptions node =+  mapIInterfaces interfacPropertyDescriptions (fromMaybe "" $ nodeName node)+                 node liftText t = [|Text.pack $(liftString (Text.unpack  t))|]  @@ -191,6 +193,8 @@                       -> Q [Dec] liftMethodDescription name smd = case smd of   (SMD (md :: MethodDescription args rets)) -> do+    when (isEmpty $ methodObjectPath md)+      . fail $ "empty method path: " ++ show md     let ats = promotedListT . map promoteDBusType $                 fromSing (sing :: Sing args)         rts = promotedListT . map promoteDBusType $@@ -232,9 +236,11 @@         Just e -> valD (varP name) (normalB . rp $ liftText e) []     return [tp, cl] -nodeSignals :: Text -> INode -> [SomeSignalDescription]-nodeSignals = mapIInterfaces interfaceSignalDs+nodeSignals :: INode -> [SomeSignalDescription]+nodeSignals node =+  mapIInterfaces interfaceSignalDs (fromMaybe "" $ nodeName node) node + interfaceSignalDs :: Text -> IInterface -> [SomeSignalDescription] interfaceSignalDs ndName iface = signalDs (objectPath ndName)                                      (iInterfaceName iface)@@ -260,7 +266,7 @@ toSings [] = SSAD SNil Done toSings (iarg : iargs) =     let t = iArgumentType iarg-        desc = iArgumentName iarg+        desc = fromMaybe "" $ iArgumentName iarg     in case (toSing t, toSings iargs) of             (SomeSing s, SSAD ss descs)                 -> SSAD (SCons s ss) (desc :> descs)

@@ -437,6 +437,7 @@     DBVUnit         ==  DBVUnit         = True     DBVArray      x == DBVByteArray   y = BS.pack (map (\(DBVByte w) -> w) x) == y     DBVByteArray  x == DBVArray       y = BS.pack (map (\(DBVByte w) -> w) y) == x+    _               ==  _               = False  castDBV :: (SingI s, SingI t) => DBusValue s -> Maybe (DBusValue t) castDBV (v :: DBusValue s)

@@ -240,13 +240,13 @@ getWord64 = getting B.getWord64le B.getWord64be 8  getInt16 :: DBusGet Int16-getInt16 = fromIntegral <$> getWord16+getInt16 = getting B.getInt16le B.getInt16be 2  getInt32 :: DBusGet Int32-getInt32 = fromIntegral <$> getWord32+getInt32 = getting B.getInt32le B.getInt32be 4  getInt64 :: DBusGet Int64-getInt64 = fromIntegral <$> getWord64+getInt64 = getting B.getInt64le B.getInt64be 8  getDouble :: DBusGet Double getDouble = getting B.getFloat64le B.getFloat64be 8@@ -355,10 +355,14 @@             EQ -> return []             GT -> mzero -+-- | Run a Binary Getter as a Sink sinkGet :: MonadThrow m => B.Get b -> C.ConduitM BS.ByteString o m b sinkGet f = sink (B.runGetIncremental f)   where       sink (B.Done bs _ v)  = C.leftover bs >> return v-      sink (B.Fail u o e)   = throwM $ DBusParseError e-      sink (B.Partial next) = C.await >>= sink . next+      sink (B.Fail u o e)   = throwM $ DBusParseError $ e+                                ++ " (" ++ show o ++ "; "+                                ++ show u ++ ")"+      sink (B.Partial next) = do+        bs <- C.await+        sink $ next bs