Safe Haskell | None |
---|---|
Language | Haskell2010 |
You should not need to import this module unless you're adding support for a new model of Arduino, or an Arduino library.
Synopsis
- type Behavior t = Stream t
- data TypedBehavior p t = TypedBehavior (Behavior t)
- data Event p v = Event v (Stream Bool)
- newtype Sketch t = Sketch (WriterT [(TriggerLimit -> Spec, TriggerLimit -> Framework)] (State UniqueIds) t)
- newtype UniqueIds = UniqueIds (Map String Integer)
- newtype UniqueId = UniqueId Integer
- data TriggerLimit
- getTriggerLimit :: TriggerLimit -> Behavior Bool
- addTriggerLimit :: TriggerLimit -> Behavior Bool -> Behavior Bool
- evalSketch :: Sketch a -> (Maybe Spec, Framework)
- whenB :: Behavior Bool -> Sketch t -> Sketch t
- getUniqueId :: String -> Sketch UniqueId
- uniqueName :: String -> UniqueId -> String
- uniqueName' :: String -> UniqueId -> String
- data Framework = Framework {}
- newtype CLine = CLine {}
- newtype CChunk = CChunk [CLine]
- mkCChunk :: [CLine] -> [CChunk]
- defineTriggerAlias :: String -> Framework -> Sketch (Framework, String)
- defineTriggerAlias' :: String -> String -> Framework -> Sketch (Framework, String)
- data InputSource t = InputSource {
- defineVar :: [CChunk]
- setupInput :: [CChunk]
- inputPinmode :: Map PinId PinMode
- readInput :: [CChunk]
- inputStream :: Stream t
- mkInput :: InputSource t -> Sketch (Behavior t)
- newtype Pin t = Pin PinId
- newtype PinId = PinId Int16
- data PinCapabilities
- = DigitalIO
- | AnalogInput
- | PWM
- type family IsDigitalIOPin t where ...
- type family IsAnalogInputPin t where ...
- type family IsPWMPin t where ...
- type family HasPinCapability (c :: t) (list :: [t]) :: Bool where ...
- type family SameCapability a b :: Bool where ...
- data PinMode
- class Output o t where
- type family BehaviorToEvent a
- class IsBehavior behavior where
- (@:) :: behavior -> Behavior Bool -> BehaviorToEvent behavior
- class Input o t where
- input :: Input o t => o -> Sketch (Behavior t)
- type ADC = Int16
- class ShowCType t where
Documentation
type Behavior t = Stream t Source #
A value that changes over time.
This is implemented as a Stream
in the Copilot DSL.
Copilot provides many operations on streams, for example
&&
to combine two streams of Bools.
For documentation on using the Copilot DSL, see https://copilot-language.github.io/
data TypedBehavior p t Source #
A Behavior with an additional phantom type p
.
The Compilot DSL only lets a Stream contain basic C types,
a limitation that Behavior
also has. When more type safely
is needed, this can be used.
Instances
Output o (Event p (Stream v)) => Output o (TypedBehavior p v) Source # | |
Defined in Copilot.Arduino.Internals (=:) :: o -> TypedBehavior p v -> Sketch () Source # | |
Typed a => IfThenElse (TypedBehavior p) a Source # | |
Defined in Copilot.Arduino ifThenElse :: Behavior Bool -> TypedBehavior p a -> TypedBehavior p a -> TypedBehavior p a Source # | |
IsBehavior (TypedBehavior p v) Source # | |
Defined in Copilot.Arduino.Internals (@:) :: TypedBehavior p v -> Behavior Bool -> BehaviorToEvent (TypedBehavior p v) Source # | |
type BehaviorToEvent (TypedBehavior p v) Source # | |
Defined in Copilot.Arduino.Internals |
A discrete event, that occurs at particular points in time.
Instances
Output SerialDevice (Event () [FormatOutput]) Source # | |
Defined in Copilot.Arduino.Library.Serial.Device (=:) :: SerialDevice -> Event () [FormatOutput] -> Sketch () Source # | |
Output RandomSeed (Event () (Stream Word8)) Source # | |
Defined in Copilot.Arduino.Library.Random | |
Output RandomSeed (Event () (Stream ADC)) Source # | |
Defined in Copilot.Arduino.Library.Random | |
EEPROMable t => Output (Range t) (Event () (RangeWrites t)) Source # | |
Defined in Copilot.Arduino.Library.EEPROMex | |
EEPROMable t => Output (Location t) (Event () (Stream t)) Source # | |
IsPWMPin t => Output (Pin t) (Event 'PWM (Stream Word8)) Source # | |
IsDigitalIOPin t => Output (Pin t) (Event () (Stream Bool)) Source # | |
An Arduino sketch, implemented using Copilot.
It's best to think of the Sketch
as a description of the state of the
Arduino at any point in time.
Under the hood, the Sketch
is run in a loop. On each iteration, it first
reads inputs and then updates outputs as needed.
While it is a monad, a Sketch's outputs are not updated in any particular order, because Copilot does not guarantee any order.
Sketch (WriterT [(TriggerLimit -> Spec, TriggerLimit -> Framework)] (State UniqueIds) t) |
Instances
Monad Sketch Source # | |
Functor Sketch Source # | |
Applicative Sketch Source # | |
MonadState UniqueIds Sketch Source # | |
IfThenElse Sketch () Source # | |
Defined in Copilot.Arduino | |
Typed a => IfThenElse Sketch (Behavior a) Source # | |
Semigroup (Sketch t) Source # | |
Monoid (Sketch ()) Source # | |
MonadWriter [(TriggerLimit -> Spec, TriggerLimit -> Framework)] Sketch Source # | |
Defined in Copilot.Arduino.Internals writer :: (a, [(TriggerLimit -> Spec, TriggerLimit -> Framework)]) -> Sketch a # tell :: [(TriggerLimit -> Spec, TriggerLimit -> Framework)] -> Sketch () # listen :: Sketch a -> Sketch (a, [(TriggerLimit -> Spec, TriggerLimit -> Framework)]) # pass :: Sketch (a, [(TriggerLimit -> Spec, TriggerLimit -> Framework)] -> [(TriggerLimit -> Spec, TriggerLimit -> Framework)]) -> Sketch a # |
data TriggerLimit Source #
Instances
Semigroup TriggerLimit Source # | |
Defined in Copilot.Arduino.Internals (<>) :: TriggerLimit -> TriggerLimit -> TriggerLimit # sconcat :: NonEmpty TriggerLimit -> TriggerLimit # stimes :: Integral b => b -> TriggerLimit -> TriggerLimit # | |
Monoid TriggerLimit Source # | |
Defined in Copilot.Arduino.Internals mempty :: TriggerLimit # mappend :: TriggerLimit -> TriggerLimit -> TriggerLimit # mconcat :: [TriggerLimit] -> TriggerLimit # | |
MonadWriter [(TriggerLimit -> Spec, TriggerLimit -> Framework)] Sketch Source # | |
Defined in Copilot.Arduino.Internals writer :: (a, [(TriggerLimit -> Spec, TriggerLimit -> Framework)]) -> Sketch a # tell :: [(TriggerLimit -> Spec, TriggerLimit -> Framework)] -> Sketch () # listen :: Sketch a -> Sketch (a, [(TriggerLimit -> Spec, TriggerLimit -> Framework)]) # pass :: Sketch (a, [(TriggerLimit -> Spec, TriggerLimit -> Framework)] -> [(TriggerLimit -> Spec, TriggerLimit -> Framework)]) -> Sketch a # |
addTriggerLimit :: TriggerLimit -> Behavior Bool -> Behavior Bool Source #
whenB :: Behavior Bool -> Sketch t -> Sketch t Source #
Limit the effects of a Sketch
to times when a Behavior
Bool
is True.
When applied to =:
, this does the same thing as @:
but without
the FRP style conversion the input Behavior
into an Event
. So @:
is generally better to use than this.
But, this can also be applied to input
, to limit how often input
gets read. Useful to avoid performing slow input operations on every
iteration of a Sketch.
v <- whenB (frequency 10) $ input pin12
(It's best to think of the value returned by that as an Event, but it's currently represented as a Behavior, since the Copilot DSL cannot operate on Events.)
The framework of an Arduino sketch.
Framework | |
|
Instances
Semigroup Framework Source # | |
Monoid Framework Source # | |
MonadWriter [(TriggerLimit -> Spec, TriggerLimit -> Framework)] Sketch Source # | |
Defined in Copilot.Arduino.Internals writer :: (a, [(TriggerLimit -> Spec, TriggerLimit -> Framework)]) -> Sketch a # tell :: [(TriggerLimit -> Spec, TriggerLimit -> Framework)] -> Sketch () # listen :: Sketch a -> Sketch (a, [(TriggerLimit -> Spec, TriggerLimit -> Framework)]) # pass :: Sketch (a, [(TriggerLimit -> Spec, TriggerLimit -> Framework)] -> [(TriggerLimit -> Spec, TriggerLimit -> Framework)]) -> Sketch a # |
A chunk of C code. Identical chunks get deduplicated.
defineTriggerAlias :: String -> Framework -> Sketch (Framework, String) Source #
Copilot only supports calling a trigger with a given name once per Spec; the generated C code will fail to build if the same name is used in two triggers. This generates a unique alias that can be used in a trigger.
data InputSource t Source #
InputSource | |
|
A pin on the Arduino board.
For definitions of pins like pin12
,
load a module such as Copilot.Arduino.Uno, which provides the pins of a
particular board.
A type-level list indicates how a Pin can be used, so the haskell compiler will detect impossible uses of pins.
Instances
data PinCapabilities Source #
Instances
type family IsDigitalIOPin t where ... Source #
IsDigitalIOPin t = 'True ~ If (HasPinCapability 'DigitalIO t) 'True (TypeError ('Text "This Pin does not support digital IO")) |
type family IsAnalogInputPin t where ... Source #
IsAnalogInputPin t = 'True ~ If (HasPinCapability 'AnalogInput t) 'True (TypeError ('Text "This Pin does not support analog input")) |
type family HasPinCapability (c :: t) (list :: [t]) :: Bool where ... Source #
HasPinCapability c '[] = 'False | |
HasPinCapability c (x ': xs) = SameCapability c x || HasPinCapability c xs |
type family SameCapability a b :: Bool where ... Source #
SameCapability 'DigitalIO 'DigitalIO = 'True | |
SameCapability 'AnalogInput 'AnalogInput = 'True | |
SameCapability 'PWM 'PWM = 'True | |
SameCapability _ _ = 'False |
class Output o t where Source #
(=:) :: o -> t -> Sketch () infixr 1 Source #
Connect a Behavior
or Event
to an Output
led =: blinking
When a Behavior
is used, its current value is written on each
iteration of the Sketch
.
For example, this constantly turns on the LED, even though it will
already be on after the first iteration, because true
is a Behavior
(that is always True).
led =: true
To avoid unncessary work being done, you can use an Event
instead. Then the write only happens at the points in time
when the Event
occurs. To turn a Behavior
into an Event
,
use @:
So to make the LED only be turned on in the first iteration, and allow it to remain on thereafter without doing extra work:
led =: true @: firstIteration
Instances
type family BehaviorToEvent a Source #
This type family is open, so it can be extended when adding other data types to the IsBehavior class.
Instances
type BehaviorToEvent [FormatOutput] Source # | |
Defined in Copilot.Arduino.Library.Serial.Device | |
type BehaviorToEvent (Behavior v) Source # | |
Defined in Copilot.Arduino.Internals | |
type BehaviorToEvent (RangeWrites t) Source # | |
Defined in Copilot.Arduino.Library.EEPROMex | |
type BehaviorToEvent (TypedBehavior p v) Source # | |
Defined in Copilot.Arduino.Internals |
class IsBehavior behavior where Source #
(@:) :: behavior -> Behavior Bool -> BehaviorToEvent behavior Source #
Generate an Event, from some type of behavior,
that only occurs when the Behavior
Bool is True.
Instances
IsBehavior [FormatOutput] Source # | |
Defined in Copilot.Arduino.Library.Serial.Device (@:) :: [FormatOutput] -> Behavior Bool -> BehaviorToEvent [FormatOutput] Source # | |
IsBehavior (Behavior v) Source # | |
Defined in Copilot.Arduino.Internals | |
EEPROMable t => IsBehavior (RangeWrites t) Source # | |
Defined in Copilot.Arduino.Library.EEPROMex (@:) :: RangeWrites t -> Behavior Bool -> BehaviorToEvent (RangeWrites t) Source # | |
IsBehavior (TypedBehavior p v) Source # | |
Defined in Copilot.Arduino.Internals (@:) :: TypedBehavior p v -> Behavior Bool -> BehaviorToEvent (TypedBehavior p v) Source # |
class Input o t where Source #
input' :: o -> [t] -> Sketch (Behavior t) Source #
The list is input to use when simulating the Sketch.
Instances
Input ClockMicros Word32 Source # | |
Defined in Copilot.Arduino | |
Input ClockMillis Word32 Source # | |
Defined in Copilot.Arduino | |
Input SerialDevice Int8 Source # | |
Defined in Copilot.Arduino.Library.Serial.Device | |
Input RandomInput Word32 Source # | |
Defined in Copilot.Arduino.Library.Random | |
(ShowCType t, EEPROMable t) => Input (RangeReads t) t Source # | |
Defined in Copilot.Arduino.Library.EEPROMex | |
IsAnalogInputPin t => Input (Pin t) ADC Source # | |
IsDigitalIOPin t => Input (Pin t) Bool Source # | |
input :: Input o t => o -> Sketch (Behavior t) Source #
Use this to read a value from a component of the Arduino.
For example, to read a digital value from pin12 and turn on the led when the pin is high:
buttonpressed <- input pin12 led =: buttonpressed
Some pins support multiple types of reads, for example pin a0
supports a digital read (Bool
), and an analog to digital converter
read (ADC
). In such cases you may need to specify the type of
data to read:
v <- input a0 :: Sketch (Behavior ADC)