module minfp

import StdEnv
import Data.Either
import Data.Functor
import Data.List
import Control.Monad
import System.GetOpt
import System.CommandLine

import parse, ast, check, int, gen

chars :: *File -> ([Char], *File)
chars f
	# (ok,c,f) = freadc f
	| not ok = ([], f)
	# (cs,f) = chars f
	= ([c:cs], f)

:: Mode = MHelp | MLex | MParse | MType | MInterpret | MGen

opts :: [OptDescr (Mode -> Mode)]
opts =
	[ Option ['?'] ["help"]      (NoArg (const MHelp))      "Display this message"
	, Option ['l'] ["lex"]       (NoArg (const MLex))       "Up to and including lexing"
	, Option ['p'] ["parse"]     (NoArg (const MParse))     "Up to and including parse"
	, Option ['t'] ["type"]      (NoArg (const MType))      "Up to and including typing"
	, Option ['i'] ["interpret"] (NoArg (const MInterpret)) "Up to and including interpretation"
	, Option ['g'] ["gen"]       (NoArg (const MGen))       "Up to and including generation"
	]

exit :: Int [String] *File *World -> *World
exit i e f w = snd (fclose (foldr fwrites f e) (setReturnCode i w))

Start :: *World -> *World
Start w
	# (io, w) = stdio w
	# ([argv0:args], w) = getCommandLine w
	# (mode, positionals, errs) = getOpt Permute opts args
	# mode = foldl (o) id mode MInterpret
	| not (errs =: []) = exit 1 [e +++ "\n"\\e<-errs] io w
	| not (positionals =: []) = exit 1 ["Positional arguments not allowed"] io w
	# (cs, io) = chars io
	# mstr = case mode of
		MHelp = Left [usageInfo ("Usage: " +++ argv0 +++ " [opts]\n") opts]
		MLex = map (nl o toString) <$> lex cs
		MParse = map (nl o either toString toString) <$> (lex cs >>= parse)
		MType = map (\(t, s)->nl (toString t +++ " :: " +++ toString s)) o snd <$> (lex cs >>= parse >>= check)
		MInterpret = pure o nl o toString <$> (lex cs >>= parse >>= check >>= int o fst)
		MGen = lex cs >>= parse >>= check >>= gen o fst
	= exit (either (\_->1) (\_->0) mstr) (either id id mstr) io w

nl x = x +++ "\n"