GPIO.hs

{-# LANGUAGE OverloadedStrings #-}
-- |
-- Module      : Fuyu.GPIO
-- Description : High-level, type-safe Haskell interface for Linux GPIO (libgpiod v2).
-- Maintainer  : BassGT
-- Stability   : experimental
-- Portability : POSIX (Linux GPIO character device interface)
--
-- This module groups functions related to GPIO chip and line handling from the
-- <https://libgpiod.readthedocs.io/en/master/core_api.html libgpiod Core API>.
-- Specifically, these functions cover GPIO Chip, GPIO line settings,
-- GPIO line configuration, GPIO line requests, and libgpiod miscellaneous interfaces.
--
module Fuyu.GPIO
  ( -- * GPIO Chip
    Chip
  , withChip
  , chipPath
  , lineOffsetFromName
  , chipFd

    -- * GPIO line definitions
  , Offset
  , pattern Offset
  , Direction
  , pattern DirAsIs
  , pattern DirInput
  , pattern DirOutput
  , Edge
  , pattern EdgeNone
  , pattern EdgeRising
  , pattern EdgeFalling
  , pattern EdgeBoth
  , Bias
  , pattern BiasAsIs
  , pattern BiasUnknown
  , pattern BiasDisabled
  , pattern BiasPullUp
  , pattern BiasPullDown
  , Drive
  , pattern PushPull
  , pattern OpenDrain
  , pattern OpenSource
  , Clock
  , pattern Monotonic
  , pattern Realtime
  , pattern Hardware
  , Value
  , pattern Active
  , pattern Inactive
  , pattern ValueError

    -- * GPIO Line Settings
  , Settings
  , withSettings
  , setDirection
  , direction
  , setEdgeDetection
  , edgeDetection
  , setBias
  , bias
  , setDrive
  , drive
  , setEventClock
  , eventClock
  , setActiveLow
  , activeLow
  , setDebouncePeriodUs
  , debouncePeriodUs
  , setOutputValue
  , outputValue
  , resetSettings

    -- * GPIO Line Config
  , Config
  , withConfig
  , addSettings
  , lineSettings
  , setOutputValues
  , numOffsets
  , configuredOffsets
  , resetConfig

    -- * GPIO Line Request
  , Request
  , RequestConfig
  , withRequest
  , lineValue
  , lineValues
  , lineValuesSubset
  , setLineValue
  , setLineValues
  , setLineValuesSubset
  , chipName
  , numLines
  , requestedOffsets
  , lineFd
  , reconfigureLines

    -- * General Utilities
  , isGPIOChip
  , gpiodAPIVersion
  ) where

import Control.Exception (bracket, throwIO)
import System.OsPath.Posix (encodeFS, decodeFS)
import qualified Data.ByteString.Char8 as C8
import qualified Data.Vector.Storable as V
import System.Posix.Types (Fd)
import qualified Fuyu.GPIO.Direct as D
import Fuyu.GPIO.Unsafe
  ( openChip
  , closeChip
  , newLineSettings
  , freeLineSettings
  , newLineConfig
  , freeLineConfig
  , requestLines
  , releaseLineRequest
  )
import Fuyu.GPIO.Exception
import Fuyu.GPIO.Types

--------------------------------------------------------------------------------
-- GPIO Chip
--------------------------------------------------------------------------------

-- | Open a GPIO chip by filesystem path (e.g. @"\/dev\/gpiochip0"@) and automatically close it when finished.
--
-- @
-- main :: IO ()
-- main = do
--   withChip "\/dev\/gpiochip0" $ \chip -> do
--     someFunc chip
-- @
withChip :: FilePath -> (Chip -> IO a) -> IO a
withChip str f = do
  path' <- encodeFS str
  bracket (openChip path') closeChip f

-- | Retrieve chip filesystem path as a 'FilePath'.
chipPath :: Chip -> IO FilePath
chipPath chip = do
  path' <- unwrapOrThrow ChipInfoFailed (D.chipPath chip)
  decodeFS path'

-- | Map a GPIO line name (e.g. "GPIO17") to its numeric 'Offset' on the chip.
lineOffsetFromName :: Chip -> String -> IO Offset
lineOffsetFromName chip name =
  unwrapOrThrow LineInfoFailed (D.chipLineOffsetFromName chip (C8.pack name))

-- | Get the underlying Linux file descriptor associated with the GPIO chip handle.
chipFd :: Chip -> IO Fd
chipFd = D.chipFd

--------------------------------------------------------------------------------
-- GPIO Line Settings
--------------------------------------------------------------------------------

-- | Allocate a new line settings object and free it automatically afterwards.
withSettings :: (Settings -> IO a) -> IO a
withSettings = bracket newLineSettings freeLineSettings

-- | Set the line direction in the settings.
setDirection :: Settings -> Direction -> IO ()
setDirection set dir = unwrapOrThrow LineSettingsSetFailed (D.lineSettingsSetDirection set dir)

-- | Get the line direction from the settings.
direction :: Settings -> IO Direction
direction = D.lineSettingsDirection

-- | Set edge detection in the settings.
setEdgeDetection :: Settings -> Edge -> IO ()
setEdgeDetection set edge = unwrapOrThrow LineSettingsSetFailed (D.lineSettingsSetEdgeDetection set edge)

-- | Get edge detection from the settings.
edgeDetection :: Settings -> IO Edge
edgeDetection = D.lineSettingsEdgeDetection

-- | Set electrical bias in the settings.
setBias :: Settings -> Bias -> IO ()
setBias _ BiasUnknown = throwIO $ InvalidArgument "setBias: BiasUnknown is a read-only state and cannot be set as a bias configuration."
setBias set biasVal   = unwrapOrThrow LineSettingsSetFailed (D.lineSettingsSetBias set biasVal)

-- | Get electrical bias from the settings.
bias :: Settings -> IO Bias
bias = D.lineSettingsBias

-- | Set drive mode in the settings.
setDrive :: Settings -> Drive -> IO ()
setDrive set driveMode = unwrapOrThrow LineSettingsSetFailed (D.lineSettingsSetDrive set driveMode)

-- | Get drive mode from the settings.
drive :: Settings -> IO Drive
drive = D.lineSettingsDrive

-- | Set event clock source in the settings.
setEventClock :: Settings -> Clock -> IO ()
setEventClock set clk = unwrapOrThrow LineSettingsSetFailed (D.lineSettingsSetEventClock set clk)

-- | Get event clock source from the settings.
eventClock :: Settings -> IO Clock
eventClock = D.lineSettingsEventClock

-- | Set active-low in the settings.
setActiveLow :: Settings -> Bool -> IO ()
setActiveLow = D.lineSettingsSetActiveLow

-- | Get active-low setting.
activeLow :: Settings -> IO Bool
activeLow = D.lineSettingsActiveLow

-- | Set debounce period in microseconds.
setDebouncePeriodUs :: Settings -> Word -> IO ()
setDebouncePeriodUs = D.lineSettingsSetDebouncePeriodUs

-- | Get debounce period in microseconds.
debouncePeriodUs :: Settings -> IO Word
debouncePeriodUs = D.lineSettingsDebouncePeriodUs

-- | Set default output value in the settings.
setOutputValue :: Settings -> Value -> IO ()
setOutputValue _ ValueError = throwIO $ InvalidArgument "setOutputValue: ValueError pattern is a read-only error state and cannot be set as an output value."
setOutputValue set val     = unwrapOrThrow LineSettingsSetFailed (D.lineSettingsSetOutputValue set val)

-- | Get default output value from the settings.
outputValue :: Settings -> IO Value
outputValue = D.lineSettingsOutputValue

-- | Reset line settings object to default values.
resetSettings :: Settings -> IO ()
resetSettings = D.lineSettingsReset

--------------------------------------------------------------------------------
-- GPIO Line Config
--------------------------------------------------------------------------------

-- | Allocate a new line configuration object and free it automatically afterwards.
-- 
withConfig :: (Config -> IO a) -> IO a
withConfig = bracket newLineConfig freeLineConfig

-- | Add settings for a list of line offsets in the configuration.
addSettings :: Config -> [Offset] -> Settings -> IO ()
addSettings config offsets stgs =
  unwrapOrThrow LineConfigNewFailed (D.lineConfigAddLineSettings config (V.fromList offsets) stgs)

-- | Get settings for a specific line offset from configuration.
lineSettings :: Config -> Offset -> IO Settings
lineSettings config offset' = unwrapOrThrow LineConfigNewFailed (D.lineConfigLineSettings config offset')

-- | Set output values for lines in configuration.
setOutputValues :: Config -> [Value] -> IO ()
setOutputValues config vals
  | V.elem ValueError (V.fromList vals) =
    throwIO $ InvalidArgument "setOutputValues: Vector contains ValueError pattern, which cannot be set as an output value."
  | otherwise                          =
    unwrapOrThrow LineConfigNewFailed (D.lineConfigSetOutputValues config (V.fromList vals))

-- | Get the number of configured offsets in the line configuration.
numOffsets :: Config -> IO Word
numOffsets = D.lineConfigNumOffsets

-- | Get all configured line offsets in the configuration as a 'Offset' list.
configuredOffsets :: Config -> IO [Offset]
configuredOffsets config = do
   vec <- D.lineConfigConfiguredOffsets config 
   return (V.toList vec)
  

-- | Reset line configuration object to empty state.
resetConfig :: Config -> IO ()
resetConfig = D.lineConfigReset

--------------------------------------------------------------------------------
-- GPIO Line Request
--------------------------------------------------------------------------------

-- | Request GPIO lines from a chip and automatically release them afterwards.
--
-- Since kernel configuration options ('RequestConfig') are optional,
-- passing 'Nothing' is equivalent to passing a NULL pointer in C.
--
-- @
-- someFunc :: IO ()
-- someFunc = do
--   withRequest chip Nothing config $ \request -> do
--     setLineValue request (Offset 271) Active 
-- @
--
-- Assuming offset 271 was configured as output ('DirOutput') with 'setDirection'
-- and added to the configuration with 'addSettings', this drives the physical pin active.
withRequest :: Chip -> Maybe RequestConfig -> Config -> (Request -> IO a) -> IO a
withRequest chip maybeReqConf lineConf = bracket (requestLines chip maybeReqConf lineConf) releaseLineRequest

-- | Get the logical value of a requested GPIO line at the given offset.
lineValue :: Request -> Offset -> IO Value
lineValue req offset' = unwrapOrThrow LineValueReadFailed (D.lineRequestValue req offset')

-- | Get the logical values of all requested lines as a 'Value' list.
lineValues :: Request -> IO [Value]
lineValues req = do
  vec <- unwrapOrThrow LineValueReadFailed (D.lineRequestValues req)
  return (V.toList vec)

-- | Get the logical values of a subset of requested lines specified by offsets.
lineValuesSubset :: Request -> [Offset] -> IO (V.Vector Value)
lineValuesSubset req offsets =
  unwrapOrThrow LineValueReadFailed (D.lineRequestSubsetValues req (V.fromList offsets))

-- | Set the logical value of a requested GPIO line at the given offset.
setLineValue :: Request -> Offset -> Value -> IO ()
setLineValue _ _ ValueError  = throwIO $ InvalidArgument "setValue: ValueError pattern is a read-only error state and cannot be written to a GPIO line."
setLineValue req offset' val = unwrapOrThrow LineValueWriteFailed (D.lineRequestSetValue req offset' val)

-- | Set the logical values of all requested lines from a 'Value' list.
setLineValues :: Request -> [Value] -> IO ()
setLineValues req vals
  | V.elem ValueError (V.fromList vals) =
    throwIO $ InvalidArgument "setValues: Vector contains ValueError pattern, which cannot be written to GPIO lines."
  | otherwise                           =
    unwrapOrThrow LineValueWriteFailed (D.lineRequestSetValues req (V.fromList vals))

-- | Set the logical values of a subset of requested lines from lists of 'Offset' and 'Value'.
setLineValuesSubset :: Request -> [Offset] -> [Value] -> IO ()
setLineValuesSubset req offsets vals
  | V.elem ValueError (V.fromList vals) =
    throwIO $ InvalidArgument "setValuesSubset: Vector contains ValueError pattern, which cannot be written to GPIO lines."
  | otherwise                           =
    unwrapOrThrow LineValueWriteFailed $ D.lineRequestSetValuesSubset req (V.fromList offsets) (V.fromList vals)

-- | Get the name as a 'String' of the chip this request was made on.
chipName :: Request -> IO String
chipName request = do
  name <- D.lineRequestChipName request  
  return (C8.unpack name)

-- | Get the number of lines in the request.
numLines :: Request -> IO Word
numLines = D.lineRequestNumLines

-- | Get all requested line offsets as a 'Offset' list.
requestedOffsets :: Request -> IO [Offset]
requestedOffsets request = do
  vec <- D.lineRequestRequestedOffsets request
  return (V.toList vec)

-- | Get the file descriptor associated with the line request handle.
lineFd :: Request -> IO Fd
lineFd = D.lineRequestFd

-- | Update the configuration of lines associated with an active line request.
reconfigureLines :: Request -> Config -> IO ()
reconfigureLines req config = unwrapOrThrow LineReconfigureFailed (D.lineRequestReconfigure req config)

--------------------------------------------------------------------------------
-- General Utilities
--------------------------------------------------------------------------------

-- | Check if the given filesystem path is a valid GPIO chip character device.
isGPIOChip :: FilePath -> IO Bool
isGPIOChip str = do
  path' <- encodeFS str   
  D.isGPIOChip path' 

-- | Retrieve the underlying libgpiod C API version string (e.g. "2.1").
gpiodAPIVersion :: IO String 
gpiodAPIVersion = C8.unpack <$> D.gpiodAPIVersion