{-# 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)
newtype Port = Port { Port -> Word8
portNo :: Word8
}
deriving (Port -> Port -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Port -> Port -> Bool
$c/= :: Port -> Port -> Bool
== :: Port -> Port -> Bool
$c== :: Port -> Port -> Bool
Eq, Eq 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
min :: Port -> Port -> Port
$cmin :: Port -> Port -> Port
max :: Port -> Port -> Port
$cmax :: Port -> Port -> Port
>= :: Port -> Port -> Bool
$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
compare :: Port -> Port -> Ordering
$ccompare :: Port -> Port -> Ordering
Ord)
instance Show Port where
show :: Port -> String
show Port
p = String
"Port" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (Port -> Word8
portNo Port
p)
data Pin = DigitalPin {Pin -> Word8
userPinNo :: Word8}
| AnalogPin {userPinNo :: Word8}
| MixedPin {userPinNo :: Word8}
instance Show Pin where
show :: Pin -> String
show (DigitalPin Word8
w) = String
"DPin" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Word8
w
show (AnalogPin Word8
w) = String
"APin" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Word8
w
show (MixedPin Word8
w) = String
"Pin" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Word8
w
newtype IPin = InternalPin { IPin -> Word8
pinNo :: Word8 }
deriving (IPin -> IPin -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IPin -> IPin -> Bool
$c/= :: IPin -> IPin -> Bool
== :: IPin -> IPin -> Bool
$c== :: IPin -> IPin -> Bool
Eq, Eq 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
min :: IPin -> IPin -> IPin
$cmin :: IPin -> IPin -> IPin
max :: IPin -> IPin -> IPin
$cmax :: IPin -> IPin -> IPin
>= :: IPin -> IPin -> Bool
$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
compare :: IPin -> IPin -> Ordering
$ccompare :: IPin -> IPin -> Ordering
Ord)
instance Show IPin where
show :: IPin -> String
show (InternalPin Word8
w) = String
"IPin" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Word8
w
pin :: Word8 -> Pin
pin :: Word8 -> Pin
pin = Word8 -> Pin
MixedPin
digital :: Word8 -> Pin
digital :: Word8 -> Pin
digital = Word8 -> Pin
DigitalPin
analog :: Word8 -> Pin
analog :: Word8 -> Pin
analog = Word8 -> Pin
AnalogPin
pinPort :: IPin -> Port
pinPort :: IPin -> Port
pinPort IPin
p = Word8 -> Port
Port (IPin -> Word8
pinNo IPin
p forall a. Integral a => a -> a -> a
`quot` Word8
8)
pinPortIndex :: IPin -> Word8
pinPortIndex :: IPin -> Word8
pinPortIndex IPin
p = IPin -> Word8
pinNo IPin
p forall a. Integral a => a -> a -> a
`rem` Word8
8
data PinMode = INPUT
| OUTPUT
| ANALOG
| PWM
| SERVO
| SHIFT
| I2C
| ONEWIRE
| STEPPER
| ENCODER
| SERIAL
| PULLUP
| UNSUPPORTED
deriving (PinMode -> PinMode -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PinMode -> PinMode -> Bool
$c/= :: PinMode -> PinMode -> Bool
== :: PinMode -> PinMode -> Bool
$c== :: PinMode -> PinMode -> Bool
Eq, Int -> PinMode -> ShowS
[PinMode] -> ShowS
PinMode -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PinMode] -> ShowS
$cshowList :: [PinMode] -> ShowS
show :: PinMode -> String
$cshow :: PinMode -> String
showsPrec :: Int -> PinMode -> ShowS
$cshowsPrec :: Int -> PinMode -> ShowS
Show, Int -> PinMode
PinMode -> Int
PinMode -> [PinMode]
PinMode -> PinMode
PinMode -> PinMode -> [PinMode]
PinMode -> PinMode -> PinMode -> [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
enumFromThenTo :: PinMode -> PinMode -> PinMode -> [PinMode]
$cenumFromThenTo :: PinMode -> PinMode -> PinMode -> [PinMode]
enumFromTo :: PinMode -> PinMode -> [PinMode]
$cenumFromTo :: PinMode -> PinMode -> [PinMode]
enumFromThen :: PinMode -> PinMode -> [PinMode]
$cenumFromThen :: PinMode -> PinMode -> [PinMode]
enumFrom :: PinMode -> [PinMode]
$cenumFrom :: PinMode -> [PinMode]
fromEnum :: PinMode -> Int
$cfromEnum :: PinMode -> Int
toEnum :: Int -> PinMode
$ctoEnum :: Int -> PinMode
pred :: PinMode -> PinMode
$cpred :: PinMode -> PinMode
succ :: PinMode -> PinMode
$csucc :: PinMode -> PinMode
Enum)
data Request = SystemReset
| QueryFirmware
| CapabilityQuery
| AnalogMappingQuery
| SetPinMode IPin PinMode
| DigitalReport Port Bool
| AnalogReport IPin Bool
| DigitalPortWrite Port Word8 Word8
| AnalogPinWrite IPin Word8 Word8
| SamplingInterval Word8 Word8
| Pulse IPin Bool Word32 Word32
deriving Int -> Request -> ShowS
[Request] -> ShowS
Request -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Request] -> ShowS
$cshowList :: [Request] -> ShowS
show :: Request -> String
$cshow :: Request -> String
showsPrec :: Int -> Request -> ShowS
$cshowsPrec :: Int -> Request -> ShowS
Show
data Response = Firmware Word8 Word8 String
| Capabilities BoardCapabilities
| AnalogMapping [Word8]
| DigitalMessage Port Word8 Word8
| AnalogMessage IPin Word8 Word8
| PulseResponse IPin Word32
| Unimplemented (Maybe String) [Word8]
instance Show Response where
show :: Response -> String
show (Firmware Word8
majV Word8
minV String
n) = String
"Firmware v" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Word8
majV forall a. [a] -> [a] -> [a]
++ String
"." forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Word8
minV forall a. [a] -> [a] -> [a]
++ String
" (" forall a. [a] -> [a] -> [a]
++ String
n forall a. [a] -> [a] -> [a]
++ String
")"
show (Capabilities BoardCapabilities
b) = String
"Capabilities:\n" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show BoardCapabilities
b
show (AnalogMapping [Word8]
bs) = String
"AnalogMapping: " forall a. [a] -> [a] -> [a]
++ [Word8] -> String
showByteList [Word8]
bs
show (DigitalMessage Port
p Word8
l Word8
h) = String
"DigitalMessage " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Port
p forall a. [a] -> [a] -> [a]
++ String
" = " forall a. [a] -> [a] -> [a]
++ Word8 -> String
showByte Word8
l forall a. [a] -> [a] -> [a]
++ String
" " forall a. [a] -> [a] -> [a]
++ Word8 -> String
showByte Word8
h
show (AnalogMessage IPin
p Word8
l Word8
h) = String
"AnalogMessage " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show IPin
p forall a. [a] -> [a] -> [a]
++ String
" = " forall a. [a] -> [a] -> [a]
++ Word8 -> String
showByte Word8
l forall a. [a] -> [a] -> [a]
++ String
" " forall a. [a] -> [a] -> [a]
++ Word8 -> String
showByte Word8
h
show (PulseResponse IPin
p Word32
v) = String
"PulseResponse " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show IPin
p forall a. [a] -> [a] -> [a]
++ String
" = " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Word32
v forall a. [a] -> [a] -> [a]
++ String
" (microseconds)"
show (Unimplemented Maybe String
mbc [Word8]
bs) = String
"Unimplemeneted " forall a. [a] -> [a] -> [a]
++ forall a. a -> Maybe a -> a
fromMaybe String
"" Maybe String
mbc forall a. [a] -> [a] -> [a]
++ String
" " forall a. [a] -> [a] -> [a]
++ [Word8] -> String
showByteList [Word8]
bs
type Resolution = Word8
data PinCapabilities = PinCapabilities {
PinCapabilities -> Maybe Word8
analogPinNumber :: Maybe Word8
, PinCapabilities -> [(PinMode, Word8)]
allowedModes :: [(PinMode, Resolution)]
}
newtype BoardCapabilities = BoardCapabilities (M.Map IPin PinCapabilities)
instance Show BoardCapabilities where
show :: BoardCapabilities -> String
show (BoardCapabilities Map IPin PinCapabilities
m) = forall a. [a] -> [[a]] -> [a]
intercalate String
"\n" (forall a b. (a -> b) -> [a] -> [b]
map forall {a}. Show a => (a, PinCapabilities) -> String
sh (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 :: Maybe Word8
analogPinNumber :: PinCapabilities -> Maybe Word8
analogPinNumber, [(PinMode, Word8)]
allowedModes :: [(PinMode, Word8)]
allowedModes :: PinCapabilities -> [(PinMode, Word8)]
allowedModes}) = forall a. Show a => a -> String
show a
p forall a. [a] -> [a] -> [a]
++ String
sep forall a. [a] -> [a] -> [a]
++ [String] -> String
unwords [forall a. Show a => a -> String
show PinMode
md | (PinMode
md, Word8
_) <- [(PinMode, Word8)]
allowedModes]
where sep :: String
sep = forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
": " (\Word8
i -> String
"[A" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Word8
i forall a. [a] -> [a] -> [a]
++ String
"]: ") Maybe Word8
analogPinNumber
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
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PinData] -> ShowS
$cshowList :: [PinData] -> ShowS
show :: PinData -> String
$cshow :: PinData -> String
showsPrec :: Int -> PinData -> ShowS
$cshowsPrec :: Int -> PinData -> ShowS
Show
newtype LCD = LCD Int
deriving (LCD -> LCD -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LCD -> LCD -> Bool
$c/= :: LCD -> LCD -> Bool
== :: LCD -> LCD -> Bool
$c== :: LCD -> LCD -> Bool
Eq, Eq 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
min :: LCD -> LCD -> LCD
$cmin :: LCD -> LCD -> LCD
max :: LCD -> LCD -> LCD
$cmax :: LCD -> LCD -> LCD
>= :: LCD -> LCD -> Bool
$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
compare :: LCD -> LCD -> Ordering
$ccompare :: LCD -> LCD -> Ordering
Ord, Int -> LCD -> ShowS
[LCD] -> ShowS
LCD -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LCD] -> ShowS
$cshowList :: [LCD] -> ShowS
show :: LCD -> String
$cshow :: LCD -> String
showsPrec :: Int -> LCD -> ShowS
$cshowsPrec :: Int -> LCD -> ShowS
Show)
data LCDController = Hitachi44780 {
LCDController -> Pin
lcdRS :: Pin
, LCDController -> Pin
lcdEN :: Pin
, LCDController -> Pin
lcdD4 :: Pin
, LCDController -> Pin
lcdD5 :: Pin
, LCDController -> Pin
lcdD6 :: Pin
, LCDController -> Pin
lcdD7 :: Pin
, LCDController -> Int
lcdRows :: Int
, LCDController -> Int
lcdCols :: Int
, LCDController -> Bool
dotMode5x10 :: Bool
}
deriving Int -> LCDController -> ShowS
[LCDController] -> ShowS
LCDController -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LCDController] -> ShowS
$cshowList :: [LCDController] -> ShowS
show :: LCDController -> String
$cshow :: LCDController -> String
showsPrec :: Int -> LCDController -> ShowS
$cshowsPrec :: Int -> LCDController -> ShowS
Show
data LCDData = LCDData {
LCDData -> Word8
lcdDisplayMode :: Word8
, LCDData -> Word8
lcdDisplayControl :: Word8
, LCDData -> Word8
lcdGlyphCount :: Word8
, LCDData -> LCDController
lcdController :: LCDController
}
data BoardState = BoardState {
BoardState -> BoardCapabilities
boardCapabilities :: BoardCapabilities
, BoardState -> Set IPin
analogReportingPins :: S.Set IPin
, BoardState -> Set IPin
digitalReportingPins :: S.Set IPin
, BoardState -> Map IPin PinData
pinStates :: M.Map IPin PinData
, BoardState -> [MVar ()]
digitalWakeUpQueue :: [MVar ()]
, BoardState -> Map LCD LCDData
lcds :: M.Map LCD LCDData
}
data ArduinoState = ArduinoState {
ArduinoState -> String -> IO ()
message :: String -> IO ()
, ArduinoState -> String -> [String] -> IO ()
bailOut :: String -> [String] -> IO ()
, ArduinoState -> SerialPort
port :: SerialPort
, ArduinoState -> String
firmataID :: String
, ArduinoState -> MVar BoardState
boardState :: MVar BoardState
, ArduinoState -> Chan Response
deviceChannel :: Chan Response
, ArduinoState -> BoardCapabilities
capabilities :: BoardCapabilities
, ArduinoState -> MVar ThreadId
listenerTid :: MVar ThreadId
}
newtype Arduino a = Arduino (StateT ArduinoState IO a)
deriving (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
<$ :: forall a b. a -> Arduino b -> Arduino a
$c<$ :: forall a b. a -> Arduino b -> Arduino a
fmap :: forall a b. (a -> b) -> Arduino a -> Arduino b
$cfmap :: forall a b. (a -> b) -> Arduino a -> Arduino b
Functor, Functor 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
<* :: forall a b. Arduino a -> Arduino b -> Arduino a
$c<* :: forall a b. Arduino a -> Arduino b -> Arduino a
*> :: forall a b. Arduino a -> Arduino b -> Arduino b
$c*> :: forall a b. Arduino a -> Arduino b -> Arduino b
liftA2 :: forall a b c. (a -> b -> c) -> Arduino a -> Arduino b -> Arduino c
$cliftA2 :: forall a b c. (a -> b -> c) -> Arduino a -> Arduino b -> Arduino c
<*> :: forall a b. Arduino (a -> b) -> Arduino a -> Arduino b
$c<*> :: forall a b. Arduino (a -> b) -> Arduino a -> Arduino b
pure :: forall a. a -> Arduino a
$cpure :: forall a. a -> Arduino a
Applicative, Applicative 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
return :: forall a. a -> Arduino a
$creturn :: forall a. a -> Arduino a
>> :: forall a b. Arduino a -> Arduino b -> Arduino b
$c>> :: forall a b. Arduino a -> Arduino b -> Arduino b
>>= :: forall a b. Arduino a -> (a -> Arduino b) -> Arduino b
$c>>= :: forall a b. Arduino a -> (a -> Arduino b) -> Arduino b
Monad, Monad Arduino
forall a. IO a -> Arduino a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
liftIO :: forall a. IO a -> Arduino a
$cliftIO :: forall a. IO a -> Arduino a
MonadIO, MonadState ArduinoState)
debug :: String -> Arduino ()
debug :: String -> Arduino ()
debug String
s = do String -> IO ()
f <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ArduinoState -> String -> IO ()
message
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ String -> IO ()
f String
s
die :: String -> [String] -> Arduino a
die :: forall a. String -> [String] -> Arduino a
die String
m [String]
ms = do String -> [String] -> IO ()
f <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ArduinoState -> String -> [String] -> IO ()
bailOut
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do String -> [String] -> IO ()
f String
m [String]
ms
forall a. IO a
exitFailure
getPinModes :: IPin -> Arduino [PinMode]
getPinModes :: IPin -> Arduino [PinMode]
getPinModes IPin
p = do
BoardCapabilities Map IPin PinCapabilities
caps <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ArduinoState -> BoardCapabilities
capabilities
case IPin
p forall k a. Ord k => k -> Map k a -> Maybe a
`M.lookup` Map IPin PinCapabilities
caps of
Maybe PinCapabilities
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return []
Just PinCapabilities{[(PinMode, Word8)]
allowedModes :: [(PinMode, Word8)]
allowedModes :: PinCapabilities -> [(PinMode, Word8)]
allowedModes} -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst [(PinMode, Word8)]
allowedModes
getPinData :: IPin -> Arduino PinData
getPinData :: IPin -> Arduino PinData
getPinData IPin
p = do
MVar BoardState
bs <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ArduinoState -> MVar BoardState
boardState
String -> [String] -> IO ()
err <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ArduinoState -> String -> [String] -> IO ()
bailOut
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a b. MVar a -> (a -> IO b) -> IO b
withMVar MVar BoardState
bs forall a b. (a -> b) -> a -> b
$ \BoardState
bst ->
case IPin
p 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 " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show IPin
p forall a. [a] -> [a] -> [a]
++ String
" without proper configuration.")
[String
"Make sure that you use 'setPinMode' to configure this pin first."]
forall a. IO a
exitFailure
Just PinData
pd -> forall (m :: * -> *) a. Monad m => a -> m a
return PinData
pd
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 <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ArduinoState -> MVar BoardState
boardState
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a b. MVar a -> (a -> IO (a, b)) -> IO b
modifyMVar MVar BoardState
bs 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) <- forall k a. Map k a -> [(k, a)]
M.assocs (BoardState -> Map IPin PinData
pinStates BoardState
bst), Port
curPort forall a. Eq a => a -> a -> Bool
== IPin -> Port
pinPort IPin
p, PinData -> PinMode
pinMode PinData
pd forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [PinMode
INPUT, PinMode
OUTPUT]]
getVal :: Word8 -> Bool
getVal Word8
i
| Word8
i forall a. Eq a => a -> a -> Bool
== Word8
curIndex = Bool
newValue
| Just (Just (Left Bool
v)) <- Word8
i 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] = forall a b. (a -> b) -> [a] -> [b]
map Word8 -> Bool
getVal [Word8
0 .. Word8
7]
lsb :: Word8
lsb = 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 forall a. Bits a => a -> Int -> a
`setBit` Int
i else Word8
m) Word8
0 (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 = 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 forall a. Bits a => a -> Int -> a
`setBit` (Int
iforall a. Num a => a -> a -> a
-Int
7) else Word8
m) Word8
0 (forall a b. [a] -> [b] -> [(a, b)]
zip [Int
7..] [Bool
b7])
bst' :: BoardState
bst' = BoardState
bst{pinStates :: Map IPin PinData
pinStates = forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert IPin
curPin PinData{pinMode :: PinMode
pinMode = PinMode
OUTPUT, pinValue :: Maybe (Either Bool Int)
pinValue = forall a. a -> Maybe a
Just (forall a b. a -> Either a b
Left Bool
newValue)}(BoardState -> Map IPin PinData
pinStates BoardState
bst)}
forall (m :: * -> *) a. Monad m => a -> m a
return (BoardState
bst', (Word8
lsb, Word8
msb))
digitalWakeUp :: MVar () -> Arduino ()
digitalWakeUp :: MVar () -> Arduino ()
digitalWakeUp MVar ()
semaphore = do
MVar BoardState
bs <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ArduinoState -> MVar BoardState
boardState
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVar_ MVar BoardState
bs forall a b. (a -> b) -> a -> b
$ \BoardState
bst -> forall (m :: * -> *) a. Monad m => a -> m a
return BoardState
bst{digitalWakeUpQueue :: [MVar ()]
digitalWakeUpQueue = MVar ()
semaphore forall a. a -> [a] -> [a]
: BoardState -> [MVar ()]
digitalWakeUpQueue BoardState
bst}
data FirmataCmd = ANALOG_MESSAGE IPin
| DIGITAL_MESSAGE Port
| REPORT_ANALOG_PIN IPin
| REPORT_DIGITAL_PORT Port
| START_SYSEX
| SET_PIN_MODE
| END_SYSEX
| PROTOCOL_VERSION
| SYSTEM_RESET
deriving Int -> FirmataCmd -> ShowS
[FirmataCmd] -> ShowS
FirmataCmd -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FirmataCmd] -> ShowS
$cshowList :: [FirmataCmd] -> ShowS
show :: FirmataCmd -> String
$cshow :: FirmataCmd -> String
showsPrec :: Int -> FirmataCmd -> ShowS
$cshowsPrec :: Int -> FirmataCmd -> ShowS
Show
firmataCmdVal :: FirmataCmd -> Word8
firmataCmdVal :: FirmataCmd -> Word8
firmataCmdVal (ANALOG_MESSAGE IPin
p) = Word8
0xE0 forall a. Bits a => a -> a -> a
.|. IPin -> Word8
pinNo IPin
p
firmataCmdVal (DIGITAL_MESSAGE Port
p) = Word8
0x90 forall a. Bits a => a -> a -> a
.|. Port -> Word8
portNo Port
p
firmataCmdVal (REPORT_ANALOG_PIN IPin
p) = Word8
0xC0 forall a. Bits a => a -> a -> a
.|. IPin -> Word8
pinNo IPin
p
firmataCmdVal (REPORT_DIGITAL_PORT Port
p) = Word8
0xD0 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
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 forall a. Bits a => a -> a -> a
.&. Word8
m forall a. Eq a => a -> a -> Bool
== Word8
m = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8
w forall a. Bits a => a -> a -> a
.&. Word8
0x0F)
| Bool
True = forall a. Maybe a
Nothing
classify :: Either Word8 FirmataCmd
classify | Word8
w forall a. Eq a => a -> a -> Bool
== Word8
0xF0 = forall a b. b -> Either a b
Right FirmataCmd
START_SYSEX
| Word8
w forall a. Eq a => a -> a -> Bool
== Word8
0xF4 = forall a b. b -> Either a b
Right FirmataCmd
SET_PIN_MODE
| Word8
w forall a. Eq a => a -> a -> Bool
== Word8
0xF7 = forall a b. b -> Either a b
Right FirmataCmd
END_SYSEX
| Word8
w forall a. Eq a => a -> a -> Bool
== Word8
0xF9 = forall a b. b -> Either a b
Right FirmataCmd
PROTOCOL_VERSION
| Word8
w forall a. Eq a => a -> a -> Bool
== Word8
0xFF = forall a b. b -> Either a b
Right FirmataCmd
SYSTEM_RESET
| Just Word8
i <- forall {a}. Num a => Word8 -> Maybe a
extract Word8
0xE0 = forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ IPin -> FirmataCmd
ANALOG_MESSAGE (Word8 -> IPin
InternalPin Word8
i)
| Just Word8
i <- forall {a}. Num a => Word8 -> Maybe a
extract Word8
0x90 = forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ Port -> FirmataCmd
DIGITAL_MESSAGE (Word8 -> Port
Port Word8
i)
| Just Word8
i <- forall {a}. Num a => Word8 -> Maybe a
extract Word8
0xC0 = forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ IPin -> FirmataCmd
REPORT_ANALOG_PIN (Word8 -> IPin
InternalPin Word8
i)
| Just Word8
i <- forall {a}. Num a => Word8 -> Maybe a
extract Word8
0xD0 = forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ Port -> FirmataCmd
REPORT_DIGITAL_PORT (Word8 -> Port
Port Word8
i)
| Bool
True = forall a b. a -> Either a b
Left Word8
w
data SysExCmd = RESERVED_COMMAND
| ANALOG_MAPPING_QUERY
| ANALOG_MAPPING_RESPONSE
| CAPABILITY_QUERY
| CAPABILITY_RESPONSE
| PIN_STATE_QUERY
| PIN_STATE_RESPONSE
| EXTENDED_ANALOG
| SERVO_CONFIG
| STRING_DATA
| PULSE
| SHIFT_DATA
| I2C_REQUEST
| I2C_REPLY
| I2C_CONFIG
| REPORT_FIRMWARE
| SAMPLING_INTERVAL
| SYSEX_NON_REALTIME
| SYSEX_REALTIME
deriving Int -> SysExCmd -> ShowS
[SysExCmd] -> ShowS
SysExCmd -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SysExCmd] -> ShowS
$cshowList :: [SysExCmd] -> ShowS
show :: SysExCmd -> String
$cshow :: SysExCmd -> String
showsPrec :: Int -> SysExCmd -> ShowS
$cshowsPrec :: Int -> SysExCmd -> ShowS
Show
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
getSysExCommand :: Word8 -> Either Word8 SysExCmd
getSysExCommand :: Word8 -> Either Word8 SysExCmd
getSysExCommand Word8
0x00 = forall a b. b -> Either a b
Right SysExCmd
RESERVED_COMMAND
getSysExCommand Word8
0x69 = forall a b. b -> Either a b
Right SysExCmd
ANALOG_MAPPING_QUERY
getSysExCommand Word8
0x6A = forall a b. b -> Either a b
Right SysExCmd
ANALOG_MAPPING_RESPONSE
getSysExCommand Word8
0x6B = forall a b. b -> Either a b
Right SysExCmd
CAPABILITY_QUERY
getSysExCommand Word8
0x6C = forall a b. b -> Either a b
Right SysExCmd
CAPABILITY_RESPONSE
getSysExCommand Word8
0x6D = forall a b. b -> Either a b
Right SysExCmd
PIN_STATE_QUERY
getSysExCommand Word8
0x6E = forall a b. b -> Either a b
Right SysExCmd
PIN_STATE_RESPONSE
getSysExCommand Word8
0x6F = forall a b. b -> Either a b
Right SysExCmd
EXTENDED_ANALOG
getSysExCommand Word8
0x70 = forall a b. b -> Either a b
Right SysExCmd
SERVO_CONFIG
getSysExCommand Word8
0x71 = forall a b. b -> Either a b
Right SysExCmd
STRING_DATA
getSysExCommand Word8
0x75 = forall a b. b -> Either a b
Right SysExCmd
SHIFT_DATA
getSysExCommand Word8
0x76 = forall a b. b -> Either a b
Right SysExCmd
I2C_REQUEST
getSysExCommand Word8
0x77 = forall a b. b -> Either a b
Right SysExCmd
I2C_REPLY
getSysExCommand Word8
0x78 = forall a b. b -> Either a b
Right SysExCmd
I2C_CONFIG
getSysExCommand Word8
0x79 = forall a b. b -> Either a b
Right SysExCmd
REPORT_FIRMWARE
getSysExCommand Word8
0x7A = forall a b. b -> Either a b
Right SysExCmd
SAMPLING_INTERVAL
getSysExCommand Word8
0x7E = forall a b. b -> Either a b
Right SysExCmd
SYSEX_NON_REALTIME
getSysExCommand Word8
0x7F = forall a b. b -> Either a b
Right SysExCmd
SYSEX_REALTIME
getSysExCommand Word8
0x74 = forall a b. b -> Either a b
Right SysExCmd
PULSE
getSysExCommand Word8
n = forall a b. a -> Either a b
Left Word8
n
registerPinMode :: IPin -> PinMode -> Arduino [Request]
registerPinMode :: IPin -> PinMode -> Arduino [Request]
registerPinMode IPin
p PinMode
m = do
BoardCapabilities Map IPin PinCapabilities
caps <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ArduinoState -> BoardCapabilities
capabilities
case IPin
p forall k a. Ord k => k -> Map k a -> Maybe a
`M.lookup` Map IPin PinCapabilities
caps of
Maybe PinCapabilities
Nothing
-> forall a. String -> [String] -> Arduino a
die (String
"Invalid access to unsupported pin: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show IPin
p)
(String
"Available pins are: " forall a. a -> [a] -> [a]
: [String
" " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show IPin
k | (IPin
k, PinCapabilities
_) <- forall k a. Map k a -> [(k, a)]
M.toAscList Map IPin PinCapabilities
caps])
Just PinCapabilities{[(PinMode, Word8)]
allowedModes :: [(PinMode, Word8)]
allowedModes :: PinCapabilities -> [(PinMode, Word8)]
allowedModes}
| PinMode
m forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst [(PinMode, Word8)]
allowedModes
-> forall a. String -> [String] -> Arduino a
die (String
"Invalid mode " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show PinMode
m forall a. [a] -> [a] -> [a]
++ String
" set for " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show IPin
p)
[String
"Supported modes for this pin are: " forall a. [a] -> [a] -> [a]
++ [String] -> String
unwords (if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(PinMode, Word8)]
allowedModes then [String
"NONE"] else forall a b. (a -> b) -> [a] -> [b]
map forall a. Show a => a -> String
show [(PinMode, Word8)]
allowedModes)]
Maybe PinCapabilities
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
MVar BoardState
bs <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ArduinoState -> MVar BoardState
boardState
Maybe PinMode
mbOldMode <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a b. MVar a -> (a -> IO b) -> IO b
withMVar MVar BoardState
bs forall a b. (a -> b) -> a -> b
$ \BoardState
bst ->
case IPin
p forall k a. Ord k => k -> Map k a -> Maybe a
`M.lookup` BoardState -> Map IPin PinData
pinStates BoardState
bst of
Maybe PinData
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
Just PinData
pd -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ PinData -> PinMode
pinMode PinData
pd
let registerNewMode :: IO ()
registerNewMode = forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVar_ MVar BoardState
bs forall a b. (a -> b) -> a -> b
$ \BoardState
bst -> forall (m :: * -> *) a. Monad m => a -> m a
return BoardState
bst{pinStates :: Map IPin PinData
pinStates = forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert IPin
p PinData{pinMode :: PinMode
pinMode = PinMode
m, pinValue :: Maybe (Either Bool Int)
pinValue = forall a. Maybe a
Nothing} (BoardState -> Map IPin PinData
pinStates BoardState
bst) }
case Maybe PinMode
mbOldMode of
Maybe PinMode
Nothing -> do 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 forall a. Eq a => a -> a -> Bool
== PinMode
m' -> forall (m :: * -> *) a. Monad m => a -> m a
return []
| Bool
True -> do 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
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [Request]
remActs forall a. [a] -> [a] -> [a]
++ [Request]
addActs
getRemovalActions :: IPin -> PinMode -> Arduino [Request]
getRemovalActions :: IPin -> PinMode -> Arduino [Request]
getRemovalActions IPin
p PinMode
INPUT = do
MVar BoardState
bs <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ArduinoState -> MVar BoardState
boardState
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a b. MVar a -> (a -> IO (a, b)) -> IO b
modifyMVar MVar BoardState
bs forall a b. (a -> b) -> a -> b
$ \BoardState
bst -> do
let dPins :: Set IPin
dPins = IPin
p 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 forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` forall a b. (a -> b) -> [a] -> [b]
map IPin -> Port
pinPort (forall a. Set a -> [a]
S.elems Set IPin
dPins)]
bst' :: BoardState
bst' = BoardState
bst { digitalReportingPins :: Set IPin
digitalReportingPins = Set IPin
dPins }
forall (m :: * -> *) a. Monad m => a -> m a
return (BoardState
bst', [Request]
acts)
getRemovalActions IPin
p PinMode
ANALOG = do
MVar BoardState
bs <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ArduinoState -> MVar BoardState
boardState
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a b. MVar a -> (a -> IO (a, b)) -> IO b
modifyMVar MVar BoardState
bs 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 forall a. Ord a => a -> Set a -> Bool
`S.member` Set IPin
aPins]
bst' :: BoardState
bst' = BoardState
bst { analogReportingPins :: Set IPin
analogReportingPins = IPin
p forall a. Ord a => a -> Set a -> Set a
`S.delete` Set IPin
aPins }
forall (m :: * -> *) a. Monad m => a -> m a
return (BoardState
bst', [Request]
acts)
getRemovalActions IPin
_ PinMode
OUTPUT = forall (m :: * -> *) a. Monad m => a -> m a
return []
getRemovalActions IPin
p PinMode
m = forall a. String -> [String] -> Arduino a
die (String
"hArduino: getRemovalActions: TBD: Unsupported mode: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show PinMode
m) [String
"On pin " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show IPin
p]
getModeActions :: IPin -> PinMode -> Arduino [Request]
getModeActions :: IPin -> PinMode -> Arduino [Request]
getModeActions IPin
p PinMode
INPUT = do
MVar BoardState
bs <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ArduinoState -> MVar BoardState
boardState
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a b. MVar a -> (a -> IO (a, b)) -> IO b
modifyMVar MVar BoardState
bs 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 forall a. Ord a => a -> Set a -> Bool
`S.member` Set IPin
aPins]
acts2 :: [Request]
acts2 = [Port -> Bool -> Request
DigitalReport Port
port Bool
True | Port
port forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` forall a b. (a -> b) -> [a] -> [b]
map IPin -> Port
pinPort (forall a. Set a -> [a]
S.elems Set IPin
dPins)]
bst' :: BoardState
bst' = BoardState
bst { analogReportingPins :: Set IPin
analogReportingPins = IPin
p forall a. Ord a => a -> Set a -> Set a
`S.delete` BoardState -> Set IPin
analogReportingPins BoardState
bst
, digitalReportingPins :: Set IPin
digitalReportingPins = IPin
p forall a. Ord a => a -> Set a -> Set a
`S.insert` BoardState -> Set IPin
digitalReportingPins BoardState
bst
}
forall (m :: * -> *) a. Monad m => a -> m a
return (BoardState
bst', [Request]
acts1 forall a. [a] -> [a] -> [a]
++ [Request]
acts2)
getModeActions IPin
p PinMode
ANALOG = do
MVar BoardState
bs <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ArduinoState -> MVar BoardState
boardState
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a b. MVar a -> (a -> IO (a, b)) -> IO b
modifyMVar MVar BoardState
bs 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 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 forall a. Ord a => a -> Set a -> Bool
`S.notMember` Set IPin
aPins]
acts2 :: [Request]
acts2 = [Port -> Bool -> Request
DigitalReport Port
port Bool
False | Port
port forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` forall a b. (a -> b) -> [a] -> [b]
map IPin -> Port
pinPort (forall a. Set a -> [a]
S.elems Set IPin
dPins)]
bst' :: BoardState
bst' = BoardState
bst { analogReportingPins :: Set IPin
analogReportingPins = IPin
p forall a. Ord a => a -> Set a -> Set a
`S.insert` BoardState -> Set IPin
analogReportingPins BoardState
bst
, digitalReportingPins :: Set IPin
digitalReportingPins = Set IPin
dPins
}
forall (m :: * -> *) a. Monad m => a -> m a
return (BoardState
bst', [Request]
acts1 forall a. [a] -> [a] -> [a]
++ [Request]
acts2)
getModeActions IPin
_ PinMode
PWM = forall (m :: * -> *) a. Monad m => a -> m a
return []
getModeActions IPin
_ PinMode
OUTPUT = forall (m :: * -> *) a. Monad m => a -> m a
return []
getModeActions IPin
_ PinMode
SERVO = forall (m :: * -> *) a. Monad m => a -> m a
return []
getModeActions IPin
p PinMode
m = forall a. String -> [String] -> Arduino a
die (String
"hArduino: getModeActions: TBD: Unsupported mode: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show PinMode
m) [String
"On pin " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show IPin
p]
getInternalPin :: Pin -> Arduino IPin
getInternalPin :: Pin -> Arduino IPin
getInternalPin (MixedPin Word8
p) = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Word8 -> IPin
InternalPin Word8
p
getInternalPin (DigitalPin Word8
p) = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Word8 -> IPin
InternalPin Word8
p
getInternalPin (AnalogPin Word8
p)
= do BoardCapabilities Map IPin PinCapabilities
caps <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ArduinoState -> BoardCapabilities
capabilities
case forall a. [a] -> Maybe a
listToMaybe [IPin
realPin | (IPin
realPin, PinCapabilities{analogPinNumber :: PinCapabilities -> Maybe Word8
analogPinNumber = Just Word8
n}) <- forall k a. Map k a -> [(k, a)]
M.toAscList Map IPin PinCapabilities
caps, Word8
p forall a. Eq a => a -> a -> Bool
== Word8
n] of
Maybe IPin
Nothing -> forall a. String -> [String] -> Arduino a
die (String
"hArduino: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Word8
p forall a. [a] -> [a] -> [a]
++ String
" is not a valid analog-pin on this board.")
[String
"Hint: To refer to analog pin number k, simply use 'pin k', not 'pin (k+noOfDigitalPins)'" | Word8
p forall a. Ord a => a -> a -> Bool
> Word8
13]
Just IPin
rp -> forall (m :: * -> *) a. Monad m => a -> m a
return IPin
rp
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 forall a. Eq a => a -> a -> Bool
== Word8
board = String
""
| Bool
True = String
" (On board " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show IPin
p forall a. [a] -> [a] -> [a]
++ String
")"
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (PinData -> PinMode
pinMode PinData
pd forall a. Eq a => a -> a -> Bool
/= PinMode
m) forall a b. (a -> b) -> a -> b
$ forall a. String -> [String] -> Arduino a
die (String
"Invalid " forall a. [a] -> [a] -> [a]
++ String
what forall a. [a] -> [a] -> [a]
++ String
" call on pin " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Pin
p' forall a. [a] -> [a] -> [a]
++ String
bInfo)
[ String
"The current mode for this pin is: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (PinData -> PinMode
pinMode PinData
pd)
, String
"For " forall a. [a] -> [a] -> [a]
++ String
what forall a. [a] -> [a] -> [a]
++ String
", it must be set to: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show PinMode
m
, String
"via a proper call to setPinMode"
]
forall (m :: * -> *) a. Monad m => a -> m a
return (IPin
p, PinData
pd)