{-# 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
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
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
}
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
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
");"
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
"));"
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
");")
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
");")
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
");")
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)