hpio-0.9.0.7: Monads for GPIO in Haskell

Copyright(c) 2018 Drew Hess
LicenseBSD3
MaintainerDrew Hess <src@drewhess.com>
Stabilityexperimental
Portabilitynon-portable
Safe HaskellSafe
LanguageHaskell2010

System.GPIO.Monad

Contents

Description

A monadic context for GPIO computations.

Synopsis

GPIO types

For your convenience, the following types are re-exported from the System.GPIO.Types module.

newtype Pin Source #

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.

Constructors

Pin Int 
Instances
Bounded Pin Source # 
Instance details

Defined in System.GPIO.Types

Methods

minBound :: Pin #

maxBound :: Pin #

Enum Pin Source # 
Instance details

Defined in System.GPIO.Types

Methods

succ :: Pin -> Pin #

pred :: Pin -> Pin #

toEnum :: Int -> Pin #

fromEnum :: Pin -> Int #

enumFrom :: Pin -> [Pin] #

enumFromThen :: Pin -> Pin -> [Pin] #

enumFromTo :: Pin -> Pin -> [Pin] #

enumFromThenTo :: Pin -> Pin -> Pin -> [Pin] #

Eq Pin Source # 
Instance details

Defined in System.GPIO.Types

Methods

(==) :: Pin -> Pin -> Bool #

(/=) :: Pin -> Pin -> Bool #

Data Pin Source # 
Instance details

Defined in System.GPIO.Types

Methods

gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> Pin -> c Pin #

gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c Pin #

toConstr :: Pin -> Constr #

dataTypeOf :: Pin -> DataType #

dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c Pin) #

dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Pin) #

gmapT :: (forall b. Data b => b -> b) -> Pin -> Pin #

gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Pin -> r #

gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Pin -> r #

gmapQ :: (forall d. Data d => d -> u) -> Pin -> [u] #

gmapQi :: Int -> (forall d. Data d => d -> u) -> Pin -> u #

gmapM :: Monad m => (forall d. Data d => d -> m d) -> Pin -> m Pin #

gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> Pin -> m Pin #

gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> Pin -> m Pin #

Ord Pin Source # 
Instance details

Defined in System.GPIO.Types

Methods

compare :: Pin -> Pin -> Ordering #

(<) :: Pin -> Pin -> Bool #

(<=) :: Pin -> Pin -> Bool #

(>) :: Pin -> Pin -> Bool #

(>=) :: Pin -> Pin -> Bool #

max :: Pin -> Pin -> Pin #

min :: Pin -> Pin -> Pin #

Read Pin Source # 
Instance details

Defined in System.GPIO.Types

Show Pin Source # 
Instance details

Defined in System.GPIO.Types

Methods

showsPrec :: Int -> Pin -> ShowS #

show :: Pin -> String #

showList :: [Pin] -> ShowS #

Ix Pin Source # 
Instance details

Defined in System.GPIO.Types

Methods

range :: (Pin, Pin) -> [Pin] #

index :: (Pin, Pin) -> Pin -> Int #

unsafeIndex :: (Pin, Pin) -> Pin -> Int

inRange :: (Pin, Pin) -> Pin -> Bool #

rangeSize :: (Pin, Pin) -> Int #

unsafeRangeSize :: (Pin, Pin) -> Int

Generic Pin Source # 
Instance details

Defined in System.GPIO.Types

Associated Types

type Rep Pin :: * -> * #

Methods

from :: Pin -> Rep Pin x #

to :: Rep Pin x -> Pin #

Arbitrary Pin Source # 
Instance details

Defined in System.GPIO.Types

Methods

arbitrary :: Gen Pin #

shrink :: Pin -> [Pin] #

type Rep Pin Source # 
Instance details

Defined in System.GPIO.Types

type Rep Pin = D1 (MetaData "Pin" "System.GPIO.Types" "hpio-0.9.0.7-6wTVDAAhQWjGywt4QfvtzA" True) (C1 (MetaCons "Pin" PrefixI False) (S1 (MetaSel (Nothing :: Maybe Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 Int)))

pinNumber :: Pin -> Int Source #

Get the pin number as an Int.

>>> pinNumber (Pin 5)
5

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.

Constructors

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 High

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 Low

Instances
Bounded PinInputMode Source # 
Instance details

Defined in System.GPIO.Types

Enum PinInputMode Source # 
Instance details

Defined in System.GPIO.Types

Eq PinInputMode Source # 
Instance details

Defined in System.GPIO.Types

Data PinInputMode Source # 
Instance details

Defined in System.GPIO.Types

Methods

gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> PinInputMode -> c PinInputMode #

gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c PinInputMode #

toConstr :: PinInputMode -> Constr #

dataTypeOf :: PinInputMode -> DataType #

dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c PinInputMode) #

dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c PinInputMode) #

gmapT :: (forall b. Data b => b -> b) -> PinInputMode -> PinInputMode #

gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> PinInputMode -> r #

gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> PinInputMode -> r #

gmapQ :: (forall d. Data d => d -> u) -> PinInputMode -> [u] #

gmapQi :: Int -> (forall d. Data d => d -> u) -> PinInputMode -> u #

gmapM :: Monad m => (forall d. Data d => d -> m d) -> PinInputMode -> m PinInputMode #

gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> PinInputMode -> m PinInputMode #

gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> PinInputMode -> m PinInputMode #

Ord PinInputMode Source # 
Instance details

Defined in System.GPIO.Types

Read PinInputMode Source # 
Instance details

Defined in System.GPIO.Types

Show PinInputMode Source # 
Instance details

Defined in System.GPIO.Types

Generic PinInputMode Source # 
Instance details

Defined in System.GPIO.Types

Associated Types

type Rep PinInputMode :: * -> * #

type Rep PinInputMode Source # 
Instance details

Defined in System.GPIO.Types

type Rep PinInputMode = D1 (MetaData "PinInputMode" "System.GPIO.Types" "hpio-0.9.0.7-6wTVDAAhQWjGywt4QfvtzA" False) ((C1 (MetaCons "InputDefault" PrefixI False) (U1 :: * -> *) :+: C1 (MetaCons "InputFloating" PrefixI False) (U1 :: * -> *)) :+: (C1 (MetaCons "InputPullUp" PrefixI False) (U1 :: * -> *) :+: C1 (MetaCons "InputPullDown" PrefixI False) (U1 :: * -> *)))

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.

Constructors

OutputDefault

The pin's default output mode, i.e., the mode used when a more specific mode is not specified

OutputPushPull

The output actively drives both the High and Low states

OutputOpenDrain

The output actively drives the Low state, but High is left floating (also known as open collector)

OutputOpenDrainPullUp

The output actively drives the Low state, and is connected to an internal pull-up resistor in the High state.

OutputOpenSource

The output actively drives the High state, but Low is left floating (also known as open emitter)

OutputOpenSourcePullDown

The output actively drives the High state, and is connected to an internal pull-down resistor in the Low state.

Instances
Bounded PinOutputMode Source # 
Instance details

Defined in System.GPIO.Types

Enum PinOutputMode Source # 
Instance details

Defined in System.GPIO.Types

Eq PinOutputMode Source # 
Instance details

Defined in System.GPIO.Types

Data PinOutputMode Source # 
Instance details

Defined in System.GPIO.Types

Methods

gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> PinOutputMode -> c PinOutputMode #

gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c PinOutputMode #

toConstr :: PinOutputMode -> Constr #

dataTypeOf :: PinOutputMode -> DataType #

dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c PinOutputMode) #

dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c PinOutputMode) #

gmapT :: (forall b. Data b => b -> b) -> PinOutputMode -> PinOutputMode #

gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> PinOutputMode -> r #

gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> PinOutputMode -> r #

gmapQ :: (forall d. Data d => d -> u) -> PinOutputMode -> [u] #

gmapQi :: Int -> (forall d. Data d => d -> u) -> PinOutputMode -> u #

gmapM :: Monad m => (forall d. Data d => d -> m d) -> PinOutputMode -> m PinOutputMode #

gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> PinOutputMode -> m PinOutputMode #

gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> PinOutputMode -> m PinOutputMode #

Ord PinOutputMode Source # 
Instance details

Defined in System.GPIO.Types

Read PinOutputMode Source # 
Instance details

Defined in System.GPIO.Types

Show PinOutputMode Source # 
Instance details

Defined in System.GPIO.Types

Generic PinOutputMode Source # 
Instance details

Defined in System.GPIO.Types

Associated Types

type Rep PinOutputMode :: * -> * #

type Rep PinOutputMode Source # 
Instance details

Defined in System.GPIO.Types

type Rep PinOutputMode = D1 (MetaData "PinOutputMode" "System.GPIO.Types" "hpio-0.9.0.7-6wTVDAAhQWjGywt4QfvtzA" False) ((C1 (MetaCons "OutputDefault" PrefixI False) (U1 :: * -> *) :+: (C1 (MetaCons "OutputPushPull" PrefixI False) (U1 :: * -> *) :+: C1 (MetaCons "OutputOpenDrain" PrefixI False) (U1 :: * -> *))) :+: (C1 (MetaCons "OutputOpenDrainPullUp" PrefixI False) (U1 :: * -> *) :+: (C1 (MetaCons "OutputOpenSource" PrefixI False) (U1 :: * -> *) :+: C1 (MetaCons "OutputOpenSourcePullDown" PrefixI False) (U1 :: * -> *))))

data PinCapabilities Source #

Catalog a pin's capabilities.

Constructors

PinCapabilities 

Fields

Instances
Eq PinCapabilities Source # 
Instance details

Defined in System.GPIO.Types

Show PinCapabilities Source # 
Instance details

Defined in System.GPIO.Types

Generic PinCapabilities Source # 
Instance details

Defined in System.GPIO.Types

Associated Types

type Rep PinCapabilities :: * -> * #

type Rep PinCapabilities Source # 
Instance details

Defined in System.GPIO.Types

type Rep PinCapabilities = D1 (MetaData "PinCapabilities" "System.GPIO.Types" "hpio-0.9.0.7-6wTVDAAhQWjGywt4QfvtzA" False) (C1 (MetaCons "PinCapabilities" PrefixI True) (S1 (MetaSel (Just "_inputModes") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 (Set PinInputMode)) :*: (S1 (MetaSel (Just "_outputModes") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 (Set PinOutputMode)) :*: S1 (MetaSel (Just "_interrupts") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 Bool))))

data PinDirection Source #

A pin's direction (input/output).

Constructors

In 
Out 
Instances
Bounded PinDirection Source # 
Instance details

Defined in System.GPIO.Types

Enum PinDirection Source # 
Instance details

Defined in System.GPIO.Types

Eq PinDirection Source # 
Instance details

Defined in System.GPIO.Types

Data PinDirection Source # 
Instance details

Defined in System.GPIO.Types

Methods

gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> PinDirection -> c PinDirection #

gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c PinDirection #

toConstr :: PinDirection -> Constr #

dataTypeOf :: PinDirection -> DataType #

dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c PinDirection) #

dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c PinDirection) #

gmapT :: (forall b. Data b => b -> b) -> PinDirection -> PinDirection #

gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> PinDirection -> r #

gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> PinDirection -> r #

gmapQ :: (forall d. Data d => d -> u) -> PinDirection -> [u] #

gmapQi :: Int -> (forall d. Data d => d -> u) -> PinDirection -> u #

gmapM :: Monad m => (forall d. Data d => d -> m d) -> PinDirection -> m PinDirection #

gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> PinDirection -> m PinDirection #

gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> PinDirection -> m PinDirection #

Ord PinDirection Source # 
Instance details

Defined in System.GPIO.Types

Read PinDirection Source # 
Instance details

Defined in System.GPIO.Types

Show PinDirection Source # 
Instance details

Defined in System.GPIO.Types

Ix PinDirection Source # 
Instance details

Defined in System.GPIO.Types

Generic PinDirection Source # 
Instance details

Defined in System.GPIO.Types

Associated Types

type Rep PinDirection :: * -> * #

Arbitrary PinDirection Source # 
Instance details

Defined in System.GPIO.Types

type Rep PinDirection Source # 
Instance details

Defined in System.GPIO.Types

type Rep PinDirection = D1 (MetaData "PinDirection" "System.GPIO.Types" "hpio-0.9.0.7-6wTVDAAhQWjGywt4QfvtzA" False) (C1 (MetaCons "In" PrefixI False) (U1 :: * -> *) :+: C1 (MetaCons "Out" PrefixI False) (U1 :: * -> *))

data PinActiveLevel Source #

A pin's active level (active-high/active-low).

Constructors

ActiveLow 
ActiveHigh 
Instances
Bounded PinActiveLevel Source # 
Instance details

Defined in System.GPIO.Types

Enum PinActiveLevel Source # 
Instance details

Defined in System.GPIO.Types

Eq PinActiveLevel Source # 
Instance details

Defined in System.GPIO.Types

Data PinActiveLevel Source # 
Instance details

Defined in System.GPIO.Types

Methods

gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> PinActiveLevel -> c PinActiveLevel #

gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c PinActiveLevel #

toConstr :: PinActiveLevel -> Constr #

dataTypeOf :: PinActiveLevel -> DataType #

dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c PinActiveLevel) #

dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c PinActiveLevel) #

gmapT :: (forall b. Data b => b -> b) -> PinActiveLevel -> PinActiveLevel #

gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> PinActiveLevel -> r #

gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> PinActiveLevel -> r #

gmapQ :: (forall d. Data d => d -> u) -> PinActiveLevel -> [u] #

gmapQi :: Int -> (forall d. Data d => d -> u) -> PinActiveLevel -> u #

gmapM :: Monad m => (forall d. Data d => d -> m d) -> PinActiveLevel -> m PinActiveLevel #

gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> PinActiveLevel -> m PinActiveLevel #

gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> PinActiveLevel -> m PinActiveLevel #

Ord PinActiveLevel Source # 
Instance details

Defined in System.GPIO.Types

Read PinActiveLevel Source # 
Instance details

Defined in System.GPIO.Types

Show PinActiveLevel Source # 
Instance details

Defined in System.GPIO.Types

Ix PinActiveLevel Source # 
Instance details

Defined in System.GPIO.Types

Generic PinActiveLevel Source # 
Instance details

Defined in System.GPIO.Types

Associated Types

type Rep PinActiveLevel :: * -> * #

Arbitrary PinActiveLevel Source # 
Instance details

Defined in System.GPIO.Types

type Rep PinActiveLevel Source # 
Instance details

Defined in System.GPIO.Types

type Rep PinActiveLevel = D1 (MetaData "PinActiveLevel" "System.GPIO.Types" "hpio-0.9.0.7-6wTVDAAhQWjGywt4QfvtzA" False) (C1 (MetaCons "ActiveLow" PrefixI False) (U1 :: * -> *) :+: C1 (MetaCons "ActiveHigh" PrefixI False) (U1 :: * -> *))

data PinValue Source #

A pin's signal level as a binary value.

Constructors

Low 
High 
Instances
Bounded PinValue Source # 
Instance details

Defined in System.GPIO.Types

Enum PinValue Source # 
Instance details

Defined in System.GPIO.Types

Eq PinValue Source # 
Instance details

Defined in System.GPIO.Types

Data PinValue Source # 
Instance details

Defined in System.GPIO.Types

Methods

gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> PinValue -> c PinValue #

gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c PinValue #

toConstr :: PinValue -> Constr #

dataTypeOf :: PinValue -> DataType #

dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c PinValue) #

dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c PinValue) #

gmapT :: (forall b. Data b => b -> b) -> PinValue -> PinValue #

gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> PinValue -> r #

gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> PinValue -> r #

gmapQ :: (forall d. Data d => d -> u) -> PinValue -> [u] #

gmapQi :: Int -> (forall d. Data d => d -> u) -> PinValue -> u #

gmapM :: Monad m => (forall d. Data d => d -> m d) -> PinValue -> m PinValue #

gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> PinValue -> m PinValue #

gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> PinValue -> m PinValue #

Ord PinValue Source # 
Instance details

Defined in System.GPIO.Types

Read PinValue Source # 
Instance details

Defined in System.GPIO.Types

Show PinValue Source # 
Instance details

Defined in System.GPIO.Types

Ix PinValue Source # 
Instance details

Defined in System.GPIO.Types

Generic PinValue Source # 
Instance details

Defined in System.GPIO.Types

Associated Types

type Rep PinValue :: * -> * #

Methods

from :: PinValue -> Rep PinValue x #

to :: Rep PinValue x -> PinValue #

Arbitrary PinValue Source # 
Instance details

Defined in System.GPIO.Types

Bits PinValue Source # 
Instance details

Defined in System.GPIO.Types

FiniteBits PinValue Source # 
Instance details

Defined in System.GPIO.Types

type Rep PinValue Source # 
Instance details

Defined in System.GPIO.Types

type Rep PinValue = D1 (MetaData "PinValue" "System.GPIO.Types" "hpio-0.9.0.7-6wTVDAAhQWjGywt4QfvtzA" False) (C1 (MetaCons "Low" PrefixI False) (U1 :: * -> *) :+: C1 (MetaCons "High" PrefixI False) (U1 :: * -> *))

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.

Constructors

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

Instances
Bounded PinInterruptMode Source # 
Instance details

Defined in System.GPIO.Types

Enum PinInterruptMode Source # 
Instance details

Defined in System.GPIO.Types

Eq PinInterruptMode Source # 
Instance details

Defined in System.GPIO.Types

Data PinInterruptMode Source # 
Instance details

Defined in System.GPIO.Types

Methods

gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> PinInterruptMode -> c PinInterruptMode #

gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c PinInterruptMode #

toConstr :: PinInterruptMode -> Constr #

dataTypeOf :: PinInterruptMode -> DataType #

dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c PinInterruptMode) #

dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c PinInterruptMode) #

gmapT :: (forall b. Data b => b -> b) -> PinInterruptMode -> PinInterruptMode #

gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> PinInterruptMode -> r #

gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> PinInterruptMode -> r #

gmapQ :: (forall d. Data d => d -> u) -> PinInterruptMode -> [u] #

gmapQi :: Int -> (forall d. Data d => d -> u) -> PinInterruptMode -> u #

gmapM :: Monad m => (forall d. Data d => d -> m d) -> PinInterruptMode -> m PinInterruptMode #

gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> PinInterruptMode -> m PinInterruptMode #

gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> PinInterruptMode -> m PinInterruptMode #

Ord PinInterruptMode Source # 
Instance details

Defined in System.GPIO.Types

Read PinInterruptMode Source # 
Instance details

Defined in System.GPIO.Types

Show PinInterruptMode Source # 
Instance details

Defined in System.GPIO.Types

Generic PinInterruptMode Source # 
Instance details

Defined in System.GPIO.Types

Associated Types

type Rep PinInterruptMode :: * -> * #

Arbitrary PinInterruptMode Source # 
Instance details

Defined in System.GPIO.Types

type Rep PinInterruptMode Source # 
Instance details

Defined in System.GPIO.Types

type Rep PinInterruptMode = D1 (MetaData "PinInterruptMode" "System.GPIO.Types" "hpio-0.9.0.7-6wTVDAAhQWjGywt4QfvtzA" False) ((C1 (MetaCons "Disabled" PrefixI False) (U1 :: * -> *) :+: C1 (MetaCons "RisingEdge" PrefixI False) (U1 :: * -> *)) :+: (C1 (MetaCons "FallingEdge" PrefixI False) (U1 :: * -> *) :+: C1 (MetaCons "Level" PrefixI False) (U1 :: * -> *)))

Some convenient constraint synonyms for MonadGpio signatures.

type MaskGpioM h m = (MonadMask m, MonadGpio h m) Source #

type ThrowGpioM h m = (MonadThrow m, MonadGpio h m) Source #

MonadGpio class

class Monad m => MonadGpio h m | m -> h where Source #

A monad type class for GPIO computations. The type class specifies a DSL for writing portable GPIO programs, and instances of the type class provide the interpreter needed to run these programs on a particular GPIO platform.

In the type signature, h represents a (platform-dependent) abstract pin handle for operating on opened pins. It is analogous to a file handle.

Active-high versus active-low logic

The DSL supports both active-high and active-low logic. That is, the active level of a GPIO pin can be configured as ActiveHigh or ActiveLow. If a pin's active level is ActiveHigh, then for that pin, a PinValue of High corresponds to a "high" physical signal level, and a PinValue of Low corresponds to a "low" physical signal level. The converse is true when the pin's active level is ActiveLow.

Despite the potential confusion, the advantage of supporting active-low logic is that you can, if you choose, write your program in terms of "positive" logic (where High always means "on" and Low always means "off"), and, with the same program, interface with either positive (active-high) or negative (active-low) logic simply by setting the pin's active level before running the program.

In the documentation for this package, whenever you see a reference to a "pin value" or "signal level," unless otherwise noted, we mean the logical value or level, not the physical value or level; that is, we mean the abstract notion of the pin being "on" or "off," independent of the voltage level seen on the physical pin. If the pin is configured as active-high, then the logical and physical values are one and the same; if not, they are the inverse of each other.

Note that the active-high/active-low setting is per-pin; each pin's active level is independent of the others.

Not all platforms natively support active-low logic. On platforms without native support, the platform interpreter will invert values (both read and written) in software when a pin is configured as active-low.

Methods

pins :: m [Pin] Source #

Get a list of available GPIO pins on the system.

This command makes a best-effort attempt to find the available pins, but some systems may not make the complete list available at runtime. Therefore, there may be more pins available than are returned by this action.

pinCapabilities :: Pin -> m PinCapabilities Source #

Query the pin's capabilities.

openPin :: Pin -> m h Source #

Open a pin for use and return a handle to it.

Note that on some platforms (notably Linux), pin handles are global resources and it is, strictly speaking, an error to attempt to open a pin which has already been opened. However, because there is generally no way to perform an atomic "only open the pin if it hasn't already been opened" operation on such platforms, this action will squash that particular error on those platforms and return the global handle anyway, without making any other state changes to the already-opened pin.

Keep in mind, however, that on these platforms where pin handles are global resources, closing one pin handle will effectively invalidate all other handles for the same pin. Be very careful to coordinate the opening and closing of pins if you are operating on the same pin in multiple threads.

closePin :: h -> m () Source #

Close the pin; i.e., indicate to the system that you no longer intend to use the pin via the given handle.

Note that on some platforms (notably Linux), pin handles are global resources and it is, strictly speaking, an error to attempt to close a pin which has already been closed via another handle to the same pin. However, this action will squash that error on those platforms and will simply return without making any changes to the GPIO environment.

Keep in mind, however, that on these platforms where pin handles are global resources, opening multiple handles for the same pin and then closing one of those handles will render all other handles for the same pin invalid. Be very careful to coordinate the opening and closing of pins if you are operating on the same pin in multiple threads.

Note that there are also platforms (again, notably certain Linux systems) where some pins are effectively always open and cannot be closed. Invoking this action on such a pin will squash any error that occurs when attempting to close the pin, and the action will simply return without making any changes to the GPIO environment.

getPinDirection :: h -> m PinDirection Source #

Get the pin's currently configured direction.

Note that there is no setPinDirection action. You set the pin's direction indirectly by setting its input mode or output mode via setPinInputMode and setPinOutputMode, respectively.

Rarely, a particular pin's direction may not be available in a cross-platform way. In these cases, calling this action is an error. In general, though, if the pin's capabilities indicate that it supports at least one PinInputMode or PinOutputMode, it's safe to call this action.

getPinInputMode :: h -> m PinInputMode Source #

Get the pin's input mode.

If the pin is not currently configured for input, it's an error to call this action.

setPinInputMode :: h -> PinInputMode -> m () Source #

Set the pin's input mode. This action will also set the pin's direction to In.

It is an error to call this action if the given pin does not support the given input mode.

getPinOutputMode :: h -> m PinOutputMode Source #

Get the pin's output mode.

If the pin is not currently configured for output, it's an error to call this action.

setPinOutputMode :: h -> PinOutputMode -> PinValue -> m () Source #

Set the pin's output mode and value. This action will also set the pin's direction to Out

If the pin is already in output mode and you only want to change its value, use writePin.

It is an error to call this action if the given pin does not support the given output mode.

readPin :: h -> m PinValue Source #

Read the pin's value.

Note that this action never blocks.

pollPin :: h -> m PinValue Source #

Block the current thread until an event occurs on the pin which corresponds to the pin's current interrupt mode. Upon detection of the event, return the pin's value.

If the pin does not support interrupts, then this action's behavior is plaform-dependent.

It is an error to call this action when the pin is not configured for input.

Note: due to its interaction with the threading system, this action may behave differently across different implementations of Haskell. It has only been tested with GHC. (On GHC, you should compile any program that uses this action with the -threaded option.)

pollPinTimeout :: h -> Int -> m (Maybe PinValue) Source #

Same as pollPin, except with a timeout, specified in microseconds. If no event occurs before the timeout expires, this action returns Nothing; otherwise, it returns the pin's signal level wrapped in a Just.

If the timeout value is negative, this action behaves just like pollPin.

If the pin does not support interrupts, then this action's behavior is platform-dependent.

It is an error to call this action when the pin is not configured for input.

Note: due to its interaction with the threading system, this action may behave differently across different implementations of Haskell. It has only been tested with GHC. (On GHC, you should compile any program that uses this action with the -threaded option.)

writePin :: h -> PinValue -> m () Source #

Set the pin's output value.

It is an error to call this action when the pin is not configured for output.

togglePin :: h -> m PinValue Source #

Toggle the pin's output value and return the pin's new output value.

It is an error to call this action when the pin is not configured for output.

getPinInterruptMode :: h -> m PinInterruptMode Source #

Get the pin's interrupt mode.

If the pin does not support interrupts, it is an error to call this action.

(Note that RisingEdge and FallingEdge are relative to the pin's active level; i.e., they refer to the pin's logical signal edges, not its physical signal edges.)

setPinInterruptMode :: h -> PinInterruptMode -> m () Source #

Set the pin's interrupt mode (only when the pin is configured for input).

A pin's interrupt mode determines the behavior of the pollPin and pollPinTimeout actions. Those actions will block the current thread on an input pin until a particular event occurs on that pin's signal waveform: a low-to-high transition (RisingEdge), a high-to-low transition (FallingEdge), or any change of level (Level).

You can also disable interrupts on the pin so that pollPin will block the current thread indefinitely (or until a timer expires, in the case of pollPinTimeout). This functionality is useful when, for example, one thread is dedicated to servicing interrupts on a pin, and another thread wants to mask interrupts on that pin for some period of time.

Some pins (or even some GPIO platforms) may not support interrupts. In such cases, it is an error to call this action.

It is an error to use this action on a pin configured for output.

getPinActiveLevel :: h -> m PinActiveLevel Source #

Get the pin's active level.

setPinActiveLevel :: h -> PinActiveLevel -> m () Source #

Set the pin's active level.

togglePinActiveLevel :: h -> m PinActiveLevel Source #

Toggle the pin's active level. Returns the pin's new level.

pins :: (MonadTrans t, MonadGpio h m', t m' ~ m) => m [Pin] Source #

Get a list of available GPIO pins on the system.

This command makes a best-effort attempt to find the available pins, but some systems may not make the complete list available at runtime. Therefore, there may be more pins available than are returned by this action.

pinCapabilities :: (MonadTrans t, MonadGpio h m', t m' ~ m) => Pin -> m PinCapabilities Source #

Query the pin's capabilities.

openPin :: (MonadTrans t, MonadGpio h m', t m' ~ m) => Pin -> m h Source #

Open a pin for use and return a handle to it.

Note that on some platforms (notably Linux), pin handles are global resources and it is, strictly speaking, an error to attempt to open a pin which has already been opened. However, because there is generally no way to perform an atomic "only open the pin if it hasn't already been opened" operation on such platforms, this action will squash that particular error on those platforms and return the global handle anyway, without making any other state changes to the already-opened pin.

Keep in mind, however, that on these platforms where pin handles are global resources, closing one pin handle will effectively invalidate all other handles for the same pin. Be very careful to coordinate the opening and closing of pins if you are operating on the same pin in multiple threads.

closePin :: (MonadTrans t, MonadGpio h m', t m' ~ m) => h -> m () Source #

Close the pin; i.e., indicate to the system that you no longer intend to use the pin via the given handle.

Note that on some platforms (notably Linux), pin handles are global resources and it is, strictly speaking, an error to attempt to close a pin which has already been closed via another handle to the same pin. However, this action will squash that error on those platforms and will simply return without making any changes to the GPIO environment.

Keep in mind, however, that on these platforms where pin handles are global resources, opening multiple handles for the same pin and then closing one of those handles will render all other handles for the same pin invalid. Be very careful to coordinate the opening and closing of pins if you are operating on the same pin in multiple threads.

Note that there are also platforms (again, notably certain Linux systems) where some pins are effectively always open and cannot be closed. Invoking this action on such a pin will squash any error that occurs when attempting to close the pin, and the action will simply return without making any changes to the GPIO environment.

getPinDirection :: (MonadTrans t, MonadGpio h m', t m' ~ m) => h -> m PinDirection Source #

Get the pin's currently configured direction.

Note that there is no setPinDirection action. You set the pin's direction indirectly by setting its input mode or output mode via setPinInputMode and setPinOutputMode, respectively.

Rarely, a particular pin's direction may not be available in a cross-platform way. In these cases, calling this action is an error. In general, though, if the pin's capabilities indicate that it supports at least one PinInputMode or PinOutputMode, it's safe to call this action.

getPinInputMode :: (MonadTrans t, MonadGpio h m', t m' ~ m) => h -> m PinInputMode Source #

Get the pin's input mode.

If the pin is not currently configured for input, it's an error to call this action.

setPinInputMode :: (MonadTrans t, MonadGpio h m', t m' ~ m) => h -> PinInputMode -> m () Source #

Set the pin's input mode. This action will also set the pin's direction to In.

It is an error to call this action if the given pin does not support the given input mode.

getPinOutputMode :: (MonadTrans t, MonadGpio h m', t m' ~ m) => h -> m PinOutputMode Source #

Get the pin's output mode.

If the pin is not currently configured for output, it's an error to call this action.

setPinOutputMode :: (MonadTrans t, MonadGpio h m', t m' ~ m) => h -> PinOutputMode -> PinValue -> m () Source #

Set the pin's output mode and value. This action will also set the pin's direction to Out

If the pin is already in output mode and you only want to change its value, use writePin.

It is an error to call this action if the given pin does not support the given output mode.

readPin :: (MonadTrans t, MonadGpio h m', t m' ~ m) => h -> m PinValue Source #

Read the pin's value.

Note that this action never blocks.

pollPin :: (MonadTrans t, MonadGpio h m', t m' ~ m) => h -> m PinValue Source #

Block the current thread until an event occurs on the pin which corresponds to the pin's current interrupt mode. Upon detection of the event, return the pin's value.

If the pin does not support interrupts, then this action's behavior is plaform-dependent.

It is an error to call this action when the pin is not configured for input.

Note: due to its interaction with the threading system, this action may behave differently across different implementations of Haskell. It has only been tested with GHC. (On GHC, you should compile any program that uses this action with the -threaded option.)

pollPinTimeout :: (MonadTrans t, MonadGpio h m', t m' ~ m) => h -> Int -> m (Maybe PinValue) Source #

Same as pollPin, except with a timeout, specified in microseconds. If no event occurs before the timeout expires, this action returns Nothing; otherwise, it returns the pin's signal level wrapped in a Just.

If the timeout value is negative, this action behaves just like pollPin.

If the pin does not support interrupts, then this action's behavior is platform-dependent.

It is an error to call this action when the pin is not configured for input.

Note: due to its interaction with the threading system, this action may behave differently across different implementations of Haskell. It has only been tested with GHC. (On GHC, you should compile any program that uses this action with the -threaded option.)

writePin :: (MonadTrans t, MonadGpio h m', t m' ~ m) => h -> PinValue -> m () Source #

Set the pin's output value.

It is an error to call this action when the pin is not configured for output.

togglePin :: (MonadTrans t, MonadGpio h m', t m' ~ m) => h -> m PinValue Source #

Toggle the pin's output value and return the pin's new output value.

It is an error to call this action when the pin is not configured for output.

getPinInterruptMode :: (MonadTrans t, MonadGpio h m', t m' ~ m) => h -> m PinInterruptMode Source #

Get the pin's interrupt mode.

If the pin does not support interrupts, it is an error to call this action.

(Note that RisingEdge and FallingEdge are relative to the pin's active level; i.e., they refer to the pin's logical signal edges, not its physical signal edges.)

setPinInterruptMode :: (MonadTrans t, MonadGpio h m', t m' ~ m) => h -> PinInterruptMode -> m () Source #

Set the pin's interrupt mode (only when the pin is configured for input).

A pin's interrupt mode determines the behavior of the pollPin and pollPinTimeout actions. Those actions will block the current thread on an input pin until a particular event occurs on that pin's signal waveform: a low-to-high transition (RisingEdge), a high-to-low transition (FallingEdge), or any change of level (Level).

You can also disable interrupts on the pin so that pollPin will block the current thread indefinitely (or until a timer expires, in the case of pollPinTimeout). This functionality is useful when, for example, one thread is dedicated to servicing interrupts on a pin, and another thread wants to mask interrupts on that pin for some period of time.

Some pins (or even some GPIO platforms) may not support interrupts. In such cases, it is an error to call this action.

It is an error to use this action on a pin configured for output.

getPinActiveLevel :: (MonadTrans t, MonadGpio h m', t m' ~ m) => h -> m PinActiveLevel Source #

Get the pin's active level.

setPinActiveLevel :: (MonadTrans t, MonadGpio h m', t m' ~ m) => h -> PinActiveLevel -> m () Source #

Set the pin's active level.

togglePinActiveLevel :: (MonadTrans t, MonadGpio h m', t m' ~ m) => h -> m PinActiveLevel Source #

Toggle the pin's active level. Returns the pin's new level.

Instances
MonadGpio h m => MonadGpio h (NoLoggingT m) Source # 
Instance details

Defined in System.GPIO.Monad

MonadGpio h m => MonadGpio h (LoggingT m) Source # 
Instance details

Defined in System.GPIO.Monad

MonadGpio h m => MonadGpio h (MaybeT m) Source # 
Instance details

Defined in System.GPIO.Monad

MonadGpio h m => MonadGpio h (ListT m) Source # 
Instance details

Defined in System.GPIO.Monad

MonadGpio h m => MonadGpio h (CatchT m) Source # 
Instance details

Defined in System.GPIO.Monad

(MonadMask m, ThrowCatchSysfsM m) => MonadGpio PinDescriptor (SysfsGpioT m) Source # 
Instance details

Defined in System.GPIO.Linux.Sysfs.Monad

(MonadGpio h m, Monoid w) => MonadGpio h (WriterT w m) Source # 
Instance details

Defined in System.GPIO.Monad

(MonadGpio h m, Monoid w) => MonadGpio h (WriterT w m) Source # 
Instance details

Defined in System.GPIO.Monad

MonadGpio h m => MonadGpio h (StateT s m) Source # 
Instance details

Defined in System.GPIO.Monad

MonadGpio h m => MonadGpio h (StateT s m) Source # 
Instance details

Defined in System.GPIO.Monad

MonadGpio h m => MonadGpio h (ExceptT e m) Source # 
Instance details

Defined in System.GPIO.Monad

MonadGpio h m => MonadGpio h (IdentityT m) Source # 
Instance details

Defined in System.GPIO.Monad

MonadGpio h m => MonadGpio h (ReaderT r m) Source # 
Instance details

Defined in System.GPIO.Monad

MonadGpio h m => MonadGpio h (ContT r m) Source # 
Instance details

Defined in System.GPIO.Monad

(MonadGpio h m, Monoid w) => MonadGpio h (RWST r w s m) Source # 
Instance details

Defined in System.GPIO.Monad

(MonadGpio h m, Monoid w) => MonadGpio h (RWST r w s m) Source # 
Instance details

Defined in System.GPIO.Monad

withPin :: MaskGpioM h m => Pin -> (h -> m a) -> m a Source #

Exception-safe pin management.

withPin opens a pin using openPin and passes the handle to the given GPIO computation. Upon completion of the computation, or an exception occuring within the computation, withPin closes the handle using closePin and then propagates the result, either by returning the value of the computation or by re-raising the exception.

Safer types

If you can restrict your use of a particular pin to just one mode of operation (input, interrupt-driven input, or output), you can achieve better type-safety than is possible with the fully-general Pin type by using the one of the following more limited types and its corresponding actions.

A caveat

On some GPIO platforms (e.g., Linux sysfs), no provision is made for opening pins in "exclusive mode," and as such, pins can be opened and configured by any number of processes on the system other than our own programs. Therefore, even when using these safer types, a robust hpio program should still be prepared to deal with configuration-related errors in case another process re-configures a pin while the hpio program is using it.

In other words, even when using these safer types, you should still be prepared to handle the full range of SomeGpioExceptions.

data InputPin h Source #

A handle to a pin that's been configured for non-blocking reads only.

You cannot poll an InputPin for interrupts. See InterruptPin.

Instances
Eq h => Eq (InputPin h) Source # 
Instance details

Defined in System.GPIO.Monad

Methods

(==) :: InputPin h -> InputPin h -> Bool #

(/=) :: InputPin h -> InputPin h -> Bool #

Show h => Show (InputPin h) Source # 
Instance details

Defined in System.GPIO.Monad

Methods

showsPrec :: Int -> InputPin h -> ShowS #

show :: InputPin h -> String #

showList :: [InputPin h] -> ShowS #

withInputPin :: MaskGpioM h m => Pin -> PinInputMode -> Maybe PinActiveLevel -> (InputPin h -> m a) -> m a Source #

Like withPin, but for InputPins. 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.

data InterruptPin h Source #

A handle to a pin that's been configured both for non-blocking reads and for interrupt-driven polling reads.

Instances
Eq h => Eq (InterruptPin h) Source # 
Instance details

Defined in System.GPIO.Monad

Show h => Show (InterruptPin h) Source # 
Instance details

Defined in System.GPIO.Monad

withInterruptPin :: MaskGpioM h m => Pin -> PinInputMode -> PinInterruptMode -> Maybe PinActiveLevel -> (InterruptPin h -> m a) -> m a Source #

Like withPin, but for InterruptPins. 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.

data OutputPin h Source #

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.

Instances
Eq h => Eq (OutputPin h) Source # 
Instance details

Defined in System.GPIO.Monad

Methods

(==) :: OutputPin h -> OutputPin h -> Bool #

(/=) :: OutputPin h -> OutputPin h -> Bool #

Show h => Show (OutputPin h) Source # 
Instance details

Defined in System.GPIO.Monad

withOutputPin :: MaskGpioM h m => Pin -> PinOutputMode -> Maybe PinActiveLevel -> PinValue -> (OutputPin h -> m a) -> m a Source #

Like withPin, but for OutputPins. 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.

The GPIO exception hierarchy

Re-exported from System.GPIO.Types.