{-# 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
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 (PinId rxpin)) (Pin (PinId 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 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
noInput :: Int8
noInput = -1
instance Output SerialDevice [FormatOutput] where
sdn =: l = sdn =: (Event l true :: Event () [FormatOutput])
instance Output 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
}
char :: Char -> FormatOutput
char c = FormatOutput Nothing Nothing
(\(SerialDeviceName devname) _ ->
CLine $ devname <> ".print('" <> esc c <> "');")
where
esc '\'' = "\\\'"
esc '\\' = "\\\\"
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
str :: t -> FormatOutput
instance OutputString String where
str s = FormatOutput Nothing Nothing $ \(SerialDeviceName devname) _ ->
CLine $ devname <> ".print(" <> quoteString s <> ");"
newtype FlashString = FlashString String
instance OutputString FlashString where
str (FlashString s) = FormatOutput Nothing Nothing $ \(SerialDeviceName devname) _ ->
CLine $ devname <> ".print(F(" <> quoteString s <> "));"
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 <> ");")
byte :: Stream Int8 -> FormatOutput
byte s = FormatOutput
(Just (arg s))
(Just (showCType (Proxy @Int8)))
(\(SerialDeviceName devname) v ->
CLine $ devname <> ".write(" <> v <> ");")
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)