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
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
|
{-# LANGUAGE OverloadedStrings #-}
module Hsm.PWM
( PWMHandle
, PWMChannel(PWM2, PWM3)
, setFrequency
, 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)
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"
setEnable :: PWMChannel -> Bool -> IO ()
setEnable channel enable = do
logMsg $ "Setting " <> pack enablePath <> " to " <> pack (show enable)
writeFile enablePath enableString
where
(enablePath, _, _) = channelPaths channel
enableString = show $ fromEnum enable
setPeriod :: PWMChannel -> Int -> IO ()
setPeriod channel period = do
logMsg $ "Setting " <> pack periodPath <> " to " <> pack (show period)
writeFile periodPath $ show period
where
(_, periodPath, _) = channelPaths channel
setDutyCycle :: PWMChannel -> Int -> IO ()
setDutyCycle channel dutyCycle = do
logMsg $ "Setting " <> pack dutyCyclePath <> " to " <> pack (show dutyCycle)
writeFile dutyCyclePath $ show dutyCycle
where
(_, _, dutyCyclePath) = channelPaths channel
setFrequency :: PWMHandle -> PWMChannel -> Int -> IO ()
setFrequency _ channel frequency = do
logMsg
$ "Setting frequency on channel "
<> pack (show channel)
<> " to "
<> pack (show frequency)
setEnable channel False
setPeriod channel frequency
setDutyCycle channel $ frequency `div` 2
setEnable channel True
allocatePWM :: Region -> (PWMChannel -> Int) -> IO PWMHandle
allocatePWM region mapper = 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
setFrequency PWMHandle channel $ mapper channel
acquire = do
waitWritable exportPath
waitWritable unexportPath
mapM_ acquireChannel allChannels
return PWMHandle
-- Release PWM channels
releaseChannel channel = do
setEnable channel False
logMsg
$ "Unexporting channel "
<> pack (show channel)
<> " on chip "
<> pack chipPath
writeFile unexportPath $ show (channelIndex channel)
release = mapM_ releaseChannel allChannels
|
