{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE OverloadedRecordDot #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeFamilies #-}

module Hsm.PWM
  ( PWMEffect
  , dutyCycle
  , withPWM
  , runPWM
  ) where

import Control.Monad.Loops (untilM_)
import Data.Text (Text, pack)
import Effectful (Dispatch(Static), DispatchOf, Eff, IOE, (:>))
import Effectful.Concurrent (Concurrent, threadDelay)
import Effectful.Dispatch.Static qualified as E
import Effectful.Exception (bracket_)
import Effectful.Log (Log, localDomain, logTrace_)
import Effectful.Reader.Static (Reader, ask)
import GHC.Records (HasField)
import System.FilePath ((</>))
import System.Posix.Files (fileAccess)

-- This `PWMEffect` implementation assumes `dtoverlay=pwm` is set in
-- `/boot/config.txt`, enabling PWM on GPIO 18 (channel 2) for the Pi 5. The
-- address attribute will be 2. 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 PWMEffect a b

type instance DispatchOf PWMEffect = Static E.WithSideEffects

newtype instance E.StaticRep PWMEffect =
  PWMEffect ()

domain :: Text
domain = "pwm"

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

exportPath :: FilePath
exportPath = pwmchip </> "export"

unexportPath :: FilePath
unexportPath = pwmchip </> "unexport"

chanIdx :: Word
chanIdx = 2

chanPath :: FilePath
chanPath = pwmchip </> ("pwm" <> show chanIdx)

enablePath :: FilePath
enablePath = chanPath </> "enable"

periodPath :: FilePath
periodPath = chanPath </> "period"

dutyCyclePath :: FilePath
dutyCyclePath = chanPath </> "duty_cycle"

-- 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 :: (Concurrent :> es, Log :> es) => FilePath -> Eff es ()
waitWritable path = do
  logTrace_ $ "Waiting for " <> pack path <> " to become writable"
  untilM_ (threadDelay 1000) $ E.unsafeEff_ (fileAccess path False True False)

dutyCycle :: (Concurrent :> es, Log :> es, PWMEffect :> es) => Word -> Eff es ()
dutyCycle dc = do
  localDomain domain $ logTrace_ $ "Setting duty cycle to " <> pack (show dc)
  E.unsafeEff_ $ writeFile (chanPath </> "duty_cycle") $ show dc

disable :: (Concurrent :> es, Log :> es, PWMEffect :> es) => Eff es ()
disable = do
  dutyCycle 0
  localDomain domain
    $ logTrace_
    $ "Disabling PWM channel " <> pack (show chanIdx)
  E.unsafeEff_ $ writeFile enablePath "0"

withPWM ::
     (Concurrent :> es, Log :> es, PWMEffect :> es) => Eff es a -> Eff es a
withPWM = bracket_ activate disable
  where
    activate = do
      localDomain domain
        $ logTrace_
        $ "Enabling PWM channel " <> pack (show chanIdx)
      E.unsafeEff_ $ writeFile enablePath "1"

runPWM ::
     forall env es a.
     ( HasField "pwmPeriod" env Word
     , Concurrent :> es
     , IOE :> es
     , Log :> es
     , Reader env :> es
     )
  => Eff (PWMEffect : es) a
  -> Eff es a
runPWM = E.evalStaticRep (PWMEffect ()) . bracket_ acquire release
  where
    acquire = do
      localDomain domain $ do
        waitWritable exportPath
        waitWritable unexportPath
        logTrace_
          $ "Exporting channel "
              <> pack (show chanIdx)
              <> " on chip "
              <> pack pwmchip
        E.unsafeEff_ $ writeFile exportPath $ show chanIdx
        waitWritable enablePath
        waitWritable periodPath
        waitWritable dutyCyclePath
        env <- ask @env
        logTrace_ $ "Fixing period to " <> pack (show env.pwmPeriod)
        E.unsafeEff_ $ writeFile periodPath $ show env.pwmPeriod
      disable
    release = do
      disable
      localDomain domain
        $ logTrace_
        $ "Unexporting channel "
            <> pack (show chanIdx)
            <> " on chip "
            <> pack pwmchip
      E.unsafeEff_ $ writeFile unexportPath $ show chanIdx