aboutsummaryrefslogtreecommitdiff
path: root/hsm-gpio
diff options
context:
space:
mode:
Diffstat (limited to 'hsm-gpio')
-rw-r--r--hsm-gpio/Hsm/GPIO.hs39
-rw-r--r--hsm-gpio/Hsm/GPIO/FFI.hs77
2 files changed, 38 insertions, 78 deletions
diff --git a/hsm-gpio/Hsm/GPIO.hs b/hsm-gpio/Hsm/GPIO.hs
index 0e4e2e5..4786379 100644
--- a/hsm-gpio/Hsm/GPIO.hs
+++ b/hsm-gpio/Hsm/GPIO.hs
@@ -3,28 +3,21 @@
{-# LANGUAGE TypeFamilies #-}
module Hsm.GPIO
- ( GPIOPin (..)
+ ( GPIOPin(..)
, GPIO
, setPins
, setAllPins
, runGPIO
- )
-where
+ ) where
import Control.Monad (forM_, void)
import Data.Vector.Storable (fromList, replicate, unsafeWith)
-import Effectful (Dispatch (Static), DispatchOf, Eff, IOE, liftIO, (:>))
-import Effectful.Dispatch.Static
- ( SideEffects (WithSideEffects)
- , StaticRep
- , evalStaticRep
- , getStaticRep
- , unsafeEff_
- )
+import Effectful (Dispatch(Static), DispatchOf, Eff, IOE, (:>), liftIO)
+import Effectful.Dispatch.Static (SideEffects(WithSideEffects), StaticRep, evalStaticRep, getStaticRep, unsafeEff_)
import Effectful.Exception (bracket)
import Effectful.Resource (Resource, allocateEff, releaseEff)
import Foreign.C.String (withCString)
-import Foreign.C.Types (CSize (CSize), CUInt)
+import Foreign.C.Types (CSize(CSize), CUInt)
import Foreign.Ptr (Ptr)
import Hsm.Core.Serial (makeSerial)
import Hsm.GPIO.FFI
@@ -49,7 +42,7 @@ import Hsm.GPIO.FFI
, requestConfigNew
, requestConfigSetConsumer
)
-import Hsm.Log (Log, Severity (Info, Trace), logMsg)
+import Hsm.Log (Log, Severity(Info, Trace), logMsg)
import Prelude hiding (replicate)
$(makeSerial "GPIO" "Pin" "pinLine" ''CUInt $ [2 .. 17] <> [20 .. 27])
@@ -67,8 +60,8 @@ data GPIO (a :: * -> *) (b :: *)
type instance DispatchOf GPIO = Static WithSideEffects
-newtype instance StaticRep GPIO
- = GPIO (Ptr LineRequest)
+newtype instance StaticRep GPIO =
+ GPIO (Ptr LineRequest)
setPins :: (GPIO :> es, Log "gpio" :> es) => [GPIOPin] -> LineValue -> Eff es ()
setPins pins lineValue = do
@@ -80,14 +73,9 @@ setAllPins :: (GPIO :> es, Log "gpio" :> es) => LineValue -> Eff es ()
setAllPins lineValue = do
GPIO lineRequest <- getStaticRep
logMsg Trace $ "Setting all pins " <> show allPins <> " to " <> show lineValue
- unsafeEff_ . unsafeWith (replicate pinCount lineValue) $
- void . lineRequestSetValues lineRequest
+ unsafeEff_ . unsafeWith (replicate pinCount lineValue) $ void . lineRequestSetValues lineRequest
-runGPIO
- :: (IOE :> es, Log "gpio" :> es, Resource :> es)
- => String
- -> Eff (GPIO : es) a
- -> Eff es a
+runGPIO :: (IOE :> es, Log "gpio" :> es, Resource :> es) => String -> Eff (GPIO : es) a -> Eff es a
runGPIO consumer action = do
(chipKey, chip) <- chipBracket
(lineSettingsKey, lineSettings) <- lineSettingsBracket
@@ -128,12 +116,7 @@ runGPIO consumer action = do
logMsg Info "Allocating line config"
logMsg Info $ "With GPIO pins " <> show allPins
lineConfig <- liftIO lineConfigNew
- liftIO . void . unsafeWith (fromList allLines) $ \pinsVector ->
- lineConfigAddLineSettings
- lineConfig
- pinsVector
- (CSize $ fromIntegral pinCount)
- lineSettings
+ liftIO . void . unsafeWith (fromList allLines) $ \pinsVector -> lineConfigAddLineSettings lineConfig pinsVector (CSize $ fromIntegral pinCount) lineSettings
return lineConfig
lineConfigDealloc lineConfig = do
logMsg Info "Freeing line config"
diff --git a/hsm-gpio/Hsm/GPIO/FFI.hs b/hsm-gpio/Hsm/GPIO/FFI.hs
index a4eae5c..e0d6d07 100644
--- a/hsm-gpio/Hsm/GPIO/FFI.hs
+++ b/hsm-gpio/Hsm/GPIO/FFI.hs
@@ -29,90 +29,67 @@ module Hsm.GPIO.FFI
, lineRequestRelease
, lineRequestSetValue
, lineRequestSetValues
- )
-where
+ ) where
import Foreign.C.String (CString)
-import Foreign.C.Types (CInt (CInt), CSize (CSize), CUInt (CUInt))
+import Foreign.C.Types (CInt(CInt), CSize(CSize), CUInt(CUInt))
import Foreign.Ptr (Ptr)
import Foreign.Storable (Storable)
data Chip
-foreign import ccall unsafe "gpiod.h gpiod_chip_open"
- chipOpen :: CString -> IO (Ptr Chip)
+foreign import ccall unsafe "gpiod.h gpiod_chip_open" chipOpen :: CString -> IO (Ptr Chip)
-foreign import ccall unsafe "gpiod.h gpiod_chip_close"
- chipClose :: Ptr Chip -> IO ()
+foreign import ccall unsafe "gpiod.h gpiod_chip_close" chipClose :: Ptr Chip -> IO ()
data LineSettings
-newtype LineDirection
- = LineDirection CInt
- deriving Show
+newtype LineDirection =
+ LineDirection CInt
+ deriving (Show)
-foreign import capi unsafe "gpiod.h value GPIOD_LINE_DIRECTION_INPUT"
- input :: LineDirection
+foreign import capi unsafe "gpiod.h value GPIOD_LINE_DIRECTION_INPUT" input :: LineDirection
-foreign import capi unsafe "gpiod.h value GPIOD_LINE_DIRECTION_OUTPUT"
- output :: LineDirection
+foreign import capi unsafe "gpiod.h value GPIOD_LINE_DIRECTION_OUTPUT" output :: LineDirection
-newtype LineValue
- = LineValue CInt
+newtype LineValue =
+ LineValue CInt
deriving (Show, Storable)
-foreign import capi unsafe "gpiod.h value GPIOD_LINE_VALUE_ACTIVE"
- active :: LineValue
+foreign import capi unsafe "gpiod.h value GPIOD_LINE_VALUE_ACTIVE" active :: LineValue
-foreign import capi unsafe "gpiod.h value GPIOD_LINE_VALUE_INACTIVE"
- inactive :: LineValue
+foreign import capi unsafe "gpiod.h value GPIOD_LINE_VALUE_INACTIVE" inactive :: LineValue
-foreign import ccall unsafe "gpiod.h gpiod_line_settings_new"
- lineSettingsNew :: IO (Ptr LineSettings)
+foreign import ccall unsafe "gpiod.h gpiod_line_settings_new" lineSettingsNew :: IO (Ptr LineSettings)
-foreign import ccall unsafe "gpiod.h gpiod_line_settings_free"
- lineSettingsFree :: Ptr LineSettings -> IO ()
+foreign import ccall unsafe "gpiod.h gpiod_line_settings_free" lineSettingsFree :: Ptr LineSettings -> IO ()
-foreign import ccall unsafe "gpiod.h gpiod_line_settings_set_direction"
- lineSettingsSetDirection :: Ptr LineSettings -> LineDirection -> IO CInt
+foreign import ccall unsafe "gpiod.h gpiod_line_settings_set_direction" lineSettingsSetDirection :: Ptr LineSettings -> LineDirection -> IO CInt
-foreign import ccall unsafe "gpiod.h gpiod_line_settings_set_output_value"
- lineSettingsSetOutputValue :: Ptr LineSettings -> LineValue -> IO CInt
+foreign import ccall unsafe "gpiod.h gpiod_line_settings_set_output_value" lineSettingsSetOutputValue :: Ptr LineSettings -> LineValue -> IO CInt
data LineConfig
-foreign import ccall unsafe "gpiod.h gpiod_line_config_new"
- lineConfigNew :: IO (Ptr LineConfig)
+foreign import ccall unsafe "gpiod.h gpiod_line_config_new" lineConfigNew :: IO (Ptr LineConfig)
-foreign import ccall unsafe "gpiod.h gpiod_line_config_free"
- lineConfigFree :: Ptr LineConfig -> IO ()
+foreign import ccall unsafe "gpiod.h gpiod_line_config_free" lineConfigFree :: Ptr LineConfig -> IO ()
-foreign import ccall unsafe "gpiod.h gpiod_line_config_add_line_settings"
- lineConfigAddLineSettings
- :: Ptr LineConfig -> Ptr CUInt -> CSize -> Ptr LineSettings -> IO CInt
+foreign import ccall unsafe "gpiod.h gpiod_line_config_add_line_settings" lineConfigAddLineSettings :: Ptr LineConfig -> Ptr CUInt -> CSize -> Ptr LineSettings -> IO CInt
data RequestConfig
-foreign import ccall unsafe "gpiod.h gpiod_request_config_new"
- requestConfigNew :: IO (Ptr RequestConfig)
+foreign import ccall unsafe "gpiod.h gpiod_request_config_new" requestConfigNew :: IO (Ptr RequestConfig)
-foreign import ccall unsafe "gpiod.h gpiod_request_config_free"
- requestConfigFree :: Ptr RequestConfig -> IO ()
+foreign import ccall unsafe "gpiod.h gpiod_request_config_free" requestConfigFree :: Ptr RequestConfig -> IO ()
-foreign import ccall unsafe "gpiod.h gpiod_request_config_set_consumer"
- requestConfigSetConsumer :: Ptr RequestConfig -> CString -> IO ()
+foreign import ccall unsafe "gpiod.h gpiod_request_config_set_consumer" requestConfigSetConsumer :: Ptr RequestConfig -> CString -> IO ()
data LineRequest
-foreign import ccall unsafe "gpiod.h gpiod_chip_request_lines"
- chipRequestLines
- :: Ptr Chip -> Ptr RequestConfig -> Ptr LineConfig -> IO (Ptr LineRequest)
+foreign import ccall unsafe "gpiod.h gpiod_chip_request_lines" chipRequestLines :: Ptr Chip -> Ptr RequestConfig -> Ptr LineConfig -> IO (Ptr LineRequest)
-foreign import ccall unsafe "gpiod.h gpiod_line_request_release"
- lineRequestRelease :: Ptr LineRequest -> IO ()
+foreign import ccall unsafe "gpiod.h gpiod_line_request_release" lineRequestRelease :: Ptr LineRequest -> IO ()
-foreign import ccall unsafe "gpiod.h gpiod_line_request_set_value"
- lineRequestSetValue :: Ptr LineRequest -> CUInt -> LineValue -> IO CInt
+foreign import ccall unsafe "gpiod.h gpiod_line_request_set_value" lineRequestSetValue :: Ptr LineRequest -> CUInt -> LineValue -> IO CInt
-foreign import ccall unsafe "gpiod.h gpiod_line_request_set_values"
- lineRequestSetValues :: Ptr LineRequest -> Ptr LineValue -> IO CInt
+foreign import ccall unsafe "gpiod.h gpiod_line_request_set_values" lineRequestSetValues :: Ptr LineRequest -> Ptr LineValue -> IO CInt
powered by cgit v1.2.1, back to main portfolio site