Copilot.hs

{-# LANGUAGE RebindableSyntax #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleInstances #-}

module Sketch.FRP.Copilot where

import Sketch.FRP.Copilot.Types
import Language.Copilot hiding (ifThenElse)
import qualified Language.Copilot
import Control.Monad.Writer
import Control.Monad.State.Strict
import Data.Functor.Identity

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

-- | Schedule when to perform different Sketches.
scheduleB
	:: (Typed t, Eq t, Context ctx)
	=> Behavior t
	-> [(t, GenSketch ctx ())]
	-> GenSketch ctx ()
scheduleB b = sequence_ . map go
  where
	go (v, s) = whenB (b == constant v) s

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

-- | 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 :: 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
	put ids'
	let (is, fs) = unzip w
	let spec = combinetl $ \c' -> sequence_ (map (\i -> i c') is)
	tell [(spec, mempty)]
	forM_ fs $ \f -> tell [(\_tl -> (return ()), combinetl f)]
	return r
  where
	combinetl :: (TriggerLimit -> a) -> TriggerLimit -> a
	combinetl g tl = g (TriggerLimit c <> tl)

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 Context ctx => IfThenElse (GenSketch ctx) () where
	ifThenElse c a b = do
		whenB c a
		whenB (not c) b

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
		return $ Language.Copilot.ifThenElse c ra rb

-- | Use this to read a value from a component of the board.
--
-- 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 a pin may
-- support 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 ctx o t => o -> GenSketch ctx (Behavior t)
input o = input' o []

-- | A stream of milliseconds.
data MilliSeconds = MilliSeconds (Stream Word32)

-- | A stream of microseconds.
data MicroSeconds = MicroSeconds (Stream Word32)

data Delay = Delay

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