module sil

import StdBool
import StdChar
import StdFile
from StdFunc import o, seq
import StdList
import StdOverloaded
import StdString
import StdTuple

import Control.Applicative
import Control.Monad
import Data.Error
from Data.Func import $
import Data.Functor
import Data.Tuple
import System.CommandLine
import System.File
import System.Process

import ABC.Assembler

from Sil.Check import :: CheckError, checkProgram
import qualified Sil.Compile as SC
import Sil.Error
import Sil.Parse
from Sil.Syntax import :: Program
import Sil.Util.Parser
from Sil.Util.Printer import :: PrintState, instance zero PrintState,
	class PrettyPrinter(..), instance PrettyPrinter Program

:: CLI =
	{ prettyprint :: Bool
	, check       :: Bool
	, compile     :: Bool
	, generate    :: Bool
	, run         :: Bool
	, inputfile   :: String
	}

instance zero CLI
where
	zero =
		{ prettyprint = False
		, check       = False
		, compile     = False
		, generate    = False
		, run         = False
		, inputfile   = ""
		}

Start w
# (io,w) = stdio w
# err = stderr
# (cmd,w)  = getCommandLine w
# (args,_) = runParser (arg until eof) $ tl cmd
| isError args
	# err = err <<< toString (fromError args) <<< "\r\n"
	= finish 1 io err w
# args = seq (fromOk args) zero
# (file,w) = readFile args.inputfile w
| isError file
	# err = err <<< "Could not open '" <<< args.inputfile <<< "' for reading.\r\n"
	= finish 1 io err w
# prog = tokenise (fromString $ fromOk file) >>= parse
| isError prog
	# err = err <<< toString (fromError prog) <<< "\r\n"
	= finish 1 io err w
# prog = fromOk prog
# io = if args.prettyprint
	(io <<< print zero prog <<< "\r\n")
	io
# (errs, err) = if args.check
	(appSnd fromJust $ checkProgram (Just err) prog)
	([], err)
| not (isEmpty errs)
	= finish 1 io err w
| not args.compile
	= finish 0 io err w
# (ok,f,w) = fopen "sil_compiled.dcl" FWriteText w
| not ok
	# err = err <<< "Could not open 'sil_compiled.dcl' for writing\r\n"
	= finish 1 io err w
# f = f <<< "definition module sil_compiled"
# (_,w) = fclose f w
# (_,w) = sleep 1 w
# (ok,f,w) = fopen "Clean System Files/sil_compiled.abc" FWriteText w
| not ok
	# err = err <<< "Could not open 'sil_compiled.abc' for writing\r\n"
	= finish 1 io err w
# prog = 'SC'.compile prog
| isError prog
	# err = err <<< fromError prog
	= finish 1 io err w
# f = f <<< fromOk prog
# (_,w) = fclose f w
| not args.generate
	= finish 0 io err w
# (p,w) = callProcess "/opt/clean/bin/clm" ["-l", "-no-pie", "sil_compiled", "-o", "sil_compiled"] Nothing w
| isError p
	# err = err <<< snd (fromError p) <<< "\r\n"
	= finish 1 io err w
| fromOk p <> 0
	= finish (fromOk p) io err w
| not args.run
	= finish 0 io err w
# (p,w) = callProcess "./sil_compiled" [] Nothing w
| isError p
	# err = err <<< snd (fromError p) <<< "\r\n"
	= finish 1 io err w
= finish 0 io err w
where
	arg :: Parser String (CLI -> CLI)
	arg = peek >>= \opt ->
		(   item "--pretty-print" *> pure (\cli -> {cli & prettyprint=True})
		<|> item "--check"        *> pure (\cli -> {cli & check=True})
		<|> item "--compile"      *> pure (\cli -> {cli & compile=True})
		<|> item "--generate"     *> pure (\cli -> {cli & generate=True})
		<|> item "--run"          *> pure (\cli -> {cli & run=True})
		<|> (satisfy isFilename >>= \name -> pure (\cli -> {cli & inputfile=name}))
		<?> P_Invalid "command line argument" opt
		)

	isFilename :: (String -> Bool)
	isFilename = all (\c -> isAlphanum c || isMember c ['./-']) o fromString

	finish :: !Int !*File !*File !*World -> *World
	finish ret io err w
	# (_,w) = fclose io w
	# (_,w) = fclose err w
	# w     = setReturnCode ret w
	= w

	sleep :: !Int !*World -> *(!Int, !*World)
	sleep i w = code inline {
		ccall sleep "I:I:A"
	}