arduino-copilot 1.5.7 → 1.6.0

raw patch · 20 files changed

+99/−542 lines, 20 filesdep +sketch-frp-copilotPVP ok

version bump matches the API change (PVP)

Dependencies added: sketch-frp-copilot

API changes (from Hackage documentation)

Files

• CHANGELOG +10/−0
• Examples/Blink/stack.yaml +1/−0
• Examples/Button/Demo.hs +10/−13
• Examples/Button/stack.yaml +1/−0
• Examples/ButtonHold/stack.yaml +1/−0
• Examples/EEPROM/stack.yaml +1/−0
• Examples/EEPROMrange/stack.yaml +1/−0
• Examples/Random/stack.yaml +1/−0
• Examples/SerialPort/Demo.hs +2/−1
• Examples/SerialPort/stack.yaml +1/−0
• Examples/WaterHeater/Demo.hs +1/−1
• Examples/WaterHeater/stack.yaml +1/−0
• TODO +0/−28
• arduino-copilot.cabal +2/−1
• src/Copilot/Arduino.hs +17/−133
• src/Copilot/Arduino/Internals.hs +37/−355
• src/Copilot/Arduino/Library/EEPROMex.hs +4/−4
• src/Copilot/Arduino/Library/Random.hs +3/−3
• src/Copilot/Arduino/Library/Serial/Device.hs +4/−3
• stack.yaml +1/−0

@@ -1,3 +1,13 @@+arduino-copilot (1.6.0) unstable; urgency=medium++  * Refactored non-Arduino-specific code into sketch-frp-copilot.+  * Code that refers to Input or Output may need to change to parameterize+    it with Pinid. And code using Copilot.Arduino.Internals will need to be+    adapted in other ways due to other API changes in sketch-frp-copilot.+  * Fix bug in compiling Serial.char '\r'++ -- Joey Hess <id@joeyh.name>  Mon, 14 Feb 2022 15:26:09 -0400+ arduino-copilot (1.5.7) unstable; urgency=medium    * Update to copilot-3.7.

@@ -3,6 +3,7 @@ - '../..' resolver: lts-18.9 extra-deps: +- sketch-frp-copilot-1.0.0 - copilot-3.7 - copilot-c99-3.7 - copilot-core-3.7

@@ -4,21 +4,18 @@  import Copilot.Arduino.Uno -longer_and_longer :: Stream Word32-longer_and_longer = counter true $ counter true false `mod` 64 == 0--counter :: Stream Bool -> Stream Bool -> Stream Word32-counter inc reset = cnt-   where-	cnt = if reset-		then 0-		else if inc-			then z + 1-			else z-	z = [0] ++ cnt- main :: IO () main = arduino $ do 	buttonpressed <- input' pin12 [False, False, False, True, True] 	led =: buttonpressed || blinking 	delay =: MilliSeconds (longer_and_longer * 2)++longer_and_longer :: Stream Word32+longer_and_longer = counter $ counter false `mod` 64 == 0++counter :: Stream Bool -> Stream Word32+counter reset = s+   where+	s = if reset then 0 else z + 1+	z = [0] ++ s+

@@ -3,6 +3,7 @@ - '../..' resolver: lts-18.9 extra-deps: +- sketch-frp-copilot-1.0.0 - copilot-3.7 - copilot-c99-3.7 - copilot-core-3.7

@@ -3,6 +3,7 @@ - '../..' resolver: lts-18.9 extra-deps: +- sketch-frp-copilot-1.0.0 - copilot-3.7 - copilot-c99-3.7 - copilot-core-3.7

@@ -3,6 +3,7 @@ - '../..' resolver: lts-18.9 extra-deps: +- sketch-frp-copilot-1.0.0 - copilot-3.7 - copilot-c99-3.7 - copilot-core-3.7

@@ -3,6 +3,7 @@ - '../..' resolver: lts-18.9 extra-deps: +- sketch-frp-copilot-1.0.0 - copilot-3.7 - copilot-c99-3.7 - copilot-core-3.7

@@ -3,6 +3,7 @@ - '../..' resolver: lts-18.9 extra-deps: +- sketch-frp-copilot-1.0.0 - copilot-3.7 - copilot-c99-3.7 - copilot-core-3.7

@@ -21,7 +21,7 @@ userIsTyping :: Behavior Int8 -> Behavior Bool userIsTyping userinput = userinput /= constant Serial.noInput -getSerial :: Input o Int8 => Bool -> o -> Sketch (Behavior Int8)+getSerial :: Input PinId o Int8 => Bool -> o -> Sketch (Behavior Int8) getSerial True i = input' i (repeat Serial.noInput) getSerial False _ = return (constant Serial.noInput) @@ -41,6 +41,7 @@ 		, Serial.showFormatted n Serial.HEX 		, Serial.str " millis:" 		, Serial.show c+		, Serial.char '\r' 		, Serial.char '\n' 		] 	when useSerial $ Serial.device =: msg

@@ -3,6 +3,7 @@ - '../..' resolver: lts-18.9 extra-deps: +- sketch-frp-copilot-1.0.0 - copilot-3.7 - copilot-c99-3.7 - copilot-core-3.7

@@ -47,7 +47,7 @@  -- Convert a raw value read from an ADC into a PSI. ----- Assumes the ADCI value is 0 at 0 PSI, and 1024 at 150 PSI.+-- Assumes the ADC value is 0 at 0 PSI, and 1024 at 150 PSI. adcToPSI :: Behavior ADC -> TypedBehavior PSI Float adcToPSI v = TypedBehavior $ v' * (constant 150 / constant 1024)   where

@@ -3,6 +3,7 @@ - '../..' resolver: lts-18.9 extra-deps: +- sketch-frp-copilot-1.0.0 - copilot-3.7 - copilot-c99-3.7 - copilot-core-3.7

@@ -32,34 +32,6 @@   facilities for operating on Array are limited so it could be useful to   have a Range interface too. -* liftB and liftB2 imply liftB[3..5] at least ought to exist.--  Really, want something like Applicative. But apparently TypedBehavior-  is not a Functor, and so cannot be Applicative. There might be some-  way to use type classes to do arbitrary arity lifting. Take a look-  at QuickCheck and printf for ideas. Also see-  https://www.seas.upenn.edu/~sweirich/papers/aritygen--  Alternative might be to wrap all of Copilot DSL's functions like (>)-  with ones that operate on TypedBehavior and Event. -  (Then rename TypedBehavior to Behavior and make everything produce-  and consume that, rather than the underlying Stream?)--  Alternativly, copilot could be improved, see-  https://github.com/Copilot-Language/copilot/issues/56-  https://github.com/Copilot-Language/copilot/issues/59--* using whenB with an input' makes the interpretation see-  each value from the list, even when the whenB is supposed to prevent the-  input' from having run, and the value should be whatever was input-  previously. This may not be fixable w/o Copilot DSL support-  for limiting when inputs happen, at least as far as what the interpreter-  displays as values of the input goes. But, it should be fixable-  as far as the value that is input, at least in theory, by ignoring-  the input values that should not have been input. The  Copilot-  DSL code used to do that may increase the size of the C program-  unncessarily though.- * The way serial output works is somewhat unsatisfying, because   it does not take a Stream FormatOutput. So the Copilot DSL can't be used   to adjust the output format as the arduino runs; it's fixed at compile

@@ -1,5 +1,5 @@ Name: arduino-copilot-Version: 1.5.7+Version: 1.6.0 Cabal-Version: >= 1.10 License: BSD3 Maintainer: Joey Hess <id@joeyh.name>@@ -114,6 +114,7 @@     Copilot.Arduino.Main   Build-Depends:     base (>= 4.5 && < 5),+    sketch-frp-copilot (== 1.0.0),     copilot (== 3.7.*),     copilot-c99 (== 3.7.*),     copilot-language (== 3.7.*),

@@ -49,6 +49,7 @@ 	IsDigitalIOPin, 	IsAnalogInputPin, 	IsPWMPin,+	PinId, 	-- * Utilities 	blinking, 	firstIteration,@@ -78,74 +79,14 @@  import Language.Copilot as X hiding (Stream, ifThenElse) import Language.Copilot (Stream)-import qualified Language.Copilot+import Sketch.FRP.Copilot import Copilot.Arduino.Internals import Copilot.Arduino.Main import Control.Monad.Writer import Data.Proxy-import Data.Maybe import qualified Data.Map as M import qualified Data.Set as S --- | Use this to make a LED blink on and off.------ On each iteration of the `Sketch`, this changes to the opposite of its--- previous value.------ This is implemented using Copilot's `clk`, so to get other blinking--- behaviors, just pick different numbers, or use Copilot `Stream`--- combinators.--- --- > blinking = clk (period 2) (phase 1)-blinking :: Behavior Bool-blinking = clk (period (2 :: Integer)) (phase (1 :: Integer))---- | True on the first iteration of the `Sketch`, and False thereafter.-firstIteration :: Behavior Bool-firstIteration = [True]++false---- | Use this to make an event occur 1 time out of n.------ This is implemented using Copilot's `clk`:------ > frequency = clk (period n) (phase 1)-frequency :: Integer -> Behavior Bool-frequency n = clk (period n) (phase 1)---- | A stream of milliseconds.-data MilliSeconds = MilliSeconds (Stream Word32)---- | A stream of microseconds.-data MicroSeconds = MicroSeconds (Stream Word32)---- | Use this to add a delay between each iteration of the `Sketch`.--- A `Sketch` with no delay will run as fast as the hardware can run it.------ > delay := MilliSeconds (constant 100)-delay :: Delay-delay = Delay--data Delay = Delay--instance Output Delay MilliSeconds where-	Delay =: (MilliSeconds n) = do-		(f, triggername) <- defineTriggerAlias "delay" mempty-		tell [(go triggername, \_ -> f)]-	  where-		go triggername tl =-			let c = getTriggerLimit tl-			in trigger triggername c [arg n]--instance Output Delay MicroSeconds where-	Delay =: (MicroSeconds n) = do-		(f, triggername) <- defineTriggerAlias "delayMicroseconds" mempty-		tell [(go triggername, \_ -> f)]-	  where-		go triggername tl = -			let c = getTriggerLimit tl-			in trigger triggername c [arg n]-- -- | Number of MillisSeconds since the Arduino booted. -- -- > n <- input millis@@ -165,10 +106,10 @@ data ClockMillis = ClockMillis data ClockMicros = ClockMicros -instance Input ClockMillis Word32 where+instance Input PinId ClockMillis Word32 where 	input' ClockMillis = inputClock "millis" -instance Input ClockMicros Word32 where+instance Input PinId ClockMicros Word32 where 	input' ClockMicros = inputClock "micros"  inputClock :: [Char] -> [Word32] -> Sketch (Behavior Word32)@@ -187,21 +128,6 @@ 		| null interpretvalues = Nothing 		| otherwise = Just interpretvalues --- | Normally when a digital value is read from a `Pin`, it is configured--- without the internal pullup resistor being enabled. Use this to enable--- the pullup register for all reads from the `Pin`.------ Bear in mind that enabling the pullup resistor inverts the value that--- will be read from the pin.------ > pullup pin12-pullup :: IsDigitalIOPin t => Pin t -> Sketch ()-pullup (Pin p) = tell [(\_ -> return (), \_ -> f)]-  where-	f = mempty-		{ pinmodes = M.singleton p (S.singleton InputPullupMode)-		}- -- | Use this to do PWM output to a pin. -- -- > pin3 =: pwm (constant 128)@@ -215,59 +141,17 @@ led :: Pin '[ 'DigitalIO ] led = Pin (PinId 13) -class IfThenElse t a where-	-- | This allows "if then else" expressions to be written-	-- that choose between two Streams, or Behaviors, or TypedBehaviors,-	-- or Sketches, when the RebindableSyntax language extension is-	-- enabled.-	---	-- > {-# LANGUAGE RebindableSyntax #-}-	-- > buttonpressed <- input pin3-	-- > if buttonpressed then ... else ...-	ifThenElse :: Behavior Bool -> t a -> t a -> t a--instance Typed a => IfThenElse Stream a where-	ifThenElse = Language.Copilot.ifThenElse--instance Typed a => IfThenElse (TypedBehavior p) a where-	ifThenElse c (TypedBehavior a) (TypedBehavior b) =-		TypedBehavior (ifThenElse c a b)--instance IfThenElse Sketch () where-	ifThenElse c a b = do-		whenB c a-		whenB (not c) b--instance Typed a => IfThenElse Sketch (Behavior a) where-	ifThenElse c a b = do-		ra <- whenB c a-		rb <- whenB (not c) b-		return $ Language.Copilot.ifThenElse c ra rb---- | Schedule when to perform different Sketches.-scheduleB :: (Typed t, Eq t) => Behavior t -> [(t, Sketch ())] -> Sketch ()-scheduleB b = sequence_ . map go-  where-	go (v, s) = whenB (b == constant v) s---- | Extracts a copilot `Spec` from a `Sketch`.+-- | Normally when a digital value is read from a `Pin`, it is configured+-- without the internal pullup resistor being enabled. Use this to enable+-- the pullup register for all reads from the `Pin`. ----- This can be useful to intergrate with other libraries --- such as copilot-theorem.-sketchSpec :: Sketch a -> Spec-sketchSpec = fromMaybe (return ()) . fst . evalSketch---- | Apply a Copilot DSL function to a `TypedBehavior`.-liftB-	:: (Behavior a -> Behavior r)-	-> TypedBehavior t a-	-> Behavior r-liftB f (TypedBehavior b) = f b---- | Apply a Copilot DSL function to two `TypedBehavior`s.-liftB2-	:: (Behavior a -> Behavior b -> Behavior r)-	-> TypedBehavior t a-	-> TypedBehavior t b-	-> Behavior r-liftB2 f (TypedBehavior a) (TypedBehavior b) = f a b+-- Bear in mind that enabling the pullup resistor inverts the value that+-- will be read from the pin.+--+-- > pullup pin12+pullup :: IsDigitalIOPin t => Pin t -> Sketch ()+pullup (Pin p) = tell [(\_ -> return (), \_ -> f)]+  where+	f = (emptyFramework @PinId)+		{ pinmodes = M.singleton p (S.singleton InputPullupMode)+		}

@@ -1,263 +1,41 @@ -- | You should not need to import this module unless you're adding support -- for a new model of Arduino, or an Arduino library. -{-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE PolyKinds #-}-{-# LANGUAGE TypeOperators #-}-{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeApplications #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE UndecidableInstances #-}-{-# LANGUAGE ScopedTypeVariables #-} -module Copilot.Arduino.Internals where+module Copilot.Arduino.Internals (+	module Copilot.Arduino.Internals,+	module X+) where +import Sketch.FRP.Copilot as X+import Sketch.FRP.Copilot.Types as X+import Sketch.FRP.Copilot.Internals as X import Language.Copilot import Control.Monad.Writer-import Control.Monad.State.Strict-import Data.Functor.Identity import qualified Data.Map as M import qualified Data.Set as S-import Data.Type.Bool import Data.Proxy-import GHC.TypeLits --- | A value that changes over time.------ This is implemented as a `Stream` in the Copilot DSL.--- Copilot provides many operations on streams, for example--- `Language.Copilot.&&` to combine two streams of Bools.--- --- For documentation on using the Copilot DSL, see--- <https://copilot-language.github.io/>-type Behavior t = Stream t---- | 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.-data TypedBehavior p t = TypedBehavior (Behavior t)---- | A discrete event, that occurs at particular points in time.-data Event p v = Event v (Stream Bool)- -- | 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.+-- board 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.-newtype Sketch t = Sketch (WriterT [(TriggerLimit -> Spec, TriggerLimit -> Framework)] (State UniqueIds) t)-	deriving -		( Monad-		, Applicative-		, Functor-		, MonadWriter [(TriggerLimit -> Spec, TriggerLimit -> Framework)]-		, MonadState UniqueIds-		)--instance Monoid (Sketch ()) where-	mempty = Sketch (return ())--instance Semigroup (Sketch t) where-	(Sketch a) <> (Sketch b) = Sketch (a >> b)--newtype UniqueIds = UniqueIds (M.Map String Integer)--newtype UniqueId = UniqueId Integer--data TriggerLimit-	= TriggerLimit (Behavior Bool)-	| NoTriggerLimit--getTriggerLimit :: TriggerLimit -> Behavior Bool-getTriggerLimit (TriggerLimit b) = b-getTriggerLimit NoTriggerLimit = true--addTriggerLimit :: TriggerLimit -> Behavior Bool -> Behavior Bool-addTriggerLimit tl c = getTriggerLimit (tl <> TriggerLimit c)--instance Monoid TriggerLimit where-	mempty = NoTriggerLimit--instance Semigroup TriggerLimit where-	TriggerLimit a <> TriggerLimit b =-		TriggerLimit (a Language.Copilot.&& b)-	a <> NoTriggerLimit = a-	NoTriggerLimit <> b = b--evalSketch :: Sketch a -> (Maybe Spec, Framework)-evalSketch (Sketch s) = (spec, f)-  where-	(is, fs) = unzip $ -		runIdentity $ evalStateT (execWriterT s) (UniqueIds mempty)-	f = mconcat (map (\f' -> f' NoTriggerLimit) fs)-	-- Copilot will throw an ugly error if given a spec that does-	-- nothing at all, so return Nothing to avoid that.-	spec :: Maybe Spec-	spec = if null is-		then Nothing-		else Just $ sequence_ $ map (\i -> i NoTriggerLimit) is---- | 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.)-whenB :: Behavior Bool -> Sketch t -> Sketch t-whenB c (Sketch s) = do-	ids <- get-	let ((r, w), ids') = runIdentity $ runStateT (runWriterT s) ids-	put ids'-	let (is, fs) = unzip w-	let spec = combinetl $ \c' -> sequence_ (map (\i -> i c') is)-	tell [(spec, mempty)]-	forM_ fs $ \f -> tell [(const (return ()), combinetl f)]-	return r-  where-	combinetl :: (TriggerLimit -> a) -> TriggerLimit -> a-	combinetl g tl = g (TriggerLimit c <> tl)---- | Gets a unique id.-getUniqueId :: String -> Sketch UniqueId-getUniqueId s = do-	UniqueIds m <- get-	let u = maybe 1 succ (M.lookup s m)-	put $ UniqueIds $ M.insert s u m-	return (UniqueId u)---- | Generates a unique name.-uniqueName :: String -> UniqueId -> String-uniqueName s (UniqueId i)-	| i Prelude.== 1 = s-	| otherwise = s <> "_" <>  show i--uniqueName' :: String -> UniqueId -> String-uniqueName' s (UniqueId i) = s <> "_" <>  show i---- | The framework of an Arduino sketch.-data Framework = Framework-	{ defines :: [CChunk]-	-- ^ Things that come before the C code generated by Copilot.-	, setups :: [CChunk]-	-- ^ Things to do at setup, not including configuring pins.-	, earlySetups :: [CChunk]-	-- ^ Things to do at setup, before the setups.-	, pinmodes :: M.Map PinId (S.Set PinMode)-	-- ^ How pins are used.-	, loops :: [CChunk]-	-- ^ Things to run in `loop`.-	}--instance Semigroup Framework where-	a <> b = Framework-		{ defines = defines a <> defines b-		, setups = setups a <> setups b-		, earlySetups = earlySetups a <> earlySetups b-		, pinmodes = M.unionWith S.union (pinmodes a) (pinmodes b)-		, loops = loops a  <> loops b-		}--instance Monoid Framework where-	mempty = Framework mempty mempty mempty mempty mempty---- | A line of C code.-newtype CLine = CLine { fromCLine :: String }-	deriving (Eq, Show, Ord)---- | A chunk of C code. Identical chunks get deduplicated.-newtype CChunk = CChunk [CLine]-	deriving (Eq, Show, Ord, Semigroup, Monoid)--mkCChunk :: [CLine] -> [CChunk]-mkCChunk l = [CChunk l]---- | 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.-defineTriggerAlias :: String -> Framework -> Sketch (Framework, String)-defineTriggerAlias = defineTriggerAlias' ""--defineTriggerAlias' :: String -> String -> Framework -> Sketch (Framework, String)-defineTriggerAlias' suffix cfuncname f = do-	let basetname = if null suffix -		then cfuncname-		else cfuncname <> "_" <> suffix-	u <- getUniqueId basetname-	let triggername = uniqueName basetname u-	let define = if cfuncname Prelude./= triggername-		then mkCChunk [ CLine $ "#define " <> triggername <> " " <> cfuncname	]-		else mempty-	return (f { defines = define <> defines f }, triggername)--data InputSource t = InputSource-	{ defineVar :: [CChunk]-	-- ^ Added to the `Framework`'s `defines`, this typically-	-- defines a C variable.-	, setupInput :: [CChunk]-	-- ^ How to set up the input, not including pin mode.-	, inputPinmode :: M.Map PinId PinMode-	-- ^ How pins are used by the input.-	, readInput :: [CChunk]-	-- ^ How to read a value from the input, this typically-	-- reads a value into a C variable.-	, inputStream :: Stream t-	-- ^ How to use Copilot's extern to access the input values.-	}--mkInput :: InputSource t -> Sketch (Behavior t)-mkInput i = do-	u <- getUniqueId "input"-	tell [(mkspec u, f u)]-	return (inputStream i)-  where-	f u ratelimited = Framework-		{ defines = defineVar i <> mkdefine u ratelimited-		, setups = setupInput i-		, earlySetups = mempty-		, pinmodes = M.map S.singleton (inputPinmode i)-		, loops = mkloops u ratelimited (readInput i)-		}--	varname = uniqueName "update_input"-	triggername = uniqueName "input"-	-	mkdefine _ NoTriggerLimit = []-	mkdefine u (TriggerLimit _) = mkCChunk $ map CLine-		[ "bool " <> varname u <> " = true;"-		, "void " <> triggername u <> " (bool v) {"-		, "  " <> varname u <> " = v;"-		, "}"-		]-	-	mkloops _ NoTriggerLimit reader = reader-	mkloops u (TriggerLimit _) reader = mkCChunk $ concat-		[ [ CLine $ "if (" <> varname u <> ") {" ]-		, map (\(CLine l) -> CLine $ "  " <> l ) readerlines-		, [ CLine "}" ]-		]-	  where-		readerlines = concatMap (\(CChunk l) -> l) reader+type Sketch = GenSketch PinId -	mkspec _ NoTriggerLimit = return ()-	mkspec u (TriggerLimit c) = trigger (triggername u) true [arg c]+-- | The framework of a sketch.+type Framework = GenFramework PinId  -- | A pin on the Arduino board. --@@ -273,112 +51,19 @@ newtype PinId = PinId Int16 	deriving (Show, Eq, Ord) -data PinCapabilities-	= DigitalIO-	| AnalogInput-	| PWM-	deriving (Show, Eq, Ord)--type family IsDigitalIOPin t where-	IsDigitalIOPin t = -		'True ~ If (HasPinCapability 'DigitalIO t)-			('True)-			(TypeError ('Text "This Pin does not support digital IO"))--type family IsAnalogInputPin t where-	IsAnalogInputPin t = -		'True ~ If (HasPinCapability 'AnalogInput t)-			('True)-			(TypeError ('Text "This Pin does not support analog input"))--type family IsPWMPin t where-	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-	HasPinCapability c '[] = 'False-	HasPinCapability c (x ': xs) = SameCapability c x || HasPinCapability c xs--type family SameCapability a b :: Bool where-	SameCapability 'DigitalIO 'DigitalIO = 'True-	SameCapability 'AnalogInput 'AnalogInput = 'True-	SameCapability 'PWM 'PWM = 'True-	SameCapability _ _ = 'False--data PinMode = InputMode | InputPullupMode | OutputMode-	deriving (Show, Eq, Ord)---- | Things that can have a `Behavior` or `Event` output to them.-class Output o t where-	(=:) :: o -> t -> Sketch ()-	-- ^ 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---- Same fixity as =<<-infixr 1 =:--instance Output o (Event () (Stream v)) => Output o (Behavior v) where-	(=:) o b = o =: te-	  where-	  	te :: Event () (Stream v)-		te = Event b true--instance Output o (Event p (Stream v)) => Output o (TypedBehavior p v) where-	(=:) o (TypedBehavior b) = o =: te-	  where-		te :: Event p (Stream v)-		te = Event b true---- | This type family is open, so it can be extended when adding other data--- types to the IsBehavior class.-type family BehaviorToEvent a-type instance BehaviorToEvent (Behavior v) = Event () (Stream v)-type instance BehaviorToEvent (TypedBehavior p v) = Event p (Stream v)--class IsBehavior behavior where-	-- | Generate an Event, from some type of behavior,-	-- that only occurs when the `Behavior` Bool is True.-	(@:) :: behavior -> Behavior Bool -> BehaviorToEvent behavior--instance IsBehavior (Behavior v) where-	b @: c = Event b c--instance IsBehavior (TypedBehavior p v) where-	(@:) (TypedBehavior b) c = Event b c--instance IsDigitalIOPin t => Output (Pin t) (Event () (Stream Bool)) where+instance IsDigitalIOPin t => Output PinId (Pin t) (Event () (Stream Bool)) where 	(Pin p@(PinId n)) =: (Event b c) = do 		(f, triggername) <- defineTriggerAlias' ("pin_" <> show n) "digitalWrite" $-			mempty { pinmodes = M.singleton p (S.singleton OutputMode) }+			(emptyFramework @PinId)+				{ pinmodes = M.singleton p (S.singleton OutputMode)+				} 		tell [(go triggername, const f)] 	  where 		go triggername tl =  			let c' = addTriggerLimit tl c 			in trigger triggername c' [arg (constant n), arg b] -instance IsPWMPin t => Output (Pin t) (Event 'PWM (Stream Word8)) where+instance IsPWMPin t => Output PinId (Pin t) (Event 'PWM (Stream Word8)) where 	(Pin (PinId n)) =: (Event v c) = do 		(f, triggername) <- defineTriggerAlias' ("pin_" <> show n) "analogWrite" mempty 		tell [(go triggername, const f)]@@ -388,28 +73,7 @@ 			in trigger triggername c' [arg (constant n), arg v] 		-- analogWrite does not need any pinmodes set up -class Input o t where-	-- | The list is input to use when simulating the Sketch.-	input' :: o -> [t] -> Sketch (Behavior t)---- | 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)-input :: Input o t => o -> Sketch (Behavior t)-input o = input' o []--instance IsDigitalIOPin t => Input (Pin t) Bool where+instance IsDigitalIOPin t => Input PinId (Pin t) Bool where 	input' (Pin p@(PinId n)) interpretvalues = mkInput $ InputSource 		{ defineVar = mkCChunk [CLine $ "bool " <> varname <> ";"] 		, setupInput = mempty@@ -427,7 +91,7 @@ -- | Value read from an Arduino's ADC. Ranges from 0-1023. type ADC = Int16 -instance IsAnalogInputPin t => Input (Pin t) ADC where+instance IsAnalogInputPin t => Input PinId (Pin t) ADC where 	input' (Pin (PinId n)) interpretvalues = mkInput $ InputSource 		{ defineVar = mkCChunk [CLine $ "int " <> varname <> ";"] 		, setupInput = mempty@@ -456,4 +120,22 @@ instance ShowCType Word64 where showCType _ = "uint64_t" instance ShowCType Float where showCType _ = "float" instance ShowCType Double where showCType _ = "double"++instance Output PinId Delay MilliSeconds where+	Delay =: (MilliSeconds n) = do+		(f, triggername) <- defineTriggerAlias "delay" mempty+		tell [(go triggername, \_ -> f)]+	  where+		go triggername tl =+			let c = getTriggerLimit tl+			in trigger triggername c [arg n]++instance Output PinId Delay MicroSeconds where+	Delay =: (MicroSeconds n) = do+		(f, triggername) <- defineTriggerAlias "delayMicroseconds" mempty+		tell [(go triggername, \_ -> f)]+	  where+		go triggername tl = +			let c = getTriggerLimit tl+			in trigger triggername c [arg n] 

@@ -192,7 +192,7 @@  data Location t = Location UniqueId -instance EEPROMable t => Output (Location t) (Event () (Stream t)) where+instance EEPROMable t => Output PinId (Location t) (Event () (Stream t)) where 	Location i =: (Event v c) = do 		(f, triggername) <- defineTriggerAlias (eepromWriterName i) mempty 		tell [(go triggername, \_ -> f)]@@ -257,10 +257,10 @@ -- instead they loop back to the start of the Range. type RangeIndex = Word16 -instance EEPROMable t => Output (Range t) (RangeWrites t) where+instance EEPROMable t => Output PinId (Range t) (RangeWrites t) where 	(=:) = writeRange true -instance EEPROMable t => Output (Range t) (Event () (RangeWrites t)) where+instance EEPROMable t => Output PinId (Range t) (Event () (RangeWrites t)) where 	range =: Event ws c =  		writeRange c range ws @@ -356,7 +356,7 @@ 	cnt = [startidx+1] ++ rest 	rest = cnt + 1 -instance (ShowCType t, EEPROMable t) => Input (RangeReads t) t where+instance (ShowCType t, EEPROMable t) => Input PinId (RangeReads t) t where 	input' (RangeReads range startidx idx) interpretvalues = do 		-- This trigger writes value of idx 		-- to indexvarname. The next time through the loop,

@@ -43,11 +43,11 @@  data RandomSeed = RandomSeed -instance Output RandomSeed (Event () (Stream Word8)) where+instance Output PinId RandomSeed (Event () (Stream Word8)) where 	RandomSeed =: e = randomSeedWith e  -- Seeds with the first 8 bits read from the ADC, discarding the rest.-instance Output RandomSeed (Event () (Stream ADC)) where+instance Output PinId RandomSeed (Event () (Stream ADC)) where 	RandomSeed =: e = randomSeedWith e  randomSeedWith :: Typed a => Event p (Stream a) -> Sketch ()@@ -82,7 +82,7 @@ randomR :: (Word32, Word32) -> RandomInput randomR (lo, hi) = RandomInput lo hi -instance Input RandomInput Word32 where+instance Input PinId RandomInput Word32 where 	input' (RandomInput lo hi) interpretvalues = do 		i <- getUniqueId "random" 		let varname = uniqueName "randomval" i

@@ -67,7 +67,7 @@  newtype SerialDevice = SerialDevice SerialDeviceName -instance Input SerialDevice Int8 where+instance Input PinId SerialDevice Int8 where 	input' (SerialDevice (SerialDeviceName devname)) interpretvalues = 		mkInput s 	  where@@ -89,10 +89,10 @@ noInput :: Int8 noInput = -1 -instance Output SerialDevice [FormatOutput] where+instance Output PinId SerialDevice [FormatOutput] where 	sdn =: l = sdn =: (Event l true :: Event () [FormatOutput]) -instance Output SerialDevice (Event () [FormatOutput]) where+instance Output PinId SerialDevice (Event () [FormatOutput]) where 	SerialDevice sdn@(SerialDeviceName devname) =: (Event l c) = do 		u <- getUniqueId "serial" 		let outputfuncname = uniqueName ("output_" <> devname) u@@ -136,6 +136,7 @@   where 	esc '\'' = "\\\'" 	esc '\\' = "\\\\"+	esc '\r' = "\\r" 	esc '\n' = "\\n" 	esc c' = [c'] 

@@ -2,6 +2,7 @@ - '.' resolver: lts-18.9 extra-deps:+- sketch-frp-copilot-1.0.0 - copilot-3.7 - copilot-c99-3.7 - copilot-core-3.7