sketch-frp-copilot 1.0.0 → 1.0.1

raw patch · 5 files changed

+47/−37 lines, 5 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• CHANGELOG +7/−0
• sketch-frp-copilot.cabal +1/−1
• src/Sketch/FRP/Copilot.hs +7/−7
• src/Sketch/FRP/Copilot/Internals.hs +13/−13
• src/Sketch/FRP/Copilot/Types.hs +19/−16

@@ -1,3 +1,10 @@+sketch-frp-copilot (1.0.1) upstream; urgency=medium++  * Added the Context type class and improved the name of a type+    parameter from "pinid" to "ctx".++ -- Joey Hess <id@joeyh.name>  Mon, 14 Feb 2022 21:07:56 -0400+ sketch-frp-copilot (1.0.0) upstream; urgency=medium    * First release, factored out of arduino-copilot and zephyr-copilot.

@@ -1,5 +1,5 @@ Name: sketch-frp-copilot-Version: 1.0.0+Version: 1.0.1 Cabal-Version: >= 1.10 License: BSD3 Maintainer: Joey Hess <id@joeyh.name>

@@ -38,10 +38,10 @@  -- | Schedule when to perform different Sketches. scheduleB-	:: (Typed t, Eq t, Ord pinid)+	:: (Typed t, Eq t, Context ctx) 	=> Behavior t-	-> [(t, GenSketch pinid ())]-	-> GenSketch pinid ()+	-> [(t, GenSketch ctx ())]+	-> GenSketch ctx () scheduleB b = sequence_ . map go   where 	go (v, s) = whenB (b == constant v) s@@ -76,7 +76,7 @@ -- (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 :: Ord pinid => Behavior Bool -> GenSketch pinid t -> GenSketch pinid t+whenB :: Context ctx => Behavior Bool -> GenSketch ctx t -> GenSketch ctx t whenB c (GenSketch s) = do 	ids <- get 	let ((r, w), ids') = runIdentity $ runStateT (runWriterT s) ids@@ -108,12 +108,12 @@ 	ifThenElse c (TypedBehavior a) (TypedBehavior b) = 		TypedBehavior (ifThenElse c a b) -instance Ord pinid => IfThenElse (GenSketch pinid) () where+instance Context ctx => IfThenElse (GenSketch ctx) () where 	ifThenElse c a b = do 		whenB c a 		whenB (not c) b -instance (Ord pinid, Typed a) => IfThenElse (GenSketch pinid) (Behavior a) where+instance (Context ctx, Typed a) => IfThenElse (GenSketch ctx) (Behavior a) where 	ifThenElse c a b = do 		ra <- whenB c a 		rb <- whenB (not c) b@@ -133,7 +133,7 @@ -- data to read: -- -- > v <- input a0 :: Sketch (Behavior ADC)-input :: Input pinid o t => o -> GenSketch pinid (Behavior t)+input :: Input ctx o t => o -> GenSketch ctx (Behavior t) input o = input' o []  -- | A stream of milliseconds.

@@ -17,7 +17,7 @@ addTriggerLimit tl c = getTriggerLimit (tl <> TriggerLimit c)  -- | Gets a unique id.-getUniqueId :: String -> GenSketch pinid UniqueId+getUniqueId :: String -> GenSketch ctx UniqueId getUniqueId s = do 	UniqueIds m <- get 	let u = maybe 1 succ (M.lookup s m)@@ -35,10 +35,10 @@  -- | Use to create an empty framework.  ----- It helps to specify the type of pinid to use:+-- It helps to specify the type of context to use: ----- > (emptyFramework @PinId) { ... }-emptyFramework :: Ord pinid => GenFramework pinid+-- > (emptyFramework @Arduino) { ... }+emptyFramework :: Context ctx => GenFramework ctx emptyFramework = mempty  mkCChunk :: [CLine] -> [CChunk]@@ -50,15 +50,15 @@ -- used in a trigger. defineTriggerAlias 	:: String-	-> GenFramework pinid-	-> GenSketch pinid (GenFramework pinid, String)+	-> GenFramework ctx+	-> GenSketch ctx (GenFramework ctx, String) defineTriggerAlias = defineTriggerAlias' ""  defineTriggerAlias' 	:: String 	-> String-	-> GenFramework pinid-	-> GenSketch pinid (GenFramework pinid, String)+	-> GenFramework ctx+	-> GenSketch ctx (GenFramework ctx, String) defineTriggerAlias' suffix cfuncname f = do 	let basetname = if null suffix  		then cfuncname@@ -70,13 +70,13 @@ 		else mempty 	return (f { defines = define <> defines f }, triggername) -data MkInputSource pinid t = InputSource+data MkInputSource ctx 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+	, inputPinmode :: M.Map ctx PinMode 	-- ^ How pins are used by the input. 	, readInput :: [CChunk] 	-- ^ How to read a value from the input, this typically@@ -85,7 +85,7 @@ 	-- ^ How to use Copilot's extern to access the input values. 	} -mkInput :: MkInputSource pinid t -> GenSketch pinid (Behavior t)+mkInput :: MkInputSource ctx t -> GenSketch ctx (Behavior t) mkInput i = do 	u <- getUniqueId "input" 	tell [(mkspec u, f u)]@@ -122,7 +122,7 @@ 	mkspec _ NoTriggerLimit = return () 	mkspec u (TriggerLimit c) = trigger (triggername u) true [arg c] -evalSketch :: Ord pinid => GenSketch pinid a -> (Maybe Spec, GenFramework pinid)+evalSketch :: Context ctx => GenSketch ctx a -> (Maybe Spec, GenFramework ctx) evalSketch (GenSketch s) = (spec, f)   where 	(is, fs) = unzip $ @@ -139,5 +139,5 @@ -- -- This can be useful to intergrate with other libraries  -- such as copilot-theorem.-sketchSpec :: Ord pinid => GenSketch pinid a -> Spec+sketchSpec :: Context ctx => GenSketch ctx a -> Spec sketchSpec = fromMaybe (return ()) . fst . evalSketch

@@ -49,25 +49,27 @@ -- While it is a monad, a Sketch's outputs are not updated in any -- particular order, because Copilot does not guarantee any order. ----- This is a generalized Sketch that can operate on any type of pinid.-newtype GenSketch pinid t = GenSketch (WriterT [(TriggerLimit -> Spec, TriggerLimit -> GenFramework pinid)] (State UniqueIds) t)+-- This is a generalized Sketch that can operate on any type of context.+newtype GenSketch ctx t = GenSketch (WriterT [(TriggerLimit -> Spec, TriggerLimit -> GenFramework ctx)] (State UniqueIds) t) 	deriving  		( Monad 		, Applicative 		, Functor-		, MonadWriter [(TriggerLimit -> Spec, TriggerLimit -> GenFramework pinid)]+		, MonadWriter [(TriggerLimit -> Spec, TriggerLimit -> GenFramework ctx)] 		, MonadState UniqueIds 		) -instance Monoid (GenSketch pinid ()) where+instance Monoid (GenSketch ctx ()) where 	mempty = GenSketch (return ()) -instance Semigroup (GenSketch pinid t) where+instance Semigroup (GenSketch ctx t) where 	(GenSketch a) <> (GenSketch b) = GenSketch (a >> b) +class Ord ctx => Context ctx+ -- | Things that can have a `Behavior` or `Event` output to them.-class Output pinid o t where-	(=:) :: o -> t -> GenSketch pinid ()+class Output ctx o t where+	(=:) :: o -> t -> GenSketch ctx () 	-- ^ Connect a `Behavior` or `Event` to an `Output` 	--  	-- > led =: blinking@@ -94,39 +96,40 @@ -- Same fixity as =<< infixr 1 =: -instance Output pinid o (Event () (Stream v)) => Output pinid o (Behavior v) where+instance Output ctx o (Event () (Stream v)) => Output ctx o (Behavior v) where 	(=:) o b = o =: te 	  where 	  	te :: Event () (Stream v) 		te = Event b true -instance Output pinid o (Event p (Stream v)) => Output pinid o (TypedBehavior p v) where+instance Output ctx o (Event p (Stream v)) => Output ctx o (TypedBehavior p v) where 	(=:) o (TypedBehavior b) = o =: te 	  where 		te :: Event p (Stream v) 		te = Event b true -class Input pinid o t where+class Input ctx o t where 	-- | The list is input to use when simulating the Sketch.-	input' :: o -> [t] -> GenSketch pinid (Behavior t)+	input' :: o -> [t] -> GenSketch ctx (Behavior t)  -- | The framework of a sketch. ----- This is a generalized Framework that can operate on any type of pinid.-data GenFramework pinid = Framework+-- This is a generalized Framework that can operate on any type of+-- context.+data GenFramework ctx = 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)+	, pinmodes :: M.Map ctx (S.Set PinMode) 	-- ^ How pins are used. 	, loops :: [CChunk] 	-- ^ Things to run in `loop`. 	} -instance Ord pinid => Semigroup (GenFramework pinid) where+instance Context ctx => Semigroup (GenFramework ctx) where 	a <> b = Framework 		{ defines = defines a <> defines b 		, setups = setups a <> setups b@@ -135,7 +138,7 @@ 		, loops = loops a  <> loops b 		} -instance Ord pinid => Monoid (GenFramework pinid) where+instance Context ctx => Monoid (GenFramework ctx) where 	mempty = Framework mempty mempty mempty mempty mempty  newtype UniqueIds = UniqueIds (M.Map String Integer)