-- | 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 n = tell [(\_ -> return (), \_ -> f)]
  where
	f = mempty
		{ earlySetups = mkCChunk
			[ CLine "#ifdef _EEPROMEX_DEBUG"
			, CLine $ "EEPROM.setMaxAllowedWrites(" <> show n <> ");"
			, CLine "#else"
			, CLine "#error \"maxAllowedWrites cannot be checked because _EEPROMEX_DEBUG is not set.\""
			, CLine "#endif"
			]
		, defines = mkCChunk [ 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 (Num, Eq, Ord, Enum, Show, Read, Bounded, Integral, 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 (Num, Eq, Ord, Enum, Show, Read, Bounded, Integral, Real)

-- | Configure the EEPROM memory pool that the program can use.
--
-- > EEPROM.memPool 0 (EndAddress sizeOfEEPROM)
memPool :: StartAddress -> EndAddress -> Sketch ()
memPool (StartAddress start) (EndAddress end) =
	tell [(\_ -> return (), \_ -> f)]
  where
	f = mempty
		-- setMemPool() has to come before any
		-- getAddress(), so do it in earlySetups.
		{ earlySetups = mkCChunk
			[ CLine $ "EEPROM.setMemPool("
				<> show start
				<> ", "
				<> show end
				<> ");"
			]
		, defines = mkCChunk [ 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 = alloc' (factoryValue (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' interpretval = do
	i <- getUniqueId "eeprom"
	let addrvarname = uniqueName "eeprom_address" i
	let bootvarname = uniqueName "eeprom_boot_val" i
	let proxy = Proxy @t
	bootval <- mkInput $ InputSource
		{ defineVar = 
			[ CChunk [includeCLine]
			, CChunk
				[ CLine $ "int " <> addrvarname <> ";"
				, CLine $ showCType proxy <> " " <> bootvarname <> ";"
				, CLine $ "void " <> eepromWriterName i
					<> "(" <> showCType proxy <> " value) {"
				, CLine $ "  EEPROM." <> writeValue proxy
					<> "(" <> addrvarname <> ", value);"
				, CLine "}"
				]
			]
		, setupInput = mkCChunk
			[ CLine $ addrvarname <> 
				" = EEPROM.getAddress(sizeof(" 
				<> showCType proxy <> "));"
			, CLine $ bootvarname <>
				" = EEPROM."
				<> readValue proxy <> "(" <> addrvarname <> ");"
			]
		, readInput = []
		, inputStream = extern bootvarname (Just (repeat interpretval))
		, inputPinmode = mempty
		}
	return (bootval, Location i)

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

data Location t = Location UniqueId

instance EEPROMable t => Output (Location t) (Event () (Stream t)) where
	Location i =: (Event v c) = do
		(f, triggername) <- defineTriggerAlias (eepromWriterName i) mempty
		tell [(go triggername, \_ -> f)]
	  where
		go triggername tl =
			let c' = addTriggerLimit tl c
			in trigger triggername c' [arg v]

-- | A range of values in the EEPROM.
data Range t = Range
	{ rangeLocation :: Location (Range t)
	, 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 sz = do
	i <- getUniqueId "eeprom"
	return (Range (Location i) 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 (Range t) (RangeWrites t) where
	(=:) = writeRange true

instance EEPROMable t => Output (Range t) (Event () (RangeWrites t)) where
	range =: Event ws c = 
		writeRange c range ws

instance EEPROMable t => IsBehavior (RangeWrites t) where
	(@:) = Event

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

writeRange :: forall t. EEPROMable t => Behavior Bool -> Range t -> RangeWrites t -> Sketch()
writeRange c range (RangeWrites idx v) = do
	(f', triggername) <- defineTriggerAlias writername f
	tell [(spec triggername, \_ -> f')]
  where
	Location i = rangeLocation range
	idx' = idx c `mod` constant (rangeSize range)
	startaddrvarname = eepromRangeStartAddrName i
	writername = uniqueName "eeprom_range_write" i
	proxy = Proxy @t
	f = Framework
		{ defines = 
			[ CChunk [includeCLine]
			, CChunk
				[ CLine $ "int " <> startaddrvarname <> ";"
				, CLine $ "void " <> writername
					<> "(" <> showCType proxy <> " value"
					<> ", " <> showCType (Proxy @Word16) <> " offset"
					<> ") {"
				, CLine $ "  EEPROM." <> writeValue proxy
					<> "(" <> startaddrvarname 
						<> " + offset*sizeof(" 
							<> showCType proxy
							<> ")"
					<> ", value);"
				, CLine "}"
				]
			]
		, setups = mkCChunk
			[ CLine $ startaddrvarname <> " = EEPROM.getAddress"
				<> "(sizeof(" <> showCType proxy <> ")" 
				<> " * " <> show (rangeSize range)
				<> ");"
			]
		, earlySetups = []
		, pinmodes = mempty
		, loops = mempty
		}
	spec triggername tl =
		let c' = addTriggerLimit tl c
		in trigger triggername c' [arg idx', arg v]

eepromRangeStartAddrName :: UniqueId -> String
eepromRangeStartAddrName = uniqueName "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 start = RangeWrites (sweepRange' 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' start c = cnt
  where
	cnt = [start] ++ rest
	rest = if c then cnt + 1 else 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 r startidx = RangeReads r startidx cnt
  where
	cnt = [startidx+1] ++ rest
	rest = cnt + 1

instance (ShowCType t, EEPROMable t) => Input (RangeReads t) t where
	input' (RangeReads range startidx idx) 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.
		(f, triggername) <- defineTriggerAlias indexvarupdatername mempty
		let t tl = 
			let c = getTriggerLimit tl
			in trigger triggername c [arg idx']
		tell [(t, \_ -> f)]
		mkInput $ InputSource
			{ defineVar = mkCChunk
				[ CLine $ showCType proxy <> " " <> valname <> ";"
				, CLine $ "int " <> indexvarname <> ";"
				, CLine $ "void " <> indexvarupdatername <> " (int idx) {"
				, CLine $ "  " <> indexvarname <> " = idx;"
				, CLine $ "}"
				]
			, setupInput =  mkCChunk
				-- Prime with startidx on the first time
				-- through the loop.
				[ CLine $ indexvarname <> " = " <> show startidx' <> ";" ]
			, readInput = mkCChunk
				[ CLine $ valname <> " = EEPROM." <> readValue proxy
					<> "("
						<> eepromRangeStartAddrName i
						<> " + " <> indexvarname 
						<> "*sizeof("
						<> showCType proxy
						<> ")"
					<> ");"
				]
			, inputStream = extern valname interpretvalues'
			, inputPinmode = mempty
			}
	  where
		Location i = rangeLocation range
		idx' = idx `mod` constant (rangeSize range)
		startidx' = startidx `Prelude.mod` rangeSize range
		proxy = Proxy @t
		indexvarname = uniqueName "eeprom_range_read_index" i
		indexvarupdatername = uniqueName "eeprom_range_read" i
		valname = uniqueName "eeprom_range_val" i
		interpretvalues'
			| null interpretvalues = Nothing
			| otherwise = Just 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 _ = "readByte"
	writeValue _ = "updateByte"
	factoryValue _ = True

instance EEPROMable Int8 where
	readValue _ = "readByte"
	writeValue _ = "updateByte"
	factoryValue _ = minBound

instance EEPROMable Int16 where
	readValue _ = "readInt"
	writeValue _ = "updateInt"
	factoryValue _= minBound

instance EEPROMable Int32 where
	readValue _ = "readLong"
	writeValue _ = "updateLong"
	factoryValue _= minBound

instance EEPROMable Word8 where
	readValue _ = "readByte"
	writeValue _ = "updateByte"
	factoryValue _ = maxBound

instance EEPROMable Word16 where
	readValue _ = "readInt"
	writeValue _ = "updateInt"
	factoryValue _ = maxBound

instance EEPROMable Word32 where
	readValue _ = "readLong"
	writeValue _ = "updateLong"
	factoryValue _ = maxBound

instance EEPROMable Float where
	readValue _ = "readFloat"
	writeValue _ = "updateFloat"
	factoryValue _ = 0/0 -- NaN

instance EEPROMable Double where
	readValue _ = "readDouble"
	writeValue _ = "updateDOuble"
	factoryValue _ = 0/0 -- NaN

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