d-bus 0.0.1.1 → 0.0.3
raw patch · 10 files changed
+43/−33 lines, 10 filesdep +conduit-extradep +exceptionsdep ~attoparsecdep ~conduitdep ~singletons
Dependencies added: conduit-extra, exceptions
Dependency ranges changed: attoparsec, conduit, singletons
Files
- d-bus.cabal +6/−4
- src/DBus.hs +5/−1
- src/DBus/MainLoop.hs +7/−6
- src/DBus/Message.hs +6/−5
- src/DBus/MessageBus.hs +3/−3
- src/DBus/Object.hs +3/−3
- src/DBus/Signal.hs +1/−1
- src/DBus/TH.hs +3/−2
- src/DBus/Types.hs +4/−4
- src/DBus/Wire.hs +5/−4
d-bus.cabal view
@@ -1,5 +1,5 @@ name: d-bus-version: 0.0.1.1+version: 0.0.3 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@@ -33,18 +33,19 @@ , DBus.Wire build-depends: base >= 4 && <5 , async >= 2.0- , attoparsec >= 0.11+ , attoparsec >= 0.12 , binary >= 0.7 , blaze-builder >= 0.3 , bytestring >= 0.10- , conduit >= 1.0+ , conduit >= 1.1+ , conduit-extra >= 1.1 , containers >= 0.5 , data-binary-ieee754 >= 0.4 , data-default >= 0.5 , free >= 4.2 , mtl >= 2.1 , network >= 2.4- , singletons >= 0.9+ , singletons >= 1.0 , stm >= 2.4 , template-haskell >= 2.8 , text >= 1.1@@ -53,6 +54,7 @@ , xml-picklers >= 0.3 , xml-types >= 0.3 , hslogger >= 1.2+ , exceptions >= 0.6 if os(freebsd) { c-sources: src/cbits/credentials.c cpp-options: -DSEND_CREDENTIALS
src/DBus.hs view
@@ -32,7 +32,9 @@ , DBusType(..) , Signature(..) , typeOf--- ** ObjectPath+-- ** Objects+ , Object(..)+ , Interface(..) , ObjectPath , objectPath , objectPathToText@@ -43,9 +45,11 @@ -- * Methods , Method(..) , MethodWrapper(..)+ , MethodDescription(..) , repMethod , callMethod , callMethod'+ , MsgError(..) -- * Introspection , addIntrospectable -- * Message Bus
src/DBus/MainLoop.hs view
@@ -16,6 +16,7 @@ import Control.Concurrent.STM import qualified Control.Exception as Ex import Control.Monad+import Control.Monad.Catch (MonadThrow, throwM) import Control.Monad.Fix (mfix) import Control.Monad.Trans import Data.Binary.Get as B@@ -38,7 +39,7 @@ import System.Log.Logger import System.Mem.Weak -import Data.Attoparsec as AP+import Data.Attoparsec.ByteString as AP import Data.List (intercalate) import Data.Monoid import Numeric@@ -99,7 +100,7 @@ case ret of Left e -> return $ Left (MsgError "org.freedesktop.DBus.Error.Failed"- (Just $ "Method threw exception "+ (Just $ "Method threw exception: " `Text.append` Text.pack (show e)) []) Right r -> return $ r let bs = either (errToErrMessage serial) (mkReturnMethod serial) ret@@ -120,13 +121,13 @@ when alive retry -- | Which Bus to connect to-data ConnectionType = Session -- ^ The well-known system bus. First+data ConnectionType = System -- ^ The well-known system bus. First -- the environmental variable- -- DBUS_SESSION_BUS_ADDRESS is checked and if it+ -- DBUS_SYSTEM_BUS_ADDRESS is checked and if it -- doesn't exist the address -- /unix:path=\/var\/run\/dbus\/system_bus_socket/ -- is used- | System -- ^ The well-known system bus. Refers to the+ | Session -- ^ The well-known session bus. Refers to the -- address stored in the environmental variable -- DBUS_SESSION_BUS_ADDRESS | Address String -- ^ The bus at the give addresss@@ -159,7 +160,7 @@ debugM "DBus" $ "connecting to " ++ addressString mbS <- connectString addressString s <- case mbS of- Nothing -> C.monadThrow (CouldNotConnect+ Nothing -> throwM (CouldNotConnect "All addresses failed to connect") Just s -> return s sendCredentials s
src/DBus/Message.hs view
@@ -13,7 +13,7 @@ import Control.Concurrent.STM import Control.Monad import Control.Monad.Reader-import qualified Data.Attoparsec.Char8 as AP8+import qualified Data.Attoparsec.ByteString.Char8 as AP8 import qualified Data.Binary.Get as B import Data.Bits import qualified Data.ByteString as BS@@ -27,6 +27,7 @@ import qualified Data.Text as Text import Data.Word import System.Mem.Weak+import Control.Monad.Catch (MonadThrow, throwM) import DBus.Error import DBus.Representable@@ -262,7 +263,7 @@ getDBVByType t return (header, args) -parseMessages :: C.MonadThrow m =>+parseMessages :: MonadThrow m => C.ConduitM BS.ByteString (MessageHeader, [SomeDBusValue]) m b parseMessages = forever $ C.yield =<< sinkGet getMessage @@ -306,7 +307,7 @@ -- | Synchronously call a method. Returned errors are thrown as 'MethodError's. -- If the returned value's type doesn't match the expected type a -- 'MethodSignatureMissmatch' is thrown.-callMethod' :: (SingI (RepType a), Representable a, C.MonadThrow m, MonadIO m) =>+callMethod' :: (SingI (RepType a), Representable a, MonadThrow m, MonadIO m) => Text.Text -- ^ Entity to send the message to -> ObjectPath -- ^ Object -> Text.Text -- ^ Interface@@ -319,7 +320,7 @@ ret <- liftIO . getAnswer $ callMethod dest path interface member args flags conn case ret of- Left e -> C.monadThrow $ MethodErrorMessage e+ Left e -> throwM $ MethodErrorMessage e Right r -> case fromRep =<< dbusValue r of- Nothing -> C.monadThrow $ MethodSignatureMissmatch r+ Nothing -> throwM $ MethodSignatureMissmatch r Just x -> return x
src/DBus/MessageBus.hs view
@@ -7,7 +7,7 @@ import DBus.Message import DBus.Object import DBus.Types-import Data.Conduit (MonadThrow, monadThrow)+import Control.Monad.Catch (MonadThrow, throwM) import Data.Default import Data.Singletons import qualified Data.Text as Text@@ -66,7 +66,7 @@ 2 -> return InQueue 3 -> return Exists 4 -> return AlreadyOwner- e -> monadThrow . MarshalError $ "Not a ReqeustName reply: " ++ show e+ e -> throwM . MarshalError $ "Not a ReqeustName reply: " ++ show e data ReleaseNameReply = Released | NonExistent@@ -82,7 +82,7 @@ 1 -> return Released 2 -> return NonExistent 3 -> return NotOwner- e -> monadThrow . MarshalError $ "Not a ReleaseName reply: " ++ show e+ e -> throwM . MarshalError $ "Not a ReleaseName reply: " ++ show e listQueuedOwners :: (MonadIO m, MonadThrow m) => Text.Text
src/DBus/Object.hs view
@@ -18,15 +18,15 @@ import Data.List (intercalate, find) import Data.Maybe import Data.Singletons-import Data.Singletons.List+import Data.Singletons.Prelude.List import Data.Singletons.TH import qualified Data.Text as Text import DBus.Types class IsMethod f where- type ArgTypes f- type ResultType f+ type ArgTypes f :: [DBusType]+ type ResultType f :: DBusType toMethod :: f -> MethodWrapper (ArgTypes f) (ResultType f) instance SingI t => IsMethod (IO (DBusValue t)) where
src/DBus/Signal.hs view
@@ -3,7 +3,7 @@ import Control.Applicative import Control.Monad.Trans-import Data.Conduit (MonadThrow)+import Control.Monad.Catch (MonadThrow) import qualified Data.List as List import Data.Maybe import Data.Monoid
src/DBus/TH.hs view
@@ -74,7 +74,7 @@ [(conName, fields)] -> oneCon conName fields cs -> multiCon cs inst <- instanceD ctx iHead- [ tySynInstD ''RepType [fullType] repType+ [ tySynInstD ''RepType $ tySynEqn [fullType] repType , funD 'toRep toClauses , funD 'fromRep fromClauses ]@@ -182,7 +182,8 @@ varNames <- replicateM num (newName "x") tmpNames <- replicateM num (newName "mbx") instanceD ctx iHead- [ tySynInstD ''RepType [tp] (appT (promotedT 'TypeStruct) tpList)+ [ tySynInstD ''RepType $ tySynEqn [tp]+ (appT (promotedT 'TypeStruct) tpList) , funD ('toRep) $ let pats = [tupP (map varP varNames)] bs = normalB (appE (conE 'DBVStruct)
src/DBus/Types.hs view
@@ -28,9 +28,9 @@ import Data.List (intercalate) import qualified Data.Map as Map import Data.Singletons (withSingI)-import Data.Singletons.Bool-import Data.Singletons.List-import Data.Singletons.TH+import Data.Singletons.Prelude.Bool+import Data.Singletons.Prelude.List+import Data.Singletons.TH hiding (Error) import qualified Data.Text as Text import Data.Typeable(Typeable) import Data.Word@@ -140,7 +140,7 @@ infixr 0 :-> data MethodDescription parity where (:->) :: Text.Text -> MethodDescription n -> MethodDescription (Arg n)- Result :: Text.Text -> MethodDescription Null+ Result :: Text.Text -> MethodDescription 'Null genSingletons [''DBusSimpleType, ''DBusType, ''Parity] singEqInstances [''DBusSimpleType, ''DBusType, ''Parity]
src/DBus/Wire.hs view
@@ -8,6 +8,7 @@ import Control.Applicative ((<$>), (<*>)) import Control.Monad+import Control.Monad.Catch (MonadThrow, throwM) import Control.Monad.RWS import Control.Monad.Reader import Control.Monad.State@@ -16,13 +17,13 @@ import qualified Data.Binary.IEEE754 as B import qualified Data.ByteString as BS import qualified Data.ByteString.Lazy.Builder as BS+import qualified Data.Conduit as C import Data.Int import Data.Singletons-import Data.Singletons.List+import Data.Singletons.Prelude.List import qualified Data.Text as Text import qualified Data.Text.Encoding as Text import Data.Word-import qualified Data.Conduit as C import DBus.Types import DBus.Signature@@ -355,9 +356,9 @@ GT -> mzero -sinkGet :: C.MonadThrow m => B.Get b -> C.ConduitM BS.ByteString o m b+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) = C.monadThrow $ DBusParseError e+ sink (B.Fail u o e) = throwM $ DBusParseError e sink (B.Partial next) = C.await >>= sink . next