module System.Hardware.BusPirate.I2C
(
I2cM
, i2cMode
, startBit
, stopBit
, readByte
, ackBit
, nackBit
, bulkWrite
, PeripheralConfig(..)
, setConfig
, I2cSpeed(..)
, setSpeed
, I2CAddress
, from7Bit
, from8Bit
, readAddr
, writeAddr
, writeReg
, readReg
, readReg'
) where
import Control.Applicative
import Control.Monad (replicateM, when, void)
import Control.Monad.IO.Class
import Control.Monad.Trans.Either
import Data.Bits
import Data.Word
import Data.List (intercalate)
import qualified Data.ByteString as BS
import Data.ByteString (ByteString)
import System.Hardware.BusPirate.Core
newtype I2cM a = I2cM (BusPirateM a)
deriving (Functor, Applicative, Monad, MonadIO)
err :: String -> I2cM a
err = I2cM . BPM . left
i2cMode :: I2cM a -> BusPirateM a
i2cMode (I2cM m) = commandExpect 0x2 "I2C1" >> m
startBit :: I2cM ()
startBit = I2cM $ command 0x2
stopBit :: I2cM ()
stopBit = I2cM $ command 0x3
readByte :: I2cM Word8
readByte = I2cM $ putByte 0x4 >> getByte
ackBit :: I2cM ()
ackBit = I2cM $ command 0x6
nackBit :: I2cM ()
nackBit = I2cM $ command 0x7
data AckNack = Ack | Nack
deriving (Show, Eq, Ord, Enum, Bounded)
bulkWrite :: ByteString -> I2cM ()
bulkWrite d
| BS.null d = return ()
| BS.length d > 16 = I2cM $ BPM $ left "Too many bytes"
| otherwise = I2cM $ do
command $ fromIntegral $ 0x10 + BS.length d 1
put d
acks <- replicateM (BS.length d) $ toEnum . fromIntegral <$> getByte
case map fst $ filter (\(n,a)->a /= Ack) $ zip [0..] acks of
[] -> return ()
nacks -> let nacks' = intercalate ", " $ map show nacks
bytes = if length nacks > 1 then "bytes" else "byte"
in fail $ "Nack after "++bytes++" "++nacks'++" during bulkWrite of "++show d
setConfig :: PeripheralConfig -> I2cM ()
setConfig config = I2cM $ setPeripherals config
data I2cSpeed = I2c_5kHz
| I2c_50kHz
| I2c_100kHz
| I2c_400kHz
deriving (Show, Eq, Ord, Enum, Bounded)
setSpeed :: I2cSpeed -> I2cM ()
setSpeed speed = I2cM $ command $ fromIntegral $ 0x60 + fromEnum speed
writeRead :: ByteString -> Int -> I2cM ByteString
writeRead send recv
| BS.length send > 0xffff = err "Too large send request"
| recv > 0xffff = err "Too large recieve request"
| otherwise = I2cM $ do
putByte 0x8
putWord16 $ fromIntegral $ BS.length send
putWord16 $ fromIntegral $ recv
put send
status <- getByte
case status of
0x00 -> fail "writeRead: Failed"
0x01 -> get recv
newtype I2CAddress = I2cAddr Word8
from7Bit :: Word8 -> I2CAddress
from7Bit = I2cAddr . (`shiftL` 1)
from8Bit :: Word8 -> I2CAddress
from8Bit = I2cAddr . (`clearBit` 0)
readAddr :: I2CAddress -> Word8
readAddr (I2cAddr n) = n + 1
writeAddr :: I2CAddress -> Word8
writeAddr (I2cAddr n) = n
type Register = Word8
readReg' :: I2CAddress -> Word8 -> Int -> I2cM BS.ByteString
readReg' addr reg length = do
startBit
bulkWrite $ BS.pack [writeAddr addr, reg]
writeRead (BS.singleton $ readAddr addr) length
readReg :: I2CAddress -> Word8 -> I2cM Word8
readReg addr reg = BS.head <$> readReg' addr reg 1
writeReg :: I2CAddress -> Word8 -> Word8 -> I2cM ()
writeReg addr reg value = do
void $ writeRead (BS.pack [writeAddr addr, reg, value]) 0