-------------------------------------------------------------------------------
-- |
-- 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
nInt -> Int -> Int
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 = (String -> IO ()) -> IO (String -> IO ())
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (IO () -> String -> IO ()
forall a b. a -> b -> a
const (() -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()))
mkDebugPrinter Bool
True  = do
        IORef Int
cnt <- Int -> IO (IORef Int)
forall a. a -> IO (IORef a)
newIORef (Int
1::Int)
        let f :: String -> IO ()
f String
s = do Int
i <- IORef Int -> IO Int
forall a. IORef a -> IO a
readIORef IORef Int
cnt
                     IORef Int -> Int -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef Int
cnt (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
                     DiffTime
tick <- UTCTime -> DiffTime
utctDayTime (UTCTime -> DiffTime) -> IO UTCTime -> IO DiffTime
forall a b. (a -> b) -> IO a -> IO b
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 = Rational -> Integer
forall b. Integral b => Rational -> b
forall a b. (RealFrac a, Integral b) => a -> b
round (Rational -> Integer)
-> (DiffTime -> Rational) -> DiffTime -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Integer -> Rational
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
precision Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
*) (Rational -> Rational)
-> (DiffTime -> Rational) -> DiffTime -> Rational
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DiffTime -> Rational
forall a. Real a => a -> Rational
toRational (DiffTime -> Integer) -> DiffTime -> Integer
forall a b. (a -> b) -> a -> b
$ DiffTime
tick
                     String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"[" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
i String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
":" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Integer -> String
forall a. Show a => a -> String
show (Integer
micro :: Integer) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"] hArduino: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s
        (String -> IO ()) -> IO (String -> IO ())
forall a. a -> IO a
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 Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
0xf  = Char
'0' Char -> String -> String
forall a. a -> [a] -> [a]
: Word8 -> String -> String
forall a. Integral a => a -> String -> String
showHex Word8
i String
""
           | Bool
True      = Word8 -> String -> String
forall a. Integral a => a -> String -> String
showHex Word8
i String
""
  where c :: Char
c = Int -> Char
chr (Int -> Char) -> Int -> Char
forall a b. (a -> b) -> a -> b
$ Word8 -> Int
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
"[" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " ((Word8 -> String) -> [Word8] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Word8 -> String
showByte [Word8]
bs) String -> String -> String
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 = a -> (Int -> Char) -> a -> String -> String
forall a. Integral a => a -> (Int -> Char) -> a -> String -> String
showIntAtBase a
2 (String -> Char
forall a. HasCallStack => [a] -> a
head (String -> Char) -> (Int -> String) -> Int -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String
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 = (Word8 -> Char) -> [Word8] -> String
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Char
chr (Int -> Char) -> (Word8 -> Int) -> Word8 -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) ([Word8] -> String) -> ([Word8] -> [Word8]) -> [Word8] -> String
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 Word8 -> [Word8] -> [Word8]
forall a. a -> [a] -> [a]
: [Word8] -> [Word8]
fromArduinoBytes [Word8]
rest
  where c :: Word8
c = Word8
h Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`shiftL` Int
7 Word8 -> Word8 -> Word8
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             Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0x7F   -- first seven bits
        hi :: Word8
hi = (Word8
w Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`shiftR` Int
7) Word8 -> Word8 -> Word8
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 = (Word32 -> Word8) -> [Word32] -> [Word8]
forall a b. (a -> b) -> [a] -> [b]
map Word32 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral [(Word32
i Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftR` Int
24) Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. Word32
0xFF, (Word32
i Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftR` Int
16) Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. Word32
0xFF, (Word32
i Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftR`  Int
8) Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. Word32
0xFF, Word32
i Word32 -> Word32 -> Word32
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) = Word8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
a Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftL` Int
24 Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|. Word8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
b Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftL` Int
16 Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|. Word8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
c Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftL` Int
8 Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|. Word8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
d