implementation module IdeState

import StdPSt, StdId, StdPictureDef, StdMisc, StdList, StdProcess, StdPStClass
import StdPathname
import UtilStrictLists
from PmAbcMagic import :: ABCCache, AC_Init
from PmProject import :: Project, PR_GetTarget
import PmCompilerOptions
import typewin
import PmEnvironment
import logfile
import set_return_code
import PmFileInfo
from PmCleanSystem import ::CompilerProcessIds,NoCompilerProcessIds

:: *General =
	{ prefs			:: !Prefs
	, project		:: !Project
	, cache			:: !*(Maybe !*ABCCache)
	, fi_cache		:: !(Maybe FileInfoCache)
	, pr_path		:: !Pathname			// proj_path
	, stup			:: !Pathname			// appl_path
	, g_compiler_process_ids :: !CompilerProcessIds
	, pm_targets	:: ![Target]
	, pm_curtarg	:: !Int
	, logfile		:: !*File
	, int_ids		:: !(!Id,!Id)
	}

initGeneral :: !Bool !CompilerOptions !String !String !Project ![Target] !*File !Id !Id-> *General
initGeneral be_verb comp_opts application_path project_path project targets logfile id1 id2
	| isNothing target_index	= abort ("Unable to find project environment in available environments.\n")
	=
	{ prefs			= prefs
	, project		= project
	, cache			= Just AC_Init
	, fi_cache		= Just FI_EmptyCache
	, pr_path		= project_path
	, stup			= application_path
	, g_compiler_process_ids=NoCompilerProcessIds
	, pm_targets	= targets
	, pm_curtarg	= fromJust target_index
	, logfile		= logfile
	, int_ids		= (id1,id2)
	}
where
	prefs =
		{ be_verbose			= be_verb
		, compopts				= comp_opts
		, edwinfont				= NonProportionalFontDef
		, edwintabs				= (4,True,False,True,True)
		, number_of_processes	= 1
		}
	target_name	= PR_GetTarget project
	target_index = findIndex 0 target_name targets

	findIndex x name [] = Nothing
	findIndex x name [t=:{target_name=n}:ns]
		| n == name = Just x
		= findIndex (inc x) name ns
	
instance Typer General
where
	getTypeWinInfo gen = (dummy_twi,gen)
	setTypeWinInfo twi gen = gen

:: Prefs =
	{ be_verbose			:: !Bool
	, compopts				:: !CompilerOptions
	, edwinfont				:: !FontDef
	, edwintabs				:: !(Int,Bool,Bool,Bool,Bool)	// tabsize, autotab, showtabs, showlinenos, showsyncol
	, number_of_processes	:: !Int
	}

:: ErrPrefs		= ErrPrefs
:: SrcPrefs		= SrcPrefs
:: NewlinePrefs	= NwlPrefs

getPrefs :: !*(PSt *General) -> (Prefs,*PSt *General)
getPrefs ps = ps!ls.prefs

setPrefs :: Prefs !*(PSt *General) -> *PSt *General
setPrefs prefs ps = {ps & ls.prefs = prefs}

getProject :: !*(PSt *General) -> (Project,*PSt *General)
getProject ps = ps!ls.project

setProject :: !Project !*(PSt *General) -> *PSt *General
setProject project ps = {ps & ls.project = project}

getABCCache :: !*(PSt *General) -> *(!*ABCCache,!*PSt *General)
getABCCache ps = accPLoc (\p=:{cache = Just cache}->(cache,{p & cache = Nothing})) ps

setABCCache :: !*ABCCache !*(PSt *General) -> *PSt *General
setABCCache cache ps = {ps & ls.cache = Just cache}

getFICache :: !*(PSt *General) -> (FileInfoCache,*PSt *General)
getFICache ps = accPLoc (\p=:{fi_cache = Just fi_cache}->(fi_cache,{p & fi_cache = Nothing})) ps

setFICache :: !FileInfoCache !*(PSt *General) -> *PSt *General
setFICache ac ps = appPLoc (\p->{p & fi_cache = Just ac}) ps

getPath :: !*(PSt *General) -> (!Pathname,!*PSt *General)
getPath ps = ps!ls.pr_path

setPath :: !Pathname !*(PSt *General) -> !*PSt *General
setPath path ps = {ps & ls.pr_path = path}

getStup :: !*(PSt *General) -> (!Pathname,!*PSt *General)
getStup ps = ps!ls.stup

//-- NOT YET IMPLEMENTED....

getInterrupt :: !*(PSt *General) -> (!(Id,Id),!*PSt *General)
getInterrupt ps = accPLoc (\p=:{int_ids}->(int_ids,p)) ps

getTargets :: !*(PSt *General) -> (![Target],!*PSt *General)
getTargets ps = accPLoc (\p=:{pm_targets}->(pm_targets,p)) ps

setTargets :: ![Target] !*(PSt *General) -> !*PSt *General
setTargets ts ps = appPLoc (\p->{p & pm_targets = ts}) ps

getCurrentTarget :: !*(PSt *General) -> (!Int,!*PSt *General)
getCurrentTarget ps = accPLoc (\p=:{pm_curtarg}->(pm_curtarg,p)) ps

setCurrentTarget :: !Int !*(PSt *General) -> !*PSt *General
setCurrentTarget tg ps
	= appPLoc (\p->{p & pm_curtarg = tg}) ps

getCurrentPaths :: !*(PSt *General) -> (!(List Pathname),!*PSt *General)
getCurrentPaths ps
	# (ct,ps) = accPLoc (\p=:{pm_targets,pm_curtarg}->(pm_targets!!pm_curtarg,p)) ps
	= (ct.target_path,ps)

getCurrentDlibs :: !*(PSt *General) -> (!(List String),!*PSt *General)
getCurrentDlibs ps
	# (ct,ps) = accPLoc (\p=:{pm_targets,pm_curtarg}->(pm_targets!!pm_curtarg,p)) ps
	= (ct.target_libs,ps)

getCurrentSlibs :: !*(PSt *General) -> (!(List String),!*PSt *General)
getCurrentSlibs ps
	# (ct,ps) = accPLoc (\p=:{pm_targets,pm_curtarg}->(pm_targets!!pm_curtarg,p)) ps
	= (ct.target_stat,ps)

getCurrentObjts :: !*(PSt *General) -> (!(List String),!*PSt *General)
getCurrentObjts ps
	# (ct,ps) = accPLoc (\p=:{pm_targets,pm_curtarg}->(pm_targets!!pm_curtarg,p)) ps
	= (ct.target_objs,ps)

getCurrentComp :: !*(PSt *General) -> (!String,!*PSt *General)
getCurrentComp ps
	# (ct,ps) = accPLoc (\p=:{pm_targets,pm_curtarg}->(pm_targets!!pm_curtarg,p)) ps
	= (ct.target_comp,ps)

getCurrentCgen :: !*(PSt *General) -> (!String,!*PSt *General)
getCurrentCgen ps
	# (ct,ps) = accPLoc (\p=:{pm_targets,pm_curtarg}->(pm_targets!!pm_curtarg,p)) ps
	= (ct.target_cgen,ps)

getCurrentLink :: !*(PSt *General) -> (!String,!*PSt *General)
getCurrentLink ps
	# (ct,ps) = accPLoc (\p=:{pm_targets,pm_curtarg}->(pm_targets!!pm_curtarg,p)) ps
	= (ct.target_link,ps)

getCurrentDynl :: !*(PSt *General) -> (!String,!*PSt *General)
getCurrentDynl ps
	# (ct,ps) = accPLoc (\p=:{pm_targets,pm_curtarg}->(pm_targets!!pm_curtarg,p)) ps
	= (ct.target_dynl,ps)

getCurrentVers :: !*(PSt *General) -> (!Int,!*PSt *General)
getCurrentVers ps
	# (ct,ps) = accPLoc (\p=:{pm_targets,pm_curtarg}->(pm_targets!!pm_curtarg,p)) ps
	= (ct.target_vers,ps)

getCurrent64BitProcessor :: !*(PSt *General) -> (!Bool,!*PSt *General)
getCurrent64BitProcessor ps
	# (ct,ps) = accPLoc (\p=:{pm_targets,pm_curtarg}->(pm_targets!!pm_curtarg,p)) ps
	= (ct.env_64_bit_processor,ps)

getCurrentProc :: !*(PSt *General) -> (!Processor,!*PSt *General)
getCurrentProc ps
	# (ct,ps) = accPLoc (\p=:{pm_targets,pm_curtarg}->(pm_targets!!pm_curtarg,p)) ps
	= (ct.target_proc,ps)

getCurrentMeth :: !*(PSt *General) -> (!CompileMethod,!*PSt *General)
getCurrentMeth ps
	# (ct,ps) = accPLoc (\p=:{pm_targets,pm_curtarg}->(pm_targets!!pm_curtarg,p)) ps
	= (ct.target_meth,ps)

getCompilerProcessIds :: !*(PSt *General) -> (!CompilerProcessIds,!*(PSt *General))
getCompilerProcessIds ps = accPLoc (\l -> l!g_compiler_process_ids) ps

setCompilerProcessIds :: !CompilerProcessIds !*(PSt *General) -> *(PSt *General)
setCompilerProcessIds compiler_project_ids ps = appPLoc (\l -> {l & g_compiler_process_ids = compiler_project_ids}) ps

getInteract  :: !*(PSt *General) -> (!Bool,!*PSt *General)
getInteract ps = (False,ps)

writeLog :: !String !*(PSt *General) -> !*PSt *General
writeLog message ps
	= appPLoc (\ls=:{logfile} -> {ls & logfile = writeLogfile message logfile}) ps

abortLog :: !Bool !String !*(PSt *General) -> !*PSt *General
abortLog flag message ps
	# ps		= case message of
					""	-> ps
					_	-> appPLoc (\ls=:{logfile} -> {ls & logfile = writeLogfile message logfile}) ps
	# (lf,ps)	= accPLoc (\ls=:{logfile} -> (logfile,{ls & logfile = stderr})) ps
	# (ok,ps)	= closeLogfile lf ps
//	| not ok ...
	# ps = case flag of
		True	-> set_return_code_pst (-1) ps
		_		-> ps
	= closeProcess ps