{-# 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 <> ["}"]