-- | 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>"