implementation module iTasks.Gin.Compiler

import StdFile, StdMisc
import iTasks
import iTasks.Framework.IWorld

import iTasks.Gin.Syntax
import iTasks.Gin.AbstractSyntax
import iTasks.Gin.Parser

import iTasks.Gin.CompilerLogParser
import iTasks.Gin.Config

import Text
import Data.Error
import System.OSError

import System.FilePath
from System.File import instance toString FileError, readFile, writeFile
from System.Process import qualified callProcess
from Data.Map import newMap

//from PmCleanSystem import 
	//::CompileOrCheckSyntax(..),
	//::CodeGenerateAsmOrCode(..),
	//::CompilerMsg(..), 
	//::CompilerOptions(..), 
	//::CompilerProcess,
	//::CompilingInfo,
	//::List,
	//::ListTypes(..),
	//::LogEnv(..),
	//::Pathname, 
	//::WindowFun,
	//CodeGen,
	//CompilePersistent,
	//DefaultCompilerOptions,
	//ExitCleanCompiler,
	//InitCompilingInfo,
	//Link,
	//instance == CompilerMsg

//from PmPath import 
	//MakeABCSystemPathname,
	//MakeObjSystemPathname
	
//from PmTypes import
	//:: ApplicationOptions(..),
	//:: CodeGenOptions(..),
	//:: Output(..),
	//:: Processor,
	//DefApplicationOptions,
	//DefaultProcessor,
	//DefCodeGenOptions
	
from linkargs import
	:: LinkInfo`(..),
	:: LPathname,
	ReadLinkOpts

import UtilStrictLists

from System.File import deleteFile

derive class iTask CompileResult

//derive JSONEncode CompilingInfo, CompilerProcess
//derive JSONDecode CompilingInfo, CompilerProcess

tmpDirectory :: *IWorld -> String
tmpDirectory iworld=:{dataDirectory} = dataDirectory +++ "-gin-temp"

runCompiler :: !GModule !(AModule -> (String, FunctionMap, LineMap)) (String String GinConfig FunctionMap LineMap *IWorld -> (CompileResult a, *IWorld)) *IWorld -> (CompileResult a, *IWorld)
runCompiler gMod printfun compiler iworld = undef // TODO
////1. Load configuration
//# (config,iworld) = accWorldIWorld ginLoadConfig iworld 
//| isNothing config = (CompileGlobalError "Configuration not found", iworld)
//# config = fromJust config
////2. Parse and transform GModule
//# (st, iworld) = accWorldIWorld (gToAModule gMod config) iworld
//# result = runParse st
//| isParseError result = (CompilePathError (getParseError result), iworld)
//# aMod = expandModule (getParseSuccess result)
////3. (Pretty-)print module
//# (basename,iworld) = getUniqueBasename iworld
//# (source,functionMap,lineMap) = printfun { AModule | aMod & name = basename }
////4. Write source code to temp icl file
//# fullname = (filenameFromConfig config (tmpDirectory iworld) basename "icl")
//# (result, iworld) = accWorldIWorld (writeFile fullname source) iworld
//| isError result = (CompileGlobalError ("Write icl file failed: " +++ toString (fromError result)), iworld)
////5. Call compiler function
//# (result, iworld) = compiler source basename config functionMap lineMap iworld
////6. Delete temp icl file
//# (deleted,iworld) = accWorldIWorld (deleteFile fullname) iworld
//| isError deleted = (CompileGlobalError ("Failed to delete file " +++ fullname +++ ": " +++ snd (fromError deleted)), iworld)
//= (result, iworld)

getUniqueBasename :: *IWorld -> (String, *IWorld)
getUniqueBasename iworld = undef // TODO
//# (mCounter, iworld) = loadValue key iworld
//# counter = case mCounter of
	//Just c = c + 1
	//Nothing = 0
//# iworld = storeValue key counter iworld
//= (prefix +++ (toString counter), iworld)
//where
	//key = "gin-tempfile"
	//prefix = "temp"

batchBuild :: !GModule *IWorld -> (CompileResult String, *IWorld)
batchBuild gMod iworld = runCompiler gMod printfun build iworld
where
	printfun :: AModule -> (String, FunctionMap, LineMap)
	printfun aMod = (prettyPrintAModule POWriteDynamics aMod, newMap, newMap)

	build :: !String !String !GinConfig FunctionMap LineMap *IWorld -> (CompileResult String, *IWorld)
	build source basename config functionMap lineMap iworld = undef // TODO
	//# (res, iworld) = accWorldIWorld (readFile (config.iTasksPath </> "Server" </> "Gin" </> "project-template")) iworld
	//| isError res = (CompileGlobalError ("Failed to read project template file: " +++ toString (fromError res)), iworld)
	//# projectFile = replaceSubString "{UserPath}" config.userPath (replaceSubString "{Basename}" basename (fromOk res))
	//# (res, iworld) = accWorldIWorld (writeFile (filenameFromConfig config (tmpDirectory iworld) basename "prj") projectFile) iworld
	//| isError res = (CompileGlobalError ("Failed to write project file: " +++ toString (fromError res)), iworld)
	//# projectFile = filenameFromConfig config (tmpDirectory iworld) basename "prj"
	//# (res, iworld) = accWorldIWorld ('System.Process'.callProcess (config.cleanPath </> "CleanIDE.exe") ["--batch-build", projectFile] (Just config.cleanPath)) iworld
	//# (deleted,iworld) = accWorldIWorld (deleteFile projectFile) iworld
	//| isError deleted = (CompileGlobalError ("Failed to delete file " +++ projectFile +++ ": " +++ snd (fromError deleted)), iworld)
	//| isError res = (CompileGlobalError ("Calling Clean IDE failed: " +++ snd (fromError res)), iworld)
	//| fromOk res == 0
		//# batchfile = (filenameFromConfig config (tmpDirectory iworld) basename "bat")
		//# (res, iworld) = accWorldIWorld ('System.Process'.callProcess batchfile [] Nothing) iworld
		//| isError res = (CompileGlobalError ("Failed to run dynamic linker batch file: " +++ snd (fromError res)), iworld)
		//# dynfile = filenameFromConfig config (tmpDirectory iworld) basename "dyn"
		//= (CompileSuccess dynfile, iworld)
	//# (res, iworld) = accWorldIWorld (readFile (filenameFromConfig config (tmpDirectory iworld) basename "log")) iworld
	//| isError res = (CompileGlobalError ("Read log file failed: " +++ toString (fromError res)), iworld)
	//# log = fromOk res
	//= (CompileGlobalError log, iworld)
	
syntaxCheck :: !GModule *IWorld -> (CompileResult Void, *IWorld)
syntaxCheck gMod iworld = undef // runCompiler gMod syntaxCheckPrintAModule (compile SyntaxCheck) iworld

// --------------------------------------------------------------------------------
// Compiler interface
// --------------------------------------------------------------------------------

//compile :: CompileOrCheckSyntax !String !String !GinConfig FunctionMap LineMap *IWorld -> (CompileResult Void, *IWorld)
compile compileOrCheckSyntax source basename config functionMap lineMap iworld = undef // TODO
//# (mCompilingInfo, iworld) = loadCompilingInfo iworld
//# compilingInfo = case mCompilingInfo of
	//Just c = c
	//Nothing = InitCompilingInfo
//# ((compileResult, compilingInfo), iworld) = accWorldIWorld (compile` compilingInfo) iworld
//# iworld = storeCompilingInfo compilingInfo iworld
//# iworld = exitCompiler iworld //<- TODO: remove
//= (compileResult, iworld)
//where
	//compile` :: CompilingInfo *World -> ((CompileResult Void, CompilingInfo), *World)
	//compile` compilingInfo world
	////Take iTasks compiler if iTasks is in subdirectory of Clean distribution
	////Otherwise, fallback to compiler shipped with Clean distribution
	//# compilerPath = 
		//if (config.GinConfig.cleanPath </> "" == takeDirectory config.GinConfig.iTasksPath </> "")
			//(dropDirectory config.GinConfig.iTasksPath </> "Compiler")
			//("Tools" </> "Clean System")
	//# env = { LogEnv | errors = [], world = world }
	//# compilingInfo = InitCompilingInfo //<- TODO: remove
	//# (compilingInfo, (env, _, compilerMsg)) = 
		//CompilePersistent
				//(compilerPath </> "CleanCompiler.exe" +++ " : -h 64M -dynamics -generics")
				//False                                      //Don't write module times
				//addError                                   //Error display function
				//(\_ x -> x)                                //Types display function
				//compileOrCheckSyntax
				//(basename +++ ".icl")
				//(ListToStrictList (searchPaths config (tmpDirectory iworld)))
				//False                                      //No memory profiling
				//False                                      //No time profiling
				//True                                       //Eager or dynamic linking
				//{ DefaultCompilerOptions & listTypes = NoTypes }
				//config.cleanPath
				//compilingInfo
				//env
	//# log = join "\n" (map (join "\n") env.LogEnv.errors)
	//| compilerMsg == GlobalError
		//= ((CompileGlobalError ("Calling Clean compiler failed: " +++ log), compilingInfo), env.LogEnv.world)
	//| compilerMsg == CompilerOK
		//= ((CompileSuccess Void, compilingInfo), env.LogEnv.world)
	//# errors = (findPathErrors (parseCleanCompilerLog log) functionMap lineMap)
	//| isEmpty errors = ((CompileGlobalError log, compilingInfo), env.LogEnv.world)
	//= ((CompilePathError errors, compilingInfo), env.LogEnv.world)

//loadCompilingInfo :: *IWorld -> (Maybe CompilingInfo, *IWorld)
loadCompilingInfo iworld = undef // TODO loadValue compilerId iworld

//storeCompilingInfo :: CompilingInfo *IWorld -> *IWorld
storeCompilingInfo compilingInfo iworld = undef // TODO storeValue compilerId compilingInfo iworld

compilerId :: String
compilerId = "gin-compiler"

deleteCompilingInfo :: *IWorld -> *IWorld
deleteCompilingInfo iworld = undef // TODO deleteValue compilerId iworld

exitCompiler :: *IWorld -> *IWorld
exitCompiler iworld = undef
//# (mCompilingInfo, iworld) = loadCompilingInfo iworld
//| isNothing mCompilingInfo = iworld
//# compilingInfo = fromJust mCompilingInfo
//# (_, iworld) = accWorldIWorld (curry ExitCleanCompiler (fromJust mCompilingInfo)) iworld
//= deleteCompilingInfo iworld

/*
// --------------------------------------------------------------------------------
// Code generator interface
// --------------------------------------------------------------------------------

codegen :: !String !GinConfig *IWorld -> (CompileResult Void, *IWorld) 
codegen basename config iworld=:{tmpDirectory} = accWorldIWorld codegen` iworld
where
	codegen` :: !*World -> (CompileResult Void, *World)	
	codegen` world
	# env = { errors = [], world = world }
	# abcfile = MakeABCSystemPathname (filenameFromConfig config tmpDirectory basename "icl")
	# (pathname, ok, env) = CodeGen
		("Tools" </> "Clean System" </> "CodeGenerator.exe")
		addError
		CodeGeneration
		abcfile
		False	//No time profiling
		DefCodeGenOptions
		DefaultProcessor
		ginApplicationOptions
		config.cleanPath
		env
	# log = join "\n" (map (join "\n") env.LogEnv.errors)
	| not ok
		= (CompileGlobalError ("Code generator error: " +++ log), env.LogEnv.world)
	# world = env.LogEnv.world
	# (_,world) = deleteFile abcfile world
	= (CompileSuccess Void, world)

// --------------------------------------------------------------------------------
// Linker interface
// --------------------------------------------------------------------------------

link :: String !GinConfig *IWorld -> (CompileResult Void, *IWorld) 
link basename config iworld=:{tmpDirectory} = accWorldIWorld (link` basename config) iworld
where
	link` :: !String !GinConfig *World -> (CompileResult Void, *World)	
	link` basename config world
	# ((linkinfo, ok, err), world) = accFiles (ReadLinkOpts (config.iTasksPath </> "Server" </> "Gin" </> "linkopts-template")) world
	| not ok = (CompileGlobalError ("Linker error: Failed to read linker options file: " +++ err), world)
	
	# env = { errors = [], world = world }
	# linkopts = MakeObjSystemPathname DefaultProcessor (filenameFromConfig config tmpDirectory (basename +++ "_options") "icl")
	# (env, ok) = Link
		("Tools" </> "Clean System" </> "StaticLinker.exe")
		addError
		(filenameFromConfig config tmpDirectory basename "exe")
		ginApplicationOptions
		linkopts										    // linker obtions file
		(dynamicLibs config tmpDirectory basename linkinfo)	// dynamic library file names
		(objectPaths config tmpDirectory basename linkinfo)	// object file names
		Nil													// static library file names
		False												// link statically
		False												// generate relocations
		False												// generate link map
		False												// link in resources
		""													// source of resources to link in
		False												// generate dll?
		""													// dll export symbols
		config.cleanPath									// startup directory
		("Tools" </> "Dynamics" </> "DynamicLinker.exe")
		DefaultProcessor
		False												// 64 bit target processor
		env
	//Delete object file and link opts
	# world = env.LogEnv.world
	# (_, world) = deleteFile (MakeObjSystemPathname DefaultProcessor (filenameFromConfig config tmpDirectory basename "obj")) world
	# (_, world) = deleteFile linkopts world
	# log = join "\n" (map (join "\n") env.LogEnv.errors)
	| not ok
		= (CompileGlobalError (log), world)
	= (CompileSuccess Void, world)

dynamicLibs :: !GinConfig !String !String !LinkInfo` -> List LPathname
dynamicLibs config tempPath basename linkinfo = Map (setLinkPaths config tempPath basename) linkinfo.dynamic_libs

objectPaths :: !GinConfig !String !String !LinkInfo` -> List LPathname
objectPaths config tempPath basename linkinfo = Map (setLinkPaths config tempPath basename) linkinfo.object_paths
	
setLinkPaths :: !GinConfig !String String !String -> String
setLinkPaths config tempPath basename haystack
# haystack = replaceSubString "{Project}" tempPath haystack
# haystack = replaceSubString "{ITasks}" config.iTasksPath haystack
# haystack = replaceSubString "{Application}" config.cleanPath haystack
# haystack = replaceSubString "{Serialization}" serializationModule haystack
= replaceSubString "{Basename}" basename haystack
*/

// --------------------------------------------------------------------------------
// Utility functions
// --------------------------------------------------------------------------------

failed :: (CompileResult a) -> Bool
failed (CompileSuccess _) = False
failed _ = True

convertFail :: (CompileResult a) -> (CompileResult b)
convertFail (CompileGlobalError msg) = CompileGlobalError msg
convertFail (CompilePathError paths) = CompilePathError paths

//addError :: [String] LogEnv -> LogEnv
addError err _ = undef //{LogEnv | errors=errs, world=w } = {LogEnv | errors = errs ++ [err], world=w} 	/* trace_n (join "\n" err) */

accWorldIWorld :: (*World -> (b, *World)) *IWorld -> (b, *IWorld)
accWorldIWorld f iworld
# (r, world) = f iworld.IWorld.world
= (r, { IWorld | iworld & world = world })

appWorldIWorld :: (*World -> *World) *IWorld -> *IWorld
appWorldIWorld f iworld = { IWorld | iworld & world = f iworld.IWorld.world }
	
filenameFromConfig :: !GinConfig !String !String !String -> String
filenameFromConfig config tempPath basename extension = tempPath </> basename +++ "." +++ extension

// --------------------------------------------------------------------------------
// Project settings
// --------------------------------------------------------------------------------

//ginApplicationOptions :: ApplicationOptions
ginApplicationOptions = undef // { DefApplicationOptions & o = NoConsole}

searchPaths :: !GinConfig !String -> [String]
searchPaths config tempPath = 
	[ tempPath
	: config.userPath
	: map ((</>) config.iTasksPath) iTasksPaths
	++ map ((</>) config.cleanPath) cleanPaths
	]

iTasksPaths :: [String]
iTasksPaths = 
	[ "Server"
	, "Server\\API\\Common"
	, "Server\\API\\Core"
	, "Server\\API\\Extensions"
	, "Server\\API\\Extensions\\Admin"
	, "Server\\Framework"
	, "Server\\Framework\\Data"
	, "Server\\Framework\\Handlers"
	, "Server\\lib"
	, "Server\\lib\\Http"
	, "Server\\lib\\Platform\\OS-Independent"
	, "Server\\lib\\Platform\\OS-Independent\\Data"
	, "Server\\lib\\Platform\\OS-Independent\\Database"
	, "Server\\lib\\Platform\\OS-Independent\\Database\\SQL"
	, "Server\\lib\\Platform\\OS-Independent\\GUI"
	, "Server\\lib\\Platform\\OS-Independent\\Internet"
	, "Server\\lib\\Platform\\OS-Independent\\Internet\\HTTP"
	, "Server\\lib\\Platform\\OS-Independent\\Math"
	, "Server\\lib\\Platform\\OS-Independent\\Network"
	, "Server\\lib\\Platform\\OS-Independent\\System"
	, "Server\\lib\\Platform\\OS-Independent\\Test"
	, "Server\\lib\\Platform\\OS-Independent\\Text"
	, "Server\\lib\\Platform\\OS-Independent\\Text\\Encodings"
	, "Server\\lib\\Platform\\OS-Windows\\Data"
	, "Server\\lib\\Platform\\OS-Windows\\Network"
	, "Server\\lib\\Platform\\OS-Windows\\System"
	, "Server\\lib\\Platform\\OS-Windows\\Database"
	, "Server\\lib\\Platform\\OS-Windows\\Database\\SQL"
	, "Server\\lib\\Platform\\OS-Windows-32\\System"
	, "Server\\lib\\graph_copy"
	]

cleanPaths :: [String]
cleanPaths = 
	[ "Libraries\\StdEnv"
	, "Libraries\\StdLib"
	, "Libraries\\Generics"
	, "Libraries\\Dynamics"
	, "Libraries\\Dynamics\\general"
	, "Libraries\\Dynamics\\implementation"
	, "Libraries\\Dynamics\\implementation\\windows"
	, "Libraries\\Directory"
	, "Libraries\\TCPIP"
	]