{-# 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.Directory
import System.Posix.Temp (mkdtemp)
import System.FilePath
import Control.Monad.Writer
import Data.List (isInfixOf)
import Data.Maybe
import qualified Data.Map as M
import qualified Data.Set as S
import Options.Applicative
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 f
(is, fs) = unzip (execWriter s)
spec = sequence_ is
!f = finalizeFramework (mconcat fs)
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
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
d <- getCurrentDirectory
let dirbase = takeFileName d
writeFile (addExtension dirbase "ino") $
unlines $ map fromCLine $
sketchFramework framework (map CLine c')
removeDirectoryRecursive mytmpdir
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 (defines f)
, [blank]
, map fromCLine ccode
, [blank]
,
[ "void setup()"
]
, codeblock $ map fromCLine (setups f)
, [blank]
,
[ "void loop()"
]
, codeblock $ map fromCLine (loops f) <>
[ "step();"
]
]
where
blank = ""
indent l = " " <> l
codeblock l = ["{"] <> map indent l <> ["}"]
finalizeFramework :: Framework -> Framework
finalizeFramework f =
let pinsetups = 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] =
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 $ CLine $
"pinMode(" <> show n <> ", " ++ v ++ ");"