{-# LANGUAGE OverloadedStrings, GeneralizedNewtypeDeriving #-}

module System.Hardware.BusPirate.I2C
  ( -- * Primitive operations
    I2cM
  , i2cMode
  , startBit
  , stopBit
  , readByte
  , ackBit
  , nackBit
  , AckNack(..)
  , bulkWrite
  , writeRead
    -- * Configuration
  , I2cConfig(..)
  , setConfig
  , I2cSpeed(..)
  , setSpeed
  ) where

import Control.Applicative
import Control.Monad (replicateM, when)
import Control.Monad.IO.Class
import Control.Monad.Trans.Either
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)
        
-- | Enter I2C mode and run given action
i2cMode :: I2cM a -> BusPirateM a
i2cMode (I2cM m) = commandExpect 0x2 "I2C1" >>  m

-- | Send a start bit
startBit :: I2cM ()
startBit = I2cM $ command 0x2

-- | Send a stop bit
stopBit :: I2cM ()
stopBit = I2cM $ command 0x3

-- | Read a byte
readByte :: I2cM Word8
readByte = I2cM $ putByte 0x4 >> getByte

data AckNack = Ack | Nack
             deriving (Show, Eq, Ord, Enum, Bounded)

-- | Send an ACK 
ackBit :: I2cM ()
ackBit = I2cM $ command 0x6

-- | Send a NACK 
nackBit :: I2cM ()
nackBit = I2cM $ command 0x7

-- | Write some bytes
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

data I2cConfig = I2cConfig { i2cPower      :: Bool
                           , i2cPullups    :: Bool
                           , i2cAux        :: Bool
                           , i2cChipSelect :: Bool
                           }
               deriving (Show)

-- | Set Bus Pirate I2C configuration bits
setConfig :: I2cConfig -> I2cM ()
setConfig config = I2cM $ 
    command $ 0x40
            + bit 3 (i2cPower config)
            + bit 2 (i2cPullups config)
            + bit 1 (i2cAux config)
            + bit 0 (i2cChipSelect config)
  where
    bit n True = 2^n
    bit _ _    = 0

data I2cSpeed = I2c_5kHz
              | I2c_50kHz
              | I2c_100kHz
              | I2c_400kHz
              deriving (Show, Eq, Ord, Enum, Bounded)
              
-- | Set I2C bus speed
setSpeed :: I2cSpeed -> I2cM ()
setSpeed speed = I2cM $ command $ fromIntegral $ 0x60 + fromEnum speed

-- | Send Start bit, write some bytes, then read some bytes (ACKing
-- each until the last), then send a stop bit
writeRead :: ByteString -> Int -> I2cM ByteString
writeRead send recv 
  | BS.length send > 0xffff = error "Too large send request"
  | recv > 0xffff           = error "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