{-# LANGUAGE RebindableSyntax #-}

module Arduino (
	module X,
	-- * Arduino sketch generation
	Sketch,
	Input,
	Output,
	arduino,
	-- * Combinators
	(=:),
	(@:),
	-- * Inputs
	boolInput,
	boolInput',
	-- TODO enumerate all avail pins, don't export constructor
	Pin(..),
	-- * Outputs
	led,
	MicroSeconds,
	delay,
	-- * Utilities
	firstIteration,
	sketchSpec,
) where

import Language.Copilot as X
import Copilot.Compile.C99
import System.Environment
import System.Directory
import System.Posix.Temp (mkdtemp)
import System.FilePath
import Text.Read
import Control.Monad.Writer
import Data.List (isInfixOf)
import qualified Prelude

-- | An Arduino sketch, implemented using copilot.
--
-- On each iteration of a Sketch, all inputs used by it are first
-- collected, before any outputs are performed.
--
-- Like a copilot `Spec`, a Sketch's outputs are not run in any
-- particular order.
type Sketch = Sketch' ()

type Sketch' t = Writer [(Spec, Framework)] t

data Framework = Framework
	{ defines :: [CFragment]
	, setups :: [CFragment]
	, loops :: [CFragment]
	}

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]
	, 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.
type Input t = Sketch' (Stream t)

data Input' t = Input'
	{ defineVar :: [CFragment]
	, setupInput :: [CFragment]
	, readInput :: [CFragment]
	, inputStream :: Stream t
	}

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

-- | A GPIO pin
newtype Pin = Pin Int

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

-- | Connect a `Stream` to an `Output`.
(=:) :: Output t -> Stream t -> Sketch
o =: s = tell [(go, toFramework o)]
  where
	go = (outputBehavior o) (outputCond o) s

-- Same fixity as =<<
infixr 1 =:

-- | By default, an `Output` is written to on each iteration of the Sketch.
--
-- For example, this constantly turns on the LED, even though it will
-- already be on after the first iteration.
--
-- > led =: true
--
-- To avoid unnecessary work being done, this combinator can make an
-- `Output` only be written to when the current value of the provided
-- `Stream` is True.
--
-- So to make the LED only be turned on in the first iteration,
-- and allow it to remain on thereafter without doing extra work:
--
-- > led @: firstIteration =: true
(@:) :: Output t -> Stream Bool -> Output t
(@:) o c = o { outputCond = c }

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

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

-- | The on-board LED.
led :: Output Bool
led = Output
	{ setupOutput = ["pinMode(13, OUTPUT)"]
	, outputBehavior = 
		\c v -> trigger "digitalWrite" c [arg (constI16 13), arg v]
	, outputCond = true
	}

-- | Use this to add a delay between each iteration of the Sketch.
delay :: Output MicroSeconds
delay = Output
	{ setupOutput = []
	, outputBehavior = \c n -> trigger "delay" c [arg n]
	, outputCond = true
	}

-- | Reading from a GPIO pin.
boolInput :: Pin -> Input Bool
boolInput n = boolInput' n []

-- | The optional list is used as simulated input
-- when interpreting the program.
boolInput' :: Pin -> [Bool] -> Input Bool
boolInput' (Pin n) interpretvalues = mkInput $ Input'
	{ defineVar = ["bool " <> varname]
	, setupInput = ["pinMode(" <> show n <> ", INPUT)"]
	, readInput = [varname <> " = digitalRead(" <> show n <> ")"]
	, inputStream = extern varname interpretvalues'
	}
  where
	varname = "arduino_boolinput" <> show n
	interpretvalues'
		| null interpretvalues = Nothing
		| otherwise = Just interpretvalues

-- | Typically your Arduino program's main will use this. For example:
--
-- > main = arduino $ do
-- >	led =: clk (period 2) (phase 1)
-- > 	delay =: const16 100
--
-- The `Sketch` is compiled into C code using copilot, and written
-- to a .ino file. That can be built and uploaded to your Arduino
-- using the Arduino IDE, or any other toolchain for Arduino sketches.
arduino :: Sketch -> IO ()
arduino s = do
	let (is, fs) = unzip (execWriter s)
	let spec = sequence_ is
	-- TODO optparse-applicative
	ps <- getArgs
	case ps of
		[] -> writeIno spec (mconcat fs)
		["-i", n] -> case readMaybe n of
			Just n' -> interpret n' spec
			Nothing -> error "expected a number after -i"
		_ -> error "bad parameters"

-- | Extracts a copilot `Spec` from a `Sketch`.
--
-- This can be useful to intergrate with other libraries 
-- such as copilot-theorem.
sketchSpec :: Sketch -> Spec
sketchSpec s = sequence_ is
  where
	(is, _fs) = unzip (execWriter s)

writeIno :: Spec -> Framework -> IO ()
writeIno spec framework = do
	-- This could be a lot prettier, unfortunately copilot only exports
	-- an interface that writes the generated code to a file.
	-- And, the .c file includes a .h file that will make it fail to
	-- build when used in the .ino file, so that include has to be
	-- filtered out.
	toptmpdir <- getTemporaryDirectory
	mytmpdir <- mkdtemp (toptmpdir </> "copilot")
	reify spec >>= compile (mytmpdir </> "copilot")
	c <- lines <$> readFile (mytmpdir </> "copilot.c")
	let c' = filter (Prelude.not . isInfixOf "#include \"") c
	-- Use a name for the ino file that will let the Arduino IDE find it.
	d <- getCurrentDirectory
	let dirbase = takeFileName d
	writeFile (addExtension dirbase "ino") $ 
		sketchFramework framework c'
	removeDirectoryRecursive mytmpdir
	

sketchFramework :: Framework -> [String] -> String
sketchFramework f ccode = unlines $ 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 <> ["}"]