-- | You should not need to import this module unless you're adding support
-- for a new model of Arduino, or an Arduino library.

{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE UndecidableInstances #-}

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 qualified Data.Map as M
import qualified Data.Set as S
import Data.Proxy

-- | An Arduino sketch, implemented using Copilot.
--
-- It's best to think of the `Sketch` as a description of the state of the
-- 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.
type Sketch = GenSketch Arduino

-- | The framework of a sketch.
type Framework = GenFramework Arduino

-- | A pin on the Arduino board.
--
-- For definitions of pins like `Copilot.Arduino.Uno.pin12`, 
-- load a module such as Copilot.Arduino.Uno, which provides the pins of a
-- particular board.
--
-- A type-level list indicates how a Pin can be used, so the haskell
-- compiler will detect impossible uses of pins.
newtype Pin t = Pin Arduino
	deriving (Int -> Pin t -> ShowS
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (t :: k). Int -> Pin t -> ShowS
forall k (t :: k). [Pin t] -> ShowS
forall k (t :: k). Pin t -> String
showList :: [Pin t] -> ShowS
$cshowList :: forall k (t :: k). [Pin t] -> ShowS
show :: Pin t -> String
$cshow :: forall k (t :: k). Pin t -> String
showsPrec :: Int -> Pin t -> ShowS
$cshowsPrec :: forall k (t :: k). Int -> Pin t -> ShowS
Show, Pin t -> Pin t -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall k (t :: k). Pin t -> Pin t -> Bool
/= :: Pin t -> Pin t -> Bool
$c/= :: forall k (t :: k). Pin t -> Pin t -> Bool
== :: Pin t -> Pin t -> Bool
$c== :: forall k (t :: k). Pin t -> Pin t -> Bool
Eq, Pin t -> Pin t -> Bool
Pin t -> Pin t -> Ordering
Pin t -> Pin t -> Pin t
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall k (t :: k). Eq (Pin t)
forall k (t :: k). Pin t -> Pin t -> Bool
forall k (t :: k). Pin t -> Pin t -> Ordering
forall k (t :: k). Pin t -> Pin t -> Pin t
min :: Pin t -> Pin t -> Pin t
$cmin :: forall k (t :: k). Pin t -> Pin t -> Pin t
max :: Pin t -> Pin t -> Pin t
$cmax :: forall k (t :: k). Pin t -> Pin t -> Pin t
>= :: Pin t -> Pin t -> Bool
$c>= :: forall k (t :: k). Pin t -> Pin t -> Bool
> :: Pin t -> Pin t -> Bool
$c> :: forall k (t :: k). Pin t -> Pin t -> Bool
<= :: Pin t -> Pin t -> Bool
$c<= :: forall k (t :: k). Pin t -> Pin t -> Bool
< :: Pin t -> Pin t -> Bool
$c< :: forall k (t :: k). Pin t -> Pin t -> Bool
compare :: Pin t -> Pin t -> Ordering
$ccompare :: forall k (t :: k). Pin t -> Pin t -> Ordering
Ord)

-- | Indicates that you're programming an arduino, and not some
-- other kind of hardware. The similar library zephyr-copilot allows
-- programming other embedded boards in a very similar style to this one.
newtype Arduino = Arduino Int16
	deriving (Int -> Arduino -> ShowS
[Arduino] -> ShowS
Arduino -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Arduino] -> ShowS
$cshowList :: [Arduino] -> ShowS
show :: Arduino -> String
$cshow :: Arduino -> String
showsPrec :: Int -> Arduino -> ShowS
$cshowsPrec :: Int -> Arduino -> ShowS
Show, Arduino -> Arduino -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Arduino -> Arduino -> Bool
$c/= :: Arduino -> Arduino -> Bool
== :: Arduino -> Arduino -> Bool
$c== :: Arduino -> Arduino -> Bool
Eq, Eq Arduino
Arduino -> Arduino -> Bool
Arduino -> Arduino -> Ordering
Arduino -> Arduino -> Arduino
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Arduino -> Arduino -> Arduino
$cmin :: Arduino -> Arduino -> Arduino
max :: Arduino -> Arduino -> Arduino
$cmax :: Arduino -> Arduino -> Arduino
>= :: Arduino -> Arduino -> Bool
$c>= :: Arduino -> Arduino -> Bool
> :: Arduino -> Arduino -> Bool
$c> :: Arduino -> Arduino -> Bool
<= :: Arduino -> Arduino -> Bool
$c<= :: Arduino -> Arduino -> Bool
< :: Arduino -> Arduino -> Bool
$c< :: Arduino -> Arduino -> Bool
compare :: Arduino -> Arduino -> Ordering
$ccompare :: Arduino -> Arduino -> Ordering
Ord)

instance Context Arduino

instance IsDigitalIOPin t => Output Arduino (Pin t) (Event () (Stream Bool)) where
	(Pin p :: Arduino
p@(Arduino Int16
n)) =: :: Pin t -> Event () (Stream Bool) -> GenSketch Arduino ()
=: (Event Stream Bool
b Stream Bool
c) = do
		(GenFramework Arduino
f, String
triggername) <- forall ctx.
String
-> String
-> GenFramework ctx
-> GenSketch ctx (GenFramework ctx, String)
defineTriggerAlias' (String
"pin_" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Int16
n) String
"digitalWrite" forall a b. (a -> b) -> a -> b
$
			(forall ctx. Context ctx => GenFramework ctx
emptyFramework @Arduino)
				{ pinmodes :: Map Arduino (Set PinMode)
pinmodes = forall k a. k -> a -> Map k a
M.singleton Arduino
p (forall a. a -> Set a
S.singleton PinMode
OutputMode)
				}
		forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [(String -> TriggerLimit -> Spec
go String
triggername, forall a b. a -> b -> a
const GenFramework Arduino
f)]
	  where
		go :: String -> TriggerLimit -> Spec
go String
triggername TriggerLimit
tl = 
			let c' :: Stream Bool
c' = TriggerLimit -> Stream Bool -> Stream Bool
addTriggerLimit TriggerLimit
tl Stream Bool
c
			in String -> Stream Bool -> [Arg] -> Spec
trigger String
triggername Stream Bool
c' [forall a. Typed a => Stream a -> Arg
arg (forall a. Typed a => a -> Stream a
constant Int16
n), forall a. Typed a => Stream a -> Arg
arg Stream Bool
b]

instance IsPWMPin t => Output Arduino (Pin t) (Event 'PWM (Stream Word8)) where
	(Pin (Arduino Int16
n)) =: :: Pin t -> Event 'PWM (Stream Word8) -> GenSketch Arduino ()
=: (Event Stream Word8
v Stream Bool
c) = do
		(GenFramework Arduino
f, String
triggername) <- forall ctx.
String
-> String
-> GenFramework ctx
-> GenSketch ctx (GenFramework ctx, String)
defineTriggerAlias' (String
"pin_" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Int16
n) String
"analogWrite" forall a. Monoid a => a
mempty
		forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [(String -> TriggerLimit -> Spec
go String
triggername, forall a b. a -> b -> a
const GenFramework Arduino
f)]
	  where
		go :: String -> TriggerLimit -> Spec
go String
triggername TriggerLimit
tl = 
			let c' :: Stream Bool
c' = TriggerLimit -> Stream Bool -> Stream Bool
addTriggerLimit TriggerLimit
tl Stream Bool
c
			in String -> Stream Bool -> [Arg] -> Spec
trigger String
triggername Stream Bool
c' [forall a. Typed a => Stream a -> Arg
arg (forall a. Typed a => a -> Stream a
constant Int16
n), forall a. Typed a => Stream a -> Arg
arg Stream Word8
v]
		-- analogWrite does not need any pinmodes set up

instance IsDigitalIOPin t => Input Arduino (Pin t) Bool where
	input' :: Pin t -> [Bool] -> GenSketch Arduino (Stream Bool)
input' (Pin p :: Arduino
p@(Arduino Int16
n)) [Bool]
interpretvalues = forall ctx t. MkInputSource ctx t -> GenSketch ctx (Behavior t)
mkInput forall a b. (a -> b) -> a -> b
$ InputSource
		{ defineVar :: [CChunk]
defineVar = [CLine] -> [CChunk]
mkCChunk [String -> CLine
CLine forall a b. (a -> b) -> a -> b
$ String
"bool " forall a. Semigroup a => a -> a -> a
<> String
varname forall a. Semigroup a => a -> a -> a
<> String
";"]
		, setupInput :: [CChunk]
setupInput = forall a. Monoid a => a
mempty
		, inputPinmode :: Map Arduino PinMode
inputPinmode = forall k a. k -> a -> Map k a
M.singleton Arduino
p PinMode
InputMode
		, readInput :: [CChunk]
readInput = [CLine] -> [CChunk]
mkCChunk
			[String -> CLine
CLine forall a b. (a -> b) -> a -> b
$ String
varname forall a. Semigroup a => a -> a -> a
<> String
" = digitalRead(" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Int16
n forall a. Semigroup a => a -> a -> a
<> String
");"]
		, inputStream :: Stream Bool
inputStream = forall a. Typed a => String -> Maybe [a] -> Stream a
extern String
varname Maybe [Bool]
interpretvalues'
		}
	  where
		varname :: String
varname = String
"arduino_digital_pin_input" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Int16
n
		interpretvalues' :: Maybe [Bool]
interpretvalues'
			| forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Bool]
interpretvalues = forall a. Maybe a
Nothing
			| Bool
otherwise = forall a. a -> Maybe a
Just [Bool]
interpretvalues

-- | Value read from an Arduino's ADC. Ranges from 0-1023.
type ADC = Int16

instance IsAnalogInputPin t => Input Arduino (Pin t) ADC where
	input' :: Pin t -> [Int16] -> GenSketch Arduino (Behavior Int16)
input' (Pin (Arduino Int16
n)) [Int16]
interpretvalues = forall ctx t. MkInputSource ctx t -> GenSketch ctx (Behavior t)
mkInput forall a b. (a -> b) -> a -> b
$ InputSource
		{ defineVar :: [CChunk]
defineVar = [CLine] -> [CChunk]
mkCChunk [String -> CLine
CLine forall a b. (a -> b) -> a -> b
$ String
"int " forall a. Semigroup a => a -> a -> a
<> String
varname forall a. Semigroup a => a -> a -> a
<> String
";"]
		, setupInput :: [CChunk]
setupInput = forall a. Monoid a => a
mempty
		, inputPinmode :: Map Arduino PinMode
inputPinmode = forall a. Monoid a => a
mempty
		, readInput :: [CChunk]
readInput = [CLine] -> [CChunk]
mkCChunk
			[String -> CLine
CLine forall a b. (a -> b) -> a -> b
$ String
varname forall a. Semigroup a => a -> a -> a
<> String
" = analogRead(" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Int16
n forall a. Semigroup a => a -> a -> a
<> String
");"]
		, inputStream :: Behavior Int16
inputStream = forall a. Typed a => String -> Maybe [a] -> Stream a
extern String
varname Maybe [Int16]
interpretvalues'
		}
	  where
		varname :: String
varname = String
"arduino_analog_pin_input" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Int16
n
		interpretvalues' :: Maybe [Int16]
interpretvalues'
			| forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Int16]
interpretvalues = forall a. Maybe a
Nothing
			| Bool
otherwise = forall a. a -> Maybe a
Just [Int16]
interpretvalues

class ShowCType t where
	showCType :: Proxy t -> String

instance ShowCType Bool where showCType :: Proxy Bool -> String
showCType Proxy Bool
_ = String
"bool"
instance ShowCType Int8 where showCType :: Proxy Int8 -> String
showCType Proxy Int8
_ = String
"int8_t"
instance ShowCType Int16 where showCType :: Proxy Int16 -> String
showCType Proxy Int16
_ = String
"int16_t"
instance ShowCType Int32 where showCType :: Proxy Int32 -> String
showCType Proxy Int32
_ = String
"int32_t"
instance ShowCType Int64 where showCType :: Proxy Int64 -> String
showCType Proxy Int64
_ = String
"int64_t"
instance ShowCType Word8 where showCType :: Proxy Word8 -> String
showCType Proxy Word8
_ = String
"uint8_t"
instance ShowCType Word16 where showCType :: Proxy Word16 -> String
showCType Proxy Word16
_ = String
"uint16_t"
instance ShowCType Word32 where showCType :: Proxy Word32 -> String
showCType Proxy Word32
_ = String
"uint32_t"
instance ShowCType Word64 where showCType :: Proxy Word64 -> String
showCType Proxy Word64
_ = String
"uint64_t"
instance ShowCType Float where showCType :: Proxy Float -> String
showCType Proxy Float
_ = String
"float"
instance ShowCType Double where showCType :: Proxy Double -> String
showCType Proxy Double
_ = String
"double"

instance Output Arduino Delay MilliSeconds where
	Delay
Delay =: :: Delay -> MilliSeconds -> GenSketch Arduino ()
=: (MilliSeconds Stream Word32
n) = do
		(GenFramework Arduino
f, String
triggername) <- forall ctx.
String
-> GenFramework ctx -> GenSketch ctx (GenFramework ctx, String)
defineTriggerAlias String
"delay" forall a. Monoid a => a
mempty
		forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [(String -> TriggerLimit -> Spec
go String
triggername, \TriggerLimit
_ -> GenFramework Arduino
f)]
	  where
		go :: String -> TriggerLimit -> Spec
go String
triggername TriggerLimit
tl =
			let c :: Stream Bool
c = TriggerLimit -> Stream Bool
getTriggerLimit TriggerLimit
tl
			in String -> Stream Bool -> [Arg] -> Spec
trigger String
triggername Stream Bool
c [forall a. Typed a => Stream a -> Arg
arg Stream Word32
n]

instance Output Arduino Delay MicroSeconds where
	Delay
Delay =: :: Delay -> MicroSeconds -> GenSketch Arduino ()
=: (MicroSeconds Stream Word32
n) = do
		(GenFramework Arduino
f, String
triggername) <- forall ctx.
String
-> GenFramework ctx -> GenSketch ctx (GenFramework ctx, String)
defineTriggerAlias String
"delayMicroseconds" forall a. Monoid a => a
mempty
		forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [(String -> TriggerLimit -> Spec
go String
triggername, \TriggerLimit
_ -> GenFramework Arduino
f)]
	  where
		go :: String -> TriggerLimit -> Spec
go String
triggername TriggerLimit
tl = 
			let c :: Stream Bool
c = TriggerLimit -> Stream Bool
getTriggerLimit TriggerLimit
tl
			in String -> Stream Bool -> [Arg] -> Spec
trigger String
triggername Stream Bool
c [forall a. Typed a => Stream a -> Arg
arg Stream Word32
n]