-------------------------------------------------------------------------------
-- |
-- Module      :  System.Hardware.Arduino.Data
-- Copyright   :  (c) Levent Erkok
-- License     :  BSD3
-- Maintainer  :  erkokl@gmail.com
-- Stability   :  experimental
--
-- Underlying data structures
-------------------------------------------------------------------------------

{-# LANGUAGE GeneralizedNewtypeDeriving  #-}
{-# LANGUAGE NamedFieldPuns              #-}
{-# LANGUAGE RankNTypes                  #-}

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

module System.Hardware.Arduino.Data where

import Control.Concurrent         (Chan, MVar, modifyMVar, modifyMVar_, withMVar, ThreadId)
import Control.Monad              (when)
import Control.Monad.State        (StateT, MonadIO, MonadState, gets, liftIO)
import Data.Bits                  ((.&.), (.|.), setBit)
import Data.List                  (intercalate)
import Data.Maybe                 (fromMaybe, listToMaybe)
import Data.Word                  (Word8, Word32)
import System.Hardware.Serialport (SerialPort)

import qualified Data.Map as M
import qualified Data.Set as S

import System.Hardware.Arduino.Utils

import System.Exit (exitFailure)

-- | A port (containing 8 pins)
newtype Port = Port { Port -> Word8
portNo :: Word8  -- ^ The port number
                    }
                    deriving (Port -> Port -> Bool
(Port -> Port -> Bool) -> (Port -> Port -> Bool) -> Eq Port
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Port -> Port -> Bool
== :: Port -> Port -> Bool
$c/= :: Port -> Port -> Bool
/= :: Port -> Port -> Bool
Eq, Eq Port
Eq Port =>
(Port -> Port -> Ordering)
-> (Port -> Port -> Bool)
-> (Port -> Port -> Bool)
-> (Port -> Port -> Bool)
-> (Port -> Port -> Bool)
-> (Port -> Port -> Port)
-> (Port -> Port -> Port)
-> Ord Port
Port -> Port -> Bool
Port -> Port -> Ordering
Port -> Port -> Port
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Port -> Port -> Ordering
compare :: Port -> Port -> Ordering
$c< :: Port -> Port -> Bool
< :: Port -> Port -> Bool
$c<= :: Port -> Port -> Bool
<= :: Port -> Port -> Bool
$c> :: Port -> Port -> Bool
> :: Port -> Port -> Bool
$c>= :: Port -> Port -> Bool
>= :: Port -> Port -> Bool
$cmax :: Port -> Port -> Port
max :: Port -> Port -> Port
$cmin :: Port -> Port -> Port
min :: Port -> Port -> Port
Ord)

-- | Show instance for Port
instance Show Port where
  show :: Port -> String
show Port
p = String
"Port" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word8 -> String
forall a. Show a => a -> String
show (Port -> Word8
portNo Port
p)

-- | A pin on the Arduino, as specified by the user via 'pin', 'digital', and 'analog' functions.
data Pin = DigitalPin {Pin -> Word8
userPinNo :: Word8}
         | AnalogPin  {userPinNo :: Word8}
         | MixedPin   {userPinNo :: Word8}

-- | Show instance for Pin
instance Show Pin where
  show :: Pin -> String
show (DigitalPin Word8
w) = String
"DPin" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word8 -> String
forall a. Show a => a -> String
show Word8
w
  show (AnalogPin  Word8
w) = String
"APin" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word8 -> String
forall a. Show a => a -> String
show Word8
w
  show (MixedPin   Word8
w) = String
"Pin"  String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word8 -> String
forall a. Show a => a -> String
show Word8
w

-- | A pin on the Arduino, as viewed by the library; i.e., real-pin numbers
newtype IPin = InternalPin { IPin -> Word8
pinNo :: Word8 }
          deriving (IPin -> IPin -> Bool
(IPin -> IPin -> Bool) -> (IPin -> IPin -> Bool) -> Eq IPin
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: IPin -> IPin -> Bool
== :: IPin -> IPin -> Bool
$c/= :: IPin -> IPin -> Bool
/= :: IPin -> IPin -> Bool
Eq, Eq IPin
Eq IPin =>
(IPin -> IPin -> Ordering)
-> (IPin -> IPin -> Bool)
-> (IPin -> IPin -> Bool)
-> (IPin -> IPin -> Bool)
-> (IPin -> IPin -> Bool)
-> (IPin -> IPin -> IPin)
-> (IPin -> IPin -> IPin)
-> Ord IPin
IPin -> IPin -> Bool
IPin -> IPin -> Ordering
IPin -> IPin -> IPin
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: IPin -> IPin -> Ordering
compare :: IPin -> IPin -> Ordering
$c< :: IPin -> IPin -> Bool
< :: IPin -> IPin -> Bool
$c<= :: IPin -> IPin -> Bool
<= :: IPin -> IPin -> Bool
$c> :: IPin -> IPin -> Bool
> :: IPin -> IPin -> Bool
$c>= :: IPin -> IPin -> Bool
>= :: IPin -> IPin -> Bool
$cmax :: IPin -> IPin -> IPin
max :: IPin -> IPin -> IPin
$cmin :: IPin -> IPin -> IPin
min :: IPin -> IPin -> IPin
Ord)

-- | Show instance for IPin
instance Show IPin where
  show :: IPin -> String
show (InternalPin Word8
w) = String
"IPin" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word8 -> String
forall a. Show a => a -> String
show Word8
w

-- | Declare a pin by its index. For maximum portability, prefer 'digital'
-- and 'analog' functions, which will adjust pin indexes properly based on
-- which board the program is running on at run-time, as Arduino boards
-- differ in their pin numbers. This function is provided for cases where
-- a pin is used in mixed-mode, i.e., both for digital and analog purposes,
-- as Arduino does not really distinguish pin usage. In these cases, the
-- user has the proof obligation to make sure that the index used is supported
-- on the board with appropriate capabilities.
pin :: Word8 -> Pin
pin :: Word8 -> Pin
pin = Word8 -> Pin
MixedPin

-- | Declare an digital pin on the board. For instance, to refer to digital pin no 12
-- use 'digital' @12@.
digital :: Word8 -> Pin
digital :: Word8 -> Pin
digital = Word8 -> Pin
DigitalPin

-- | Declare an analog pin on the board. For instance, to refer to analog pin no 0
-- simply use 'analog' @0@.
--
-- Note that 'analog' @0@ on an Arduino UNO will be appropriately adjusted
-- internally to refer to pin 14, since UNO has 13 digital pins, while on an
-- Arduino MEGA, it will refer to internal pin 55, since MEGA has 54 digital pins;
-- and similarly for other boards depending on their capabilities.
-- (Also see the note on 'pin' for pin mappings.)
analog :: Word8 -> Pin
analog :: Word8 -> Pin
analog = Word8 -> Pin
AnalogPin

-- | On the Arduino, pins are grouped into banks of 8.
-- Given a pin, this function determines which port it belongs to
pinPort :: IPin -> Port
pinPort :: IPin -> Port
pinPort IPin
p = Word8 -> Port
Port (IPin -> Word8
pinNo IPin
p Word8 -> Word8 -> Word8
forall a. Integral a => a -> a -> a
`quot` Word8
8)

-- | On the Arduino, pins are grouped into banks of 8.
-- Given a pin, this function determines which index it belongs to in its port
pinPortIndex :: IPin -> Word8
pinPortIndex :: IPin -> Word8
pinPortIndex IPin
p = IPin -> Word8
pinNo IPin
p Word8 -> Word8 -> Word8
forall a. Integral a => a -> a -> a
`rem` Word8
8

-- | The mode for a pin.
data PinMode = INPUT        -- ^ Digital input
             | OUTPUT       -- ^ Digital output
             | ANALOG       -- ^ Analog input
             | PWM          -- ^ PWM (Pulse-Width-Modulation) output 
             | SERVO        -- ^ Servo Motor controller
             | SHIFT        -- ^ Shift controller
             | I2C          -- ^ I2C (Inter-Integrated-Circuit) connection
             | ONEWIRE      -- ^ NB. No explicit support
             | STEPPER      -- ^ NB. No explicit support
             | ENCODER      -- ^ NB. No explicit support
             | SERIAL       -- ^ NB. No explicit support
             | PULLUP       -- ^ NB. No explicit support
             | UNSUPPORTED  -- ^ A mode we do not understand or support
             deriving (PinMode -> PinMode -> Bool
(PinMode -> PinMode -> Bool)
-> (PinMode -> PinMode -> Bool) -> Eq PinMode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PinMode -> PinMode -> Bool
== :: PinMode -> PinMode -> Bool
$c/= :: PinMode -> PinMode -> Bool
/= :: PinMode -> PinMode -> Bool
Eq, Int -> PinMode -> ShowS
[PinMode] -> ShowS
PinMode -> String
(Int -> PinMode -> ShowS)
-> (PinMode -> String) -> ([PinMode] -> ShowS) -> Show PinMode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PinMode -> ShowS
showsPrec :: Int -> PinMode -> ShowS
$cshow :: PinMode -> String
show :: PinMode -> String
$cshowList :: [PinMode] -> ShowS
showList :: [PinMode] -> ShowS
Show, Int -> PinMode
PinMode -> Int
PinMode -> [PinMode]
PinMode -> PinMode
PinMode -> PinMode -> [PinMode]
PinMode -> PinMode -> PinMode -> [PinMode]
(PinMode -> PinMode)
-> (PinMode -> PinMode)
-> (Int -> PinMode)
-> (PinMode -> Int)
-> (PinMode -> [PinMode])
-> (PinMode -> PinMode -> [PinMode])
-> (PinMode -> PinMode -> [PinMode])
-> (PinMode -> PinMode -> PinMode -> [PinMode])
-> Enum PinMode
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: PinMode -> PinMode
succ :: PinMode -> PinMode
$cpred :: PinMode -> PinMode
pred :: PinMode -> PinMode
$ctoEnum :: Int -> PinMode
toEnum :: Int -> PinMode
$cfromEnum :: PinMode -> Int
fromEnum :: PinMode -> Int
$cenumFrom :: PinMode -> [PinMode]
enumFrom :: PinMode -> [PinMode]
$cenumFromThen :: PinMode -> PinMode -> [PinMode]
enumFromThen :: PinMode -> PinMode -> [PinMode]
$cenumFromTo :: PinMode -> PinMode -> [PinMode]
enumFromTo :: PinMode -> PinMode -> [PinMode]
$cenumFromThenTo :: PinMode -> PinMode -> PinMode -> [PinMode]
enumFromThenTo :: PinMode -> PinMode -> PinMode -> [PinMode]
Enum)

-- | A request, as sent to Arduino
data Request = SystemReset                                -- ^ Send system reset
             | QueryFirmware                              -- ^ Query the Firmata version installed
             | CapabilityQuery                            -- ^ Query the capabilities of the board
             | AnalogMappingQuery                         -- ^ Query the mapping of analog pins
             | SetPinMode         IPin PinMode            -- ^ Set the mode on a pin
             | DigitalReport      Port Bool               -- ^ Digital report values on port enable/disable
             | AnalogReport       IPin Bool               -- ^ Analog report values on pin enable/disable
             | DigitalPortWrite   Port Word8 Word8        -- ^ Set the values on a port digitally
             | AnalogPinWrite     IPin  Word8 Word8       -- ^ Send an analog-write; used for servo control
             | SamplingInterval   Word8 Word8             -- ^ Set the sampling interval
             | Pulse              IPin Bool Word32 Word32 -- ^ Request for a pulse reading on a pin, value, duration, timeout
             deriving Int -> Request -> ShowS
[Request] -> ShowS
Request -> String
(Int -> Request -> ShowS)
-> (Request -> String) -> ([Request] -> ShowS) -> Show Request
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Request -> ShowS
showsPrec :: Int -> Request -> ShowS
$cshow :: Request -> String
show :: Request -> String
$cshowList :: [Request] -> ShowS
showList :: [Request] -> ShowS
Show

-- | A response, as returned from the Arduino
data Response = Firmware  Word8 Word8 String         -- ^ Firmware version (maj/min and indentifier
              | Capabilities BoardCapabilities       -- ^ Capabilities report
              | AnalogMapping [Word8]                -- ^ Analog pin mappings
              | DigitalMessage Port Word8 Word8      -- ^ Status of a port
              | AnalogMessage  IPin Word8 Word8      -- ^ Status of an analog pin
              | PulseResponse  IPin Word32           -- ^ Repsonse to a PulseInCommand
              | Unimplemented (Maybe String) [Word8] -- ^ Represents messages currently unsupported

-- | Show instance for Response
instance Show Response where
  show :: Response -> String
show (Firmware Word8
majV Word8
minV String
n)  = String
"Firmware v" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word8 -> String
forall a. Show a => a -> String
show Word8
majV String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"." String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word8 -> String
forall a. Show a => a -> String
show Word8
minV String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" (" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
n String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")"
  show (Capabilities BoardCapabilities
b)        = String
"Capabilities:\n" String -> ShowS
forall a. [a] -> [a] -> [a]
++ BoardCapabilities -> String
forall a. Show a => a -> String
show BoardCapabilities
b
  show (AnalogMapping [Word8]
bs)      = String
"AnalogMapping: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [Word8] -> String
showByteList [Word8]
bs
  show (DigitalMessage Port
p Word8
l Word8
h)  = String
"DigitalMessage " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Port -> String
forall a. Show a => a -> String
show Port
p String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" = " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word8 -> String
showByte Word8
l String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word8 -> String
showByte Word8
h
  show (AnalogMessage  IPin
p Word8
l Word8
h)  = String
"AnalogMessage "  String -> ShowS
forall a. [a] -> [a] -> [a]
++ IPin -> String
forall a. Show a => a -> String
show IPin
p String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" = " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word8 -> String
showByte Word8
l String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word8 -> String
showByte Word8
h
  show (PulseResponse IPin
p Word32
v)     = String
"PulseResponse "  String -> ShowS
forall a. [a] -> [a] -> [a]
++ IPin -> String
forall a. Show a => a -> String
show IPin
p String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" = " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word32 -> String
forall a. Show a => a -> String
show Word32
v String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" (microseconds)"
  show (Unimplemented Maybe String
mbc [Word8]
bs)  = String
"Unimplemeneted " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
"" Maybe String
mbc String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [Word8] -> String
showByteList [Word8]
bs

-- | Resolution, as referred to in http://firmata.org/wiki/Protocol#Capability_Query
-- TODO: Not quite sure how this is used, so merely keep it as a Word8 now
type Resolution = Word8

-- | Capabilities of a pin
data PinCapabilities  = PinCapabilities {
                          PinCapabilities -> Maybe Word8
analogPinNumber :: Maybe Word8              -- ^ Analog pin number, if any
                        , PinCapabilities -> [(PinMode, Word8)]
allowedModes    :: [(PinMode, Resolution)]  -- ^ Allowed modes and resolutions
                        }

-- | What the board is capable of and current settings
newtype BoardCapabilities = BoardCapabilities (M.Map IPin PinCapabilities)

-- | Show instance for BoardCapabilities
instance Show BoardCapabilities where
  show :: BoardCapabilities -> String
show (BoardCapabilities Map IPin PinCapabilities
m) = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"\n" (((IPin, PinCapabilities) -> String)
-> [(IPin, PinCapabilities)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (IPin, PinCapabilities) -> String
forall {a}. Show a => (a, PinCapabilities) -> String
sh (Map IPin PinCapabilities -> [(IPin, PinCapabilities)]
forall k a. Map k a -> [(k, a)]
M.toAscList Map IPin PinCapabilities
m))
    where sh :: (a, PinCapabilities) -> String
sh (a
p, PinCapabilities{Maybe Word8
analogPinNumber :: PinCapabilities -> Maybe Word8
analogPinNumber :: Maybe Word8
analogPinNumber, [(PinMode, Word8)]
allowedModes :: PinCapabilities -> [(PinMode, Word8)]
allowedModes :: [(PinMode, Word8)]
allowedModes}) = a -> String
forall a. Show a => a -> String
show a
p String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
sep String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
unwords [PinMode -> String
forall a. Show a => a -> String
show PinMode
md | (PinMode
md, Word8
_) <- [(PinMode, Word8)]
allowedModes]
             where sep :: String
sep = String -> (Word8 -> String) -> Maybe Word8 -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
": " (\Word8
i -> String
"[A" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word8 -> String
forall a. Show a => a -> String
show Word8
i String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"]: ") Maybe Word8
analogPinNumber

-- | Data associated with a pin
data PinData = PinData {
                 PinData -> PinMode
pinMode  :: PinMode
               , PinData -> Maybe (Either Bool Int)
pinValue :: Maybe (Either Bool Int)
               }
               deriving Int -> PinData -> ShowS
[PinData] -> ShowS
PinData -> String
(Int -> PinData -> ShowS)
-> (PinData -> String) -> ([PinData] -> ShowS) -> Show PinData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PinData -> ShowS
showsPrec :: Int -> PinData -> ShowS
$cshow :: PinData -> String
show :: PinData -> String
$cshowList :: [PinData] -> ShowS
showList :: [PinData] -> ShowS
Show

-- | LCD's connected to the board
newtype LCD = LCD Int
            deriving (LCD -> LCD -> Bool
(LCD -> LCD -> Bool) -> (LCD -> LCD -> Bool) -> Eq LCD
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: LCD -> LCD -> Bool
== :: LCD -> LCD -> Bool
$c/= :: LCD -> LCD -> Bool
/= :: LCD -> LCD -> Bool
Eq, Eq LCD
Eq LCD =>
(LCD -> LCD -> Ordering)
-> (LCD -> LCD -> Bool)
-> (LCD -> LCD -> Bool)
-> (LCD -> LCD -> Bool)
-> (LCD -> LCD -> Bool)
-> (LCD -> LCD -> LCD)
-> (LCD -> LCD -> LCD)
-> Ord LCD
LCD -> LCD -> Bool
LCD -> LCD -> Ordering
LCD -> LCD -> LCD
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: LCD -> LCD -> Ordering
compare :: LCD -> LCD -> Ordering
$c< :: LCD -> LCD -> Bool
< :: LCD -> LCD -> Bool
$c<= :: LCD -> LCD -> Bool
<= :: LCD -> LCD -> Bool
$c> :: LCD -> LCD -> Bool
> :: LCD -> LCD -> Bool
$c>= :: LCD -> LCD -> Bool
>= :: LCD -> LCD -> Bool
$cmax :: LCD -> LCD -> LCD
max :: LCD -> LCD -> LCD
$cmin :: LCD -> LCD -> LCD
min :: LCD -> LCD -> LCD
Ord, Int -> LCD -> ShowS
[LCD] -> ShowS
LCD -> String
(Int -> LCD -> ShowS)
-> (LCD -> String) -> ([LCD] -> ShowS) -> Show LCD
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> LCD -> ShowS
showsPrec :: Int -> LCD -> ShowS
$cshow :: LCD -> String
show :: LCD -> String
$cshowList :: [LCD] -> ShowS
showList :: [LCD] -> ShowS
Show)

-- | Hitachi LCD controller: See: <http://en.wikipedia.org/wiki/Hitachi_HD44780_LCD_controller>.
-- We model only the 4-bit variant, with RS and EN lines only. (The most common Arduino usage.)
-- The data sheet can be seen at: <http://lcd-linux.sourceforge.net/pdfdocs/hd44780.pdf>.
data LCDController = Hitachi44780 {
                       LCDController -> Pin
lcdRS       :: Pin  -- ^ Hitachi pin @ 4@: Register-select
                     , LCDController -> Pin
lcdEN       :: Pin  -- ^ Hitachi pin @ 6@: Enable
                     , LCDController -> Pin
lcdD4       :: Pin  -- ^ Hitachi pin @11@: Data line @4@
                     , LCDController -> Pin
lcdD5       :: Pin  -- ^ Hitachi pin @12@: Data line @5@
                     , LCDController -> Pin
lcdD6       :: Pin  -- ^ Hitachi pin @13@: Data line @6@
                     , LCDController -> Pin
lcdD7       :: Pin  -- ^ Hitachi pin @14@: Data line @7@
                     , LCDController -> Int
lcdRows     :: Int  -- ^ Number of rows (typically 1 or 2, upto 4)
                     , LCDController -> Int
lcdCols     :: Int  -- ^ Number of cols (typically 16 or 20, upto 40)
                     , LCDController -> Bool
dotMode5x10 :: Bool -- ^ Set to True if 5x10 dots are used
                     }
                     deriving Int -> LCDController -> ShowS
[LCDController] -> ShowS
LCDController -> String
(Int -> LCDController -> ShowS)
-> (LCDController -> String)
-> ([LCDController] -> ShowS)
-> Show LCDController
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> LCDController -> ShowS
showsPrec :: Int -> LCDController -> ShowS
$cshow :: LCDController -> String
show :: LCDController -> String
$cshowList :: [LCDController] -> ShowS
showList :: [LCDController] -> ShowS
Show

-- | State of the LCD, a mere 8-bit word for the Hitachi
data LCDData = LCDData {
                  LCDData -> Word8
lcdDisplayMode    :: Word8         -- ^ Display mode (left/right/scrolling etc.)
                , LCDData -> Word8
lcdDisplayControl :: Word8         -- ^ Display control (blink on/off, display on/off etc.)
                , LCDData -> Word8
lcdGlyphCount     :: Word8         -- ^ Count of custom created glyphs (typically at most 8)
                , LCDData -> LCDController
lcdController     :: LCDController -- ^ Actual controller
                }

-- | State of the board
data BoardState = BoardState {
                    BoardState -> BoardCapabilities
boardCapabilities    :: BoardCapabilities   -- ^ Capabilities of the board
                  , BoardState -> Set IPin
analogReportingPins  :: S.Set IPin          -- ^ Which analog pins are reporting
                  , BoardState -> Set IPin
digitalReportingPins :: S.Set IPin          -- ^ Which digital pins are reporting
                  , BoardState -> Map IPin PinData
pinStates            :: M.Map IPin PinData  -- ^ For-each pin, store its data
                  , BoardState -> [MVar ()]
digitalWakeUpQueue   :: [MVar ()]           -- ^ Semaphore list to wake-up upon receiving a digital message
                  , BoardState -> Map LCD LCDData
lcds                 :: M.Map LCD LCDData   -- ^ LCD's attached to the board
                  }

-- | State of the computation
data ArduinoState = ArduinoState {
                ArduinoState -> String -> IO ()
message       :: String -> IO ()             -- ^ Current debugging routine
              , ArduinoState -> String -> [String] -> IO ()
bailOut       :: String -> [String] -> IO () -- ^ Clean-up and quit with a hopefully informative message
              , ArduinoState -> SerialPort
port          :: SerialPort                  -- ^ Serial port we are communicating on
              , ArduinoState -> String
firmataID     :: String                      -- ^ The ID of the board (as identified by the Board itself)
              , ArduinoState -> MVar BoardState
boardState    :: MVar BoardState             -- ^ Current state of the board
              , ArduinoState -> Chan Response
deviceChannel :: Chan Response               -- ^ Incoming messages from the board
              , ArduinoState -> BoardCapabilities
capabilities  :: BoardCapabilities           -- ^ Capabilities of the board
              , ArduinoState -> MVar ThreadId
listenerTid   :: MVar ThreadId               -- ^ ThreadId of the listener
              }

-- | The Arduino monad.
newtype Arduino a = Arduino (StateT ArduinoState IO a)
                  deriving ((forall a b. (a -> b) -> Arduino a -> Arduino b)
-> (forall a b. a -> Arduino b -> Arduino a) -> Functor Arduino
forall a b. a -> Arduino b -> Arduino a
forall a b. (a -> b) -> Arduino a -> Arduino b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> Arduino a -> Arduino b
fmap :: forall a b. (a -> b) -> Arduino a -> Arduino b
$c<$ :: forall a b. a -> Arduino b -> Arduino a
<$ :: forall a b. a -> Arduino b -> Arduino a
Functor, Functor Arduino
Functor Arduino =>
(forall a. a -> Arduino a)
-> (forall a b. Arduino (a -> b) -> Arduino a -> Arduino b)
-> (forall a b c.
    (a -> b -> c) -> Arduino a -> Arduino b -> Arduino c)
-> (forall a b. Arduino a -> Arduino b -> Arduino b)
-> (forall a b. Arduino a -> Arduino b -> Arduino a)
-> Applicative Arduino
forall a. a -> Arduino a
forall a b. Arduino a -> Arduino b -> Arduino a
forall a b. Arduino a -> Arduino b -> Arduino b
forall a b. Arduino (a -> b) -> Arduino a -> Arduino b
forall a b c. (a -> b -> c) -> Arduino a -> Arduino b -> Arduino c
forall (f :: * -> *).
Functor f =>
(forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
$cpure :: forall a. a -> Arduino a
pure :: forall a. a -> Arduino a
$c<*> :: forall a b. Arduino (a -> b) -> Arduino a -> Arduino b
<*> :: forall a b. Arduino (a -> b) -> Arduino a -> Arduino b
$cliftA2 :: forall a b c. (a -> b -> c) -> Arduino a -> Arduino b -> Arduino c
liftA2 :: forall a b c. (a -> b -> c) -> Arduino a -> Arduino b -> Arduino c
$c*> :: forall a b. Arduino a -> Arduino b -> Arduino b
*> :: forall a b. Arduino a -> Arduino b -> Arduino b
$c<* :: forall a b. Arduino a -> Arduino b -> Arduino a
<* :: forall a b. Arduino a -> Arduino b -> Arduino a
Applicative, Applicative Arduino
Applicative Arduino =>
(forall a b. Arduino a -> (a -> Arduino b) -> Arduino b)
-> (forall a b. Arduino a -> Arduino b -> Arduino b)
-> (forall a. a -> Arduino a)
-> Monad Arduino
forall a. a -> Arduino a
forall a b. Arduino a -> Arduino b -> Arduino b
forall a b. Arduino a -> (a -> Arduino b) -> Arduino b
forall (m :: * -> *).
Applicative m =>
(forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
$c>>= :: forall a b. Arduino a -> (a -> Arduino b) -> Arduino b
>>= :: forall a b. Arduino a -> (a -> Arduino b) -> Arduino b
$c>> :: forall a b. Arduino a -> Arduino b -> Arduino b
>> :: forall a b. Arduino a -> Arduino b -> Arduino b
$creturn :: forall a. a -> Arduino a
return :: forall a. a -> Arduino a
Monad, Monad Arduino
Monad Arduino => (forall a. IO a -> Arduino a) -> MonadIO Arduino
forall a. IO a -> Arduino a
forall (m :: * -> *).
Monad m =>
(forall a. IO a -> m a) -> MonadIO m
$cliftIO :: forall a. IO a -> Arduino a
liftIO :: forall a. IO a -> Arduino a
MonadIO, MonadState ArduinoState)

-- | Debugging only: print the given string on stdout.
debug :: String -> Arduino ()
debug :: String -> Arduino ()
debug String
s = do String -> IO ()
f <- (ArduinoState -> String -> IO ()) -> Arduino (String -> IO ())
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ArduinoState -> String -> IO ()
message
             IO () -> Arduino ()
forall a. IO a -> Arduino a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Arduino ()) -> IO () -> Arduino ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
f String
s

-- | Bailing out: print the given string on stdout and die
die :: String -> [String] -> Arduino a
die :: forall a. String -> [String] -> Arduino a
die String
m [String]
ms = do String -> [String] -> IO ()
f <- (ArduinoState -> String -> [String] -> IO ())
-> Arduino (String -> [String] -> IO ())
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ArduinoState -> String -> [String] -> IO ()
bailOut
              IO a -> Arduino a
forall a. IO a -> Arduino a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> Arduino a) -> IO a -> Arduino a
forall a b. (a -> b) -> a -> b
$ do String -> [String] -> IO ()
f String
m [String]
ms
                          IO a
forall a. IO a
exitFailure

-- | Which modes does this pin support?
getPinModes :: IPin -> Arduino [PinMode]
getPinModes :: IPin -> Arduino [PinMode]
getPinModes IPin
p = do
  BoardCapabilities Map IPin PinCapabilities
caps <- (ArduinoState -> BoardCapabilities) -> Arduino BoardCapabilities
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ArduinoState -> BoardCapabilities
capabilities
  case IPin
p IPin -> Map IPin PinCapabilities -> Maybe PinCapabilities
forall k a. Ord k => k -> Map k a -> Maybe a
`M.lookup` Map IPin PinCapabilities
caps of
    Maybe PinCapabilities
Nothing                            -> [PinMode] -> Arduino [PinMode]
forall a. a -> Arduino a
forall (m :: * -> *) a. Monad m => a -> m a
return []
    Just PinCapabilities{[(PinMode, Word8)]
allowedModes :: PinCapabilities -> [(PinMode, Word8)]
allowedModes :: [(PinMode, Word8)]
allowedModes} -> [PinMode] -> Arduino [PinMode]
forall a. a -> Arduino a
forall (m :: * -> *) a. Monad m => a -> m a
return ([PinMode] -> Arduino [PinMode]) -> [PinMode] -> Arduino [PinMode]
forall a b. (a -> b) -> a -> b
$ ((PinMode, Word8) -> PinMode) -> [(PinMode, Word8)] -> [PinMode]
forall a b. (a -> b) -> [a] -> [b]
map (PinMode, Word8) -> PinMode
forall a b. (a, b) -> a
fst [(PinMode, Word8)]
allowedModes

-- | Current state of the pin
getPinData :: IPin -> Arduino PinData
getPinData :: IPin -> Arduino PinData
getPinData IPin
p = do
  MVar BoardState
bs  <- (ArduinoState -> MVar BoardState) -> Arduino (MVar BoardState)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ArduinoState -> MVar BoardState
boardState
  String -> [String] -> IO ()
err <- (ArduinoState -> String -> [String] -> IO ())
-> Arduino (String -> [String] -> IO ())
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ArduinoState -> String -> [String] -> IO ()
bailOut
  IO PinData -> Arduino PinData
forall a. IO a -> Arduino a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO PinData -> Arduino PinData) -> IO PinData -> Arduino PinData
forall a b. (a -> b) -> a -> b
$ MVar BoardState -> (BoardState -> IO PinData) -> IO PinData
forall a b. MVar a -> (a -> IO b) -> IO b
withMVar MVar BoardState
bs ((BoardState -> IO PinData) -> IO PinData)
-> (BoardState -> IO PinData) -> IO PinData
forall a b. (a -> b) -> a -> b
$ \BoardState
bst ->
     case IPin
p IPin -> Map IPin PinData -> Maybe PinData
forall k a. Ord k => k -> Map k a -> Maybe a
`M.lookup` BoardState -> Map IPin PinData
pinStates BoardState
bst of
       Maybe PinData
Nothing -> do String -> [String] -> IO ()
err (String
"Trying to access " String -> ShowS
forall a. [a] -> [a] -> [a]
++ IPin -> String
forall a. Show a => a -> String
show IPin
p String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" without proper configuration.")
                         [String
"Make sure that you use 'setPinMode' to configure this pin first."]
                     IO PinData
forall a. IO a
exitFailure
       Just PinData
pd -> PinData -> IO PinData
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return PinData
pd

-- | Given a pin, collect the digital value corresponding to the
-- port it belongs to, where the new value of the current pin is given
-- The result is two bytes:
--
--   * First  lsb: pins 0-6 on the port
--   * Second msb: pins 7-13 on the port
--
-- In particular, the result is suitable to be sent with a digital message
computePortData :: IPin -> Bool -> Arduino (Word8, Word8)
computePortData :: IPin -> Bool -> Arduino (Word8, Word8)
computePortData IPin
curPin Bool
newValue = do
  let curPort :: Port
curPort  = IPin -> Port
pinPort IPin
curPin
  let curIndex :: Word8
curIndex = IPin -> Word8
pinPortIndex IPin
curPin
  MVar BoardState
bs <- (ArduinoState -> MVar BoardState) -> Arduino (MVar BoardState)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ArduinoState -> MVar BoardState
boardState
  IO (Word8, Word8) -> Arduino (Word8, Word8)
forall a. IO a -> Arduino a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Word8, Word8) -> Arduino (Word8, Word8))
-> IO (Word8, Word8) -> Arduino (Word8, Word8)
forall a b. (a -> b) -> a -> b
$ MVar BoardState
-> (BoardState -> IO (BoardState, (Word8, Word8)))
-> IO (Word8, Word8)
forall a b. MVar a -> (a -> IO (a, b)) -> IO b
modifyMVar MVar BoardState
bs ((BoardState -> IO (BoardState, (Word8, Word8)))
 -> IO (Word8, Word8))
-> (BoardState -> IO (BoardState, (Word8, Word8)))
-> IO (Word8, Word8)
forall a b. (a -> b) -> a -> b
$ \BoardState
bst -> do
     let values :: [(Word8, Maybe (Either Bool Int))]
values = [(IPin -> Word8
pinPortIndex IPin
p, PinData -> Maybe (Either Bool Int)
pinValue PinData
pd) | (IPin
p, PinData
pd) <- Map IPin PinData -> [(IPin, PinData)]
forall k a. Map k a -> [(k, a)]
M.assocs (BoardState -> Map IPin PinData
pinStates BoardState
bst), Port
curPort Port -> Port -> Bool
forall a. Eq a => a -> a -> Bool
== IPin -> Port
pinPort IPin
p, PinData -> PinMode
pinMode PinData
pd PinMode -> [PinMode] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [PinMode
INPUT, PinMode
OUTPUT]]
         getVal :: Word8 -> Bool
getVal Word8
i
           | Word8
i Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
curIndex                             = Bool
newValue
           | Just (Just (Left Bool
v)) <- Word8
i Word8
-> [(Word8, Maybe (Either Bool Int))]
-> Maybe (Maybe (Either Bool Int))
forall a b. Eq a => a -> [(a, b)] -> Maybe b
`lookup` [(Word8, Maybe (Either Bool Int))]
values = Bool
v
           | Bool
True                                      = Bool
False
         [Bool
b0, Bool
b1, Bool
b2, Bool
b3, Bool
b4, Bool
b5, Bool
b6, Bool
b7] = (Word8 -> Bool) -> [Word8] -> [Bool]
forall a b. (a -> b) -> [a] -> [b]
map Word8 -> Bool
getVal [Word8
0 .. Word8
7]
         lsb :: Word8
lsb = ((Int, Bool) -> Word8 -> Word8) -> Word8 -> [(Int, Bool)] -> Word8
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\(Int
i, Bool
b) Word8
m -> if Bool
b then Word8
m Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`setBit` Int
i     else Word8
m) Word8
0 ([Int] -> [Bool] -> [(Int, Bool)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] [Bool
b0, Bool
b1, Bool
b2, Bool
b3, Bool
b4, Bool
b5, Bool
b6])
         msb :: Word8
msb = ((Int, Bool) -> Word8 -> Word8) -> Word8 -> [(Int, Bool)] -> Word8
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\(Int
i, Bool
b) Word8
m -> if Bool
b then Word8
m Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`setBit` (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
7) else Word8
m) Word8
0 ([Int] -> [Bool] -> [(Int, Bool)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
7..] [Bool
b7])
         bst' :: BoardState
bst' = BoardState
bst{pinStates = M.insert curPin PinData{pinMode = OUTPUT, pinValue = Just (Left newValue)}(pinStates bst)}
     (BoardState, (Word8, Word8)) -> IO (BoardState, (Word8, Word8))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (BoardState
bst', (Word8
lsb, Word8
msb))

-- | Keep track of listeners on a digital message
digitalWakeUp :: MVar () -> Arduino ()
digitalWakeUp :: MVar () -> Arduino ()
digitalWakeUp MVar ()
semaphore = do
    MVar BoardState
bs <- (ArduinoState -> MVar BoardState) -> Arduino (MVar BoardState)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ArduinoState -> MVar BoardState
boardState
    IO () -> Arduino ()
forall a. IO a -> Arduino a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Arduino ()) -> IO () -> Arduino ()
forall a b. (a -> b) -> a -> b
$ MVar BoardState -> (BoardState -> IO BoardState) -> IO ()
forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVar_ MVar BoardState
bs ((BoardState -> IO BoardState) -> IO ())
-> (BoardState -> IO BoardState) -> IO ()
forall a b. (a -> b) -> a -> b
$ \BoardState
bst -> BoardState -> IO BoardState
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return BoardState
bst{digitalWakeUpQueue = semaphore : digitalWakeUpQueue bst}

-- | Firmata commands, see: http://firmata.org/wiki/Protocol#Message_Types
data FirmataCmd = ANALOG_MESSAGE      IPin -- ^ @0xE0@ pin
                | DIGITAL_MESSAGE     Port -- ^ @0x90@ port
                | REPORT_ANALOG_PIN   IPin -- ^ @0xC0@ pin
                | REPORT_DIGITAL_PORT Port -- ^ @0xD0@ port
                | START_SYSEX              -- ^ @0xF0@
                | SET_PIN_MODE             -- ^ @0xF4@
                | END_SYSEX                -- ^ @0xF7@
                | PROTOCOL_VERSION         -- ^ @0xF9@
                | SYSTEM_RESET             -- ^ @0xFF@
                deriving Int -> FirmataCmd -> ShowS
[FirmataCmd] -> ShowS
FirmataCmd -> String
(Int -> FirmataCmd -> ShowS)
-> (FirmataCmd -> String)
-> ([FirmataCmd] -> ShowS)
-> Show FirmataCmd
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FirmataCmd -> ShowS
showsPrec :: Int -> FirmataCmd -> ShowS
$cshow :: FirmataCmd -> String
show :: FirmataCmd -> String
$cshowList :: [FirmataCmd] -> ShowS
showList :: [FirmataCmd] -> ShowS
Show

-- | Compute the numeric value of a command
firmataCmdVal :: FirmataCmd -> Word8
firmataCmdVal :: FirmataCmd -> Word8
firmataCmdVal (ANALOG_MESSAGE      IPin
p) = Word8
0xE0 Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. IPin -> Word8
pinNo  IPin
p
firmataCmdVal (DIGITAL_MESSAGE     Port
p) = Word8
0x90 Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. Port -> Word8
portNo Port
p
firmataCmdVal (REPORT_ANALOG_PIN   IPin
p) = Word8
0xC0 Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. IPin -> Word8
pinNo  IPin
p
firmataCmdVal (REPORT_DIGITAL_PORT Port
p) = Word8
0xD0 Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. Port -> Word8
portNo Port
p
firmataCmdVal FirmataCmd
START_SYSEX             = Word8
0xF0
firmataCmdVal FirmataCmd
SET_PIN_MODE            = Word8
0xF4
firmataCmdVal FirmataCmd
END_SYSEX               = Word8
0xF7
firmataCmdVal FirmataCmd
PROTOCOL_VERSION        = Word8
0xF9
firmataCmdVal FirmataCmd
SYSTEM_RESET            = Word8
0xFF

-- | Convert a byte to a Firmata command
getFirmataCmd :: Word8 -> Either Word8 FirmataCmd
getFirmataCmd :: Word8 -> Either Word8 FirmataCmd
getFirmataCmd Word8
w = Either Word8 FirmataCmd
classify
  where extract :: Word8 -> Maybe a
extract Word8
m | Word8
w Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
m Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
m = a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> a -> Maybe a
forall a b. (a -> b) -> a -> b
$ Word8 -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8
w Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0x0F)
                  | Bool
True         = Maybe a
forall a. Maybe a
Nothing
        classify :: Either Word8 FirmataCmd
classify | Word8
w Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0xF0              = FirmataCmd -> Either Word8 FirmataCmd
forall a b. b -> Either a b
Right FirmataCmd
START_SYSEX
                 | Word8
w Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0xF4              = FirmataCmd -> Either Word8 FirmataCmd
forall a b. b -> Either a b
Right FirmataCmd
SET_PIN_MODE
                 | Word8
w Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0xF7              = FirmataCmd -> Either Word8 FirmataCmd
forall a b. b -> Either a b
Right FirmataCmd
END_SYSEX
                 | Word8
w Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0xF9              = FirmataCmd -> Either Word8 FirmataCmd
forall a b. b -> Either a b
Right FirmataCmd
PROTOCOL_VERSION
                 | Word8
w Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0xFF              = FirmataCmd -> Either Word8 FirmataCmd
forall a b. b -> Either a b
Right FirmataCmd
SYSTEM_RESET
                 | Just Word8
i <- Word8 -> Maybe Word8
forall {a}. Num a => Word8 -> Maybe a
extract Word8
0xE0 = FirmataCmd -> Either Word8 FirmataCmd
forall a b. b -> Either a b
Right (FirmataCmd -> Either Word8 FirmataCmd)
-> FirmataCmd -> Either Word8 FirmataCmd
forall a b. (a -> b) -> a -> b
$ IPin -> FirmataCmd
ANALOG_MESSAGE      (Word8 -> IPin
InternalPin Word8
i)
                 | Just Word8
i <- Word8 -> Maybe Word8
forall {a}. Num a => Word8 -> Maybe a
extract Word8
0x90 = FirmataCmd -> Either Word8 FirmataCmd
forall a b. b -> Either a b
Right (FirmataCmd -> Either Word8 FirmataCmd)
-> FirmataCmd -> Either Word8 FirmataCmd
forall a b. (a -> b) -> a -> b
$ Port -> FirmataCmd
DIGITAL_MESSAGE     (Word8 -> Port
Port Word8
i)
                 | Just Word8
i <- Word8 -> Maybe Word8
forall {a}. Num a => Word8 -> Maybe a
extract Word8
0xC0 = FirmataCmd -> Either Word8 FirmataCmd
forall a b. b -> Either a b
Right (FirmataCmd -> Either Word8 FirmataCmd)
-> FirmataCmd -> Either Word8 FirmataCmd
forall a b. (a -> b) -> a -> b
$ IPin -> FirmataCmd
REPORT_ANALOG_PIN   (Word8 -> IPin
InternalPin Word8
i)
                 | Just Word8
i <- Word8 -> Maybe Word8
forall {a}. Num a => Word8 -> Maybe a
extract Word8
0xD0 = FirmataCmd -> Either Word8 FirmataCmd
forall a b. b -> Either a b
Right (FirmataCmd -> Either Word8 FirmataCmd)
-> FirmataCmd -> Either Word8 FirmataCmd
forall a b. (a -> b) -> a -> b
$ Port -> FirmataCmd
REPORT_DIGITAL_PORT (Word8 -> Port
Port Word8
i)
                 | Bool
True                   = Word8 -> Either Word8 FirmataCmd
forall a b. a -> Either a b
Left Word8
w

-- | Sys-ex commands, see: http://firmata.org/wiki/Protocol#Sysex_Message_Format
data SysExCmd = RESERVED_COMMAND        -- ^ @0x00@  2nd SysEx data byte is a chip-specific command (AVR, PIC, TI, etc).
              | ANALOG_MAPPING_QUERY    -- ^ @0x69@  ask for mapping of analog to pin numbers
              | ANALOG_MAPPING_RESPONSE -- ^ @0x6A@  reply with mapping info
              | CAPABILITY_QUERY        -- ^ @0x6B@  ask for supported modes and resolution of all pins
              | CAPABILITY_RESPONSE     -- ^ @0x6C@  reply with supported modes and resolution
              | PIN_STATE_QUERY         -- ^ @0x6D@  ask for a pin's current mode and value
              | PIN_STATE_RESPONSE      -- ^ @0x6E@  reply with a pin's current mode and value
              | EXTENDED_ANALOG         -- ^ @0x6F@  analog write (PWM, Servo, etc) to any pin
              | SERVO_CONFIG            -- ^ @0x70@  set max angle, minPulse, maxPulse, freq
              | STRING_DATA             -- ^ @0x71@  a string message with 14-bits per char
              | PULSE                   -- ^ @0x74@  Pulse, see: https://github.com/rwldrn/johnny-five/issues/18
              | SHIFT_DATA              -- ^ @0x75@  shiftOut config/data message (34 bits)
              | I2C_REQUEST             -- ^ @0x76@  I2C request messages from a host to an I/O board
              | I2C_REPLY               -- ^ @0x77@  I2C reply messages from an I/O board to a host
              | I2C_CONFIG              -- ^ @0x78@  Configure special I2C settings such as power pins and delay times
              | REPORT_FIRMWARE         -- ^ @0x79@  report name and version of the firmware
              | SAMPLING_INTERVAL       -- ^ @0x7A@  sampling interval
              | SYSEX_NON_REALTIME      -- ^ @0x7E@  MIDI Reserved for non-realtime messages
              | SYSEX_REALTIME          -- ^ @0x7F@  MIDI Reserved for realtime messages
              deriving Int -> SysExCmd -> ShowS
[SysExCmd] -> ShowS
SysExCmd -> String
(Int -> SysExCmd -> ShowS)
-> (SysExCmd -> String) -> ([SysExCmd] -> ShowS) -> Show SysExCmd
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SysExCmd -> ShowS
showsPrec :: Int -> SysExCmd -> ShowS
$cshow :: SysExCmd -> String
show :: SysExCmd -> String
$cshowList :: [SysExCmd] -> ShowS
showList :: [SysExCmd] -> ShowS
Show

-- | Convert a 'SysExCmd' to a byte
sysExCmdVal :: SysExCmd -> Word8
sysExCmdVal :: SysExCmd -> Word8
sysExCmdVal SysExCmd
RESERVED_COMMAND        = Word8
0x00
sysExCmdVal SysExCmd
ANALOG_MAPPING_QUERY    = Word8
0x69
sysExCmdVal SysExCmd
ANALOG_MAPPING_RESPONSE = Word8
0x6A
sysExCmdVal SysExCmd
CAPABILITY_QUERY        = Word8
0x6B
sysExCmdVal SysExCmd
CAPABILITY_RESPONSE     = Word8
0x6C
sysExCmdVal SysExCmd
PIN_STATE_QUERY         = Word8
0x6D
sysExCmdVal SysExCmd
PIN_STATE_RESPONSE      = Word8
0x6E
sysExCmdVal SysExCmd
EXTENDED_ANALOG         = Word8
0x6F
sysExCmdVal SysExCmd
SERVO_CONFIG            = Word8
0x70
sysExCmdVal SysExCmd
STRING_DATA             = Word8
0x71
sysExCmdVal SysExCmd
PULSE                   = Word8
0x74
sysExCmdVal SysExCmd
SHIFT_DATA              = Word8
0x75
sysExCmdVal SysExCmd
I2C_REQUEST             = Word8
0x76
sysExCmdVal SysExCmd
I2C_REPLY               = Word8
0x77
sysExCmdVal SysExCmd
I2C_CONFIG              = Word8
0x78
sysExCmdVal SysExCmd
REPORT_FIRMWARE         = Word8
0x79
sysExCmdVal SysExCmd
SAMPLING_INTERVAL       = Word8
0x7A
sysExCmdVal SysExCmd
SYSEX_NON_REALTIME      = Word8
0x7E
sysExCmdVal SysExCmd
SYSEX_REALTIME          = Word8
0x7F

-- | Convert a byte into a 'SysExCmd'
getSysExCommand :: Word8 -> Either Word8 SysExCmd
getSysExCommand :: Word8 -> Either Word8 SysExCmd
getSysExCommand Word8
0x00 = SysExCmd -> Either Word8 SysExCmd
forall a b. b -> Either a b
Right SysExCmd
RESERVED_COMMAND
getSysExCommand Word8
0x69 = SysExCmd -> Either Word8 SysExCmd
forall a b. b -> Either a b
Right SysExCmd
ANALOG_MAPPING_QUERY
getSysExCommand Word8
0x6A = SysExCmd -> Either Word8 SysExCmd
forall a b. b -> Either a b
Right SysExCmd
ANALOG_MAPPING_RESPONSE
getSysExCommand Word8
0x6B = SysExCmd -> Either Word8 SysExCmd
forall a b. b -> Either a b
Right SysExCmd
CAPABILITY_QUERY
getSysExCommand Word8
0x6C = SysExCmd -> Either Word8 SysExCmd
forall a b. b -> Either a b
Right SysExCmd
CAPABILITY_RESPONSE
getSysExCommand Word8
0x6D = SysExCmd -> Either Word8 SysExCmd
forall a b. b -> Either a b
Right SysExCmd
PIN_STATE_QUERY
getSysExCommand Word8
0x6E = SysExCmd -> Either Word8 SysExCmd
forall a b. b -> Either a b
Right SysExCmd
PIN_STATE_RESPONSE
getSysExCommand Word8
0x6F = SysExCmd -> Either Word8 SysExCmd
forall a b. b -> Either a b
Right SysExCmd
EXTENDED_ANALOG
getSysExCommand Word8
0x70 = SysExCmd -> Either Word8 SysExCmd
forall a b. b -> Either a b
Right SysExCmd
SERVO_CONFIG
getSysExCommand Word8
0x71 = SysExCmd -> Either Word8 SysExCmd
forall a b. b -> Either a b
Right SysExCmd
STRING_DATA
getSysExCommand Word8
0x75 = SysExCmd -> Either Word8 SysExCmd
forall a b. b -> Either a b
Right SysExCmd
SHIFT_DATA
getSysExCommand Word8
0x76 = SysExCmd -> Either Word8 SysExCmd
forall a b. b -> Either a b
Right SysExCmd
I2C_REQUEST
getSysExCommand Word8
0x77 = SysExCmd -> Either Word8 SysExCmd
forall a b. b -> Either a b
Right SysExCmd
I2C_REPLY
getSysExCommand Word8
0x78 = SysExCmd -> Either Word8 SysExCmd
forall a b. b -> Either a b
Right SysExCmd
I2C_CONFIG
getSysExCommand Word8
0x79 = SysExCmd -> Either Word8 SysExCmd
forall a b. b -> Either a b
Right SysExCmd
REPORT_FIRMWARE
getSysExCommand Word8
0x7A = SysExCmd -> Either Word8 SysExCmd
forall a b. b -> Either a b
Right SysExCmd
SAMPLING_INTERVAL
getSysExCommand Word8
0x7E = SysExCmd -> Either Word8 SysExCmd
forall a b. b -> Either a b
Right SysExCmd
SYSEX_NON_REALTIME
getSysExCommand Word8
0x7F = SysExCmd -> Either Word8 SysExCmd
forall a b. b -> Either a b
Right SysExCmd
SYSEX_REALTIME
getSysExCommand Word8
0x74 = SysExCmd -> Either Word8 SysExCmd
forall a b. b -> Either a b
Right SysExCmd
PULSE
getSysExCommand Word8
n    = Word8 -> Either Word8 SysExCmd
forall a b. a -> Either a b
Left Word8
n

-- | Keep track of pin-mode changes
registerPinMode :: IPin -> PinMode -> Arduino [Request]
registerPinMode :: IPin -> PinMode -> Arduino [Request]
registerPinMode IPin
p PinMode
m = do
        -- first check that the requested mode is supported for this pin
        BoardCapabilities Map IPin PinCapabilities
caps <- (ArduinoState -> BoardCapabilities) -> Arduino BoardCapabilities
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ArduinoState -> BoardCapabilities
capabilities
        case IPin
p IPin -> Map IPin PinCapabilities -> Maybe PinCapabilities
forall k a. Ord k => k -> Map k a -> Maybe a
`M.lookup` Map IPin PinCapabilities
caps of
          Maybe PinCapabilities
Nothing
             -> String -> [String] -> Arduino ()
forall a. String -> [String] -> Arduino a
die (String
"Invalid access to unsupported pin: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ IPin -> String
forall a. Show a => a -> String
show IPin
p)
                    (String
"Available pins are: " String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String
"  " String -> ShowS
forall a. [a] -> [a] -> [a]
++ IPin -> String
forall a. Show a => a -> String
show IPin
k | (IPin
k, PinCapabilities
_) <- Map IPin PinCapabilities -> [(IPin, PinCapabilities)]
forall k a. Map k a -> [(k, a)]
M.toAscList Map IPin PinCapabilities
caps])
          Just PinCapabilities{[(PinMode, Word8)]
allowedModes :: PinCapabilities -> [(PinMode, Word8)]
allowedModes :: [(PinMode, Word8)]
allowedModes}
            | PinMode
m PinMode -> [PinMode] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` ((PinMode, Word8) -> PinMode) -> [(PinMode, Word8)] -> [PinMode]
forall a b. (a -> b) -> [a] -> [b]
map (PinMode, Word8) -> PinMode
forall a b. (a, b) -> a
fst [(PinMode, Word8)]
allowedModes
            -> String -> [String] -> Arduino ()
forall a. String -> [String] -> Arduino a
die (String
"Invalid mode " String -> ShowS
forall a. [a] -> [a] -> [a]
++ PinMode -> String
forall a. Show a => a -> String
show PinMode
m String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" set for " String -> ShowS
forall a. [a] -> [a] -> [a]
++ IPin -> String
forall a. Show a => a -> String
show IPin
p)
                   [String
"Supported modes for this pin are: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
unwords (if [(PinMode, Word8)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(PinMode, Word8)]
allowedModes then [String
"NONE"] else ((PinMode, Word8) -> String) -> [(PinMode, Word8)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (PinMode, Word8) -> String
forall a. Show a => a -> String
show [(PinMode, Word8)]
allowedModes)]
          Maybe PinCapabilities
_ -> () -> Arduino ()
forall a. a -> Arduino a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        -- see if there was a mode already set for this pin
        MVar BoardState
bs  <- (ArduinoState -> MVar BoardState) -> Arduino (MVar BoardState)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ArduinoState -> MVar BoardState
boardState
        Maybe PinMode
mbOldMode <- IO (Maybe PinMode) -> Arduino (Maybe PinMode)
forall a. IO a -> Arduino a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe PinMode) -> Arduino (Maybe PinMode))
-> IO (Maybe PinMode) -> Arduino (Maybe PinMode)
forall a b. (a -> b) -> a -> b
$ MVar BoardState
-> (BoardState -> IO (Maybe PinMode)) -> IO (Maybe PinMode)
forall a b. MVar a -> (a -> IO b) -> IO b
withMVar MVar BoardState
bs ((BoardState -> IO (Maybe PinMode)) -> IO (Maybe PinMode))
-> (BoardState -> IO (Maybe PinMode)) -> IO (Maybe PinMode)
forall a b. (a -> b) -> a -> b
$ \BoardState
bst ->
                                case IPin
p IPin -> Map IPin PinData -> Maybe PinData
forall k a. Ord k => k -> Map k a -> Maybe a
`M.lookup` BoardState -> Map IPin PinData
pinStates BoardState
bst of
                                  Maybe PinData
Nothing -> Maybe PinMode -> IO (Maybe PinMode)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe PinMode
forall a. Maybe a
Nothing -- completely new, register
                                  Just PinData
pd -> Maybe PinMode -> IO (Maybe PinMode)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe PinMode -> IO (Maybe PinMode))
-> Maybe PinMode -> IO (Maybe PinMode)
forall a b. (a -> b) -> a -> b
$ PinMode -> Maybe PinMode
forall a. a -> Maybe a
Just (PinMode -> Maybe PinMode) -> PinMode -> Maybe PinMode
forall a b. (a -> b) -> a -> b
$ PinData -> PinMode
pinMode PinData
pd
        -- depending on old/new mode, determine what actions to take
        let registerNewMode :: IO ()
registerNewMode = MVar BoardState -> (BoardState -> IO BoardState) -> IO ()
forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVar_ MVar BoardState
bs ((BoardState -> IO BoardState) -> IO ())
-> (BoardState -> IO BoardState) -> IO ()
forall a b. (a -> b) -> a -> b
$ \BoardState
bst -> BoardState -> IO BoardState
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return BoardState
bst{pinStates = M.insert p PinData{pinMode = m, pinValue = Nothing} (pinStates bst) }
        case Maybe PinMode
mbOldMode of
          Maybe PinMode
Nothing -> do IO () -> Arduino ()
forall a. IO a -> Arduino a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO ()
registerNewMode
                        IPin -> PinMode -> Arduino [Request]
getModeActions IPin
p PinMode
m
          Just PinMode
m' | PinMode
m PinMode -> PinMode -> Bool
forall a. Eq a => a -> a -> Bool
== PinMode
m' -> [Request] -> Arduino [Request]
forall a. a -> Arduino a
forall (m :: * -> *) a. Monad m => a -> m a
return []  -- no mode change, nothing to do
                  | Bool
True    -> do IO () -> Arduino ()
forall a. IO a -> Arduino a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO ()
registerNewMode
                                  [Request]
remActs <- IPin -> PinMode -> Arduino [Request]
getRemovalActions IPin
p PinMode
m'
                                  [Request]
addActs <- IPin -> PinMode -> Arduino [Request]
getModeActions IPin
p PinMode
m
                                  [Request] -> Arduino [Request]
forall a. a -> Arduino a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Request] -> Arduino [Request]) -> [Request] -> Arduino [Request]
forall a b. (a -> b) -> a -> b
$ [Request]
remActs [Request] -> [Request] -> [Request]
forall a. [a] -> [a] -> [a]
++ [Request]
addActs

-- | A mode was removed from this pin, update internal state and determine any necessary actions to remove it
getRemovalActions :: IPin -> PinMode -> Arduino [Request]
getRemovalActions :: IPin -> PinMode -> Arduino [Request]
getRemovalActions IPin
p PinMode
INPUT  = do -- This pin is no longer digital input
        MVar BoardState
bs <- (ArduinoState -> MVar BoardState) -> Arduino (MVar BoardState)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ArduinoState -> MVar BoardState
boardState
        IO [Request] -> Arduino [Request]
forall a. IO a -> Arduino a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Request] -> Arduino [Request])
-> IO [Request] -> Arduino [Request]
forall a b. (a -> b) -> a -> b
$ MVar BoardState
-> (BoardState -> IO (BoardState, [Request])) -> IO [Request]
forall a b. MVar a -> (a -> IO (a, b)) -> IO b
modifyMVar MVar BoardState
bs ((BoardState -> IO (BoardState, [Request])) -> IO [Request])
-> (BoardState -> IO (BoardState, [Request])) -> IO [Request]
forall a b. (a -> b) -> a -> b
$ \BoardState
bst -> do
                let dPins :: Set IPin
dPins = IPin
p IPin -> Set IPin -> Set IPin
forall a. Ord a => a -> Set a -> Set a
`S.delete` BoardState -> Set IPin
digitalReportingPins BoardState
bst
                    port :: Port
port  = IPin -> Port
pinPort IPin
p
                    acts :: [Request]
acts  = [Port -> Bool -> Request
DigitalReport Port
port Bool
False | Port
port Port -> [Port] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` (IPin -> Port) -> [IPin] -> [Port]
forall a b. (a -> b) -> [a] -> [b]
map IPin -> Port
pinPort (Set IPin -> [IPin]
forall a. Set a -> [a]
S.elems Set IPin
dPins)]   -- no need for a digital report on this port anymore
                    bst' :: BoardState
bst'  = BoardState
bst { digitalReportingPins = dPins }
                (BoardState, [Request]) -> IO (BoardState, [Request])
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (BoardState
bst', [Request]
acts)
getRemovalActions IPin
p PinMode
ANALOG = do -- This pin is no longer analog
        MVar BoardState
bs <- (ArduinoState -> MVar BoardState) -> Arduino (MVar BoardState)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ArduinoState -> MVar BoardState
boardState
        IO [Request] -> Arduino [Request]
forall a. IO a -> Arduino a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Request] -> Arduino [Request])
-> IO [Request] -> Arduino [Request]
forall a b. (a -> b) -> a -> b
$ MVar BoardState
-> (BoardState -> IO (BoardState, [Request])) -> IO [Request]
forall a b. MVar a -> (a -> IO (a, b)) -> IO b
modifyMVar MVar BoardState
bs ((BoardState -> IO (BoardState, [Request])) -> IO [Request])
-> (BoardState -> IO (BoardState, [Request])) -> IO [Request]
forall a b. (a -> b) -> a -> b
$ \BoardState
bst -> do
                let aPins :: Set IPin
aPins = BoardState -> Set IPin
analogReportingPins BoardState
bst
                    acts :: [Request]
acts  = [IPin -> Bool -> Request
AnalogReport IPin
p Bool
False | IPin
p IPin -> Set IPin -> Bool
forall a. Ord a => a -> Set a -> Bool
`S.member` Set IPin
aPins] -- no need for an analog report on this port anymore
                    bst' :: BoardState
bst'  = BoardState
bst { analogReportingPins = p `S.delete` aPins }
                (BoardState, [Request]) -> IO (BoardState, [Request])
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (BoardState
bst', [Request]
acts)
getRemovalActions IPin
_ PinMode
OUTPUT = [Request] -> Arduino [Request]
forall a. a -> Arduino a
forall (m :: * -> *) a. Monad m => a -> m a
return []
getRemovalActions IPin
p PinMode
m = String -> [String] -> Arduino [Request]
forall a. String -> [String] -> Arduino a
die (String
"hArduino: getRemovalActions: TBD: Unsupported mode: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ PinMode -> String
forall a. Show a => a -> String
show PinMode
m) [String
"On pin " String -> ShowS
forall a. [a] -> [a] -> [a]
++ IPin -> String
forall a. Show a => a -> String
show IPin
p]

-- | Depending on a mode-set call, determine what further
-- actions should be executed, such as enabling/disabling pin/port reporting
getModeActions :: IPin -> PinMode -> Arduino [Request]
getModeActions :: IPin -> PinMode -> Arduino [Request]
getModeActions IPin
p PinMode
INPUT  = do -- This pin is just configured for digital input
        MVar BoardState
bs <- (ArduinoState -> MVar BoardState) -> Arduino (MVar BoardState)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ArduinoState -> MVar BoardState
boardState
        IO [Request] -> Arduino [Request]
forall a. IO a -> Arduino a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Request] -> Arduino [Request])
-> IO [Request] -> Arduino [Request]
forall a b. (a -> b) -> a -> b
$ MVar BoardState
-> (BoardState -> IO (BoardState, [Request])) -> IO [Request]
forall a b. MVar a -> (a -> IO (a, b)) -> IO b
modifyMVar MVar BoardState
bs ((BoardState -> IO (BoardState, [Request])) -> IO [Request])
-> (BoardState -> IO (BoardState, [Request])) -> IO [Request]
forall a b. (a -> b) -> a -> b
$ \BoardState
bst -> do
                    let aPins :: Set IPin
aPins = BoardState -> Set IPin
analogReportingPins BoardState
bst
                        dPins :: Set IPin
dPins = BoardState -> Set IPin
digitalReportingPins BoardState
bst
                        port :: Port
port  = IPin -> Port
pinPort IPin
p
                        acts1 :: [Request]
acts1 = [IPin -> Bool -> Request
AnalogReport  IPin
p    Bool
False | IPin
p    IPin -> Set IPin -> Bool
forall a. Ord a => a -> Set a -> Bool
`S.member` Set IPin
aPins]                       -- there was an analog report, remove it
                        acts2 :: [Request]
acts2 = [Port -> Bool -> Request
DigitalReport Port
port Bool
True  | Port
port Port -> [Port] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem`  (IPin -> Port) -> [IPin] -> [Port]
forall a b. (a -> b) -> [a] -> [b]
map IPin -> Port
pinPort (Set IPin -> [IPin]
forall a. Set a -> [a]
S.elems Set IPin
dPins)] -- there was no digital report, add it
                        bst' :: BoardState
bst' = BoardState
bst { analogReportingPins  = p `S.delete` analogReportingPins  bst
                                   , digitalReportingPins = p `S.insert` digitalReportingPins bst
                                   }
                    (BoardState, [Request]) -> IO (BoardState, [Request])
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (BoardState
bst', [Request]
acts1 [Request] -> [Request] -> [Request]
forall a. [a] -> [a] -> [a]
++ [Request]
acts2)
getModeActions IPin
p PinMode
ANALOG = do -- This pin just configured for analog
        MVar BoardState
bs <- (ArduinoState -> MVar BoardState) -> Arduino (MVar BoardState)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ArduinoState -> MVar BoardState
boardState
        IO [Request] -> Arduino [Request]
forall a. IO a -> Arduino a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Request] -> Arduino [Request])
-> IO [Request] -> Arduino [Request]
forall a b. (a -> b) -> a -> b
$ MVar BoardState
-> (BoardState -> IO (BoardState, [Request])) -> IO [Request]
forall a b. MVar a -> (a -> IO (a, b)) -> IO b
modifyMVar MVar BoardState
bs ((BoardState -> IO (BoardState, [Request])) -> IO [Request])
-> (BoardState -> IO (BoardState, [Request])) -> IO [Request]
forall a b. (a -> b) -> a -> b
$ \BoardState
bst -> do
                    let aPins :: Set IPin
aPins = BoardState -> Set IPin
analogReportingPins BoardState
bst
                        dPins :: Set IPin
dPins = IPin
p IPin -> Set IPin -> Set IPin
forall a. Ord a => a -> Set a -> Set a
`S.delete` BoardState -> Set IPin
digitalReportingPins BoardState
bst
                        port :: Port
port  = IPin -> Port
pinPort IPin
p
                        acts1 :: [Request]
acts1 = [IPin -> Bool -> Request
AnalogReport  IPin
p    Bool
True  | IPin
p    IPin -> Set IPin -> Bool
forall a. Ord a => a -> Set a -> Bool
`S.notMember` Set IPin
aPins]                       -- there was no analog report, add it
                        acts2 :: [Request]
acts2 = [Port -> Bool -> Request
DigitalReport Port
port Bool
False | Port
port Port -> [Port] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem`     (IPin -> Port) -> [IPin] -> [Port]
forall a b. (a -> b) -> [a] -> [b]
map IPin -> Port
pinPort (Set IPin -> [IPin]
forall a. Set a -> [a]
S.elems Set IPin
dPins)] -- no need for a digital report, remove it
                        bst' :: BoardState
bst' = BoardState
bst { analogReportingPins  = p `S.insert` analogReportingPins  bst
                                   , digitalReportingPins = dPins
                                   }
                    (BoardState, [Request]) -> IO (BoardState, [Request])
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (BoardState
bst', [Request]
acts1 [Request] -> [Request] -> [Request]
forall a. [a] -> [a] -> [a]
++ [Request]
acts2)
getModeActions IPin
_ PinMode
PWM    = [Request] -> Arduino [Request]
forall a. a -> Arduino a
forall (m :: * -> *) a. Monad m => a -> m a
return []
getModeActions IPin
_ PinMode
OUTPUT = [Request] -> Arduino [Request]
forall a. a -> Arduino a
forall (m :: * -> *) a. Monad m => a -> m a
return []
getModeActions IPin
_ PinMode
SERVO  = [Request] -> Arduino [Request]
forall a. a -> Arduino a
forall (m :: * -> *) a. Monad m => a -> m a
return []
getModeActions IPin
p PinMode
m      = String -> [String] -> Arduino [Request]
forall a. String -> [String] -> Arduino a
die (String
"hArduino: getModeActions: TBD: Unsupported mode: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ PinMode -> String
forall a. Show a => a -> String
show PinMode
m) [String
"On pin " String -> ShowS
forall a. [a] -> [a] -> [a]
++ IPin -> String
forall a. Show a => a -> String
show IPin
p]

-- | On the arduino, digital pin numbers are in 1-to-1 match with
-- the board pins. However, ANALOG pins come at an offset, determined by
-- the capabilities query. Users of the library refer to these pins
-- simply by their natural numbers, which makes for portable programs
-- between boards that have different number of digital pins. We adjust
-- for this shift here.
getInternalPin :: Pin -> Arduino IPin
getInternalPin :: Pin -> Arduino IPin
getInternalPin (MixedPin Word8
p)   = IPin -> Arduino IPin
forall a. a -> Arduino a
forall (m :: * -> *) a. Monad m => a -> m a
return (IPin -> Arduino IPin) -> IPin -> Arduino IPin
forall a b. (a -> b) -> a -> b
$ Word8 -> IPin
InternalPin Word8
p
getInternalPin (DigitalPin Word8
p) = IPin -> Arduino IPin
forall a. a -> Arduino a
forall (m :: * -> *) a. Monad m => a -> m a
return (IPin -> Arduino IPin) -> IPin -> Arduino IPin
forall a b. (a -> b) -> a -> b
$ Word8 -> IPin
InternalPin Word8
p
getInternalPin (AnalogPin Word8
p)
  = do BoardCapabilities Map IPin PinCapabilities
caps <- (ArduinoState -> BoardCapabilities) -> Arduino BoardCapabilities
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ArduinoState -> BoardCapabilities
capabilities
       case [IPin] -> Maybe IPin
forall a. [a] -> Maybe a
listToMaybe [IPin
realPin | (IPin
realPin, PinCapabilities{analogPinNumber :: PinCapabilities -> Maybe Word8
analogPinNumber = Just Word8
n}) <- Map IPin PinCapabilities -> [(IPin, PinCapabilities)]
forall k a. Map k a -> [(k, a)]
M.toAscList Map IPin PinCapabilities
caps, Word8
p Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
n] of
         Maybe IPin
Nothing -> String -> [String] -> Arduino IPin
forall a. String -> [String] -> Arduino a
die (String
"hArduino: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word8 -> String
forall a. Show a => a -> String
show Word8
p String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" is not a valid analog-pin on this board.")
                        -- Try to be helpful in case they are trying to use a large value thinking it needs to be offset
                        [String
"Hint: To refer to analog pin number k, simply use 'pin k', not 'pin (k+noOfDigitalPins)'" | Word8
p Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
> Word8
13]
         Just IPin
rp -> IPin -> Arduino IPin
forall a. a -> Arduino a
forall (m :: * -> *) a. Monad m => a -> m a
return IPin
rp

-- | Similar to getInternalPin above, except also makes sure the pin is in a required mode.
convertAndCheckPin :: String -> Pin -> PinMode -> Arduino (IPin, PinData)
convertAndCheckPin :: String -> Pin -> PinMode -> Arduino (IPin, PinData)
convertAndCheckPin String
what Pin
p' PinMode
m = do
   IPin
p <- Pin -> Arduino IPin
getInternalPin Pin
p'
   PinData
pd <- IPin -> Arduino PinData
getPinData IPin
p
   let user :: Word8
user = Pin -> Word8
userPinNo Pin
p'
       board :: Word8
board = IPin -> Word8
pinNo IPin
p
       bInfo :: String
bInfo
         | Word8
user Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
board = String
""
         | Bool
True          = String
" (On board " String -> ShowS
forall a. [a] -> [a] -> [a]
++ IPin -> String
forall a. Show a => a -> String
show IPin
p String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")"
   Bool -> Arduino () -> Arduino ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (PinData -> PinMode
pinMode PinData
pd PinMode -> PinMode -> Bool
forall a. Eq a => a -> a -> Bool
/= PinMode
m) (Arduino () -> Arduino ()) -> Arduino () -> Arduino ()
forall a b. (a -> b) -> a -> b
$ String -> [String] -> Arduino ()
forall a. String -> [String] -> Arduino a
die (String
"Invalid " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
what String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" call on pin " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Pin -> String
forall a. Show a => a -> String
show Pin
p' String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
bInfo)
                                [ String
"The current mode for this pin is: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ PinMode -> String
forall a. Show a => a -> String
show (PinData -> PinMode
pinMode PinData
pd)
                                , String
"For " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
what String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
", it must be set to: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ PinMode -> String
forall a. Show a => a -> String
show PinMode
m
                                , String
"via a proper call to setPinMode"
                                ]
   (IPin, PinData) -> Arduino (IPin, PinData)
forall a. a -> Arduino a
forall (m :: * -> *) a. Monad m => a -> m a
return (IPin
p, PinData
pd)