{-# LANGUAGE BangPatterns #-}

module Copilot.Arduino.Main (arduino) where

import Language.Copilot (Spec, interpret, reify)
import Copilot.Compile.C99 (compile)
import Copilot.Arduino.Internals
import System.IO
import System.Directory
import System.IO.Temp (withSystemTempDirectory, createTempDirectory)
import System.FilePath
import System.Exit
import Data.List (isInfixOf)
import Data.Maybe
import qualified Data.Map as M
import qualified Data.Set as S
import Options.Applicative

-- | Typically your Arduino program's main will be implemented using this.
-- For example:
--
-- > {-# LANGUAGE RebindableSyntax #-}
-- > 
-- > import Copilot.Arduino
-- > 
-- > main = arduino $ do
-- >	led =: flashing
-- > 	delay =: MilliSeconds (constant 100)
--
-- Running this program compiles the `Sketch` into C code using copilot, and
-- writes it to a .ino file. That can be built and uploaded to your Arduino
-- using the Arduino IDE, or any other toolchain for Arduino sketches.
--
-- This also supports interpreting a `Sketch`, without loading it onto an
-- Arduino. Run the program with parameters "-i 4" to display what it
-- would do on the first 4 iterations. The output will look something like
-- this:
--
-- > delay:         digitalWrite: 
-- > (100)          (13,false)    
-- > (100)          (13,true)     
-- > (100)          (13,false)    
-- > (100)          (13,true)     
arduino :: Sketch () -> IO ()
arduino s = go =<< execParser opts
  where
	opts = info (parseCmdLine <**> helper)
		( fullDesc
		<> progDesc "Run this program with no options to generate an Arduino sketch."
		)

	go o = case (mspec, interpretSteps o) of
		(Nothing, _) -> do
			hPutStrLn stderr "This Sketch does not do anything."
			exitFailure
		(Just spec, Just n) -> interpret n spec
		(Just spec, Nothing) -> writeIno spec f'
	
	(mspec, f) = evalSketch s
	
	-- Strict evaluation because this may throw errors,
	-- and we want to throw them before starting compilation.
	!f' = finalizeFramework f

data CmdLine = CmdLine
	{ interpretSteps :: Maybe Integer
	}


parseCmdLine :: Parser CmdLine
parseCmdLine = CmdLine
	<$> optional (option auto
		( long "interpret"
		<> short 'i'
		<> help "use copilot to interpret the program, displaying what it would do"
		<> metavar "NUM"
		))

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.
	withSystemTempDirectory "copilot" $ \toptmpdir -> do
		mytmpdir <- createTempDirectory 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") $ 
			unlines $ map fromCLine $
				sketchFramework framework (map CLine c')

-- Makes an arduino sketch, using a Framework, and a list of lines of C
-- code generated by Copilot.
sketchFramework :: Framework -> [CLine] -> [CLine]
sketchFramework f ccode = map CLine $ concat
	[
		[ "/* automatically generated, do not edit */"
		, blank
		, "#include <stdbool.h>"
		, "#include <stdint.h>"
		, blank
		]
	, map fromCLine (fromchunks (defines f))
	, [blank]
	, map fromCLine ccode
	, [blank]
	,
		[ "void setup()"
		]
	, codeblock $ map fromCLine
		(fromchunks (earlySetups f) <> fromchunks (setups f))
	, [blank]
	,
		[ "void loop()"
		]
	, codeblock $ map fromCLine (fromchunks (loops f)) <>
		[ "step();"
		]
	]
  where
	blank = ""
	indent l = "  " <> l
	codeblock l = ["{"] <> map indent l <> ["}"]
	-- If two CChunks are identical, only include it once.
	-- This can happen when eg, the same setup code is generated
	-- to use a resource that's accessed more than once in a program.
	-- Note: Does not preserve order of chunks in the list.
	fromchunks :: [CChunk] -> [CLine]
	fromchunks cl = concatMap (\(CChunk l) -> l) $
		S.toList $ S.fromList cl

finalizeFramework :: Framework -> Framework
finalizeFramework f = 
	let pinsetups = concat $
		mapMaybe setuppinmode (M.toList $ pinmodes f)
	in f { setups = pinsetups <> setups f }
  where
	setuppinmode (PinId n, s)
		| s == S.singleton OutputMode =
			setmode n "OUTPUT"
		| s == S.singleton InputMode =
			setmode n "INPUT"
		| s == S.singleton InputPullupMode =
			setmode n "INPUT_PULLUP"
		| s == S.fromList [InputMode, InputPullupMode] =
			-- Enabling pullup is documented to make all
			-- reads from that pin be with pullup.
			setmode n "INPUT_PULLUP"
		| S.null s = Nothing
		| otherwise = error $
			"The program uses pin " ++ show n ++
			" in multiple ways in different places (" ++
			unwords (map show (S.toList s)) ++ "). " ++
			"This is not currently supported by arduino-copilot."
	
	setmode n v = Just $ mkCChunk
		[ CLine $ "pinMode(" <> show n <> ", " ++ v ++ ");" ]