diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,5 +1,20 @@ # Revision history for fuyu-gpio +## 0.1.0.0 -- 2026-09-06 + +* **API Simplification & Architectural Consolidation**: + * Merged `Fuyu.GPIO.Chip` and `Fuyu.GPIO.Line` into a unified `Fuyu.GPIO` core module. + * Merged `Chip.Info`, `Line.Info`, and `Chip.Watch` into `Fuyu.GPIO.Monitor`. + * Consolidated all manual and low-level FFI operations into a single `Fuyu.GPIO.Unsafe` module. + * Explicit naming for unsafe allocators (`newLineSettings`, `freeLineSettings`, `newLineConfig`, `freeLineConfig`, `releaseLineRequest`) to eliminate domain ambiguity. +* **Dependencies & Compatibility**: + * Updated dependency on `fuyu-gpio-direct` to `^>= 0.2.0.0`. + * Added upper bounds for `filepath (< 1.6)` and `managed (< 1.1)` compliant with PVP. +* **Documentation & Examples**: + * Reached 100% Haddock documentation coverage across all library modules. + * Added structured progressive examples (01 to 05) with `Control.Monad.Managed` and `transformers` (`ContT` / `StateT`). + * Updated README with detailed module architecture and design concepts. + ## 0.0.9.0 -- 2026-08-13 * Initial release. High-level managed abstraction layer for libgpiod built on top of fuyu-gpio-direct. diff --git a/examples/01-blink.hs b/examples/01-blink.hs --- a/examples/01-blink.hs +++ b/examples/01-blink.hs @@ -3,47 +3,48 @@ -- using nested resource allocation brackets ('withChip', 'withSettings', 'withConfig', 'withRequest'). module Main where --- High-level resource brackets & utility functions -import Fuyu.GPIO.Chip (withChip, isGPIOChip) -import Fuyu.GPIO.Line (withSettings, withConfig, withRequest) -import qualified Fuyu.GPIO.Line as Line +-- High-level resource brackets & utility functions. +-- This import libgpiod Core API functions for chip and line (definitions, settings, configuration, request). +-- Also this module contains the miscellaneous functions for libgpiod ('isGPIOChip' & 'gpiodAPIVersion') +import Fuyu.GPIO --- Base & third-party libraries +-- Base & third-party libraries. +-- Usually we are going to use these modules and their functions. import Control.Concurrent (threadDelay) import Control.Monad (replicateM_) -import Data.Vector.Storable (singleton) --- We could check if this file is a GPIO Chip with 'isGPIOChip' function -chipPath :: FilePath -chipPath = "/dev/gpiochip0" +-- We could check if this file is a GPIO Chip with 'isGPIOChip' function. +myChipPath :: FilePath +myChipPath = "/dev/gpiochip0" -- In Orange Pi devices we could find this information with 'gpio readall' command (or in docs) -- In this case the line offset 269 corresponds to physical pin 7 -ledOffset :: Line.Offset -ledOffset = Line.Offset 269 +ledOffset :: Offset +ledOffset = Offset 269 + main :: IO () main = do - isChip <- isGPIOChip chipPath + isChip <- isGPIOChip myChipPath if isChip then do putStrLn "Example started: LED blinking" runApp - else putStrLn $ chipPath ++ " does not correspond to a valid GPIO Chip" + else putStrLn $ myChipPath ++ " does not correspond to a valid GPIO Chip" runApp :: IO () runApp = do - withChip chipPath $ \chip -> do + withChip myChipPath $ \chip -> do withSettings $ \settings -> do - Line.setDirection settings Line.DirOutput + setDirection settings DirOutput withConfig $ \config -> do - Line.addSettings config (singleton ledOffset) settings + addSettings config [ledOffset] settings -- The use of Nothing instead of a 'RequestConfig' means that we are using a NULL request configuration object. -- (Do not confuse Fuyu.GPIO.RequestConfig with Fuyu.GPIO.Line.Config, the first one is used for kernel options -- and the second one is used for line config). withRequest chip Nothing config $ \request -> do replicateM_ 10 $ do - Line.setValue request ledOffset Line.Active + setLineValue request ledOffset Active threadDelay 500000 -- 0.5 seconds pause - Line.setValue request ledOffset Line.Inactive + setLineValue request ledOffset Inactive threadDelay 500000 -- 0.5 seconds pause diff --git a/examples/02-button.hs b/examples/02-button.hs --- a/examples/02-button.hs +++ b/examples/02-button.hs @@ -3,64 +3,64 @@ -- using a user-space event buffer with 'userBufferCapacity 1' to read button press events. module Main where --- High-level resource brackets & exception handling -import Fuyu.GPIO.Chip (withChip) -import Fuyu.GPIO.Exception (withGpioApp) -import Fuyu.GPIO.Line (withSettings, withConfig, withRequest) -import qualified Fuyu.GPIO.Line as Line -import Fuyu.GPIO.EdgeEvent (withBuffer) -import qualified Fuyu.GPIO.EdgeEvent as Event +-- High-level resource brackets & exception handling. +-- I recommend a qualified import of 'Fuyu.GPIO.EdgeEvent', for example as Edge. +import Fuyu.GPIO +import qualified Fuyu.GPIO.EdgeEvent as Edge --- Base & third-party libraries +-- Base & third-party libraries. +-- To have a clean output when we press Ctrl+c. +import Control.Exception (catch, throwIO, AsyncException(UserInterrupt)) import Control.Monad (forever) -import Data.Vector.Storable (singleton) -chipPath :: FilePath -chipPath = "/dev/gpiochip0" +myChipPath :: FilePath +myChipPath = "/dev/gpiochip0" -- This constant defines the maximum duration 'waitEvents' will wait for an event. -- (This timeout can also be configured as infinite or immediate). -fiveSecondsNs :: Event.Timeout -fiveSecondsNs = Event.Nanoseconds 5000000000 +fiveSecondsNs :: Edge.Timeout +fiveSecondsNs = Edge.Nanoseconds 5000000000 -- Do not confuse this with kernel ring buffer capacity. 'Capacity' refers to the user-space event buffer. -- It is clamped between 1 and 1024, and must be constructed via 'userBufferCapacity' -- (passing 0 defaults to 64). -bufferCapacity :: Event.Capacity -bufferCapacity = Event.userBufferCapacity 1 +myBufferCapacity :: Edge.Capacity +myBufferCapacity = Edge.userBufferCapacity 1 -buttonOffset :: Line.Offset -buttonOffset = Line.Offset 257 +buttonOffset :: Offset +buttonOffset = Offset 257 -buttonSettings :: Line.Settings -> IO () +buttonSettings :: Settings -> IO () buttonSettings stgs = do - Line.setDirection stgs Line.DirInput -- Configure line as input mode - Line.setBias stgs Line.BiasPullUp -- Enable internal pull-up resistor - -- (the physical button connects GND when pressed, driving the line to Inactive) - Line.setDebouncePeriodUs stgs 20000 -- 20ms debounce period to filter out mechanical contact bounce without threadDelay - Line.setEdgeDetection stgs Line.EdgeBoth -- Listen for both Rising and Falling edge transitions + setDirection stgs DirInput -- Configure line as input mode + setBias stgs BiasPullUp -- Enable internal pull-up resistor + -- (the physical button connects GND when pressed, driving the line to Inactive) + setDebouncePeriodUs stgs 20000 -- 20ms debounce period to filter out mechanical contact bounce without threadDelay + setEdgeDetection stgs EdgeBoth -- Listen for both Rising and Falling edge transitions -buttonWorker :: Line.Request -> Event.Buffer -> IO () +buttonWorker :: Request -> Edge.Buffer -> IO () buttonWorker req buf = do - res <- Event.waitEvents req fiveSecondsNs + res <- Edge.waitEvents req fiveSecondsNs case res of - Event.EventReady readyReq -> do - events <- Event.readEvents readyReq buf -- Read events from user buffer (configured with capacity 1) + Edge.EventReady readyReq -> do + events <- Edge.readEvents readyReq buf -- Read events from user buffer (configured with capacity 1) print events - Event.TimeoutResult -> putStrLn "Timeout: No event was read" -- Printed after the 5-second wait timeout expires + Edge.TimeoutResult -> putStrLn "Timeout: No event was read" -- Printed after the 5-second wait timeout expires main :: IO () -main = withGpioApp runApp +main = runApp `catch` \exc -> case exc of + UserInterrupt -> putStrLn "\nLoop terminated successfully!" + other -> throwIO other runApp :: IO () runApp = do - withChip chipPath $ \chip -> do + withChip myChipPath $ \chip -> do withSettings $ \settings -> do buttonSettings settings withConfig $ \config -> do - Line.addSettings config (singleton buttonOffset) settings + addSettings config [buttonOffset] settings withRequest chip Nothing config $ \request -> do - withBuffer bufferCapacity $ \buffer -> do + Edge.withBuffer myBufferCapacity $ \buffer -> do putStrLn "Loop started: Press the button to generate events or Ctrl+C to exit" forever (buttonWorker request buffer) diff --git a/examples/03-led-and-button.hs b/examples/03-led-and-button.hs deleted file mode 100644 --- a/examples/03-led-and-button.hs +++ /dev/null @@ -1,112 +0,0 @@ --- In this example we will learn how to coordinate GPIO output (LED blinking) and input (button press) --- concurrently. We launch two worker threads with 'forkIO' and use an 'MVar' to dynamically --- control the LED blinking speed upon detecting button press edge events. -module Main where - --- High-level resource brackets & exception handling -import Fuyu.GPIO.Chip (withChip) -import Fuyu.GPIO.Exception (withGpioApp) -import Fuyu.GPIO.Line (withSettings, withConfig, withRequest) -import qualified Fuyu.GPIO.Line as Line -import Fuyu.GPIO.EdgeEvent (withBuffer) -import qualified Fuyu.GPIO.EdgeEvent as Event - --- Base & third-party libraries -import Control.Concurrent (MVar, forkIO, killThread, modifyMVar_, newMVar, readMVar, threadDelay) -import Control.Exception (finally) -import Control.Monad (forever) -import Data.Vector.Storable (singleton) -import System.IO (BufferMode(NoBuffering), hSetBuffering, stdout) - -chipPath :: FilePath -chipPath = "/dev/gpiochip0" - --- This constant defines the maximum duration 'waitEvents' will wait for an event. --- A short 100ms timeout yields execution back to the RTS so worker threads run smoothly. -waitTimeoutNs :: Event.Timeout -waitTimeoutNs = Event.Nanoseconds 100000000 - --- Do not confuse this with kernel ring buffer capacity. 'Capacity' refers to the user-space event buffer. --- It is clamped between 1 and 1024, and must be constructed via 'userBufferCapacity' --- (passing 0 defaults to 64). -bufferCapacity :: Event.Capacity -bufferCapacity = Event.userBufferCapacity 1 - -ledOffset :: Line.Offset -ledOffset = Line.Offset 256 - -buttonOffset :: Line.Offset -buttonOffset = Line.Offset 271 - -type Microseconds = Int - --- Available blinking speed states -data LooptimeState = OneSec | HalfSec | FifthOfSec | TenthOfSec - deriving (Eq, Show) - --- Convert LooptimeState into delay duration in microseconds -stateToMicroseconds :: LooptimeState -> Microseconds -stateToMicroseconds OneSec = 1000000 -- 1.0s delay -stateToMicroseconds HalfSec = 500000 -- 0.5s delay -stateToMicroseconds FifthOfSec = 200000 -- 0.2s delay -stateToMicroseconds TenthOfSec = 100000 -- 0.1s delay - --- Cycle to the next blinking speed state -nextSpeed :: LooptimeState -> LooptimeState -nextSpeed OneSec = HalfSec -nextSpeed HalfSec = FifthOfSec -nextSpeed FifthOfSec = TenthOfSec -nextSpeed TenthOfSec = OneSec - -ledSettings :: Line.Settings -> IO () -ledSettings stgs = Line.setDirection stgs Line.DirOutput - -buttonSettings :: Line.Settings -> IO () -buttonSettings stgs = do - Line.setDirection stgs Line.DirInput -- Configure line as input mode - Line.setBias stgs Line.BiasPullUp -- Enable internal pull-up resistor - -- (the physical button connects GND when pressed, driving the line to Inactive) - Line.setDebouncePeriodUs stgs 80000 -- 80ms native kernel debounce period to filter out mechanical contact bounce without threadDelay - Line.setEdgeDetection stgs Line.EdgeFalling -- Listen for Falling edge transitions (button press to GND) - --- Blinks the LED continuously using the delay duration read from the MVar -ledWorker :: Line.Request -> MVar LooptimeState -> IO () -ledWorker req speedMVar = forever $ do - lts <- readMVar speedMVar - let delayUs = stateToMicroseconds lts - Line.setValue req ledOffset Line.Active - threadDelay delayUs - Line.setValue req ledOffset Line.Inactive - threadDelay delayUs - --- Listens for button edge events and cycles the blinking speed state -buttonWorker :: Line.Request -> Event.Buffer -> MVar LooptimeState -> IO () -buttonWorker req buf speedMVar = do - res <- Event.waitEvents req waitTimeoutNs - case res of - Event.EventReady readyReq -> do - _events <- Event.readEvents readyReq buf -- Read events from user buffer (configured with capacity 1) - modifyMVar_ speedMVar (return . nextSpeed) - Event.TimeoutResult -> threadDelay 20000 -- 20ms pause to yield file descriptor to LED worker thread - -main :: IO () -main = withGpioApp runApp - -runApp :: IO () -runApp = do - hSetBuffering stdout NoBuffering - initialSpeedMVar <- newMVar OneSec - withChip chipPath $ \chip -> do - withSettings $ \buttonStgs -> do - buttonSettings buttonStgs - withSettings $ \ledStgs -> do - ledSettings ledStgs - withConfig $ \config -> do - Line.addSettings config (singleton ledOffset) ledStgs - Line.addSettings config (singleton buttonOffset) buttonStgs - withRequest chip Nothing config $ \request -> do - withBuffer bufferCapacity $ \buffer -> do - Line.setValue request ledOffset Line.Inactive - putStrLn "Loop started: LED blinking concurrently. Press the button to change speed, or Ctrl+C to exit" - tid <- forkIO (forever $ ledWorker request initialSpeedMVar) - forever (buttonWorker request buffer initialSpeedMVar) `finally` killThread tid diff --git a/examples/03-monitor.hs b/examples/03-monitor.hs new file mode 100644 --- /dev/null +++ b/examples/03-monitor.hs @@ -0,0 +1,71 @@ +-- In this example we will learn how to monitor GPIO line status changes across processes using chip watching. +-- This example structures the application into modular helper blocks ('runApp', 'monitorApp', 'lineApp'), +-- serving as an intermediate modular phase before introducing resource management with 'Control.Monad.Managed' +-- in the next example (04-led-and-button.hs) to eliminate deeply nested brackets. +module Main where + +-- High-level resource brackets & exception handling. +import Fuyu.GPIO + +-- Qualified Domain Modules. +-- Same as Fuyu.GPIO.EdgeEvent I sugest an qualified import. +import qualified Fuyu.GPIO.Monitor as Monitor + +-- Base & third-party libraries. +import Control.Concurrent (forkIO, threadDelay) + +myChipPath :: FilePath +myChipPath = "/dev/gpiochip0" + +targetOffset :: Offset +targetOffset = Offset 257 + +waitTimeoutNs :: Monitor.Timeout +waitTimeoutNs = Monitor.Nanoseconds 5000000000 -- 5 seconds + +main :: IO () +main = do + putStrLn "Starting line status event monitor..." + runApp + putStrLn "Line status event monitor completed successfully." + +-- We could use some modular application blocks as the next ones to avoid +-- "super nested" functions. Personally I sugest to use this kind of organization +-- or use managed package (next example) for medium size programs. + +-- 'runApp' centralizes worker threads and watchers organized in structured blocks. +runApp :: IO () +runApp = do + putStrLn "Opening GPIO chip and starting line status watching..." + withChip myChipPath $ \chip -> do + -- Register the line watch in the kernel before any interaction + -- (required so the kernel starts queueing status events for targetOffset) + Monitor.withWatchLine chip targetOffset $ \_lineInfo -> do + _ <- forkIO $ lineApp chip + monitorApp chip + +-- 'monitorApp' waits for status change events using 'waitEvent' and security token 'ReadyChip' +monitorApp :: Chip -> IO () +monitorApp chip = do + putStrLn "Waiting for line status change event (timeout: 5s)..." + res <- Monitor.waitEvent chip waitTimeoutNs + case res of + -- Same pattern as 'Fuyu.GPIO.EdgeEvent.waitEvents' + Monitor.EventReady readyChip -> do + Monitor.withEvent readyChip $ \infoEvent -> do + -- In this case, we expect a 'Requested' info event type + eventType <- Monitor.eventType infoEvent + putStrLn ("Event received! " ++ show eventType) + Monitor.TimeoutResult -> putStrLn "Wait timed out (timeout)." + +-- 'lineApp' simulates line interactions (requesting access to targetOffset) in a concurrent thread +lineApp :: Chip -> IO () +lineApp chip = do + withSettings $ \settings -> do + setDirection settings DirAsIs + withConfig $ \config -> do + addSettings config [targetOffset] settings + withRequest chip Nothing config $ \request -> do + name <- chipName request + putStrLn ("Line request created successfully on chip: " ++ show name) + threadDelay 500000 -- Hold requested line briefly diff --git a/examples/04-led-and-button.hs b/examples/04-led-and-button.hs new file mode 100644 --- /dev/null +++ b/examples/04-led-and-button.hs @@ -0,0 +1,159 @@ +-- In this example we will learn how to coordinate GPIO output (LED blinking) and input (button press) +-- concurrently using 'forkIO' and an 'MVar' to dynamically control the LED blinking speed upon +-- detecting button press edge events. +-- +-- We introduce 'Control.Monad.Managed' ('managed', 'runManaged') to acquire and compose nested resources +-- in a clean, linear 'do' block. This effectively eliminates the "Pyramid of Doom" (deeply nested 'with*' +-- brackets) in an accessible, lightweight manner before introducing more advanced abstractions like +-- monad transformers ('ContT' / 'StateT') in example 05. +module Main where + +-- High-level resource brackets & exception handling. +import Fuyu.GPIO +import qualified Fuyu.GPIO.EdgeEvent as Edge + +-- Base & third-party libraries. +import Control.Monad.Managed (managed, runManaged, liftIO) +-- For concurrent medium size programs, 'Control.Concurrent' is awesome. +import Control.Concurrent (MVar, forkIO, killThread, modifyMVar_, newMVar, readMVar, threadDelay) +-- Besides the functions and types we used before (to manage Ctrl+c exit), we alse need 'finally' to ensure +-- the cleanup of the concurrent thread when the main loop ends or is interrupted. +import Control.Exception (finally, catch, throwIO, AsyncException(UserInterrupt)) +import Control.Monad (forever) +import System.IO (BufferMode(NoBuffering), hSetBuffering, stdout) + +myChipPath :: FilePath +myChipPath = "/dev/gpiochip0" + +-- This constant defines the maximum duration 'waitEvents' will wait for an event. +-- A short 100ms timeout yields execution back to the RTS so worker threads run smoothly. +waitTimeoutNs :: Edge.Timeout +waitTimeoutNs = Edge.Nanoseconds 100000000 + +-- Do not confuse this with kernel ring buffer capacity. 'Capacity' refers to the user-space event buffer. +-- It is clamped between 1 and 1024, and must be constructed via 'userBufferCapacity' +-- (passing 0 defaults to 64). +bufferCapacity :: Edge.Capacity +bufferCapacity = Edge.userBufferCapacity 1 + +ledOffset :: Offset +ledOffset = Offset 256 + +buttonOffset :: Offset +buttonOffset = Offset 271 + +type Microseconds = Int + +-- Available blinking speed states. +data LooptimeState = OneSec | HalfSec | FifthOfSec | TenthOfSec + deriving (Eq, Show) + +-- Convert LooptimeState into delay duration in microseconds. +stateToMicroseconds :: LooptimeState -> Microseconds +stateToMicroseconds OneSec = 1000000 -- 1.0s delay +stateToMicroseconds HalfSec = 500000 -- 0.5s delay +stateToMicroseconds FifthOfSec = 200000 -- 0.2s delay +stateToMicroseconds TenthOfSec = 100000 -- 0.1s delay + +-- Cycle to the next blinking speed state. +nextSpeed :: LooptimeState -> LooptimeState +nextSpeed OneSec = HalfSec +nextSpeed HalfSec = FifthOfSec +nextSpeed FifthOfSec = TenthOfSec +nextSpeed TenthOfSec = OneSec + +myLedSettings :: Settings -> IO () +myLedSettings stgs = setDirection stgs DirOutput + +myButtonSettings :: Settings -> IO () +myButtonSettings stgs = do + setDirection stgs DirInput -- Configure line as input mode. + setBias stgs BiasPullUp -- Enable internal pull-up resistor. + -- (the physical button connects GND when pressed, driving the line to Inactive). + setDebouncePeriodUs stgs 80000 -- 80ms native kernel debounce period to filter out mechanical contact bounce without threadDelay. + setEdgeDetection stgs EdgeFalling -- Listen for Falling edge transitions (button press to GND). + +-- Blinks the LED continuously using the delay duration read from the MVar. +ledWorker :: Request -> MVar LooptimeState -> IO () +ledWorker req speedMVar = forever $ do + lts <- readMVar speedMVar + let delayUs = stateToMicroseconds lts + setLineValue req ledOffset Active + threadDelay delayUs + setLineValue req ledOffset Inactive + threadDelay delayUs + +-- Listens for button edge events and cycles the blinking speed state. +buttonWorker :: Request -> Edge.Buffer -> MVar LooptimeState -> IO () +buttonWorker req buf speedMVar = do + res <- Edge.waitEvents req waitTimeoutNs + case res of + Edge.EventReady readyReq -> do + _events <- Edge.readEvents readyReq buf -- Read events from user buffer (configured with capacity 1). + modifyMVar_ speedMVar (return . nextSpeed) + Edge.TimeoutResult -> threadDelay 20000 -- 20ms pause to yield file descriptor to LED worker thread. + +withAppConfig :: Settings -> Settings -> (Config -> IO r) -> IO r +withAppConfig ledStgs btnStgs action = + withConfig $ \config -> do + addSettings config [ledOffset] ledStgs + addSettings config [buttonOffset] btnStgs + action config + +withAppRequest :: Chip -> Config -> (Request -> IO r) -> IO r +withAppRequest chip = withRequest chip Nothing + +main :: IO () +main = runApp `catch` \exc -> case exc of + UserInterrupt -> putStrLn "\nLoop terminated seccessfully!" + other -> throwIO other + +-- The next lines shows us how to manage libgpiod resources with managed package +-- (avoiding the Pyramid of Doom). + +runApp :: IO () +runApp = do + hSetBuffering stdout NoBuffering + initialSpeedMVar <- newMVar OneSec + + -- Instead of nesting 6 levels of 'with*' brackets, 'runManaged' flattens + -- resource acquisition sequentially while guaranteeing safe cleanup on exit. + runManaged $ do + chip <- managed (withChip myChipPath) + ledSettings <- managed withSettings + btnSettings <- managed withSettings + liftIO $ do + myLedSettings ledSettings + myButtonSettings btnSettings + config <- managed (withAppConfig ledSettings btnSettings) + request <- managed (withAppRequest chip config) + buffer <- managed (Edge.withBuffer bufferCapacity) + liftIO (appLoop request initialSpeedMVar buffer) + +appLoop :: Request -> MVar LooptimeState -> Edge.Buffer -> IO () +appLoop request speed buffer = do + setLineValue request ledOffset Inactive + putStrLn "Loop started: LED blinking concurrently. Press the button to change speed, or Ctrl+C to exit" + tid <- forkIO (forever $ ledWorker request speed) + forever (buttonWorker request buffer speed) `finally` killThread tid + +{- +-- For comparison, here is how 'runApp' would look without 'Control.Monad.Managed' +-- (demonstrating the "Pyramid of Doom" caused by multiple nested brackets): + +runAppPyramid :: IO () +runAppPyramid = do + hSetBuffering stdout NoBuffering + initialSpeedMVar <- newMVar OneSec + withChip chipPath $ \chip -> do + withSettings $ \btnStgs -> do + myButtonSettings btnStgs + withSettings $ \ledStgs -> do + myLedSettings ledStgs + withConfig $ \config -> do + addSettings config (singleton ledOffset) ledStgs + addSettings config (singleton buttonOffset) btnStgs + withRequest chip Nothing config $ \request -> do + withBuffer bufferCapacity $ \buffer -> do + appLoop request initialSpeedMVar buffer +-} diff --git a/examples/04-line-watch.hs b/examples/04-line-watch.hs deleted file mode 100644 --- a/examples/04-line-watch.hs +++ /dev/null @@ -1,69 +0,0 @@ --- In this example we will learn how to monitor GPIO line status changes across processes using chip watching. --- This example structures the application into modular helper functions ('runApp', 'monitorApp', 'lineApp'), --- serving as an intermediate modular phase before refactoring nested brackets with monadic continuation ('ContT'). -module Main where - --- High-level resource brackets & exception handling -import Fuyu.GPIO.Chip (Chip, withChip) -import Fuyu.GPIO.Line (withRequest, withConfig, withSettings) -import Fuyu.GPIO.Exception (withGpioApp) - --- Qualified Domain Modules -import qualified Fuyu.GPIO.Chip.Watch as Watch -import qualified Fuyu.GPIO.Line as Line - --- Base & third-party libraries -import Control.Concurrent (forkIO, threadDelay) -import Data.Vector.Storable (singleton) - -chipPath :: FilePath -chipPath = "/dev/gpiochip0" - -targetOffset :: Line.Offset -targetOffset = Line.Offset 257 - -waitTimeoutNs :: Watch.Timeout -waitTimeoutNs = Watch.Nanoseconds 5000000000 -- 5 seconds - -main :: IO () -main = withGpioApp $ do - putStrLn "Starting line status event monitor..." - runApp - putStrLn "Line status event monitor completed successfully." - --- 'runApp' centralizes worker threads and watchers to avoid pyramid of doom -runApp :: IO () -runApp = do - putStrLn "Opening GPIO chip and starting line status watching..." - withChip chipPath $ \chip -> do - -- Register the line watch in the kernel before any interaction - -- (required so the kernel starts queueing status events for targetOffset) - Watch.withWatchLine chip targetOffset $ \_lineInfo -> do - _ <- forkIO $ lineApp chip - monitorApp chip - --- 'monitorApp' waits for status change events using 'waitEvent' and security token 'ReadyChip' -monitorApp :: Chip -> IO () -monitorApp chip = do - putStrLn "Waiting for line status change event (timeout: 5s)..." - res <- Watch.waitEvent chip waitTimeoutNs - case res of - -- Same pattern as 'Fuyu.GPIO.EdgeEvent.waitEvents' - Watch.EventReady readyChip -> do - Watch.withEvent readyChip $ \infoEvent -> do - -- In this case, we expect a 'Requested' info event type - eventType <- Watch.eventType infoEvent - putStrLn ("Event received! " ++ show eventType) - Watch.TimeoutResult -> putStrLn "Wait timed out (timeout)." - --- 'lineApp' simulates line interactions (requesting access to targetOffset) in a concurrent thread -lineApp :: Chip -> IO () -lineApp chip = do - withSettings $ \settings -> do - Line.setDirection settings Line.DirAsIs - withConfig $ \config -> do - Line.addSettings config (singleton targetOffset) settings - withRequest chip Nothing config $ \request -> do - name <- Line.chipName request - putStrLn ("Line request created successfully on chip: " ++ show name) - threadDelay 500000 -- Hold requested line briefly diff --git a/examples/05-request-config.hs b/examples/05-request-config.hs --- a/examples/05-request-config.hs +++ b/examples/05-request-config.hs @@ -5,42 +5,42 @@ module Main where -- High-level resource brackets & exception handling -import Fuyu.GPIO.Chip (withChip) -import qualified Fuyu.GPIO.Line as Line -import qualified Fuyu.GPIO.EdgeEvent as EdgeEvent +import Fuyu.GPIO +import qualified Fuyu.GPIO.EdgeEvent as Edge import qualified Fuyu.GPIO.RequestConfig as ReqConf -import Fuyu.GPIO.Exception (withGpioApp) --- Base & third-party libraries +-- Base & core libraries ('transformers' is a core GHC boot package with zero external dependencies). import Control.Monad.Trans.Cont (evalContT, ContT(..)) +-- We import 'Control.Monad.Trans.State.Strict' directly from 'transformers' rather than +-- 'Control.Monad.State' from 'mtl' to keep external dependencies minimal. +-- We explicitly choose the strict variant ('.Strict') and use 'modify'' to force evaluation of state +-- updates eagerly. This prevents space leaks (accumulation of unevaluated thunks in memory) +-- as encoder tick counts change continuously. import Control.Monad.Trans.State.Strict (StateT, evalStateT, gets, modify') import Control.Monad.IO.Class (liftIO) import Control.Monad (forever, when) -import qualified Data.Vector.Storable as V (fromList) +-- To have a clean exit when Ctrl+C is pressed. +import Control.Exception (catch, throwIO, AsyncException(UserInterrupt)) import Data.List.NonEmpty (NonEmpty(..)) -chipPath :: FilePath -chipPath = "/dev/gpiochip0" +myChipPath :: FilePath +myChipPath = "/dev/gpiochip0" -- Line offsets for the rotary encoder signals -offsetCLK :: Line.Offset -offsetCLK = Line.Offset 256 +offsetCLK :: Offset +offsetCLK = Offset 256 -offsetDT :: Line.Offset -offsetDT = Line.Offset 271 +offsetDT :: Offset +offsetDT = Offset 271 -- Timeout for waiting on edge events (5 seconds) -fiveSecondsNs :: EdgeEvent.Timeout -fiveSecondsNs = EdgeEvent.Nanoseconds 5000000000 +fiveSecondsNs :: Edge.Timeout +fiveSecondsNs = Edge.Nanoseconds 5000000000 -- Setting user buffer capacity to 1 guarantees that 'readEvents' returns exactly 1 event at a time. -- This simplifies pattern matching to '(ev :| _)' without losing any events in the kernel queue. -capacity :: EdgeEvent.Capacity -capacity = EdgeEvent.userBufferCapacity 1 - --------------------------------------------------------------------------------- --- Encoder State Definition --------------------------------------------------------------------------------- +capacity :: Edge.Capacity +capacity = Edge.userBufferCapacity 1 -- Clean pure Haskell record representing the quadrature state and step count. data EncoderState = EncoderState @@ -54,71 +54,66 @@ initialState = EncoderState { clkPin = 1, dtPin = 1, position = 0 } main :: IO () -main = withGpioApp $ do - putStrLn "Starting request config example..." - runApp - putStrLn "Request config example completed successfully." - --------------------------------------------------------------------------------- --- Helper Configurator Brackets --------------------------------------------------------------------------------- +main = do + putStrLn "Starting request config example (Press Ctrl+C to exit)..." + runApp `catch` \exc -> case exc of + UserInterrupt -> putStrLn "\nLoop terminated successfully!" + other -> throwIO other --- Encapsulates the creation and configuration of RequestConfig (consumer label & buffer size). +-- We need some helpers configurator brackets. +-- This one encapsulates the creation and configuration of RequestConfig (consumer label & buffer size). withAppRequestConfig :: (ReqConf.RequestConfig -> IO r) -> IO r withAppRequestConfig action = ReqConf.withRequestConfig $ \reqconf -> do ReqConf.setConsumer reqconf "encoder-app" ReqConf.setBufferSize reqconf 256 action reqconf --- Encapsulates line settings configuration (input mode, 1ms debounce, edge detection). -withAppLineSettings :: (Line.Settings -> IO r) -> IO r -withAppLineSettings action = Line.withSettings $ \settings -> do - Line.setDirection settings Line.DirInput - Line.setDebouncePeriodUs settings 1000 -- 1ms debounce suitable for rotary encoder hardware - Line.setEdgeDetection settings Line.EdgeBoth +-- To encapsulates line settings configuration (input mode, 1ms debounce, edge detection). +withAppLineSettings :: (Settings -> IO r) -> IO r +withAppLineSettings action = withSettings $ \settings -> do + setDirection settings DirInput + setDebouncePeriodUs settings 1000 -- 1ms debounce suitable for rotary encoder hardware + setEdgeDetection settings EdgeBoth action settings --- Encapsulates building line configuration for target pin offsets (CLK & DT). -withAppLineConfig :: Line.Settings -> (Line.Config -> IO r) -> IO r -withAppLineConfig settings action = Line.withConfig $ \config -> do - Line.addSettings config (V.fromList [offsetCLK, offsetDT]) settings +-- And to encapsulates building line configuration for target pin offsets (CLK & DT). +withAppLineConfig :: Settings -> (Config -> IO r) -> IO r +withAppLineConfig settings action = withConfig $ \config -> do + addSettings config [offsetCLK, offsetDT] settings action config --------------------------------------------------------------------------------- --- Resource Setup using ContT and Execution with StateT --------------------------------------------------------------------------------- - --- Monadic resource setup using 'ContT' flattens nested 'with...' brackets into a linear 'do' block. --- 'evalStateT' then runs the application loop with managed pure state ('EncoderState'). +-- Monadic resource setup using 'ContT' (from 'transformers') flattens nested 'with...' brackets +-- into a linear 'do' block. This achieves the same goal as 'runManaged' in example 04, but using +-- standard core transformers without external dependencies. +-- 'evalStateT' then runs the stateful application loop initialized with 'initialState'. runApp :: IO () runApp = evalContT $ do - chip <- ContT $ withChip chipPath + chip <- ContT $ withChip myChipPath reqconf <- ContT withAppRequestConfig settings <- ContT withAppLineSettings config <- ContT $ withAppLineConfig settings - request <- ContT $ Line.withRequest chip (Just reqconf) config - buffer <- ContT $ EdgeEvent.withBuffer capacity + request <- ContT $ withRequest chip (Just reqconf) config + buffer <- ContT $ Edge.withBuffer capacity - -- Run stateful application loop starting with 'initialState' + -- Run stateful application loop starting with 'initialState'. liftIO $ evalStateT (appLoop request buffer) initialState --------------------------------------------------------------------------------- --- Encoder Application Loop using MonadState (StateT) --------------------------------------------------------------------------------- - -- Application loop running in 'StateT EncoderState IO ()'. -appLoop :: Line.Request -> EdgeEvent.Buffer -> StateT EncoderState IO () +-- Unlike example 04 which used an 'MVar' to share mutable state across concurrent threads ('forkIO'), +-- this example is a single-threaded sequential event loop. 'StateT' provides pure, structured state +-- transitions without the synchronization overhead or locking primitives of MVars. +appLoop :: Request -> Edge.Buffer -> StateT EncoderState IO () appLoop request buffer = forever $ do - result <- liftIO $ EdgeEvent.waitEvents request fiveSecondsNs + result <- liftIO $ Edge.waitEvents request fiveSecondsNs case result of - EdgeEvent.TimeoutResult -> + Edge.TimeoutResult -> liftIO $ putStrLn "No edge event was read (timeout)." - EdgeEvent.EventReady req -> do - (ev :| _) <- liftIO $ EdgeEvent.readEvents req buffer + Edge.EventReady req -> do + (ev :| _) <- liftIO $ Edge.readEvents req buffer oldPos <- gets position - -- Update pure state cleanly using strict 'modify'' + -- Update pure state cleanly using strict 'modify'. modify' (updateEncoderState ev) newPos <- gets position @@ -129,13 +124,13 @@ -- When CLK transitions to LOW (Falling edge), we inspect the current state of DT: -- - DT == 1 (HIGH) -> Clockwise rotation (+1) -- - DT == 0 (LOW) -> Counter-Clockwise rotation (-1) -updateEncoderState :: EdgeEvent.EdgeEvent -> EncoderState -> EncoderState -updateEncoderState (EdgeEvent.EdgeEvent offset evType _) st = case (offset, evType) of - (Line.Offset 256, EdgeEvent.Falling) -> +updateEncoderState :: Edge.Event -> EncoderState -> EncoderState +updateEncoderState (Edge.EdgeEvent offset evType _) st = case (offset, evType) of + (Offset 256, Edge.Falling) -> let delta = if dtPin st == 1 then 1 else (-1) in st { clkPin = 0, position = position st + delta } - (Line.Offset 256, EdgeEvent.Rising) -> st { clkPin = 1 } - (Line.Offset 271, EdgeEvent.Falling) -> st { dtPin = 0 } - (Line.Offset 271, EdgeEvent.Rising) -> st { dtPin = 1 } - _ -> st + (Offset 256, Edge.Rising) -> st { clkPin = 1 } + (Offset 271, Edge.Falling) -> st { dtPin = 0 } + (Offset 271, Edge.Rising) -> st { dtPin = 1 } + _ -> st diff --git a/fuyu-gpio.cabal b/fuyu-gpio.cabal --- a/fuyu-gpio.cabal +++ b/fuyu-gpio.cabal @@ -1,6 +1,6 @@ cabal-version: 3.0 name: fuyu-gpio -version: 0.0.9.0 +version: 0.1.0.0 synopsis: High-level, type-safe interface for Linux GPIO (libgpiod v2). description: High-level, type-safe, and resource-managed Haskell interface for Linux GPIO character devices using libgpiod v2. Built on top of fuyu-gpio-direct, fuyu-gpio provides automatic memory management (bracket / with* style), typed exception handling, metadata snapshots, and zero-copy vector operations for high-performance GPIO I/O. license: LGPL-2.1-or-later @@ -22,29 +22,20 @@ library import: warnings exposed-modules: Fuyu.GPIO, - Fuyu.GPIO.Chip, - Fuyu.GPIO.Chip.Info, - Fuyu.GPIO.Chip.Info.Unsafe, - Fuyu.GPIO.Chip.Unsafe, - Fuyu.GPIO.Line, - Fuyu.GPIO.Line.Info, - Fuyu.GPIO.Line.Info.Unsafe, - Fuyu.GPIO.Line.Unsafe, + Fuyu.GPIO.Unsafe, + Fuyu.GPIO.Monitor, Fuyu.GPIO.RequestConfig, - Fuyu.GPIO.RequestConfig.Unsafe, Fuyu.GPIO.EdgeEvent, - Fuyu.GPIO.EdgeEvent.Unsafe, - Fuyu.GPIO.Chip.Watch, - Fuyu.GPIO.Chip.Watch.Unsafe, Fuyu.GPIO.Exception other-modules: Fuyu.GPIO.Types -- other-extensions: build-depends: base >= 4.18 && < 5, - fuyu-gpio-direct ^>=0.1.0.0, + fuyu-gpio-direct ^>=0.2.0.0, bytestring ^>=0.12.1.0, - vector ^>=0.13.1.0 + vector ^>=0.13.1.0, + filepath >= 1.5.5.0 && < 1.6 hs-source-dirs: src @@ -68,6 +59,7 @@ base >= 4.18 && < 5, fuyu-gpio, vector ^>= 0.13.1.0, + managed >= 1.0.10 && < 1.1, transformers >= 0.5 && < 0.7, bytestring ^>= 0.12.1.0 @@ -80,16 +72,16 @@ import: example-config main-is: 02-button.hs -executable 03-led-and-button - import: example-config - main-is: 03-led-and-button.hs - ghc-options: -threaded - -executable 04-line-watch +executable 03-monitor import: example-config - main-is: 04-line-watch.hs + main-is: 03-monitor.hs ghc-options: -threaded -rtsopts +executable 04-led-and-button + import: example-config + main-is: 04-led-and-button.hs + ghc-options: -threaded + executable 05-request-config import: example-config main-is: 05-request-config.hs diff --git a/src/Fuyu/GPIO.hs b/src/Fuyu/GPIO.hs --- a/src/Fuyu/GPIO.hs +++ b/src/Fuyu/GPIO.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE OverloadedStrings #-} -- | -- Module : Fuyu.GPIO -- Description : High-level, type-safe Haskell interface for Linux GPIO (libgpiod v2). @@ -5,26 +6,363 @@ -- Stability : experimental -- Portability : POSIX (Linux GPIO character device interface) -- --- This is the main umbrella module for @fuyu-gpio@, providing high-level, --- managed resource wrappers ('withChip', 'withSettings', 'withConfig', 'withRequest') --- and exception handling ('GpioException', 'withGpioApp') for Linux GPIO character devices. +-- This module groups functions related to GPIO chip and line handling from the +-- . +-- Specifically, these functions cover GPIO Chip, GPIO line settings, +-- GPIO line configuration, GPIO line requests, and libgpiod miscellaneous interfaces. -- --- For detailed metadata inspection, import "Fuyu.GPIO.Chip.Info" or "Fuyu.GPIO.Line.Info" qualified. --- For manual/unmanaged FFI resource lifecycle, import the corresponding @.Unsafe@ submodules. module Fuyu.GPIO - ( -- * Domain Modules - module Fuyu.GPIO.Chip - , module Fuyu.GPIO.Line - , module Fuyu.GPIO.RequestConfig - , module Fuyu.GPIO.EdgeEvent + ( -- * GPIO Chip + Chip + , withChip + , chipPath + , lineOffsetFromName + , chipFd - -- * Exception & App Runner - , GpioException(..) - , withGpioApp + -- * 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 Fuyu.GPIO.Chip hiding (fd, eventType, timestampNs) -import Fuyu.GPIO.Line hiding (fd) -import Fuyu.GPIO.RequestConfig -import Fuyu.GPIO.EdgeEvent -import Fuyu.GPIO.Exception (GpioException(..), withGpioApp) +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 diff --git a/src/Fuyu/GPIO/Chip.hs b/src/Fuyu/GPIO/Chip.hs deleted file mode 100644 --- a/src/Fuyu/GPIO/Chip.hs +++ /dev/null @@ -1,66 +0,0 @@ --- | --- Module : Fuyu.GPIO.Chip --- Description : High-level operations for GPIO chips and line watching. --- Maintainer : BassGT --- Stability : experimental --- Portability : POSIX (Linux gpiod v2) --- --- This module provides managed resource brackets ('withChip') for opening and closing --- Linux GPIO chips safely, as well as functions for watching line status changes. -module Fuyu.GPIO.Chip - ( -- * Operations & Brackets - withChip - , withChipInfo - , withLineInfo - , path - , offsetFromName - , fd - - -- * Line Watch & Info Events - , module Fuyu.GPIO.Chip.Watch - - -- * General Utilities - , isGPIOChip - , gpiodAPIVersion - ) where - -import Control.Exception (bracket) -import Data.ByteString (ByteString) -import qualified Data.ByteString.Char8 as BS8 -import System.Posix.Types (Fd) -import qualified Fuyu.GPIO.Direct as D -import Fuyu.GPIO.Chip.Info (withChipInfo) -import Fuyu.GPIO.Line.Info (withLineInfo) -import Fuyu.GPIO.Chip.Unsafe (openChip, closeChip) -import Fuyu.GPIO.Chip.Watch -import Fuyu.GPIO.Exception - --- | Open a GPIO chip by filesystem path (e.g. "/dev/gpiochip0") and automatically close it when finished. -withChip :: FilePath -> (Chip -> IO a) -> IO a -withChip path' = bracket (openChip path') closeChip - --- | Retrieve chip filesystem path as a 'ByteString'. -path :: Chip -> IO ByteString -path chip = unwrapOrThrow ChipInfoFailed (D.chipPath chip) - --- | Map a GPIO line name (e.g. "GPIO17") to its numeric 'Offset' on the chip. -offsetFromName :: Chip -> ByteString -> IO Offset -offsetFromName chip name = unwrapOrThrow LineInfoFailed (D.chipLineOffsetFromName chip name) - --- | Get the underlying Linux file descriptor associated with the GPIO chip handle. -fd :: Chip -> IO Fd -fd = D.chipFd - --------------------------------------------------------------------------------- --- General Utilities --------------------------------------------------------------------------------- --- General Utilities --------------------------------------------------------------------------------- - --- | Check if the given filesystem path is a valid GPIO chip character device. -isGPIOChip :: FilePath -> IO Bool -isGPIOChip = D.isGPIOChip . BS8.pack - --- | Retrieve the underlying libgpiod C API version string (e.g. "2.1"). -gpiodAPIVersion :: IO ByteString -gpiodAPIVersion = D.gpiodAPIVersion diff --git a/src/Fuyu/GPIO/Chip/Info.hs b/src/Fuyu/GPIO/Chip/Info.hs deleted file mode 100644 --- a/src/Fuyu/GPIO/Chip/Info.hs +++ /dev/null @@ -1,47 +0,0 @@ --- | --- Module : Fuyu.GPIO.Chip.Info --- Description : Read-only metadata query functions for ChipInfo. --- Maintainer : BassGT --- Stability : experimental --- Portability : POSIX (Linux gpiod v2) --- --- This module provides functions to inspect 'ChipInfo' snapshots. --- It is designed to be imported qualified: --- --- @ --- import qualified Fuyu.GPIO.Chip.Info as ChipInfo --- @ -module Fuyu.GPIO.Chip.Info - ( -- * Types - ChipInfo - - -- * Managed Resource Allocation - , withChipInfo - - -- * Metadata Accessors - , name - , label - , numLines - ) where - -import Control.Exception (bracket) -import Data.ByteString (ByteString) -import qualified Fuyu.GPIO.Direct as D -import Fuyu.GPIO.Chip.Info.Unsafe (chipInfo, freeChipInfo) -import Fuyu.GPIO.Types - --- | Retrieve information about a GPIO chip and free it automatically afterwards. -withChipInfo :: Chip -> (ChipInfo -> IO a) -> IO a -withChipInfo chip = bracket (chipInfo chip) freeChipInfo - --- | Get the name of the GPIO chip (e.g. "gpiochip4"). -name :: ChipInfo -> IO ByteString -name = D.chipInfoName - --- | Get the label of the GPIO chip. -label :: ChipInfo -> IO ByteString -label = D.chipInfoLabel - --- | Get the total number of lines exposed by the GPIO chip. -numLines :: ChipInfo -> IO Word -numLines = D.chipInfoNumLines diff --git a/src/Fuyu/GPIO/Chip/Info/Unsafe.hs b/src/Fuyu/GPIO/Chip/Info/Unsafe.hs deleted file mode 100644 --- a/src/Fuyu/GPIO/Chip/Info/Unsafe.hs +++ /dev/null @@ -1,29 +0,0 @@ --- | --- Module : Fuyu.GPIO.Chip.Info.Unsafe --- Description : Unsafe manual resource allocation for ChipInfo. --- Maintainer : BassGT --- Stability : experimental --- Portability : POSIX (Linux gpiod v2) --- --- Manual resource allocation ('chipInfo', 'freeChipInfo') for 'ChipInfo' handles. -module Fuyu.GPIO.Chip.Info.Unsafe - ( -- * Types - ChipInfo - - -- * Unsafe Manual Resource Allocation - , chipInfo - , freeChipInfo - ) where - -import qualified Fuyu.GPIO.Direct as D -import Fuyu.GPIO.Exception -import Fuyu.GPIO.Types - --- | Retrieve chip info directly. --- Must be manually freed using 'freeChipInfo'. -chipInfo :: Chip -> IO ChipInfo -chipInfo chip = unwrapOrThrow ChipInfoFailed (D.chipInfo chip) - --- | Free a 'ChipInfo' handle. -freeChipInfo :: ChipInfo -> IO () -freeChipInfo = D.chipInfoFree diff --git a/src/Fuyu/GPIO/Chip/Unsafe.hs b/src/Fuyu/GPIO/Chip/Unsafe.hs deleted file mode 100644 --- a/src/Fuyu/GPIO/Chip/Unsafe.hs +++ /dev/null @@ -1,36 +0,0 @@ --- | --- Module : Fuyu.GPIO.Chip.Unsafe --- Description : Unsafe manual resource allocation for GPIO chips and info events. --- Maintainer : BassGT --- Stability : experimental --- Portability : POSIX (Linux gpiod v2) --- --- Manual resource allocation ('openChip', 'closeChip', 'readInfoEvent', 'freeInfoEvent') --- for applications that cannot use managed bracket functions. -module Fuyu.GPIO.Chip.Unsafe - ( -- * Types - Chip - , InfoEvent - - -- * Unsafe Manual Resource Allocation - , openChip - , closeChip - , readInfoEvent - , freeInfoEvent - ) where - -import qualified Data.ByteString.Char8 as BS8 -import qualified Fuyu.GPIO.Direct as D -import Fuyu.GPIO.Chip.Watch.Unsafe (readInfoEvent, freeInfoEvent) -import Fuyu.GPIO.Exception -import Fuyu.GPIO.Types - --- | Open a GPIO chip by its filesystem path (e.g. "/dev/gpiochip4"). --- Must be manually closed using 'closeChip'. -openChip :: FilePath -> IO Chip -openChip path = unwrapOrThrow (ChipOpenFailed path) (D.chipOpen (BS8.pack path)) - --- | Close a GPIO chip handle. -closeChip :: Chip -> IO () -closeChip = D.chipClose - diff --git a/src/Fuyu/GPIO/Chip/Watch.hs b/src/Fuyu/GPIO/Chip/Watch.hs deleted file mode 100644 --- a/src/Fuyu/GPIO/Chip/Watch.hs +++ /dev/null @@ -1,99 +0,0 @@ -{-# LANGUAGE PatternSynonyms #-} - --- | --- Module : Fuyu.GPIO.Chip.Watch --- Description : Operations for watching GPIO line status events. --- Maintainer : BassGT --- Stability : experimental --- Portability : POSIX (Linux gpiod v2) --- --- This module provides managed resource brackets ('withWatchLine', 'withEvent') --- and functions for watching line status changes (e.g. requested, released, reconfigured). --- --- It is designed to be imported qualified or used via top-level "Fuyu.GPIO": --- --- @ --- import qualified Fuyu.GPIO.Chip.Watch as Watch --- @ -module Fuyu.GPIO.Chip.Watch - ( -- * Types & Patterns - Chip - , ReadyChip(..) - , readyToChip - , WaitResult(..) - , LineInfo - , Offset - , pattern Offset - , Timeout - , pattern Nanoseconds - , pattern Immediate - , pattern Infinite - , Timestamp - , InfoEvent - , InfoEventType - , pattern Requested - , pattern Released - , pattern ConfigChanged - - -- * Managed Brackets - , withWatchLine - , withEvent - - -- * Line Watch Operations - , watchLine - , unwatchLine - , waitEvent - - -- * InfoEvent Accessors - , eventType - , timestampNs - , lineInfo - ) where - -import Control.Exception (bracket) -import qualified Fuyu.GPIO.Direct as D -import Fuyu.GPIO.Chip.Watch.Unsafe (readInfoEvent, freeInfoEvent) -import Fuyu.GPIO.Exception -import Fuyu.GPIO.Types hiding (eventType) - --- | Start watching a line for status change events (e.g. requested, released, reconfigured) --- within a bracket, automatically unwatching the line when finished. --- --- Passes the initial 'LineInfo' snapshot of the line to the callback. -withWatchLine :: Chip -> Offset -> (LineInfo -> IO a) -> IO a -withWatchLine chip offset' = bracket (watchLine chip offset') (\_ -> unwatchLine chip offset') - --- | Start watching a line for status change events (e.g. requested, released, reconfigured). --- Returns the initial 'LineInfo' snapshot of the line. -watchLine :: Chip -> Offset -> IO LineInfo -watchLine chip offset' = unwrapOrThrow LineInfoFailed (D.chipWatchLineInfo chip offset') - --- | Stop watching a line for status change events. -unwatchLine :: Chip -> Offset -> IO () -unwatchLine chip offset' = unwrapOrThrow LineInfoFailed (D.chipUnwatchLineInfo chip offset') - --- | Wait for status change info events on any of the watched lines on the chip until the specified timeout. --- Throws 'WaitInfoEventFailed' on error. -waitEvent :: Chip -> Timeout -> IO (WaitResult ReadyChip) -waitEvent chip timeout = do - res <- unwrapOrThrow WaitInfoEventFailed (D.chipWaitInfoEvent chip timeout) - pure $ case res of - D.EventReady -> EventReady (ReadyChip chip) - D.Timeout -> TimeoutResult - --- | Read a status change info event from a chip once 'waitEvent' indicates it is ready, --- and automatically free it afterwards. -withEvent :: ReadyChip -> (InfoEvent -> IO a) -> IO a -withEvent readyChip = bracket (readInfoEvent readyChip) freeInfoEvent - --- | Get the event type of an 'InfoEvent' ('Requested', 'Released', 'ConfigChanged'). -eventType :: InfoEvent -> IO InfoEventType -eventType = D.infoEventType - --- | Get the timestamp in nanoseconds of an 'InfoEvent'. -timestampNs :: InfoEvent -> IO Timestamp -timestampNs = D.infoEventTimestamp - --- | Get the line info snapshot associated with an 'InfoEvent'. -lineInfo :: InfoEvent -> IO LineInfo -lineInfo = D.infoEventLineInfo diff --git a/src/Fuyu/GPIO/Chip/Watch/Unsafe.hs b/src/Fuyu/GPIO/Chip/Watch/Unsafe.hs deleted file mode 100644 --- a/src/Fuyu/GPIO/Chip/Watch/Unsafe.hs +++ /dev/null @@ -1,33 +0,0 @@ --- | --- Module : Fuyu.GPIO.Chip.Watch.Unsafe --- Description : Unsafe manual resource allocation for line info events. --- Maintainer : BassGT --- Stability : experimental --- Portability : POSIX (Linux gpiod v2) --- --- Manual resource allocation ('readInfoEvent', 'freeInfoEvent') --- for applications that cannot use managed bracket functions. -module Fuyu.GPIO.Chip.Watch.Unsafe - ( -- * Types & Security Token - Chip - , ReadyChip(..) - , readyToChip - , InfoEvent - - -- * Unsafe Manual Resource Allocation - , readInfoEvent - , freeInfoEvent - ) where - -import qualified Fuyu.GPIO.Direct as D -import Fuyu.GPIO.Exception -import Fuyu.GPIO.Types - --- | Read a line info event from a chip after 'Fuyu.GPIO.Chip.Watch.waitEvent' confirms it is ready. --- Must be manually freed using 'freeInfoEvent'. -readInfoEvent :: ReadyChip -> IO InfoEvent -readInfoEvent (ReadyChip chip) = unwrapOrThrow ReadInfoEventFailed (D.chipReadInfoEvent chip) - --- | Free an info event object. -freeInfoEvent :: InfoEvent -> IO () -freeInfoEvent = D.infoEventFree diff --git a/src/Fuyu/GPIO/EdgeEvent.hs b/src/Fuyu/GPIO/EdgeEvent.hs --- a/src/Fuyu/GPIO/EdgeEvent.hs +++ b/src/Fuyu/GPIO/EdgeEvent.hs @@ -10,8 +10,14 @@ -- This module provides managed resource brackets ('withBuffer') and functions for waiting -- on edge events ('waitEvents') and reading them ('readEvents') securely using the -- 'ReadyRequest' capability token. +-- +-- It is designed to be imported qualified: +-- +-- @ +-- import qualified Fuyu.GPIO.EdgeEvent as Edge +-- @ module Fuyu.GPIO.EdgeEvent - ( -- * Security Token & Wait Result + ( -- * Security Tokens & Wait Result WaitResult(..) , ReadyRequest(..) , readyToRequest @@ -21,8 +27,10 @@ , Capacity , userBufferCapacity , capacity - , Event + , RawEvent , Timeout + , Event + , EventType , pattern Nanoseconds , pattern Immediate , pattern Infinite @@ -34,18 +42,19 @@ -- * Event Data Type & Parser , NonEmpty(..) , EdgeEvent(..) - , parseEvent + , parseRawEvent - -- * Event Buffer Operations (Managed) + -- * Event Buffer Operations , withBuffer , bufferCapacity , bufferNumEvents - , bufferEvent + , bufferRawEvent -- * Waiting & Reading Events , waitEvents , readEvents - , withRawEvents + , forRawEvents + , forRawEvents_ -- * RawEdgeEvent Metadata Accessors , eventType @@ -56,16 +65,30 @@ , copyEvent ) where -import Control.Exception (bracket) -import Control.Monad (forM) +import Control.Exception (bracket, throwIO) +import Foreign.C.Error (Errno(..)) +import Control.Monad (forM, forM_) import Data.List.NonEmpty (NonEmpty(..)) import qualified Data.List.NonEmpty as NE import Data.Word (Word64) import qualified Fuyu.GPIO.Direct as D -import Fuyu.GPIO.EdgeEvent.Unsafe (newEventBuffer, freeEventBuffer, readEventsRaw) +import Fuyu.GPIO.Unsafe (newEventBuffer, freeEventBuffer, readEventsRaw) import Fuyu.GPIO.Exception import Fuyu.GPIO.Types hiding (eventType) +-------------------------------------------------------------------------------- +-- Domain Type Aliases +-------------------------------------------------------------------------------- +-- | Type alias for 'EdgeEvent' designed for qualified use (e.g. @Edge.Event@). +type Event = EdgeEvent + +-- | Type alias for 'EdgeEventType' designed for qualified use (e.g. @Edge.EventType@). +type EventType = EdgeEventType + +-------------------------------------------------------------------------------- +-- Core Edge Event Functions +-------------------------------------------------------------------------------- + -- | Allocate an edge event buffer of the specified capacity and free it automatically afterwards. withBuffer :: Capacity -> (Buffer -> IO a) -> IO a withBuffer capacity' = bracket (newEventBuffer capacity') freeEventBuffer @@ -78,67 +101,79 @@ bufferNumEvents :: Buffer -> IO Word bufferNumEvents = D.eventBufferNumEvents --- | Get a specific edge event from the buffer by index. -bufferEvent :: Buffer -> Word -> IO Event -bufferEvent buf idx = unwrapOrThrow ReadEdgeEventsFailed (D.eventBufferGetEvent buf idx) +-- | Get a specific edge event from the buffer by index, returning 'Nothing' if the index is out of bounds. +bufferRawEvent :: Buffer -> Word -> IO (Maybe RawEvent) +bufferRawEvent buf idx = do + res <- D.eventBufferGetEvent buf idx + pure $ case res of + Right ev -> Just ev + Left _ -> Nothing -- | Wait for edge events to occur on requested lines until the specified timeout. -- Throws 'WaitEdgeEventsFailed' on error. waitEvents :: Request -> Timeout -> IO (WaitResult ReadyRequest) waitEvents req timeout = do - res <- unwrapOrThrow WaitEdgeEventsFailed (D.lineRequestWaitEdgeEvents req timeout) - pure $ case res of - D.EventReady -> EventReady (ReadyRequest req) - D.Timeout -> TimeoutResult + res <- D.lineRequestWaitEdgeEvents req timeout + case res of + Left (Errno 4) -> waitEvents req timeout -- Retry on EINTR so GHC RTS can deliver UserInterrupt. + Left err -> throwIO (WaitEdgeEventsFailed err) + Right D.EventReady -> pure (EventReady (ReadyRequest req)) + Right D.Timeout -> pure TimeoutResult -- | Parse a raw edge event pointer into a pure Haskell 'EdgeEvent' structure. -parseEvent :: Event -> IO EdgeEvent -parseEvent ev = EdgeEvent +parseRawEvent :: RawEvent -> IO Event +parseRawEvent ev = EdgeEvent <$> D.rawEdgeEventLineOffset ev <*> D.rawEdgeEventType ev <*> D.rawEdgeEventTimestampNs ev -- | Read buffered edge events once 'waitEvents' indicates they are ready, -- parsing them into a non-empty list of pure 'EdgeEvent' structures. -readEvents :: ReadyRequest -> Buffer -> IO (NonEmpty EdgeEvent) -readEvents readyReq buf = withRawEvents readyReq buf parseEvent +readEvents :: ReadyRequest -> Buffer -> IO (NonEmpty Event) +readEvents readyReq buf = forRawEvents readyReq buf parseRawEvent -- | Process raw edge events directly in the buffer using a callback without intermediate allocations, -- returning a non-empty list of results. -withRawEvents :: ReadyRequest -> Buffer -> (Event -> IO a) -> IO (NonEmpty a) -withRawEvents readyReq buf action = do +forRawEvents :: ReadyRequest -> Buffer -> (RawEvent -> IO a) -> IO (NonEmpty a) +forRawEvents readyReq buf action = do count <- readEventsRaw readyReq buf results <- forM [0 .. count - 1] $ \idx -> do - ev <- bufferEvent buf (fromIntegral idx) + Just ev <- bufferRawEvent buf (fromIntegral idx) + action ev + return $ NE.fromList results + +-- | Same as 'forRawEvents' but ignore the results +forRawEvents_ :: ReadyRequest -> Buffer -> (RawEvent -> IO b) -> IO () +forRawEvents_ readyReq buf action = do + count <- readEventsRaw readyReq buf + forM_ [0 .. count - 1] $ \idx -> do + Just ev <- bufferRawEvent buf (fromIntegral idx) action ev - case NE.nonEmpty results of - Just ne -> pure ne - Nothing -> ioError (userError "readEvents: expected at least one event from ReadyRequest but got none") - + -------------------------------------------------------------------------------- --- RawEdgeEvent Metadata Accessors +-- RawEvent Metadata Accessors -------------------------------------------------------------------------------- -- | Get the type of event ('Rising' or 'Falling'). -eventType :: Event -> IO EdgeEventType +eventType :: RawEvent -> IO EventType eventType = D.rawEdgeEventType -- | Get the event timestamp in nanoseconds. -timestampNs :: Event -> IO Timestamp +timestampNs :: RawEvent -> IO Timestamp timestampNs = D.rawEdgeEventTimestampNs -- | Get the offset of the line that triggered the event. -lineOffset :: Event -> IO Offset +lineOffset :: RawEvent -> IO Offset lineOffset = D.rawEdgeEventLineOffset -- | Get the global sequence number of the event. -globalSeqNo :: Event -> IO Word64 +globalSeqNo :: RawEvent -> IO Word64 globalSeqNo = D.rawEdgeEventGlobalSeqNo -- | Get the line-specific sequence number of the event. -lineSeqNo :: Event -> IO Offset +lineSeqNo :: RawEvent -> IO Offset lineSeqNo = D.rawEdgeEventLineSeqNo -- | Make a copy of a raw edge event object. -copyEvent :: Event -> IO Event +copyEvent :: RawEvent -> IO RawEvent copyEvent ev = unwrapOrThrow RawEdgeEventCopyFailed (D.rawEdgeEventCopy ev) diff --git a/src/Fuyu/GPIO/EdgeEvent/Unsafe.hs b/src/Fuyu/GPIO/EdgeEvent/Unsafe.hs deleted file mode 100644 --- a/src/Fuyu/GPIO/EdgeEvent/Unsafe.hs +++ /dev/null @@ -1,42 +0,0 @@ --- | --- Module : Fuyu.GPIO.EdgeEvent.Unsafe --- Description : Unsafe manual resource allocation and raw buffer reading for event buffers. --- Maintainer : BassGT --- Stability : experimental --- Portability : POSIX (Linux gpiod v2) --- --- Manual resource allocation ('newEventBuffer', 'freeEventBuffer') and raw reading ('readEventsRaw') for edge 'Buffer' handles. -module Fuyu.GPIO.EdgeEvent.Unsafe - ( -- * Types & Security Token - Buffer - , Capacity - , userBufferCapacity - , capacity - , ReadyRequest(..) - - -- * Unsafe Manual Resource Allocation & Reading - , newEventBuffer - , freeEventBuffer - , readEventsRaw - ) where - -import qualified Fuyu.GPIO.Direct as D -import Fuyu.GPIO.Exception -import Fuyu.GPIO.Types - --- | Allocate an edge event buffer of the specified capacity. --- Must be manually freed with 'freeEventBuffer'. -newEventBuffer :: Capacity -> IO Buffer -newEventBuffer cap = unwrapOrThrow EventBufferNewFailed (D.eventBufferNew (capacity cap)) - --- | Free an edge event buffer object. -freeEventBuffer :: Buffer -> IO () -freeEventBuffer = D.eventBufferFree - --- | Read raw edge events into the buffer and return the number of events read. --- Automatically uses the buffer's full capacity. --- Throws 'ReadEdgeEventsFailed' on error. -readEventsRaw :: ReadyRequest -> Buffer -> IO Int -readEventsRaw (ReadyRequest req) buf = do - cap <- D.eventBufferCapacity buf - unwrapOrThrow ReadEdgeEventsFailed (D.lineRequestReadEdgeEvents req buf cap) diff --git a/src/Fuyu/GPIO/Exception.hs b/src/Fuyu/GPIO/Exception.hs --- a/src/Fuyu/GPIO/Exception.hs +++ b/src/Fuyu/GPIO/Exception.hs @@ -1,28 +1,25 @@ {-# LANGUAGE DeriveAnyClass #-} -{-# LANGUAGE ScopedTypeVariables #-} -- | -- Module : Fuyu.GPIO.Exception --- Description : Exception types and high-level application handler for fuyu-gpio operations. +-- Description : Exception types for fuyu-gpio operations. -- Maintainer : BassGT -- Stability : experimental -- Portability : POSIX -- --- High-level exception type 'GpioException' thrown by fuyu-gpio operations, --- and managed application runner 'withGpioApp' for graceful signal handling. +-- High-level exception type 'GpioException' thrown by fuyu-gpio operations. module Fuyu.GPIO.Exception ( GpioException(..) , unwrapOrThrow - , withGpioApp ) where -import Control.Exception (Exception, SomeException, catch, fromException, throwIO, AsyncException(UserInterrupt)) +import Control.Exception (Exception, throwIO) +import System.OsPath.Posix (PosixPath) import Foreign.C.Error (Errno(..)) -import Control.Monad (void) -- | High-level exceptions thrown by fuyu-gpio operations. data GpioException - = ChipOpenFailed FilePath Errno + = ChipOpenFailed PosixPath Errno | ChipInfoFailed Errno | LineInfoFailed Errno | LineSettingsNewFailed Errno @@ -42,33 +39,10 @@ | LineInfoCopyFailed Errno | CustomGpioError String Errno | InvalidArgument String - deriving (Exception) - -instance Eq GpioException where - ChipOpenFailed p1 e1 == ChipOpenFailed p2 e2 = p1 == p2 && e1 == e2 - ChipInfoFailed e1 == ChipInfoFailed e2 = e1 == e2 - LineInfoFailed e1 == LineInfoFailed e2 = e1 == e2 - LineSettingsNewFailed e1 == LineSettingsNewFailed e2 = e1 == e2 - LineSettingsSetFailed e1 == LineSettingsSetFailed e2 = e1 == e2 - LineConfigNewFailed e1 == LineConfigNewFailed e2 = e1 == e2 - RequestConfigNewFailed e1 == RequestConfigNewFailed e2 = e1 == e2 - LineRequestFailed e1 == LineRequestFailed e2 = e1 == e2 - EventBufferNewFailed e1 == EventBufferNewFailed e2 = e1 == e2 - LineValueReadFailed e1 == LineValueReadFailed e2 = e1 == e2 - LineValueWriteFailed e1 == LineValueWriteFailed e2 = e1 == e2 - LineReconfigureFailed e1 == LineReconfigureFailed e2 = e1 == e2 - WaitEdgeEventsFailed e1 == WaitEdgeEventsFailed e2 = e1 == e2 - ReadEdgeEventsFailed e1 == ReadEdgeEventsFailed e2 = e1 == e2 - WaitInfoEventFailed e1 == WaitInfoEventFailed e2 = e1 == e2 - ReadInfoEventFailed e1 == ReadInfoEventFailed e2 = e1 == e2 - RawEdgeEventCopyFailed e1 == RawEdgeEventCopyFailed e2 = e1 == e2 - LineInfoCopyFailed e1 == LineInfoCopyFailed e2 = e1 == e2 - CustomGpioError s1 e1 == CustomGpioError s2 e2 = s1 == s2 && e1 == e2 - InvalidArgument msg1 == InvalidArgument msg2 = msg1 == msg2 - _ == _ = False + deriving (Eq, Exception) instance Show GpioException where - show (ChipOpenFailed path (Errno e)) = "ChipOpenFailed: Failed to open chip at '" ++ path ++ "' (errno " ++ show e ++ ")" + show (ChipOpenFailed path (Errno e)) = "ChipOpenFailed: Failed to open chip at " ++ show path ++ " (errno " ++ show e ++ ")" show (ChipInfoFailed (Errno e)) = "ChipInfoFailed (errno " ++ show e ++ ")" show (LineInfoFailed (Errno e)) = "LineInfoFailed (errno " ++ show e ++ ")" show (LineSettingsNewFailed (Errno e)) = "LineSettingsNewFailed (errno " ++ show e ++ ")" @@ -97,20 +71,3 @@ Left errno -> throwIO (mkExc errno) Right val -> pure val --- | High-level managed application runner. --- Automatically handles 'Ctrl+C' ('UserInterrupt'), interrupted system calls ('EINTR' / 'WaitEdgeEventsFailed'), --- and prints formatted 'GpioException' messages cleanly without uncaught backtraces. -withGpioApp :: IO a -> IO () -withGpioApp action = void action `catch` handleAppException - where - handleAppException :: SomeException -> IO () - handleAppException exc - | isUserInterrupt exc = putStrLn "\nLoop terminated successfully!" - | Just (WaitEdgeEventsFailed (Errno 4)) <- fromException exc = putStrLn "\nLoop terminated successfully!" - | Just (gpioErr :: GpioException) <- fromException exc = putStrLn $ "\n[GPIO Exception]: " ++ show gpioErr - | otherwise = throwIO exc - - isUserInterrupt :: SomeException -> Bool - isUserInterrupt e = case fromException e of - Just UserInterrupt -> True - _ -> False diff --git a/src/Fuyu/GPIO/Line.hs b/src/Fuyu/GPIO/Line.hs deleted file mode 100644 --- a/src/Fuyu/GPIO/Line.hs +++ /dev/null @@ -1,279 +0,0 @@ --- | --- Module : Fuyu.GPIO.Line --- Description : High-level operations for GPIO line settings, requests, and value I/O. --- Maintainer : BassGT --- Stability : experimental --- Portability : POSIX (Linux gpiod v2) --- --- This module provides managed resource brackets ('withSettings', 'withConfig', 'withRequest') --- for configuring GPIO line properties (direction, bias, drive mode, active-low, debounce) --- and requesting access to read or write logical values to GPIO lines. -module Fuyu.GPIO.Line - ( -- * Types & Patterns - Settings - , Config - , Request - , RequestConfig - , Offset - , pattern Offset - , Value - , pattern Active - , pattern Inactive - , pattern ValueError - , 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 - - -- * Managed Resource Allocation (with*) - , withSettings - , withConfig - , withRequest - - -- * Line Settings Operations - , setDirection - , direction - , setEdgeDetection - , edgeDetection - , setBias - , bias - , setDrive - , drive - , setEventClock - , eventClock - , setActiveLow - , activeLow - , setDebouncePeriodUs - , debouncePeriodUs - , setOutputValue - , outputValue - , resetSettings - - -- * Line Configuration Operations - , addSettings - , settings - , setOutputValues - , numOffsets - , configuredOffsets - , resetConfig - - -- * Line Value Operations (Read / Write) - , value - , values - , valuesSubset - , setValue - , setValues - , setValuesSubset - - -- * Line Request Operations & Metadata - , chipName - , numLines - , requestedOffsets - , fd - , reconfigureLines - ) where - -import Control.Exception (bracket, throwIO) -import Data.ByteString (ByteString) -import qualified Data.Vector.Storable as V -import System.Posix.Types (Fd) -import qualified Fuyu.GPIO.Direct as D -import Fuyu.GPIO.Exception -import Fuyu.GPIO.Line.Unsafe (newSettings, freeSettings, newConfig, freeConfig, requestLines, releaseRequest) -import Fuyu.GPIO.Types - --------------------------------------------------------------------------------- --- Resource Bracket Management --------------------------------------------------------------------------------- - --- | Allocate a new line settings object and free it automatically afterwards. -withSettings :: (Settings -> IO a) -> IO a -withSettings = bracket newSettings freeSettings - --- | Allocate a new line configuration object and free it automatically afterwards. -withConfig :: (Config -> IO a) -> IO a -withConfig = bracket newConfig freeConfig - --- | Request GPIO lines from a chip and automatically release them afterwards. -withRequest :: Chip -> Maybe RequestConfig -> Config -> (Request -> IO a) -> IO a -withRequest chip maybeReqConf lineConf = bracket (requestLines chip maybeReqConf lineConf) releaseRequest - --------------------------------------------------------------------------------- --- Line Settings Setters & Getters --------------------------------------------------------------------------------- - --- | 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 - --------------------------------------------------------------------------------- --- Line Configuration Operations --------------------------------------------------------------------------------- - --- | Add settings for a vector of line offsets in the configuration. -addSettings :: Config -> V.Vector Offset -> Settings -> IO () -addSettings config offsets stgs = unwrapOrThrow LineConfigNewFailed (D.lineConfigAddLineSettings config offsets stgs) - --- | Get settings for a specific line offset from configuration. -settings :: Config -> Offset -> IO Settings -settings config offset' = unwrapOrThrow LineConfigNewFailed (D.lineConfigLineSettings config offset') - --- | Set output values for lines in configuration. -setOutputValues :: Config -> V.Vector Value -> IO () -setOutputValues config vals - | V.elem ValueError vals = throwIO $ InvalidArgument "setOutputValues: Vector contains ValueError pattern, which cannot be set as an output value." - | otherwise = unwrapOrThrow LineConfigNewFailed (D.lineConfigSetOutputValues config 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 Storable 'V.Vector'. -configuredOffsets :: Config -> IO (V.Vector Offset) -configuredOffsets = D.lineConfigConfiguredOffsets - --- | Reset line configuration object to empty state. -resetConfig :: Config -> IO () -resetConfig = D.lineConfigReset - --------------------------------------------------------------------------------- --- Line Reading & Writing --------------------------------------------------------------------------------- - --- | Get the logical value of a requested GPIO line at the given offset. -value :: Request -> Offset -> IO Value -value req offset' = unwrapOrThrow LineValueReadFailed (D.lineRequestValue req offset') - --- | Get the logical values of all requested lines as a Storable 'V.Vector'. -values :: Request -> IO (V.Vector Value) -values req = unwrapOrThrow LineValueReadFailed (D.lineRequestValues req) - --- | Get the logical values of a subset of requested lines specified by offsets. -valuesSubset :: Request -> V.Vector Offset -> IO (V.Vector Value) -valuesSubset req offsets = unwrapOrThrow LineValueReadFailed (D.lineRequestSubsetValues req offsets) - --- | Set the logical value of a requested GPIO line at the given offset. -setValue :: Request -> Offset -> Value -> IO () -setValue _ _ ValueError = throwIO $ InvalidArgument "setValue: ValueError pattern is a read-only error state and cannot be written to a GPIO line." -setValue req offset' val = unwrapOrThrow LineValueWriteFailed (D.lineRequestSetValue req offset' val) - --- | Set the logical values of all requested lines from a Storable 'V.Vector'. -setValues :: Request -> V.Vector Value -> IO () -setValues req vals - | V.elem ValueError vals = throwIO $ InvalidArgument "setValues: Vector contains ValueError pattern, which cannot be written to GPIO lines." - | otherwise = unwrapOrThrow LineValueWriteFailed (D.lineRequestSetValues req vals) - --- | Set the logical values of a subset of requested lines from vectors of offsets and values. -setValuesSubset :: Request -> V.Vector Offset -> V.Vector Value -> IO () -setValuesSubset req offsets vals - | V.elem ValueError vals = throwIO $ InvalidArgument "setValuesSubset: Vector contains ValueError pattern, which cannot be written to GPIO lines." - | otherwise = unwrapOrThrow LineValueWriteFailed (D.lineRequestSetValuesSubset req offsets vals) - --------------------------------------------------------------------------------- --- Line Request Operations & Metadata --------------------------------------------------------------------------------- - --- | Get the name of the chip this request was made on. -chipName :: Request -> IO ByteString -chipName = D.lineRequestChipName - --- | Get the number of lines in the request. -numLines :: Request -> IO Word -numLines = D.lineRequestNumLines - --- | Get all requested line offsets as a Storable 'V.Vector'. -requestedOffsets :: Request -> IO (V.Vector Offset) -requestedOffsets = D.lineRequestRequestedOffsets - --- | Get the file descriptor associated with the line request handle. -fd :: Request -> IO Fd -fd = 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) diff --git a/src/Fuyu/GPIO/Line/Info.hs b/src/Fuyu/GPIO/Line/Info.hs deleted file mode 100644 --- a/src/Fuyu/GPIO/Line/Info.hs +++ /dev/null @@ -1,92 +0,0 @@ --- | --- Module : Fuyu.GPIO.Line.Info --- Description : Read-only metadata query functions for LineInfo snapshots. --- Maintainer : BassGT --- Stability : experimental --- Portability : POSIX (Linux gpiod v2) --- --- This module provides functions to inspect 'LineInfo' snapshots. --- It is designed to be imported qualified: --- --- @ --- import qualified Fuyu.GPIO.Line.Info as LineInfo --- @ -module Fuyu.GPIO.Line.Info - ( -- * Types - LineInfo - - -- * Managed Resource Allocation - , withLineInfo - - -- * Metadata Accessors - , offset - , name - , isUsed - , consumer - , direction - , edgeDetection - , bias - , drive - , isActiveLow - , isDebounced - , debouncePeriod - , eventClock - ) where - -import Control.Exception (bracket) -import Data.ByteString (ByteString) -import qualified Fuyu.GPIO.Direct as D -import Fuyu.GPIO.Line.Info.Unsafe (lineInfo, freeLineInfo) -import Fuyu.GPIO.Types - --- | Retrieve information about a specific line on a chip and free it automatically afterwards. -withLineInfo :: Chip -> Offset -> (LineInfo -> IO a) -> IO a -withLineInfo chip offset' = bracket (lineInfo chip offset') freeLineInfo - --- | Get the numeric 'Offset' of the line from a 'LineInfo' snapshot. -offset :: LineInfo -> IO Offset -offset = D.lineInfoOffset - --- | Get the name of the line (e.g. "GPIO17"), if set. -name :: LineInfo -> IO (Maybe ByteString) -name = D.lineInfoName - --- | Check if the line is currently in use by a consumer kernel driver or user process. -isUsed :: LineInfo -> IO Bool -isUsed = D.lineInfoIsUsed - --- | Get the consumer name string of the line, if in use. -consumer :: LineInfo -> IO (Maybe ByteString) -consumer = D.lineInfoConsumer - --- | Get the configured direction of the line ('DirInput', 'DirOutput', 'DirAsIs'). -direction :: LineInfo -> IO Direction -direction = D.lineInfoDirection - --- | Get the configured edge detection of the line ('EdgeNone', 'EdgeRising', 'EdgeFalling', 'EdgeBoth'). -edgeDetection :: LineInfo -> IO Edge -edgeDetection = D.lineInfoEdgeDetection - --- | Get the configured electrical bias ('BiasDisabled', 'BiasPullUp', 'BiasPullDown', etc.). -bias :: LineInfo -> IO Bias -bias = D.lineInfoBias - --- | Get the configured drive mode ('PushPull', 'OpenDrain', 'OpenSource'). -drive :: LineInfo -> IO Drive -drive = D.lineInfoDrive - --- | Check if active-low logic is configured for the line. -isActiveLow :: LineInfo -> IO Bool -isActiveLow = D.lineInfoIsActiveLow - --- | Check if hardware debounce is configured for the line. -isDebounced :: LineInfo -> IO Bool -isDebounced = D.lineInfoIsDebounced - --- | Get the debounce period in microseconds for the line. -debouncePeriod :: LineInfo -> IO Word -debouncePeriod = D.lineInfoDebouncePeriod - --- | Get the event clock source configured for the line ('Monotonic', 'Realtime', 'Hardware'). -eventClock :: LineInfo -> IO Clock -eventClock = D.lineInfoEventClock diff --git a/src/Fuyu/GPIO/Line/Info/Unsafe.hs b/src/Fuyu/GPIO/Line/Info/Unsafe.hs deleted file mode 100644 --- a/src/Fuyu/GPIO/Line/Info/Unsafe.hs +++ /dev/null @@ -1,35 +0,0 @@ --- | --- Module : Fuyu.GPIO.Line.Info.Unsafe --- Description : Unsafe manual resource allocation for LineInfo snapshots. --- Maintainer : BassGT --- Stability : experimental --- Portability : POSIX (Linux gpiod v2) --- --- Manual resource allocation ('lineInfo', 'freeLineInfo', 'copyLineInfo') for 'LineInfo' handles. -module Fuyu.GPIO.Line.Info.Unsafe - ( -- * Types - LineInfo - - -- * Unsafe Manual Resource Allocation - , lineInfo - , freeLineInfo - , copyLineInfo - ) where - -import qualified Fuyu.GPIO.Direct as D -import Fuyu.GPIO.Exception -import Fuyu.GPIO.Types - --- | Retrieve information about a specific line on a chip. --- Must be manually freed using 'freeLineInfo'. -lineInfo :: Chip -> Offset -> IO LineInfo -lineInfo chip offset' = unwrapOrThrow LineInfoFailed (D.chipLineInfo chip offset') - --- | Free a 'LineInfo' handle. -freeLineInfo :: LineInfo -> IO () -freeLineInfo = D.lineInfoFree - --- | Make a copy of a 'LineInfo' snapshot. --- Must be manually freed using 'freeLineInfo'. -copyLineInfo :: LineInfo -> IO LineInfo -copyLineInfo info = unwrapOrThrow LineInfoCopyFailed (D.lineInfoCopy info) diff --git a/src/Fuyu/GPIO/Line/Unsafe.hs b/src/Fuyu/GPIO/Line/Unsafe.hs deleted file mode 100644 --- a/src/Fuyu/GPIO/Line/Unsafe.hs +++ /dev/null @@ -1,57 +0,0 @@ --- | --- Module : Fuyu.GPIO.Line.Unsafe --- Description : Unsafe manual resource allocation for line settings, config, and requests. --- Maintainer : BassGT --- Stability : experimental --- Portability : POSIX (Linux gpiod v2) --- --- Manual resource allocation ('newSettings', 'freeSettings', 'newConfig', 'freeConfig', --- 'requestLines', 'releaseRequest') for line settings, configs, and requests. -module Fuyu.GPIO.Line.Unsafe - ( -- * Types - Chip - , Settings - , Config - , Request - , RequestConfig - - -- * Unsafe Manual Resource Allocation - , newSettings - , freeSettings - , newConfig - , freeConfig - , requestLines - , releaseRequest - ) where - -import qualified Fuyu.GPIO.Direct as D -import Fuyu.GPIO.Exception -import Fuyu.GPIO.Types - --- | Allocate a new line settings object. --- Must be manually freed with 'freeSettings'. -newSettings :: IO Settings -newSettings = unwrapOrThrow LineSettingsNewFailed D.lineSettingsNew - --- | Free a line settings object. -freeSettings :: Settings -> IO () -freeSettings = D.lineSettingsFree - --- | Allocate a new line configuration object. --- Must be manually freed with 'freeConfig'. -newConfig :: IO Config -newConfig = unwrapOrThrow LineConfigNewFailed D.lineConfigNew - --- | Free a line configuration object. -freeConfig :: Config -> IO () -freeConfig = D.lineConfigFree - --- | Request GPIO lines from a chip. --- Must be manually released with 'releaseRequest'. -requestLines :: Chip -> Maybe RequestConfig -> Config -> IO Request -requestLines chip maybeReqConf lineConf = - unwrapOrThrow LineRequestFailed (D.chipRequestLines chip maybeReqConf lineConf) - --- | Release a line request handle. -releaseRequest :: Request -> IO () -releaseRequest = D.lineRequestRelease diff --git a/src/Fuyu/GPIO/Monitor.hs b/src/Fuyu/GPIO/Monitor.hs new file mode 100644 --- /dev/null +++ b/src/Fuyu/GPIO/Monitor.hs @@ -0,0 +1,239 @@ +{-# LANGUAGE PatternSynonyms #-} + +-- | +-- Module : Fuyu.GPIO.Monitor +-- Description : Read-only metadata query functions for ChipInfo and LineInfo, +-- and operations for watching GPIO line status events. +-- Maintainer : BassGT +-- Stability : experimental +-- Portability : POSIX (Linux gpiod v2) +-- +-- This module unifies metadata query functions for 'ChipInfo' and 'LineInfo' +-- snapshots, as well as real-time line status change event monitoring ('InfoEvent'). +-- +-- It is designed to be imported qualified: +-- +-- @ +-- import qualified Fuyu.GPIO.Monitor as Monitor +-- @ +module Fuyu.GPIO.Monitor + ( -- * Chip Metadata Snapshot & Inspection + ChipInfo + , withChipInfo + , chipName + , label + , numLines + + -- * Line Metadata Snapshot & Inspection + , LineInfo + , withLineInfo + , offset + , lineName + , isUsed + , consumer + , direction + , edgeDetection + , bias + , drive + , isActiveLow + , isDebounced + , debouncePeriod + , eventClock + + -- * Line Status Watching & Events + , ReadyChip(..) + , readyToChip + , WaitResult(..) + , Event + , EventType + , pattern Requested + , pattern Released + , pattern ConfigChanged + , withWatchLine + , watchLine + , unwatchLine + , waitEvent + , withEvent + , eventType + , timestampNs + , lineInfo + + -- * Types & Patterns + , Chip + , 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 + , Timeout + , pattern Nanoseconds + , pattern Immediate + , pattern Infinite + , Timestamp + ) where + +import Control.Exception (bracket, throwIO) +import Foreign.C.Error (Errno(..)) +import qualified Data.ByteString.Char8 as C8 +import qualified Fuyu.GPIO.Direct as D +import qualified Fuyu.GPIO.Unsafe as Unsafe +import Fuyu.GPIO.Exception +import Fuyu.GPIO.Types hiding (eventType) + +-------------------------------------------------------------------------------- +-- Domain Type Aliases +-------------------------------------------------------------------------------- + +-- | Type alias for 'InfoEvent' designed for qualified use (e.g. @Monitor.Event@). +type Event = InfoEvent + +-- | Type alias for 'InfoEventType' designed for qualified use (e.g. @Monitor.EventType@). +type EventType = InfoEventType + +-------------------------------------------------------------------------------- +-- Chip Metadata Snapshot & Inspection +-------------------------------------------------------------------------------- + +-- | Retrieve information about a GPIO chip and free it automatically afterwards. +withChipInfo :: Chip -> (ChipInfo -> IO a) -> IO a +withChipInfo chip = bracket (Unsafe.chipInfo chip) Unsafe.freeChipInfo + +-- | Get the name of the GPIO chip (e.g. "gpiochip0"). +chipName :: ChipInfo -> IO String +chipName info = C8.unpack <$> D.chipInfoName info + +-- | Get the label of the GPIO chip. +label :: ChipInfo -> IO String +label info = C8.unpack <$> D.chipInfoLabel info + +-- | Get the total number of lines exposed by the GPIO chip. +numLines :: ChipInfo -> IO Word +numLines = D.chipInfoNumLines + +-------------------------------------------------------------------------------- +-- Line Metadata Snapshot & Inspection +-------------------------------------------------------------------------------- + +-- | Retrieve information about a specific line on a chip and free it automatically afterwards. +withLineInfo :: Chip -> Offset -> (LineInfo -> IO a) -> IO a +withLineInfo chip offset' = bracket (Unsafe.lineInfo chip offset') Unsafe.freeLineInfo + +-- | Get the numeric 'Offset' of the line from a 'LineInfo' snapshot. +offset :: LineInfo -> IO Offset +offset = D.lineInfoOffset + +-- | Get the name of the line (e.g. "GPIO17"), if set. +lineName :: LineInfo -> IO (Maybe String) +lineName info = fmap C8.unpack <$> D.lineInfoName info + +-- | Check if the line is currently in use by a consumer kernel driver or user process. +isUsed :: LineInfo -> IO Bool +isUsed = D.lineInfoIsUsed + +-- | Get the consumer name string of the line, if in use. +consumer :: LineInfo -> IO (Maybe String) +consumer info = fmap C8.unpack <$> D.lineInfoConsumer info + +-- | Get the configured direction of the line ('DirInput', 'DirOutput', 'DirAsIs'). +direction :: LineInfo -> IO Direction +direction = D.lineInfoDirection + +-- | Get the configured edge detection of the line ('EdgeNone', 'EdgeRising', 'EdgeFalling', 'EdgeBoth'). +edgeDetection :: LineInfo -> IO Edge +edgeDetection = D.lineInfoEdgeDetection + +-- | Get the configured electrical bias ('BiasDisabled', 'BiasPullUp', 'BiasPullDown', etc.). +bias :: LineInfo -> IO Bias +bias = D.lineInfoBias + +-- | Get the configured drive mode ('PushPull', 'OpenDrain', 'OpenSource'). +drive :: LineInfo -> IO Drive +drive = D.lineInfoDrive + +-- | Check if active-low logic is configured for the line. +isActiveLow :: LineInfo -> IO Bool +isActiveLow = D.lineInfoIsActiveLow + +-- | Check if hardware debounce is configured for the line. +isDebounced :: LineInfo -> IO Bool +isDebounced = D.lineInfoIsDebounced + +-- | Get the debounce period in microseconds for the line. +debouncePeriod :: LineInfo -> IO Word +debouncePeriod = D.lineInfoDebouncePeriod + +-- | Get the event clock source configured for the line ('Monotonic', 'Realtime', 'Hardware'). +eventClock :: LineInfo -> IO Clock +eventClock = D.lineInfoEventClock + +-------------------------------------------------------------------------------- +-- Line Status Watching & Events +-------------------------------------------------------------------------------- + +-- | Start watching a line for status change events (e.g. requested, released, reconfigured) +-- within a bracket, automatically unwatching the line and freeing the initial snapshot when finished. +-- Passes the initial 'LineInfo' snapshot of the line to the callback. +withWatchLine :: Chip -> Offset -> (LineInfo -> IO a) -> IO a +withWatchLine chip offset' = + bracket + (watchLine chip offset') + (\info -> do + Unsafe.freeLineInfo info + unwatchLine chip offset') + +-- | Start watching a line for status change events (e.g. requested, released, reconfigured). +-- Returns the initial 'LineInfo' snapshot of the line. +watchLine :: Chip -> Offset -> IO LineInfo +watchLine chip offset' = unwrapOrThrow LineInfoFailed (D.chipWatchLineInfo chip offset') + +-- | Stop watching a line for status change events. +unwatchLine :: Chip -> Offset -> IO () +unwatchLine chip offset' = unwrapOrThrow LineInfoFailed (D.chipUnwatchLineInfo chip offset') + +-- | Wait for status change info events on any of the watched lines on the chip until the specified timeout. +-- Throws 'WaitInfoEventFailed' on error. +waitEvent :: Chip -> Timeout -> IO (WaitResult ReadyChip) +waitEvent chip timeout = do + res <- D.chipWaitInfoEvent chip timeout + case res of + Left (Errno 4) -> waitEvent chip timeout -- Retry on EINTR so GHC RTS can deliver UserInterrupt. + Left err -> throwIO (WaitInfoEventFailed err) + Right D.EventReady -> pure (EventReady (ReadyChip chip)) + Right D.Timeout -> pure TimeoutResult + +-- | Read a status change info event from a chip once 'waitEvent' indicates it is ready, +-- and automatically free it afterwards. +withEvent :: ReadyChip -> (Event -> IO a) -> IO a +withEvent readyChip = bracket (Unsafe.readInfoEvent readyChip) Unsafe.freeInfoEvent + +-- | Get the event type of an 'InfoEvent' ('Requested', 'Released', 'ConfigChanged'). +eventType :: Event -> IO EventType +eventType = D.infoEventType + +-- | Get the timestamp in nanoseconds of an 'InfoEvent'. +timestampNs :: Event -> IO Timestamp +timestampNs = D.infoEventTimestamp + +-- | Get the line info snapshot associated with an 'InfoEvent'. +lineInfo :: Event -> IO LineInfo +lineInfo = D.infoEventLineInfo diff --git a/src/Fuyu/GPIO/RequestConfig.hs b/src/Fuyu/GPIO/RequestConfig.hs --- a/src/Fuyu/GPIO/RequestConfig.hs +++ b/src/Fuyu/GPIO/RequestConfig.hs @@ -19,7 +19,7 @@ import Control.Exception (bracket) import Data.ByteString (ByteString) import qualified Fuyu.GPIO.Direct as D -import Fuyu.GPIO.RequestConfig.Unsafe (newRequestConfig, freeRequestConfig) +import Fuyu.GPIO.Unsafe (newRequestConfig, freeRequestConfig) import Fuyu.GPIO.Types -- | Allocate a new request configuration object and free it automatically afterwards. diff --git a/src/Fuyu/GPIO/RequestConfig/Unsafe.hs b/src/Fuyu/GPIO/RequestConfig/Unsafe.hs deleted file mode 100644 --- a/src/Fuyu/GPIO/RequestConfig/Unsafe.hs +++ /dev/null @@ -1,29 +0,0 @@ --- | --- Module : Fuyu.GPIO.RequestConfig.Unsafe --- Description : Unsafe manual resource allocation for RequestConfig. --- Maintainer : BassGT --- Stability : experimental --- Portability : POSIX (Linux gpiod v2) --- --- Manual resource allocation ('newRequestConfig', 'freeRequestConfig') for 'RequestConfig' handles. -module Fuyu.GPIO.RequestConfig.Unsafe - ( -- * Types - RequestConfig - - -- * Unsafe Manual Resource Allocation - , newRequestConfig - , freeRequestConfig - ) where - -import qualified Fuyu.GPIO.Direct as D -import Fuyu.GPIO.Exception -import Fuyu.GPIO.Types - --- | Allocate a new request configuration object. --- Must be manually freed with 'freeRequestConfig'. -newRequestConfig :: IO RequestConfig -newRequestConfig = unwrapOrThrow RequestConfigNewFailed D.requestConfigNew - --- | Free a request configuration object. -freeRequestConfig :: RequestConfig -> IO () -freeRequestConfig = D.requestConfigFree diff --git a/src/Fuyu/GPIO/Types.hs b/src/Fuyu/GPIO/Types.hs --- a/src/Fuyu/GPIO/Types.hs +++ b/src/Fuyu/GPIO/Types.hs @@ -9,7 +9,7 @@ , Request , RequestConfig , Buffer - , Event + , RawEvent , ReadyRequest(..) , readyToRequest , ReadyChip(..) @@ -102,7 +102,7 @@ -- | Alias for 'D.EventBuffer' type Buffer = D.EventBuffer -- | Alias for 'D.RawEdgeEvent' -type Event = D.RawEdgeEvent +type RawEvent = D.RawEdgeEvent -- | Alias for 'D.LineOffset' type Offset = D.LineOffset diff --git a/src/Fuyu/GPIO/Unsafe.hs b/src/Fuyu/GPIO/Unsafe.hs new file mode 100644 --- /dev/null +++ b/src/Fuyu/GPIO/Unsafe.hs @@ -0,0 +1,241 @@ +-- | +-- Module : Fuyu.GPIO.Unsafe +-- Description : Unsafe manual resource allocation and low-level FFI operations. +-- Maintainer : BassGT +-- Stability : experimental +-- Portability : POSIX (Linux gpiod v2) +-- +-- Manual resource allocation ('openChip', 'closeChip', 'newLineSettings', 'freeLineSettings', etc.) +-- and raw FFI operations for applications that cannot use managed bracket functions. +module Fuyu.GPIO.Unsafe + ( -- * Types & Security Tokens + Chip + , ChipInfo + , LineInfo + , Settings + , Config + , Request + , RequestConfig + , Buffer + , RawEvent + , Offset + , Capacity + , userBufferCapacity + , capacity + , ReadyRequest(..) + , readyToRequest + , ReadyChip(..) + , readyToChip + , InfoEvent + + -- * Chip Manual Resource Allocation + , openChip + , closeChip + + -- * Chip Info Manual Resource Allocation + , chipInfo + , freeChipInfo + + -- * Chip Watch / Line Info Event Manual Resource Allocation + , watchLine + , unwatchLine + , readInfoEvent + , freeInfoEvent + + -- * Line Settings Manual Resource Allocation + , newLineSettings + , freeLineSettings + + -- * Line Configuration Manual Resource Allocation + , newLineConfig + , freeLineConfig + + -- * Line Request Manual Resource Allocation + , requestLines + , releaseLineRequest + + -- * Line Info Manual Resource Allocation & Copy + , lineInfo + , freeLineInfo + , copyLineInfo + + -- * Request Configuration Manual Resource Allocation + , newRequestConfig + , freeRequestConfig + + -- * Edge Event Buffer Manual Allocation & Raw Reading + , newEventBuffer + , freeEventBuffer + , readEventsRaw + ) where + +import System.OsPath.Posix (PosixPath) +import qualified Fuyu.GPIO.Direct as D +import Fuyu.GPIO.Exception +import Fuyu.GPIO.Types + +-------------------------------------------------------------------------------- +-- Chip Manual Resource Allocation +-------------------------------------------------------------------------------- + +-- | Open a GPIO chip by its filesystem path (e.g. @"\/dev\/gpiochip0"@). +-- Must be manually closed using 'closeChip'. +openChip :: PosixPath -> IO Chip +openChip path = unwrapOrThrow (ChipOpenFailed path) (D.chipOpen path) + +-- | Close a GPIO chip handle. +closeChip :: Chip -> IO () +closeChip = D.chipClose + +-------------------------------------------------------------------------------- +-- Chip Info Manual Resource Allocation +-------------------------------------------------------------------------------- + +-- | Retrieve chip info directly. +-- Must be manually freed using 'freeChipInfo'. +chipInfo :: Chip -> IO ChipInfo +chipInfo chip = unwrapOrThrow ChipInfoFailed (D.chipInfo chip) + +-- | Free a 'ChipInfo' handle. +freeChipInfo :: ChipInfo -> IO () +freeChipInfo = D.chipInfoFree + +-------------------------------------------------------------------------------- +-- Chip Watch / Line Info Event Manual Resource Allocation +-------------------------------------------------------------------------------- + +-- | Start watching a line for status change events (e.g. requested, released, reconfigured). +-- +-- Returns the initial 'LineInfo' snapshot of the line at the moment watching starts. +-- +-- * __Memory Management__: The returned 'LineInfo' is allocated in C heap memory and +-- must be manually freed using 'freeLineInfo'. +-- * __Kernel Watch State__: Freeing the 'LineInfo' snapshot does /not/ stop the kernel watch; +-- the kernel continues watching the line until 'unwatchLine' is explicitly called. +-- +-- @ +-- monitorApp :: IO () +-- monitorApp = do +-- chip <- openChip "\/dev\/gpiochip0" +-- +-- -- Start watching line in the kernel and get initial snapshot +-- info <- watchLine chip (Offset 271) +-- +-- -- Inspect initial metadata and free the snapshot immediately +-- dir <- Monitor.direction info +-- freeLineInfo info +-- +-- -- ... wait for events with 'Monitor.waitEvent' and read with 'readInfoEvent' ... +-- +-- -- Stop watching the line when finished +-- unwatchLine chip (Offset 271) +-- closeChip chip +-- @ +watchLine :: Chip -> Offset -> IO LineInfo +watchLine chip offset' = unwrapOrThrow LineInfoFailed (D.chipWatchLineInfo chip offset') + +-- | Stop watching a line for status change events. +-- Disables kernel notifications previously initiated with 'watchLine'. +unwatchLine :: Chip -> Offset -> IO () +unwatchLine chip offset' = unwrapOrThrow LineInfoFailed (D.chipUnwatchLineInfo chip offset') + +-- | Read a line info event from a chip after 'Fuyu.GPIO.Monitor.waitEvent' confirms it is ready. +-- Must be manually freed using 'freeInfoEvent'. +readInfoEvent :: ReadyChip -> IO InfoEvent +readInfoEvent (ReadyChip chip) = unwrapOrThrow ReadInfoEventFailed (D.chipReadInfoEvent chip) + +-- | Free an info event object. +freeInfoEvent :: InfoEvent -> IO () +freeInfoEvent = D.infoEventFree + +-------------------------------------------------------------------------------- +-- Line Settings Manual Resource Allocation +-------------------------------------------------------------------------------- + +-- | Allocate a new line settings object. +-- Must be manually freed with 'freeLineSettings'. +newLineSettings :: IO Settings +newLineSettings = unwrapOrThrow LineSettingsNewFailed D.lineSettingsNew + +-- | Free a line settings object. +freeLineSettings :: Settings -> IO () +freeLineSettings = D.lineSettingsFree + +-------------------------------------------------------------------------------- +-- Line Configuration Manual Resource Allocation +-------------------------------------------------------------------------------- + +-- | Allocate a new line configuration object. +-- Must be manually freed with 'freeLineConfig'. +newLineConfig :: IO Config +newLineConfig = unwrapOrThrow LineConfigNewFailed D.lineConfigNew + +-- | Free a line configuration object. +freeLineConfig :: Config -> IO () +freeLineConfig = D.lineConfigFree + +-------------------------------------------------------------------------------- +-- Line Request Manual Resource Allocation +-------------------------------------------------------------------------------- + +-- | Request GPIO lines from a chip. +-- Must be manually released with 'releaseLineRequest'. +requestLines :: Chip -> Maybe RequestConfig -> Config -> IO Request +requestLines chip maybeReqConf lineConf = + unwrapOrThrow LineRequestFailed (D.chipRequestLines chip maybeReqConf lineConf) + +-- | Release a line request handle. +releaseLineRequest :: Request -> IO () +releaseLineRequest = D.lineRequestRelease + +-------------------------------------------------------------------------------- +-- Line Info Manual Resource Allocation & Copy +-------------------------------------------------------------------------------- + +-- | Retrieve information about a specific line on a chip. +-- Must be manually freed using 'freeLineInfo'. +lineInfo :: Chip -> Offset -> IO LineInfo +lineInfo chip offset' = unwrapOrThrow LineInfoFailed (D.chipLineInfo chip offset') + +-- | Free a 'LineInfo' handle. +freeLineInfo :: LineInfo -> IO () +freeLineInfo = D.lineInfoFree + +-- | Make a copy of a 'LineInfo' snapshot. +-- Must be manually freed using 'freeLineInfo'. +copyLineInfo :: LineInfo -> IO LineInfo +copyLineInfo info = unwrapOrThrow LineInfoCopyFailed (D.lineInfoCopy info) + +-------------------------------------------------------------------------------- +-- Request Configuration Manual Resource Allocation +-------------------------------------------------------------------------------- + +-- | Allocate a new request configuration object. +-- Must be manually freed with 'freeRequestConfig'. +newRequestConfig :: IO RequestConfig +newRequestConfig = unwrapOrThrow RequestConfigNewFailed D.requestConfigNew + +-- | Free a request configuration object. +freeRequestConfig :: RequestConfig -> IO () +freeRequestConfig = D.requestConfigFree + +-------------------------------------------------------------------------------- +-- Edge Event Buffer Manual Allocation & Raw Reading +-------------------------------------------------------------------------------- + +-- | Allocate an edge event buffer of the specified capacity. +-- Must be manually freed with 'freeEventBuffer'. +newEventBuffer :: Capacity -> IO Buffer +newEventBuffer cap = unwrapOrThrow EventBufferNewFailed (D.eventBufferNew (capacity cap)) + +-- | Free an edge event buffer object. +freeEventBuffer :: Buffer -> IO () +freeEventBuffer = D.eventBufferFree + +-- | Read raw edge events into the buffer and return the number of events read. +-- Automatically uses the buffer's full capacity. +-- Throws 'ReadEdgeEventsFailed' on error. +readEventsRaw :: ReadyRequest -> Buffer -> IO Int +readEventsRaw (ReadyRequest req) buf = do + cap <- D.eventBufferCapacity buf + unwrapOrThrow ReadEdgeEventsFailed (D.lineRequestReadEdgeEvents req buf cap)