arduino-copilot-1.5.5: Arduino programming in haskell using the Copilot stream DSL
Safe HaskellNone
LanguageHaskell2010

Copilot.Arduino.Internals

Description

You should not need to import this module unless you're adding support for a new model of Arduino, or an Arduino library.

Synopsis

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.

Constructors

TypedBehavior (Behavior t) 

Instances

Instances details
Output o (Event p (Stream v)) => Output o (TypedBehavior p v) Source # 
Instance details

Defined in Copilot.Arduino.Internals

Methods

(=:) :: o -> TypedBehavior p v -> Sketch () Source #

Typed a => IfThenElse (TypedBehavior p) a Source # 
Instance details

Defined in Copilot.Arduino

IsBehavior (TypedBehavior p v) Source # 
Instance details

Defined in Copilot.Arduino.Internals

type BehaviorToEvent (TypedBehavior p v) Source # 
Instance details

Defined in Copilot.Arduino.Internals

data Event p v Source #

A discrete event, that occurs at particular points in time.

Constructors

Event v (Stream Bool) 

Instances

Instances details
Output SerialDevice (Event () [FormatOutput]) Source # 
Instance details

Defined in Copilot.Arduino.Library.Serial.Device

Output RandomSeed (Event () (Stream Word8)) Source # 
Instance details

Defined in Copilot.Arduino.Library.Random

Methods

(=:) :: RandomSeed -> Event () (Stream Word8) -> Sketch () Source #

Output RandomSeed (Event () (Stream ADC)) Source # 
Instance details

Defined in Copilot.Arduino.Library.Random

Methods

(=:) :: RandomSeed -> Event () (Stream ADC) -> Sketch () Source #

EEPROMable t => Output (Range t) (Event () (RangeWrites t)) Source # 
Instance details

Defined in Copilot.Arduino.Library.EEPROMex

Methods

(=:) :: Range t -> Event () (RangeWrites t) -> Sketch () Source #

EEPROMable t => Output (Location t) (Event () (Stream t)) Source # 
Instance details

Defined in Copilot.Arduino.Library.EEPROMex

Methods

(=:) :: Location t -> Event () (Stream t) -> Sketch () Source #

IsPWMPin t => Output (Pin t) (Event 'PWM (Stream Word8)) Source # 
Instance details

Defined in Copilot.Arduino.Internals

Methods

(=:) :: Pin t -> Event 'PWM (Stream Word8) -> Sketch () Source #

IsDigitalIOPin t => Output (Pin t) (Event () (Stream Bool)) Source # 
Instance details

Defined in Copilot.Arduino.Internals

Methods

(=:) :: Pin t -> Event () (Stream Bool) -> Sketch () Source #

newtype Sketch t 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.

Instances

Instances details
Monad Sketch Source # 
Instance details

Defined in Copilot.Arduino.Internals

Methods

(>>=) :: Sketch a -> (a -> Sketch b) -> Sketch b #

(>>) :: Sketch a -> Sketch b -> Sketch b #

return :: a -> Sketch a #

Functor Sketch Source # 
Instance details

Defined in Copilot.Arduino.Internals

Methods

fmap :: (a -> b) -> Sketch a -> Sketch b #

(<$) :: a -> Sketch b -> Sketch a #

Applicative Sketch Source # 
Instance details

Defined in Copilot.Arduino.Internals

Methods

pure :: a -> Sketch a #

(<*>) :: Sketch (a -> b) -> Sketch a -> Sketch b #

liftA2 :: (a -> b -> c) -> Sketch a -> Sketch b -> Sketch c #

(*>) :: Sketch a -> Sketch b -> Sketch b #

(<*) :: Sketch a -> Sketch b -> Sketch a #

MonadState UniqueIds Sketch Source # 
Instance details

Defined in Copilot.Arduino.Internals

Methods

get :: Sketch UniqueIds #

put :: UniqueIds -> Sketch () #

state :: (UniqueIds -> (a, UniqueIds)) -> Sketch a #

IfThenElse Sketch () Source # 
Instance details

Defined in Copilot.Arduino

Methods

ifThenElse :: Behavior Bool -> Sketch () -> Sketch () -> Sketch () Source #

Typed a => IfThenElse Sketch (Behavior a) Source # 
Instance details

Defined in Copilot.Arduino

Semigroup (Sketch t) Source # 
Instance details

Defined in Copilot.Arduino.Internals

Methods

(<>) :: Sketch t -> Sketch t -> Sketch t #

sconcat :: NonEmpty (Sketch t) -> Sketch t #

stimes :: Integral b => b -> Sketch t -> Sketch t #

Monoid (Sketch ()) Source # 
Instance details

Defined in Copilot.Arduino.Internals

Methods

mempty :: Sketch () #

mappend :: Sketch () -> Sketch () -> Sketch () #

mconcat :: [Sketch ()] -> Sketch () #

MonadWriter [(TriggerLimit -> Spec, TriggerLimit -> Framework)] Sketch Source # 
Instance details

Defined in Copilot.Arduino.Internals

newtype UniqueIds Source #

Constructors

UniqueIds (Map String Integer) 

Instances

Instances details
MonadState UniqueIds Sketch Source # 
Instance details

Defined in Copilot.Arduino.Internals

Methods

get :: Sketch UniqueIds #

put :: UniqueIds -> Sketch () #

state :: (UniqueIds -> (a, UniqueIds)) -> Sketch a #

newtype UniqueId Source #

Constructors

UniqueId Integer 

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.)

getUniqueId :: String -> Sketch UniqueId Source #

Gets a unique id.

uniqueName :: String -> UniqueId -> String Source #

Generates a unique name.

data Framework Source #

The framework of an Arduino sketch.

Constructors

Framework 

Fields

newtype CLine Source #

A line of C code.

Constructors

CLine 

Fields

Instances

Instances details
Eq CLine Source # 
Instance details

Defined in Copilot.Arduino.Internals

Methods

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

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

Ord CLine Source # 
Instance details

Defined in Copilot.Arduino.Internals

Methods

compare :: CLine -> CLine -> Ordering #

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

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

(>) :: CLine -> CLine -> Bool #

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

max :: CLine -> CLine -> CLine #

min :: CLine -> CLine -> CLine #

Show CLine Source # 
Instance details

Defined in Copilot.Arduino.Internals

Methods

showsPrec :: Int -> CLine -> ShowS #

show :: CLine -> String #

showList :: [CLine] -> ShowS #

newtype CChunk Source #

A chunk of C code. Identical chunks get deduplicated.

Constructors

CChunk [CLine] 

Instances

Instances details
Eq CChunk Source # 
Instance details

Defined in Copilot.Arduino.Internals

Methods

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

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

Ord CChunk Source # 
Instance details

Defined in Copilot.Arduino.Internals

Show CChunk Source # 
Instance details

Defined in Copilot.Arduino.Internals

Semigroup CChunk Source # 
Instance details

Defined in Copilot.Arduino.Internals

Monoid CChunk Source # 
Instance details

Defined in Copilot.Arduino.Internals

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 #

Constructors

InputSource 

Fields

newtype Pin t Source #

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.

Constructors

Pin PinId 

Instances

Instances details
Eq (Pin t) Source # 
Instance details

Defined in Copilot.Arduino.Internals

Methods

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

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

Ord (Pin t) Source # 
Instance details

Defined in Copilot.Arduino.Internals

Methods

compare :: Pin t -> Pin t -> Ordering #

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

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

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

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

max :: Pin t -> Pin t -> Pin t #

min :: Pin t -> Pin t -> Pin t #

Show (Pin t) Source # 
Instance details

Defined in Copilot.Arduino.Internals

Methods

showsPrec :: Int -> Pin t -> ShowS #

show :: Pin t -> String #

showList :: [Pin t] -> ShowS #

IsAnalogInputPin t => Input (Pin t) ADC Source # 
Instance details

Defined in Copilot.Arduino.Internals

Methods

input' :: Pin t -> [ADC] -> Sketch (Behavior ADC) Source #

IsDigitalIOPin t => Input (Pin t) Bool Source # 
Instance details

Defined in Copilot.Arduino.Internals

Methods

input' :: Pin t -> [Bool] -> Sketch (Behavior Bool) Source #

IsPWMPin t => Output (Pin t) (Event 'PWM (Stream Word8)) Source # 
Instance details

Defined in Copilot.Arduino.Internals

Methods

(=:) :: Pin t -> Event 'PWM (Stream Word8) -> Sketch () Source #

IsDigitalIOPin t => Output (Pin t) (Event () (Stream Bool)) Source # 
Instance details

Defined in Copilot.Arduino.Internals

Methods

(=:) :: Pin t -> Event () (Stream Bool) -> Sketch () Source #

newtype PinId Source #

Constructors

PinId Int16 

Instances

Instances details
Eq PinId Source # 
Instance details

Defined in Copilot.Arduino.Internals

Methods

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

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

Ord PinId Source # 
Instance details

Defined in Copilot.Arduino.Internals

Methods

compare :: PinId -> PinId -> Ordering #

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

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

(>) :: PinId -> PinId -> Bool #

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

max :: PinId -> PinId -> PinId #

min :: PinId -> PinId -> PinId #

Show PinId Source # 
Instance details

Defined in Copilot.Arduino.Internals

Methods

showsPrec :: Int -> PinId -> ShowS #

show :: PinId -> String #

showList :: [PinId] -> ShowS #

data PinCapabilities Source #

Constructors

DigitalIO 
AnalogInput 
PWM 

Instances

Instances details
Eq PinCapabilities Source # 
Instance details

Defined in Copilot.Arduino.Internals

Ord PinCapabilities Source # 
Instance details

Defined in Copilot.Arduino.Internals

Show PinCapabilities Source # 
Instance details

Defined in Copilot.Arduino.Internals

IsAnalogInputPin t => Input (Pin t) ADC Source # 
Instance details

Defined in Copilot.Arduino.Internals

Methods

input' :: Pin t -> [ADC] -> Sketch (Behavior ADC) Source #

IsDigitalIOPin t => Input (Pin t) Bool Source # 
Instance details

Defined in Copilot.Arduino.Internals

Methods

input' :: Pin t -> [Bool] -> Sketch (Behavior Bool) Source #

IsPWMPin t => Output (Pin t) (Event 'PWM (Stream Word8)) Source # 
Instance details

Defined in Copilot.Arduino.Internals

Methods

(=:) :: Pin t -> Event 'PWM (Stream Word8) -> Sketch () Source #

IsDigitalIOPin t => Output (Pin t) (Event () (Stream Bool)) Source # 
Instance details

Defined in Copilot.Arduino.Internals

Methods

(=:) :: Pin t -> Event () (Stream Bool) -> Sketch () Source #

type family IsDigitalIOPin t where ... Source #

Equations

IsDigitalIOPin t = 'True ~ If (HasPinCapability 'DigitalIO t) 'True (TypeError ('Text "This Pin does not support digital IO")) 

type family IsAnalogInputPin t where ... Source #

Equations

IsAnalogInputPin t = 'True ~ If (HasPinCapability 'AnalogInput t) 'True (TypeError ('Text "This Pin does not support analog input")) 

type family IsPWMPin t where ... Source #

Equations

IsPWMPin t = 'True ~ If (HasPinCapability 'PWM t) 'True (TypeError ('Text "This Pin does not support PWM")) 

type family HasPinCapability (c :: t) (list :: [t]) :: Bool where ... Source #

Equations

HasPinCapability c '[] = 'False 
HasPinCapability c (x ': xs) = SameCapability c x || HasPinCapability c xs 

data PinMode Source #

Instances

Instances details
Eq PinMode Source # 
Instance details

Defined in Copilot.Arduino.Internals

Methods

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

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

Ord PinMode Source # 
Instance details

Defined in Copilot.Arduino.Internals

Show PinMode Source # 
Instance details

Defined in Copilot.Arduino.Internals

class Output o t where Source #

Things that can have a Behavior or Event output to them.

Methods

(=:) :: 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

Instances details
Output o (Event () (Stream v)) => Output o (Behavior v) Source # 
Instance details

Defined in Copilot.Arduino.Internals

Methods

(=:) :: o -> Behavior v -> Sketch () Source #

Output SerialDevice [FormatOutput] Source # 
Instance details

Defined in Copilot.Arduino.Library.Serial.Device

Output o (Event p (Stream v)) => Output o (TypedBehavior p v) Source # 
Instance details

Defined in Copilot.Arduino.Internals

Methods

(=:) :: o -> TypedBehavior p v -> Sketch () Source #

Output SerialDevice (Event () [FormatOutput]) Source # 
Instance details

Defined in Copilot.Arduino.Library.Serial.Device

Output RandomSeed (Event () (Stream Word8)) Source # 
Instance details

Defined in Copilot.Arduino.Library.Random

Methods

(=:) :: RandomSeed -> Event () (Stream Word8) -> Sketch () Source #

Output RandomSeed (Event () (Stream ADC)) Source # 
Instance details

Defined in Copilot.Arduino.Library.Random

Methods

(=:) :: RandomSeed -> Event () (Stream ADC) -> Sketch () Source #

EEPROMable t => Output (Range t) (RangeWrites t) Source # 
Instance details

Defined in Copilot.Arduino.Library.EEPROMex

Methods

(=:) :: Range t -> RangeWrites t -> Sketch () Source #

EEPROMable t => Output (Range t) (Event () (RangeWrites t)) Source # 
Instance details

Defined in Copilot.Arduino.Library.EEPROMex

Methods

(=:) :: Range t -> Event () (RangeWrites t) -> Sketch () Source #

EEPROMable t => Output (Location t) (Event () (Stream t)) Source # 
Instance details

Defined in Copilot.Arduino.Library.EEPROMex

Methods

(=:) :: Location t -> Event () (Stream t) -> Sketch () Source #

IsPWMPin t => Output (Pin t) (Event 'PWM (Stream Word8)) Source # 
Instance details

Defined in Copilot.Arduino.Internals

Methods

(=:) :: Pin t -> Event 'PWM (Stream Word8) -> Sketch () Source #

IsDigitalIOPin t => Output (Pin t) (Event () (Stream Bool)) Source # 
Instance details

Defined in Copilot.Arduino.Internals

Methods

(=:) :: Pin t -> Event () (Stream Bool) -> Sketch () Source #

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

Instances details
type BehaviorToEvent [FormatOutput] Source # 
Instance details

Defined in Copilot.Arduino.Library.Serial.Device

type BehaviorToEvent (Behavior v) Source # 
Instance details

Defined in Copilot.Arduino.Internals

type BehaviorToEvent (RangeWrites t) Source # 
Instance details

Defined in Copilot.Arduino.Library.EEPROMex

type BehaviorToEvent (TypedBehavior p v) Source # 
Instance details

Defined in Copilot.Arduino.Internals

class IsBehavior behavior where Source #

Methods

(@:) :: behavior -> Behavior Bool -> BehaviorToEvent behavior Source #

Generate an Event, from some type of behavior, that only occurs when the Behavior Bool is True.

class Input o t where Source #

Methods

input' :: o -> [t] -> Sketch (Behavior t) Source #

The list is input to use when simulating the Sketch.

Instances

Instances details
Input ClockMicros Word32 Source # 
Instance details

Defined in Copilot.Arduino

Input ClockMillis Word32 Source # 
Instance details

Defined in Copilot.Arduino

Input SerialDevice Int8 Source # 
Instance details

Defined in Copilot.Arduino.Library.Serial.Device

Input RandomInput Word32 Source # 
Instance details

Defined in Copilot.Arduino.Library.Random

(ShowCType t, EEPROMable t) => Input (RangeReads t) t Source # 
Instance details

Defined in Copilot.Arduino.Library.EEPROMex

Methods

input' :: RangeReads t -> [t] -> Sketch (Behavior t) Source #

IsAnalogInputPin t => Input (Pin t) ADC Source # 
Instance details

Defined in Copilot.Arduino.Internals

Methods

input' :: Pin t -> [ADC] -> Sketch (Behavior ADC) Source #

IsDigitalIOPin t => Input (Pin t) Bool Source # 
Instance details

Defined in Copilot.Arduino.Internals

Methods

input' :: Pin t -> [Bool] -> Sketch (Behavior 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)

type ADC = Int16 Source #

Value read from an Arduino's ADC. Ranges from 0-1023.

class ShowCType t where Source #

Methods

showCType :: Proxy t -> String Source #

Instances

Instances details
ShowCType Bool Source # 
Instance details

Defined in Copilot.Arduino.Internals

ShowCType Double Source # 
Instance details

Defined in Copilot.Arduino.Internals

ShowCType Float Source # 
Instance details

Defined in Copilot.Arduino.Internals

ShowCType Int8 Source # 
Instance details

Defined in Copilot.Arduino.Internals

ShowCType Int16 Source # 
Instance details

Defined in Copilot.Arduino.Internals

ShowCType Int32 Source # 
Instance details

Defined in Copilot.Arduino.Internals

ShowCType Int64 Source # 
Instance details

Defined in Copilot.Arduino.Internals

ShowCType Word8 Source # 
Instance details

Defined in Copilot.Arduino.Internals

ShowCType Word16 Source # 
Instance details

Defined in Copilot.Arduino.Internals

ShowCType Word32 Source # 
Instance details

Defined in Copilot.Arduino.Internals

ShowCType Word64 Source # 
Instance details

Defined in Copilot.Arduino.Internals