{-# LANGUAGE RebindableSyntax #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Copilot.Arduino (
arduino,
Sketch,
Pin,
Behavior,
TypedBehavior(..),
Event,
(@:),
Input,
input,
input',
pullup,
millis,
micros,
Output,
led,
(=:),
pwm,
delay,
ADC,
MilliSeconds(..),
MicroSeconds(..),
ClockMillis,
ClockMicros,
IsDigitalIOPin,
IsAnalogInputPin,
IsPWMPin,
blinking,
firstIteration,
frequency,
sketchSpec,
liftB,
liftB2,
whenB,
scheduleB,
ifThenElse,
IfThenElse,
Stream,
module X,
) where
import Language.Copilot as X hiding (Stream, ifThenElse)
import Language.Copilot (Stream)
import qualified Language.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
blinking :: Behavior Bool
blinking = clk (period (2 :: Integer)) (phase (1 :: Integer))
firstIteration :: Behavior Bool
firstIteration = [True]++false
frequency :: Integer -> Behavior Bool
frequency n = clk (period n) (phase 1)
data MilliSeconds = MilliSeconds (Stream Word32)
data MicroSeconds = MicroSeconds (Stream Word32)
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]
millis :: ClockMillis
millis = ClockMillis
micros :: ClockMicros
micros = ClockMicros
data ClockMillis = ClockMillis
data ClockMicros = ClockMicros
instance Input ClockMillis Word32 where
input' ClockMillis = inputClock "millis"
instance Input ClockMicros Word32 where
input' ClockMicros = inputClock "micros"
inputClock :: [Char] -> [Word32] -> Sketch (Behavior Word32)
inputClock src interpretvalues = mkInput $ InputSource
{ setupInput = []
, defineVar = mkCChunk
[CLine $ showCType (Proxy @Word32) <> " " <> varname <>";"]
, inputPinmode = mempty
, readInput = mkCChunk
[CLine $ varname <> " = " <> src <> "();"]
, inputStream = extern varname interpretvalues'
}
where
varname = "clock_" <> src
interpretvalues'
| null interpretvalues = Nothing
| otherwise = Just interpretvalues
pullup :: IsDigitalIOPin t => Pin t -> Sketch ()
pullup (Pin p) = tell [(\_ -> return (), \_ -> f)]
where
f = mempty
{ pinmodes = M.singleton p (S.singleton InputPullupMode)
}
pwm :: Behavior Word8 -> TypedBehavior 'PWM Word8
pwm = TypedBehavior
led :: Pin '[ 'DigitalIO ]
led = Pin (PinId 13)
class IfThenElse t a where
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
scheduleB :: (Typed t, Eq t) => Behavior t -> [(t, Sketch ())] -> Sketch ()
scheduleB b = sequence_ . map go
where
go (v, s) = whenB (b == constant v) s
sketchSpec :: Sketch a -> Spec
sketchSpec = fromMaybe (return ()) . fst . evalSketch
liftB
:: (Behavior a -> Behavior r)
-> TypedBehavior t a
-> Behavior r
liftB f (TypedBehavior b) = f b
liftB2
:: (Behavior a -> Behavior b -> Behavior r)
-> TypedBehavior t a
-> TypedBehavior t b
-> Behavior r
liftB2 f (TypedBehavior a) (TypedBehavior b) = f a b