-------------------------------------------------------------------------------
-- |
-- Module      :  System.Hardware.Arduino.Protocol
-- Copyright   :  (c) Levent Erkok
-- License     :  BSD3
-- Maintainer  :  erkokl@gmail.com
-- Stability   :  experimental
--
-- Internal representation of the firmata protocol.
-------------------------------------------------------------------------------

{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}

module System.Hardware.Arduino.Protocol(package, unpackageSysEx, unpackageNonSysEx) where

import Data.Word (Word8)

import qualified Data.ByteString as B
import qualified Data.Map        as M

import System.Hardware.Arduino.Data
import System.Hardware.Arduino.Utils

-- | Wrap a sys-ex message to be sent to the board
sysEx :: SysExCmd -> [Word8] -> B.ByteString
sysEx :: SysExCmd -> [Word8] -> ByteString
sysEx SysExCmd
cmd [Word8]
bs = [Word8] -> ByteString
B.pack forall a b. (a -> b) -> a -> b
$  FirmataCmd -> Word8
firmataCmdVal FirmataCmd
START_SYSEX
                      forall a. a -> [a] -> [a]
:  SysExCmd -> Word8
sysExCmdVal SysExCmd
cmd
                      forall a. a -> [a] -> [a]
:  [Word8]
bs
                      forall a. [a] -> [a] -> [a]
++ [FirmataCmd -> Word8
firmataCmdVal FirmataCmd
END_SYSEX]

-- | Construct a non sys-ex message
nonSysEx :: FirmataCmd -> [Word8] -> B.ByteString
nonSysEx :: FirmataCmd -> [Word8] -> ByteString
nonSysEx FirmataCmd
cmd [Word8]
bs = [Word8] -> ByteString
B.pack forall a b. (a -> b) -> a -> b
$ FirmataCmd -> Word8
firmataCmdVal FirmataCmd
cmd forall a. a -> [a] -> [a]
: [Word8]
bs

-- | Package a request as a sequence of bytes to be sent to the board
-- using the Firmata protocol.
package :: Request -> B.ByteString
package :: Request -> ByteString
package Request
SystemReset              = FirmataCmd -> [Word8] -> ByteString
nonSysEx FirmataCmd
SYSTEM_RESET            []
package Request
QueryFirmware            = SysExCmd -> [Word8] -> ByteString
sysEx    SysExCmd
REPORT_FIRMWARE         []
package Request
CapabilityQuery          = SysExCmd -> [Word8] -> ByteString
sysEx    SysExCmd
CAPABILITY_QUERY        []
package Request
AnalogMappingQuery       = SysExCmd -> [Word8] -> ByteString
sysEx    SysExCmd
ANALOG_MAPPING_QUERY    []
package (AnalogReport  IPin
p Bool
b)      = FirmataCmd -> [Word8] -> ByteString
nonSysEx (IPin -> FirmataCmd
REPORT_ANALOG_PIN IPin
p)   [if Bool
b then Word8
1 else Word8
0]
package (DigitalReport Port
p Bool
b)      = FirmataCmd -> [Word8] -> ByteString
nonSysEx (Port -> FirmataCmd
REPORT_DIGITAL_PORT Port
p) [if Bool
b then Word8
1 else Word8
0]
package (SetPinMode IPin
p PinMode
m)         = FirmataCmd -> [Word8] -> ByteString
nonSysEx FirmataCmd
SET_PIN_MODE            [forall a b. (Integral a, Num b) => a -> b
fromIntegral (IPin -> Word8
pinNo IPin
p), forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Enum a => a -> Int
fromEnum PinMode
m)]
package (DigitalPortWrite Port
p Word8
l Word8
m) = FirmataCmd -> [Word8] -> ByteString
nonSysEx (Port -> FirmataCmd
DIGITAL_MESSAGE Port
p)     [Word8
l, Word8
m]
package (AnalogPinWrite IPin
p Word8
l Word8
m)   = FirmataCmd -> [Word8] -> ByteString
nonSysEx (IPin -> FirmataCmd
ANALOG_MESSAGE IPin
p)      [Word8
l, Word8
m]
package (SamplingInterval Word8
l Word8
m)   = SysExCmd -> [Word8] -> ByteString
sysEx    SysExCmd
SAMPLING_INTERVAL       [Word8
l, Word8
m]
package (Pulse IPin
p Bool
b Word32
dur Word32
to)       = SysExCmd -> [Word8] -> ByteString
sysEx    SysExCmd
PULSE                   ([forall a b. (Integral a, Num b) => a -> b
fromIntegral (IPin -> Word8
pinNo IPin
p), if Bool
b then Word8
1 else Word8
0] forall a. [a] -> [a] -> [a]
++ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Word8 -> [Word8]
toArduinoBytes (Word32 -> [Word8]
word2Bytes Word32
dur forall a. [a] -> [a] -> [a]
++ Word32 -> [Word8]
word2Bytes Word32
to))

-- | Unpackage a SysEx response
unpackageSysEx :: [Word8] -> Response
unpackageSysEx :: [Word8] -> Response
unpackageSysEx []              = Maybe String -> [Word8] -> Response
Unimplemented (forall a. a -> Maybe a
Just String
"<EMPTY-SYSEX-CMD>") []
unpackageSysEx (Word8
cmdWord:[Word8]
args)
  | Right SysExCmd
cmd <- Word8 -> Either Word8 SysExCmd
getSysExCommand Word8
cmdWord
  = case (SysExCmd
cmd, [Word8]
args) of
      (SysExCmd
REPORT_FIRMWARE, Word8
majV : Word8
minV : [Word8]
rest) -> Word8 -> Word8 -> String -> Response
Firmware Word8
majV Word8
minV ([Word8] -> String
getString [Word8]
rest)
      (SysExCmd
CAPABILITY_RESPONSE, [Word8]
bs)             -> BoardCapabilities -> Response
Capabilities ([Word8] -> BoardCapabilities
getCapabilities [Word8]
bs)
      (SysExCmd
ANALOG_MAPPING_RESPONSE, [Word8]
bs)         -> [Word8] -> Response
AnalogMapping [Word8]
bs
      (SysExCmd
PULSE, [Word8]
xs) | forall (t :: * -> *) a. Foldable t => t a -> Int
length [Word8]
xs forall a. Eq a => a -> a -> Bool
== Int
10         -> let [Word8
p, Word8
a, Word8
b, Word8
c, Word8
d] = [Word8] -> [Word8]
fromArduinoBytes [Word8]
xs in IPin -> Word32 -> Response
PulseResponse (Word8 -> IPin
InternalPin Word8
p) ((Word8, Word8, Word8, Word8) -> Word32
bytes2Words (Word8
a, Word8
b, Word8
c, Word8
d))
      (SysExCmd, [Word8])
_                                     -> Maybe String -> [Word8] -> Response
Unimplemented (forall a. a -> Maybe a
Just (forall a. Show a => a -> String
show SysExCmd
cmd)) [Word8]
args
  | Bool
True
  = Maybe String -> [Word8] -> Response
Unimplemented forall a. Maybe a
Nothing (Word8
cmdWord forall a. a -> [a] -> [a]
: [Word8]
args)

getCapabilities :: [Word8] -> BoardCapabilities
getCapabilities :: [Word8] -> BoardCapabilities
getCapabilities [Word8]
bs = Map IPin PinCapabilities -> BoardCapabilities
BoardCapabilities forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => [(k, a)] -> Map k a
M.fromList forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\IPin
p [(PinMode, Word8)]
c -> (IPin
p, PinCapabilities{analogPinNumber :: Maybe Word8
analogPinNumber = forall a. Maybe a
Nothing, allowedModes :: [(PinMode, Word8)]
allowedModes = [(PinMode, Word8)]
c}))
                                                              (forall a b. (a -> b) -> [a] -> [b]
map Word8 -> IPin
InternalPin [(Word8
0::Word8)..]) (forall a b. (a -> b) -> [a] -> [b]
map forall {b}. Integral b => [b] -> [(PinMode, b)]
pinCaps (forall {a}. (Eq a, Num a) => [a] -> [[a]]
chunk [Word8]
bs))
  where chunk :: [a] -> [[a]]
chunk [a]
xs = case forall a. (a -> Bool) -> [a] -> ([a], [a])
break (forall a. Eq a => a -> a -> Bool
== a
0x7f) [a]
xs of
                     ([], [])         -> []
                     ([a]
cur, a
0x7f:[a]
rest) -> [a]
cur forall a. a -> [a] -> [a]
: [a] -> [[a]]
chunk [a]
rest
                     ([a], [a])
_                -> [[a]
xs]
        pinCaps :: [b] -> [(PinMode, b)]
pinCaps (b
x:b
y:[b]
rest) = (Int -> PinMode
findMode (forall a b. (Integral a, Num b) => a -> b
fromIntegral b
x), b
y) forall a. a -> [a] -> [a]
: [b] -> [(PinMode, b)]
pinCaps [b]
rest
        pinCaps [b]
_          = []

        -- Code defensively against capabilities we do not know
        findMode :: Int -> PinMode
        findMode :: Int -> PinMode
findMode Int
0  = PinMode
INPUT
        findMode Int
1  = PinMode
OUTPUT
        findMode Int
2  = PinMode
ANALOG
        findMode Int
3  = PinMode
PWM
        findMode Int
4  = PinMode
SERVO
        findMode Int
5  = PinMode
SHIFT
        findMode Int
6  = PinMode
I2C
        findMode Int
7  = PinMode
ONEWIRE
        findMode Int
8  = PinMode
STEPPER
        findMode Int
9  = PinMode
ENCODER
        findMode Int
10 = PinMode
SERIAL
        findMode Int
11 = PinMode
PULLUP
        findMode Int
_  = PinMode
UNSUPPORTED

-- | Unpackage a Non-SysEx response
unpackageNonSysEx :: (Int -> IO [Word8]) -> FirmataCmd -> IO Response
unpackageNonSysEx :: (Int -> IO [Word8]) -> FirmataCmd -> IO Response
unpackageNonSysEx Int -> IO [Word8]
getBytes FirmataCmd
c = FirmataCmd -> IO Response
grab FirmataCmd
c
 where unimplemented :: Int -> IO Response
unimplemented Int
n = Maybe String -> [Word8] -> Response
Unimplemented (forall a. a -> Maybe a
Just (forall a. Show a => a -> String
show FirmataCmd
c)) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Int -> IO [Word8]
getBytes Int
n
       grab :: FirmataCmd -> IO Response
grab (ANALOG_MESSAGE       IPin
p)    = Int -> IO [Word8]
getBytes Int
2 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \[Word8
l, Word8
h] -> forall (m :: * -> *) a. Monad m => a -> m a
return (IPin -> Word8 -> Word8 -> Response
AnalogMessage  IPin
p Word8
l Word8
h)
       grab (DIGITAL_MESSAGE      Port
p)    = Int -> IO [Word8]
getBytes Int
2 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \[Word8
l, Word8
h] -> forall (m :: * -> *) a. Monad m => a -> m a
return (Port -> Word8 -> Word8 -> Response
DigitalMessage Port
p Word8
l Word8
h)
       -- we should never see any of the following since they are "request" codes
       -- TBD: Maybe we should put them in a different data-type
       grab (REPORT_ANALOG_PIN   IPin
_pin)  = Int -> IO Response
unimplemented Int
1
       grab (REPORT_DIGITAL_PORT Port
_port) = Int -> IO Response
unimplemented Int
1
       grab FirmataCmd
START_SYSEX                 = Int -> IO Response
unimplemented Int
0
       grab FirmataCmd
SET_PIN_MODE                = Int -> IO Response
unimplemented Int
2
       grab FirmataCmd
END_SYSEX                   = Int -> IO Response
unimplemented Int
0
       grab FirmataCmd
PROTOCOL_VERSION            = Int -> IO Response
unimplemented Int
2
       grab FirmataCmd
SYSTEM_RESET                = Int -> IO Response
unimplemented Int
0