{-# 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 :: Sketch () -> IO ()
arduino Sketch ()
s = CmdLine -> IO ()
go forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall a. ParserInfo a -> IO a
execParser ParserInfo CmdLine
opts
  where
	opts :: ParserInfo CmdLine
opts = forall a. Parser a -> InfoMod a -> ParserInfo a
info (Parser CmdLine
parseCmdLine forall (f :: * -> *) a b. Applicative f => f a -> f (a -> b) -> f b
<**> forall a. Parser (a -> a)
helper)
		( forall a. InfoMod a
fullDesc
		forall a. Semigroup a => a -> a -> a
<> forall a. String -> InfoMod a
progDesc String
"Run this program with no options to generate an Arduino sketch."
		)

	go :: CmdLine -> IO ()
go CmdLine
o = case (Maybe Spec
mspec, CmdLine -> Maybe Integer
interpretSteps CmdLine
o) of
		(Maybe Spec
Nothing, Maybe Integer
_) -> do
			Handle -> String -> IO ()
hPutStrLn Handle
stderr String
"This Sketch does not do anything."
			forall a. IO a
exitFailure
		(Just Spec
spec, Just Integer
n) -> Integer -> Spec -> IO ()
interpret Integer
n Spec
spec
		(Just Spec
spec, Maybe Integer
Nothing) -> Spec -> Framework -> IO ()
writeIno Spec
spec Framework
f'
	
	(Maybe Spec
mspec, Framework
f) = forall ctx a.
Context ctx =>
GenSketch ctx a -> (Maybe Spec, GenFramework ctx)
evalSketch Sketch ()
s
	
	-- Strict evaluation because this may throw errors,
	-- and we want to throw them before starting compilation.
	!f' :: Framework
f' = Framework -> Framework
finalizeFramework Framework
f

data CmdLine = CmdLine
	{ CmdLine -> Maybe Integer
interpretSteps :: Maybe Integer
	}


parseCmdLine :: Parser CmdLine
parseCmdLine :: Parser CmdLine
parseCmdLine = Maybe Integer -> CmdLine
CmdLine
	forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (forall a. ReadM a -> Mod OptionFields a -> Parser a
option forall a. Read a => ReadM a
auto
		( forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"interpret"
		forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'i'
		forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
help String
"use copilot to interpret the program, displaying what it would do"
		forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"NUM"
		))

writeIno :: Spec -> Framework -> IO ()
writeIno :: Spec -> Framework -> IO ()
writeIno Spec
spec Framework
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.
	forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
String -> (String -> m a) -> m a
withSystemTempDirectory String
"copilot" forall a b. (a -> b) -> a -> b
$ \String
toptmpdir -> do
		String
mytmpdir <- String -> String -> IO String
createTempDirectory String
toptmpdir String
"copilot"
		forall a. Spec' a -> IO Spec
reify Spec
spec forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> Spec -> IO ()
compile (String
mytmpdir String -> String -> String
</> String
"copilot")
		[String]
c <- String -> [String]
lines forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO String
readFile (String
mytmpdir String -> String -> String
</> String
"copilot.c")
		let c' :: [String]
c' = forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
Prelude.not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Eq a => [a] -> [a] -> Bool
isInfixOf String
"#include \"") [String]
c
		-- Use a name for the ino file that will let the Arduino IDE find it.
		String
d <- IO String
getCurrentDirectory
		let dirbase :: String
dirbase = String -> String
takeFileName String
d
		String -> String -> IO ()
writeFile (String -> String -> String
addExtension String
dirbase String
"ino") forall a b. (a -> b) -> a -> b
$ 
			[String] -> String
unlines forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map CLine -> String
fromCLine forall a b. (a -> b) -> a -> b
$
				Framework -> [CLine] -> [CLine]
sketchFramework Framework
framework (forall a b. (a -> b) -> [a] -> [b]
map String -> CLine
CLine [String]
c')

-- Makes an arduino sketch, using a Framework, and a list of lines of C
-- code generated by Copilot.
sketchFramework :: Framework -> [CLine] -> [CLine]
sketchFramework :: Framework -> [CLine] -> [CLine]
sketchFramework Framework
f [CLine]
ccode = forall a b. (a -> b) -> [a] -> [b]
map String -> CLine
CLine forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
	[
		[ String
"/* automatically generated, do not edit */"
		, String
blank
		, String
"#include <stdbool.h>"
		, String
"#include <stdint.h>"
		, String
blank
		]
	, forall a b. (a -> b) -> [a] -> [b]
map CLine -> String
fromCLine ([CChunk] -> [CLine]
fromchunks (forall ctx. GenFramework ctx -> [CChunk]
defines Framework
f))
	, [String
blank]
	, forall a b. (a -> b) -> [a] -> [b]
map CLine -> String
fromCLine [CLine]
ccode
	, [String
blank]
	,
		[ String
"void setup()"
		]
	, [String] -> [String]
codeblock forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map CLine -> String
fromCLine
		([CChunk] -> [CLine]
fromchunks (forall ctx. GenFramework ctx -> [CChunk]
earlySetups Framework
f) forall a. Semigroup a => a -> a -> a
<> [CChunk] -> [CLine]
fromchunks (forall ctx. GenFramework ctx -> [CChunk]
setups Framework
f))
	, [String
blank]
	,
		[ String
"void loop()"
		]
	, [String] -> [String]
codeblock forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map CLine -> String
fromCLine ([CChunk] -> [CLine]
fromchunks (forall ctx. GenFramework ctx -> [CChunk]
loops Framework
f)) forall a. Semigroup a => a -> a -> a
<>
		[ String
"step();"
		]
	]
  where
	blank :: String
blank = String
""
	indent :: String -> String
indent String
l = String
"  " forall a. Semigroup a => a -> a -> a
<> String
l
	codeblock :: [String] -> [String]
codeblock [String]
l = [String
"{"] forall a. Semigroup a => a -> a -> a
<> forall a b. (a -> b) -> [a] -> [b]
map String -> String
indent [String]
l forall a. Semigroup a => a -> a -> a
<> [String
"}"]
	-- 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 :: [CChunk] -> [CLine]
fromchunks [CChunk]
cl = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\(CChunk [CLine]
l) -> [CLine]
l) forall a b. (a -> b) -> a -> b
$
		forall a. Set a -> [a]
S.toList forall a b. (a -> b) -> a -> b
$ forall a. Ord a => [a] -> Set a
S.fromList [CChunk]
cl

finalizeFramework :: Framework -> Framework
finalizeFramework :: Framework -> Framework
finalizeFramework Framework
f = 
	let pinsetups :: [CChunk]
pinsetups = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall a b. (a -> b) -> a -> b
$
		forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Arduino, Set PinMode) -> Maybe [CChunk]
setuppinmode (forall k a. Map k a -> [(k, a)]
M.toList forall a b. (a -> b) -> a -> b
$ forall ctx. GenFramework ctx -> Map ctx (Set PinMode)
pinmodes Framework
f)
	in Framework
f { setups :: [CChunk]
setups = [CChunk]
pinsetups forall a. Semigroup a => a -> a -> a
<> forall ctx. GenFramework ctx -> [CChunk]
setups Framework
f }
  where
	setuppinmode :: (Arduino, Set PinMode) -> Maybe [CChunk]
setuppinmode (Arduino Int16
n, Set PinMode
s)
		| Set PinMode
s forall a. Eq a => a -> a -> Bool
== forall a. a -> Set a
S.singleton PinMode
OutputMode =
			forall {a}. Show a => a -> String -> Maybe [CChunk]
setmode Int16
n String
"OUTPUT"
		| Set PinMode
s forall a. Eq a => a -> a -> Bool
== forall a. a -> Set a
S.singleton PinMode
InputMode =
			forall {a}. Show a => a -> String -> Maybe [CChunk]
setmode Int16
n String
"INPUT"
		| Set PinMode
s forall a. Eq a => a -> a -> Bool
== forall a. a -> Set a
S.singleton PinMode
InputPullupMode =
			forall {a}. Show a => a -> String -> Maybe [CChunk]
setmode Int16
n String
"INPUT_PULLUP"
		| Set PinMode
s forall a. Eq a => a -> a -> Bool
== forall a. Ord a => [a] -> Set a
S.fromList [PinMode
InputMode, PinMode
InputPullupMode] =
			-- Enabling pullup is documented to make all
			-- reads from that pin be with pullup.
			forall {a}. Show a => a -> String -> Maybe [CChunk]
setmode Int16
n String
"INPUT_PULLUP"
		| forall a. Set a -> Bool
S.null Set PinMode
s = forall a. Maybe a
Nothing
		| Bool
otherwise = forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$
			String
"The program uses pin " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int16
n forall a. [a] -> [a] -> [a]
++
			String
" in multiple ways in different places (" forall a. [a] -> [a] -> [a]
++
			[String] -> String
unwords (forall a b. (a -> b) -> [a] -> [b]
map forall a. Show a => a -> String
show (forall a. Set a -> [a]
S.toList Set PinMode
s)) forall a. [a] -> [a] -> [a]
++ String
"). " forall a. [a] -> [a] -> [a]
++
			String
"This is not currently supported by arduino-copilot."
	
	setmode :: a -> String -> Maybe [CChunk]
setmode a
n String
v = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ [CLine] -> [CChunk]
mkCChunk
		[ String -> CLine
CLine forall a b. (a -> b) -> a -> b
$ String
"pinMode(" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show a
n forall a. Semigroup a => a -> a -> a
<> String
", " forall a. [a] -> [a] -> [a]
++ String
v forall a. [a] -> [a] -> [a]
++ String
");" ]