Device.hs

-- | 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.Spec (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 devname) n = tell [(\_ -> return (), \_ -> f)]
  where
	f = mempty
		{ setups = mkCChunk
			[CLine $ devname <> ".begin(" <> Prelude.show n <> ");"]
		}

newtype Baud = Baud Int
	deriving (Show, Eq)

configureD
	:: (IsDigitalIOPin rx, IsDigitalIOPin tx)
	=> SerialDeviceName
	-> Pin rx
	-> Pin tx
	-> Baud
	-> Sketch ()
configureD d@(SerialDeviceName devname) (Pin (Arduino rxpin)) (Pin (Arduino txpin)) (Baud n) = do
	baudD d n
	tell [(\_ -> return (), \_ -> f)]
  where
	f = mempty
		{ defines =
			[ CChunk [ CLine $ "#include <SoftwareSerial.h>" ]
			, CChunk
				[ CLine $ "SoftwareSerial " <> devname
					<> " = SoftwareSerial"
					<> "("
					<> Prelude.show rxpin
					<> ", "
					<> Prelude.show txpin
					<> ");"
				]
			]
		}

newtype SerialDevice = SerialDevice SerialDeviceName

instance Input Arduino SerialDevice Int8 where
	input' (SerialDevice (SerialDeviceName devname)) interpretvalues =
		mkInput s
	  where
		s = InputSource
			{ defineVar = mkCChunk
				[CLine $ "int " <> varname <> ";"]
			, setupInput = []
			, inputPinmode = mempty
			, readInput = mkCChunk
				[CLine $ varname <> " = " <> devname <> ".read();"]
			, inputStream = extern varname interpretvalues'
			}
		varname = "input_" <> devname
		interpretvalues'
			| null interpretvalues = Nothing
			| otherwise = Just interpretvalues

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

instance Output Arduino SerialDevice [FormatOutput] where
	sdn =: l = sdn =: (Event l true :: Event () [FormatOutput])

instance Output Arduino SerialDevice (Event () [FormatOutput]) where
	SerialDevice sdn@(SerialDeviceName devname) =: (Event l c) = do
		u <- getUniqueId "serial"
		let outputfuncname = uniqueName ("output_" <> devname) u
		let f = mempty { defines = printer outputfuncname }
		(f', triggername) <- defineTriggerAlias outputfuncname f
		tell [(go triggername, \_ -> f')]
	  where
		go triggername tl = 
			let c' = addTriggerLimit tl c
			in trigger triggername c' (mapMaybe formatArg l)
	
		printer outputfuncname = mkCChunk $ concat
			[ [CLine $ "void " <> outputfuncname <> "("
				<> intercalate ", " arglist <> ") {"]
			, map (\(fmt, n) -> CLine ("  " <> fromCLine (fmt n)))
				(zip (map (\fo -> formatCLine fo sdn) l) argnames)
			, [CLine "}"]
			]
		
		argnames = map (\n -> "arg" <> Prelude.show n) ([1..] :: [Integer])
		arglist = mapMaybe mkarg (zip (map formatCType l) argnames)
		mkarg (Just ctype, argname) = Just (ctype <> " " <> argname)
		mkarg (Nothing, _) = Nothing

instance IsBehavior [FormatOutput] where
	(@:) = Event

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

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

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

quoteString :: String -> String
quoteString s = '"' : concatMap esc s <> "\""
  where
	esc '"' = "\\\""
	esc '\\' = "\\\\"
	esc '\n' = "\\n"
	esc c = [c]

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

instance OutputString String where
	str s = FormatOutput Nothing Nothing $ \(SerialDeviceName devname) _ ->
		CLine $ devname <> ".print(" <> quoteString s <> ");"

-- | 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 s) = FormatOutput Nothing Nothing $ \(SerialDeviceName devname) _ ->
		CLine $ devname <> ".print(F(" <> quoteString s <> "));"

-- | 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 s = FormatOutput
	(Just (arg s))
	(Just (showCType (Proxy @t)))
	(\(SerialDeviceName devname) v ->
		CLine $ devname <> ".print(" <> v <> ");")

-- | Write a byte to the serial port.
byte :: Stream Int8 -> FormatOutput
byte s = FormatOutput
	(Just (arg s))
	(Just (showCType (Proxy @Int8)))
	(\(SerialDeviceName devname) v ->
		CLine $ devname <> ".write(" <> v <> ");")

-- | Write an array of bytes to the serial port.
byteArray :: KnownNat n => Stream (Array n Int8) -> FormatOutput
byteArray arr = FormatOutput
	(Just (arg arr))
	(Just (showCType (Proxy @Int8)))
	(\(SerialDeviceName devname) v ->
		CLine $ devname <> ".write(" <> v <> ");")

-- | 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 s f = FormatOutput
	(Just (arg s))
	(Just (showCType t))
	(\(SerialDeviceName devname) v ->
		CLine $ devname <> ".print(" <> v <> ", " <> formatter t f <> ");")
  where
	t = Proxy @t

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

instance FormatableType Float Int where
	formatter _ precision = Prelude.show precision

instance Integral t => FormatableType t Base where
	formatter _ b = Prelude.show b

data Base = BIN | OCT | DEC | HEX
	deriving (Show)