ble 0.1.3.0 → 0.2.0.0

raw patch · 9 files changed

+37/−74 lines, 9 files

Files

• ble.cabal +1/−1
• examples/Counter.hs +2/−2
• package.yaml +1/−1
• src/Bluetooth.hs +8/−12
• src/Bluetooth/Internal/Errors.hs +18/−51
• src/Bluetooth/Internal/HasInterface.hs +1/−1
• src/Bluetooth/Internal/Serialize.hs +3/−3
• src/Bluetooth/Internal/Types.hs +2/−2
• test/BluetoothSpec.hs +1/−1

@@ -3,7 +3,7 @@ -- see: https://github.com/sol/hpack  name:           ble-version:        0.1.3.0+version:        0.2.0.0 synopsis:       Bluetooth Low Energy (BLE) peripherals description:    This package provides a Haskell API for writing Bluetooth Low Energy peripherals. stability:      alpha

@@ -36,13 +36,13 @@       & writeValue ?~ encodeWrite writeV       & properties .~ [CPRead, CPWrite]   where-    readV :: ReadValueM Int+    readV :: Handler Int     readV = liftIO $ do       v <- atomically $ modifyTVar' ref succ >> readTVar ref       putStrLn $ "Value requested. New value: " ++ show v       return v -    writeV :: Int -> WriteValueM Bool+    writeV :: Int -> Handler Bool     writeV i = liftIO $ do       v <- atomically $ swapTVar ref i       putStrLn $ "Value changed to: " ++ show i

@@ -1,5 +1,5 @@ name:                ble-version:             0.1.3.0+version:             0.2.0.0 synopsis:            Bluetooth Low Energy (BLE) peripherals description:         >     This package provides a Haskell API for writing Bluetooth Low Energy

@@ -94,20 +94,16 @@   , encodeWrite    -- * Handler-  -- | @Handler err@ is a monad that allows the errors in the type-level list-  -- @err@.+  -- | @Handler@ is the monad BLE handlers run in.   , Handler-  , ReadValueM-  , WriteValueM -  -- ** Handler error classes-  , ThrowsFailed(..)-  , ThrowsInProgress(..)-  , ThrowsNotPermitted(..)-  , ThrowsNotAuthorized(..)-  , ThrowsNotSupported(..)-  , ThrowsInvalidValueLength(..)-  , IsElem+  -- ** Handler errors+  , errorFailed+  , errorInProgress+  , errorNotPermitted+  , errorNotSupported+  , errorNotAuthorized+  , errorInvalidValueLength    -- * Re-exports   , module Lens.Micro

@@ -9,62 +9,29 @@  import           Control.Monad.Except import qualified Data.Text            as T-import           GHC.Exts             (Constraint)---- All of this would be less verbose with overloaded labels, but then we--- couldn't supported GHC < 8.--type ReadValueM a = Handler '[ ThrowsFailed-                            , ThrowsInProgress-                            , ThrowsNotPermitted-                            , ThrowsNotAuthorized-                            , ThrowsNotSupported-                            ] a--type WriteValueM a = Handler '[ ThrowsFailed-                             , ThrowsInProgress-                             , ThrowsNotPermitted-                             , ThrowsInvalidValueLength-                             , ThrowsNotAuthorized-                             , ThrowsNotSupported-                             ] a+import           GHC.Generics         (Generic) -newtype Handler (errs :: [(* -> *) -> Constraint]) a+newtype Handler a   = Handler { getReadValue :: ExceptT T.Text IO a }-  -- NOT MonadError!-  deriving (Functor, Applicative, Monad, MonadIO)---- | Asserts that an error type is an element of a list.------ > example :: ThrowsFailed `IsElem` errs => Handler errs ()--- > example--- >  = errFailed "Every attempt is a wholly new start, and a different kind of failure"------ @since 0.1.2.0-type family IsElem (x :: k) (list :: [k]) :: Constraint where-  IsElem x (x ': xs) = ()-  IsElem x (y ': xs) = IsElem x xs+  deriving (Functor, Applicative, Monad, MonadIO, Generic, MonadError T.Text) -class ThrowsFailed m where errFailed :: m a-instance (ThrowsFailed `IsElem` errs) => ThrowsFailed (Handler errs) where-  errFailed = Handler $ throwError "org.bluez.Error.Failed"+-- | Generic failure+errorFailed :: Handler a+errorFailed = throwError "org.bluez.Error.Failed" -class ThrowsInProgress m where errInProgress :: m a-instance (ThrowsInProgress `IsElem` errs) => ThrowsInProgress (Handler errs) where-  errInProgress = Handler $ throwError "org.bluez.Error.InProgress"+errorInProgress :: Handler a+errorInProgress = throwError "org.bluez.Error.InProgress" -class ThrowsNotPermitted m where errNotPermitted :: m a-instance (ThrowsNotPermitted `IsElem` errs) => ThrowsNotPermitted (Handler errs) where-  errNotPermitted = Handler $ throwError "org.bluez.Error.NotPermitted"+errorNotPermitted  :: Handler a+errorNotPermitted = throwError "org.bluez.Error.NotPermitted" -class ThrowsNotAuthorized m where errNotAuthorized :: m a-instance (ThrowsNotAuthorized `IsElem` errs) => ThrowsNotAuthorized (Handler errs) where-  errNotAuthorized = Handler $ throwError "org.bluez.Error.NotAuthorized"+errorNotAuthorized :: Handler a+errorNotAuthorized = throwError "org.bluez.Error.NotAuthorized" -class ThrowsNotSupported m where errNotSupported :: m a-instance (ThrowsNotSupported `IsElem` errs) => ThrowsNotSupported (Handler errs) where-  errNotSupported = Handler $ throwError "org.bluez.Error.NotSupported"+errorNotSupported :: Handler a+errorNotSupported = throwError "org.bluez.Error.NotSupported" -class ThrowsInvalidValueLength m where errInvalidValueLength :: m a-instance (ThrowsInvalidValueLength `IsElem` errs) => ThrowsInvalidValueLength (Handler errs) where-  errInvalidValueLength = Handler $ throwError "org.bluez.Error.InvalidValueLength"+-- | Indicates that the argument has invalid length. Should not be used from+-- a read handler+errorInvalidValueLength :: Handler a+errorInvalidValueLength = throwError "org.bluez.Error.InvalidValueLength"

@@ -175,7 +175,7 @@   Nothing -> handler   Just v -> BS.drop (fromInteger $ toInteger v) <$> handler -handlerToMethodHandler :: Handler errs a -> MethodHandlerT IO a+handlerToMethodHandler :: Handler a -> MethodHandlerT IO a handlerToMethodHandler (Handler h) = MHT $ mapExceptT go h   where     go :: IO (Either T.Text a) -> WriterT [SomeSignal] IO (Either MsgError a)

@@ -6,11 +6,11 @@  import Bluetooth.Internal.Errors -encodeRead :: S.Serialize a => ReadValueM a -> ReadValueM BS.ByteString+encodeRead :: S.Serialize a => Handler a -> Handler BS.ByteString encodeRead h = S.encode <$> h  encodeWrite :: (S.Serialize a)-  => (a -> WriteValueM Bool) -> (BS.ByteString -> WriteValueM Bool)+  => (a -> Handler Bool) -> (BS.ByteString -> Handler Bool) encodeWrite h v = case S.decode v of-  Left _   -> errFailed+  Left _   -> errorFailed   Right v' -> h v'

@@ -206,10 +206,10 @@ data Characteristic typ = Characteristic   { characteristicUuid       :: UUID   , characteristicProperties :: [CharacteristicProperty]-  , characteristicReadValue  :: Maybe (ReadValueM typ)+  , characteristicReadValue  :: Maybe (Handler typ)   -- | Write a value. Note that the value is only writeable externally if the   -- characteristic contains the CPWrite property *and* this is a Just.-  , characteristicWriteValue :: Maybe (typ -> WriteValueM Bool)+  , characteristicWriteValue :: Maybe (typ -> Handler Bool)   -- | If @Nothing@, this characteristic does not send notifications.   -- If @Just False@, the characteristic does not currently send notifications, but   -- can be made to (with a @StartNotify@ method request).

@@ -76,7 +76,7 @@       & readValue ?~ encodeRead go       & properties .~ [CPRead]   where-    go :: ReadValueM BS.ByteString+    go :: Handler BS.ByteString     go = do       liftIO $ putStrLn "Reading characteristic!"       return "s"