packages feed

myo (empty) → 0.1.0.0

raw patch · 25 files changed

+1117/−0 lines, 25 filesdep +aesondep +basedep +containerssetup-changed

Dependencies added: aeson, base, containers, inline-c, lens-family, lens-family-th, myo, scientific, tasty, tasty-hunit, template-haskell, text, vector, websockets

Files

+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2015++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Your name here nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ cbits/wrapper.c view
@@ -0,0 +1,15 @@++#include "libmyo.h"+#include <stdio.h>++void myo_string_free(libmyo_string_t s) {+  libmyo_string_free(s);+}++void myo_error_details_free(libmyo_error_details_t t) {+ if (t != NULL) libmyo_free_error_details(t);+}++void myo_hub_free(libmyo_hub_t h) {+  if (h != NULL) libmyo_shutdown_hub(h, NULL);+}
+ examples/WS.hs view
@@ -0,0 +1,29 @@+{-# LANGUAGE ScopedTypeVariables #-}+module Main where++import qualified Data.Aeson as JSON+import Network.WebSockets+import Myo.WebSockets+import Control.Monad+import Lens.Family2++main :: IO ()+main = runClient "localhost" 10138 "/myo/3?appid=com.example.appid" myoWS++myoWS :: Connection -> IO ()+myoWS conn = forever $ do+  newData <- receiveData conn+  let (msg :: Either String MyoFrame) = JSON.eitherDecode' newData+  case msg of+    Left e   -> do+      putStrLn e+      putStrLn (show newData)+    Right (Event my) -> case my ^. mye_type of+      EVT_Paired -> putStrLn "MYO PAIRED!"+      EVT_Connected -> putStrLn "MYO CONNECTED!"+      EVT_Pose -> case my ^. mye_pose of+        Nothing -> putStrLn "GOT A POSE!"+        Just  p -> putStrLn $ "GOT POSE: " ++ show p+      EVT_Arm_Synced -> putStrLn "MYO ARM SYNCED"+      EVT_Arm_Unsynced -> putStrLn "MYO ARM UNSYNCED"+      _ -> return ()
+ myo.cabal view
@@ -0,0 +1,91 @@+name:                myo+version:             0.1.0.0+synopsis:            Haskell binding to the Myo armband+description:         Please see README.md+homepage:            http://github.com/adinapoli/myo+license:             MIT+license-file:        LICENSE+author:              Alfredo Di Napoli+maintainer:          alfredo.dinapoli@gmail.com+-- copyright:+category:            System+build-type:          Simple+-- extra-source-files:++cabal-version:       >=1.10++library+  hs-source-dirs:      src+  include-dirs:+    include+  exposed-modules:+    Myo+    Myo.WebSockets+    Myo.WebSockets.Types+    Myo.Foreign.Hub+    Myo.Foreign.Hub.Types+    Myo.Foreign.Types+    Myo.Foreign.Result+    Myo.Foreign.String+    Myo.Foreign.String.Types+    Myo.Foreign.Device+    Myo.Foreign.Locking+    Myo.Foreign.Event+    Myo.Foreign.Handler+  build-depends:+    base >= 4.7 && < 5,+    containers,+    template-haskell,+    websockets,+    aeson,+    lens-family,+    lens-family-th,+    vector,+    text,+    scientific,+    inline-c+  extra-libraries:+    stdc+++  ld-options:+    -framework myo+  other-extensions:+    TemplateHaskell+    QuasiQuotes+    OverloadedStrings+  c-sources:+    cbits/wrapper.c+    src/Myo.c+    src/Myo/Foreign/String.c+    src/Myo/Foreign/String/Types.c+    src/Myo/Foreign/Types.c+    src/Myo/Foreign/Hub.c+    src/Myo/Foreign/Hub/Types.c+  ghc-options:+    -Wall++  default-language:    Haskell2010++executable myo-ws-example+  hs-source-dirs:      examples+  main-is:             WS.hs+  build-depends:       base+                     , myo+                     , websockets+                     , aeson+                     ,lens-family+  default-language:    Haskell2010++test-suite myo-test+  type:                exitcode-stdio-1.0+  hs-source-dirs:      test+  main-is:             Tests.hs+  build-depends:       base+                     , myo+                     , tasty+                     , tasty-hunit+  ghc-options:         -threaded -rtsopts -with-rtsopts=-N+  default-language:    Haskell2010++source-repository head+  type:     git+  location: https://github.com/adinapoli/myo
+ src/Myo.c view
@@ -0,0 +1,74 @@++#include "libmyo.h"++#include <string.h>++#include "wrapper.h"++void inline_c_Myo_0_8a356f0fa910bb8b8831c109c51000723e3c4d4b(libmyo_error_details_t ed_27_inline_c_0, libmyo_result_t * resPtr_inline_c_1) {++      libmyo_result_t r = libmyo_error_kind(ed_27_inline_c_0);+      memmove(resPtr_inline_c_1+             , &r+             , sizeof(libmyo_result_t)+             );+      +}+++const char * inline_c_Myo_1_79bcd9dad570978d588a7fdfd305a8c8c5dc82db(libmyo_error_details_t ed_27_inline_c_0) {+return ( libmyo_error_cstring(ed_27_inline_c_0) );+}+++void inline_c_Myo_2_b1135c706f85aba73a458ba622c6082422b76325(libmyo_hub_t h_27_inline_c_0, libmyo_locking_policy_t * lp_27_inline_c_1, libmyo_error_details_t ed_27_inline_c_2, libmyo_result_t * resPtr_inline_c_3) {++          libmyo_result_t r = libmyo_set_locking_policy(+                                h_27_inline_c_0+                              , *lp_27_inline_c_1+                              , &ed_27_inline_c_2+                              );+          memmove(resPtr_inline_c_3+                 , &r+                 , sizeof(libmyo_result_t)+                 );+          +}+++uint64_t inline_c_Myo_3_76ef5b24d42ab668d1d8851f3f948fc2a44c31fe(libmyo_myo_t myo_inline_c_0) {+return ( libmyo_get_mac_address(myo_inline_c_0));+}+++void inline_c_Myo_4_6a9cce20aa4bf910286093a6c81fd50a27a8f95d(libmyo_myo_t d_inline_c_0, libmyo_vibration_type_t * vibPtr_inline_c_1, libmyo_error_details_t ed_inline_c_2, libmyo_result_t * resPtr_inline_c_3) {++         libmyo_result_t r = libmyo_vibrate(+                               d_inline_c_0+                             , *vibPtr_inline_c_1+                             , &ed_inline_c_2+                             );+         memmove(resPtr_inline_c_3+                , &r+                , sizeof(libmyo_result_t)+                );+         +}+++void inline_c_Myo_5_1a45ee2e6fc626f18feb7a5e33f1bd7f0ca56492(libmyo_hub_t h_27_inline_c_0, unsigned dur_inline_c_1, libmyo_handler_t hdlr_inline_c_2, void * ud_27_inline_c_3, libmyo_error_details_t ed_27_inline_c_4, libmyo_result_t * resPtr_inline_c_5) {++            libmyo_result_t r = libmyo_run(+                                  h_27_inline_c_0+                                , dur_inline_c_1+                                , hdlr_inline_c_2+                                , ud_27_inline_c_3+                                , ed_27_inline_c_4+                                );+            memmove(resPtr_inline_c_5+                   , &r+                   , sizeof(libmyo_result_t)+                   );+            +}+
+ src/Myo.hs view
@@ -0,0 +1,144 @@+{-# LANGUAGE OverloadedStrings, TemplateHaskell, QuasiQuotes, RecordWildCards #-}+module Myo (+    module Myo.Foreign.Types+  , module Myo.Foreign.Hub+  , module Myo.Foreign.String+  , errorKind+  , errorCString+  , getMacAddress+  , setLockingPolicy+  , vibrate+  , run+) where++import qualified Language.C.Inline as C++import Data.Word+import Data.Monoid+import Myo.Foreign.Types+import Myo.Foreign.String+import Myo.Foreign.Hub+import Myo.Foreign.Hub.Types+import Foreign.C.String+import Foreign.ForeignPtr+import Foreign.Storable+import Foreign.Marshal.Alloc++C.context (myoCtx <> hubCtx)+C.include "libmyo.h"+C.include "<string.h>"+C.include "wrapper.h"++-------------------------------------------------------------------------------+errorKind :: ErrorDetails -> IO Result+errorKind ed = withForeignPtr ed $ \ed' -> do+  alloca $ \resPtr -> do+    [C.block| void {+      libmyo_result_t r = libmyo_error_kind($(libmyo_error_details_t ed'));+      memmove($(libmyo_result_t* resPtr)+             , &r+             , sizeof(libmyo_result_t)+             );+      }+    |]+    peek resPtr++-------------------------------------------------------------------------------+errorCString :: ErrorDetails -> IO CString+errorCString ed = withForeignPtr ed $ \ed' -> do+ [C.exp| const char* { libmyo_error_cstring($(libmyo_error_details_t ed')) }|]++-------------------------------------------------------------------------------+--  Set the locking policy for Myos connected to the hub.+--  @returns libmyo_success if the locking policy is successfully set, otherwise+--  - libmyo_error_invalid_argument if \a hub is NULL+--  - libmyo_error if \a hub is not a valid hub+-- libmyo_result_t libmyo_set_locking_policy(libmyo_hub_t hub, libmyo_locking_policy_t locking_policy,+--                                           libmyo_error_details_t* out_error);+setLockingPolicy :: MyoHub -> LockingPolicy -> ErrorDetails -> IO Result+setLockingPolicy h lp ed = withForeignPtr h $ \h' ->+  withForeignPtr ed $ \ed' -> do+    alloca $ \lp' -> do+      poke lp' lp+      alloca $ \resPtr -> do+        [C.block| void {+          libmyo_result_t r = libmyo_set_locking_policy(+                                $(libmyo_hub_t h')+                              , *$(libmyo_locking_policy_t* lp')+                              , &$(libmyo_error_details_t ed')+                              );+          memmove($(libmyo_result_t* resPtr)+                 , &r+                 , sizeof(libmyo_result_t)+                 );+          }+        |]+        peek resPtr++-- | Retrieve the MAC address of a Myo.+-- The MAC address is unique to the physical Myo, and is a 48-bit number.+-- uint64_t libmyo_get_mac_address(libmyo_myo_t myo);+getMacAddress :: MyoDevice -> IO Word64+getMacAddress md = withForeignPtr md $ \myo -> do+  [C.exp| uint64_t { libmyo_get_mac_address($(libmyo_myo_t myo))} |]++-- | Vibrate the given myo.+-- Can be called when a Myo is paired.+-- @returns libmyo_success if the Myo successfully vibrated, otherwise+--  - libmyo_error_invalid_argument if \a myo is NULL+vibrate :: MyoDevice -> Vibration -> ErrorDetails -> IO Result+vibrate device vib eDetails = withForeignPtr device $ \d ->+  withForeignPtr eDetails $ \ed -> do+    alloca $ \resPtr -> do+     alloca $ \vibPtr -> do+       poke vibPtr vib+       [C.block| void {+         libmyo_result_t r = libmyo_vibrate(+                               $(libmyo_myo_t d)+                             , *$(libmyo_vibration_type_t* vibPtr)+                             , &$(libmyo_error_details_t ed)+                             );+         memmove($(libmyo_result_t* resPtr)+                , &r+                , sizeof(libmyo_result_t)+                );+         }+       |]+       peek resPtr++type Duration = Int++-- | Process events and call the provided callback as they occur.+-- Runs for up to approximately \a duration_ms milliseconds or until a called handler returns libmyo_handler_stop.+-- @returns libmyo_success after a successful run, otherwise+--  - libmyo_error_invalid_argument if \a hub is NULL+--  - libmyo_error_invalid_argument if \a handler is NULL+-- libmyo_result_t libmyo_run(libmyo_hub_t hub, unsigned int duration_ms, libmyo_handler_t handler, void* user_data,+--                            libmyo_error_details_t* out_error);+run :: MyoHub+    -> Duration+    -> Handler+    -> UserData+    -> ErrorDetails+    -> IO Result+run h dur_ms hdlr ud ed = do+  let dur = fromIntegral dur_ms+  withForeignPtr h $ \h' -> do+    withForeignPtr ed $ \ed' -> do+      withForeignPtr ud $ \ud' -> do+        alloca $ \resPtr -> do+          [C.block| void {+            libmyo_result_t r = libmyo_run(+                                  $(libmyo_hub_t h')+                                , $(unsigned int dur)+                                , $(libmyo_handler_t hdlr)+                                , $(void * ud')+                                , $(libmyo_error_details_t ed')+                                );+            memmove($(libmyo_result_t* resPtr)+                   , &r+                   , sizeof(libmyo_result_t)+                   );+            }+          |]+          peek resPtr
+ src/Myo/Foreign/Device.hsc view
@@ -0,0 +1,30 @@+module Myo.Foreign.Device where++import Foreign.Storable+import Foreign.Ptr+import Foreign.ForeignPtr+import Foreign.C.Types++#include "libmyo.h"++data MyoDevice_t+type MyoDevice = ForeignPtr MyoDevice_t++data Vibration =+    VibrationShort+  | VibrationMedium+  | VibrationLong++instance Storable Vibration where+	sizeOf _ = (#size libmyo_vibration_type_t)+	alignment _ = alignment (undefined :: Ptr Vibration)+	peek ptr = do+	  v <- peekByteOff ptr 0+	  return $ case (v :: CInt) of+	    0 -> VibrationShort+	    1 -> VibrationMedium+	    _ -> VibrationLong+	poke p v = case v of+	  VibrationShort  -> pokeByteOff p 0 (0 :: Int)+	  VibrationMedium -> pokeByteOff p 1 (1 :: Int)+	  VibrationLong   -> pokeByteOff p 2  (2 :: Int)
+ src/Myo/Foreign/Event.hsc view
@@ -0,0 +1,42 @@++module Myo.Foreign.Event where++import Foreign.Storable+import Foreign.Ptr+import Foreign.ForeignPtr++#include "libmyo.h"++data EventType =+      Paired           -- ^ Successfully paired with a Myo.+    | Unpaired         -- ^ Successfully unpaired from a Myo.+    | Connected        -- ^ A Myo has successfully connected.+    | Disconnected     -- ^ A Myo has been disconnected.+    | ArmSynced        -- ^ A Myo has recognized that the sync gesture has been successfully performed.+    | ArmUnsynced      -- ^ A Myo has been moved or removed from the arm.+    | Orientation      -- ^ Orientation data has been received.+    | Pose             -- ^ A change in pose has been detected. @see libmyo_pose_t.+    | Rssi             -- ^ An RSSI value has been received.+    | Unlocked         -- ^ A Myo has become unlocked.+    | Locked           -- ^ A Myo has become locked.+    | Emg              -- ^ EMG data has been received.+    | BatteryLevel     -- ^ A battery level value has been received.+    | WarmupCompleted  -- ^ The warmup period has completed.+    deriving (Show, Eq, Ord, Bounded, Enum)++instance Storable EventType where+  sizeOf _ = (#size libmyo_event_type_t)+  alignment _ = alignment (undefined :: Ptr EventType)+  peek ptr = do+    v <- peekByteOff ptr 0+    return $ toEnum v+  poke p v = let e = fromEnum v in pokeByteOff p e e++data Event_t+type Event = ForeignPtr Event_t++instance Storable Event_t where+  sizeOf _ = (#size libmyo_event_t)+  alignment _ = alignment (undefined :: Ptr Event_t)+  peek _   = error "Event_t.peek: Absurd"+  poke _ _ = error "Event_t.poke: Absurd"
+ src/Myo/Foreign/Handler.hsc view
@@ -0,0 +1,27 @@+module Myo.Foreign.Handler where++import Foreign.Storable+import Foreign.Ptr+import Foreign.ForeignPtr++import Myo.Foreign.Event++#include "libmyo.h"++data HandlerResult =+      Continue     -- ^ Continue processing events+    | Stop         -- ^ Stop processing events+    deriving (Show, Eq, Ord, Bounded, Enum)++instance Storable HandlerResult where+  sizeOf _ = (#size libmyo_handler_result_t)+  alignment _ = alignment (undefined :: Ptr HandlerResult)+  peek ptr = do+    v <- peekByteOff ptr 0+    return $ toEnum v+  poke p v = let e = fromEnum v in pokeByteOff p e e+++type Handler = FunPtr (UserData -> Event -> HandlerResult)++type UserData = ForeignPtr ()
+ src/Myo/Foreign/Hub.c view
@@ -0,0 +1,14 @@++#include "libmyo.h"++#include <string.h>++void inline_c_Myo_Foreign_Hub_0_6d0ace92dadbe060f2a38f3d76d724cdf8afc520(libmyo_hub_t h_27_inline_c_0, const char * aid_inline_c_1, libmyo_error_details_t e_27_inline_c_2, libmyo_result_t * resPtr_inline_c_3) {++             libmyo_result_t r = libmyo_init_hub( &h_27_inline_c_0+                                   , aid_inline_c_1+                                   , &e_27_inline_c_2);+             memmove(resPtr_inline_c_3 ,&r, sizeof(libmyo_result_t));+            +}+
+ src/Myo/Foreign/Hub.hsc view
@@ -0,0 +1,74 @@+{-# LANGUAGE OverloadedStrings, TemplateHaskell, QuasiQuotes, RecordWildCards #-}+module Myo.Foreign.Hub (+  -- * Low level functions+    initHub+  , freeHub+  , freeErrorDetails+  -- * High level functions+  , newHub+  ) where++import qualified Language.C.Inline as C+import           Data.Monoid+import           Foreign.ForeignPtr+import           Foreign.Ptr+import           Foreign.C.String+import           Foreign.Storable+import           Foreign.Marshal.Alloc++import           Myo.Foreign.Types+import           Myo.Foreign.Hub.Types++C.context (myoCtx <> hubCtx)+C.include "libmyo.h"+C.include "<string.h>"++{-+Initialize a connection to the hub.+\a application_identifier must follow a reverse domain name format (ex. com.domainname.appname). Application+identifiers can be formed from the set of alphanumeric ASCII characters (a-z, A-Z, 0-9). The hyphen (-) and+underscore (_) characters are permitted if they are not adjacent to a period (.) character (i.e. not at the start or+end of each segment), but are not permitted in the top-level domain. Application identifiers must have three or more+segments. For example, if a company's domain is example.com and the application is named hello-world, one could use+"com.example.hello-world" as a valid application identifier. \a application_identifier can be NULL or empty.+@returns libmyo_success if the connection is successfully established, otherwise:+ - libmyo_error_runtime if a connection could not be established+ - libmyo_error_invalid_argument if \a out_hub is NULL+ - libmyo_error_invalid_argument if \a application_identifier is longer than 255 characters+ - libmyo_error_invalid_argument if \a application_identifier is not in the proper reverse domain name format+-}++initHub :: MyoHub -> ApplicationID -> ErrorDetails -> IO Result+initHub h aid e = withForeignPtr h $ \h' ->+  withForeignPtr e $ \e' -> do+    alloca $ \resPtr -> do+     [C.block| void {+             libmyo_result_t r = libmyo_init_hub( &$(libmyo_hub_t h')+                                   , $(const char* aid)+                                   , &$(libmyo_error_details_t e'));+             memmove($(libmyo_result_t* resPtr) ,&r, sizeof(libmyo_result_t));+            }+     |]+     peek resPtr++-------------------------------------------------------------------------------+-- | Free the resources allocated by the ErrorDetails object.+foreign import ccall "wrapper.h &myo_error_details_free"+  freeErrorDetails :: FunPtr (Ptr ErrorDetails_t -> IO ())++-------------------------------------------------------------------------------+-- | Free the resources allocated by the ErrorDetails object.+foreign import ccall "wrapper.h &myo_hub_free"+  freeHub :: FunPtr (Ptr Hub_t -> IO ())++-------------------------------------------------------------------------------+-- | High-level function to create a new Hub.+newHub :: String -> IO (Either ErrorReport MyoHub)+newHub aid = do+  hub <- malloc >>= newForeignPtr_ -- freeHub+  eDetails <- malloc >>= newForeignPtr_ --freeErrorDetails+  aId <- newCString aid+  r <- initHub hub aId eDetails+  case r of+    Success -> return $ Right hub+    _ -> return $ Left (ErrorReport r eDetails)
+ src/Myo/Foreign/Hub/Types.c view
@@ -0,0 +1,4 @@++#include "libmyo.h"++#include <string.h>
+ src/Myo/Foreign/Hub/Types.hsc view
@@ -0,0 +1,33 @@+{-# LANGUAGE OverloadedStrings, TemplateHaskell, QuasiQuotes, RecordWildCards #-}+module Myo.Foreign.Hub.Types where++import qualified Language.C.Inline as C+import           Language.C.Inline.Context+import qualified Language.Haskell.TH as TH+import qualified Language.C.Types as C+import qualified Data.Map.Strict as Map+import           Data.Monoid+import           Foreign.ForeignPtr+import           Foreign.Ptr+import           Foreign.Storable++#include "libmyo.h"+C.include "libmyo.h"+C.include "<string.h>"++data Hub_t+type MyoHub = ForeignPtr Hub_t++instance Storable Hub_t where+  sizeOf _ = (#size libmyo_hub_t)+  alignment _ = alignment (undefined :: Ptr Hub_t)+  peek _   = error "Hub_t.peek: Absurd"+  poke _ _ = error "Hub_t.poke: Absurd"++hubCtx :: Context+hubCtx = mempty { ctxTypesTable = hubTable }++hubTable :: Map.Map C.TypeSpecifier TH.TypeQ+hubTable = Map.fromList+   [ (C.TypeName "libmyo_hub_t", [t| Ptr Hub_t |])+   ]
+ src/Myo/Foreign/Locking.hsc view
@@ -0,0 +1,17 @@+module Myo.Foreign.Locking where++import Foreign.Ptr+import Foreign.Storable++#include "libmyo.h"++data LockingPolicy = None | Standard+  deriving (Show, Eq, Ord, Bounded, Enum)++instance Storable LockingPolicy where+  sizeOf _ = (#size libmyo_locking_policy_t)+  alignment _ = alignment (undefined :: Ptr LockingPolicy)+  peek ptr = do+    v <- peekByteOff ptr 0+    return $ toEnum v+  poke p v = let e = fromEnum v in pokeByteOff p e e
+ src/Myo/Foreign/Result.hsc view
@@ -0,0 +1,35 @@+module Myo.Foreign.Result where++import Foreign.Ptr+import Foreign.ForeignPtr+import Foreign.Storable++#include "libmyo.h"++data Result =+    Success+  | Error+  | InvalidArgument+  | RuntimeError+  deriving (Show, Eq, Ord, Bounded, Enum)++data ErrorReport =+  ErrorReport Result ErrorDetails+  deriving (Show, Eq, Ord)++data ErrorDetails_t+type ErrorDetails = ForeignPtr ErrorDetails_t++instance Storable ErrorDetails_t where+  sizeOf _ = (#size libmyo_error_details_t)+  alignment _ = alignment (undefined :: Ptr ErrorDetails)+  peek _   = error "ErrorDetails_t.peek: Absurd"+  poke _ _ = error "ErrorDetails_t.poke: Absurd"++instance Storable Result where+  sizeOf _ = (#size libmyo_result_t)+  alignment _ = alignment (undefined :: Ptr Result)+  peek ptr = do+    v <- peekByteOff ptr 0+    return $ toEnum v+  poke p v = let e = fromEnum v in pokeByteOff p e e
+ src/Myo/Foreign/String.c view
@@ -0,0 +1,21 @@++#include "libmyo.h"++#include "wrapper.h"++const char * inline_c_Myo_Foreign_String_0_817cf39fc030b767c64bf15739f8ce47d8341d52(libmyo_string_t ms_inline_c_0) {+return ( libmyo_string_c_str(ms_inline_c_0) );+}+++libmyo_string_t inline_c_Myo_Foreign_String_1_322eef913ad66043ba6f6f6786116e88e2976984(uint64_t i_inline_c_0) {+return (+    libmyo_mac_address_to_string(i_inline_c_0)+    );+}+++uint64_t inline_c_Myo_Foreign_String_2_509e55339657b08ea171a116a2858442cc7a7b25(const char * sPtr_inline_c_0) {+return ( libmyo_string_to_mac_address(sPtr_inline_c_0) );+}+
+ src/Myo/Foreign/String.hs view
@@ -0,0 +1,40 @@+{-# LANGUAGE OverloadedStrings, TemplateHaskell, QuasiQuotes, RecordWildCards #-}+{-# LANGUAGE ScopedTypeVariables #-}+module Myo.Foreign.String where++import qualified Language.C.Inline as C++import Myo.Foreign.String.Types+import Myo.Foreign.Types+import Foreign.C.String+import Foreign.ForeignPtr+import Foreign.Ptr+import Data.Word+import Data.Monoid++C.context (myoCtx <> stringCtx)+C.include "libmyo.h"+C.include "wrapper.h"++-------------------------------------------------------------------------------+fromMyoString :: MyoString -> IO CString+fromMyoString sPtr = withForeignPtr sPtr $ \ms -> do+  [C.exp| const char* { libmyo_string_c_str($(libmyo_string_t ms)) } |]++-------------------------------------------------------------------------------+macAddressToString :: Word64 -> IO MyoString+macAddressToString i = do+  newStr <- [C.exp| libmyo_string_t {+    libmyo_mac_address_to_string($(uint64_t i))+    }+  |]+  newForeignPtr freeMyoString newStr++-------------------------------------------------------------------------------+stringToMacAddress :: CString -> Word64+stringToMacAddress sPtr = [C.pure| uint64_t { libmyo_string_to_mac_address($(const char* sPtr)) } |]++-------------------------------------------------------------------------------+-- | Free the resources allocated by the string object.+foreign import ccall "wrapper.h &myo_string_free"+  freeMyoString :: FunPtr (Ptr MyoString_t -> IO ())
+ src/Myo/Foreign/String/Types.c view
@@ -0,0 +1,2 @@++#include "libmyo.h"
+ src/Myo/Foreign/String/Types.hsc view
@@ -0,0 +1,37 @@+{-# LANGUAGE OverloadedStrings, TemplateHaskell, QuasiQuotes, RecordWildCards #-}+module Myo.Foreign.String.Types (+    MyoString_t+  , MyoString+  , stringCtx+  ) where++import Data.Monoid++import           Language.C.Inline.Context+import qualified Language.Haskell.TH as TH+import qualified Language.C.Types as C+import qualified Language.C.Inline as C+import qualified Data.Map.Strict as Map++import           Foreign.ForeignPtr+import           Foreign.Ptr+import           Foreign.Storable++#include "libmyo.h"+C.include "libmyo.h"++data MyoString_t+type MyoString = ForeignPtr MyoString_t++instance Storable MyoString_t where+  sizeOf _ = (#size libmyo_string_t)+  alignment _ = alignment (undefined :: Ptr MyoString)+  peek _   = error "MyoString_t.peek: Absurd"+  poke _ _ = error "MyoString_t.poke: Absurd"++stringCtx :: Context+stringCtx = mempty { ctxTypesTable = typesTable }++typesTable :: Map.Map C.TypeSpecifier TH.TypeQ+typesTable = Map.fromList+   [ (C.TypeName "libmyo_string_t", [t| Ptr MyoString_t |]) ]
+ src/Myo/Foreign/Types.c view
@@ -0,0 +1,2 @@++#include "libmyo.h"
+ src/Myo/Foreign/Types.hsc view
@@ -0,0 +1,47 @@+{-# LANGUAGE OverloadedStrings, TemplateHaskell, QuasiQuotes, RecordWildCards #-}+module Myo.Foreign.Types (+    module Myo.Foreign.Device+  , module Myo.Foreign.Result+  , module Myo.Foreign.Locking+  , module Myo.Foreign.Event+  , module Myo.Foreign.Handler+  , myoCtx+  , ApplicationID+  ) where++import Data.Monoid++import           Language.C.Inline.Context+import qualified Language.Haskell.TH as TH+import qualified Language.C.Types as C+import qualified Language.C.Inline as C+import qualified Data.Map.Strict as Map++import           Foreign.Ptr+import           Foreign.C.String+import           Myo.Foreign.Device+import           Myo.Foreign.Result+import           Myo.Foreign.Locking+import           Myo.Foreign.Event+import           Myo.Foreign.Handler++#include "libmyo.h"+C.include "libmyo.h"++type ApplicationID = CString++myoCtx :: Context+myoCtx = baseCtx <> funCtx <> vecCtx <> mempty { ctxTypesTable = typesTable }++typesTable :: Map.Map C.TypeSpecifier TH.TypeQ+typesTable = Map.fromList+   [ (C.TypeName "libmyo_vibration_type_t", [t| Vibration |])+   , (C.TypeName "libmyo_result_t", [t| Result |])+   , (C.TypeName "libmyo_error_details_t", [t| Ptr ErrorDetails_t |])+   , (C.TypeName "libmyo_myo_t", [t| Ptr MyoDevice_t |])+   , (C.TypeName "libmyo_locking_policy_t", [t| LockingPolicy |])+   , (C.TypeName "libmyo_event_type_t", [t| EventType |])+   , (C.TypeName "libmyo_event_t", [t| Ptr Event_t |])+   , (C.TypeName "libmyo_handler_result_t", [t| HandlerResult |])+   , (C.TypeName "libmyo_handler_t", [t| Handler |])+   ]
+ src/Myo/WebSockets.hs view
@@ -0,0 +1,32 @@+{-# LANGUAGE OverloadedStrings #-}+module Myo.WebSockets (+    module Myo.WebSockets.Types+  , ApplicationID+  , APIVersion(..)+  , renderAPIVersion+  ) where++--import Network.WebSockets+import Myo.WebSockets.Types+import qualified Data.Text as T++data APIVersion = V3++type ApplicationID = T.Text++renderAPIVersion :: APIVersion -> T.Text+renderAPIVersion V3 = "3"++{-+connect :: APIVersion+        -> ApplicationID+        -- ^ The Myo ApplicationID+        -> String+        -- ^ Host+        -> Int+        -- ^ Port+        -> IO a+connect apiVr aId host port = do+ runClient host port (T.unpack $ "/myo/" <> renderAPIVersion <> "?appid=" <> aId)+ 127.0.0.1:10138/myo/?appid=com.example.appid+-}
+ src/Myo/WebSockets/Types.hs view
@@ -0,0 +1,192 @@+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}+{-# OPTIONS_GHC -fno-warn-type-defaults #-}+module Myo.WebSockets.Types where++import Data.Aeson.TH+import Data.Int+import Data.Scientific+import Data.Aeson.Types+import Data.Char+import Control.Monad+import Control.Applicative+import Lens.Family2.TH+import qualified Data.Vector as V+import qualified Data.Text as T++-------------------------------------------------------------------------------+data MyoEventType =+    EVT_Paired+  | EVT_Battery_Level+  | EVT_Locked+  | EVT_Unlocked+  | EVT_Warmup_Completed+  | EVT_Connected+  | EVT_Disconnected+  | EVT_Arm_Synced+  | EVT_Arm_Unsynced+  | EVT_Orientation+  | EVT_Pose+  | EVT_RSSI+  | EVT_EMG+  deriving (Show, Eq)++-------------------------------------------------------------------------------+type MyoID = Integer++-------------------------------------------------------------------------------+data MyoVersion = MyoVersion {+    _myv_major    :: !Integer+  , _myv_minor    :: !Integer+  , _myv_patch    :: !Integer+  , _myv_hardware :: !Integer+  } deriving (Show, Eq)++-------------------------------------------------------------------------------+-- It's an 8 bit integer+data EMG  = EMG Int8 deriving (Show, Eq)++-------------------------------------------------------------------------------+data MyoPose =+     Rest+   | Fist+   | Wave_In+   | Wave_Out+   | Fingers_Spread+   | Double_Tap+   | Unknown+   deriving (Show, Eq)++data Orientation = Orientation {+     _ori_x :: !Double+   , _ori_y :: !Double+   , _ori_z :: !Double+   , _ori_w :: !Double+   } deriving (Show, Eq)++data Accelerometer = Accelerometer {+     _acc_x :: !Double+   , _acc_y :: !Double+   , _acc_z :: !Double+   } deriving (Show, Eq)++data Gyroscope = Gyroscope {+     _gyr_x :: !Double+   , _gyr_y :: !Double+   , _gyr_z :: !Double+   } deriving (Show, Eq)++-------------------------------------------------------------------------------+data MyoArm = Arm_Left | Arm_Right deriving (Show, Eq)++-------------------------------------------------------------------------------+data MyoDirection = Toward_wrist | Toward_elbow deriving (Show, Eq)++-------------------------------------------------------------------------------+data MyoFrame = Event MyoEvent+              | Command MyoCommand+              deriving (Show, Eq)++instance FromJSON MyoFrame where+ parseJSON (Array v) = case V.toList v of+   [String "event", o@(Object _)] -> Event <$> parseJSON o+   [String "command", o@(Object _)] -> Command <$> parseJSON o+   _ -> mzero+ parseJSON v = typeMismatch "MyoFrame: Expecting an Array of frames." v++-------------------------------------------------------------------------------+data MyoEvent = MyoEvent {+    _mye_type :: !MyoEventType+  , _mye_timestamp :: !T.Text+  , _mye_myo :: !MyoID+  , _mye_arm :: !(Maybe MyoArm)+  , _mye_x_direction :: !(Maybe MyoDirection)+  , _mye_version :: !(Maybe MyoVersion)+  , _mye_warmup_result :: !(Maybe MyoResult)+  , _mye_rssi :: !(Maybe Int)+  , _mye_pose :: !(Maybe MyoPose)+  , _mye_emg :: !(Maybe EMG)+  , _mye_orientation :: !(Maybe Orientation)+  , _mye_accelerometer :: !(Maybe Accelerometer)+  , _mye_gyroscope :: !(Maybe Gyroscope)+  } deriving (Show, Eq)+++data MyoResult = Success | Fail deriving (Show, Eq)++data MyoCommandType =+    COM_vibrate+  | COM_request_rssi+  | COM_set_stream_emg+  | COM_set_locking_policy+  | COM_unlock+  | COM_lock+  | COM_notify_user_action+  deriving (Show, Eq)++-------------------------------------------------------------------------------+data MyoCommand = MyoCommand {+    _myc_command :: !MyoCommandType+  , _myc_timestamp :: !T.Text+  , _myc_myo :: !MyoID+  , _myc_type :: !T.Text -- Use an ADT+  } deriving (Show, Eq)++-------------------------------------------------------------------------------+instance FromJSON MyoVersion where+ parseJSON (Array v) = do+  let lst = V.toList v+  case liftM2 (,) (Just $ length lst) (mapM toNumber lst) of+   Just (4, x) -> case mapM floatingOrInteger x of+      Right [ma, mi, pa, ha] -> return $ MyoVersion ma mi pa ha+      _ -> mzero+   _ -> mzero+ parseJSON v = typeMismatch "MyoVersion: Expecting an Array like [major, minor, patch, hardware]" v+++toNumber :: Value -> Maybe Scientific+toNumber (Number v) = Just v+toNumber _ = Nothing++-- TODO: Create an Int8 in a better way than this one!+instance FromJSON EMG where+ parseJSON (Array v) = do+  let lst = V.toList v+  case liftM2 (,) (Just $ length lst) (mapM toNumber lst) of+   Just (8, x) -> case mapM floatingOrInteger x of+      Right res -> return . EMG . read $ concatMap show res+      _ -> mzero+   _ -> mzero+ parseJSON v = typeMismatch "EMG: Expecting an Array of size 8." v++instance FromJSON Gyroscope where+ parseJSON (Array v) = case V.toList v of+   [Number x, Number y, Number z] -> return $ Gyroscope (toRealFloat x) (toRealFloat y) (toRealFloat z)+   _ -> mzero+ parseJSON v = typeMismatch "Gyroscope: Expecting an Array of Double like [x,y,z]" v++instance FromJSON Accelerometer where+ parseJSON (Array v) = case V.toList v of+   [Number x, Number y, Number z] -> return $ Accelerometer (toRealFloat x) (toRealFloat y) (toRealFloat z)+   _ -> mzero+ parseJSON v = typeMismatch "Accelerometer: Expecting an Array of Double like [x,y,z]" v++-------------------------------------------------------------------------------+-- JSON+deriveFromJSON defaultOptions { fieldLabelModifier = drop 5 } ''MyoEvent+deriveFromJSON defaultOptions { fieldLabelModifier = drop 5 } ''MyoCommand+deriveFromJSON defaultOptions { constructorTagModifier = map toLower . drop 4 } ''MyoCommandType+deriveFromJSON defaultOptions { constructorTagModifier = map toLower . drop 4 } ''MyoResult+deriveFromJSON defaultOptions { fieldLabelModifier = drop 5 } ''Orientation+deriveFromJSON defaultOptions { constructorTagModifier = map toLower . drop 4 } ''MyoEventType+deriveFromJSON defaultOptions { constructorTagModifier = map toLower } ''MyoPose+deriveFromJSON defaultOptions { constructorTagModifier = map toLower } ''MyoDirection+deriveFromJSON defaultOptions { constructorTagModifier = map toLower . drop 4 } ''MyoArm++-------------------------------------------------------------------------------+-- Lenses+makeLenses ''MyoEvent+makeLenses ''MyoCommand+makeLenses ''MyoVersion
+ test/Tests.hs view
@@ -0,0 +1,83 @@+{-# OPTIONS_GHC -fno-warn-unused-imports #-}+{-# OPTIONS_GHC -fno-warn-unused-binds #-}+module Main where++import Test.Tasty+import Test.Tasty.HUnit++import Myo+import Myo.Foreign.Types++import Control.Monad+import Foreign.C.String+import Foreign.Ptr+import Foreign.Storable+import Foreign.ForeignPtr+import Data.Either+import Foreign.Marshal.Alloc++main = defaultMain tests++tests :: TestTree+tests = testGroup "Myo Tests" [unitTests]++unitTests = testGroup "Unit tests"+  [ testCase "stringToMacAddress" testStringToMacAddress+  , testCase "MAC roundtrip" testMACRoundtrip+  , testGroup "Hub tests" [+      testCase "initHub succeeds" testInitHub+    , testCase "initHub correctly fails for wrong app id" testInitHubWrongAppId+    , testCase "newHub succeeds" testNewHub+    ]+  , testGroup "Myo-specific tests" [+      testCase "run succeeds" testRunMyo+    ]+  ]++testStringToMacAddress :: Assertion+testStringToMacAddress = do+  input <- newCString "0A-00-00-00-00-00"+  let res = stringToMacAddress input+  assertBool (show res) (res `compare` 10 == EQ)++testMACRoundtrip :: Assertion+testMACRoundtrip = do+  let mac = "0a-00-00-00-00-00"+  input <- newCString mac+  let res = stringToMacAddress input+  mString <- macAddressToString res+  ms <- fromMyoString mString+  expected <- peekCString ms+  assertBool (show expected) (expected `compare` mac == EQ)++testHubFinalise :: Assertion+testHubFinalise = do+ hub <- malloc >>= newForeignPtr freeHub+ aId <- newCString "com.example.hello-world"+ eDetails <- mallocForeignPtr+ _ <- initHub hub aId eDetails+ return ()++testInitHub :: Assertion+testInitHub = do+ hub <- mallocForeignPtr+ eDetails <- mallocForeignPtr+ aId <- newCString "com.example.hello-world"+ r <- initHub hub aId eDetails+ assertBool (show r) (r == Success)++testInitHubWrongAppId :: Assertion+testInitHubWrongAppId = do+ hub <- mallocForeignPtr+ eDetails <- mallocForeignPtr+ aId <- newCString "eoueoue"+ r <- initHub hub aId eDetails+ assertBool (show r) (r == InvalidArgument)++testNewHub :: Assertion+testNewHub = do+ res <- newHub "com.example.hello-world"+ assertBool (show res) (isRight res)++testRunMyo :: Assertion+testRunMyo = return ()