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

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

import Data.Text (Text, pack)
import Effectful (Dispatch(Static), DispatchOf, Eff, IOE, (:>))
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.Process (callCommand)

-- The following PWMEffect implementation assumes `dtoverlay=pwm` to be set on
-- `/boot/config.txt`. On the Pi 5, this enables one active PWM on GPIO 18.
-- This is channel 2, so the address attribute will be 2. Alternative
-- configurations with more PWM channels are possible. Consult the following
-- links for more info:
--
-- 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"

chanIdx :: Word
chanIdx = 2

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

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

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

disable :: (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 :: (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
     , IOE :> es
     , Log :> es
     , Reader env :> es
     )
  => Eff (PWMEffect : es) a
  -> Eff es a
runPWM action = E.evalStaticRep (PWMEffect ()) $ bracket_ acquire release action
  where
    export = pwmchip </> "export"
    period = chanPath </> "period"
    unexport = pwmchip </> "unexport"
    acquire = do
      localDomain domain $ do
        logTrace_
          $ "Exporting channel "
              <> pack (show chanIdx)
              <> " on chip "
              <> pack pwmchip
        E.unsafeEff_ $ writeFile export $ show chanIdx
        logTrace_ "Giving UDEV a chance to settle"
        E.unsafeEff_ $ callCommand "udevadm settle"
        env <- ask @env
        logTrace_ $ "Fixing period to " <> pack (show env.pwmPeriod)
        E.unsafeEff_ $ writeFile period $ show env.pwmPeriod
      disable
    release = do
      disable
      localDomain domain
        $ logTrace_
        $ "Unexporting channel "
            <> pack (show chanIdx)
            <> " on chip "
            <> pack pwmchip
      E.unsafeEff_ $ writeFile unexport $ show chanIdx