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

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

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

newtype Baud = Baud Int
	deriving (Int -> Baud -> String -> String
[Baud] -> String -> String
Baud -> String
(Int -> Baud -> String -> String)
-> (Baud -> String) -> ([Baud] -> String -> String) -> Show Baud
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [Baud] -> String -> String
$cshowList :: [Baud] -> String -> String
show :: Baud -> String
$cshow :: Baud -> String
showsPrec :: Int -> Baud -> String -> String
$cshowsPrec :: Int -> Baud -> String -> String
Show, Baud -> Baud -> Bool
(Baud -> Baud -> Bool) -> (Baud -> Baud -> Bool) -> Eq Baud
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 :: SerialDeviceName -> Pin rx -> Pin tx -> Baud -> Sketch ()
configureD d :: SerialDeviceName
d@(SerialDeviceName String
devname) (Pin (PinId Int16
rxpin)) (Pin (PinId Int16
txpin)) (Baud Int
n) = do
	SerialDeviceName -> Int -> Sketch ()
baudD SerialDeviceName
d Int
n
	[(TriggerLimit -> WriterT [SpecItem] Identity (),
  TriggerLimit -> Framework)]
-> Sketch ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [(\TriggerLimit
_ -> () -> WriterT [SpecItem] Identity ()
forall (m :: * -> *) a. Monad m => a -> m a
return (), \TriggerLimit
_ -> Framework
f)]
  where
	f :: Framework
f = Framework
forall a. Monoid a => a
mempty
		{ defines :: [CChunk]
defines =
			[ [CLine] -> CChunk
CChunk [ String -> CLine
CLine (String -> CLine) -> String -> CLine
forall a b. (a -> b) -> a -> b
$ String
"#include <SoftwareSerial.h>" ]
			, [CLine] -> CChunk
CChunk
				[ String -> CLine
CLine (String -> CLine) -> String -> CLine
forall a b. (a -> b) -> a -> b
$ String
"SoftwareSerial " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
devname
					String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" = SoftwareSerial"
					String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"("
					String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int16 -> String
forall a. Show a => a -> String
Prelude.show Int16
rxpin
					String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
", "
					String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int16 -> String
forall a. Show a => a -> String
Prelude.show Int16
txpin
					String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
");"
				]
			]
		}

newtype SerialDevice = SerialDevice SerialDeviceName

instance Input SerialDevice Int8 where
	input' :: SerialDevice -> [Int8] -> Sketch (Behavior Int8)
input' (SerialDevice (SerialDeviceName String
devname)) [Int8]
interpretvalues =
		InputSource Int8 -> Sketch (Behavior Int8)
forall t. InputSource t -> Sketch (Behavior t)
mkInput InputSource Int8
s
	  where
		s :: InputSource Int8
s = InputSource :: forall t.
[CChunk]
-> [CChunk]
-> Map PinId PinMode
-> [CChunk]
-> Stream t
-> InputSource t
InputSource
			{ defineVar :: [CChunk]
defineVar = [CLine] -> [CChunk]
mkCChunk
				[String -> CLine
CLine (String -> CLine) -> String -> CLine
forall a b. (a -> b) -> a -> b
$ String
"int " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
varname String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
";"]
			, setupInput :: [CChunk]
setupInput = []
			, inputPinmode :: Map PinId PinMode
inputPinmode = Map PinId PinMode
forall a. Monoid a => a
mempty
			, readInput :: [CChunk]
readInput = [CLine] -> [CChunk]
mkCChunk
				[String -> CLine
CLine (String -> CLine) -> String -> CLine
forall a b. (a -> b) -> a -> b
$ String
varname String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" = " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
devname String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
".read();"]
			, inputStream :: Behavior Int8
inputStream = String -> Maybe [Int8] -> Behavior Int8
forall a. Typed a => String -> Maybe [a] -> Stream a
extern String
varname Maybe [Int8]
interpretvalues'
			}
		varname :: String
varname = String
"input_" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
devname
		interpretvalues' :: Maybe [Int8]
interpretvalues'
			| [Int8] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Int8]
interpretvalues = Maybe [Int8]
forall a. Maybe a
Nothing
			| Bool
otherwise = [Int8] -> Maybe [Int8]
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 SerialDevice [FormatOutput] where
	SerialDevice
sdn =: :: SerialDevice -> [FormatOutput] -> Sketch ()
=: [FormatOutput]
l = SerialDevice
sdn SerialDevice -> Event () [FormatOutput] -> Sketch ()
forall o t. Output o t => o -> t -> Sketch ()
=: ([FormatOutput] -> Stream Bool -> Event () [FormatOutput]
forall k (p :: k) v. v -> Stream Bool -> Event p v
Event [FormatOutput]
l Stream Bool
true :: Event () [FormatOutput])

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

instance IsBehavior [FormatOutput] where
	@: :: [FormatOutput] -> Stream Bool -> BehaviorToEvent [FormatOutput]
(@:) = [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 Maybe Arg
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
	(\(SerialDeviceName String
devname) String
_ ->
		String -> CLine
CLine (String -> CLine) -> String -> CLine
forall a b. (a -> b) -> a -> b
$ String
devname String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
".print('" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Char -> String
esc Char
c String -> String -> String
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']

quoteString :: String -> String
quoteString :: String -> String
quoteString String
s = Char
'"' Char -> String -> String
forall a. a -> [a] -> [a]
: (Char -> String) -> String -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Char -> String
esc String
s String -> String -> String
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 Maybe Arg
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing ((SerialDeviceName -> String -> CLine) -> FormatOutput)
-> (SerialDeviceName -> String -> CLine) -> FormatOutput
forall a b. (a -> b) -> a -> b
$ \(SerialDeviceName String
devname) String
_ ->
		String -> CLine
CLine (String -> CLine) -> String -> CLine
forall a b. (a -> b) -> a -> b
$ String
devname String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
".print(" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String -> String
quoteString String
s String -> String -> String
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 Maybe Arg
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing ((SerialDeviceName -> String -> CLine) -> FormatOutput)
-> (SerialDeviceName -> String -> CLine) -> FormatOutput
forall a b. (a -> b) -> a -> b
$ \(SerialDeviceName String
devname) String
_ ->
		String -> CLine
CLine (String -> CLine) -> String -> CLine
forall a b. (a -> b) -> a -> b
$ String
devname String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
".print(F(" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String -> String
quoteString String
s String -> String -> String
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 :: Stream t -> FormatOutput
show Stream t
s = Maybe Arg
-> Maybe String
-> (SerialDeviceName -> String -> CLine)
-> FormatOutput
FormatOutput
	(Arg -> Maybe Arg
forall a. a -> Maybe a
Just (Stream t -> Arg
forall a. Typed a => Stream a -> Arg
arg Stream t
s))
	(String -> Maybe String
forall a. a -> Maybe a
Just (Proxy t -> String
forall k (t :: k). ShowCType t => Proxy t -> String
showCType (Proxy t
forall k (t :: k). Proxy t
Proxy @t)))
	(\(SerialDeviceName String
devname) String
v ->
		String -> CLine
CLine (String -> CLine) -> String -> CLine
forall a b. (a -> b) -> a -> b
$ String
devname String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
".print(" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
v String -> String -> String
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
	(Arg -> Maybe Arg
forall a. a -> Maybe a
Just (Behavior Int8 -> Arg
forall a. Typed a => Stream a -> Arg
arg Behavior Int8
s))
	(String -> Maybe String
forall a. a -> Maybe a
Just (Proxy Int8 -> String
forall k (t :: k). ShowCType t => Proxy t -> String
showCType (Proxy Int8
forall k (t :: k). Proxy t
Proxy @Int8)))
	(\(SerialDeviceName String
devname) String
v ->
		String -> CLine
CLine (String -> CLine) -> String -> CLine
forall a b. (a -> b) -> a -> b
$ String
devname String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
".write(" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
v String -> String -> String
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 :: Stream t -> f -> FormatOutput
showFormatted Stream t
s f
f = Maybe Arg
-> Maybe String
-> (SerialDeviceName -> String -> CLine)
-> FormatOutput
FormatOutput
	(Arg -> Maybe Arg
forall a. a -> Maybe a
Just (Stream t -> Arg
forall a. Typed a => Stream a -> Arg
arg Stream t
s))
	(String -> Maybe String
forall a. a -> Maybe a
Just (Proxy t -> String
forall k (t :: k). ShowCType t => Proxy t -> String
showCType Proxy t
t))
	(\(SerialDeviceName String
devname) String
v ->
		String -> CLine
CLine (String -> CLine) -> String -> CLine
forall a b. (a -> b) -> a -> b
$ String
devname String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
".print(" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
v String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
", " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Proxy t -> f -> String
forall k (t :: k) f. FormatableType t f => Proxy t -> f -> String
formatter Proxy t
t f
f String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
");")
  where
	t :: Proxy t
t = Proxy 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 = Int -> String
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 = Base -> String
forall a. Show a => a -> String
Prelude.show Base
b

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