Internals.hs

-- | 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 <> ["}"]