-- | EEPROMex library for arduino-copilot.
--
-- This module is designed to be imported qualified.
--
-- This is an interface to the C EEPROMex library, which will need to be
-- installed in your Arduino development environment.
-- https://playground.arduino.cc/Code/EEPROMex/

{-# LANGUAGE RebindableSyntax #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE TypeFamilies #-}

module Copilot.Arduino.Library.EEPROMex (
	-- * Configuration
	maxAllowedWrites,
	memPool,
	StartAddress(..),
	EndAddress(..),
	EEPROMable,
	-- * Single values
	alloc,
	alloc',
	Location,
	-- * Ranges
	Range,
	RangeIndex,
	allocRange,
	sweepRange,
	sweepRange',
	RangeWrites(..),
	scanRange,
	RangeReads(..),
) where

import Copilot.Arduino
import Copilot.Arduino.Internals
import Control.Monad.Writer
import Data.Proxy
import qualified Prelude

-- | Set the maximum number of writes to EEPROM that can be made while
-- the Arduino is running. When too many writes have been made,
-- it will no longer write to the EEPROM, and will send warning
-- messages to the serial port.
--
-- This is a strongly encouraged safety measure to use, because the
-- Arduino's EEPROM can only endure around 100,000 writes, and
-- a Sketch that's constantly writing to EEPROM, without a well chosen 
-- `:@` rate limit or `delay`, could damage your hardware in just a few
-- minutes.
--
-- Note that this module uses EEPROMex's update facility for all writes
-- to EEPROM. That avoids writing a byte when its current value is
-- the same as what needed to be written. That prevents excessive wear
-- in some cases, but you should still use maxAllowedWrites too.
--
-- For this to work, CPPFLAGS needs to include "-D_EEPROMEX_DEBUG" when the
-- EEPROMex C library gets built. When you use this, it generates C
-- code that makes sure that is enabled.
maxAllowedWrites :: Word16 -> Sketch ()
maxAllowedWrites :: RangeIndex -> Sketch ()
maxAllowedWrites RangeIndex
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
		{ earlySetups :: [CChunk]
earlySetups = [CLine] -> [CChunk]
mkCChunk
			[ String -> CLine
CLine String
"#ifdef _EEPROMEX_DEBUG"
			, String -> CLine
CLine forall a b. (a -> b) -> a -> b
$ String
"EEPROM.setMaxAllowedWrites(" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show RangeIndex
n forall a. Semigroup a => a -> a -> a
<> String
");"
			, String -> CLine
CLine String
"#else"
			, String -> CLine
CLine String
"#error \"maxAllowedWrites cannot be checked because _EEPROMEX_DEBUG is not set.\""
			, String -> CLine
CLine String
"#endif"
			]
		, defines :: [CChunk]
defines = [CLine] -> [CChunk]
mkCChunk [ CLine
includeCLine ]
		}

-- | The address of the first byte of the EEPROM that will be allocated
-- by `alloc`. The default is to start allocation from 0. 
--
-- Picking a different StartAddress can avoid overwriting the 
-- part of the EEPROM that is used by some other program.
newtype StartAddress = StartAddress Word16
	deriving (Integer -> StartAddress
StartAddress -> StartAddress
StartAddress -> StartAddress -> StartAddress
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> StartAddress
$cfromInteger :: Integer -> StartAddress
signum :: StartAddress -> StartAddress
$csignum :: StartAddress -> StartAddress
abs :: StartAddress -> StartAddress
$cabs :: StartAddress -> StartAddress
negate :: StartAddress -> StartAddress
$cnegate :: StartAddress -> StartAddress
* :: StartAddress -> StartAddress -> StartAddress
$c* :: StartAddress -> StartAddress -> StartAddress
- :: StartAddress -> StartAddress -> StartAddress
$c- :: StartAddress -> StartAddress -> StartAddress
+ :: StartAddress -> StartAddress -> StartAddress
$c+ :: StartAddress -> StartAddress -> StartAddress
Num, StartAddress -> StartAddress -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StartAddress -> StartAddress -> Bool
$c/= :: StartAddress -> StartAddress -> Bool
== :: StartAddress -> StartAddress -> Bool
$c== :: StartAddress -> StartAddress -> Bool
Eq, Eq StartAddress
StartAddress -> StartAddress -> Bool
StartAddress -> StartAddress -> Ordering
StartAddress -> StartAddress -> StartAddress
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 :: StartAddress -> StartAddress -> StartAddress
$cmin :: StartAddress -> StartAddress -> StartAddress
max :: StartAddress -> StartAddress -> StartAddress
$cmax :: StartAddress -> StartAddress -> StartAddress
>= :: StartAddress -> StartAddress -> Bool
$c>= :: StartAddress -> StartAddress -> Bool
> :: StartAddress -> StartAddress -> Bool
$c> :: StartAddress -> StartAddress -> Bool
<= :: StartAddress -> StartAddress -> Bool
$c<= :: StartAddress -> StartAddress -> Bool
< :: StartAddress -> StartAddress -> Bool
$c< :: StartAddress -> StartAddress -> Bool
compare :: StartAddress -> StartAddress -> Ordering
$ccompare :: StartAddress -> StartAddress -> Ordering
Ord, Int -> StartAddress
StartAddress -> Int
StartAddress -> [StartAddress]
StartAddress -> StartAddress
StartAddress -> StartAddress -> [StartAddress]
StartAddress -> StartAddress -> StartAddress -> [StartAddress]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: StartAddress -> StartAddress -> StartAddress -> [StartAddress]
$cenumFromThenTo :: StartAddress -> StartAddress -> StartAddress -> [StartAddress]
enumFromTo :: StartAddress -> StartAddress -> [StartAddress]
$cenumFromTo :: StartAddress -> StartAddress -> [StartAddress]
enumFromThen :: StartAddress -> StartAddress -> [StartAddress]
$cenumFromThen :: StartAddress -> StartAddress -> [StartAddress]
enumFrom :: StartAddress -> [StartAddress]
$cenumFrom :: StartAddress -> [StartAddress]
fromEnum :: StartAddress -> Int
$cfromEnum :: StartAddress -> Int
toEnum :: Int -> StartAddress
$ctoEnum :: Int -> StartAddress
pred :: StartAddress -> StartAddress
$cpred :: StartAddress -> StartAddress
succ :: StartAddress -> StartAddress
$csucc :: StartAddress -> StartAddress
Enum, Int -> StartAddress -> ShowS
[StartAddress] -> ShowS
StartAddress -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StartAddress] -> ShowS
$cshowList :: [StartAddress] -> ShowS
show :: StartAddress -> String
$cshow :: StartAddress -> String
showsPrec :: Int -> StartAddress -> ShowS
$cshowsPrec :: Int -> StartAddress -> ShowS
Show, ReadPrec [StartAddress]
ReadPrec StartAddress
Int -> ReadS StartAddress
ReadS [StartAddress]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [StartAddress]
$creadListPrec :: ReadPrec [StartAddress]
readPrec :: ReadPrec StartAddress
$creadPrec :: ReadPrec StartAddress
readList :: ReadS [StartAddress]
$creadList :: ReadS [StartAddress]
readsPrec :: Int -> ReadS StartAddress
$creadsPrec :: Int -> ReadS StartAddress
Read, StartAddress
forall a. a -> a -> Bounded a
maxBound :: StartAddress
$cmaxBound :: StartAddress
minBound :: StartAddress
$cminBound :: StartAddress
Bounded, Enum StartAddress
Real StartAddress
StartAddress -> Integer
StartAddress -> StartAddress -> (StartAddress, StartAddress)
StartAddress -> StartAddress -> StartAddress
forall a.
Real a
-> Enum a
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> (a, a))
-> (a -> a -> (a, a))
-> (a -> Integer)
-> Integral a
toInteger :: StartAddress -> Integer
$ctoInteger :: StartAddress -> Integer
divMod :: StartAddress -> StartAddress -> (StartAddress, StartAddress)
$cdivMod :: StartAddress -> StartAddress -> (StartAddress, StartAddress)
quotRem :: StartAddress -> StartAddress -> (StartAddress, StartAddress)
$cquotRem :: StartAddress -> StartAddress -> (StartAddress, StartAddress)
mod :: StartAddress -> StartAddress -> StartAddress
$cmod :: StartAddress -> StartAddress -> StartAddress
div :: StartAddress -> StartAddress -> StartAddress
$cdiv :: StartAddress -> StartAddress -> StartAddress
rem :: StartAddress -> StartAddress -> StartAddress
$crem :: StartAddress -> StartAddress -> StartAddress
quot :: StartAddress -> StartAddress -> StartAddress
$cquot :: StartAddress -> StartAddress -> StartAddress
Integral, Num StartAddress
Ord StartAddress
StartAddress -> Rational
forall a. Num a -> Ord a -> (a -> Rational) -> Real a
toRational :: StartAddress -> Rational
$ctoRational :: StartAddress -> Rational
Real)

-- | The address of the last byte of the EEPROM that can be allocated
-- by `alloc`. The default is to allow allocating 512 bytes.
--
-- Modules for particular boards, such as Copilot.Arduino.Library.Uno,
-- each define a sizeOfEEPROM value, so to use the entire EEPROM, use:
--
-- > EndAddress sizeOfEEPROM
newtype EndAddress = EndAddress Word16
	deriving (Integer -> EndAddress
EndAddress -> EndAddress
EndAddress -> EndAddress -> EndAddress
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> EndAddress
$cfromInteger :: Integer -> EndAddress
signum :: EndAddress -> EndAddress
$csignum :: EndAddress -> EndAddress
abs :: EndAddress -> EndAddress
$cabs :: EndAddress -> EndAddress
negate :: EndAddress -> EndAddress
$cnegate :: EndAddress -> EndAddress
* :: EndAddress -> EndAddress -> EndAddress
$c* :: EndAddress -> EndAddress -> EndAddress
- :: EndAddress -> EndAddress -> EndAddress
$c- :: EndAddress -> EndAddress -> EndAddress
+ :: EndAddress -> EndAddress -> EndAddress
$c+ :: EndAddress -> EndAddress -> EndAddress
Num, EndAddress -> EndAddress -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EndAddress -> EndAddress -> Bool
$c/= :: EndAddress -> EndAddress -> Bool
== :: EndAddress -> EndAddress -> Bool
$c== :: EndAddress -> EndAddress -> Bool
Eq, Eq EndAddress
EndAddress -> EndAddress -> Bool
EndAddress -> EndAddress -> Ordering
EndAddress -> EndAddress -> EndAddress
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 :: EndAddress -> EndAddress -> EndAddress
$cmin :: EndAddress -> EndAddress -> EndAddress
max :: EndAddress -> EndAddress -> EndAddress
$cmax :: EndAddress -> EndAddress -> EndAddress
>= :: EndAddress -> EndAddress -> Bool
$c>= :: EndAddress -> EndAddress -> Bool
> :: EndAddress -> EndAddress -> Bool
$c> :: EndAddress -> EndAddress -> Bool
<= :: EndAddress -> EndAddress -> Bool
$c<= :: EndAddress -> EndAddress -> Bool
< :: EndAddress -> EndAddress -> Bool
$c< :: EndAddress -> EndAddress -> Bool
compare :: EndAddress -> EndAddress -> Ordering
$ccompare :: EndAddress -> EndAddress -> Ordering
Ord, Int -> EndAddress
EndAddress -> Int
EndAddress -> [EndAddress]
EndAddress -> EndAddress
EndAddress -> EndAddress -> [EndAddress]
EndAddress -> EndAddress -> EndAddress -> [EndAddress]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: EndAddress -> EndAddress -> EndAddress -> [EndAddress]
$cenumFromThenTo :: EndAddress -> EndAddress -> EndAddress -> [EndAddress]
enumFromTo :: EndAddress -> EndAddress -> [EndAddress]
$cenumFromTo :: EndAddress -> EndAddress -> [EndAddress]
enumFromThen :: EndAddress -> EndAddress -> [EndAddress]
$cenumFromThen :: EndAddress -> EndAddress -> [EndAddress]
enumFrom :: EndAddress -> [EndAddress]
$cenumFrom :: EndAddress -> [EndAddress]
fromEnum :: EndAddress -> Int
$cfromEnum :: EndAddress -> Int
toEnum :: Int -> EndAddress
$ctoEnum :: Int -> EndAddress
pred :: EndAddress -> EndAddress
$cpred :: EndAddress -> EndAddress
succ :: EndAddress -> EndAddress
$csucc :: EndAddress -> EndAddress
Enum, Int -> EndAddress -> ShowS
[EndAddress] -> ShowS
EndAddress -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EndAddress] -> ShowS
$cshowList :: [EndAddress] -> ShowS
show :: EndAddress -> String
$cshow :: EndAddress -> String
showsPrec :: Int -> EndAddress -> ShowS
$cshowsPrec :: Int -> EndAddress -> ShowS
Show, ReadPrec [EndAddress]
ReadPrec EndAddress
Int -> ReadS EndAddress
ReadS [EndAddress]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [EndAddress]
$creadListPrec :: ReadPrec [EndAddress]
readPrec :: ReadPrec EndAddress
$creadPrec :: ReadPrec EndAddress
readList :: ReadS [EndAddress]
$creadList :: ReadS [EndAddress]
readsPrec :: Int -> ReadS EndAddress
$creadsPrec :: Int -> ReadS EndAddress
Read, EndAddress
forall a. a -> a -> Bounded a
maxBound :: EndAddress
$cmaxBound :: EndAddress
minBound :: EndAddress
$cminBound :: EndAddress
Bounded, Enum EndAddress
Real EndAddress
EndAddress -> Integer
EndAddress -> EndAddress -> (EndAddress, EndAddress)
EndAddress -> EndAddress -> EndAddress
forall a.
Real a
-> Enum a
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> (a, a))
-> (a -> a -> (a, a))
-> (a -> Integer)
-> Integral a
toInteger :: EndAddress -> Integer
$ctoInteger :: EndAddress -> Integer
divMod :: EndAddress -> EndAddress -> (EndAddress, EndAddress)
$cdivMod :: EndAddress -> EndAddress -> (EndAddress, EndAddress)
quotRem :: EndAddress -> EndAddress -> (EndAddress, EndAddress)
$cquotRem :: EndAddress -> EndAddress -> (EndAddress, EndAddress)
mod :: EndAddress -> EndAddress -> EndAddress
$cmod :: EndAddress -> EndAddress -> EndAddress
div :: EndAddress -> EndAddress -> EndAddress
$cdiv :: EndAddress -> EndAddress -> EndAddress
rem :: EndAddress -> EndAddress -> EndAddress
$crem :: EndAddress -> EndAddress -> EndAddress
quot :: EndAddress -> EndAddress -> EndAddress
$cquot :: EndAddress -> EndAddress -> EndAddress
Integral, Num EndAddress
Ord EndAddress
EndAddress -> Rational
forall a. Num a -> Ord a -> (a -> Rational) -> Real a
toRational :: EndAddress -> Rational
$ctoRational :: EndAddress -> Rational
Real)

-- | Configure the EEPROM memory pool that the program can use.
--
-- > EEPROM.memPool 0 (EndAddress sizeOfEEPROM)
memPool :: StartAddress -> EndAddress -> Sketch ()
memPool :: StartAddress -> EndAddress -> Sketch ()
memPool (StartAddress RangeIndex
start) (EndAddress RangeIndex
end) =
	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
		-- setMemPool() has to come before any
		-- getAddress(), so do it in earlySetups.
		{ earlySetups :: [CChunk]
earlySetups = [CLine] -> [CChunk]
mkCChunk
			[ String -> CLine
CLine forall a b. (a -> b) -> a -> b
$ String
"EEPROM.setMemPool("
				forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show RangeIndex
start
				forall a. Semigroup a => a -> a -> a
<> String
", "
				forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show RangeIndex
end
				forall a. Semigroup a => a -> a -> a
<> String
");"
			]
		, defines :: [CChunk]
defines = [CLine] -> [CChunk]
mkCChunk [ CLine
includeCLine ]
		}

-- | Allocates a location in the EEPROM. 
--
-- Two things are returned; first a `Behavior` which contains a value
-- read from the EEPROM at boot; and secondly a `Location` that can be
-- written to later on.
--
-- Here's an example of using it, to remember the maximum value read from
-- a1, persistently across power cycles.
--
-- > EEPROM.maxAllowedWrites 100
-- > (bootval, eepromloc) <- EEPROM.alloc
-- > currval <- input a1 :: Sketch (Behavior ADC)
-- > let maxval = [maxBound] ++ if currval > bootval then currval else bootval
-- > eepromloc =: currval @: (currval > maxval)
-- > delay =: MilliSeconds (constant 10000)
--
-- Of course, the EEPROM could already contain any value at the allocated
-- location to start with (either some default value or something written
-- by another program). So you'll need to first boot up a sketch that zeros
-- it out before using the sketch above. Here's a simple sketch that zeros
-- two values:
--
-- > EEPROM.maxAllowedWrites 100
-- > (_, eepromloc1) <- EEPROM.alloc
-- > (_, eepromloc2) <- EEPROM.alloc
-- > eepromloc1 =: constant (0 :: ADC) :@ firstIteration
-- > eepromloc2 =: constant (0 :: Word16) :@ firstIteration
-- 
-- `alloc` can be used as many times as you want, storing multiple values
-- in the EEPROM, up to the limit of the size of the EEPROM.
-- (Which is not statically checked.)
--
-- Do note that the EEPROM layout is controlled by the order of calls to
-- `alloc`, so take care when reordering or deleting calls.
alloc :: forall t. (EEPROMable t) => Sketch (Behavior t, Location t)
alloc :: forall t. EEPROMable t => Sketch (Behavior t, Location t)
alloc = forall t. EEPROMable t => t -> Sketch (Behavior t, Location t)
alloc' (forall t. EEPROMable t => Proxy t -> t
factoryValue (forall {k} (t :: k). Proxy t
Proxy @t))

-- | Same as `alloc'`, but with a value which will be used
-- as the EEPROM's boot value when interpreting the Sketch,
-- instead of the default of acting as if all bits of the EEPROM are
-- set.
alloc' :: forall t. (EEPROMable t) => t -> Sketch (Behavior t, Location t)
alloc' :: forall t. EEPROMable t => t -> Sketch (Behavior t, Location t)
alloc' t
interpretval = do
	UniqueId
i <- forall ctx. String -> GenSketch ctx UniqueId
getUniqueId String
"eeprom"
	let addrvarname :: String
addrvarname = String -> UniqueId -> String
uniqueName String
"eeprom_address" UniqueId
i
	let bootvarname :: String
bootvarname = String -> UniqueId -> String
uniqueName String
"eeprom_boot_val" UniqueId
i
	let proxy :: Proxy t
proxy = forall {k} (t :: k). Proxy t
Proxy @t
	Behavior t
bootval <- forall ctx t. MkInputSource ctx t -> GenSketch ctx (Behavior t)
mkInput forall a b. (a -> b) -> a -> b
$ InputSource
		{ defineVar :: [CChunk]
defineVar = 
			[ [CLine] -> CChunk
CChunk [CLine
includeCLine]
			, [CLine] -> CChunk
CChunk
				[ String -> CLine
CLine forall a b. (a -> b) -> a -> b
$ String
"int " forall a. Semigroup a => a -> a -> a
<> String
addrvarname forall a. Semigroup a => a -> a -> a
<> String
";"
				, String -> CLine
CLine forall a b. (a -> b) -> a -> b
$ forall {k} (t :: k). ShowCType t => Proxy t -> String
showCType Proxy t
proxy forall a. Semigroup a => a -> a -> a
<> String
" " forall a. Semigroup a => a -> a -> a
<> String
bootvarname forall a. Semigroup a => a -> a -> a
<> String
";"
				, String -> CLine
CLine forall a b. (a -> b) -> a -> b
$ String
"void " forall a. Semigroup a => a -> a -> a
<> UniqueId -> String
eepromWriterName UniqueId
i
					forall a. Semigroup a => a -> a -> a
<> String
"(" forall a. Semigroup a => a -> a -> a
<> forall {k} (t :: k). ShowCType t => Proxy t -> String
showCType Proxy t
proxy forall a. Semigroup a => a -> a -> a
<> String
" value) {"
				, String -> CLine
CLine forall a b. (a -> b) -> a -> b
$ String
"  EEPROM." forall a. Semigroup a => a -> a -> a
<> forall t. EEPROMable t => Proxy t -> String
writeValue Proxy t
proxy
					forall a. Semigroup a => a -> a -> a
<> String
"(" forall a. Semigroup a => a -> a -> a
<> String
addrvarname forall a. Semigroup a => a -> a -> a
<> String
", value);"
				, String -> CLine
CLine String
"}"
				]
			]
		, setupInput :: [CChunk]
setupInput = [CLine] -> [CChunk]
mkCChunk
			[ String -> CLine
CLine forall a b. (a -> b) -> a -> b
$ String
addrvarname forall a. Semigroup a => a -> a -> a
<> 
				String
" = EEPROM.getAddress(sizeof(" 
				forall a. Semigroup a => a -> a -> a
<> forall {k} (t :: k). ShowCType t => Proxy t -> String
showCType Proxy t
proxy forall a. Semigroup a => a -> a -> a
<> String
"));"
			, String -> CLine
CLine forall a b. (a -> b) -> a -> b
$ String
bootvarname forall a. Semigroup a => a -> a -> a
<>
				String
" = EEPROM."
				forall a. Semigroup a => a -> a -> a
<> forall t. EEPROMable t => Proxy t -> String
readValue Proxy t
proxy forall a. Semigroup a => a -> a -> a
<> String
"(" forall a. Semigroup a => a -> a -> a
<> String
addrvarname forall a. Semigroup a => a -> a -> a
<> String
");"
			]
		, readInput :: [CChunk]
readInput = []
		, inputStream :: Behavior t
inputStream = forall a. Typed a => String -> Maybe [a] -> Stream a
extern String
bootvarname (forall a. a -> Maybe a
Just (forall a. a -> [a]
repeat t
interpretval))
		, inputPinmode :: Map Arduino PinMode
inputPinmode = forall a. Monoid a => a
mempty
		}
	forall (m :: * -> *) a. Monad m => a -> m a
return (Behavior t
bootval, forall t. UniqueId -> Location t
Location UniqueId
i)

eepromWriterName :: UniqueId -> String
eepromWriterName :: UniqueId -> String
eepromWriterName = String -> UniqueId -> String
uniqueName' String
"eeprom_write"

data Location t = Location UniqueId

instance EEPROMable t => Output Arduino (Location t) (Event () (Stream t)) where
	Location UniqueId
i =: :: Location t -> Event () (Stream t) -> Sketch ()
=: (Event Stream t
v Stream Bool
c) = do
		(GenFramework Arduino
f, String
triggername) <- forall ctx.
String
-> GenFramework ctx -> GenSketch ctx (GenFramework ctx, String)
defineTriggerAlias (UniqueId -> String
eepromWriterName UniqueId
i) forall a. Monoid a => a
mempty
		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. Typed a => Stream a -> Arg
arg Stream t
v]

-- | A range of values in the EEPROM.
data Range t = Range
	{ forall t. Range t -> Location (Range t)
rangeLocation :: Location (Range t)
	, forall t. Range t -> RangeIndex
rangeSize :: Word16 -- ^ number of `t` values in the Range
	}

-- | Allocates a Range in the EEPROM, which stores the specified number of
-- items of some type.
--
-- This is an example of using a range of the EEPROM as a ring buffer,
-- to store the last 100 values read from a1.
--
-- > EEPROM.maxAllowedWrites 1000
-- > range <- EEPROM.allocRange 100 :: Sketch (EEPROM.Range ADC)
-- > currval <- input a1 :: Sketch (Behavior ADC)
-- > range =: EEPROM.sweepRange 0 currval
-- > delay =: MilliSeconds (constant 10000)
--
-- `allocRange` can be used as many times as you want, and combined with
-- uses of `alloc`, up to the size of the EEPROM. 
-- (Which is not statically checked.)
--
-- Do note that the EEPROM layout is controlled by the order of calls to
-- `allocRange` and `alloc`, so take care when reordering or deleting calls.
allocRange :: (EEPROMable t) => Word16 -> Sketch (Range t)
allocRange :: forall t. EEPROMable t => RangeIndex -> Sketch (Range t)
allocRange RangeIndex
sz = do
	UniqueId
i <- forall ctx. String -> GenSketch ctx UniqueId
getUniqueId String
"eeprom"
	forall (m :: * -> *) a. Monad m => a -> m a
return (forall t. Location (Range t) -> RangeIndex -> Range t
Range (forall t. UniqueId -> Location t
Location UniqueId
i) RangeIndex
sz)

-- | Description of writes made to a Range.
--
-- This can be turned into an `Event` by using `@:` with it, and that's
-- what the Behavior Bool is needed for. Consider this example,
-- that ignores the Behavior Bool, and just uses a counter for the
-- `RangeIndex`:
--
-- > range =: EEPROM.RangeWrites (\_ -> counter) (constant 0) @: blinking
--
-- The use of `@:` `blinking` makes an `Event` that only occurs on every other
-- iteration of the Sketch. But, the counter increases on every
-- iteration of the Sketch. So that will only write to every other value
-- in the `Range`.
--
-- The Behavior Bool is only True when an event occurs, and so
-- it can be used to avoid incrementing the counter otherwise. See
--`sweepRange'` for an example.
data RangeWrites t = RangeWrites
	(Behavior Bool -> Behavior RangeIndex) 
	(Behavior t)

-- | An index into a Range. 0 is the first value in the Range.
--
-- Indexes larger than the size of the Range will not overflow it,
-- instead they loop back to the start of the Range.
type RangeIndex = Word16

instance EEPROMable t => Output Arduino (Range t) (RangeWrites t) where
	=: :: Range t -> RangeWrites t -> Sketch ()
(=:) = forall t.
EEPROMable t =>
Stream Bool -> Range t -> RangeWrites t -> Sketch ()
writeRange Stream Bool
true

instance EEPROMable t => Output Arduino (Range t) (Event () (RangeWrites t)) where
	Range t
range =: :: Range t -> Event () (RangeWrites t) -> Sketch ()
=: Event RangeWrites t
ws Stream Bool
c = 
		forall t.
EEPROMable t =>
Stream Bool -> Range t -> RangeWrites t -> Sketch ()
writeRange Stream Bool
c Range t
range RangeWrites t
ws

instance EEPROMable t => IsBehavior (RangeWrites t) where
	@: :: RangeWrites t -> Stream Bool -> BehaviorToEvent (RangeWrites t)
(@:) = forall {k} (p :: k) v. v -> Stream Bool -> Event p v
Event

type instance BehaviorToEvent (RangeWrites t) = Event () (RangeWrites t)

writeRange :: forall t. EEPROMable t => Behavior Bool -> Range t -> RangeWrites t -> Sketch()
writeRange :: forall t.
EEPROMable t =>
Stream Bool -> Range t -> RangeWrites t -> Sketch ()
writeRange Stream Bool
c Range t
range (RangeWrites Stream Bool -> Stream RangeIndex
idx Behavior t
v) = do
	(GenFramework Arduino
f', String
triggername) <- forall ctx.
String
-> GenFramework ctx -> GenSketch ctx (GenFramework ctx, String)
defineTriggerAlias String
writername GenFramework Arduino
f
	forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [(String -> TriggerLimit -> WriterT [SpecItem] Identity ()
spec String
triggername, \TriggerLimit
_ -> GenFramework Arduino
f')]
  where
	Location UniqueId
i = forall t. Range t -> Location (Range t)
rangeLocation Range t
range
	idx' :: Stream RangeIndex
idx' = Stream Bool -> Stream RangeIndex
idx Stream Bool
c forall a. (Typed a, Integral a) => Stream a -> Stream a -> Stream a
`mod` forall a. Typed a => a -> Stream a
constant (forall t. Range t -> RangeIndex
rangeSize Range t
range)
	startaddrvarname :: String
startaddrvarname = UniqueId -> String
eepromRangeStartAddrName UniqueId
i
	writername :: String
writername = String -> UniqueId -> String
uniqueName String
"eeprom_range_write" UniqueId
i
	proxy :: Proxy t
proxy = forall {k} (t :: k). Proxy t
Proxy @t
	f :: GenFramework Arduino
f = Framework
		{ defines :: [CChunk]
defines = 
			[ [CLine] -> CChunk
CChunk [CLine
includeCLine]
			, [CLine] -> CChunk
CChunk
				[ String -> CLine
CLine forall a b. (a -> b) -> a -> b
$ String
"int " forall a. Semigroup a => a -> a -> a
<> String
startaddrvarname forall a. Semigroup a => a -> a -> a
<> String
";"
				, String -> CLine
CLine forall a b. (a -> b) -> a -> b
$ String
"void " forall a. Semigroup a => a -> a -> a
<> String
writername
					forall a. Semigroup a => a -> a -> a
<> String
"(" forall a. Semigroup a => a -> a -> a
<> forall {k} (t :: k). ShowCType t => Proxy t -> String
showCType Proxy t
proxy forall a. Semigroup a => a -> a -> a
<> String
" value"
					forall a. Semigroup a => a -> a -> a
<> String
", " forall a. Semigroup a => a -> a -> a
<> forall {k} (t :: k). ShowCType t => Proxy t -> String
showCType (forall {k} (t :: k). Proxy t
Proxy @Word16) forall a. Semigroup a => a -> a -> a
<> String
" offset"
					forall a. Semigroup a => a -> a -> a
<> String
") {"
				, String -> CLine
CLine forall a b. (a -> b) -> a -> b
$ String
"  EEPROM." forall a. Semigroup a => a -> a -> a
<> forall t. EEPROMable t => Proxy t -> String
writeValue Proxy t
proxy
					forall a. Semigroup a => a -> a -> a
<> String
"(" forall a. Semigroup a => a -> a -> a
<> String
startaddrvarname 
						forall a. Semigroup a => a -> a -> a
<> String
" + offset*sizeof(" 
							forall a. Semigroup a => a -> a -> a
<> forall {k} (t :: k). ShowCType t => Proxy t -> String
showCType Proxy t
proxy
							forall a. Semigroup a => a -> a -> a
<> String
")"
					forall a. Semigroup a => a -> a -> a
<> String
", value);"
				, String -> CLine
CLine String
"}"
				]
			]
		, setups :: [CChunk]
setups = [CLine] -> [CChunk]
mkCChunk
			[ String -> CLine
CLine forall a b. (a -> b) -> a -> b
$ String
startaddrvarname forall a. Semigroup a => a -> a -> a
<> String
" = EEPROM.getAddress"
				forall a. Semigroup a => a -> a -> a
<> String
"(sizeof(" forall a. Semigroup a => a -> a -> a
<> forall {k} (t :: k). ShowCType t => Proxy t -> String
showCType Proxy t
proxy forall a. Semigroup a => a -> a -> a
<> String
")" 
				forall a. Semigroup a => a -> a -> a
<> String
" * " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show (forall t. Range t -> RangeIndex
rangeSize Range t
range)
				forall a. Semigroup a => a -> a -> a
<> String
");"
			]
		, earlySetups :: [CChunk]
earlySetups = []
		, pinmodes :: Map Arduino (Set PinMode)
pinmodes = forall a. Monoid a => a
mempty
		, loops :: [CChunk]
loops = forall a. Monoid a => a
mempty
		}
	spec :: String -> TriggerLimit -> WriterT [SpecItem] Identity ()
spec 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. Typed a => Stream a -> Arg
arg Stream RangeIndex
idx', forall a. Typed a => Stream a -> Arg
arg Behavior t
v]

eepromRangeStartAddrName :: UniqueId -> String
eepromRangeStartAddrName :: UniqueId -> String
eepromRangeStartAddrName = String -> UniqueId -> String
uniqueName String
"eeprom_range_address"

-- | Treat the `Range` as a ring buffer, and starting with the specified
-- `RangeIndex`, sweep over the `Range` writing values from the
-- `Behavior`.
sweepRange :: RangeIndex -> Behavior t -> RangeWrites t
sweepRange :: forall t. RangeIndex -> Behavior t -> RangeWrites t
sweepRange RangeIndex
start = forall t.
(Stream Bool -> Stream RangeIndex) -> Behavior t -> RangeWrites t
RangeWrites (RangeIndex -> Stream Bool -> Stream RangeIndex
sweepRange' RangeIndex
start)

-- | This is actually just a simple counter that increments on each write
-- to the range. That's sufficient, because writes that overflow the
-- end of the range wrap back to the start.
sweepRange' :: RangeIndex -> Behavior Bool -> Behavior RangeIndex
sweepRange' :: RangeIndex -> Stream Bool -> Stream RangeIndex
sweepRange' RangeIndex
start Stream Bool
c = Stream RangeIndex
cnt
  where
	cnt :: Stream RangeIndex
cnt = [RangeIndex
start] forall a. Typed a => [a] -> Stream a -> Stream a
++ Stream RangeIndex
rest
	rest :: Stream RangeIndex
rest = if Stream Bool
c then Stream RangeIndex
cnt forall a. Num a => a -> a -> a
+ Stream RangeIndex
1 else Stream RangeIndex
cnt

-- | Description of how to read a` Range`.
--
-- The first read is made at the specified RangeIndex, and the location
-- to read from subsequently comes from the Behavior RangeIndex.
data RangeReads t = RangeReads (Range t) RangeIndex (Behavior RangeIndex)

-- | Scan through the `Range`, starting with the specified `RangeIndex`.
--
-- > range <- EEPROM.allocRange 100 :: Sketch (EEPROM.Range ADC)
-- > v <- input $ scanRange range 0
-- 
-- Once the end of the `Range` is reached, input continues
-- from the start of the `Range`.
--
-- It's fine to write and read from the same range in the same Sketch,
-- but if the RangeIndex being read and written is the same, it's not
-- defined in what order the two operations will happen.
--
-- Also, when interpreting a Sketch that both reads and writes to a range,
-- the input from that range won't reflect the writes made to it,
-- but will instead come from the list of values passed to `input'`.
scanRange :: Range t -> RangeIndex -> RangeReads t
scanRange :: forall t. Range t -> RangeIndex -> RangeReads t
scanRange Range t
r RangeIndex
startidx = forall t.
Range t -> RangeIndex -> Stream RangeIndex -> RangeReads t
RangeReads Range t
r RangeIndex
startidx Stream RangeIndex
cnt
  where
	cnt :: Stream RangeIndex
cnt = [RangeIndex
startidxforall a. Num a => a -> a -> a
+RangeIndex
1] forall a. Typed a => [a] -> Stream a -> Stream a
++ Stream RangeIndex
rest
	rest :: Stream RangeIndex
rest = Stream RangeIndex
cnt forall a. Num a => a -> a -> a
+ Stream RangeIndex
1

instance (ShowCType t, EEPROMable t) => Input Arduino (RangeReads t) t where
	input' :: RangeReads t -> [t] -> GenSketch Arduino (Behavior t)
input' (RangeReads Range t
range RangeIndex
startidx Stream RangeIndex
idx) [t]
interpretvalues = do
		-- This trigger writes value of idx
		-- to indexvarname. The next time through the loop,
		-- the extern uses that to determine where to read from.
		(GenFramework Arduino
f, String
triggername) <- forall ctx.
String
-> GenFramework ctx -> GenSketch ctx (GenFramework ctx, String)
defineTriggerAlias String
indexvarupdatername forall a. Monoid a => a
mempty
		let t :: TriggerLimit -> WriterT [SpecItem] Identity ()
t TriggerLimit
tl = 
			let c :: Stream Bool
c = TriggerLimit -> Stream Bool
getTriggerLimit TriggerLimit
tl
			in String -> Stream Bool -> [Arg] -> WriterT [SpecItem] Identity ()
trigger String
triggername Stream Bool
c [forall a. Typed a => Stream a -> Arg
arg Stream RangeIndex
idx']
		forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [(TriggerLimit -> WriterT [SpecItem] Identity ()
t, \TriggerLimit
_ -> GenFramework Arduino
f)]
		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
$ forall {k} (t :: k). ShowCType t => Proxy t -> String
showCType Proxy t
proxy forall a. Semigroup a => a -> a -> a
<> String
" " forall a. Semigroup a => a -> a -> a
<> String
valname forall a. Semigroup a => a -> a -> a
<> String
";"
				, String -> CLine
CLine forall a b. (a -> b) -> a -> b
$ String
"int " forall a. Semigroup a => a -> a -> a
<> String
indexvarname forall a. Semigroup a => a -> a -> a
<> String
";"
				, String -> CLine
CLine forall a b. (a -> b) -> a -> b
$ String
"void " forall a. Semigroup a => a -> a -> a
<> String
indexvarupdatername forall a. Semigroup a => a -> a -> a
<> String
" (int idx) {"
				, String -> CLine
CLine forall a b. (a -> b) -> a -> b
$ String
"  " forall a. Semigroup a => a -> a -> a
<> String
indexvarname forall a. Semigroup a => a -> a -> a
<> String
" = idx;"
				, String -> CLine
CLine forall a b. (a -> b) -> a -> b
$ String
"}"
				]
			, setupInput :: [CChunk]
setupInput =  [CLine] -> [CChunk]
mkCChunk
				-- Prime with startidx on the first time
				-- through the loop.
				[ String -> CLine
CLine forall a b. (a -> b) -> a -> b
$ String
indexvarname forall a. Semigroup a => a -> a -> a
<> String
" = " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show RangeIndex
startidx' forall a. Semigroup a => a -> a -> a
<> String
";" ]
			, readInput :: [CChunk]
readInput = [CLine] -> [CChunk]
mkCChunk
				[ String -> CLine
CLine forall a b. (a -> b) -> a -> b
$ String
valname forall a. Semigroup a => a -> a -> a
<> String
" = EEPROM." forall a. Semigroup a => a -> a -> a
<> forall t. EEPROMable t => Proxy t -> String
readValue Proxy t
proxy
					forall a. Semigroup a => a -> a -> a
<> String
"("
						forall a. Semigroup a => a -> a -> a
<> UniqueId -> String
eepromRangeStartAddrName UniqueId
i
						forall a. Semigroup a => a -> a -> a
<> String
" + " forall a. Semigroup a => a -> a -> a
<> String
indexvarname 
						forall a. Semigroup a => a -> a -> a
<> String
"*sizeof("
						forall a. Semigroup a => a -> a -> a
<> forall {k} (t :: k). ShowCType t => Proxy t -> String
showCType Proxy t
proxy
						forall a. Semigroup a => a -> a -> a
<> String
")"
					forall a. Semigroup a => a -> a -> a
<> String
");"
				]
			, inputStream :: Behavior t
inputStream = forall a. Typed a => String -> Maybe [a] -> Stream a
extern String
valname Maybe [t]
interpretvalues'
			, inputPinmode :: Map Arduino PinMode
inputPinmode = forall a. Monoid a => a
mempty
			}
	  where
		Location UniqueId
i = forall t. Range t -> Location (Range t)
rangeLocation Range t
range
		idx' :: Stream RangeIndex
idx' = Stream RangeIndex
idx forall a. (Typed a, Integral a) => Stream a -> Stream a -> Stream a
`mod` forall a. Typed a => a -> Stream a
constant (forall t. Range t -> RangeIndex
rangeSize Range t
range)
		startidx' :: RangeIndex
startidx' = RangeIndex
startidx forall a. Integral a => a -> a -> a
`Prelude.mod` forall t. Range t -> RangeIndex
rangeSize Range t
range
		proxy :: Proxy t
proxy = forall {k} (t :: k). Proxy t
Proxy @t
		indexvarname :: String
indexvarname = String -> UniqueId -> String
uniqueName String
"eeprom_range_read_index" UniqueId
i
		indexvarupdatername :: String
indexvarupdatername = String -> UniqueId -> String
uniqueName String
"eeprom_range_read" UniqueId
i
		valname :: String
valname = String -> UniqueId -> String
uniqueName String
"eeprom_range_val" UniqueId
i
		interpretvalues' :: Maybe [t]
interpretvalues'
			| forall (t :: * -> *) a. Foldable t => t a -> Bool
null [t]
interpretvalues = forall a. Maybe a
Nothing
			| Bool
otherwise = forall a. a -> Maybe a
Just [t]
interpretvalues

class (ShowCType t, Typed t) => EEPROMable t where
	readValue :: Proxy t -> String
	writeValue :: Proxy t -> String
	factoryValue :: Proxy t -> t
	-- ^ The EEPROM comes from the factory with all bits set,
	-- this follows suite. Eg, maxBound for unsigned ints,
	-- minBound for signed ints since the sign bit being set
	-- makes it negative, and NaN for floats.

-- | This instance is not efficient; a whole byte is read/written
-- rather than a single bit.
instance EEPROMable Bool where
	readValue :: Proxy Bool -> String
readValue Proxy Bool
_ = String
"readByte"
	writeValue :: Proxy Bool -> String
writeValue Proxy Bool
_ = String
"updateByte"
	factoryValue :: Proxy Bool -> Bool
factoryValue Proxy Bool
_ = Bool
True

instance EEPROMable Int8 where
	readValue :: Proxy Int8 -> String
readValue Proxy Int8
_ = String
"readByte"
	writeValue :: Proxy Int8 -> String
writeValue Proxy Int8
_ = String
"updateByte"
	factoryValue :: Proxy Int8 -> Int8
factoryValue Proxy Int8
_ = forall a. Bounded a => a
minBound

instance EEPROMable Int16 where
	readValue :: Proxy Int16 -> String
readValue Proxy Int16
_ = String
"readInt"
	writeValue :: Proxy Int16 -> String
writeValue Proxy Int16
_ = String
"updateInt"
	factoryValue :: Proxy Int16 -> Int16
factoryValue Proxy Int16
_= forall a. Bounded a => a
minBound

instance EEPROMable Int32 where
	readValue :: Proxy Int32 -> String
readValue Proxy Int32
_ = String
"readLong"
	writeValue :: Proxy Int32 -> String
writeValue Proxy Int32
_ = String
"updateLong"
	factoryValue :: Proxy Int32 -> Int32
factoryValue Proxy Int32
_= forall a. Bounded a => a
minBound

instance EEPROMable Word8 where
	readValue :: Proxy Word8 -> String
readValue Proxy Word8
_ = String
"readByte"
	writeValue :: Proxy Word8 -> String
writeValue Proxy Word8
_ = String
"updateByte"
	factoryValue :: Proxy Word8 -> Word8
factoryValue Proxy Word8
_ = forall a. Bounded a => a
maxBound

instance EEPROMable Word16 where
	readValue :: Proxy RangeIndex -> String
readValue Proxy RangeIndex
_ = String
"readInt"
	writeValue :: Proxy RangeIndex -> String
writeValue Proxy RangeIndex
_ = String
"updateInt"
	factoryValue :: Proxy RangeIndex -> RangeIndex
factoryValue Proxy RangeIndex
_ = forall a. Bounded a => a
maxBound

instance EEPROMable Word32 where
	readValue :: Proxy Word32 -> String
readValue Proxy Word32
_ = String
"readLong"
	writeValue :: Proxy Word32 -> String
writeValue Proxy Word32
_ = String
"updateLong"
	factoryValue :: Proxy Word32 -> Word32
factoryValue Proxy Word32
_ = forall a. Bounded a => a
maxBound

instance EEPROMable Float where
	readValue :: Proxy Float -> String
readValue Proxy Float
_ = String
"readFloat"
	writeValue :: Proxy Float -> String
writeValue Proxy Float
_ = String
"updateFloat"
	factoryValue :: Proxy Float -> Float
factoryValue Proxy Float
_ = Float
0forall a. Fractional a => a -> a -> a
/Float
0 -- NaN

instance EEPROMable Double where
	readValue :: Proxy Double -> String
readValue Proxy Double
_ = String
"readDouble"
	writeValue :: Proxy Double -> String
writeValue Proxy Double
_ = String
"updateDOuble"
	factoryValue :: Proxy Double -> Double
factoryValue Proxy Double
_ = Double
0forall a. Fractional a => a -> a -> a
/Double
0 -- NaN

includeCLine :: CLine
includeCLine :: CLine
includeCLine = String -> CLine
CLine String
"#include <EEPROMex.h>"