module Copilot.Arduino.Main (arduino) where

import Language.Copilot (Spec, interpret, reify)
import Copilot.Compile.C99 (compile)
import Copilot.Arduino.Internals
import System.Directory
import System.Posix.Temp (mkdtemp)
import System.FilePath
import Control.Monad.Writer
import Data.List (isInfixOf)
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 =: 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 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 interpretSteps o of
                Just n -> interpret n spec
                Nothing -> writeIno spec (mconcat fs)

        (is, fs) = unzip (execWriter s)
        spec = sequence_ is

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.
        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") $
                unlines $ sketchFramework framework c'
        removeDirectoryRecursive mytmpdir