-- | You should not need to import this module unless you're adding support
-- for a new model of Arduino, or an Arduino library.

{-# LANGUAGE RebindableSyntax #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE FlexibleInstances #-}

module Copilot.Arduino.Internals where

import Language.Copilot
import Control.Monad.Writer

-- | An Arduino sketch, implemented using Copilot.
--
-- It's best to think of the `Sketch` as a description of the state of the
-- Arduino at any point in time.
--
-- Under the hood, the `Sketch` is run in a loop. On each iteration, it first
-- reads all 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.
newtype Sketch t = Sketch (Writer [(Spec, Framework)] t)
        deriving (Monad, Applicative, Functor, MonadWriter [(Spec, Framework)])

instance Monoid (Sketch ()) where
        mempty = Sketch (return ())

instance Semigroup (Sketch t) where
        (Sketch a) <> (Sketch b) = Sketch (a >> b)

-- | The framework of an Arduino sketch.
data Framework = Framework
        { defines :: [CFragment]
        -- ^ Things that come before the C code generated by Copilot.
        , setups :: [CFragment]
        -- ^ Things to run in `setup`.
        , loops :: [CFragment]
        -- ^ Things to run in `loop`.
        }

-- | A fragment of C code.
type CFragment = String

instance Semigroup Framework where
        a <> b = Framework
                { defines = defines a <> defines b
                , setups = setups a <> setups b
                , loops = loops a  <> loops b
                }

instance Monoid Framework where
        mempty = Framework mempty mempty mempty

class ToFramework t where
        toFramework :: t -> Framework

type Behavior t = Stream t -> Spec

-- | Somewhere that a Stream can be directed to, in order to control the
-- Arduino.
data Output t = Output
        { setupOutput :: [CFragment]
        -- ^ How to set up the output.
        , outputCond :: Stream Bool
        , outputBehavior :: Stream Bool -> Behavior t
        }

instance ToFramework (Output t) where
        toFramework o = Framework
                { defines = mempty
                , setups = setupOutput o
                , loops = mempty
                }

-- | A source of a `Stream` of values input from the Arduino.
--
-- Runs in the `Sketch` monad.
type Input t = Sketch (Stream t)

data InputSource t = InputSource
        { defineVar :: [CFragment]
        -- ^ Added to the `Framework`'s `defines`, this typically
        -- defines a C variable.
        , setupInput :: [CFragment]
        -- ^ How to set up the input.
        , readInput :: [CFragment]
        -- ^ How to read a value from the input, this typically
        -- reads a value into a C variable.
        , inputStream :: Stream t
        }

instance ToFramework (InputSource t) where
        toFramework i = Framework
                { defines = defineVar i
                , setups = setupInput i
                , loops = readInput i
                }

mkInput :: InputSource t -> Input t
mkInput i = do
        tell [(return (), toFramework i)]
        return (inputStream i)

-- | A GPIO pin
--
-- For definitions of GPIO pins like `Copilot.Arduino.Uno.pin12`, 
-- load a module such as Copilot.Arduino.Uno, which provides the pins of a
-- particular board.
newtype GPIO = GPIO Int16

-- FIXME should be a newtype, but how to make a stream of a newtype?
type MicroSeconds = Int16

-- | Makes an arduino sketch, using a Framework, and a list of lines of C
-- code generated by Copilot.
sketchFramework :: Framework -> [String] -> [CFragment]
sketchFramework f ccode = concat
        [
                [ "/* automatically generated, do not edit */"
                , blank
                , "#include <stdbool.h>"
                , "#include <stdint.h>"
                , blank
                ]
        , map statement (defines f)
        , [blank]
        , ccode
        , [blank]
        ,
                [ "void setup()"
                ]
        , codeblock $ map statement (setups f)
        , [blank]
        ,
                [ "void loop()"
                ]
        , codeblock $ map statement $ (loops f) <>
                [ "step()"
                ]
        ]
  where
        blank = ""
        indent l = "  " <> l
        statement d = d <> ";"
        codeblock l = ["{"] <> map indent l <> ["}"]