{-# LANGUAGE OverloadedRecordDot #-}
{-# LANGUAGE OverloadedStrings #-}

module Hsm.PWM
  ( PWMHandle
  , PWMChannel(PWM2, PWM3)
  , PWMConfig(PWMConfig, period, dutyCycle)
  , defaultPWMConfig
  , setPeriod
  , setDutyCycle
  , allocatePWM
  ) where

import Control.Concurrent (threadDelay)
import Control.IO.Region (Region, alloc_)
import Control.Monad.Loops (untilM_)
import Data.Text (Text, pack)
import Hsm.Log qualified as L
import System.FilePath ((</>))
import System.Posix.Files (fileAccess)

-- This data type defines a placeholder `PWMHandle` to ensure that PWM actions
-- occur only after the `allocatePWM` function has been called. The empty
-- handle acts as a flag to enforce the correct order of operations.
data PWMHandle =
  PWMHandle

-- This PWM controller assumes `dtoverlay=pwm-2chan` is set in
-- `/boot/config.txt`, enabling PWM on GPIO 18 (channel 2) and GPIO 19
-- (channel 3) for the Pi 5. Alternative configurations with additional PWM
-- channels are possible. For more information, consult the following links:
--
-- - Modifications to `config.txt`:
--   https://www.pi4j.com/blog/2024/20240423_pwm_rpi5/#modify-configtxt
--
-- - SysFS PWM interface:
--   https://forums.raspberrypi.com/viewtopic.php?t=359251
--
-- - UDEV setup for non-root access:
--   https://forums.raspberrypi.com/viewtopic.php?t=316514
data PWMChannel
  = PWM2
  | PWM3
  deriving (Bounded, Enum, Show)

data PWMConfig = PWMConfig
  { period :: Int
  , dutyCycle :: Int
  }

defaultPWMConfig :: PWMConfig
defaultPWMConfig = PWMConfig {period = 1000000, dutyCycle = 0}

logMsg :: Text -> IO ()
logMsg = L.logMsg ["pwm"]

chipPath :: FilePath
chipPath = "/sys/class/pwm/pwmchip0"

channelIndex :: PWMChannel -> Int
channelIndex = read . drop 3 . show

channelPaths :: PWMChannel -> (FilePath, FilePath, FilePath)
channelPaths channel = (enablePath, periodPath, dutyCyclePath)
  where
    channelPath = chipPath </> ("pwm" <> show (channelIndex channel))
    enablePath = channelPath </> "enable"
    periodPath = channelPath </> "period"
    dutyCyclePath = channelPath </> "duty_cycle"

setPeriod :: PWMHandle -> PWMChannel -> Int -> IO ()
setPeriod _ channel period = do
  logMsg
    $ "Setting period on channel "
        <> pack (show channel)
        <> " to "
        <> pack (show period)
  writeFile periodPath $ show period
  where
    (_, periodPath, _) = channelPaths channel

setDutyCycle :: PWMHandle -> PWMChannel -> Int -> IO ()
setDutyCycle _ channel dutyCycle = do
  logMsg
    $ "Setting duty cycle on channel "
        <> pack (show channel)
        <> " to "
        <> pack (show dutyCycle)
  writeFile dutyCyclePath $ show dutyCycle
  where
    (_, _, dutyCyclePath) = channelPaths channel

allocatePWM :: Region -> IO PWMHandle
allocatePWM region = alloc_ region acquire $ const release
  where
    exportPath = chipPath </> "export"
    unexportPath = chipPath </> "unexport"
    -- This function waits for a file at the given `path` to become writable
    -- by the `pwm` user group. A UDEV rule ensures that files in
    -- `/sys/class/pwm/pwmchip*` are made writable through a `chown` call.
    -- However, because UDEV rules are applied asynchronously, there may be a
    -- brief delay before the rule takes effect. This function blocks and
    -- repeatedly checks the file's write permissions by calling `fileAccess`.
    -- It continues checking until write access is confirmed.
    waitWritable path = do
      logMsg $ "Waiting for " <> pack path <> " to become writable"
      untilM_ (threadDelay 1000) $ fileAccess path False True False
    allChannels = [minBound .. maxBound]
    -- Acquire PWM channels
    acquireChannel channel = do
      logMsg
        $ "Exporting channel "
            <> pack (show channel)
            <> " on chip "
            <> pack chipPath
      writeFile exportPath $ show (channelIndex channel)
      let (enablePath, periodPath, dutyCyclePath) = channelPaths channel
      waitWritable enablePath
      waitWritable periodPath
      waitWritable dutyCyclePath
      logMsg $ "Enabling channel " <> pack (show channel)
      writeFile enablePath "1"
      -- Sets default PWM period to 1 us
      setPeriod PWMHandle channel 1000
      setDutyCycle PWMHandle channel 0
    acquire = do
      waitWritable exportPath
      waitWritable unexportPath
      mapM_ acquireChannel allChannels
      return PWMHandle
    -- Release PWM channels
    releaseChannel channel = do
      let (enablePath, _, dutyCyclePath) = channelPaths channel
      logMsg $ "Setting duty cycle to 0 on channel " <> pack (show channel)
      writeFile dutyCyclePath "0"
      logMsg $ "Disabling channel " <> pack (show channel)
      writeFile enablePath "0"
      logMsg
        $ "Unexporting channel "
            <> pack (show channel)
            <> " on chip "
            <> pack chipPath
      writeFile unexportPath $ show (channelIndex channel)
    release = mapM_ releaseChannel allChannels