EdgeEvent.hs

{-# LANGUAGE PatternSynonyms #-}

-- |
-- Module      : Fuyu.GPIO.EdgeEvent
-- Description : High-level edge event waiting, reading, and buffer management.
-- Maintainer  : BassGT
-- Stability   : experimental
-- Portability : POSIX (Linux gpiod v2)
--
-- 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 Tokens & Wait Result
    WaitResult(..)
  , ReadyRequest(..)
  , readyToRequest

    -- * Buffer & Event Types
  , Buffer
  , Capacity
  , userBufferCapacity
  , capacity
  , RawEvent
  , Timeout
  , Event
  , EventType  
  , pattern Nanoseconds
  , pattern Immediate
  , pattern Infinite
  , Timestamp
  , EdgeEventType
  , pattern Rising
  , pattern Falling

    -- * Event Data Type & Parser
  , NonEmpty(..)
  , EdgeEvent(..)
  , parseRawEvent

    -- * Event Buffer Operations
  , withBuffer
  , bufferCapacity
  , bufferNumEvents
  , bufferRawEvent

    -- * Waiting & Reading Events
  , waitEvents
  , readEvents
  , forRawEvents
  , forRawEvents_

    -- * RawEdgeEvent Metadata Accessors
  , eventType
  , timestampNs
  , lineOffset
  , globalSeqNo
  , lineSeqNo
  , copyEvent
  ) where

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.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

-- | Get the capacity of an event buffer.
bufferCapacity :: Buffer -> IO Capacity
bufferCapacity buf = userBufferCapacity <$> D.eventBufferCapacity buf

-- | Get the number of events currently stored in an event buffer.
bufferNumEvents :: Buffer -> IO Word
bufferNumEvents = D.eventBufferNumEvents

-- | 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 <- 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.
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 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.
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
    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
  
--------------------------------------------------------------------------------
-- RawEvent Metadata Accessors
--------------------------------------------------------------------------------

-- | Get the type of event ('Rising' or 'Falling').
eventType :: RawEvent -> IO EventType
eventType = D.rawEdgeEventType

-- | Get the event timestamp in nanoseconds.
timestampNs :: RawEvent -> IO Timestamp
timestampNs = D.rawEdgeEventTimestampNs

-- | Get the offset of the line that triggered the event.
lineOffset :: RawEvent -> IO Offset
lineOffset = D.rawEdgeEventLineOffset

-- | Get the global sequence number of the event.
globalSeqNo :: RawEvent -> IO Word64
globalSeqNo = D.rawEdgeEventGlobalSeqNo

-- | Get the line-specific sequence number of the event.
lineSeqNo :: RawEvent -> IO Offset
lineSeqNo = D.rawEdgeEventLineSeqNo

-- | Make a copy of a raw edge event object.
copyEvent :: RawEvent -> IO RawEvent
copyEvent ev = unwrapOrThrow RawEdgeEventCopyFailed (D.rawEdgeEventCopy ev)