{-# LANGUAGE RebindableSyntax #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE UndecidableInstances #-}
module Copilot.Arduino (
arduino,
Sketch,
Pin,
Behavior,
Event,
(@:),
Input,
readfrom,
readfrom',
pullup,
Voltage,
readvoltage,
readvoltage',
Output,
led,
(=:),
PWMDutyCycle(..),
delay,
MilliSeconds(..),
MicroSeconds(..),
blinking,
firstIteration,
sketchSpec,
Stream,
module X,
) where
import Language.Copilot as X hiding (Stream)
import Language.Copilot (Stream)
import Copilot.Arduino.Internals
import Copilot.Arduino.Main
import Control.Monad.Writer
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
data MilliSeconds = MilliSeconds (Stream Word16)
data MicroSeconds = MicroSeconds (Stream Word16)
delay :: Delay
delay = Delay
data Delay = Delay
instance Output Delay MilliSeconds where
Delay =: (MilliSeconds n) = tell
[(trigger "delay" true [arg n], mempty)]
instance Output Delay MicroSeconds where
Delay =: (MicroSeconds n) = tell
[(trigger "delayMicroseconds" true [arg n], mempty)]
readfrom :: IsDigitalIOPin t => Pin t -> Input Bool
readfrom p = readfrom' p []
readfrom' :: IsDigitalIOPin t => Pin t -> [Bool] -> Input Bool
readfrom' (Pin p@(PinId n)) interpretvalues = mkInput $ InputSource
{ defineVar = [CLine $ "bool " <> varname <> ";"]
, setupInput = []
, inputPinmode = M.singleton p InputMode
, readInput = [CLine $ varname <> " = digitalRead(" <> show n <> ");"]
, inputStream = extern varname interpretvalues'
}
where
varname = "arduino_digital_pin_input" <> show n
interpretvalues'
| null interpretvalues = Nothing
| otherwise = Just interpretvalues
pullup :: Pin t -> Sketch ()
pullup (Pin p) = tell [(return (), f)]
where
f = mempty
{ pinmodes = M.singleton p (S.singleton InputPullupMode)
}
type Voltage = Int16
readvoltage :: IsAnalogInputPin t => Pin t -> Input Voltage
readvoltage p = readvoltage' p []
readvoltage' :: IsAnalogInputPin t => Pin t -> [Int16] -> Input Voltage
readvoltage' (Pin (PinId n)) interpretvalues = mkInput $ InputSource
{ defineVar = [CLine $ "int " <> varname <> ";"]
, setupInput = []
, inputPinmode = mempty
, readInput = [CLine $ varname <> " = analogRead(" <> show n <> ");"]
, inputStream = extern varname interpretvalues'
}
where
varname = "arduino_analog_pin_input" <> show n
interpretvalues'
| null interpretvalues = Nothing
| otherwise = Just interpretvalues
data PWMDutyCycle = PWMDutyCycle (Behavior Word8)
instance IsPWMPin t => Output (Pin t) (Event PWMDutyCycle) where
(Pin (PinId n)) =: (Event (PWMDutyCycle v) c) = tell [(go, f)]
where
go = trigger triggername c [arg (constant n), arg v]
(f, triggername) = defineTriggerAlias (show n) "analogWrite" mempty
instance IsPWMPin t => Output (Pin t) PWMDutyCycle where
(=:) o s = o =: alwaysEvent s
led :: Pin '[ 'DigitalIO ]
led = Pin (PinId 13)
sketchSpec :: Sketch a -> Spec
sketchSpec (Sketch s) = sequence_ is
where
(is, _fs) = unzip (execWriter s)