-- | This module be used to create a new module targeting a specific
-- serial device. See CoPilot.Arduino.Library.Serial and
-- CoPilot.Arduino.Library.Serial.XBee for examples.

{-# LANGUAGE RebindableSyntax #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}

module Copilot.Arduino.Library.Serial.Device (
	module Copilot.Arduino.Library.Serial.Device,
	IsDigitalIOPin,
) where

import Copilot.Arduino hiding (show)
import Copilot.Arduino.Internals
import Control.Monad.Writer
import Copilot.Language.Stream (Arg)
import Data.List
import Data.Maybe
import Data.Proxy
import GHC.TypeNats
import qualified Prelude

-- | Eg \"Serial\" or \"Serial2\"
newtype SerialDeviceName = SerialDeviceName String

baudD :: SerialDeviceName -> Int -> Sketch ()
baudD :: SerialDeviceName -> Int -> Sketch ()
baudD (SerialDeviceName String
devname) Int
n = forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [(\TriggerLimit
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return (), \TriggerLimit
_ -> GenFramework Arduino
f)]
  where
	f :: GenFramework Arduino
f = forall a. Monoid a => a
mempty
		{ setups :: [CChunk]
setups = [CLine] -> [CChunk]
mkCChunk
			[String -> CLine
CLine forall a b. (a -> b) -> a -> b
$ String
devname forall a. Semigroup a => a -> a -> a
<> String
".begin(" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
Prelude.show Int
n forall a. Semigroup a => a -> a -> a
<> String
");"]
		}

newtype Baud = Baud Int
	deriving (Int -> Baud -> ShowS
[Baud] -> ShowS
Baud -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Baud] -> ShowS
$cshowList :: [Baud] -> ShowS
show :: Baud -> String
$cshow :: Baud -> String
showsPrec :: Int -> Baud -> ShowS
$cshowsPrec :: Int -> Baud -> ShowS
Show, Baud -> Baud -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Baud -> Baud -> Bool
$c/= :: Baud -> Baud -> Bool
== :: Baud -> Baud -> Bool
$c== :: Baud -> Baud -> Bool
Eq)

configureD
	:: (IsDigitalIOPin rx, IsDigitalIOPin tx)
	=> SerialDeviceName
	-> Pin rx
	-> Pin tx
	-> Baud
	-> Sketch ()
configureD :: forall (rx :: [PinCapabilities]) (tx :: [PinCapabilities]).
(IsDigitalIOPin rx, IsDigitalIOPin tx) =>
SerialDeviceName -> Pin rx -> Pin tx -> Baud -> Sketch ()
configureD d :: SerialDeviceName
d@(SerialDeviceName String
devname) (Pin (Arduino Int16
rxpin)) (Pin (Arduino Int16
txpin)) (Baud Int
n) = do
	SerialDeviceName -> Int -> Sketch ()
baudD SerialDeviceName
d Int
n
	forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [(\TriggerLimit
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return (), \TriggerLimit
_ -> GenFramework Arduino
f)]
  where
	f :: GenFramework Arduino
f = forall a. Monoid a => a
mempty
		{ defines :: [CChunk]
defines =
			[ [CLine] -> CChunk
CChunk [ String -> CLine
CLine forall a b. (a -> b) -> a -> b
$ String
"#include <SoftwareSerial.h>" ]
			, [CLine] -> CChunk
CChunk
				[ String -> CLine
CLine forall a b. (a -> b) -> a -> b
$ String
"SoftwareSerial " forall a. Semigroup a => a -> a -> a
<> String
devname
					forall a. Semigroup a => a -> a -> a
<> String
" = SoftwareSerial"
					forall a. Semigroup a => a -> a -> a
<> String
"("
					forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
Prelude.show Int16
rxpin
					forall a. Semigroup a => a -> a -> a
<> String
", "
					forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
Prelude.show Int16
txpin
					forall a. Semigroup a => a -> a -> a
<> String
");"
				]
			]
		}

newtype SerialDevice = SerialDevice SerialDeviceName

instance Input Arduino SerialDevice Int8 where
	input' :: SerialDevice -> [Int8] -> GenSketch Arduino (Behavior Int8)
input' (SerialDevice (SerialDeviceName String
devname)) [Int8]
interpretvalues =
		forall ctx t. MkInputSource ctx t -> GenSketch ctx (Behavior t)
mkInput MkInputSource Arduino Int8
s
	  where
		s :: MkInputSource Arduino Int8
s = 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 = []
			, 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
" = " forall a. Semigroup a => a -> a -> a
<> String
devname forall a. Semigroup a => a -> a -> a
<> String
".read();"]
			, inputStream :: Behavior Int8
inputStream = forall a. Typed a => String -> Maybe [a] -> Stream a
extern String
varname Maybe [Int8]
interpretvalues'
			}
		varname :: String
varname = String
"input_" forall a. Semigroup a => a -> a -> a
<> String
devname
		interpretvalues' :: Maybe [Int8]
interpretvalues'
			| forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Int8]
interpretvalues = forall a. Maybe a
Nothing
			| Bool
otherwise = forall a. a -> Maybe a
Just [Int8]
interpretvalues

-- | Value that is read from serial port when there is no input available.
noInput :: Int8
noInput :: Int8
noInput = -Int8
1

instance Output Arduino SerialDevice [FormatOutput] where
	SerialDevice
sdn =: :: SerialDevice -> [FormatOutput] -> Sketch ()
=: [FormatOutput]
l = SerialDevice
sdn forall ctx o t. Output ctx o t => o -> t -> GenSketch ctx ()
=: (forall {k} (p :: k) v. v -> Stream Bool -> Event p v
Event [FormatOutput]
l Stream Bool
true :: Event () [FormatOutput])

instance Output Arduino SerialDevice (Event () [FormatOutput]) where
	SerialDevice sdn :: SerialDeviceName
sdn@(SerialDeviceName String
devname) =: :: SerialDevice -> Event () [FormatOutput] -> Sketch ()
=: (Event [FormatOutput]
l Stream Bool
c) = do
		UniqueId
u <- forall ctx. String -> GenSketch ctx UniqueId
getUniqueId String
"serial"
		let outputfuncname :: String
outputfuncname = String -> UniqueId -> String
uniqueName (String
"output_" forall a. Semigroup a => a -> a -> a
<> String
devname) UniqueId
u
		let f :: GenFramework Arduino
f = forall a. Monoid a => a
mempty { defines :: [CChunk]
defines = String -> [CChunk]
printer String
outputfuncname }
		(GenFramework Arduino
f', String
triggername) <- forall ctx.
String
-> GenFramework ctx -> GenSketch ctx (GenFramework ctx, String)
defineTriggerAlias String
outputfuncname GenFramework Arduino
f
		forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [(String -> TriggerLimit -> WriterT [SpecItem] Identity ()
go String
triggername, \TriggerLimit
_ -> GenFramework Arduino
f')]
	  where
		go :: String -> TriggerLimit -> WriterT [SpecItem] Identity ()
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] -> WriterT [SpecItem] Identity ()
trigger String
triggername Stream Bool
c' (forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe FormatOutput -> Maybe Arg
formatArg [FormatOutput]
l)
	
		printer :: String -> [CChunk]
printer String
outputfuncname = [CLine] -> [CChunk]
mkCChunk forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
			[ [String -> CLine
CLine forall a b. (a -> b) -> a -> b
$ String
"void " forall a. Semigroup a => a -> a -> a
<> String
outputfuncname forall a. Semigroup a => a -> a -> a
<> String
"("
				forall a. Semigroup a => a -> a -> a
<> forall a. [a] -> [[a]] -> [a]
intercalate String
", " [String]
arglist forall a. Semigroup a => a -> a -> a
<> String
") {"]
			, forall a b. (a -> b) -> [a] -> [b]
map (\(String -> CLine
fmt, String
n) -> String -> CLine
CLine (String
"  " forall a. Semigroup a => a -> a -> a
<> CLine -> String
fromCLine (String -> CLine
fmt String
n)))
				(forall a b. [a] -> [b] -> [(a, b)]
zip (forall a b. (a -> b) -> [a] -> [b]
map (\FormatOutput
fo -> FormatOutput -> SerialDeviceName -> String -> CLine
formatCLine FormatOutput
fo SerialDeviceName
sdn) [FormatOutput]
l) [String]
argnames)
			, [String -> CLine
CLine String
"}"]
			]
		
		argnames :: [String]
argnames = forall a b. (a -> b) -> [a] -> [b]
map (\Integer
n -> String
"arg" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
Prelude.show Integer
n) ([Integer
1..] :: [Integer])
		arglist :: [String]
arglist = forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Maybe String, String) -> Maybe String
mkarg (forall a b. [a] -> [b] -> [(a, b)]
zip (forall a b. (a -> b) -> [a] -> [b]
map FormatOutput -> Maybe String
formatCType [FormatOutput]
l) [String]
argnames)
		mkarg :: (Maybe String, String) -> Maybe String
mkarg (Just String
ctype, String
argname) = forall a. a -> Maybe a
Just (String
ctype forall a. Semigroup a => a -> a -> a
<> String
" " forall a. Semigroup a => a -> a -> a
<> String
argname)
		mkarg (Maybe String
Nothing, String
_) = forall a. Maybe a
Nothing

instance IsBehavior [FormatOutput] where
	@: :: [FormatOutput] -> Stream Bool -> BehaviorToEvent [FormatOutput]
(@:) = forall {k} (p :: k) v. v -> Stream Bool -> Event p v
Event

type instance BehaviorToEvent [FormatOutput] = Event () [FormatOutput]

data FormatOutput = FormatOutput
	{ FormatOutput -> Maybe Arg
formatArg :: Maybe Arg
	, FormatOutput -> Maybe String
formatCType :: Maybe String
	, FormatOutput -> SerialDeviceName -> String -> CLine
formatCLine :: SerialDeviceName -> String -> CLine
	}

-- | Use this to output a Char.
char :: Char -> FormatOutput
char :: Char -> FormatOutput
char Char
c = Maybe Arg
-> Maybe String
-> (SerialDeviceName -> String -> CLine)
-> FormatOutput
FormatOutput forall a. Maybe a
Nothing forall a. Maybe a
Nothing
	(\(SerialDeviceName String
devname) String
_ ->
		String -> CLine
CLine forall a b. (a -> b) -> a -> b
$ String
devname forall a. Semigroup a => a -> a -> a
<> String
".print('" forall a. Semigroup a => a -> a -> a
<> Char -> String
esc Char
c forall a. Semigroup a => a -> a -> a
<> String
"');")
  where
	esc :: Char -> String
esc Char
'\'' = String
"\\\'"
	esc Char
'\\' = String
"\\\\"
	esc Char
'\r' = String
"\\r"
	esc Char
'\n' = String
"\\n"
	esc Char
c' = [Char
c']

quoteString :: String -> String
quoteString :: ShowS
quoteString String
s = Char
'"' forall a. a -> [a] -> [a]
: forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Char -> String
esc String
s forall a. Semigroup a => a -> a -> a
<> String
"\""
  where
	esc :: Char -> String
esc Char
'"' = String
"\\\""
	esc Char
'\\' = String
"\\\\"
	esc Char
'\n' = String
"\\n"
	esc Char
c = [Char
c]

class OutputString t where
	-- | Use this to output a `String` or `FlashString`
	str :: t -> FormatOutput

instance OutputString String where
	str :: String -> FormatOutput
str String
s = Maybe Arg
-> Maybe String
-> (SerialDeviceName -> String -> CLine)
-> FormatOutput
FormatOutput forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a b. (a -> b) -> a -> b
$ \(SerialDeviceName String
devname) String
_ ->
		String -> CLine
CLine forall a b. (a -> b) -> a -> b
$ String
devname forall a. Semigroup a => a -> a -> a
<> String
".print(" forall a. Semigroup a => a -> a -> a
<> ShowS
quoteString String
s forall a. Semigroup a => a -> a -> a
<> String
");"

-- | Normally a String will be copied into ram before it is output.
-- A FlashString will be output directly from flash memory.
--
-- Using this with `str` will reduce the amount of memory used by your
-- program, but will likely slightly increase the size of the program.
newtype FlashString = FlashString String

instance OutputString FlashString where
	str :: FlashString -> FormatOutput
str (FlashString String
s) = Maybe Arg
-> Maybe String
-> (SerialDeviceName -> String -> CLine)
-> FormatOutput
FormatOutput forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a b. (a -> b) -> a -> b
$ \(SerialDeviceName String
devname) String
_ ->
		String -> CLine
CLine forall a b. (a -> b) -> a -> b
$ String
devname forall a. Semigroup a => a -> a -> a
<> String
".print(F(" forall a. Semigroup a => a -> a -> a
<> ShowS
quoteString String
s forall a. Semigroup a => a -> a -> a
<> String
"));"

-- | Use this to show the current value of a Stream.
--
-- Numbers will be formatted in decimal. Bool is displayed as 0 and 1.
show :: forall t. (ShowCType t, Typed t) => Stream t -> FormatOutput
show :: forall t. (ShowCType t, Typed t) => Stream t -> FormatOutput
show Stream t
s = Maybe Arg
-> Maybe String
-> (SerialDeviceName -> String -> CLine)
-> FormatOutput
FormatOutput
	(forall a. a -> Maybe a
Just (forall a. Typed a => Stream a -> Arg
arg Stream t
s))
	(forall a. a -> Maybe a
Just (forall {k} (t :: k). ShowCType t => Proxy t -> String
showCType (forall {k} (t :: k). Proxy t
Proxy @t)))
	(\(SerialDeviceName String
devname) String
v ->
		String -> CLine
CLine forall a b. (a -> b) -> a -> b
$ String
devname forall a. Semigroup a => a -> a -> a
<> String
".print(" forall a. Semigroup a => a -> a -> a
<> String
v forall a. Semigroup a => a -> a -> a
<> String
");")

-- | Write a byte to the serial port.
byte :: Stream Int8 -> FormatOutput
byte :: Behavior Int8 -> FormatOutput
byte Behavior Int8
s = Maybe Arg
-> Maybe String
-> (SerialDeviceName -> String -> CLine)
-> FormatOutput
FormatOutput
	(forall a. a -> Maybe a
Just (forall a. Typed a => Stream a -> Arg
arg Behavior Int8
s))
	(forall a. a -> Maybe a
Just (forall {k} (t :: k). ShowCType t => Proxy t -> String
showCType (forall {k} (t :: k). Proxy t
Proxy @Int8)))
	(\(SerialDeviceName String
devname) String
v ->
		String -> CLine
CLine forall a b. (a -> b) -> a -> b
$ String
devname forall a. Semigroup a => a -> a -> a
<> String
".write(" forall a. Semigroup a => a -> a -> a
<> String
v forall a. Semigroup a => a -> a -> a
<> String
");")

-- | Write an array of bytes to the serial port.
byteArray :: KnownNat n => Stream (Array n Int8) -> FormatOutput
byteArray :: forall (n :: Nat).
KnownNat n =>
Stream (Array n Int8) -> FormatOutput
byteArray Stream (Array n Int8)
arr = Maybe Arg
-> Maybe String
-> (SerialDeviceName -> String -> CLine)
-> FormatOutput
FormatOutput
	(forall a. a -> Maybe a
Just (forall a. Typed a => Stream a -> Arg
arg Stream (Array n Int8)
arr))
	(forall a. a -> Maybe a
Just (forall {k} (t :: k). ShowCType t => Proxy t -> String
showCType (forall {k} (t :: k). Proxy t
Proxy @Int8)))
	(\(SerialDeviceName String
devname) String
v ->
		String -> CLine
CLine forall a b. (a -> b) -> a -> b
$ String
devname forall a. Semigroup a => a -> a -> a
<> String
".write(" forall a. Semigroup a => a -> a -> a
<> String
v forall a. Semigroup a => a -> a -> a
<> String
");")

-- | Show the current value of a Stream with control over the formatting.
--
-- When used with a Float, provide the number of decimal places
-- to show.
--
-- > Serial.showFormatted (constant (1.234 :: Float)) 2 -- "1.23"
--
-- When used with any Integral type, provide the `Base` to display it in
--
-- > Serial.showFormatted (constant (78 :: Int8)) Serial.HEX -- "4E"
showFormatted
	:: forall t f. (ShowCType t, Typed t, FormatableType t f)
	=> Stream t
	-> f
	-> FormatOutput
showFormatted :: forall t f.
(ShowCType t, Typed t, FormatableType t f) =>
Stream t -> f -> FormatOutput
showFormatted Stream t
s f
f = Maybe Arg
-> Maybe String
-> (SerialDeviceName -> String -> CLine)
-> FormatOutput
FormatOutput
	(forall a. a -> Maybe a
Just (forall a. Typed a => Stream a -> Arg
arg Stream t
s))
	(forall a. a -> Maybe a
Just (forall {k} (t :: k). ShowCType t => Proxy t -> String
showCType Proxy t
t))
	(\(SerialDeviceName String
devname) String
v ->
		String -> CLine
CLine forall a b. (a -> b) -> a -> b
$ String
devname forall a. Semigroup a => a -> a -> a
<> String
".print(" forall a. Semigroup a => a -> a -> a
<> String
v forall a. Semigroup a => a -> a -> a
<> String
", " forall a. Semigroup a => a -> a -> a
<> forall {k} (t :: k) f. FormatableType t f => Proxy t -> f -> String
formatter Proxy t
t f
f forall a. Semigroup a => a -> a -> a
<> String
");")
  where
	t :: Proxy t
t = forall {k} (t :: k). Proxy t
Proxy @t

class FormatableType t f where
	formatter :: Proxy t -> f -> String

instance FormatableType Float Int where
	formatter :: Proxy Float -> Int -> String
formatter Proxy Float
_ Int
precision = forall a. Show a => a -> String
Prelude.show Int
precision

instance Integral t => FormatableType t Base where
	formatter :: Proxy t -> Base -> String
formatter Proxy t
_ Base
b = forall a. Show a => a -> String
Prelude.show Base
b

data Base = BIN | OCT | DEC | HEX
	deriving (Int -> Base -> ShowS
[Base] -> ShowS
Base -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Base] -> ShowS
$cshowList :: [Base] -> ShowS
show :: Base -> String
$cshow :: Base -> String
showsPrec :: Int -> Base -> ShowS
$cshowsPrec :: Int -> Base -> ShowS
Show)