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

newtype Baud = Baud Int
        deriving (Show, Eq)

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

outputD
        :: SerialDeviceName
        -> Stream Bool
        -- ^ This Stream controls when output is sent to the serial port.
        -> [FormatOutput]
        -> Sketch ()
outputD sdn@(SerialDeviceName devname) c l = tell [(go, f)]
  where
        go = trigger triggername c (mapMaybe formatArg l)
        f = mempty { defines = printer }

        triggername = "arduino_serial_" <> devname <> "_output"

        printer = concat
                [ [CLine $ "void " <> triggername <> "("
                        <> 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

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 '\n' = "\\n"
        esc c' = [c']

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

-- | 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. (ShowableType 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 <> ");")

-- | 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. (ShowableType 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 ShowableType t where
        showCType :: Proxy t -> String

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

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)

inputD :: SerialDeviceName -> Input Int8
inputD d = input'D d []

-- | The list is used to simulate serial input when interpreting the program.
input'D :: SerialDeviceName -> [Int8] -> Input Int8
input'D (SerialDeviceName devname) interpretvalues = mkInput $ InputSource
        { defineVar = [CLine $ "int " <> varname <> ";"]
        , setupInput = []
        , inputPinmode = mempty
        , readInput = [CLine $ varname <> " = " <> devname <> ".read();"]
        , inputStream = extern varname interpretvalues'
        }
  where
        varname = "arduino_serial_" <> devname <> "_read"
        interpretvalues'
                | null interpretvalues = Nothing
                | otherwise = Just interpretvalues

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