ble 0.3.1.0 → 0.3.2.0
raw patch · 6 files changed
+60/−10 lines, 6 files
Files
- ble.cabal +3/−3
- package.yaml +2/−2
- src/Bluetooth.hs +2/−0
- src/Bluetooth/Internal/DBus.hs +25/−3
- src/Bluetooth/Internal/Types.hs +2/−2
- test/BluetoothSpec.hs +26/−0
ble.cabal view
@@ -3,12 +3,12 @@ -- see: https://github.com/sol/hpack name: ble-version: 0.3.1.0+version: 0.3.2.0 synopsis: Bluetooth Low Energy (BLE) peripherals description: This package provides a Haskell API for writing Bluetooth Low Energy peripherals. stability: alpha homepage: http://github.com/plow-technologies/ble#readme-bug-reports: https://github.com/plow-techonologies/ble/issues+bug-reports: https://github.com/plow-technologies/ble/issues author: Julian K. Arni maintainer: jkarni@turingjump.com copyright: 2016 Julian K. Arni@@ -25,7 +25,7 @@ source-repository head type: git- location: https://github.com/plow-techonologies/ble+ location: https://github.com/plow-technologies/ble flag bluez543 description: Bluez version 5.43 or greater
package.yaml view
@@ -1,5 +1,5 @@ name: ble-version: 0.3.1.0+version: 0.3.2.0 synopsis: Bluetooth Low Energy (BLE) peripherals description: > This package provides a Haskell API for writing Bluetooth Low Energy@@ -11,7 +11,7 @@ author: Julian K. Arni maintainer: jkarni@turingjump.com copyright: 2016 Julian K. Arni-github: plow-techonologies/ble+github: plow-technologies/ble stability: alpha tested-with: GHC == 7.10.3, GHC == 8.0.1
src/Bluetooth.hs view
@@ -47,8 +47,10 @@ ( registerApplication , registerAndAdvertiseApplication+ , unregisterApplication , advertise , advertisementFor+ , unadvertise , connect , runBluetoothM , runHandler
src/Bluetooth/Internal/DBus.hs view
@@ -32,13 +32,23 @@ conn <- ask addAllObjs conn app () <- toBluetoothM . const- $ callMethod bluezName bluezPath (T.pack gattManagerIFace) "RegisterApplication" args []+ $ callMethod bluezName bluezPath (T.pack gattManagerIFace)+ "RegisterApplication" args [] $ dbusConn conn- return ApplicationRegistered+ return $ ApplicationRegistered (app ^. path) where args :: (ObjectPath, Map.Map T.Text Any) args = (app ^. path, Map.empty) +unregisterApplication :: ApplicationRegistered -> BluetoothM ()+unregisterApplication (ApplicationRegistered appPath) = do+ conn <- ask+ toBluetoothM . const+ $ callMethod bluezName bluezPath (T.pack gattManagerIFace)+ "UnregisterApplication" appPath []+ $ dbusConn conn++ -- | Adds handlers for all the objects managed by the Application (plus the -- Application itself). addAllObjs :: Connection -> Application -> BluetoothM ()@@ -75,6 +85,18 @@ args :: (ObjectPath, Map.Map T.Text Any) args = (adv ^. path, Map.empty) +-- | Unregister an adverstisement.+unadvertise :: WithObjectPath Advertisement -> BluetoothM ()+unadvertise adv = do+ conn <- ask+ toBluetoothM . const $ do+ callMethod bluezName bluezPath (T.pack leAdvertisingManagerIFace) "UnregisterAdvertisement" args []+ $ dbusConn conn+ where+ args :: ObjectPath+ args = adv ^. path++ -- | Create an advertisement for all of an application's services. -- The advertisement will be for peripheral (not broadcast) by default. advertisementFor :: Application -> WithObjectPath Advertisement@@ -86,7 +108,7 @@ -- | Triggers notifications or indications. triggerNotification :: ApplicationRegistered -> CharacteristicBS -> BluetoothM ()-triggerNotification ApplicationRegistered c = do+triggerNotification (ApplicationRegistered _) c = do case c ^. readValue of Nothing -> throwError "Handler does not have a readValue implementation!" Just readHandler -> do
src/Bluetooth/Internal/Types.hs view
@@ -464,8 +464,8 @@ -- | This datatype, which is kept opaque, is returned when an application is -- successfully registered, and required as an argument from functions that -- should only be called after the application has been registered.-data ApplicationRegistered = ApplicationRegistered- deriving (Eq, Show, Read, Generic)+newtype ApplicationRegistered = ApplicationRegistered ObjectPath+ deriving (Eq, Show, Generic) data Status = Success
test/BluetoothSpec.hs view
@@ -20,7 +20,9 @@ return () #else registerApplicationSpec+ unregisterApplicationSpec advertiseSpec+ unadvertiseSpec {-notifySpec-} #endif @@ -35,6 +37,16 @@ Left err <- runBluetoothM (registerApplication testApp) conn show err `shouldContain` "Already Exists" +unregisterApplicationSpec :: Spec+unregisterApplicationSpec = describe "unregisterApplication" $ before connect $ do++ it "unregisters the service" $ \conn -> do+ Right p <- runBluetoothM (registerApplication testApp) conn+ v1 <- runBluetoothM (unregisterApplication p) conn+ v1 `shouldSatisfy` isRight+ v2 <- runBluetoothM (registerApplication testApp) conn+ v2 `shouldSatisfy` isRight+ advertiseSpec :: Spec advertiseSpec = describe "advertise" $ before connect $ do @@ -44,6 +56,7 @@ -- We verify that the advertisement was registered by checking that -- attempting to register it again throws an AlreadyExists error. Left err <- runBluetoothM (advertise ad) conn+ _ <- runBluetoothM (unadvertise ad) conn show err `shouldContain` "Already Exists" it "adverstises a set of services" $ \conn -> checkAdvert testAdv conn@@ -57,6 +70,19 @@ it "works with manufacturer data" $ \conn -> do let adv = testAdv & value . manufacturerData . at 1 ?~ "hi" checkAdvert adv conn++unadvertiseSpec :: Spec+unadvertiseSpec = describe "unadvertise" $ before connect $ do++ it "unregisters an advertisement" $ \conn -> do+ v1 <- runBluetoothM (advertise testAdv) conn+ v1 `shouldSatisfy` isRight+ Left err <- runBluetoothM (advertise testAdv) conn+ show err `shouldContain` "Already Exists"+ v2 <- runBluetoothM (unadvertise testAdv) conn+ v2 `shouldSatisfy` isRight+ v3 <- runBluetoothM (advertise testAdv) conn+ v3 `shouldSatisfy` isRight {-notifySpec :: Spec-} {-notifySpec = describe "notification" $ before connect $ do-}