Commit 9064006a authored by Steffen Michels's avatar Steffen Michels

improved OS tasks:

 - use platform independent representation of paths (Directory.dcl) instead of strings
 - a custom message is shown to the user while an external process is running
 - the external process node type is removed from the task tree; a monitor node is used to show the message instead

git-svn-id: https://svn.cs.ru.nl/repos/iTask-system/trunk@1115 63da3aa8-80fd-4f01-9db8-e6ea747a3da2
parent e664ce80
......@@ -63,7 +63,6 @@ itasks.TaskForestTabPanel = Ext.extend( Ext.Panel, {
'<div class="taskForestLegend task-grp">Grouping Combinator</div>'+
'<div class="taskForestLegend task-par">Parallel Combinator</div>'+
'<div class="taskForestLegend task-rpc">Remote Procedure Call</div>'+
'<div class="taskForestLegend task-prc">External Process</div>'+
'<div class="x-clear"></div>'
});
......
......@@ -425,10 +425,6 @@ div.taskForestLegend{
background-image:url('img/icons/monitor-go.png') !important;
}
.task-prc {
background-image:url('img/icons/cog.png') !important;
}
.task-seq {
background-image:url('img/icons/arrow_right.png') !important;
}
......
......@@ -4,6 +4,7 @@ import iTasks, CommonDomain, Text
from StdFunc import flip
import PmProject, UtilStrictLists
import CompilerInterface, AppState, Configuration, GUI, StdMisc
from Directory import pathToPD_String
Start world = startEngine [ workflow "Clean IDE (using formatted text type)" (cleanIDEFT <<@ Subject "Clean IDE (using formatted text type)")
, workflow "Clean IDE (using source code type)" (cleanIDESC <<@ Subject "Clean IDE (using source code type)")
......@@ -18,9 +19,9 @@ where
>>= \mbConfig. case mbConfig of
Just config =
createDB (initAppState config)
>>= \sid. isDirectory (config.projectsPath +++ "\\test")
>>= \sid. isDirectory (config.projectsPath +< [PathDown "test"])
>>= \prjExists. if prjExists (return Void) (createTestPrj sid)
>>| openFile (config.projectsPath +++ "\\test\\test.icl") sid
>>| openFile (config.projectsPath +< [PathDown "test", PathDown "test.icl"]) sid
>>| dynamicGroupAOnly [srcEditor sid] (actions sid)
>>| deleteDB sid
Nothing = stop
......@@ -55,9 +56,9 @@ where
>>= \mbConfig. case mbConfig of
Just config =
createDB (initAppState config)
>>= \sid. isDirectory (config.projectsPath +++ "\\test")
>>= \sid. isDirectory (config.projectsPath +< [PathDown "test"])
>>= \prjExists. if prjExists (return Void) (createTestPrj sid)
>>| openFile (config.projectsPath +++ "\\test\\test.icl") sid
>>| openFile (config.projectsPath +< [PathDown "test", PathDown "test.icl"]) sid
>>| dynamicGroupAOnly [srcEditor sid] (actions sid)
>>| deleteDB sid
Nothing = stop
......@@ -100,9 +101,10 @@ menuStructure = [ Menu "File" [ MenuItem "Save" ActionSave Nothing
editProjectOptions desc get putback sid =
readDB sid
>>= \state. accWorld (accFiles (ReadProjectFile (state.ideConfig.projectsPath +++ "\\test\\test.prj") ""))
>>= \state. pathToPDString (state.ideConfig.projectsPath +< [PathDown "test", PathDown "test.prj"])
>>= \prjPath. accWorld (accFiles (ReadProjectFile prjPath ""))
>>= \(prj,ok,err). editOptions desc prj get putback
>>= \prj. accWorld (accFiles (SaveProjectFile (state.ideConfig.projectsPath +++ "\\test\\test.prj") prj ""))
>>= \prj. accWorld (accFiles (SaveProjectFile prjPath prj ""))
>>| stop
editAppStateOptions desc get putback sid =
......@@ -194,7 +196,7 @@ where
save :: !(DBid AppState) -> Task Void
save sid =
readDB sid
>>= \state. writeTextFile (state.ideConfig.projectsPath +++ "\\test\\test.icl") (removeMarkers state.srcEditorContent)
>>= \state. writeTextFile (removeMarkers state.srcEditorContent) (state.ideConfig.projectsPath +< [PathDown "test", PathDown "test.icl"])
saveAndCompile :: !(DBid AppState) -> Task Void
saveAndCompile sid
......@@ -225,11 +227,14 @@ openFile path sid =
createTestPrj :: !(DBid AppState) -> Task Void
createTestPrj sid =
readDB sid
>>= \state. createDirectory (state.ideConfig.projectsPath +++ "\\test")
>>= \state. createDirectory (state.ideConfig.projectsPath +< [PathDown "test"])
>>| accWorld (createPrjFile state.ideConfig.projectsPath)
>>= \ok. writeTextFile (state.ideConfig.projectsPath +++ "\\test\\test.icl") "module test\n\nimport StdEnv\n\nStart = "
>>= \ok. writeTextFile "module test\n\nimport StdEnv\n\nStart = " (state.ideConfig.projectsPath +< [PathDown "test", PathDown "test.icl"])
where
createPrjFile path world = accFiles (\f -> SaveProjectFile (path +++ "\\test\\test.prj") initProj "" f) world
createPrjFile path world
# (pathStr, world) = pathToPD_String (path +< [PathDown "test", PathDown "test.prj"]) world
= accFiles (\f -> SaveProjectFile pathStr initProj "" f) world
initProj = PR_NewProject "test" editOptions compilerOptions codeGenOptions appOptions ("{Project}" :! Nil) linkOptions
where
editOptions = {eo = {newlines = NewlineConventionNone}, pos_size = NoWindowPosAndSize}
......
......@@ -16,12 +16,13 @@ where
compileToExe` =
getConfig sid
>>= \config. getAppPath
>>= \appPath. callProcess (config.oldIDEPath +++ " --batch-build \"" +++ appPath +++ (config.projectsPath +++ "\\test\\test.prj\""))
>>= \appPath. pathToPDString config.projectsPath
>>= \prjPath. callProcess "building project..." config.oldIDEPath ["--batch-build \"" +++ appPath +++ prjPath +++ "\\test\\test.prj\""]
>>= \ret. case ret of
0 = importDocument "projects\\test\\test.exe"
>>= return
_ = readTextFile (config.projectsPath +++ "\\test\\test.logd")
>>= \log. throw (CompilerErrors (filter ((<>) "") (split "\n" log)))
0 = importDocument (prjPath +++ "\\test\\test.exe")
>>= return
_ = readTextFile (config.projectsPath +< [PathDown "test", PathDown "test.log"])
>>= \log. throw (CompilerErrors (filter ((<>) "") (split "\n" log)))
handleCallException (CallFailed path) = throw (CannotRunCompiler ("Error creating process '" +++ path +++ "'"))
handleReadLogException (FileException path _) = throw (CannotRunCompiler ("Unable to retrieve compiler errors from '" +++ path +++ "'"))
......
......@@ -4,8 +4,8 @@ import iTasks, JSON, GUI, AppState
derive class iTask IDEConfig
derive class SharedVariable IDEConfig
derive JSONDecode IDEConfig
derive JSONEncode IDEConfig
derive JSONDecode IDEConfig, Path, PathStep
derive JSONEncode IDEConfig, Path, PathStep
derive bimap Maybe, (,)
loadConfig :: Task (Maybe IDEConfig)
......@@ -47,10 +47,11 @@ where
>>= \ok. case ok of
True = return (config, GotoNext)
False =
requestConfirmation ("Directory '" +++ config.projectsPath +++ "' does not exist. Should it be created?")
pathToPDString config.projectsPath
>>= \prjPath. requestConfirmation ("Directory '" +++ prjPath +++ "' does not exist. Should it be created?")
>>= \create. if create
(let
handleException = (\CannotCreate -> showMessageAbout "Error" ("Could not create '" +++ config.projectsPath +++ "'!") >>| return (config, GotoPrevious))
handleException = (\CannotCreate -> showMessageAbout "Error" ("Could not create '" +++ prjPath +++ "'!") >>| return (config, GotoPrevious))
in
(try (createDirectory config.projectsPath >>| return (config, GotoNext)) handleException)
)
......@@ -68,8 +69,9 @@ where
fileExists config.oldIDEPath
>>= \ok. if ok
(return (config, GotoNext))
( showMessageAbout "Error" ("'" +++ config.oldIDEPath +++ "' does not exist!")
>>| return (config, GotoPrevious)
( pathToPDString config.oldIDEPath
>>= \idePath. showMessageAbout "Error" ("'" +++ idePath +++ "' does not exist!")
>>| return (config, GotoPrevious)
)
)
,
......@@ -77,8 +79,8 @@ where
]
initConfig = { oldIDEPath = "..\\..\\..\\..\\..\\CleanIDE.exe"
, projectsPath = "projects"
initConfig = { oldIDEPath = RelativePath [PathUp, PathUp, PathUp, PathUp, PathUp, PathDown "CleanIDE.exe"]
, projectsPath = RelativePath [PathDown "projects"]
}
getConfig :: !(DBid AppState) -> Task IDEConfig
......
definition module OSTasks
import iTasks
from Directory import :: Path(..), ::DiskName, :: PathStep(..)
:: Path :== String
// Appends a list of path steps to a path.
(+<) infixr 5 :: !Path ![PathStep] -> Path
// Exceptions
:: FileException = FileException !Path !FileProblem
:: FileException = FileException !String !FileProblem
:: FileProblem = CannotOpen | CannotClose | IOError
:: CallException = CallFailed !Path
:: CallException = CallFailed !String
:: DirectoryException = CannotCreate
derive gPrint FileException, FileProblem, CallException, DirectoryException
derive gParse FileException, FileProblem, CallException, DirectoryException
derive gVisualize FileException, FileProblem, CallException, DirectoryException
derive gUpdate FileException, FileProblem, CallException, DirectoryException
derive gHint FileException, FileProblem, CallException, DirectoryException
derive gError FileException, FileProblem, CallException, DirectoryException
derive class iTask Path, FileException, FileProblem, CallException, DirectoryException
derive class SharedVariable Path
/**
* Generate a platform dependent string representation of a path.
*
* @param a path
* @return the path's string representation
*/
pathToPDString :: !Path -> Task String
/**
* Calls an external executable. The call is non-blocking.
*
* @param a message shown to the user while the process is running
* @param path to the executable
* @param a list of command-line arguments
* @return return-code of the process
* @throws CallException
*/
callProcess :: !Path -> Task Int
callProcess :: !message !Path ![String] -> Task Int | html message
/**
* Calls an external executable. The call is blocking and should only
......@@ -32,9 +40,10 @@ callProcess :: !Path -> Task Int
*
* @param path to the executable
* @return return-code of the process
* @param a list of command-line arguments
* @throws CallException
*/
callProcessBlocking :: !Path -> Task Int
callProcessBlocking :: !Path ![String] -> Task Int
/**
* Reads a textfile from disc.
......@@ -79,8 +88,9 @@ isDirectory :: !Path -> Task Bool
createDirectory :: !Path -> Task Void
/**
* Returns the path of the iTasks-server executable.
* Returns the path of the directory including the iTasks-server executable.
* A platform dependent string representation is generated.
*
* @return path of the iTasks-server executable
* @return path of the directory including the iTasks-server executable
*/
getAppPath :: Task String
implementation module OSTasks
import iTasks, TSt, ostoolbox, clCCall_12, StdFile, Text
from Directory import pathToPD_String
import code from "OSTasksC."
derive gPrint FileException, FileProblem, CallException, DirectoryException
derive gParse FileException, FileProblem, CallException, DirectoryException
derive gVisualize FileException, FileProblem, CallException, DirectoryException
derive gUpdate FileException, FileProblem, CallException, DirectoryException
derive gHint FileException, FileProblem, CallException, DirectoryException
derive gError FileException, FileProblem, CallException, DirectoryException
derive class iTask Path, PathStep, FileException, FileProblem, CallException, DirectoryException
derive class SharedVariable Path, PathStep
derive bimap Maybe, (,)
callProcessBlocking :: !Path -> Task Int
callProcessBlocking cmd = mkInstantTask "callProcess" callProcess`
(+<) infixr 5 :: !Path ![PathStep] -> Path
(+<) (RelativePath steps) appSteps = RelativePath (steps ++ appSteps)
(+<) (AbsolutePath disk steps) appSteps = AbsolutePath disk (steps ++ appSteps)
pathToPDString :: !Path -> Task String
pathToPDString path = accWorld (pathToPD_String path)
callProcessBlocking :: !Path ![String] -> Task Int
callProcessBlocking cmd args = mkInstantTask "callProcess" callProcess`
where
callProcess` tst=:{TSt|iworld=iworld=:{IWorld|world}}
# (os,world) = worldGetToolbox world
# (cmd, world) = mkCmdString cmd args world
# (ccmd,os) = winMakeCString cmd os
# (succ,ret,os) = winCallProcess ccmd 0 0 0 0 0 os
# os = winReleaseCString ccmd os
......@@ -24,14 +29,16 @@ where
| not succ = (TaskException (dynamic (CallFailed cmd)), tst)
| otherwise = (TaskFinished ret, tst)
callProcess :: !Path -> Task Int
callProcess cmd = mkExtProcessTask "callProcess" cmd callProcess`
callProcess :: !message !Path ![String] -> Task Int | html message
callProcess msg cmd args = mkMonitorTask "callProcess" callProcess`
where
callProcess` tst
# tst = setStatus (html msg) tst
# (mbHandle, tst) = getTaskStore "handle" tst
# tst=:{TSt|iworld=iworld=:{IWorld|world}}
= tst
# (os, world) = worldGetToolbox world
# (cmd, world) = mkCmdString cmd args world
# (res, handle, os) = case mbHandle of
Nothing
# (ccmd,os) = winMakeCString cmd os
......@@ -66,22 +73,28 @@ where
.end
}
mkCmdString :: !Path ![String] !*World -> (String, *World)
mkCmdString path args world
# (pathStr, world) = pathToPD_String path world
= (foldl (\cmd arg -> cmd +++ " " +++ arg) pathStr args, world)
readTextFile :: !Path -> Task String
readTextFile path = mkInstantTask "readTextFile" readTextFile`
where
readTextFile` tst=:{TSt|iworld=iworld=:{IWorld|world}}
# (ok,file,world) = fopen path FReadText world
| not ok = (TaskException (fileException CannotOpen),{TSt|tst & iworld = {IWorld|iworld & world = world}})
# (pathStr, world) = pathToPD_String path world
# (ok,file,world) = fopen pathStr FReadText world
| not ok = (TaskException (fileException pathStr CannotOpen),{TSt|tst & iworld = {IWorld|iworld & world = world}})
# (mbStrAcc,file) = readFile file []
# (ok,world) = fclose file world
# tst = {TSt|tst & iworld = {IWorld|iworld & world = world}}
= case mbStrAcc of
Nothing = (TaskException (fileException IOError),tst)
Nothing = (TaskException (fileException pathStr IOError),tst)
Just strAcc
| not ok = (TaskException (fileException CannotClose),tst)
| not ok = (TaskException (fileException pathStr CannotClose),tst)
| otherwise = (TaskFinished (foldr (+++) "" (reverse strAcc)),tst)
fileException prob = (dynamic (FileException path prob))
fileException pathStr prob = (dynamic (FileException pathStr prob))
readFile file acc
# (str,file) = freads file 1024
......@@ -92,27 +105,36 @@ where
| otherwise = readFile file [str:acc]
writeTextFile :: !String !Path -> Task Void
writeTextFile path text = mkInstantTask "writeTextFile" writeTextFile`
writeTextFile text path = mkInstantTask "writeTextFile" writeTextFile`
where
writeTextFile` tst=:{TSt|iworld=iworld=:{IWorld|world}}
# (ok,file,world) = fopen path FWriteText world
| not ok = (TaskException (fileException CannotOpen),{TSt|tst & iworld = {IWorld|iworld & world = world}})
# (pathStr, world) = pathToPD_String path world
# (ok,file,world) = fopen pathStr FWriteText world
| not ok = (TaskException (fileException pathStr CannotOpen),{TSt|tst & iworld = {IWorld|iworld & world = world}})
# file = fwrites text file
# (err,file) = ferror file
# (ok,world) = fclose file world
# tst = {TSt|tst & iworld = {IWorld|iworld & world = world}}
| err = (TaskException (fileException IOError),tst)
| not ok = (TaskException (fileException CannotClose),tst)
| err = (TaskException (fileException pathStr IOError),tst)
| not ok = (TaskException (fileException pathStr CannotClose),tst)
| otherwise = (TaskFinished Void,tst)
fileException prob = (dynamic (FileException path prob))
fileException pathStr prob = (dynamic (FileException pathStr prob))
fileExists :: !Path -> Task Bool
fileExists path = mkInstantTask "fileExists" (\tst -> (TaskFinished (winFileExists path), tst))
fileExists path = mkInstantTask "fileExists" fileExists`
where
fileExists` tst=:{TSt|iworld=iworld=:{IWorld|world}}
# (pathStr, world) = pathToPD_String path world
= (TaskFinished (winFileExists pathStr), {TSt|tst & iworld = {IWorld|iworld & world = world}})
isDirectory :: !Path -> Task Bool
isDirectory path = return (winIsDirectory path)
isDirectory path = mkInstantTask "isDirectory" isDirectory`
where
isDirectory` tst=:{TSt|iworld=iworld=:{IWorld|world}}
# (pathStr, world) = pathToPD_String path world
= (TaskFinished (winIsDirectory pathStr), {TSt|tst & iworld = {IWorld|iworld & world = world}})
winIsDirectory :: !{#Char} -> Bool
winIsDirectory _ = code
{
......@@ -122,8 +144,15 @@ where
}
createDirectory :: !Path -> Task Void
createDirectory path = if (winCreateDirectory path) stop (throw CannotCreate)
createDirectory path = mkInstantTask "createDirectory" createDirectory`
where
createDirectory` tst=:{TSt|iworld=iworld=:{IWorld|world}}
# (pathStr, world) = pathToPD_String path world
# tst = {TSt|tst & iworld = {IWorld|iworld & world = world}}
# success = winCreateDirectory pathStr
| success = (TaskFinished Void, tst)
| otherwise = (TaskException (dynamic CannotCreate), tst)
winCreateDirectory :: !{#Char} -> Bool
winCreateDirectory _ = code
{
......
......@@ -293,16 +293,6 @@ mkInstructionTask :: !String !(*TSt -> *(!TaskResult Void,!*TSt)) -> Task Void
*/
mkRpcTask :: !String !RPCExecute !(String -> a) -> Task a | gUpdate{|*|} a
/**
* Create a task represention an external running process.
*
* @param A name used as the task label
* @param The name of the command shown the user if the process is not finished
* at the moment the treee is build
*
* @return Teh constructed external process task
*/
mkExtProcessTask :: !String !String !(*TSt -> *(!TaskResult Int,!*TSt)) -> Task Int
/**
* Wraps a function of proper type to create a task that will consist
* of a sequence of subtasks. The given task function will execute in a blank sequence
* and the resulting sequence will be combined in a single sequence node.
......@@ -312,7 +302,7 @@ mkExtProcessTask :: !String !String !(*TSt -> *(!TaskResult Int,!*TSt)) -> Task
*
* @return The newly constructed sequence task
*/
mkSequenceTask :: !String !(*TSt -> *(!TaskResult a,!*TSt)) -> Task a
mkSequenceTask :: !String !(*TSt -> *(!TaskResult a,!*TSt)) -> Task a
/**
* Wrap a function of proper type to create a function that also
* keeps track of the the internal numbering and administration for
......
......@@ -501,8 +501,6 @@ applyChangeToTaskTree pid (lifetime,change) tst=:{taskNr,taskInfo,tree,staticInf
Nothing
= tst
import StdDebug
calculateTaskTree :: !TaskId ![TaskEvent] !*TSt -> (!TaskTree, !*TSt)
calculateTaskTree taskId events tst
# (mbProcess,tst) = getProcess taskId tst
......@@ -680,12 +678,6 @@ where
setStatus "" tst = tst
setStatus status tst = setTaskStore "status" status tst
mkExtProcessTask :: !String !String !(*TSt -> *(!TaskResult Int,!*TSt)) -> Task Int
mkExtProcessTask taskname cmdline taskfun = Task {initManagerProperties & subject = taskname} initGroupedProperties Nothing mkExtProcessTask`
where
mkExtProcessTask` tst =:{TSt | taskInfo}
= taskfun {tst & tree = TTExtProcessTask taskInfo cmdline}
mkSequenceTask :: !String !(*TSt -> *(!TaskResult a,!*TSt)) -> Task a
mkSequenceTask taskname taskfun = Task {initManagerProperties & subject = taskname} initGroupedProperties Nothing mkSequenceTask`
......@@ -876,8 +868,6 @@ getTaskStoreFor taskNr key tst=:{TSt|iworld=iworld=:{IWorld|store,world}}
where
storekey = "iTask_" +++ (taskNrToString taskNr) +++ "-" +++ key
getEvents :: !*TSt -> ([(!String,!String)],!*TSt)
getEvents tst=:{taskNr,events}
= ([(name,value) \\ (task,name,value) <- events | task == taskId], tst)
......
......@@ -92,14 +92,6 @@ buildTaskPanel` tree menus menusChanged gActions currentUser = case tree of
, html = toString (DivTag [] [Text rpc.RPCExecute.operation.RPCOperation.name, Text ": ", Text rpc.RPCExecute.status])
, subtaskId = Nothing
}
(TTExtProcessTask ti cmdline)
= TTCMonitorContainer {TTCMonitorContainer
| xtype = "itasks.ttc.monitor"
, id = "taskform-" +++ ti.TaskInfo.taskId
, taskId = ti.TaskInfo.taskId
, html = toString (DivTag [] [Text "running '", Text cmdline, Text "' ..."])
, subtaskId = Nothing
}
(TTMainTask ti mti menus _ _)
= TTCProcessControlContainer {TTCProcessControlContainer
| xtype = "itasks.ttc.proc-control"
......@@ -201,7 +193,6 @@ where
TTInteractiveTask ti _ = ti
TTMonitorTask ti _ = ti
TTRpcTask ti _ = ti
TTExtProcessTask ti _ = ti
TTFinishedTask ti _ = ti
TTParallelTask ti _ _ = ti
TTSequenceTask ti _ = ti
......
......@@ -26,7 +26,6 @@ from TUIDefinition import :: TUIDef, :: TUIUpdate
| TTMonitorTask TaskInfo [HtmlTag] //A task that upon evaluation monitors a condition and may give status output
| TTInstructionTask TaskInfo [HtmlTag] (Maybe [HtmlTag]) //A task which displays an (offline) instruction to the user
| TTRpcTask TaskInfo RPCExecute //A task that represents an rpc invocation
| TTExtProcessTask TaskInfo !String //A task that represents an external process
| TTSequenceTask TaskInfo [TaskTree] //A task that is composed of a number of sequentially executed subtasks
| TTParallelTask TaskInfo TaskParallelInfo [TaskTree] //A task that is composed of a number of parallel executed subprocesses
| TTGroupedTask TaskInfo [TaskTree] ![(Action, (Either Bool (*TSt -> *(!Bool,!*TSt))))] !(Maybe String) //A task that is composed of a number of grouped subtasks
......
......@@ -82,18 +82,6 @@ where
, children = []
}
mkTree (TTExtProcessTask info _ )
= { cls = "master-task"
, uiProvider = "col"
, user = ""
, leaf = True
, iconCls = "task-prc"
, taskId = info.TaskInfo.taskId
, taskLabel = toString (Text info.TaskInfo.taskLabel)
, taskClass = "RPC"
, children = []
}
mkTree (TTSequenceTask info trees)
= { cls = "master-task"
, uiProvider = "col"
......
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment