-- | Programming the Arduino with Copilot, in functional reactive style.
--
-- This module should work on any model of Arduino.
-- See Copilot.Arduino.Uno and Copilot.Arduino.Nano for model-specific code.
--
-- There are also libraries like Copilot.Arduino.Library.Serial to support
-- additional hardware.

{-# LANGUAGE RebindableSyntax #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Copilot.Arduino (
        -- * Arduino sketch generation
        arduino,
        Sketch,
        Pin,
        -- * Functional reactive programming
        Behavior,
        TypedBehavior(..),
        Event,
        (@:),
        -- * Inputs
        Input,
        input,
        input',
        pullup,
        millis,
        micros,
        -- * Outputs
        --
        -- | Only a few common outputs are included in this module.
        -- Import a module such as Copilot.Arduino.Uno for `Pin`
        -- definitions etc.
        Output,
        led,
        (=:),
        pwm,
        delay,
        -- * Other types
        ADC,
        MilliSeconds(..),
        MicroSeconds(..),
        ClockMillis,
        ClockMicros,
        IsDigitalIOPin,
        IsAnalogInputPin,
        IsPWMPin,
        -- * Utilities
        blinking,
        firstIteration,
        frequency,
        sketchSpec,
        -- * Combinators
        liftB,
        liftB2,
        whenB,
        scheduleB,
        ifThenElse,
        IfThenElse,
        -- * Copilot DSL
        --
        -- | Most of the Copilot.Language module is re-exported here,
        -- including a version of the Prelude modified for it. You
        -- should enable the RebindableSyntax language extension in
        -- your program to use the Copilot DSL.
        --
        -- > {-# LANGUAGE RebindableSyntax #-}
        --
        -- For documentation on using the Copilot DSL, see
        -- <https://copilot-language.github.io/>
        Stream,
        module X,
) where

import Language.Copilot as X hiding (Stream, ifThenElse)
import Language.Copilot (Stream)
import qualified Language.Copilot
import Copilot.Arduino.Internals
import Copilot.Arduino.Main
import Control.Monad.Writer
import Data.Proxy
import Data.Maybe
import qualified Data.Map as M
import qualified Data.Set as S

-- | Use this to make a LED blink on and off.
--
-- On each iteration of the `Sketch`, this changes to the opposite of its
-- previous value.
--
-- This is implemented using Copilot's `clk`, so to get other blinking
-- behaviors, just pick different numbers, or use Copilot `Stream`
-- combinators.
-- 
-- > blinking = clk (period 2) (phase 1)
blinking :: Behavior Bool
blinking = clk (period (2 :: Integer)) (phase (1 :: Integer))

-- | True on the first iteration of the `Sketch`, and False thereafter.
firstIteration :: Behavior Bool
firstIteration = [True]++false

-- | Use this to make an event occur 1 time out of n.
--
-- This is implemented using Copilot's `clk`:
--
-- > frequency = clk (period n) (phase 1)
frequency :: Integer -> Behavior Bool
frequency n = clk (period n) (phase 1)

-- | A stream of milliseconds.
data MilliSeconds = MilliSeconds (Stream Word32)

-- | A stream of microseconds.
data MicroSeconds = MicroSeconds (Stream Word32)

-- | Use this to add a delay between each iteration of the `Sketch`.
-- A `Sketch` with no delay will run as fast as the hardware can run it.
--
-- > delay := MilliSeconds (constant 100)
delay :: Delay
delay = Delay

data Delay = Delay

instance Output Delay MilliSeconds where
        Delay =: (MilliSeconds n) = do
                (f, triggername) <- defineTriggerAlias "delay" mempty
                tell [(go triggername, \_ -> f)]
          where
                go triggername tl =
                        let c = getTriggerLimit tl
                        in trigger triggername c [arg n]

instance Output Delay MicroSeconds where
        Delay =: (MicroSeconds n) = do
                (f, triggername) <- defineTriggerAlias "delayMicroseconds" mempty
                tell [(go triggername, \_ -> f)]
          where
                go triggername tl =
                        let c = getTriggerLimit tl
                        in trigger triggername c [arg n]


-- | Number of MillisSeconds since the Arduino booted.
--
-- > n <- input millis
-- 
-- The value wraps back to zero after approximately 50 days.
millis :: ClockMillis
millis = ClockMillis

-- | Number of MicroSeconds since the Arduino booted.
--
-- > n <- input micros
-- 
-- The value wraps back to zero after approximately 70 minutes.
micros :: ClockMicros
micros = ClockMicros

data ClockMillis = ClockMillis
data ClockMicros = ClockMicros

instance Input ClockMillis Word32 where
        input' ClockMillis = inputClock "millis"

instance Input ClockMicros Word32 where
        input' ClockMicros = inputClock "micros"

inputClock :: [Char] -> [Word32] -> Sketch (Behavior Word32)
inputClock src interpretvalues = mkInput $ InputSource
        { setupInput = []
        , defineVar = mkCChunk
                [CLine $ showCType (Proxy @Word32) <> " " <> varname <>";"]
        , inputPinmode = mempty
        , readInput = mkCChunk
                [CLine $ varname <> " = " <> src <> "();"]
        , inputStream = extern varname interpretvalues'
        }
  where
        varname = "clock_" <> src
        interpretvalues'
                | null interpretvalues = Nothing
                | otherwise = Just interpretvalues

-- | Normally when a digital value is read from a `Pin`, it is configured
-- without the internal pullup resistor being enabled. Use this to enable
-- the pullup register for all reads from the `Pin`.
--
-- Bear in mind that enabling the pullup resistor inverts the value that
-- will be read from the pin.
--
-- > pullup pin12
pullup :: IsDigitalIOPin t => Pin t -> Sketch ()
pullup (Pin p) = tell [(\_ -> return (), \_ -> f)]
  where
        f = mempty
                { pinmodes = M.singleton p (S.singleton InputPullupMode)
                }

-- | Use this to do PWM output to a pin.
--
-- > pin3 =: pwm (constant 128)
-- 
-- Each Word8 of the Behavior describes a PWM square wave.
-- 0 is always off and 255 is always on.
pwm :: Behavior Word8 -> TypedBehavior 'PWM Word8
pwm = TypedBehavior

-- | The on-board LED.
led :: Pin '[ 'DigitalIO ]
led = Pin (PinId 13)

class IfThenElse t a where
        -- | This allows "if then else" expressions to be written
        -- that choose between two Streams, or Behaviors, or TypedBehaviors,
        -- or Sketches, when the RebindableSyntax language extension is
        -- enabled.
        --
        -- > {-# LANGUAGE RebindableSyntax #-}
        -- > buttonpressed <- input pin3
        -- > if buttonpressed then ... else ...
        ifThenElse :: Behavior Bool -> t a -> t a -> t a

instance Typed a => IfThenElse Stream a where
        ifThenElse = Language.Copilot.ifThenElse

instance Typed a => IfThenElse (TypedBehavior p) a where
        ifThenElse c (TypedBehavior a) (TypedBehavior b) =
                TypedBehavior (ifThenElse c a b)

instance IfThenElse Sketch () where
        ifThenElse c a b = do
                whenB c a
                whenB (not c) b

instance Typed a => IfThenElse Sketch (Behavior a) where
        ifThenElse c a b = do
                ra <- whenB c a
                rb <- whenB (not c) b
                return $ Language.Copilot.ifThenElse c ra rb

-- | Schedule when to perform different Sketches.
scheduleB :: (Typed t, Eq t) => Behavior t -> [(t, Sketch ())] -> Sketch ()
scheduleB b = sequence_ . map go
  where
        go (v, s) = whenB (b == constant v) s

-- | Extracts a copilot `Spec` from a `Sketch`.
--
-- This can be useful to intergrate with other libraries 
-- such as copilot-theorem.
sketchSpec :: Sketch a -> Spec
sketchSpec = fromMaybe (return ()) . fst . evalSketch

-- | Apply a Copilot DSL function to a `TypedBehavior`.
liftB
        :: (Behavior a -> Behavior r)
        -> TypedBehavior t a
        -> Behavior r
liftB f (TypedBehavior b) = f b

-- | Apply a Copilot DSL function to two `TypedBehavior`s.
liftB2
        :: (Behavior a -> Behavior b -> Behavior r)
        -> TypedBehavior t a
        -> TypedBehavior t b
        -> Behavior r
liftB2 f (TypedBehavior a) (TypedBehavior b) = f a b