{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE UndecidableInstances #-}
module Copilot.Arduino.Internals (
module Copilot.Arduino.Internals,
module X
) where
import Sketch.FRP.Copilot as X
import Sketch.FRP.Copilot.Types as X
import Sketch.FRP.Copilot.Internals as X
import Language.Copilot
import Control.Monad.Writer
import qualified Data.Map as M
import qualified Data.Set as S
import Data.Proxy
type Sketch = GenSketch Arduino
type Framework = GenFramework Arduino
newtype Pin t = Pin Arduino
deriving (Int -> Pin t -> ShowS
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (t :: k). Int -> Pin t -> ShowS
forall k (t :: k). [Pin t] -> ShowS
forall k (t :: k). Pin t -> String
showList :: [Pin t] -> ShowS
$cshowList :: forall k (t :: k). [Pin t] -> ShowS
show :: Pin t -> String
$cshow :: forall k (t :: k). Pin t -> String
showsPrec :: Int -> Pin t -> ShowS
$cshowsPrec :: forall k (t :: k). Int -> Pin t -> ShowS
Show, Pin t -> Pin t -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall k (t :: k). Pin t -> Pin t -> Bool
/= :: Pin t -> Pin t -> Bool
$c/= :: forall k (t :: k). Pin t -> Pin t -> Bool
== :: Pin t -> Pin t -> Bool
$c== :: forall k (t :: k). Pin t -> Pin t -> Bool
Eq, Pin t -> Pin t -> Bool
Pin t -> Pin t -> Ordering
Pin t -> Pin t -> Pin t
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall k (t :: k). Eq (Pin t)
forall k (t :: k). Pin t -> Pin t -> Bool
forall k (t :: k). Pin t -> Pin t -> Ordering
forall k (t :: k). Pin t -> Pin t -> Pin t
min :: Pin t -> Pin t -> Pin t
$cmin :: forall k (t :: k). Pin t -> Pin t -> Pin t
max :: Pin t -> Pin t -> Pin t
$cmax :: forall k (t :: k). Pin t -> Pin t -> Pin t
>= :: Pin t -> Pin t -> Bool
$c>= :: forall k (t :: k). Pin t -> Pin t -> Bool
> :: Pin t -> Pin t -> Bool
$c> :: forall k (t :: k). Pin t -> Pin t -> Bool
<= :: Pin t -> Pin t -> Bool
$c<= :: forall k (t :: k). Pin t -> Pin t -> Bool
< :: Pin t -> Pin t -> Bool
$c< :: forall k (t :: k). Pin t -> Pin t -> Bool
compare :: Pin t -> Pin t -> Ordering
$ccompare :: forall k (t :: k). Pin t -> Pin t -> Ordering
Ord)
newtype Arduino = Arduino Int16
deriving (Int -> Arduino -> ShowS
[Arduino] -> ShowS
Arduino -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Arduino] -> ShowS
$cshowList :: [Arduino] -> ShowS
show :: Arduino -> String
$cshow :: Arduino -> String
showsPrec :: Int -> Arduino -> ShowS
$cshowsPrec :: Int -> Arduino -> ShowS
Show, Arduino -> Arduino -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Arduino -> Arduino -> Bool
$c/= :: Arduino -> Arduino -> Bool
== :: Arduino -> Arduino -> Bool
$c== :: Arduino -> Arduino -> Bool
Eq, Eq Arduino
Arduino -> Arduino -> Bool
Arduino -> Arduino -> Ordering
Arduino -> Arduino -> Arduino
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Arduino -> Arduino -> Arduino
$cmin :: Arduino -> Arduino -> Arduino
max :: Arduino -> Arduino -> Arduino
$cmax :: Arduino -> Arduino -> Arduino
>= :: Arduino -> Arduino -> Bool
$c>= :: Arduino -> Arduino -> Bool
> :: Arduino -> Arduino -> Bool
$c> :: Arduino -> Arduino -> Bool
<= :: Arduino -> Arduino -> Bool
$c<= :: Arduino -> Arduino -> Bool
< :: Arduino -> Arduino -> Bool
$c< :: Arduino -> Arduino -> Bool
compare :: Arduino -> Arduino -> Ordering
$ccompare :: Arduino -> Arduino -> Ordering
Ord)
instance Context Arduino
instance IsDigitalIOPin t => Output Arduino (Pin t) (Event () (Stream Bool)) where
(Pin p :: Arduino
p@(Arduino Int16
n)) =: :: Pin t -> Event () (Stream Bool) -> GenSketch Arduino ()
=: (Event Stream Bool
b Stream Bool
c) = do
(GenFramework Arduino
f, String
triggername) <- forall ctx.
String
-> String
-> GenFramework ctx
-> GenSketch ctx (GenFramework ctx, String)
defineTriggerAlias' (String
"pin_" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Int16
n) String
"digitalWrite" forall a b. (a -> b) -> a -> b
$
(forall ctx. Context ctx => GenFramework ctx
emptyFramework @Arduino)
{ pinmodes :: Map Arduino (Set PinMode)
pinmodes = forall k a. k -> a -> Map k a
M.singleton Arduino
p (forall a. a -> Set a
S.singleton PinMode
OutputMode)
}
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [(String -> TriggerLimit -> Spec
go String
triggername, forall a b. a -> b -> a
const GenFramework Arduino
f)]
where
go :: String -> TriggerLimit -> Spec
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] -> Spec
trigger String
triggername Stream Bool
c' [forall a. Typed a => Stream a -> Arg
arg (forall a. Typed a => a -> Stream a
constant Int16
n), forall a. Typed a => Stream a -> Arg
arg Stream Bool
b]
instance IsPWMPin t => Output Arduino (Pin t) (Event 'PWM (Stream Word8)) where
(Pin (Arduino Int16
n)) =: :: Pin t -> Event 'PWM (Stream Word8) -> GenSketch Arduino ()
=: (Event Stream Word8
v Stream Bool
c) = do
(GenFramework Arduino
f, String
triggername) <- forall ctx.
String
-> String
-> GenFramework ctx
-> GenSketch ctx (GenFramework ctx, String)
defineTriggerAlias' (String
"pin_" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Int16
n) String
"analogWrite" forall a. Monoid a => a
mempty
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [(String -> TriggerLimit -> Spec
go String
triggername, forall a b. a -> b -> a
const GenFramework Arduino
f)]
where
go :: String -> TriggerLimit -> Spec
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] -> Spec
trigger String
triggername Stream Bool
c' [forall a. Typed a => Stream a -> Arg
arg (forall a. Typed a => a -> Stream a
constant Int16
n), forall a. Typed a => Stream a -> Arg
arg Stream Word8
v]
instance IsDigitalIOPin t => Input Arduino (Pin t) Bool where
input' :: Pin t -> [Bool] -> GenSketch Arduino (Stream Bool)
input' (Pin p :: Arduino
p@(Arduino Int16
n)) [Bool]
interpretvalues = forall ctx t. MkInputSource ctx t -> GenSketch ctx (Behavior t)
mkInput forall a b. (a -> b) -> a -> b
$ InputSource
{ defineVar :: [CChunk]
defineVar = [CLine] -> [CChunk]
mkCChunk [String -> CLine
CLine forall a b. (a -> b) -> a -> b
$ String
"bool " forall a. Semigroup a => a -> a -> a
<> String
varname forall a. Semigroup a => a -> a -> a
<> String
";"]
, setupInput :: [CChunk]
setupInput = forall a. Monoid a => a
mempty
, inputPinmode :: Map Arduino PinMode
inputPinmode = forall k a. k -> a -> Map k a
M.singleton Arduino
p PinMode
InputMode
, 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
" = digitalRead(" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Int16
n forall a. Semigroup a => a -> a -> a
<> String
");"]
, inputStream :: Stream Bool
inputStream = forall a. Typed a => String -> Maybe [a] -> Stream a
extern String
varname Maybe [Bool]
interpretvalues'
}
where
varname :: String
varname = String
"arduino_digital_pin_input" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Int16
n
interpretvalues' :: Maybe [Bool]
interpretvalues'
| forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Bool]
interpretvalues = forall a. Maybe a
Nothing
| Bool
otherwise = forall a. a -> Maybe a
Just [Bool]
interpretvalues
type ADC = Int16
instance IsAnalogInputPin t => Input Arduino (Pin t) ADC where
input' :: Pin t -> [Int16] -> GenSketch Arduino (Behavior Int16)
input' (Pin (Arduino Int16
n)) [Int16]
interpretvalues = forall ctx t. MkInputSource ctx t -> GenSketch ctx (Behavior t)
mkInput forall a b. (a -> b) -> a -> b
$ 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 = forall a. Monoid a => a
mempty
, 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
" = analogRead(" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Int16
n forall a. Semigroup a => a -> a -> a
<> String
");"]
, inputStream :: Behavior Int16
inputStream = forall a. Typed a => String -> Maybe [a] -> Stream a
extern String
varname Maybe [Int16]
interpretvalues'
}
where
varname :: String
varname = String
"arduino_analog_pin_input" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Int16
n
interpretvalues' :: Maybe [Int16]
interpretvalues'
| forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Int16]
interpretvalues = forall a. Maybe a
Nothing
| Bool
otherwise = forall a. a -> Maybe a
Just [Int16]
interpretvalues
class ShowCType t where
showCType :: Proxy t -> String
instance ShowCType Bool where showCType :: Proxy Bool -> String
showCType Proxy Bool
_ = String
"bool"
instance ShowCType Int8 where showCType :: Proxy Int8 -> String
showCType Proxy Int8
_ = String
"int8_t"
instance ShowCType Int16 where showCType :: Proxy Int16 -> String
showCType Proxy Int16
_ = String
"int16_t"
instance ShowCType Int32 where showCType :: Proxy Int32 -> String
showCType Proxy Int32
_ = String
"int32_t"
instance ShowCType Int64 where showCType :: Proxy Int64 -> String
showCType Proxy Int64
_ = String
"int64_t"
instance ShowCType Word8 where showCType :: Proxy Word8 -> String
showCType Proxy Word8
_ = String
"uint8_t"
instance ShowCType Word16 where showCType :: Proxy Word16 -> String
showCType Proxy Word16
_ = String
"uint16_t"
instance ShowCType Word32 where showCType :: Proxy Word32 -> String
showCType Proxy Word32
_ = String
"uint32_t"
instance ShowCType Word64 where showCType :: Proxy Word64 -> String
showCType Proxy Word64
_ = String
"uint64_t"
instance ShowCType Float where showCType :: Proxy Float -> String
showCType Proxy Float
_ = String
"float"
instance ShowCType Double where showCType :: Proxy Double -> String
showCType Proxy Double
_ = String
"double"
instance Output Arduino Delay MilliSeconds where
Delay
Delay =: :: Delay -> MilliSeconds -> GenSketch Arduino ()
=: (MilliSeconds Stream Word32
n) = do
(GenFramework Arduino
f, String
triggername) <- forall ctx.
String
-> GenFramework ctx -> GenSketch ctx (GenFramework ctx, String)
defineTriggerAlias String
"delay" forall a. Monoid a => a
mempty
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [(String -> TriggerLimit -> Spec
go String
triggername, \TriggerLimit
_ -> GenFramework Arduino
f)]
where
go :: String -> TriggerLimit -> Spec
go String
triggername TriggerLimit
tl =
let c :: Stream Bool
c = TriggerLimit -> Stream Bool
getTriggerLimit TriggerLimit
tl
in String -> Stream Bool -> [Arg] -> Spec
trigger String
triggername Stream Bool
c [forall a. Typed a => Stream a -> Arg
arg Stream Word32
n]
instance Output Arduino Delay MicroSeconds where
Delay
Delay =: :: Delay -> MicroSeconds -> GenSketch Arduino ()
=: (MicroSeconds Stream Word32
n) = do
(GenFramework Arduino
f, String
triggername) <- forall ctx.
String
-> GenFramework ctx -> GenSketch ctx (GenFramework ctx, String)
defineTriggerAlias String
"delayMicroseconds" forall a. Monoid a => a
mempty
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [(String -> TriggerLimit -> Spec
go String
triggername, \TriggerLimit
_ -> GenFramework Arduino
f)]
where
go :: String -> TriggerLimit -> Spec
go String
triggername TriggerLimit
tl =
let c :: Stream Bool
c = TriggerLimit -> Stream Bool
getTriggerLimit TriggerLimit
tl
in String -> Stream Bool -> [Arg] -> Spec
trigger String
triggername Stream Bool
c [forall a. Typed a => Stream a -> Arg
arg Stream Word32
n]