Safe Haskell | Safe |
---|---|
Language | Haskell2010 |
- newtype Pin = Pin Int
- data PinValue
- data PinActiveLevel
- data PinDirection
- data PinInputMode
- data PinOutputMode
- data PinInterruptMode
- data PinCapabilities = PinCapabilities {}
- runTutorial :: SysfsGpioMockIO a -> IO a
- data InputPin h
- withInputPin :: MaskGpioM h m => Pin -> PinInputMode -> Maybe PinActiveLevel -> (InputPin h -> m a) -> m a
- data InterruptPin h
- withInterruptPin :: MaskGpioM h m => Pin -> PinInputMode -> PinInterruptMode -> Maybe PinActiveLevel -> (InterruptPin h -> m a) -> m a
- data OutputPin h
- withOutputPin :: MaskGpioM h m => Pin -> PinOutputMode -> Maybe PinActiveLevel -> PinValue -> (OutputPin h -> m a) -> m a
- data TutorialEnv
- type TutorialReaderGpioIO a = ReaderT TutorialEnv (SysfsGpioT (SysfsMockT IO)) a
Introduction
The hpio
package is a collection of monads for writing GPIO programs
in Haskell.
For each supported GPIO platform, hpio
provides two contexts for
writing GPIO programs: a cross-platform domain-specific language
(DSL), and a platform-specific DSL. Programs written in the
cross-platform DSL will run on any supported platform, but as the
cross-platform DSL must take a "least-common denominator" approach,
cross-platform programs may not be capable of taking advantage of all
of the features of a particular GPIO platform. On the other hand,
programs written for a platform-specific DSL can use all of those
platform-specific features, but will not work on other GPIO platforms.
Primarily, this tutorial focuses on the cross-platform DSL.
Requirements
Though Haskell is a much more capable programming language than, say,
Wiring, this power comes with a few trade-offs.
Whereas a program written in Wiring (or even C) can run directly on a
low-cost microcontroller, a program written in Haskell cannot.
Therefore, hpio
is intended for use with more powerful GPIO-capable
platforms, such as the Raspberry Pi platform,
or the Beagle platform, which
marry a 32- or 64-bit CPU core with GPIO functionality.
Terminology and types
GPIO
General-purpose input/output. A GPIO pin is a user-programmable, serial (i.e., a single-bit wide) interface from the system to an external device or circuit. GPIO pins can usually be configured either for input (for reading external signals) or for output (for driving signals to external devices), though sometimes a pin may be hard-wired to one direction or the other.
Some platforms may reserve one or more GPIO pins for their own use,
e.g., to drive an external storage interface. Typically these pins are
not visible to the user and therefore cannot be programmed by hpio
,
but you should always consult your hardware documentation to make sure
you don't accidentally use a system-reserved pin.
GPIO pins are often physically expressed on a circuit board as a male or female breakout header, which is a bank of pins (male) or sockets (female) for connecting individual wires or low-density molded connectors. However, on platforms with a large number of GPIO pins, it is typically the case that just a handful of pins are accessible via such a header, while the rest are only accessible via a high-density connector, intended for use by high-volume system integrators with custom hardware designs.
Pin number
GPIO pins are typically identified by their pin number. Unfortunately, it is often the case that the pin number used in the system's hardware documentation is different than the pin number used by the software to identify the same pin.
In hpio
, a pin's number refers to the number used by the system
software to identify the pin. Consult your hardware documentation (or
Google) for the hardware-to-software pin mapping.
hpio
uses the Pin
type to identify GPIO pins.
A GPIO pin, identified by pin number.
Note that GPIO pin numbering is platform- and runtime-dependent. See the documentation for your particular platform for an explanation of how pin numbers are assigned to physical pins.
Pin (signal) value
In digital design, a pin's value (sometimes called its signal level) is either high or low. When we say that a pin's value or signal level is high, we mean the general notion of the pin being "on" or active; and when we say the pin's value or signal level is low, we mean the pin is "off" or inactive.
Complicating matters is the concept of active-low logic. Digital electronic components are built using either positive (active-high) logic, or negative (active-low) logic. In active-high logic, a pin is active when the voltage on the pin is high (relative to ground); whereas in active-low logic, a pin is active when the voltage on the pin is low (or grounded).
When designing logic, or programs to interface with logic, it's often
easier to think of a signal as being active or inactive, rather than
worrying about its physical voltage. Therefore, the hpio
cross-platform DSL supports, on a pin-by-pin basis, both types of
logic: active-high and active-low. When writing your programs, you can
simply use the values High
and Low
, and then set a per-pin active
level before running your program, depending on whether you're
interfacing with active-high or active-low logic.
In the hpio
documentation, and in this tutorial, whenever you see a
reference to a "pin value" or "signal level," unless otherwise noted,
we mean the abstract notion of the pin being "on" or "off,"
independent of the voltage level seen on the physical pin. We refer to
this notion as the pin's logical value, as opposed to
its physical value.
In hpio
, the PinValue
type represents a pin's value, and
PinActiveLevel
represents its active-level setting:
A pin's signal level as a binary value.
data PinActiveLevel Source #
A pin's active level (active-high/active-low).
Pin direction and pin input / output modes
We say a pin's direction is either in (for input) or out (for output). However, not all inputs and outputs are necessarily the same. On some GPIO platforms, it's possible to configure an input or output pin in various modes which change the behavior of the pin under certain conditions.
For example, consider an input pin. If the pin is not connected to a source, what is its value? If the input pin is in floating mode (sometimes called tri-state or high-impedance mode), then its value when disconnected may "float," or vary, from moment to moment. Perhaps your application can tolerate this indeterminacy, in which case floating mode is fine, and probably uses less power than other input modes, to boot. But if your application requires that a disconnected pin maintain a predictable, constant state, and your GPIO platform supports it, you can set the input pin's mode to pull-up or pull-down to give the disconnected pin an always-high or always-low value, respectively.
Output pin modes are even more complicated due to the fact that multiple output pins are often connected together to drive a single input; this is known as wired-OR or wired-AND design, depending on whether the devices involved use positive or negative logic.
A full discussion of the various input and output modes, and when you
should use them, is outside the scope of this tutorial. We simply
point out here that the hpio
cross-platform DSL provides the ability
to set many of these modes on your input and output pins, provided
that your hardware supports them.
For simple needs, the DSL provides default input and output mode values, which set whatever mode the target platform uses by default. These are the values we'll use in this tutorial.
In hpio
, the PinDirection
type represents a pin's direction (a
simple "in" or "out"), while the PinInputMode
and PinOutputMode
types represent modes for input and output pins, respectively.
data PinDirection Source #
A pin's direction (input/output).
data PinInputMode Source #
GPIO pins may support a number of different physical configurations when used as a digital input.
Pins that are capable of input will at least support the
InputDefault
mode. InputDefault
mode is special in that, unlike
the other input modes, it does not represent a unique physical
configuration, but is simply a pseudonym for another (actual) input
mode. Exactly which mode is used by the hardware when
InputDefault
mode is specified is platform-dependent. By using
InputDefaut
mode, you are saying that you don't care about the
pin's actual configuration, other than the fact that it's being
used for input.
InputDefault | The pin's default input mode, i.e., the mode used when a more specific mode is not specified |
InputFloating | A floating / high-impedance / tri-state mode which uses little power, but when disconnected, may cause the pin's value to be indeterminate |
InputPullUp | The pin is connected to an internal pull-up resistor such
that, when the pin is disconnected or connected to a floating /
high-impedance node, its physical value will be |
InputPullDown | The pin is connected to an internal pull-down resistor such
that, when the pin is disconnected or connected to a floating /
high-impedance node, its physical value will be |
data PinOutputMode Source #
GPIO pins may support a number of different physical configurations when used as a digital output.
Pins that are capable of output will at least support the
OutputDefault
mode. OutputDefault
mode is special in that,
unlike the other output modes, it does not represent a unique
physical configuration, but is simply a pseudonym for another
(actual) output mode. Exactly which mode is used by the hardware
when OutputDefault
mode is specified is platform-dependent. By
using OutputDefaut
mode, you are saying that you don't care about
the pin's actual configuration, other than the fact that it's being
used for output.
OutputDefault | The pin's default output mode, i.e., the mode used when a more specific mode is not specified |
OutputPushPull | |
OutputOpenDrain | The output actively drives the |
OutputOpenDrainPullUp | The output actively drives the |
OutputOpenSource | The output actively drives the |
OutputOpenSourcePullDown | The output actively drives the |
Interrupts
In logic programming, it's often useful to block the program's execution on an input pin until its value changes. Furthermore, you may want to wait until the signal transitions from low to high (its rising edge), or from high to low (its falling edge).
The hpio
cross-platform DSL supports this functionality. You can
block the current Haskell thread on a GPIO input pin until a rising
edge, falling edge, or either edge (a level trigger), is visible on
the pin -- effectively, a programmable interrupt. Which type event of
triggers the interrupt is determined by the pin's interrupt mode.
If you want to mask interrupts for some period of time without needing to stop and re-start the blocking thread, you can also disable interrupts on a given pin.
Some pins may not support this functionality, but the cross-platform DSL provides a mechanism to query a pin to see whether it's supported.
The PinInterruptMode
type represents the type of event which
triggers an interrupt.
data PinInterruptMode Source #
A pin's interrupt mode.
Note that the pin's interrupt mode is defined in terms of the pin's
logical signal value; i.e., when the pin is configured for
active-low logic, RisingEdge
refers to the physical signal's
trailing edge, and FallingEdge
refers to the physical signal's
rising edge.
Disabled | Interrupts are disabled |
RisingEdge | Interrupt on the pin's (logical) rising edge |
FallingEdge | Interrupt on the pin's (logical) falling edge |
Level | Interrupt on any change to the pin's signal level |
Pin capabilities
To help you determine which modes a particular pin supports, hpio
provides the PinCapabilities
type.
data PinCapabilities Source #
Catalog a pin's capabilities.
PinCapabilities | |
|
Interpreters
The hpio
cross-platform DSL is defined by the MonadGpio
type
class. Each method of the MonadGpio
type class describes an action
that can be performed on a GPIO pin (or on the GPIO system as a
whole).
For each supported platform, hpio
provides an instance of the
MonadGpio
type class. The platform-specific instance maps actions in
the cross-platform DSL to actions on that particular GPIO platform.
You can therefore think of each MonadGpio
instance as a
platform-specific interpreter for the cross-platform DSL. Each
interpreter provides a "run" action which, given a MonadGpio
program, will execute the program on its GPIO platform.
A mock interpreter
Testing GPIO programs is inconvenient. The target system is often under-powered compared to our development environment, and may use a completely different processor architecture and / or operating system (and cross-compiling Haskell programs is, circa 2016, still somewhat problematic). It's also not uncommon for our development environments not to have any GPIO capabilities at all.
For your convenience, hpio
provides a reasonably complete, entirely
software-based "mock" GPIO implementation that can run on any system
where Haskell programs can run, irrespective of that system's GPIO
capabilities or operating system. This particular implementation mocks
the Linux sysfs
GPIO filesystem and is capable of emulating much of
that platform's functionality.
In this tutorial, we will make use of this mock GPIO implementation in many of the code examples, meaning that those examples can be run on any Haskell-capable system. In a few cases, we'll discuss functionality that the mock implementation does not handle. These cases will be called out.
To use the mock interpreter, you must supply its mock GPIO state, and
this is a bit complicated, not to mention irrelevant to understanding
how to use the hpio
cross-platform DSL. (Using an interpreter for a
real GPIO platform is much simpler.) To avoid getting bogged down in
the details, we'll supply a wrapper, named runTutorial
, which sets
up a mock GPIO environment with 17 pins and runs a hpio
program in
that environment. The first 16 pins, numbered 0-15, are fully-general
pins. Pin 17 is a special-case pin that we'll use to demonstrate
failure modes and other quirks.
(Don't worry about the details of the SysfsGpioMockIO
type for the
moment. We'll explain it later. For now, suffice it to say that it's
the type of our hpio
programs when run in this particular mock
interpreter.)
Note: in our examples, each time we use runTutorial
we are
creating a new mock environment from scratch, so any changes made to
the mock environment are not persistent from one example to the next.
runTutorial :: SysfsGpioMockIO a -> IO a Source #
Run a hpio
program on a mock system with 17 GPIO pins.
Basic pin operations
Which pins are available?
To get the list of all pins available on the system, use the pins
command:
>>>
runTutorial pins
[Pin 0,Pin 1,Pin 2,Pin 3,Pin 4,Pin 5,Pin 6,Pin 7,Pin 8,Pin 9,Pin 10,Pin 11,Pin 12,Pin 13,Pin 14,Pin 15,Pin 16]
Querying a pin's capabilities
To see which modes a pin supports, use the pinCapabilities
command:
>>>
runTutorial $ pinCapabilities (Pin 1)
PinCapabilities {_inputModes = fromList [InputDefault], _outputModes = fromList [OutputDefault], _interrupts = True}
>>>
runTutorial $ pinCapabilities (Pin 16)
PinCapabilities {_inputModes = fromList [], _outputModes = fromList [], _interrupts = False}
Here we can see that Pin
1
can support both input and output --
though not any specific input or output modes, only the defaults --
and also interrupts. Pin
16
, on the other hand, is effectively
useless, as it's capable of neither input nor output. (Pin
16
is
pathalogical, and you wouldn't expect to see a pin like this on an
actual system.)
Pin resource management
Before you can operate on a GPIO pin, you must signal your intention to the system by opening that pin. Opening the pin returns a handle, which you then use to operate on the pin. Then, when you're finished with the pin, you should allow the system to clean up any pin-related resources by closing the pin.
Opening and closing a pin are performed by the openPin
and
closePin
DSL actions, respectively:
>>>
:{
runTutorial $ do h <- openPin (Pin 5) liftIO $ putStrLn "Opened pin 5" closePin h liftIO $ putStrLn "Closed pin 5" :} Opened pin 5 Closed pin 5
(Note that, because our interpreter is an instance of MonadIO
, we
can interleave IO
actions into our GPIO computations.)
As with file handles, when an exception occurs in a computation, we
should clean up any open pin handles. We could wrap each openPin
/
closePin
pair with bracket
, or we could just
use the provided withPin
wrapper, which does this for us:
>>>
:{
runTutorial $ withPin (Pin 5) $ \h -> do liftIO $ putStrLn "Opened pin 5" fail "Oops" :} Opened pin 5 *** Exception: user error (Oops)
Using withPin
is good hygiene, so we'll use it throughout this
tutorial.
You can, of course, nest uses of withPin
:
>>>
:{
runTutorial $ do withPin (Pin 5) $ \h1 -> do liftIO $ putStrLn "Opened pin 5" withPin (Pin 6) $ \h2 -> liftIO $ putStrLn "Opened pin 6" liftIO $ putStrLn "Closed pin 6" liftIO $ putStrLn "Closed pin 5" :} Opened pin 5 Opened pin 6 Closed pin 6 Closed pin 5
Pin configuration
Every pin has an active level, which we can query using
getPinActiveLevel
:
>>>
runTutorial $ withPin (Pin 8) getPinActiveLevel
ActiveHigh
You can change it using setPinActiveLevel
:
>>>
:{
runTutorial $ withPin (Pin 5) $ \h -> do setPinActiveLevel h ActiveLow getPinActiveLevel h :} ActiveLow
or toggle it using togglePinActiveLevel
:
>>>
runTutorial $ withPin (Pin 8) togglePinActiveLevel
ActiveLow
You can get a pin's current direction using getPinDirection
:
>>>
runTutorial $ withPin (Pin 10) getPinDirection
Out
>>>
runTutorial $ withPin (Pin 16) getPinDirection -- Pin 16's direction is not settable
*** Exception: NoDirectionAttribute (Pin 16)
If getPinDirection
fails, as it does for Pin
16
in our example,
then the pin's direction is not queryable in a cross-platform way, in
which case you'll need another (platform-specific) method for
determining its hard-wired direction.
To configure a pin for input or output, we must specify not only its
direction, but also its input / output mode, as discussed earlier.
Therefore, there is no setPinDirection
action. Instead, you set the
pin's direction and mode simultaneously using the setPinInputMode
or setPinOutputMode
actions:
>>>
:{
runTutorial $ withPin (Pin 5) $ \h -> do setPinInputMode h InputDefault getPinDirection h :} In
>>>
:{
runTutorial $ withPin (Pin 5) $ \h -> do setPinOutputMode h OutputDefault Low getPinDirection h :} Out
Note that when we configure a pin for output, we must also supply an initial output value for the pin. (This value is relative to the pin's active level, i.e., it is a logical value.)
If we want to know more about the pin's input or output configuration than just its direction, we can query its input or output mode:
>>>
:{
runTutorial $ withPin (Pin 5) $ \h -> do setPinInputMode h InputDefault getPinInputMode h :} InputDefault
>>>
:{
runTutorial $ withPin (Pin 7) $ \h -> do setPinOutputMode h OutputDefault Low getPinOutputMode h :} OutputDefault
It's an error to query a pin's input mode when the pin is configured for output, and vice versa:
>>>
:{
runTutorial $ withPin (Pin 5) $ \h -> do setPinInputMode h InputDefault getPinOutputMode h :} *** Exception: InvalidOperation (Pin 5)
>>>
:{
runTutorial $ withPin (Pin 7) $ \h -> do setPinOutputMode h OutputDefault Low getPinInputMode h :} *** Exception: InvalidOperation (Pin 7)
If we attempt to use a mode that the pin doesn't support, we get an error:
>>>
:{
runTutorial $ withPin (Pin 5) $ \h -> setPinInputMode h InputPullDown :} *** Exception: UnsupportedInputMode InputPullDown (Pin 5)
>>>
:{
runTutorial $ withPin (Pin 5) $ \h -> setPinOutputMode h OutputOpenSourcePullDown Low :} *** Exception: UnsupportedOutputMode OutputOpenSourcePullDown (Pin 5)
Also, it's obviously an error to try to set the direction of a pin whose direction is not settable:
>>>
:{
-- Pin 16's direction is not settable runTutorial $ withPin (Pin 16) $ \h -> setPinInputMode h InputDefault :} *** Exception: NoDirectionAttribute (Pin 16)
The NoDirectionAttribute
exception value refers to the Linux sysfs
GPIO per-pin direction
attribute, which is used to configure the
pin's direction. Exception types in hpio
are platform-specific -- in
this case, specific to Linux sysfs
GPIO, as we're using the mock
sysfs
GPIO interpreter -- and vary based on which particular
interpreter you're using, but all hpio
exception types are instances
of the SomeGpioException
type class.
Finally, some pins, when configured for input, may support edge- or
level-triggered interrupts. As with the pin's direction, you can
discover whether a pin supports this functionality by asking for its
interrupt mode via the getPinInterruptMode
action:
>>>
:{
runTutorial $ withPin (Pin 5) $ \h -> do setPinInputMode h InputDefault getPinInterruptMode h :} Disabled
>>>
runTutorial $ withPin (Pin 16) $ getPinInterruptMode
*** Exception: NoEdgeAttribute (Pin 16)
In our example, Pin
16
does not support interrupts, so
getPinInterruptMode
throws an exception.
If the pin supports interrupts, you can change its interrupt mode
using setPinInterruptMode
. In this example, we configure Pin
5
for level-triggered interrupts. Note that we must configure the pin
for input before we do so:
>>>
:{
runTutorial $ withPin (Pin 5) $ \h -> do setPinInputMode h InputDefault setPinInterruptMode h Level getPinInterruptMode h :} Level
If the pin does not support interrupts, or if the pin is configured for output, it is an error to attempt to set its interrupt mode:
>>>
:{
-- Here we have tried to set an output pin's interrupt mode runTutorial $ withPin (Pin 5) $ \h -> do setPinOutputMode h OutputDefault Low setPinInterruptMode h Level getPinInterruptMode h :} *** Exception: InvalidOperation (Pin 5)
>>>
:{
-- Pin 16 does not support interrupts runTutorial $ withPin (Pin 16) $ \h -> do setPinInterruptMode h Level getPinInterruptMode h :} *** Exception: NoEdgeAttribute (Pin 16)
Note that the exception value thrown in each case is different, to better help you identify what you did wrong.
See below for examples of how to make use of pin interrupts and a pin's interrupt mode.
Reading and writing pins
The core operation of GPIO is, of course, reading and writing pin values.
To read a pin's value and return that value immediately, without
blocking the current thread, use the readPin
action:
>>>
:{
-- Pin 16 is hard-wired for input. -- Its physical signal level is 'High'. runTutorial $ withPin (Pin 16) readPin :} High
>>>
:{
-- Pin 9's initial direction is 'Out'. -- Its initial physical signal level is 'Low'. runTutorial $ withPin (Pin 9) readPin :} Low
Note that we can use readPin
on a pin regardless of its direction or
input / output mode.
The value returned by readPin
is relative to the pin's current
active level. Using the same pins as the previous two examples, but
this time changing their active levels before reading them, we get:
>>>
:{
runTutorial $ withPin (Pin 16) $ \h -> do setPinActiveLevel h ActiveLow readPin h :} Low
>>>
:{
runTutorial $ withPin (Pin 9) $ \h -> do setPinActiveLevel h ActiveLow readPin h :} High
When a pin is configured for output, we can set its value using
writePin
:
>>>
:{
runTutorial $ withPin (Pin 9) $ \h -> do setPinOutputMode h OutputDefault Low writePin h High readPin h :} High
It is an error to attempt to set the value of a pin that is configured for input:
>>>
:{
runTutorial $ withPin (Pin 9) $ \h -> do setPinInputMode h InputDefault writePin h High readPin h :} *** Exception: PermissionDenied (Pin 9)
We can also toggle an output pin's value using togglePin
, which
returns the new value:
>>>
:{
runTutorial $ withPin (Pin 9) $ \h -> do setPinOutputMode h OutputDefault Low v1 <- togglePin h v2 <- togglePin h return (v1,v2) :} (High,Low)
The value we write on an output pin is relative to its current active
level; e.g., if the output pin's active level is Low
and we write a
High
value, then the physical signal level that the system drives
on that pin is low. In the mock GPIO system there is no physical
signal level, per se, but the mock interpreter does keep track of the
"actual" value:
>>>
:{
runTutorial $ withPin (Pin 9) $ \h -> do setPinActiveLevel h ActiveLow setPinOutputMode h OutputDefault High v1 <- readPin h setPinActiveLevel h ActiveHigh v2 <- readPin h return (v1,v2) :} (High,Low)
>>>
:{
runTutorial $ withPin (Pin 9) $ \h -> do setPinActiveLevel h ActiveLow setPinOutputMode h OutputDefault High v1 <- togglePin h setPinActiveLevel h ActiveHigh v2 <- togglePin h return (v1,v2) :} (Low,Low)
(Note that in a real circuit, the value returned by readPin
or
togglePin
on an output pin may be different than the value your
program last wrote to it, depending on the pin's output mode, what
other elements are attached to the pin, etc. A discussion of these
factors is outside the scope of this tutorial.)
Waiting for interrupts
As described above, readPin
reads a pin's current value and returns
that value immediately. pollPin
and pollPinTimeout
, like
readPin
, also return a given input pin's value. However, unlike
readPin
, these actions do not return the value immediately, but
instead block the current thread until a particular event occurs.
Given a handle to an input pin, pollPin
will block the current
thread on that pin's value until an event corresponding to the the
pin's interrupt mode event occurs, at which point pollPin
unblocks
and returns the value that triggered the event. pollPinTimeout
is
like pollPin
, except that it also takes a timeout argument and
returns the pin's value wrapped in a Just
value. If the timeout
expires before the event occurs, pollPinTimeout
returns Nothing
.
The current implementation of the mock sysfs
GPIO interpreter does
not support interrupts, so we do not provide a runnable example in
this tutorial. However, here is an example from an actual Linux system
which demonstrates the use of pollPinTimeout
(a
similar program
is included in hpio
's source distribution):
-- interrupt.hs import Control.Concurrent (threadDelay) import Control.Concurrent.Async (concurrently) import Control.Monad (forever, void) import Control.Monad.Catch (MonadMask) import Control.Monad.IO.Class (MonadIO, liftIO) import System.GPIO.Linux.Sysfs (runSysfsGpioIO) import System.GPIO.Monad import System.GPIO.Types -- | Given a pin, an interrupt mode, and a timeout (in microseconds), -- configure the pin for input, then repeatedly wait for either the -- given event, or a timeout. pollInput :: (MonadMask m, MonadIO m, MonadGpio h m) => Pin -> PinInterruptMode -> Int -> m () pollInput p mode to = withPin p $ \h -> do setPinInputMode h InputDefault setPinInterruptMode h mode forever $ do result <- pollPinTimeout h to case result of Nothing -> output ("pollInput timed out after " ++ show to ++ " microseconds") Just v -> output ("Input: " ++ show v) -- | Given a pin and a 'delay' (in microseconds), configure the pin for output and -- repeatedly toggle its value, pausing for 'delay' microseconds inbetween -- successive toggles. driveOutput :: (MonadMask m, MonadIO m, MonadGpio h m) => Pin -> Int -> m () driveOutput p delay = withPin p $ \h -> do setPinOutputMode h OutputMode Low forever $ do liftIO $ threadDelay delay v <- togglePin h output ("Output: " ++ show v)
Given these two looping actions, we can launch two threads, one for
each loop, to drive the input pin from the output pin, assuming the
two pins are connected. For example, to wait for the signal's rising
edge using gpio47
for input and gpio48
for output with a 1-second
read timeout and a 1/4-second delay between output value toggles:
-- interrupt.hs main = void $ concurrently (void $ runSysfsGpioIO $ pollInput (Pin 47) RisingEdge 1000000) (runSysfsGpioIO $ driveOutput (Pin 48) 250000)
$ ./interrupt Output: High Input: High Output: Low Output: High Input: High Output: Low Output: High Input: High Output: Low Output: High Input: High ^C $
Note that the Input
lines only appear when the output signal goes
from Low
to High
, as pollInput
is waiting for RisingEdge
events
on the input pin.
If we now flip the read timeout and toggle delay values, we can see
that pollInput
times out every 1/4-second until the rising edge
occurs again:
-- interrupt.hs main = void $ concurrently (void $ runSysfsGpioIO $ pollInput (Pin 47) RisingEdge 250000) (runSysfsGpioIO $ driveOutput (Pin 48) 1000000)
$ ./interrupt pollInput timed out after 250000 microseconds pollInput timed out after 250000 microseconds pollInput timed out after 250000 microseconds Output: High Input: High pollInput timed out after 250000 microseconds pollInput timed out after 250000 microseconds pollInput timed out after 250000 microseconds Output: Low pollInput timed out after 250000 microseconds pollInput timed out after 250000 microseconds pollInput timed out after 250000 microseconds pollInput timed out after 250000 microseconds Output: High Input: High pollInput timed out after 250000 microseconds pollInput timed out after 250000 microseconds pollInput timed out after 250000 microseconds Output: Low pollInput timed out after 250000 microseconds pollInput timed out after 250000 microseconds pollInput timed out after 250000 microseconds pollInput timed out after 250000 microseconds Output: High Input: High pollInput timed out after 250000 microseconds ^C $
Because they block the current thread, in order to use pollPin
and
pollPinTimeout
, you must compile your program such that the Haskell
runtime supports multiple threads. On GHC, use the -threaded
compile-time flag. Other Haskell compilers have not been tested with
hpio
, so we cannot provide guidance for them; consult your
compiler's documentation. Also, if you're using a compiler other than
GHC on Linux, see the documentation for the
SysfsIOT
monad transformer for details on
how it uses the C FFI, and its implications for multi-threading.
Better type-safety
You may have noticed that, while describing the various DSL actions above, we spent almost as much time talking about error conditions as we did properly-functioning code. Primarily, this is due to the low-level nature of native GPIO APIs.
Native GPIO APIs, as a rule, provide more or less the same interface for all GPIO pins, regardless of their actual capabilities or configuration. For example, a pin configured for input is typically represented by the system as the same type as a pin configured for output, even though the set of actions that can legally be performed on each pin is different.
One advantage of this approach is that it is quite flexible. It is, for example, possible to re-configure a given pin "on the fly" for input, output, interrupts, etc. However, a drawback of this approach is that it's easy to make a mistake, e.g., by waiting for interrupts on a pin that has been configured for output (an operation which, on Linux, at least, will not raise an error but will block forever).
The primary goal of the hpio
cross-platform DSL is to make available
to the Haskell programmer as much of the low-level capabilities of a
typical GPIO platform as possible. As such, it retains both the
flexibility of this one-pin-fits-all approach, and its disadvantages.
The disadvantages are apparent by the number of ways you can cause an
exception by performing an invalid operation on a pin.
By trading some of that flexibility for more restricted types, we can
make GPIO programming safer. The hpio
cross-platform DSL therefore
provides 3 additional types for representing pins in a particular
configuration state (input, interrupt-capable input, or output), and
then defines the subset of GPIO actions that can safely be performed
on a pin in that state. This makes it possible to write GPIO programs
which, given a particular pin type, cannot perform an illegal
action on that pin.
The 3 safer pin types are InputPin
, OutputPin
, and InterruptPin
.
The constructors for these types are not exported. You can only create
instances of these types by calling their corresponding with*
action. Each type's with*
action attempts to configure the pin as
requested; if it cannot, the with*
action throws an exception, but
if it can, you can use the returned instance safely.
(Note: all of these safer pin types support actions which query or
change their active level, but as these actions are effectively
identical to the more general getPinActiveLevel
and
setPinActiveLevel
actions, examples of their use are not given here.)
A handle to a pin that's been configured for non-blocking reads only.
You cannot poll an InputPin
for interrupts. See InterruptPin
.
withInputPin :: MaskGpioM h m => Pin -> PinInputMode -> Maybe PinActiveLevel -> (InputPin h -> m a) -> m a Source #
Like withPin
, but for InputPin
s. Sets the pin's input mode to
the specified PinInputMode
value.
If the optional active level argument is Nothing
, then the pin's
active level is unchanged from its current state. Otherwise, the
pin's active level is set to the specified level.
It is an error to call this action if the pin cannot be configured for input, or if it does not support the specified input mode.
Input pins
Input pins can be read with a non-blocking read via the readInputPin
action:
>>>
:{
runTutorial $ withInputPin (Pin 2) InputDefault Nothing $ \h -> readInputPin h :} Low
data InterruptPin h Source #
A handle to a pin that's been configured both for non-blocking reads and for interrupt-driven polling reads.
Eq h => Eq (InterruptPin h) Source # | |
Show h => Show (InterruptPin h) Source # | |
withInterruptPin :: MaskGpioM h m => Pin -> PinInputMode -> PinInterruptMode -> Maybe PinActiveLevel -> (InterruptPin h -> m a) -> m a Source #
Like withPin
, but for InterruptPin
s. The pin is opened for
input, is input mode is set to the specified PinInputMode
value,
and its interrupt mode is set to the specified PinInterruptMode
value.
If the optional active level argument is Nothing
, then the pin's
active level is unchanged from its current state. Otherwise, the
pin's active level is set to the specified level.
It is an error to call this action if any of the following are true:
- The pin cannot be configured for input.
- The pin does not support the specified input mode.
- The pin does not support interrupts.
Interrupt pins
Interrupt pins can be read with a non-blocking read via the
readInterruptPin
action:
>>>
:{
runTutorial $ withInterruptPin (Pin 2) InputDefault Level Nothing $ \h -> readInterruptPin h :} Low
They also, of course, support interrupts (blocking reads). Because the
mock interpreter cannot emulate interrupts, no working examples are
given here, but see the pollInterruptPin
and
pollInterruptPinTimeout
actions for details.
Changing an interrupt pin's interrupt mode is generally a safe
operation, so the DSL provides the getInterruptPinInterruptMode
and
setInterruptPinInterruptMode
actions:
>>>
:{
runTutorial $ withInterruptPin (Pin 2) InputDefault RisingEdge Nothing $ \h -> do m1 <- getInterruptPinInterruptMode h setInterruptPinInterruptMode h FallingEdge m2 <- getInterruptPinInterruptMode h return (m1,m2) :} (RisingEdge,FallingEdge)
A handle to a pin that's been configured for output only.
Note that output pins can be both read and written. However, they only support non-blocking reads, not interrupt-driven polling reads.
withOutputPin :: MaskGpioM h m => Pin -> PinOutputMode -> Maybe PinActiveLevel -> PinValue -> (OutputPin h -> m a) -> m a Source #
Like withPin
, but for OutputPin
s. Sets the pin's output mode
to the specified PinOutputMode
value.
The PinValue
argument specifies the pin's initial output value.
It is relative to the active level argument, or to the pin's
current active level if the active level argument is Nothing
.
It is an error to call this action if the pin cannot be configured for output, or if it does not support the specified output mode.
Output pins
Output pins can be both read (readOutputPin
) and written
(writeOutputPin
):
>>>
:{
runTutorial $ withOutputPin (Pin 8) OutputDefault Nothing Low $ \h -> do v1 <- readOutputPin h writeOutputPin h High v2 <- readOutputPin h return (v1,v2) :} (Low,High)
The pin's value can also be toggled via toggleOutputPin
:
>>>
:{
runTutorial $ withOutputPin (Pin 8) OutputDefault Nothing Low $ \h -> toggleOutputPin h :} High
Advanced topics
The Linux sysfs
GPIO interpreter
Using the Linux sysfs
GPIO interpreter is complicated by the fact
that it supports both actual Linux systems, and the mock environment
that we've used throughout most of this tutorial.
Strictly speaking, you don't need to understand how the sysfs
GPIO
interpreter implemented, but understanding it does help motivate why
using it seems a bit convoluted.
In Linux sysfs
GPIO, userspace GPIO operations are performed on
virtual files in the sysfs
filesystem. See the
Linux kernel documentation
for details, but in a nutshell:
- Pins are exported (akin to opening a file) by writing their pin
number to the
/sys/class/gpio/export
file. - Once a pin is exported, the Linux kernel creates a subdirectory for
that pin number (e.g.,
/sys/class/gpio/gpio7
), along with several pseudo-files, called attributes, for controlling the pin's direction, reading and writing its pin value, etc. - Pins are unexported (akin to closing a file) by writing their pin
number to the
/sys/class/gpio/unexport
file. When the pin is unexported, the kernel removes the pin'ssysfs
subdirectory.
The hpio
interpreter for the Linux sysfs
GPIO system translates
actions in the cross-platform DSL to sysfs
filesystem operations.
The most straightforward way to implement this interpreter is to use
filesystem actions such as readFile
and writeFile
directly.
However, by adding a level of abstraction at the filesystem layer, we
can substitute a sysfs
filesystem emulator for the real thing, and
the interpreter's none the wiser. Because we're only implementing the
subset of filesystem functionality required by the Linux sysfs
GPIO
interpreter (and certainly not an entire real filesystem!), there are
only a handful of actions we need to emulate.
So that is the approach used by hpio
's sysfs
interprefer. It
breaks the Linux sysfs
GPIO interpreter into two pieces: a
high-level piece which maps cross-platform GPIO operations to abstract
filesystem actions, and a low-level piece which implements those
filesystem actions. It then provides two low-level implementations:
one which maps the abstract filesystem actions onto real filesystem
operations, and one which implements a subset of the sysfs
filesystem as an in-memory mock filesystem for emulating the Linux
kernel's sysfs
GPIO behavior.
To use this implementation, you don't need to worry about these
details; you just need to know how to compose the two interpreters. If
you want to run real GPIO programs on a real Linux GPIO-capable
system, the composition is relatively straightforward. Assuming that
program
is your program:
runSysfsIOT $ runSysfsGpioT program
Here the runSysfsGpioT
interpreter
translates GPIO actions in program
to abstract sysfs
filesystem
operations, and the runSysfsIOT
interpreter
translates abstract sysfs
filesystem operations to their native
filesystem equivalents.
(Note that if program
runs directly in IO
and not in a transformer
stack, then you can use the runSysfsGpioIO
action, which conveniently composes these two interpreters for you.)
mtl
compatibility and use with transformer stacks
Most of the examples shown up to this point in the tutorial have run
directly on top of the IO
monad (via MonadIO
). However, in the
event that you want to integrate GPIO computations into more
complicated monad transformer stacks, hpio
has you covered!
Each hpio
interpreter is implemented as a monad transformer, and
each is also an instance of the monad type classes defined in the
mtl package, so long as its
implementation satisfies the laws of that particular mtl
type class.
This makes it easy to integrate hpio
interpreters into mtl
-style
monad transformer stacks.
Additionally, the MonadGpio
type class provides instances of itself
for all the mtl
monad type classes for which it can satisfy the
laws, meaning that you don't need to lift
MonadGpio
operations out
of these monads manually.
Here's an example of using a MonadGpio
program with the reader
monad and the mock sysfs
GPIO interpreter. (A
more sophisticated example
of using MonadGpio
with a reader transformer
stack and a real (as opposed to mock) GPIO platform is provided in the
hpio
source distribution.)
First, let's define the reader environment and give our transformer stack a type alias:
data TutorialEnv = TutorialEnv {_pin :: Pin ,_initialValue :: PinValue ,_delay :: Int ,_iterations :: Int} -- | Our transformer stack: -- * A reader monad. -- * The Linux @sysfs@ GPIO interpreter -- * The (mock) Linux @sysfs@ back-end. -- * 'IO' type TutorialReaderGpioIO a = ReaderT TutorialEnv (SysfsGpioT (SysfsMockT IO)) a
Next, let's define the interpreter for our stack. Up to this point,
we've used runTutorial
as our interpreter, and it has handled all
the nitty-gritty details of composing the sysfs
GPIO
sub-interpreters and configuring the mock GPIO environment. Now,
however, it's time to expose those layers and talk about them in
detail, as that's where most of the complexity comes when using
transformer stacks.
-- | Mock GPIO chips chip0 :: MockGpioChip chip0 = MockGpioChip "chip0" 0 (replicate 16 defaultMockPinState) chip1 :: MockGpioChip chip1 = MockGpioChip "chip1" 16 [defaultMockPinState {_direction = In, _userVisibleDirection = False, _value = High, _edge = Nothing}] -- | The interpreter for our transformer stack. runTutorialReaderGpioIO :: TutorialReaderGpioIO a -> TutorialEnv -> IO a runTutorialReaderGpioIO program config = evalSysfsMockT (runSysfsGpioT $ runReaderT program config) initialMockWorld [chip0, chip1]
Don't worry too much about the MockGpioChip
definitions or the
initialMockWorld
; those exist only to set up the mock GPIO
environment so that we can run some examples in this tutorial. In a
real Linux GPIO environment, the definition for the interpreter would
be quite a bit simpler, as we wouldn't need to supply this mock
environment. An analogous transformer stack for a real Linux sysfs
GPIO system would look something like this:
-- | Our 'IO' transformer stack: -- * A reader monad. -- * The Linux @sysfs@ GPIO interpreter -- * The (real) Linux @sysfs@ back-end. -- * 'IO' type TutorialReaderGpioIO a = ReaderT TutorialEnv (SysfsGpioT (SysfsIOT IO)) a -- | The interpreter for our IO transformer stack. runTutorialReaderGpioIO :: TutorialReaderGpioIO a -> Config -> IO a runTutorialReaderGpioIO program config = runSysfsIOT $ runSysfsGpioT $ runReaderT program config
(The earlier cited example program uses this very stack, albeit with a different reader environment.)
The part that's the same in both the mock transformer stack and the "real" transformer stack is this bit:
runSysfsGpioT $ runReaderT program config
Here we see 2 layers of the transformer stack: at the core is the
ReaderT
transformer, which we execute via the runReaderT
"interpreter." This layer provides us with the ability to use reader
monad actions such as asks
inside our program
.
The next layer up is the SysfsGpioT
transformer, which we execute
via the runSysfsGpioT
interpreter. This layer makes the hpio
cross-platform DSL actions available to our program
-- actions such
as readPin
and writePin
.
However, as explained earlier in the tutorial, the SysfsGpioT
transformer is only one half of the sysfs
GPIO story. The
runSysfsGpioT
interpreter translates GPIO actions such as readPin
to Linux sysfs
GPIO operations, but it does not provide the
implementation of those sysfs
GPIO operations: it depends on yet
another layer of the transformer stack to provide that functionality.
This is where SysfsMockT
and evalSysfsMockT
come in (or, in the
case of a "real" GPIO program that runs on an actual Linux system,
SyfsIOT
and
runSysfsIOT
). The SysfsMockT
transformer
maps sysfs
GPIO operations in the runSysfsGpioT
interpreter onto
mock sysfs
filesystem actions; and the evalSysfsMockT
interpreter
provides the in-memory implementation of those mock sysfs
filesystem
actions.
Likewise, as you can probably guess from the definition of our "real"
GPIO transformer stack, the SyfsIOT
transformer and its runSysfsIOT
interpreter
map abstract sysfs
GPIO operations in the runSysfsGpioT
interpreter onto actual sysfs
filesystem actions using Haskell's
standard filesystem actions (readFile
, writeFile
, etc.)
(If you're curious about the interface between the two sysfs
interpreter layers, see the MonadSysfs
type class. You can even use it directly, if you want to implement
your own sysfs
-specific GPIO DSL.)
Returning to our mock transformer stack, the SysfsMockT
transformer
is just a newtype
wrapper around the
StateT
transformer. The state that the
SysfsMockT
transformer provides to its interpreter is the state of
all mock pins defined by the mock GPIO system, and the state of the
in-memory mock filesystem (the directory structure, the contents of
the various files, etc.).
For testing purposes, it's often useful to retrieve the final mock
state along with the final result of a mock hpio
computation, so
just as StateT
does, the SysfsMockT
transformer provides three different interpreters. Which interpreter
you choose depends on whether you want the final mock state of the
computation, the final result of the computation, or a tuple
containing the pair of them. For our purposes in this tutorial, we
only want the final result of the computation, so we use the
evalSysfsMockT
interpreter here.
The mock state of the mock sysfs
interpreter is completely
configurable. We won't go into the details in this tutorial, but in a
nutshell, you provide the mock interpreter a list of mock pins along
with their initial state; and the initial state of the mock sysfs
GPIO filesystem. The [chip0, chip1]
and initialMockWorld
values
passed to the evalSysfsMockT
interpreter provide the initial state
that we'll use in our transformer stack examples. (These parameters
are not needed for the "real" sysfs
interpreter, of course, since
the actual hardware and the Linux kernel determine the visible GPIO
state on a real system.)
By composing the runSysfsGpioT
and evalSysfsMockT
interpreters
(or, in the case of a real Linux system, the runSysfsGpioT
and
runSysfsIOT
interpreters), we create a
complete hpio
cross-platform DSL interpreter.
The final, outer-most layer of our transformer stack is IO
. You may
be wondering why, as we're using the mock sysfs
interpreter here
(which does not perform any IO
actions), we need the IO
monad. As
it turns out, we do not! Both the SysfsMockT
transformer and the
SysfsGpioT
transformer are pure, and neither requires the IO
monad
in order to function.
They do, however, need to be stacked on top of a monad which is an
instance of MonadThrow
. Additionally, SysfsGpioT
requires its
inner monad to be an instance of MonadCatch
. GPIO computations --
even mock ones -- can throw exceptions, and we need a way to express
them "out of band." hpio
uses the excellent
exceptions package,
which provides the MonadThrow
and MonadCatch
abstractions and
makes it possible for the mock sysfs
GPIO interpreter to run in a
pure environment, without IO
, so long as the inner monad is an
instance of both MonadThrow
and MonadCatch
.
In fact, the exceptions
package provides the
Catch
monad, which satisfies both of those
constraints, and hpio
's mock sysfs
implementation provides a
convenient type alias for an interpreter which runs hpio
computations in a pure mock GPIO environment, using
Catch
as the outer-most monad, rather than
IO
. That interpreter expresses GPIO errors as Left
values instead
of throwing exceptions. See SysfsGpioMock
and its interpreters for
details.
However, in this tutorial, we're only using the mock sysfs
GPIO
interpreter out of necessity, and we prefer to keep the examples as
close to "real world" behavior as we can. Therefore, we use IO
here
and express errors in GPIO computations as actual thrown exceptions,
rather than pure Left
values.
A reader monad example
Now that we've defined (and explained to death) an example transformer stack, let's put it to use. We define the following trivial program, which runs in our transformer stack and makes use of the reader monad context to retrieve its configuration:
>>>
:{
let toggleOutput :: (MonadMask m, MonadIO m, MonadGpio h m, MonadReader TutorialEnv m) => m () toggleOutput = do p <- asks _pin delay <- asks _delay iv <- asks _initialValue it <- asks _iterations withPin p $ \h -> do setPinOutputMode h OutputDefault iv forM_ [1..it] $ const $ do liftIO $ threadDelay delay v <- togglePin h liftIO $ putStrLn ("Output: " ++ show v) :}
>>>
runTutorialReaderGpioIO toggleOutput (TutorialEnv (Pin 4) High 100000 5)
Output: Low Output: High Output: Low Output: High Output: Low
>>>
runTutorialReaderGpioIO toggleOutput (TutorialEnv (Pin 16) High 100000 5)
*** Exception: NoDirectionAttribute (Pin 16)
>>>
runTutorialReaderGpioIO toggleOutput (TutorialEnv (Pin 99) High 100000 5)
*** Exception: InvalidPin (Pin 99)
More important than what this program does, is its type signature. It
runs in a monad m
and returns a void result, but note the following
about monad m
:
- It must be an instance of
MonadMask
because it callswithPin
. - It must be an instance of
MonadIO
because it callsputStrLn
andthreadDelay
. - It must be an instance of
MonadReader
TutorialEnv
because it usesasks
to extract its configuration from aTutorialEnv
. - It must be an instance of
MonadGpio
because it uses actions from thehpio
cross-platform DSL. (By the way, theh
type parameter toMonadGpio
represents an implementation-dependent pin handle type.)
Our mock transformer stack satisfies all of these requirements, so
it's capable of running this program. The "real GPIO" transformer
stack we defined earlier is also capable of running this program, and
as future GPIO platforms are added to hpio
, any of those
interpreters will be able to run this program, as well!
data TutorialEnv Source #
type TutorialReaderGpioIO a = ReaderT TutorialEnv (SysfsGpioT (SysfsMockT IO)) a Source #
Copyright
This tutorial is copyright Quixoftic, LLC, 2017, and is licensed under the Creative Commons Attribution 4.0 International License.