d-bus 0.1.0 → 0.1.1

raw patch · 4 files changed

+18/−37 lines, 4 files

Files

• d-bus.cabal +1/−1
• src/DBus/Message.hs +1/−1
• src/DBus/Object.hs +3/−18
• src/DBus/Types.hs +13/−17

@@ -1,5 +1,5 @@ name:                d-bus-version:             0.1.0+version:             0.1.1 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

@@ -367,7 +367,7 @@             -> IO (Either MethodError ret) callMethod dest path interface member (arg :: args) flags conn = do     let sng = sing :: Sing (RepType args)-        flsng = flattenRepS sng+        flsng = sFlattenRepType sng         args' = withSingI flsng $ argsToValues $ SDBA (flattenRep arg)     ret <- getAnswer $ callMethod' dest path interface member args' flags conn     return $ case ret of

@@ -61,28 +61,13 @@     type RepMethodValue f :: [DBusType]     repMethod :: f -> MethodWrapper (RepMethodArgs f) (RepMethodValue f) -type family FlattenRepType r where-    FlattenRepType TypeUnit = '[]-    FlattenRepType (TypeStruct ts) = ts-    FlattenRepType t = '[t]---- TODO: Figure out how to convice GHC that the flattenRepType function and the--- FlattenRepType type function coincide-flattenRepS :: Sing a -> Sing (FlattenRepType a)-flattenRepS s = case flattenRepS' s of-    SomeSing s' -> unsafeCoerce s'-  where-    flattenRepS' STypeUnit = SomeSing SNil-    flattenRepS' (STypeStruct ts) = SomeSing ts-    flattenRepS' t = SomeSing (SCons t SNil)- flattenRep :: ( Representable a ) =>               a            -> DBusArguments (FlattenRepType (RepType a)) flattenRep (x :: t) =     let rts = sing :: Sing (RepType t)         frts :: Sing (FlattenRepType (RepType t))-        frts = flattenRepS rts+        frts = sFlattenRepType rts     in case (rts, frts) of         (STypeUnit, SNil) -> ArgsNil         (STypeStruct ts, ts') -> case toRep x of DBVStruct str -> structToArgs str@@ -94,14 +79,14 @@     type RepMethodArgs (IO t) = '[]     type RepMethodValue (IO t) = FlattenRepType (RepType t)     repMethod (f :: IO t)-        = let sng = flattenRepS (sing :: Sing (RepType t))+        = let sng = sFlattenRepType (sing :: Sing (RepType t))           in withSingI sng $ MReturn $ flattenRep . toRep <$> lift f  instance (Representable t) => RepMethod (SignalT IO t) where     type RepMethodArgs (SignalT IO t) = '[]     type RepMethodValue (SignalT IO t) = FlattenRepType (RepType t)     repMethod (f :: SignalT IO t)-        = let sng = flattenRepS (sing :: Sing (RepType t))+        = let sng = sFlattenRepType (sing :: Sing (RepType t))           in withSingI sng $ MReturn $ flattenRep . toRep <$> f  

@@ -13,7 +13,9 @@ {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE PolyKinds #-} + module DBus.Types where  import           Control.Applicative@@ -148,6 +150,14 @@ singEqInstances [''DBusSimpleType, ''DBusType, ''Parity] singDecideInstances [''DBusSimpleType, ''DBusType] ++singletons [d|+  flattenRepType :: DBusType -> [DBusType]+  flattenRepType TypeUnit              = []+  flattenRepType (TypeStruct ts)       = ts+  flattenRepType (DBusSimpleType t)  = [DBusSimpleType t]+  |]+ -- | A Transformer for (IO) actions that might want to send a signal. newtype SignalT m a = SignalT { unSignal :: WriterT [Signal] m a}                       deriving ( Functor@@ -324,28 +334,14 @@     DBVByteArray  x == DBVArray       y = BS.pack (map (\(DBVByte w) -> w) y) == x     _               ==  _               = False ---- TODO: Reinstate once https://github.com/goldfirere/singletons/issues/2 is--- resolved---- fromVariant :: SingI t => DBusValue TypeVariant -> Maybe (DBusValue t)--- fromVariant (DBVVariant (v :: DBusValue s))---     = fix $ \(_ :: Maybe (DBusValue t)) ->---         let ss = (sing :: Sing s)---             st = (sing :: Sing t)---         in case (ss %~ st) of---             Proved Refl -- Bring into scope a proof that s~t---                 -> Just v---             Disproved _ -> Nothing- castDBV :: (SingI s, SingI t) => DBusValue s -> Maybe (DBusValue t) castDBV (v :: DBusValue s)     = fix $ \(_ :: Maybe (DBusValue t)) ->         let ss = (sing :: Sing s)             st = (sing :: Sing t)-        in case (ss %:== st) of-            STrue -> Just (unsafeCoerce v)-            SFalse -> Nothing+        in case (ss %~ st) of+            Proved Refl -> Just v+            Disproved _ -> Nothing  data SomeDBusValue where     DBV :: SingI t => DBusValue t -> SomeDBusValue