--------------------------------------------------------------------------------- |-- Module : System.Hardware.Arduino.Utils-- Copyright : (c) Levent Erkok-- License : BSD3-- Maintainer : erkokl@gmail.com-- Stability : experimental---- Internal utilities-------------------------------------------------------------------------------moduleSystem.Hardware.Arduino.UtilswhereimportControl.Concurrent(threadDelay)importData.Bits((.|.),shiftL,(.&.),shiftR)importData.Char(isAlphaNum,isAscii,isSpace,chr)importData.IORef(newIORef,readIORef,writeIORef)importData.List(intercalate)importData.Word(Word8,Word32)importData.Time(getCurrentTime,utctDayTime)importNumeric(showHex,showIntAtBase)-- | Delay (wait) for the given number of milli-secondsdelay ::Int->IO()delay :: Int -> IO ()
delay Int
n =Int -> IO ()
threadDelay(Int
n forall a. Num a => a -> a -> a
*Int
1000)-- | A simple printer that can keep track of sequence numbers. Used for debugging purposes.mkDebugPrinter ::Bool->IO(String->IO())mkDebugPrinter :: Bool -> IO (String -> IO ())
mkDebugPrinter Bool
False=forall (m :: * -> *) a. Monad m => a -> m a
return(forall a b. a -> b -> a
const(forall (m :: * -> *) a. Monad m => a -> m a
return()))mkDebugPrinter Bool
True=doIORef Int
cnt <-forall a. a -> IO (IORef a)
newIORef(Int
1::Int)letf :: String -> IO ()
f String
s =doInt
i <-forall a. IORef a -> IO a
readIORefIORef Int
cnt forall a. IORef a -> a -> IO ()
writeIORefIORef Int
cnt (Int
i forall a. Num a => a -> a -> a
+Int
1)DiffTime
tick <-UTCTime -> DiffTime
utctDayTimeforall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap`IO UTCTime
getCurrentTimeletprecision :: Integer
precision =Integer
1000000::Integermicro :: Integer
micro =forall a b. (RealFrac a, Integral b) => a -> b
roundforall b c a. (b -> c) -> (a -> b) -> a -> c
.(forall a b. (Integral a, Num b) => a -> b
fromIntegralInteger
precision forall a. Num a => a -> a -> a
*)forall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a. Real a => a -> Rational
toRationalforall a b. (a -> b) -> a -> b
$DiffTime
tick String -> IO ()
putStrLnforall a b. (a -> b) -> a -> b
$String
"["forall a. [a] -> [a] -> [a]
++forall a. Show a => a -> String
showInt
i forall a. [a] -> [a] -> [a]
++String
":"forall a. [a] -> [a] -> [a]
++forall a. Show a => a -> String
show(Integer
micro ::Integer)forall a. [a] -> [a] -> [a]
++String
"] hArduino: "forall a. [a] -> [a] -> [a]
++String
s forall (m :: * -> *) a. Monad m => a -> m a
returnString -> IO ()
f -- | Show a byte in a visible format.showByte ::Word8->StringshowByte :: Word8 -> String
showByte Word8
i |Bool
isVisible =[Char
c ]|Word8
i forall a. Ord a => a -> a -> Bool
<=Word8
0xf=Char
'0'forall a. a -> [a] -> [a]
:forall a. (Integral a, Show a) => a -> ShowS
showHexWord8
i String
""|Bool
True=forall a. (Integral a, Show a) => a -> ShowS
showHexWord8
i String
""wherec :: Char
c =Int -> Char
chrforall a b. (a -> b) -> a -> b
$forall a b. (Integral a, Num b) => a -> b
fromIntegralWord8
i isVisible :: Bool
isVisible =Char -> Bool
isAsciiChar
c Bool -> Bool -> Bool
&&Char -> Bool
isAlphaNumChar
c Bool -> Bool -> Bool
&&Char -> Bool
isSpaceChar
c -- | Show a list of bytesshowByteList ::[Word8]->StringshowByteList :: [Word8] -> String
showByteList [Word8]
bs =String
"["forall a. [a] -> [a] -> [a]
++forall a. [a] -> [[a]] -> [a]
intercalateString
", "(forall a b. (a -> b) -> [a] -> [b]
mapWord8 -> String
showByte [Word8]
bs )forall a. [a] -> [a] -> [a]
++String
"]"-- | Show a number as a binary valueshowBin ::(Integrala ,Showa )=>a ->StringshowBin :: forall a. (Integral a, Show a) => a -> String
showBin a
n =forall a. (Integral a, Show a) => a -> (Int -> Char) -> a -> ShowS
showIntAtBasea
2(forall a. [a] -> a
headforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a. Show a => a -> String
show)a
n String
""-- | Turn a lo/hi encoded Arduino string constant into a Haskell stringgetString ::[Word8]->StringgetString :: [Word8] -> String
getString =forall a b. (a -> b) -> [a] -> [b]
map(Int -> Char
chrforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a b. (Integral a, Num b) => a -> b
fromIntegral)forall b c a. (b -> c) -> (a -> b) -> a -> c
.[Word8] -> [Word8]
fromArduinoBytes -- | Turn a lo/hi encoded Arduino sequence into a bunch of words, again weird-- encoding.fromArduinoBytes ::[Word8]->[Word8]fromArduinoBytes :: [Word8] -> [Word8]
fromArduinoBytes []=[]fromArduinoBytes [Word8
x ]=[Word8
x ]-- shouldn't really happenfromArduinoBytes (Word8
l :Word8
h :[Word8]
rest )=Word8
c forall a. a -> [a] -> [a]
:[Word8] -> [Word8]
fromArduinoBytes [Word8]
rest wherec :: Word8
c =Word8
h forall a. Bits a => a -> Int -> a
`shiftL`Int
7forall a. Bits a => a -> a -> a
.|.Word8
l -- first seven bit comes from l; then extra stuff is in h-- | Turn a normal byte into a lo/hi Arduino byte. If you think this encoding-- is just plain weird, you're not alone. (I suspect it has something to do-- with error-correcting low-level serial communication of the past.)toArduinoBytes ::Word8->[Word8]toArduinoBytes :: Word8 -> [Word8]
toArduinoBytes Word8
w =[Word8
lo ,Word8
hi ]wherelo :: Word8
lo =Word8
w forall a. Bits a => a -> a -> a
.&.Word8
0x7F-- first seven bitshi :: Word8
hi =(Word8
w forall a. Bits a => a -> Int -> a
`shiftR`Int
7)forall a. Bits a => a -> a -> a
.&.Word8
0x7F-- one extra high-bit-- | Convert a word to it's bytes, as would be required by Arduino commsword2Bytes ::Word32->[Word8]word2Bytes :: Word32 -> [Word8]
word2Bytes Word32
i =forall a b. (a -> b) -> [a] -> [b]
mapforall a b. (Integral a, Num b) => a -> b
fromIntegral[(Word32
i forall a. Bits a => a -> Int -> a
`shiftR`Int
24)forall a. Bits a => a -> a -> a
.&.Word32
0xFF,(Word32
i forall a. Bits a => a -> Int -> a
`shiftR`Int
16)forall a. Bits a => a -> a -> a
.&.Word32
0xFF,(Word32
i forall a. Bits a => a -> Int -> a
`shiftR`Int
8)forall a. Bits a => a -> a -> a
.&.Word32
0xFF,Word32
i forall a. Bits a => a -> a -> a
.&.Word32
0xFF]-- | Inverse conversion for word2Bytesbytes2Words ::(Word8,Word8,Word8,Word8)->Word32bytes2Words :: (Word8, Word8, Word8, Word8) -> Word32
bytes2Words (Word8
a ,Word8
b ,Word8
c ,Word8
d )=forall a b. (Integral a, Num b) => a -> b
fromIntegralWord8
a forall a. Bits a => a -> Int -> a
`shiftL`Int
24forall a. Bits a => a -> a -> a
.|.forall a b. (Integral a, Num b) => a -> b
fromIntegralWord8
b forall a. Bits a => a -> Int -> a
`shiftL`Int
16forall a. Bits a => a -> a -> a
.|.forall a b. (Integral a, Num b) => a -> b
fromIntegralWord8
c forall a. Bits a => a -> Int -> a
`shiftL`Int
8forall a. Bits a => a -> a -> a
.|.forall a b. (Integral a, Num b) => a -> b
fromIntegralWord8
d