Copyright | (c) 2017 Quixoftic LLC |
---|---|
License | BSD3 |
Maintainer | Drew Hess <dhess-src@quixoftic.com> |
Stability | experimental |
Portability | non-portable |
Safe Haskell | Trustworthy |
Language | Haskell2010 |
A mock MonadSysfs
instance, for testing GPIO programs.
Note that this monad only mocks the subset of sysfs
functionality
required for GPIO programs. It does not mock the entire sysfs
filesystem.
- data MockWorld
- data MockPinState = MockPinState {
- _direction :: !PinDirection
- _userVisibleDirection :: !Bool
- _activeLow :: !Bool
- _value :: !PinValue
- _edge :: Maybe SysfsEdge
- defaultMockPinState :: MockPinState
- logicalValue :: MockPinState -> PinValue
- setLogicalValue :: PinValue -> MockPinState -> MockPinState
- data MockGpioChip = MockGpioChip {
- _label :: !Text
- _base :: !Int
- _initialPinStates :: [MockPinState]
- type MockPins = Map Pin MockPinState
- mockWorldPins :: MockWorld -> MockPins
- initialMockWorld :: MockWorld
- newtype SysfsMockT m a = SysfsMockT {
- unSysfsMockT :: StateT MockWorld m a
- runSysfsMockT :: MockM m => SysfsMockT m a -> MockWorld -> [MockGpioChip] -> m (a, MockWorld)
- evalSysfsMockT :: MockM m => SysfsMockT m a -> MockWorld -> [MockGpioChip] -> m a
- execSysfsMockT :: MockM m => SysfsMockT m a -> MockWorld -> [MockGpioChip] -> m MockWorld
- type SysfsGpioMock = SysfsGpioT SysfsMock
- runSysfsGpioMock :: SysfsGpioMock a -> MockWorld -> [MockGpioChip] -> Either SomeException (a, MockWorld)
- evalSysfsGpioMock :: SysfsGpioMock a -> MockWorld -> [MockGpioChip] -> Either SomeException a
- execSysfsGpioMock :: SysfsGpioMock a -> MockWorld -> [MockGpioChip] -> Either SomeException MockWorld
- type SysfsGpioMockIO = SysfsGpioT SysfsMockIO
- runSysfsGpioMockIO :: SysfsGpioMockIO a -> MockWorld -> [MockGpioChip] -> IO (a, MockWorld)
- evalSysfsGpioMockIO :: SysfsGpioMockIO a -> MockWorld -> [MockGpioChip] -> IO a
- execSysfsGpioMockIO :: SysfsGpioMockIO a -> MockWorld -> [MockGpioChip] -> IO MockWorld
- data MockFSException
- type SysfsMock = SysfsMockT Catch
- runSysfsMock :: SysfsMock a -> MockWorld -> [MockGpioChip] -> Either SomeException (a, MockWorld)
- evalSysfsMock :: SysfsMock a -> MockWorld -> [MockGpioChip] -> Either SomeException a
- execSysfsMock :: SysfsMock a -> MockWorld -> [MockGpioChip] -> Either SomeException MockWorld
- type SysfsMockIO = SysfsMockT IO
- runSysfsMockIO :: SysfsMockIO a -> MockWorld -> [MockGpioChip] -> IO (a, MockWorld)
- evalSysfsMockIO :: SysfsMockIO a -> MockWorld -> [MockGpioChip] -> IO a
- execSysfsMockIO :: SysfsMockIO a -> MockWorld -> [MockGpioChip] -> IO MockWorld
- doesDirectoryExist :: MockM m => FilePath -> SysfsMockT m Bool
- doesFileExist :: MockM m => FilePath -> SysfsMockT m Bool
- getDirectoryContents :: MockM m => FilePath -> SysfsMockT m [FilePath]
- readFile :: MockM m => FilePath -> SysfsMockT m ByteString
- writeFile :: MockM m => FilePath -> ByteString -> SysfsMockT m ()
- unlockedWriteFile :: MockM m => FilePath -> ByteString -> SysfsMockT m ()
- pollFile :: MockM m => FilePath -> Int -> SysfsMockT m CInt
SysfsMock types
The global state of a mock Linux GPIO subsystem with a sysfs
interface. It consists of the mock sysfs
GPIO filesystem state,
along with the state of every mock pin.
An actual Linux sysfs
GPIO filesystem is not like a
general-purpose filesystem. The user cannot create files or
directories directly; they can only be created (or modified) via
prescribed operations on special conrol files, which are themselves
created by the kernel.
Likewise, the kernel and hardware platform together determine which
GPIO pins are exposed to the user via the sysfs
GPIO filesystem.
To preserve the illusion of an actual sysfs
GPIO filesystem, the
MockWorld
type is opaque and can only be manipulated via the
handful of actions that are implemented in this module. These
actions have been designed to keep the internal state of the mock
sysfs
GPIO filesystem consistent with the behavior that would be
seen in an actual sysfs
GPIO filesystem.
The high/low signal level on a real GPIO pin can, of course, be
manipulated by the circuit to which the pin is conected. A future
version of this implementation may permit the direct manipulation
of mock pin values in order to simulate simple circuits, but
currently the only way to manipulate pin state is via the mock
sysfs
GPIO filesystem.
data MockPinState Source #
A mock pin.
MockPinState | |
|
defaultMockPinState :: MockPinState Source #
Default initial state of mock pins.
>>>
defaultMockPinState
MockPinState {_direction = Out, _userVisibleDirection = True, _activeLow = False, _value = Low, _edge = Just None}
logicalValue :: MockPinState -> PinValue Source #
Linux sysfs
GPIO natively supports active-low logic levels. A
pin's "active" level is controlled by the pin's active_low
attribute. The pin's value relative to its active_low
attribute
is called its logical value. This function returns the mock pin's
logical value.
>>>
logicalValue defaultMockPinState
Low>>>
logicalValue defaultMockPinState { _value = High }
High>>>
logicalValue defaultMockPinState { _activeLow = True }
High>>>
logicalValue defaultMockPinState { _activeLow = True, _value = High }
Low
setLogicalValue :: PinValue -> MockPinState -> MockPinState Source #
This function sets the MockPinState
signal level to the given
logical value.
>>>
_value $ setLogicalValue High defaultMockPinState
High>>>
_value $ setLogicalValue High defaultMockPinState { _activeLow = True }
Low
data MockGpioChip Source #
A mock GPIO "chip." In the Linux sysfs
GPIO filesystem, a GPIO
chip is a set of one or more GPIO pins.
Note that the _initialPinStates
list is used to construct the pin
state for a MockWorld
(see runSysfsMockT
). For each
MockPinState
value in the list, a mock pin will be created in the
mock filesystem such that, when that pin is exported, its path is
/sys/class/gpio/gpioN
, where N
is _base
+ the pin's index
in the _initialPinStates
list.
MockGpioChip | |
|
type MockPins = Map Pin MockPinState Source #
A type alias for a strict map of Pin
to its MockPinState
.
initialMockWorld :: MockWorld Source #
The initial MockWorld
, representing a sysfs
filesystem with
no pins.
The SysfsMock monad
newtype SysfsMockT m a Source #
A monad transformer which adds mock sysfs
computations to an
inner monad m
.
SysfsMockT | |
|
runSysfsMockT :: MockM m => SysfsMockT m a -> MockWorld -> [MockGpioChip] -> m (a, MockWorld) Source #
Run a mock sysfs
computation in monad m
with an initial mock
world and list of MockGpioChip
s; and return a tuple containing the
computation's value and the final MockWorld
. If an exception
occurs in the mock computation, a MockFSException
is thrown.
Before running the computation, the MockWorld
is populated with
the GPIO pins as specified by the list of MockGpioChip
s. If any
of the chips' pin ranges overlap, a MockFSException
is thrown.
Typically, you will only need this action if you're trying to mock
Linux sysfs
GPIO computations using a custom monad transformer
stack. For simple cases, see runSysfsGpioMock
or
runSysfsGpioMockIO
.
evalSysfsMockT :: MockM m => SysfsMockT m a -> MockWorld -> [MockGpioChip] -> m a Source #
Like runSysfsMockT
, but returns only the computation's value.
execSysfsMockT :: MockM m => SysfsMockT m a -> MockWorld -> [MockGpioChip] -> m MockWorld Source #
Like runSysfsMockT
, but returns only the final MockWorld
.
Run mock GPIO computations
type SysfsGpioMock = SysfsGpioT SysfsMock Source #
A specialization of SysfsGpioT
which runs (pure, fake) GPIO
computations via a mock sysfs
.
runSysfsGpioMock :: SysfsGpioMock a -> MockWorld -> [MockGpioChip] -> Either SomeException (a, MockWorld) Source #
Run a SysfsGpioMock
computation with an initial mock world and
list of MockGpioChip
s, and return a tuple containing the
computation's value and the final MockWorld
. Any exceptions that
occur in the mock computation are returned as a Left
value.
Before running the computation, the MockWorld
is populated with
the GPIO pins as specified by the list of MockGpioChip
s. If any
of the chips' pin ranges overlap, a MockFSException
is returned
in a Left
value.
>>>
import System.GPIO.Monad
>>>
let mockChip = MockGpioChip "chip0" 0 (replicate 16 defaultMockPinState)
>>>
fst <$> runSysfsGpioMock pins initialMockWorld [mockChip]
Right [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]>>>
fst <$> runSysfsGpioMock (openPin (Pin 32)) initialMockWorld [mockChip]
Left InvalidPin (Pin 32)
evalSysfsGpioMock :: SysfsGpioMock a -> MockWorld -> [MockGpioChip] -> Either SomeException a Source #
Like runSysfsGpioMock
, but returns only the computation's
value.
execSysfsGpioMock :: SysfsGpioMock a -> MockWorld -> [MockGpioChip] -> Either SomeException MockWorld Source #
Like runSysfsGpioMock
, but returns only the final MockWorld
.
type SysfsGpioMockIO = SysfsGpioT SysfsMockIO Source #
Like SysfsGpioMock
, but wraps IO
so that you can mix IO
actions and GPIO actions in a mock GPIO environment.
runSysfsGpioMockIO :: SysfsGpioMockIO a -> MockWorld -> [MockGpioChip] -> IO (a, MockWorld) Source #
Run a SysfsGpioMockIO
computation with an initial mock world
and list of MockGpioChip
s, and return a tuple containing the
computation's value and the final MockWorld
.
Before running the computation, the MockWorld
is populated with
the GPIO pins as specified by the list of MockGpioChip
s. If any
of the chips' pin ranges overlap, a MockFSException
is thrown.
>>>
import System.GPIO.Monad
>>>
let mockChip = MockGpioChip "chip0" 0 (replicate 16 defaultMockPinState)
>>>
fst <$> runSysfsGpioMockIO pins initialMockWorld [mockChip]
[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]>>>
fst <$> runSysfsGpioMockIO (openPin (Pin 32)) initialMockWorld [mockChip]
*** Exception: InvalidPin (Pin 32)
evalSysfsGpioMockIO :: SysfsGpioMockIO a -> MockWorld -> [MockGpioChip] -> IO a Source #
Like runSysfsGpioMockIO
, but returns only the computation's
value.
execSysfsGpioMockIO :: SysfsGpioMockIO a -> MockWorld -> [MockGpioChip] -> IO MockWorld Source #
Like runSysfsGpioMockIO
, but returns only the final
MockWorld
.
Mock sysfs
exceptions.
data MockFSException Source #
Exceptions that can be thrown by mock sysfs
filesystem
operations.
Note that, as much as is reasonably possible, when an error occurs,
the mock filesystem implementation throws the same exception as
would occur in an actual sysfs
filesystem (i.e., IOError
s).
However, in a few cases, there are exceptions that are specific to
the mock sysfs
implementation; in these cases, a
MockFSException
is thrown.
GpioChipOverlap Pin | The user has defined defined at least two |
InternalError Text | An internal error has occurred in the mock |
Run mock sysfs
computations.
Generally speaking, you should not need to use these types, as they're not very useful on their own. They are primarily exported for unit testing.
If you want to run mock GPIO computations, use
SysfsMockT
for buildling transformer stacks, or either
SysfsGpioMock
or SysfsGpioMockIO
for simple
computations that are pure or mix with IO
, respectively.
type SysfsMock = SysfsMockT Catch Source #
The simplest possible (pure) mock sysfs
monad.
NB: this monad cannot run GPIO computations; its only use is to
mock sysfs
operations on an extremely limited mock sysfs
simulator.
You probably do not want to use this monad; see either
SysfsGpioMock
or SysfsGpioMockIO
, which adds GPIO computations
to this mock sysfs
environment.
runSysfsMock :: SysfsMock a -> MockWorld -> [MockGpioChip] -> Either SomeException (a, MockWorld) Source #
A pure version of runSysfsMockT
which returns errors in a
Left
, and both the computation's value and the final state of the
MockWorld
in a Right
.
>>>
let mockChip = MockGpioChip "chip0" 0 (replicate 16 defaultMockPinState)
>>>
fst <$> runSysfsMock (getDirectoryContents "/sys/class/gpio") initialMockWorld [mockChip]
Right ["gpiochip0","export","unexport"]>>>
runSysfsMock (getDirectoryContents "/sys/class/does_not_exist") initialMockWorld [mockChip]
Left /sys/class/does_not_exist: Mock.Internal.cd: does not exist
evalSysfsMock :: SysfsMock a -> MockWorld -> [MockGpioChip] -> Either SomeException a Source #
Like runSysfsMock
, but returns only the computation's value.
execSysfsMock :: SysfsMock a -> MockWorld -> [MockGpioChip] -> Either SomeException MockWorld Source #
Like runSysfsMock
, but returns only the final MockWorld
.
type SysfsMockIO = SysfsMockT IO Source #
The simplest possible (IO
-enabled) mock sysfs
monad. Like
SysfsMock
, but allows you to mix IO
operations into your
sysfs
computations, as well.
NB: this monad cannot run GPIO computations; its only use is to
mock sysfs
operations on an extremely limited mock sysfs
simulator.
You probably do not want to use this monad; see either
SysfsGpioMock
or SysfsGpioMockIO
, which adds GPIO computations
to this mock sysfs
environment.
runSysfsMockIO :: SysfsMockIO a -> MockWorld -> [MockGpioChip] -> IO (a, MockWorld) Source #
An IO
version of runSysfsMockT
. Errors are expressed as
exceptions.
>>>
let mockChip = MockGpioChip "chip0" 0 (replicate 16 defaultMockPinState)
>>>
fst <$> runSysfsMockIO (getDirectoryContents "/sys/class/gpio") initialMockWorld [mockChip]
["gpiochip0","export","unexport"]>>>
runSysfsMockIO (getDirectoryContents "/sys/class/does_not_exist") initialMockWorld [mockChip]
*** Exception: /sys/class/does_not_exist: Mock.Internal.cd: does not exist
evalSysfsMockIO :: SysfsMockIO a -> MockWorld -> [MockGpioChip] -> IO a Source #
Like runSysfsMockIO
, but returns only the computation's value.
execSysfsMockIO :: SysfsMockIO a -> MockWorld -> [MockGpioChip] -> IO MockWorld Source #
Like runSysfsMockIO
, but returns only the final MockWorld
.
Mock sysfs
actions
Generally speaking, you should not need these actions. They are primarily exported for unit testing.
doesDirectoryExist :: MockM m => FilePath -> SysfsMockT m Bool Source #
Check whether the specified directory exists in the mock filesystem.
doesFileExist :: MockM m => FilePath -> SysfsMockT m Bool Source #
Check whether the specified file exists in the mock filesystem.
getDirectoryContents :: MockM m => FilePath -> SysfsMockT m [FilePath] Source #
Get a directory listing for the specified directory in the mock filesystem.
readFile :: MockM m => FilePath -> SysfsMockT m ByteString Source #
Read the contents of the specified file in the mock filesystem.
writeFile :: MockM m => FilePath -> ByteString -> SysfsMockT m () Source #
Write the contents of the specified file in the mock filesystem.
unlockedWriteFile :: MockM m => FilePath -> ByteString -> SysfsMockT m () Source #
For the mock filesystem, this action is equivalent to
writeFile
.