packages feed

h2c (empty) → 1.0.0

raw patch · 6 files changed

+315/−0 lines, 6 filesdep +basedep +bytestringdep +mtlsetup-changed

Dependencies added: base, bytestring, mtl, resourcet

Files

+ LICENSE view
@@ -0,0 +1,19 @@+Copyright (c) 2017 Edward Amsden++Permission is hereby granted, free of charge, to any person obtaining a copy+of this software and associated documentation files (the "Software"), to deal+in the Software without restriction, including without limitation the rights+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the Software is+furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in all+copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+SOFTWARE.
+ README.md view
@@ -0,0 +1,17 @@+# h2c: Haskell bindings to Linux I2C API++H2C is a binding to the Linux i2c-tools/i2c-dev API.+It uses the I2C_RDWR ioctl for repeated-start communications between master and slave.++## Notes+ - You'll probably have to run as root. Getting regular users direct access to i2c busses on Linux is tricky.+ - The Linux i2c-stub driver that you might think would be useful for testing doesn't support the I2C_RDWR ioctl.+   This is why, if you try to use it, you'll get the "invalid argument" error.++## Documentation+` $ stack haddock --open`, find module `System.IO.I2C`++BE CAREFUL WITH I2C. It can be used to poke at things like your graphics card, fans, &c.++See my library [bno055-haskell](https://bitbucket.org/fmapE/bno055-haskell) for examples of h2c in use.+
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ cfiles/typedefs.h view
@@ -0,0 +1,9 @@+#include <linux/i2c-dev.h>++#ifndef __H2C_TYPEDEF_H__+#define __H2C_TYPEDEF_H__++typedef struct i2c_rdwr_ioctl_data i2c_rdwr_ioctl_data_t;+typedef struct i2c_msg i2c_msg_t;++#endif
+ h2c.cabal view
@@ -0,0 +1,42 @@+-- This file has been generated from package.yaml by hpack version 0.17.0.+--+-- see: https://github.com/sol/hpack++name:           h2c+version:        1.0.0+synopsis:       Bindings to Linux I2C with support for repeated-start transactions.+description:    H2C is a high-level binding to the Linux I2C subsystem with support for repeated-start transactions, not just individual reads and writes.+category:       System+homepage:       https://bitbucket.org/fmapE/h2c+bug-reports:    https://bitbucket.org/fmapE/h2c/issues+author:         Edward Amsden+maintainer:     edwardamsden@gmail.com+copyright:      2017 Edward Amsden+license:        MIT+license-file:   LICENSE+build-type:     Simple+cabal-version:  >= 1.10++extra-source-files:+    cfiles/typedefs.h+    README.md++source-repository head+  type: git+  location: https://bitbucket.org/fmapE/h2c.git++library+  hs-source-dirs:+      src+  include-dirs:+      cfiles+  build-depends:+      base >=4.7 && <5+    , bytestring+    , mtl+    , resourcet+  exposed-modules:+      System.IO.I2C+  other-modules:+      Paths_h2c+  default-language: Haskell2010
+ src/System/IO/I2C.hsc view
@@ -0,0 +1,226 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE RecordWildCards #-}+module System.IO.I2C+  ( +    -- * I2C bus handles+    -- $bushandles+    I2Cfd()+  , openI2Cfd+    -- * Checking I2C functionality+  , I2CFunctionality(..)+  , getI2CFunctionality+    -- * Reading and writing an I2C bus+    -- $readwrite+  , I2CTransaction()+  , I2CAddress+  , writeToSlave+  , readFromSlave+  , runI2CTransaction+  ) where++import           Control.Monad.State+import           Control.Monad.Trans          (liftIO)+import           Control.Monad.Trans.Resource+import           Data.Bits+import           Data.ByteString              (ByteString)+import qualified Data.ByteString              as ByteString+import           Data.Int+import           Data.Word+import           Foreign.C.Error+import           Foreign.C.String+import           Foreign.C.Types+import           Foreign.Marshal.Alloc+import           Foreign.Marshal.Utils+import           Foreign.Ptr+import           Foreign.Storable++#include <linux/i2c-dev.h>+#include <fcntl.h>+#include <sys/types.h>+#include <sys/stat.h>+#include <sys/ioctl.h>+#include "typedefs.h"+++foreign import ccall "open" c_open :: Ptr CChar -> #{type int} -> IO #{type int}+foreign import ccall "close" c_close :: #{type int} -> IO #{type int}+foreign import ccall "ioctl" c_ioctl_ptr :: #{type int} -> #{type unsigned long} -> Ptr () -> IO #{type int}++-- $bushandles+-- To do any operations on an I2C bus we need a way to reference it.+-- +-- Values of type 'I2Cfd' point to I2C busses.+-- Opening a bus is done with the 'openI2Cfd' function, which is in the 'ResourceT' monad.+-- This ensures that the resource is properly closed whether we exit via error or by completion.+-- All operations using a handle should be done within the same call to 'runResourceT' where the handle is allocated,+-- using 'liftIO' to lift IO operations to 'ResourceT'.+--+-- When the enclosing call to 'runResourceT' terminates, the 'I2Cfd' will be closed.++-- | A handle to an I2C bus+newtype I2Cfd = I2Cfd { i2cFD :: #{type int} }++-- | Open a handle to an I2C bus in the 'ResourceT' monad+openI2Cfd :: MonadResource m => String -> m (ReleaseKey, I2Cfd)+openI2Cfd path = do+  (pathReleaseKey, pathCString) <- allocate (newCString path) free+  releaseKeyAndFd <- allocate (fmap I2Cfd $ throwErrnoIf (< 0) ("open i2c " ++ path) $ c_open pathCString oRdwr) (throwErrnoIf_ (< 0) "close" . c_close . i2cFD)+  release pathReleaseKey+  return releaseKeyAndFd++-- | Flags of I2C functionality+data I2CFunctionality+  = I2CFunctionality+  { i2cTenBitAddresses :: Bool+  , i2cSmbusPec :: Bool+  , i2cI2C :: Bool+  } deriving Show++-- | Get the I2C functionality available on a specific bus+getI2CFunctionality :: I2Cfd -> IO I2CFunctionality+getI2CFunctionality (I2Cfd {..}) = runResourceT $ do+  functionalityPtr <- snd <$> allocate (mallocBytes #{size unsigned long}) free+  liftIO $ throwErrnoIf_ (< 0) ("ioctl(" ++ show i2cFD ++ ", I2C_FUNCS, " ++ show functionalityPtr) $ c_ioctl_ptr i2cFD i2cFuncs functionalityPtr+  functionality <- liftIO $ peek $ castPtr functionalityPtr :: ResourceT IO #{type unsigned long}+  return $ I2CFunctionality (functionality .&. i2cFunc10bitAddr > 0) (functionality .&. i2cFuncSmbusPec > 0) (functionality .&. i2cFuncI2c > 0)+  ++type UnsignedLongHSC = #{type unsigned long}+type IntHSC = #{type int}++-- $readwrite+-- I2C supports sequences of writes and reads using what is called "repeated start."+-- Every write or read begins with the master (the computer controlling the bus) issuing a START condition on the bus.+-- The master will then send the address of the slave it wishes to read from or write to.+-- Once the master has then sent the value to be written or the slave has sent the value to be read, the master will generally issue a STOP condition on the bus.+--+-- "Repeated start" groups several reads and writes together before a STOP. Before each read or write, the master will issue the START condition and send the address of+-- the slave it wishes to read or write. Once the master or slave has sent the data to be written or read, the master will issue another START condition, rather than a STOP,+-- and another address and read/write bit. Several such actions may be chained together before a stop.+--+-- Many I2C devices support writing to and reading from registers.+-- Registers have addresses, allowing the master to specify which parameter of the device it wishes to read or write.+-- Reading a register typically involves a repeated start transaction (a group of reads and writes taking place without an intervening STOP)+-- where the master first writes the the register number it wishes to read to the slave, and then reads from the slave. Several starts with the read bit set to a slave+-- often signal the slave to send several sequential registers, beginning with the register written at the beginning of the transaction.+--+-- Similarly, register writes generally involve a write of the register number, a repeated start, and then a write of the value to write to the register.+--+-- The 'I2CTransaction' type describes an arbitrary sequence of reads and writes in one repeated-start transaction.+-- It is an instance of 'Applicative', which permits us to sequence reads and writes and combine multiple read values using arbitrary functions.+-- However, it is not an instance of 'Monad', as we do not permit further read or write actions in the same transaction to depend on the result of a previous read.++-- | The type of an address for an I2C slave.+type I2CAddress = #{type long}++#{enum Word16, , I2C_M_TEN, I2C_M_RD, I2C_M_NOSTART, I2C_M_REV_DIR_ADDR, I2C_M_IGNORE_NAK, I2C_M_NO_RD_ACK }+#{enum UnsignedLongHSC, , I2C_SLAVE, I2C_TENBIT, I2C_PEC, I2C_FUNCS, I2C_RDWR }+#{enum IntHSC, , O_RDWR}+#{enum UnsignedLongHSC, , I2C_FUNC_10BIT_ADDR, I2C_FUNC_SMBUS_PEC, I2C_FUNC_I2C}++-- | A description of writes and reads to make with "repeated start" to the I2C bus+--+-- Transactions are intended to be built in sequence using the 'Applicative' instance+data I2CTransaction a where+  Pure :: a -> I2CTransaction a+  Write :: #{type long} -> ByteString -> I2CTransaction ()+  Read :: #{type long} -> #{type __u16} -> I2CTransaction ByteString+  Apply :: I2CTransaction (a -> b) -> I2CTransaction a -> I2CTransaction b++instance Functor I2CTransaction where+  fmap = Apply . Pure++instance Applicative I2CTransaction where+  pure = Pure+  (<*>) = Apply++-- | A master->slave write in a transaction+writeToSlave +  :: I2CAddress -- ^ The address of the slave+  -> ByteString  -- ^ The sequence of bytes to write+  -> I2CTransaction ()+writeToSlave address bytestring = Write address bytestring++-- | A slave->master read in a transaction+readFromSlave+  :: I2CAddress  -- ^ The address of the slave+  -> #{type __u16} -- ^ The number of bytes to read+  -> I2CTransaction ByteString+readFromSlave address length = Read address length++-- | Run an I2C repeated-start transaction+runI2CTransaction+  :: I2Cfd -- ^ The bus to run the transaction on+  -> I2CTransaction a -- ^ The transaction to run+  -> IO a+runI2CTransaction (I2Cfd {..}) transaction = runResourceT $ do+  let messageCount = length i2CMessages+  (_, rdwrPtr) <-+    allocate (mallocBytes #{size i2c_rdwr_ioctl_data_t}) free+  (_, messagesPtr) <-+    allocate (mallocBytes $ #{size i2c_msg_t} * messageCount) free+  liftIO $ #{poke i2c_rdwr_ioctl_data_t, msgs} rdwrPtr messagesPtr +  liftIO $ #{poke i2c_rdwr_ioctl_data_t, nmsgs} rdwrPtr messageCount+  forM (zip i2CMessages [0..])+    (\(message, index) ->+      either+        -- Write+        (\(address, message) -> do+          let messagePtr = plusPtr messagesPtr $ index * #{size i2c_msg_t}+          (_, (bufferPtr, messageLength)) <-+            allocate+              (ByteString.useAsCStringLen message $ \ (string, messageLength) -> do+                 bufferPtr <- mallocBytes messageLength+                 copyBytes bufferPtr string messageLength+                 return (bufferPtr, messageLength))+              (free . fst)+          liftIO $ #{poke i2c_msg_t, buf} messagePtr bufferPtr+          liftIO $ #{poke i2c_msg_t, addr} messagePtr address+          liftIO $ #{poke i2c_msg_t, flags} messagePtr (0 :: Word16)+          liftIO $ #{poke i2c_msg_t, len} messagePtr messageLength+        )+        -- Read+        (\(address, length) -> do+          let messagePtr = plusPtr messagesPtr $ index * #{size i2c_msg_t}+          (_, bufferPtr) <- allocate (mallocBytes $ fromIntegral length) free+          liftIO $ #{poke i2c_msg_t, buf} messagePtr bufferPtr+          liftIO $ #{poke i2c_msg_t, addr} messagePtr address+          liftIO $ #{poke i2c_msg_t, flags} messagePtr i2cMRd+          liftIO $ #{poke i2c_msg_t, len} messagePtr length+        )+        message)+  liftIO $ throwErrnoIf_ (< 0) ("ioctl(" ++ show i2cFD ++ ", I2C_RDWR, " ++ show rdwrPtr ++ ")") $ c_ioctl_ptr i2cFD i2cRdwr rdwrPtr+  liftIO $ reassembleI2CMessages messagesPtr transaction+         +  where+    i2CMessages :: [Either (#{type long}, ByteString) (#{type long}, #{type __u16})]+    i2CMessages = buildI2CMessages transaction []++    buildI2CMessages+      :: I2CTransaction a+      -> (   [Either (#{type long}, ByteString) (#{type long}, #{type __u16})]+          -> [Either (#{type long}, ByteString) (#{type long}, #{type __u16})])+    buildI2CMessages (Pure _) = id+    buildI2CMessages (Write address bytestring) = (Left (address, bytestring) :)+    buildI2CMessages (Read address length) = (Right (address, length) :)+    buildI2CMessages (Apply l r) = buildI2CMessages l . buildI2CMessages r++    reassembleI2CMessages :: Ptr () -> I2CTransaction a -> IO a+    reassembleI2CMessages ptr transaction = flip evalStateT 0 $ reassembleI2CMessagesFromTransaction ptr transaction++    reassembleI2CMessagesFromTransaction :: (MonadIO m, MonadState Int m) => Ptr () -> I2CTransaction a -> m a+    reassembleI2CMessagesFromTransaction _ (Pure x) = return x+    reassembleI2CMessagesFromTransaction _ (Write _ _) = modify succ -- skip a message, it was data we wrote to the slave+    reassembleI2CMessagesFromTransaction ptr (Read _ length) = do+      index <- get+      modify succ -- bump the index+      let thisMessagePtr = plusPtr ptr $ index * #{size i2c_msg_t} +      buffer <- liftIO $ #{peek i2c_msg_t, buf} thisMessagePtr+      len <- liftIO $ #{peek i2c_msg_t, len} thisMessagePtr -- sanity check+      if len /= length then liftIO $ error "Read length not equal to requested length" else return ()+      liftIO $ ByteString.packCStringLen (buffer, fromIntegral len)+    reassembleI2CMessagesFromTransaction ptr (Apply f x) =+          ($)+      <$> reassembleI2CMessagesFromTransaction ptr f+      <*> reassembleI2CMessagesFromTransaction ptr x