-------------------------------------------------------------------------------
-- |
-- Module      :  System.Hardware.Arduino.Utils
-- Copyright   :  (c) Levent Erkok
-- License     :  BSD3
-- Maintainer  :  erkokl@gmail.com
-- Stability   :  experimental
--
-- Internal utilities
-------------------------------------------------------------------------------
module System.Hardware.Arduino.Utils where

import Control.Concurrent (threadDelay)
import Data.Bits          ((.|.), shiftL, (.&.), shiftR)
import Data.Char          (isAlphaNum, isAscii, isSpace, chr)
import Data.IORef         (newIORef, readIORef, writeIORef)
import Data.List          (intercalate)
import Data.Word          (Word8, Word32)
import Data.Time          (getCurrentTime, utctDayTime)
import Numeric            (showHex, showIntAtBase)

-- | Delay (wait) for the given number of milli-seconds
delay :: Int -> IO ()
delay :: Int -> IO ()
delay Int
n = Int -> IO ()
threadDelay (Int
nforall 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  = do
        IORef Int
cnt <- forall a. a -> IO (IORef a)
newIORef (Int
1::Int)
        let f :: String -> IO ()
f String
s = do Int
i <- forall a. IORef a -> IO a
readIORef IORef Int
cnt
                     forall a. IORef a -> a -> IO ()
writeIORef IORef Int
cnt (Int
iforall a. Num a => a -> a -> a
+Int
1)
                     DiffTime
tick <- UTCTime -> DiffTime
utctDayTime forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` IO UTCTime
getCurrentTime
                     let precision :: Integer
precision = Integer
1000000 :: Integer
                         micro :: Integer
micro = forall a b. (RealFrac a, Integral b) => a -> b
round forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
precision forall a. Num a => a -> a -> a
*) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Real a => a -> Rational
toRational forall a b. (a -> b) -> a -> b
$ DiffTime
tick
                     String -> IO ()
putStrLn forall a b. (a -> b) -> a -> b
$ String
"[" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
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
return String -> IO ()
f

-- | Show a byte in a visible format.
showByte :: Word8 -> String
showByte :: 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
showHex Word8
i String
""
           | Bool
True      = forall a. (Integral a, Show a) => a -> ShowS
showHex Word8
i String
""
  where c :: Char
c = Int -> Char
chr forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
i
        isVisible :: Bool
isVisible = Char -> Bool
isAscii Char
c Bool -> Bool -> Bool
&& Char -> Bool
isAlphaNum Char
c Bool -> Bool -> Bool
&& Char -> Bool
isSpace Char
c

-- | Show a list of bytes
showByteList :: [Word8] -> String
showByteList :: [Word8] -> String
showByteList [Word8]
bs =  String
"[" forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [[a]] -> [a]
intercalate String
", " (forall a b. (a -> b) -> [a] -> [b]
map Word8 -> String
showByte [Word8]
bs) forall a. [a] -> [a] -> [a]
++ String
"]"

-- | Show a number as a binary value
showBin :: (Integral a, Show a) => a -> String
showBin :: forall a. (Integral a, Show a) => a -> String
showBin a
n = forall a. (Integral a, Show a) => a -> (Int -> Char) -> a -> ShowS
showIntAtBase a
2 (forall a. [a] -> a
head forall 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 string
getString :: [Word8] -> String
getString :: [Word8] -> String
getString = forall a b. (a -> b) -> [a] -> [b]
map (Int -> Char
chr forall 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 happen
fromArduinoBytes (Word8
l:Word8
h:[Word8]
rest) = Word8
c forall a. a -> [a] -> [a]
: [Word8] -> [Word8]
fromArduinoBytes [Word8]
rest
  where c :: Word8
c = Word8
h forall a. Bits a => a -> Int -> a
`shiftL` Int
7 forall 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]
  where lo :: Word8
lo =  Word8
w             forall a. Bits a => a -> a -> a
.&. Word8
0x7F   -- first seven bits
        hi :: 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 comms
word2Bytes :: Word32 -> [Word8]
word2Bytes :: Word32 -> [Word8]
word2Bytes Word32
i = forall a b. (a -> b) -> [a] -> [b]
map forall 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 word2Bytes
bytes2Words :: (Word8, Word8, Word8, Word8) -> Word32
bytes2Words :: (Word8, Word8, Word8, Word8) -> Word32
bytes2Words (Word8
a, Word8
b, Word8
c, Word8
d) = forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
a forall a. Bits a => a -> Int -> a
`shiftL` Int
24 forall a. Bits a => a -> a -> a
.|. forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
b forall a. Bits a => a -> Int -> a
`shiftL` Int
16 forall a. Bits a => a -> a -> a
.|. forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
c forall a. Bits a => a -> Int -> a
`shiftL` Int
8 forall a. Bits a => a -> a -> a
.|. forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
d