1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
|
{-# 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
|
