{-# LANGUAGE OverloadedStrings, ForeignFunctionInterface #-}

-- |Library for controlling the GPIO pins on a Raspberry Pi (or any system using the Broadcom 2835 SOC). It is constructed

-- as a FFI wrapper over the BCM2835 library by Mike McCauley.

module System.RaspberryPi.GPIO (
    -- *Data types

    Pin(..),
    PinMode(..),
    LogicLevel,
    Address,
    SPIBitOrder(..),
    SPIPin(..),
    CPOL,
    CPHA,
    -- *General functions

    withGPIO,
    -- *GPIO specific functions

    setPinFunction,
    readPin,
    writePin,
    -- *I2C specific functions

    withI2C,
    setI2cClockDivider,
    setI2cBaudRate,
    writeI2C,
    readI2C,
    writeReadRSI2C,
    -- *SPI specific functions

    withAUXSPI,
    withSPI,
    chipSelectSPI,
    setBitOrderSPI,
    setChipSelectPolaritySPI,
    setClockDividerAUXSPI,
    setClockDividerSPI,
    setDataModeSPI,
    transferAUXSPI,
    transferSPI,
    transferManySPI
    ) where

-- FFI wrapper over the I2C portions of the BCM2835 library by Mike McCauley, also some utility functions to

-- make reading and writing simpler


import Control.Applicative ((<$>))
import Control.Exception
import Foreign
import Foreign.C
import Foreign.C.String
import qualified Data.ByteString as BS
import Data.Maybe
import Data.Tuple
import GHC.IO.Exception

------------------------------------------------------------------------------------------------------------------------------------

--------------------------------------------- Data types ---------------------------------------------------------------------------

-- |This describes the pins on the Raspberry Pi boards. Since the BCM2835 SOC internally uses different numbers (and these numbers 

-- differ between versions, the library internally translates this pin number to the correct number.

data Pin =  -- |Pins for the P1 connector of the V2 revision of the Raspberry Pi

            Pin03|Pin05|Pin07|Pin08|Pin10|Pin11|Pin12|Pin13|Pin15|Pin16|Pin18|Pin19|Pin21|Pin22|Pin23|Pin24|Pin26|Pin36|
            -- |Pins for the P5 connector of the V2 revision of the Raspberry Pi

            PinP5_03|PinP5_04|PinP5_05|PinP5_06|
            -- |Pins for the P1 connector of the V1 revision of the Raspberry Pi

            PinV1_03|PinV1_05|PinV1_07|PinV1_08|PinV1_10|PinV1_11|PinV1_12|PinV1_13|PinV1_15|PinV1_16|PinV1_18|PinV1_19|PinV1_21|
            PinV1_22|PinV1_23|PinV1_24|PinV1_26
            deriving (Pin -> Pin -> LogicLevel
forall a. (a -> a -> LogicLevel) -> (a -> a -> LogicLevel) -> Eq a
/= :: Pin -> Pin -> LogicLevel
$c/= :: Pin -> Pin -> LogicLevel
== :: Pin -> Pin -> LogicLevel
$c== :: Pin -> Pin -> LogicLevel
Eq,Int -> Pin -> ShowS
[Pin] -> ShowS
Pin -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Pin] -> ShowS
$cshowList :: [Pin] -> ShowS
show :: Pin -> String
$cshow :: Pin -> String
showsPrec :: Int -> Pin -> ShowS
$cshowsPrec :: Int -> Pin -> ShowS
Show)

-- |A GPIO pin can be either set to input mode, output mode or an alternative mode.

data PinMode = Input | Output | Alt0 | Alt1 | Alt2 | Alt3 | Alt4 | Alt5 deriving (PinMode -> PinMode -> LogicLevel
forall a. (a -> a -> LogicLevel) -> (a -> a -> LogicLevel) -> Eq a
/= :: PinMode -> PinMode -> LogicLevel
$c/= :: PinMode -> PinMode -> LogicLevel
== :: PinMode -> PinMode -> LogicLevel
$c== :: PinMode -> PinMode -> LogicLevel
Eq,Int -> PinMode -> ShowS
[PinMode] -> ShowS
PinMode -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PinMode] -> ShowS
$cshowList :: [PinMode] -> ShowS
show :: PinMode -> String
$cshow :: PinMode -> String
showsPrec :: Int -> PinMode -> ShowS
$cshowsPrec :: Int -> PinMode -> ShowS
Show)

instance Enum PinMode where -- bit strange, but just deriving Enum doesn't work because the numbers don't monotonically ascend

    fromEnum :: PinMode -> Int
fromEnum = forall a. HasCallStack => Maybe a -> a
fromJust forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup [(PinMode, Int)]
table
    toEnum :: Int -> PinMode
toEnum = forall a. HasCallStack => Maybe a -> a
fromJust forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> (b, a)
swap [(PinMode, Int)]
table)
table :: [(PinMode, Int)]
table = [(PinMode
Input, Int
0), (PinMode
Output, Int
1), (PinMode
Alt0, Int
4), (PinMode
Alt1, Int
5), (PinMode
Alt2, Int
6), (PinMode
Alt3, Int
7), (PinMode
Alt4, Int
3), (PinMode
Alt5, Int
2)]

-- |This describes the address of an I2C slave.

type Address = Word8 --adress of an I2C slave


-- |Either high or low.

type LogicLevel = Bool

-- |Specifies the SPI data bit ordering.

data SPIBitOrder = LSBFirst | MSBFirst

-- |This describes which Chip Select pins are asserted (used in SPI communications).

data SPIPin = CS0 | CS1 | CS2 | CSNONE deriving (SPIPin -> SPIPin -> LogicLevel
forall a. (a -> a -> LogicLevel) -> (a -> a -> LogicLevel) -> Eq a
/= :: SPIPin -> SPIPin -> LogicLevel
$c/= :: SPIPin -> SPIPin -> LogicLevel
== :: SPIPin -> SPIPin -> LogicLevel
$c== :: SPIPin -> SPIPin -> LogicLevel
Eq, Int -> SPIPin -> ShowS
[SPIPin] -> ShowS
SPIPin -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SPIPin] -> ShowS
$cshowList :: [SPIPin] -> ShowS
show :: SPIPin -> String
$cshow :: SPIPin -> String
showsPrec :: Int -> SPIPin -> ShowS
$cshowsPrec :: Int -> SPIPin -> ShowS
Show, Int -> SPIPin
SPIPin -> Int
SPIPin -> [SPIPin]
SPIPin -> SPIPin
SPIPin -> SPIPin -> [SPIPin]
SPIPin -> SPIPin -> SPIPin -> [SPIPin]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: SPIPin -> SPIPin -> SPIPin -> [SPIPin]
$cenumFromThenTo :: SPIPin -> SPIPin -> SPIPin -> [SPIPin]
enumFromTo :: SPIPin -> SPIPin -> [SPIPin]
$cenumFromTo :: SPIPin -> SPIPin -> [SPIPin]
enumFromThen :: SPIPin -> SPIPin -> [SPIPin]
$cenumFromThen :: SPIPin -> SPIPin -> [SPIPin]
enumFrom :: SPIPin -> [SPIPin]
$cenumFrom :: SPIPin -> [SPIPin]
fromEnum :: SPIPin -> Int
$cfromEnum :: SPIPin -> Int
toEnum :: Int -> SPIPin
$ctoEnum :: Int -> SPIPin
pred :: SPIPin -> SPIPin
$cpred :: SPIPin -> SPIPin
succ :: SPIPin -> SPIPin
$csucc :: SPIPin -> SPIPin
Enum)

-- |Clock polarity (CPOL) for SPI transmissions.

type CPOL = Bool

-- |Clock phase (CPHA) for SPI transmissions.

type CPHA = Bool

------------------------------------------------------------------------------------------------------------------------------------

------------------------------------------ Foreign imports -------------------------------------------------------------------------


----------------------------------------- Library functions ------------------------------------------------------------------------

--initialises /dev/mem and obtaining the proper pointers to device registers. Don't use any other functions if this fails!

foreign import ccall unsafe "bcm2835.h bcm2835_init" initBCM2835 :: IO Int
--deallocates any memory, closes /dev/mem and stops the library in general

foreign import ccall unsafe "bcm2835.h bcm2835_close" stopBCM2835 :: IO Int
--sets debug level

foreign import ccall unsafe "bcm2835.h bcm2835_set_debug" setDebugBCM2835 :: CUChar -> IO ()

---------------------------------------- Basic GPIO functions ----------------------------------------------------------------------

-- setFunction (input/output)

foreign import ccall unsafe "bcm2835.h bcm2835_gpio_fsel" c_setPinFunction    :: CUChar -> CUChar -> IO ()
-- setPin (zet een outputpin hoog/laag)

foreign import ccall unsafe "bcm2835.h bcm2835_gpio_write" c_writePin         :: CUChar -> CUChar -> IO ()
-- readPin (geeft weer of een pin hoog/laag is)

foreign import ccall unsafe "bcm2835.h bcm2835_gpio_lev" c_readPin            :: CUChar -> IO CUChar

------------------------------------------- I2C functions --------------------------------------------------------------------------

--inits the i2c pins

foreign import ccall unsafe "bcm2835.h bcm2835_i2c_begin" initI2C   :: IO ()
--resets the i2c pins

foreign import ccall unsafe "bcm2835.h bcm2835_i2c_end"   stopI2C   :: IO ()

--sets the slave address used

foreign import ccall unsafe "bcm2835.h bcm2835_i2c_setSlaveAddress" c_setSlaveAddressI2C ::   CUChar -> IO ()
--sets the I2C bus clock divider (and thus, the speed)

foreign import ccall unsafe "bcm2835.h bcm2835_i2c_setClockDivider" c_setClockDividerI2C ::   CUShort -> IO ()
--sets the I2C bus baud rate (100000 for the default 100khz)

foreign import ccall unsafe "bcm2835.h bcm2835_i2c_set_baudrate"    c_setBaudRateI2C ::       CUInt -> IO ()

-- writes some bytes to the bus

foreign import ccall unsafe "bcm2835.h bcm2835_i2c_write" c_writeI2C :: CString -> CUInt -> IO CUChar
--read some bytes from the bus

foreign import ccall unsafe "bcm2835.h bcm2835_i2c_read" c_readI2C :: CString -> CUShort -> IO CUChar
--reads a certain register with the repeated start method

foreign import ccall unsafe "bcm2835.h bcm2835_i2c_write_read_rs" c_writeReadRSI2C :: CString -> CUInt -> CString -> CUInt -> IO CUChar

------------------------------------------- SPI functions --------------------------------------------------------------------------

--inits the SPI pins

foreign import ccall unsafe "bcm2835.h bcm2835_spi_begin" initSPI   :: IO ()
--resets the SPI pins

foreign import ccall unsafe "bcm2835.h bcm2835_spi_end"   stopSPI   :: IO ()

--Transfers one byte to and from the currently selected SPI slave

foreign import ccall unsafe "bcm2835.h bcm2835_spi_transfer"        c_transferSPI :: CUChar -> IO CUChar
--Transfers multiple bytes to and from the currently selected SPI slave

foreign import ccall unsafe "bcm2835.h bcm2835_spi_transfern"      c_transferManySPI :: CString -> CUInt -> IO ()
--Changes the chip select pins

foreign import ccall unsafe "bcm2835.h bcm2835_spi_chipSelect"      c_chipSelectSPI :: CUChar -> IO ()

--Set the bit order to be used for transmit and receive.

foreign import ccall unsafe "bcm2835.h bcm2835_spi_setBitOrder"           c_setBitOrder :: CUChar -> IO ()
--Sets whether SPI Chip Select pulls pins high or low.

foreign import ccall unsafe "bcm2835.h bcm2835_spi_setChipSelectPolarity" c_setChipSelectPolarity :: CUChar -> CUChar -> IO ()
--Sets the SPI clock divider and therefore the SPI clock speed.

foreign import ccall unsafe "bcm2835.h bcm2835_spi_setClockDivider"       c_setClockDividerSPI :: CUShort -> IO ()
--Sets the data mode used (phase/polarity)

foreign import ccall unsafe "bcm2835.h bcm2835_spi_setDataMode"     c_setDataModeSPI :: CUChar -> IO ()

----------------------------------------- AUX SPI functions ------------------------------------------------------------------------

--inits the AUX SPI pins

foreign import ccall unsafe "bcm2835.h bcm2835_aux_spi_begin" initAUXSPI   :: IO Int
--resets the AUX SPI pins

foreign import ccall unsafe "bcm2835.h bcm2835_aux_spi_end"   stopAUXSPI   :: IO ()

--Transfers one byte to and from the currently selected SPI slave

foreign import ccall unsafe "bcm2835.h bcm2835_aux_spi_transfer"       c_transferAUXSPI :: CUChar -> IO CUChar

--Sets the SPI clock divider and therefore the SPI clock speed.

foreign import ccall unsafe "bcm2835.h bcm2835_aux_spi_setClockDivider"     c_setClockDividerAUXSPI :: CUShort -> IO ()

------------------------------------------------------------------------------------------------------------------------------------

------------------------------------------ Exportable functions --------------------------------------------------------------------


------------------------------------------- Utility functions ----------------------------------------------------------------------

-- |Any IO computation that accesses the GPIO pins using this library should be wrapped with this function; ie @withGPIO $ do foo@.

-- It prepares the file descriptors to /dev/mem and makes sure everything is safely deallocated if an exception occurs. The behavior

-- when accessing the GPIO outside of this function is undefined.

withGPIO :: IO a -> IO a
withGPIO :: forall a. IO a -> IO a
withGPIO IO a
f = forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket    IO Int
initBCM2835
                        (forall a b. a -> b -> a
const IO Int
stopBCM2835) --const because you don't care about the output of initBCM2835

                        (\Int
a -> if Int
aforall a. Eq a => a -> a -> LogicLevel
==Int
0 then forall e a. Exception e => e -> IO a
throwIO IOException
ioe else IO a
f) -- init returning 0 is not good

                            where ioe :: IOException
ioe = Maybe Handle
-> IOErrorType
-> String
-> String
-> Maybe CInt
-> Maybe String
-> IOException
IOError forall a. Maybe a
Nothing IOErrorType
IllegalOperation String
"GPIO: " String
"Unable to start GPIO." forall a. Maybe a
Nothing forall a. Maybe a
Nothing

-- |Any IO computation that uses the I2C bus using this library should be wrapped with this function; ie @withI2C $ do foo@.

-- It prepares the relevant pins for use with the I2C protocol and makes sure everything is safely returned to normal if an exception

-- occurs. If you only use the GPIO pins for I2C, you can do @withGPIO . withI2C $ do foo@ and it will work as expected. WARNING: 

-- after this function returns, the I2C pins will be set to Input, so use 'setPinFunction' if you want to use them for output.

withI2C :: IO a -> IO a
withI2C :: forall a. IO a -> IO a
withI2C IO a
f = forall a b c. IO a -> IO b -> IO c -> IO c
bracket_    IO ()
initI2C
                        IO ()
stopI2C
                        IO a
f

-- |Any IO computation that uses the SPI functionality using this library should be wrapped with this function; ie @withSPI $ do foo@.

-- It prepares the relevant pins for use with the SPI protocol and makes sure everything is safely returned to normal if an exception

-- occurs. If you only use the GPIO pins for SPI, you can do @withGPIO . withSPI $ do foo@ and it will work as expected. WARNING: 

-- after this function returns, the SPI pins will be set to Input, so use 'setPinFunction' if you want to use them for output.

withSPI :: IO a -> IO a
withSPI :: forall a. IO a -> IO a
withSPI IO a
f = forall a b c. IO a -> IO b -> IO c -> IO c
bracket_    IO ()
initSPI
                        IO ()
stopSPI
                        IO a
f
                        
-- Possible error results for I2C functions. (not exported)

actOnResult :: CUChar -> CStringLen -> IO BS.ByteString
actOnResult :: CUChar -> CStringLen -> IO ByteString
actOnResult CUChar
rr CStringLen
buf = case CUChar
rr of
    CUChar
0x01 -> forall e a. Exception e => e -> IO a
throwIO forall a b. (a -> b) -> a -> b
$ Maybe Handle
-> IOErrorType
-> String
-> String
-> Maybe CInt
-> Maybe String
-> IOException
IOError forall a. Maybe a
Nothing IOErrorType
IllegalOperation String
"I2C: " String
"Received an unexpected NACK." forall a. Maybe a
Nothing forall a. Maybe a
Nothing
    CUChar
0x02 -> forall e a. Exception e => e -> IO a
throwIO forall a b. (a -> b) -> a -> b
$ Maybe Handle
-> IOErrorType
-> String
-> String
-> Maybe CInt
-> Maybe String
-> IOException
IOError forall a. Maybe a
Nothing IOErrorType
IllegalOperation String
"I2C: " String
"Received Clock Stretch Timeout." forall a. Maybe a
Nothing forall a. Maybe a
Nothing 
    CUChar
0x04 -> forall e a. Exception e => e -> IO a
throwIO forall a b. (a -> b) -> a -> b
$ Maybe Handle
-> IOErrorType
-> String
-> String
-> Maybe CInt
-> Maybe String
-> IOException
IOError forall a. Maybe a
Nothing IOErrorType
IllegalOperation String
"I2C: " String
"Not all data was read." forall a. Maybe a
Nothing forall a. Maybe a
Nothing
    CUChar
0x00 -> CStringLen -> IO ByteString
BS.packCStringLen CStringLen
buf --convert C buffer to a bytestring



-- Mapping raspberry pi pin number to internal bmc2835 pin number, ugly solution, but meh. Also, the existence of mutiple versions

-- of the pin layout makes this the most elegant solution without resorting to state monads (which I don't want to do because that

-- would hamper the simplicity of having writePin and readPin be simple IO actions). As this function isn't exported anyway, the

-- user should never be troubled by all this.

getHwPin :: Pin -> CUChar
--P1 connector on V1 boards

getHwPin :: Pin -> CUChar
getHwPin Pin
PinV1_03 = CUChar
0
getHwPin Pin
PinV1_05 = CUChar
1
getHwPin Pin
PinV1_07 = CUChar
4
getHwPin Pin
PinV1_08 = CUChar
14
getHwPin Pin
PinV1_10 = CUChar
15
getHwPin Pin
PinV1_11 = CUChar
17
getHwPin Pin
PinV1_12 = CUChar
18
getHwPin Pin
PinV1_13 = CUChar
21
getHwPin Pin
PinV1_15 = CUChar
22
getHwPin Pin
PinV1_16 = CUChar
23
getHwPin Pin
PinV1_18 = CUChar
24
getHwPin Pin
PinV1_19 = CUChar
10
getHwPin Pin
PinV1_21 = CUChar
9
getHwPin Pin
PinV1_22 = CUChar
25
getHwPin Pin
PinV1_23 = CUChar
11
getHwPin Pin
PinV1_24 = CUChar
8
getHwPin Pin
PinV1_26 = CUChar
7
--P1 connector on V2 boards

getHwPin Pin
Pin03 = CUChar
2
getHwPin Pin
Pin05 = CUChar
3
getHwPin Pin
Pin07 = CUChar
4
getHwPin Pin
Pin08 = CUChar
14
getHwPin Pin
Pin10 = CUChar
15
getHwPin Pin
Pin11 = CUChar
17
getHwPin Pin
Pin12 = CUChar
18
getHwPin Pin
Pin13 = CUChar
27
getHwPin Pin
Pin15 = CUChar
22
getHwPin Pin
Pin16 = CUChar
23
getHwPin Pin
Pin18 = CUChar
24
getHwPin Pin
Pin19 = CUChar
10
getHwPin Pin
Pin21 = CUChar
9
getHwPin Pin
Pin22 = CUChar
25
getHwPin Pin
Pin23 = CUChar
11
getHwPin Pin
Pin24 = CUChar
8
getHwPin Pin
Pin26 = CUChar
7
getHwPin Pin
Pin36 = CUChar
16
--for the P5 connector on V2 boards

getHwPin Pin
PinP5_03 = CUChar
28
getHwPin Pin
PinP5_04 = CUChar
29
getHwPin Pin
PinP5_05 = CUChar
30
getHwPin Pin
PinP5_06 = CUChar
31

------------------------------------------- GPIO functions -------------------------------------------------------------------------

-- |Sets the pin to either 'Input' or 'Output' mode.

setPinFunction :: Pin -> PinMode -> IO ()
setPinFunction :: Pin -> PinMode -> IO ()
setPinFunction Pin
pin PinMode
mode = CUChar -> CUChar -> IO ()
c_setPinFunction (Pin -> CUChar
getHwPin Pin
pin) (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall a. Enum a => a -> Int
fromEnum PinMode
mode)

-- |Sets the specified pin to either 'True' or 'False'.

writePin :: Pin -> LogicLevel -> IO () --wat gebeurt er als het geen output pin is?

writePin :: Pin -> LogicLevel -> IO ()
writePin Pin
pin LogicLevel
level = CUChar -> CUChar -> IO ()
c_writePin (Pin -> CUChar
getHwPin Pin
pin) (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall a. Enum a => a -> Int
fromEnum LogicLevel
level)

-- |Returns the current state of the specified pin.

readPin :: Pin -> IO LogicLevel
readPin :: Pin -> IO LogicLevel
readPin Pin
pin = (forall a. Enum a => Int -> a
toEnum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CUChar -> IO CUChar
c_readPin (Pin -> CUChar
getHwPin Pin
pin)

-------------------------------------------- I2C functions -------------------------------------------------------------------------

--not exported, only used internally

setI2cAddress :: Address -> IO ()
setI2cAddress :: Word8 -> IO ()
setI2cAddress Word8
a = CUChar -> IO ()
c_setSlaveAddressI2C forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
a

-- |Sets the clock divider for (and hence the speed of) the I2C bus.

setI2cClockDivider :: Word16 -> IO ()
setI2cClockDivider :: Word16 -> IO ()
setI2cClockDivider Word16
a = CUShort -> IO ()
c_setClockDividerI2C forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
a

-- |Sets the baud rate of the I2C bus.

setI2cBaudRate :: Word32 -> IO ()
setI2cBaudRate :: Word32 -> IO ()
setI2cBaudRate Word32
a = CUInt -> IO ()
c_setBaudRateI2C forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
a

-- |Writes the data in the 'ByteString' to the specified I2C 'Address'. Throws an IOException if an error occurs.

writeI2C :: Address -> BS.ByteString -> IO () --writes a bytestring to the specified address

writeI2C :: Word8 -> ByteString -> IO ()
writeI2C Word8
address ByteString
by = forall a. ByteString -> (CStringLen -> IO a) -> IO a
BS.useAsCStringLen ByteString
by forall a b. (a -> b) -> a -> b
$ \(Ptr CChar
bs,Int
len) -> do
    Word8 -> IO ()
setI2cAddress Word8
address
    CUChar
readresult <- Ptr CChar -> CUInt -> IO CUChar
c_writeI2C Ptr CChar
bs (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len)
    case CUChar
readresult of
        CUChar
0x01 -> forall e a. Exception e => e -> IO a
throwIO forall a b. (a -> b) -> a -> b
$ Maybe Handle
-> IOErrorType
-> String
-> String
-> Maybe CInt
-> Maybe String
-> IOException
IOError forall a. Maybe a
Nothing IOErrorType
IllegalOperation String
"I2C: " String
"Received an unexpected NACK." forall a. Maybe a
Nothing forall a. Maybe a
Nothing
        CUChar
0x02 -> forall e a. Exception e => e -> IO a
throwIO forall a b. (a -> b) -> a -> b
$ Maybe Handle
-> IOErrorType
-> String
-> String
-> Maybe CInt
-> Maybe String
-> IOException
IOError forall a. Maybe a
Nothing IOErrorType
IllegalOperation String
"I2C: " String
"Received Clock Stretch Timeout." forall a. Maybe a
Nothing forall a. Maybe a
Nothing 
        CUChar
0x04 -> forall e a. Exception e => e -> IO a
throwIO forall a b. (a -> b) -> a -> b
$ Maybe Handle
-> IOErrorType
-> String
-> String
-> Maybe CInt
-> Maybe String
-> IOException
IOError forall a. Maybe a
Nothing IOErrorType
IllegalOperation String
"I2C: " String
"Not all data was read." forall a. Maybe a
Nothing forall a. Maybe a
Nothing
        CUChar
0x00 -> forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- |Reads num bytes from the specified 'Address'. Throws an IOException if an error occurs.

readI2C :: Address -> Int -> IO BS.ByteString --reads num bytes from the specified address

readI2C :: Word8 -> Int -> IO ByteString
readI2C Word8
address Int
num = forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes (Int
numforall a. Num a => a -> a -> a
+Int
1) forall a b. (a -> b) -> a -> b
$ \Ptr CChar
buf -> do --is the +1 necessary??

    Word8 -> IO ()
setI2cAddress Word8
address
    CUChar
readresult <- Ptr CChar -> CUShort -> IO CUChar
c_readI2C Ptr CChar
buf (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
num)
    CUChar -> CStringLen -> IO ByteString
actOnResult CUChar
readresult (Ptr CChar
buf, Int
num)

-- |Writes the data in the 'ByteString' to the specified 'Address', then issues a "repeated start" (with no prior stop) and then 

-- reads num bytes from the same 'Address'. Necessary for devices that require such behavior, such as the MLX90620.

writeReadRSI2C :: Address -> BS.ByteString -> Int -> IO BS.ByteString
writeReadRSI2C :: Word8 -> ByteString -> Int -> IO ByteString
writeReadRSI2C Word8
address ByteString
by Int
num = forall a. ByteString -> (CStringLen -> IO a) -> IO a
BS.useAsCStringLen ByteString
by forall a b. (a -> b) -> a -> b
$ \(Ptr CChar
bs,Int
len) -> do --marshall the register-containing bytestring

    forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
num forall a b. (a -> b) -> a -> b
$ \Ptr CChar
buf -> do --allocate a buffer for the response

        Word8 -> IO ()
setI2cAddress Word8
address
        CUChar
readresult <- Ptr CChar -> CUInt -> Ptr CChar -> CUInt -> IO CUChar
c_writeReadRSI2C Ptr CChar
bs (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len) Ptr CChar
buf (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
num)
        CUChar -> CStringLen -> IO ByteString
actOnResult CUChar
readresult (Ptr CChar
buf, Int
num)
        
-------------------------------------------- SPI functions -------------------------------------------------------------------------

-- |Sets the chip select pin(s). When a transfer is made with 'transferSPI' or 'transferManySPI', the selected pin(s) will be 

-- asserted during the transfer. 

chipSelectSPI :: SPIPin -> IO ()
chipSelectSPI :: SPIPin -> IO ()
chipSelectSPI SPIPin
pin = CUChar -> IO ()
c_chipSelectSPI (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Enum a => a -> Int
fromEnum forall a b. (a -> b) -> a -> b
$ SPIPin
pin)

-- |Sets the SPI clock divider and therefore the SPI clock speed.

setClockDividerSPI :: Word16 -> IO ()
setClockDividerSPI :: Word16 -> IO ()
setClockDividerSPI Word16
a = CUShort -> IO ()
c_setClockDividerSPI forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
a

-- |Set the bit order to be used for transmit and receive. The bcm2835 SPI0 only supports MSBFirst,

-- so if you select LSBFirst, the bytes will be reversed in software.

-- The library defaults to MSBFirst.

setBitOrderSPI :: SPIBitOrder -> IO ()
setBitOrderSPI :: SPIBitOrder -> IO ()
setBitOrderSPI SPIBitOrder
LSBFirst = CUChar -> IO ()
c_setBitOrder CUChar
0
setBitOrderSPI SPIBitOrder
MSBFirst = CUChar -> IO ()
c_setBitOrder CUChar
1

-- |Sets the chip select pin polarity for a given pin(s). When a transfer is made with 'transferSPI' or 'transferManySPI', the 

-- currently selected chip select pin(s) will be asserted to the LogicLevel supplied. When transfers are not happening, the chip 

-- select pin(s) return to the complement (inactive) value. 

setChipSelectPolaritySPI :: SPIPin -> LogicLevel -> IO ()
setChipSelectPolaritySPI :: SPIPin -> LogicLevel -> IO ()
setChipSelectPolaritySPI SPIPin
pin LogicLevel
level = CUChar -> CUChar -> IO ()
c_setChipSelectPolarity (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Enum a => a -> Int
fromEnum forall a b. (a -> b) -> a -> b
$ SPIPin
pin) (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Enum a => a -> Int
fromEnum forall a b. (a -> b) -> a -> b
$ LogicLevel
level)

-- |Sets the SPI clock polarity and phase (ie, CPOL and CPHA)

setDataModeSPI :: (CPOL,CPHA) -> IO ()
setDataModeSPI :: (LogicLevel, LogicLevel) -> IO ()
setDataModeSPI (LogicLevel
False,LogicLevel
False) = CUChar -> IO ()
c_setDataModeSPI CUChar
0
setDataModeSPI (LogicLevel
False,LogicLevel
True)  = CUChar -> IO ()
c_setDataModeSPI CUChar
1
setDataModeSPI (LogicLevel
True,LogicLevel
False)  = CUChar -> IO ()
c_setDataModeSPI CUChar
2
setDataModeSPI (LogicLevel
True,LogicLevel
True)   = CUChar -> IO ()
c_setDataModeSPI CUChar
3

-- |Transfers one byte to and from the currently selected SPI slave. Asserts the currently selected CS pins (as previously set by 

-- 'chipSelectSPI') during the transfer. Clocks the 8 bit value out on MOSI, and simultaneously clocks in data from MISO. Returns the 

-- read data byte from the slave.

transferSPI :: Word8 -> IO Word8
transferSPI :: Word8 -> IO Word8
transferSPI Word8
input = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CUChar -> IO CUChar
c_transferSPI (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
input)

-- |Transfers any number of bytes to and from the currently selected SPI slave, one byte at a time. Asserts the currently selected 

-- CS pins (as previously set by 'chipSelectSPI') during the transfer. Clocks 8 bit bytes out on MOSI, and simultaneously clocks in 

-- data from MISO.

transferManySPI :: [Word8] -> IO [Word8]
transferManySPI :: [Word8] -> IO [Word8]
transferManySPI [Word8]
input = forall a. ByteString -> (CStringLen -> IO a) -> IO a
BS.useAsCStringLen ([Word8] -> ByteString
BS.pack [Word8]
input) forall a b. (a -> b) -> a -> b
$ \(Ptr CChar
buf,Int
len) -> do --convert input list to bytestring and from there to CString

    --returns the read bytes in buf. Uses CStringLen because the responses might have zero bytes and this will influence the result if a

    --normal CString is used

    Ptr CChar -> CUInt -> IO ()
c_transferManySPI Ptr CChar
buf (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len) --

    (CStringLen -> IO ByteString
BS.packCStringLen (Ptr CChar
buf,Int
len)) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [Word8]
BS.unpack -- translate back from a buffer to a bytestring to a [Word8]

        
------------------------------------------ AUX SPI functions -----------------------------------------------------------------------


-- |Any IO computation that uses the AUX SPI functionality using this library should be wrapped with this function; ie @withAUXSPI $ do foo@.

-- It prepares the relevant pins for use with the SPI protocol and makes sure everything is safely returned to normal if an exception

-- occurs. If you only use the GPIO pins for SPI, you can do @withGPIO . withAUXSPI $ do foo@ and it will work as expected. WARNING: 

-- after this function returns, the SPI pins will be set to Input, so use 'setPinFunction' if you want to use them for output.

withAUXSPI :: IO a -> IO a
withAUXSPI :: forall a. IO a -> IO a
withAUXSPI IO a
f = forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket IO Int
initAUXSPI
                       (forall a b. a -> b -> a
const IO ()
stopAUXSPI)
                       (\Int
r -> if Int
rforall a. Eq a => a -> a -> LogicLevel
==Int
0 then forall e a. Exception e => e -> IO a
throwIO IOException
ioe else IO a
f)
                            where ioe :: IOException
ioe = Maybe Handle
-> IOErrorType
-> String
-> String
-> Maybe CInt
-> Maybe String
-> IOException
IOError forall a. Maybe a
Nothing IOErrorType
IllegalOperation String
"AUXAPI: " String
"Unable to start AUXAPI." forall a. Maybe a
Nothing forall a. Maybe a
Nothing

-- |Sets the AUX SPI clock divider and therefore the SPI clock speed.

setClockDividerAUXSPI :: Word16 -> IO ()
setClockDividerAUXSPI :: Word16 -> IO ()
setClockDividerAUXSPI Word16
a = CUShort -> IO ()
c_setClockDividerAUXSPI forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
a

-- |Transfers one byte to and from the SPI slave. Asserts the CS2 pin during the transfer. Clocks the 8 bit value out

-- on MOSI, and simultaneously clocks in data from MISO. Returns the read data byte from the slave.

transferAUXSPI :: Word8 -> IO Word8
transferAUXSPI :: Word8 -> IO Word8
transferAUXSPI Word8
input = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CUChar -> IO CUChar
c_transferAUXSPI (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
input)