-- | You should not need to import this module unless you're adding support
-- for a specific board supported by Zephyr, or a Zephyr library.

{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE UndecidableInstances #-}

module Copilot.Zephyr.Internals (
	module Copilot.Zephyr.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.Char (toLower, toUpper)

-- | A sketch, implemented using Copilot.
--
-- It's best to think of the `Sketch` as a description of the state of the
-- board at any point in time.
--
-- Under the hood, the `Sketch` is run in a loop. On each iteration, it first
-- reads inputs and then updates outputs as needed.
--
-- While it is a monad, a Sketch's outputs are not updated in any
-- particular order, because Copilot does not guarantee any order.
type Sketch = GenSketch Zephyr

-- | The framework of a sketch.
type Framework = GenFramework Zephyr

-- | A pin on the board.
--
-- For definitions of specific pins, load a module which provides the pins
-- of a particular board.
--
-- A type-level list indicates how a Pin can be used, so the haskell
-- compiler will detect impossible uses of pins.
newtype Pin t = Pin Zephyr
	deriving (Int -> Pin t -> ShowS
[Pin t] -> ShowS
Pin t -> String
(Int -> Pin t -> ShowS)
-> (Pin t -> String) -> ([Pin t] -> ShowS) -> Show (Pin t)
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
$cshowsPrec :: forall k (t :: k). Int -> Pin t -> ShowS
showsPrec :: Int -> Pin t -> ShowS
$cshow :: forall k (t :: k). Pin t -> String
show :: Pin t -> String
$cshowList :: forall k (t :: k). [Pin t] -> ShowS
showList :: [Pin t] -> ShowS
Show, Pin t -> Pin t -> Bool
(Pin t -> Pin t -> Bool) -> (Pin t -> Pin t -> Bool) -> Eq (Pin t)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall k (t :: k). 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
Eq, Eq (Pin t)
Eq (Pin t) =>
(Pin t -> Pin t -> Ordering)
-> (Pin t -> Pin t -> Bool)
-> (Pin t -> Pin t -> Bool)
-> (Pin t -> Pin t -> Bool)
-> (Pin t -> Pin t -> Bool)
-> (Pin t -> Pin t -> Pin t)
-> (Pin t -> Pin t -> Pin t)
-> Ord (Pin t)
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
$ccompare :: forall k (t :: k). Pin t -> Pin t -> Ordering
compare :: Pin t -> Pin t -> Ordering
$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
>= :: Pin t -> Pin t -> Bool
$cmax :: forall k (t :: k). Pin t -> Pin t -> Pin t
max :: Pin t -> Pin t -> Pin t
$cmin :: forall k (t :: k). Pin t -> Pin t -> Pin t
min :: Pin t -> Pin t -> Pin t
Ord)

-- | Indicates that you're programming a board with Zephyr.
-- The similar library arduino-copilot allows programming
-- Arduinos in a very similar style to this one.
data Zephyr = Zephyr GPIOAlias GPIOAddress
	deriving (Int -> Zephyr -> ShowS
[Zephyr] -> ShowS
Zephyr -> String
(Int -> Zephyr -> ShowS)
-> (Zephyr -> String) -> ([Zephyr] -> ShowS) -> Show Zephyr
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Zephyr -> ShowS
showsPrec :: Int -> Zephyr -> ShowS
$cshow :: Zephyr -> String
show :: Zephyr -> String
$cshowList :: [Zephyr] -> ShowS
showList :: [Zephyr] -> ShowS
Show, Zephyr -> Zephyr -> Bool
(Zephyr -> Zephyr -> Bool)
-> (Zephyr -> Zephyr -> Bool) -> Eq Zephyr
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Zephyr -> Zephyr -> Bool
== :: Zephyr -> Zephyr -> Bool
$c/= :: Zephyr -> Zephyr -> Bool
/= :: Zephyr -> Zephyr -> Bool
Eq, Eq Zephyr
Eq Zephyr =>
(Zephyr -> Zephyr -> Ordering)
-> (Zephyr -> Zephyr -> Bool)
-> (Zephyr -> Zephyr -> Bool)
-> (Zephyr -> Zephyr -> Bool)
-> (Zephyr -> Zephyr -> Bool)
-> (Zephyr -> Zephyr -> Zephyr)
-> (Zephyr -> Zephyr -> Zephyr)
-> Ord Zephyr
Zephyr -> Zephyr -> Bool
Zephyr -> Zephyr -> Ordering
Zephyr -> Zephyr -> Zephyr
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
$ccompare :: Zephyr -> Zephyr -> Ordering
compare :: Zephyr -> Zephyr -> Ordering
$c< :: Zephyr -> Zephyr -> Bool
< :: Zephyr -> Zephyr -> Bool
$c<= :: Zephyr -> Zephyr -> Bool
<= :: Zephyr -> Zephyr -> Bool
$c> :: Zephyr -> Zephyr -> Bool
> :: Zephyr -> Zephyr -> Bool
$c>= :: Zephyr -> Zephyr -> Bool
>= :: Zephyr -> Zephyr -> Bool
$cmax :: Zephyr -> Zephyr -> Zephyr
max :: Zephyr -> Zephyr -> Zephyr
$cmin :: Zephyr -> Zephyr -> Zephyr
min :: Zephyr -> Zephyr -> Zephyr
Ord)

instance Context Zephyr

newtype GPIOAlias = GPIOAlias String
	deriving (Int -> GPIOAlias -> ShowS
[GPIOAlias] -> ShowS
GPIOAlias -> String
(Int -> GPIOAlias -> ShowS)
-> (GPIOAlias -> String)
-> ([GPIOAlias] -> ShowS)
-> Show GPIOAlias
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GPIOAlias -> ShowS
showsPrec :: Int -> GPIOAlias -> ShowS
$cshow :: GPIOAlias -> String
show :: GPIOAlias -> String
$cshowList :: [GPIOAlias] -> ShowS
showList :: [GPIOAlias] -> ShowS
Show, GPIOAlias -> GPIOAlias -> Bool
(GPIOAlias -> GPIOAlias -> Bool)
-> (GPIOAlias -> GPIOAlias -> Bool) -> Eq GPIOAlias
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GPIOAlias -> GPIOAlias -> Bool
== :: GPIOAlias -> GPIOAlias -> Bool
$c/= :: GPIOAlias -> GPIOAlias -> Bool
/= :: GPIOAlias -> GPIOAlias -> Bool
Eq, Eq GPIOAlias
Eq GPIOAlias =>
(GPIOAlias -> GPIOAlias -> Ordering)
-> (GPIOAlias -> GPIOAlias -> Bool)
-> (GPIOAlias -> GPIOAlias -> Bool)
-> (GPIOAlias -> GPIOAlias -> Bool)
-> (GPIOAlias -> GPIOAlias -> Bool)
-> (GPIOAlias -> GPIOAlias -> GPIOAlias)
-> (GPIOAlias -> GPIOAlias -> GPIOAlias)
-> Ord GPIOAlias
GPIOAlias -> GPIOAlias -> Bool
GPIOAlias -> GPIOAlias -> Ordering
GPIOAlias -> GPIOAlias -> GPIOAlias
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
$ccompare :: GPIOAlias -> GPIOAlias -> Ordering
compare :: GPIOAlias -> GPIOAlias -> Ordering
$c< :: GPIOAlias -> GPIOAlias -> Bool
< :: GPIOAlias -> GPIOAlias -> Bool
$c<= :: GPIOAlias -> GPIOAlias -> Bool
<= :: GPIOAlias -> GPIOAlias -> Bool
$c> :: GPIOAlias -> GPIOAlias -> Bool
> :: GPIOAlias -> GPIOAlias -> Bool
$c>= :: GPIOAlias -> GPIOAlias -> Bool
>= :: GPIOAlias -> GPIOAlias -> Bool
$cmax :: GPIOAlias -> GPIOAlias -> GPIOAlias
max :: GPIOAlias -> GPIOAlias -> GPIOAlias
$cmin :: GPIOAlias -> GPIOAlias -> GPIOAlias
min :: GPIOAlias -> GPIOAlias -> GPIOAlias
Ord)

data GPIOAddress
	= GPIOAddress String
	-- ^ Eg "porta 17"
	| GPIOAddressBuiltIn
	-- ^ Use when Zephyr defines the GPIO address for a GPIOAlias.
	deriving (Int -> GPIOAddress -> ShowS
[GPIOAddress] -> ShowS
GPIOAddress -> String
(Int -> GPIOAddress -> ShowS)
-> (GPIOAddress -> String)
-> ([GPIOAddress] -> ShowS)
-> Show GPIOAddress
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GPIOAddress -> ShowS
showsPrec :: Int -> GPIOAddress -> ShowS
$cshow :: GPIOAddress -> String
show :: GPIOAddress -> String
$cshowList :: [GPIOAddress] -> ShowS
showList :: [GPIOAddress] -> ShowS
Show, GPIOAddress -> GPIOAddress -> Bool
(GPIOAddress -> GPIOAddress -> Bool)
-> (GPIOAddress -> GPIOAddress -> Bool) -> Eq GPIOAddress
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GPIOAddress -> GPIOAddress -> Bool
== :: GPIOAddress -> GPIOAddress -> Bool
$c/= :: GPIOAddress -> GPIOAddress -> Bool
/= :: GPIOAddress -> GPIOAddress -> Bool
Eq, Eq GPIOAddress
Eq GPIOAddress =>
(GPIOAddress -> GPIOAddress -> Ordering)
-> (GPIOAddress -> GPIOAddress -> Bool)
-> (GPIOAddress -> GPIOAddress -> Bool)
-> (GPIOAddress -> GPIOAddress -> Bool)
-> (GPIOAddress -> GPIOAddress -> Bool)
-> (GPIOAddress -> GPIOAddress -> GPIOAddress)
-> (GPIOAddress -> GPIOAddress -> GPIOAddress)
-> Ord GPIOAddress
GPIOAddress -> GPIOAddress -> Bool
GPIOAddress -> GPIOAddress -> Ordering
GPIOAddress -> GPIOAddress -> GPIOAddress
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
$ccompare :: GPIOAddress -> GPIOAddress -> Ordering
compare :: GPIOAddress -> GPIOAddress -> Ordering
$c< :: GPIOAddress -> GPIOAddress -> Bool
< :: GPIOAddress -> GPIOAddress -> Bool
$c<= :: GPIOAddress -> GPIOAddress -> Bool
<= :: GPIOAddress -> GPIOAddress -> Bool
$c> :: GPIOAddress -> GPIOAddress -> Bool
> :: GPIOAddress -> GPIOAddress -> Bool
$c>= :: GPIOAddress -> GPIOAddress -> Bool
>= :: GPIOAddress -> GPIOAddress -> Bool
$cmax :: GPIOAddress -> GPIOAddress -> GPIOAddress
max :: GPIOAddress -> GPIOAddress -> GPIOAddress
$cmin :: GPIOAddress -> GPIOAddress -> GPIOAddress
min :: GPIOAddress -> GPIOAddress -> GPIOAddress
Ord)

instance IsDigitalIOPin t => Output Zephyr (Pin t) (Event () (Stream Bool)) where
	(Pin p :: Zephyr
p@(Zephyr (GPIOAlias String
n) GPIOAddress
_)) =: :: Pin t -> Event () (Stream Bool) -> GenSketch Zephyr ()
=: (Event Stream Bool
b Stream Bool
c) = do
		(GenFramework Zephyr
f, String
triggername) <- String
-> GenFramework Zephyr
-> GenSketch Zephyr (GenFramework Zephyr, String)
forall ctx.
String
-> GenFramework ctx -> GenSketch ctx (GenFramework ctx, String)
defineTriggerAlias String
pinsetfunc GenFramework Zephyr
basef
		[(TriggerLimit -> Spec, TriggerLimit -> GenFramework Zephyr)]
-> GenSketch Zephyr ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [(String -> TriggerLimit -> Spec
go String
triggername, GenFramework Zephyr -> TriggerLimit -> GenFramework Zephyr
forall a b. a -> b -> a
const GenFramework Zephyr
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' [Stream Bool -> Arg
forall a. Typed a => Stream a -> Arg
arg Stream Bool
b]
		basef :: GenFramework Zephyr
basef = (forall ctx. Context ctx => GenFramework ctx
emptyFramework @Zephyr)
				{ pinmodes = M.singleton p (S.singleton OutputMode)
				, defines = (\[CLine]
v -> [[CLine] -> CChunk
CChunk [CLine]
v])
					[ CLine $ "static inline int " 
						<> pinsetfunc
						<> "(int value) {"
					, CLine $ "  return gpio_pin_set"
						<> "(" <> pinDevVar n
						<> ", " <> pinDevDef n
						<> ", value);"
					, CLine "}"
					]
				}
		pinsetfunc :: String
pinsetfunc = String
"gpio_pin_set_" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> (Char -> Char) -> ShowS
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower String
n

pinDevVar :: String -> String
pinDevVar :: ShowS
pinDevVar String
n = String
"pin_dev_" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> (Char -> Char) -> ShowS
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower String
n

pinDevDef :: String -> String
pinDevDef :: ShowS
pinDevDef String
n = String
"PIN_DEV_" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> (Char -> Char) -> ShowS
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toUpper String
n

pinDevNode :: String -> String
pinDevNode :: ShowS
pinDevNode String
n = ShowS
pinDevDef String
n String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"_NODE"

-- FIXME for zephyr
instance IsPWMPin t => Output Zephyr (Pin t) (Event 'PWM (Stream Word8)) where
	(Pin (Zephyr (GPIOAlias String
n) GPIOAddress
_)) =: :: Pin t -> Event 'PWM (Stream Word8) -> GenSketch Zephyr ()
=: (Event Stream Word8
v Stream Bool
c) = do
		(GenFramework Zephyr
f, String
triggername) <- String
-> String
-> GenFramework Zephyr
-> GenSketch Zephyr (GenFramework Zephyr, String)
forall ctx.
String
-> String
-> GenFramework ctx
-> GenSketch ctx (GenFramework ctx, String)
defineTriggerAlias' (String
"pin_" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
n) String
"analogWrite" GenFramework Zephyr
forall a. Monoid a => a
mempty
		[(TriggerLimit -> Spec, TriggerLimit -> GenFramework Zephyr)]
-> GenSketch Zephyr ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [(String -> TriggerLimit -> Spec
go String
triggername, GenFramework Zephyr -> TriggerLimit -> GenFramework Zephyr
forall a b. a -> b -> a
const GenFramework Zephyr
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' [Stream Word8 -> Arg
forall a. Typed a => Stream a -> Arg
arg Stream Word8
v]
		-- analogWrite does not need any pinmodes set up

instance IsDigitalIOPin t => Input Zephyr (Pin t) Bool where
	input' :: Pin t -> [Bool] -> GenSketch Zephyr (Stream Bool)
input' (Pin p :: Zephyr
p@(Zephyr (GPIOAlias String
n) GPIOAddress
_)) [Bool]
interpretvalues = MkInputSource Zephyr Bool -> GenSketch Zephyr (Stream Bool)
forall ctx t. MkInputSource ctx t -> GenSketch ctx (Behavior t)
mkInput (MkInputSource Zephyr Bool -> GenSketch Zephyr (Stream Bool))
-> MkInputSource Zephyr Bool -> GenSketch Zephyr (Stream Bool)
forall a b. (a -> b) -> a -> b
$ InputSource
		{ defineVar :: [CChunk]
defineVar = [CLine] -> [CChunk]
mkCChunk 
			[ String -> CLine
CLine (String -> CLine) -> String -> CLine
forall a b. (a -> b) -> a -> b
$ String
"bool " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
varname String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
";"
			, String -> CLine
CLine (String -> CLine) -> String -> CLine
forall a b. (a -> b) -> a -> b
$ String
"static const struct gpio_dt_spec " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
specname
				String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" = GPIO_DT_SPEC_GET_OR(" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
nodename String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
", gpios, {0});"
			]
		, setupInput :: [CChunk]
setupInput = [CChunk]
forall a. Monoid a => a
mempty
		, inputPinmode :: Map Zephyr PinMode
inputPinmode = Zephyr -> PinMode -> Map Zephyr PinMode
forall k a. k -> a -> Map k a
M.singleton Zephyr
p PinMode
InputMode
		, readInput :: [CChunk]
readInput = [CLine] -> [CChunk]
mkCChunk
			[String -> CLine
CLine (String -> CLine) -> String -> CLine
forall a b. (a -> b) -> a -> b
$ String
varname String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" = gpio_pin_get_dt(&" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
specname String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
");"]
		, inputStream :: Stream Bool
inputStream = String -> Maybe [Bool] -> Stream Bool
forall a. Typed a => String -> Maybe [a] -> Stream a
extern String
varname Maybe [Bool]
interpretvalues'
		}
	  where
		varname :: String
varname = String
"zephyr_digital_pin_input_" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
n
		specname :: String
specname = String
"zephyr_digital_pin_dt_spec_" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
n
		nodename :: String
nodename = ShowS
pinDevNode String
n
		interpretvalues' :: Maybe [Bool]
interpretvalues'
			| [Bool] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Bool]
interpretvalues = Maybe [Bool]
forall a. Maybe a
Nothing
			| Bool
otherwise = [Bool] -> Maybe [Bool]
forall a. a -> Maybe a
Just [Bool]
interpretvalues

-- | Value read from an ADC. Ranges from 0-1023.
type ADC = Int16

-- FIXME for zephyr
instance IsAnalogInputPin t => Input Zephyr (Pin t) ADC where
	input' :: Pin t -> [ADC] -> GenSketch Zephyr (Behavior ADC)
input' (Pin (Zephyr (GPIOAlias String
n) GPIOAddress
_)) [ADC]
interpretvalues = MkInputSource Zephyr ADC -> GenSketch Zephyr (Behavior ADC)
forall ctx t. MkInputSource ctx t -> GenSketch ctx (Behavior t)
mkInput (MkInputSource Zephyr ADC -> GenSketch Zephyr (Behavior ADC))
-> MkInputSource Zephyr ADC -> GenSketch Zephyr (Behavior ADC)
forall a b. (a -> b) -> a -> b
$ InputSource
		{ defineVar :: [CChunk]
defineVar = [CLine] -> [CChunk]
mkCChunk [String -> CLine
CLine (String -> CLine) -> String -> CLine
forall a b. (a -> b) -> a -> b
$ String
"int " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
varname String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
";"]
		, setupInput :: [CChunk]
setupInput = [CChunk]
forall a. Monoid a => a
mempty
		, inputPinmode :: Map Zephyr PinMode
inputPinmode = Map Zephyr PinMode
forall a. Monoid a => a
mempty
		, readInput :: [CChunk]
readInput = [CLine] -> [CChunk]
mkCChunk
			[String -> CLine
CLine (String -> CLine) -> String -> CLine
forall a b. (a -> b) -> a -> b
$ String
varname String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" = analogRead(" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ShowS
forall a. Show a => a -> String
show String
n String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
");"]
		, inputStream :: Behavior ADC
inputStream = String -> Maybe [ADC] -> Behavior ADC
forall a. Typed a => String -> Maybe [a] -> Stream a
extern String
varname Maybe [ADC]
interpretvalues'
		}
	  where
		varname :: String
varname = String
"zephyr_analog_pin_input_" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ShowS
forall a. Show a => a -> String
show String
n
		interpretvalues' :: Maybe [ADC]
interpretvalues'
			| [ADC] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ADC]
interpretvalues = Maybe [ADC]
forall a. Maybe a
Nothing
			| Bool
otherwise = [ADC] -> Maybe [ADC]
forall a. a -> Maybe a
Just [ADC]
interpretvalues

instance Output Zephyr Delay MilliSeconds where
	Delay
Delay =: :: Delay -> MilliSeconds -> GenSketch Zephyr ()
=: (MilliSeconds Stream Word32
n) = do
		(GenFramework Zephyr
f, String
triggername) <- String
-> GenFramework Zephyr
-> GenSketch Zephyr (GenFramework Zephyr, String)
forall ctx.
String
-> GenFramework ctx -> GenSketch ctx (GenFramework ctx, String)
defineTriggerAlias String
"k_msleep" GenFramework Zephyr
forall a. Monoid a => a
mempty
		[(TriggerLimit -> Spec, TriggerLimit -> GenFramework Zephyr)]
-> GenSketch Zephyr ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [(String -> TriggerLimit -> Spec
go String
triggername, \TriggerLimit
_ -> GenFramework Zephyr
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 [Stream Word32 -> Arg
forall a. Typed a => Stream a -> Arg
arg Stream Word32
n]

instance Output Zephyr Delay MicroSeconds where
	Delay
Delay =: :: Delay -> MicroSeconds -> GenSketch Zephyr ()
=: (MicroSeconds Stream Word32
n) = do
		(GenFramework Zephyr
f, String
triggername) <- String
-> GenFramework Zephyr
-> GenSketch Zephyr (GenFramework Zephyr, String)
forall ctx.
String
-> GenFramework ctx -> GenSketch ctx (GenFramework ctx, String)
defineTriggerAlias String
"k_usleep" GenFramework Zephyr
forall a. Monoid a => a
mempty
		[(TriggerLimit -> Spec, TriggerLimit -> GenFramework Zephyr)]
-> GenSketch Zephyr ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [(String -> TriggerLimit -> Spec
go String
triggername, \TriggerLimit
_ -> GenFramework Zephyr
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 [Stream Word32 -> Arg
forall a. Typed a => Stream a -> Arg
arg Stream Word32
n]