Commit 6677b225 authored by Bas Lijnse's avatar Bas Lijnse

Updated 'externalProcess' task to accept an Editor for visualizing the task value.

This version is not perfect yet because it still refreshes its ui on every event
parent 16d89539
......@@ -71,7 +71,7 @@ where
runWithOutput :: FilePath [String] (Maybe FilePath) (Shared [String]) -> Task (ExitCode,[String])
runWithOutput prog args dir out
= externalProcess prog args dir out {onStartup=onStartup,onOutData=onOutData,onErrData=onErrData,onShareChange=onShareChange,onExit=onExit}
= externalProcess prog args dir out {onStartup=onStartup,onOutData=onOutData,onErrData=onErrData,onShareChange=onShareChange,onExit=onExit} gEditor{|*|}
where
onStartup r = (Ok (ExitCode 0,[]), Nothing, [], False)
onOutData data (e,o) r = (Ok (e,o ++ [data]), Just (r ++ [data]), [], False)
......
......@@ -18,7 +18,7 @@ where
callProcess :: !d ![ViewOption ProcessStatus] !FilePath ![String] !(Maybe FilePath) -> Task ProcessStatus | toPrompt d
callProcess prompt viewOptions executable arguments workingDirectory
= externalProcess executable arguments workingDirectory unitShare handlers
= externalProcess executable arguments workingDirectory unitShare handlers gEditor{|*|}
where
handlers = {onStartup = onStartup, onOutData = onOutData, onErrData = onErrData, onShareChange = onShareChange, onExit = onExit}
......
......@@ -20,10 +20,10 @@ serve :: ![TaskWrapper] ![(!Int,!ConnectionTask)] ![BackgroundTask] (*IWorld ->
addListener :: !TaskId !Int !Bool !ConnectionTask !*IWorld -> (!MaybeError TaskException (),!*IWorld)
//Dynamically add a connection
addConnection :: !TaskId !String !Int !ConnectionTask !*IWorld -> (!MaybeError TaskException (),!*IWorld)
addConnection :: !TaskId !String !Int !ConnectionTask !*IWorld -> (!MaybeError TaskException Dynamic,!*IWorld)
//Dynamically add an external process
addExternalProc :: !TaskId !FilePath ![String] !(Maybe FilePath) !ExternalProcessTask !IWorld -> (!MaybeError TaskException (), !*IWorld)
addExternalProc :: !TaskId !FilePath ![String] !(Maybe FilePath) !ExternalProcessTask !IWorld -> (!MaybeError TaskException Dynamic, !*IWorld)
//Dynamically add a background task
addBackgroundTask :: !BackgroundTask !*IWorld -> (!MaybeError TaskException BackgroundTaskId,!*IWorld)
......
......@@ -524,7 +524,7 @@ addListener taskId port removeOnClose connectionTask iworld=:{ioTasks={todo,done
# ioStates = 'DM'.put taskId (IOActive 'DM'.newMap) ioStates
= (Ok (),{iworld & ioTasks = {done=done,todo=todo}, ioStates = ioStates, world = world})
addConnection :: !TaskId !String !Int !ConnectionTask !*IWorld -> (!MaybeError TaskException (),!*IWorld)
addConnection :: !TaskId !String !Int !ConnectionTask !*IWorld -> (!MaybeError TaskException Dynamic,!*IWorld)
addConnection taskId host port connectionTask=:(ConnectionTask handlers sds) iworld
= addIOTask taskId sds init tcpConnectionIOOps onInitHandler mkIOTaskInstance iworld
where
......@@ -547,7 +547,7 @@ where
# opts = {ConnectionInstanceOpts|taskId = taskId, connectionId = 0, remoteHost = ip, connectionTask = connectionTask, removeOnClose = False}
= ConnectionInstance opts channel
addExternalProc :: !TaskId !FilePath ![String] !(Maybe FilePath) !ExternalProcessTask !IWorld -> (!MaybeError TaskException (), !*IWorld)
addExternalProc :: !TaskId !FilePath ![String] !(Maybe FilePath) !ExternalProcessTask !IWorld -> (!MaybeError TaskException Dynamic, !*IWorld)
addExternalProc taskId cmd args dir extProcTask=:(ExternalProcessTask handlers sds) iworld
= addIOTask taskId sds init externalProcessIOOps onInitHandler mkIOTaskInstance iworld
where
......@@ -575,7 +575,7 @@ addIOTask :: !TaskId
!(initInfo Dynamic *IWorld -> (!MaybeErrorString Dynamic, !Maybe Dynamic, ![String], !Bool, !*IWorld))
!(initInfo .ioChannels -> *IOTaskInstance)
!*IWorld
-> (!MaybeError TaskException (), !*IWorld)
-> (!MaybeError TaskException Dynamic, !*IWorld)
addIOTask taskId sds init ioOps onInitHandler mkIOTaskInstance iworld
# (mbInitRes, iworld) = init iworld
= case mbInitRes of
......@@ -586,18 +586,21 @@ addIOTask taskId sds init ioOps onInitHandler mkIOTaskInstance iworld
| isError mbr = (liftError mbr, iworld)
// Evaluate onInit handler
# (mbl, mbw, out, close, iworld) = onInitHandler initInfo (fromOk mbr) iworld
// write output
# (ioChannels, iworld) = seq [ioOps.writeData o \\ o <- out] (ioChannels, iworld)
//Close or add to queue
| close
# iworld = ioOps.closeIO (ioChannels, iworld)
= (Ok (), iworld)
# ioStates = iworld.ioStates
# ioStates = case mbl of
Ok l = 'DM'.put taskId (IOActive ('DM'.fromList [(0,(l, False))])) ioStates
Error e = 'DM'.put taskId (IOException e) ioStates
# {done, todo} = iworld.ioTasks
= (Ok (), {iworld & ioStates = ioStates, ioTasks = {done = [mkIOTaskInstance initInfo ioChannels : done], todo = todo}})
// Check initialization of local state
= case mbl of
Error e = (Error (exception e), iworld)
Ok l
// write output
# (ioChannels, iworld) = seq [ioOps.writeData o \\ o <- out] (ioChannels, iworld)
//Close or add to queue
| close
# iworld = ioOps.closeIO (ioChannels, iworld)
= (Ok (dynamic l), iworld)
| otherwise
# ioStates = iworld.ioStates
# ioStates = 'DM'.put taskId (IOActive ('DM'.fromList [(0,(l, False))])) ioStates
# {done, todo} = iworld.ioTasks
= (Ok l, {iworld & ioStates = ioStates, ioTasks = {done = [mkIOTaskInstance initInfo ioChannels : done], todo = todo}})
//Dynamically add a background task
addBackgroundTask :: !BackgroundTask !*IWorld -> (!MaybeError TaskException BackgroundTaskId,!*IWorld)
......
......@@ -31,8 +31,9 @@ from Data.Error import :: MaybeError, :: MaybeErrorString
* @param (optional) startup directory
* @param A reference to shared data the task has access to
* @param The event handler functions
* @param An editor for visualizing the local state
*/
externalProcess :: !FilePath ![String] !(Maybe FilePath) !(RWShared () r w) !(ExternalProcessHandlers l r w) -> Task l | iTask l & TC r & TC w
externalProcess :: !FilePath ![String] !(Maybe FilePath) !(SDS () r w) !(ExternalProcessHandlers l r w) !(Editor l) -> Task l | iTask l & TC r & TC w
/**
* Connect to an external system using TCP. This task's value becomes stable when the connection is closed
* @param Hostname
......
......@@ -2,6 +2,8 @@ implementation module iTasks.WF.Tasks.IO
import iTasks.WF.Definition
import iTasks.UI.Definition
import iTasks.UI.Editor
import iTasks.UI.Prompt
import iTasks.Internal.IWorld
import iTasks.Internal.Task
......@@ -9,6 +11,7 @@ import iTasks.Internal.TaskState
import iTasks.Internal.TaskEval
import iTasks.Internal.TaskServer
import iTasks.Internal.Generic.Visualization
import iTasks.Internal.Generic.Defaults
import Text, Text.JSON
import qualified Data.Map as DM
......@@ -29,25 +32,31 @@ import qualified Data.Map as DM
, onExit :: !(ExitCode l r -> (!MaybeErrorString l, !Maybe w ))
}
externalProcess :: !FilePath ![String] !(Maybe FilePath) !(RWShared () r w) !(ExternalProcessHandlers l r w) -> Task l | iTask l & TC r & TC w
externalProcess cmd args dir sds handlers = Task eval
externalProcess :: !FilePath ![String] !(Maybe FilePath) !(SDS () r w) !(ExternalProcessHandlers l r w) !(Editor l) -> Task l | iTask l & TC r & TC w
externalProcess cmd args dir sds handlers editor = Task eval
where
eval event evalOpts tree=:(TCInit taskId ts) iworld
= case addExternalProc taskId cmd args dir (wrapExternalProcTask handlers sds) iworld of
(Error e, iworld)
= (ExceptionResult e, iworld)
(Ok (l :: l^), iworld)
= case replaceUI taskId l iworld of
(Ok change, iworld) = (ValueResult (Value l False) (info ts) change (TCBasic taskId ts JSONNull False),iworld)
(Error e, iworld) = (ExceptionResult (exception e),iworld)
(Ok _, iworld)
= (ValueResult NoValue {TaskEvalInfo|lastEvent=ts,removedTasks=[],refreshSensitive=True} rep (TCBasic taskId ts JSONNull False),iworld)
= (ExceptionResult (exception "Corrupt IO task init in externalProcess"), iworld)
eval event evalOpts tree=:(TCBasic taskId ts _ _) iworld=:{ioStates}
= case 'DM'.get taskId ioStates of
Nothing
= (ValueResult NoValue {TaskEvalInfo|lastEvent=ts,removedTasks=[],refreshSensitive=True} rep tree, iworld)
= (ValueResult NoValue (info ts) NoChange tree, iworld)
Just (IOActive values)
= case 'DM'.get 0 values of
Just (l :: l^, s)
= (ValueResult (Value l s) {TaskEvalInfo|lastEvent=ts,removedTasks=[],refreshSensitive=True} rep tree, iworld)
Just (l :: l^, s) = case replaceUI taskId l iworld of
(Ok change,iworld) = (ValueResult (Value l s) (info ts) change tree, iworld)
(Error e,iworld) = (ExceptionResult (exception e),iworld)
_
= (ExceptionResult (exception "Corrupt IO task result"),iworld)
= (ExceptionResult (exception "Corrupt IO task result in externalProcess"),iworld)
Just (IOException e)
= (ExceptionResult (exception e),iworld)
......@@ -57,8 +66,13 @@ where
_ = ioStates
= (DestroyedResult,{iworld & ioStates = ioStates})
rep = ReplaceUI (stringDisplay ("External process " <+++ cmd <+++ " " <+++ join " " args))
info ts = {TaskEvalInfo|lastEvent=ts,removedTasks=[],refreshSensitive=True}
replaceUI taskId view iworld
# vst = {VSt| taskId = toString taskId, mode = View, optional = False, selectedConsIndex = -1, iworld = iworld}
= case editor.Editor.genUI [] view vst of
(Ok (editorUI,mask), {VSt|iworld}) = (Ok (ReplaceUI (uic UIInteract [ui UIEmpty, editorUI])), iworld)
(Error e,{VSt|iworld}) = (Error e,iworld)
tcplisten :: !Int !Bool !(RWShared () r w) (ConnectionHandlers l r w) -> Task [l] | iTask l & iTask r & iTask w
tcplisten port removeClosed sds handlers = Task eval
......
......@@ -232,6 +232,7 @@ where
runBuildTool directory
= get cpmExecutable
>>- \cpm -> callProcess () [] cpm ["test.prj"] (Just directory)
>>* [OnAction ActionClose (ifStable return)] //Pause after command...
importExecutable directory state
= importDocument (directory </> "test.exe")
......@@ -247,6 +248,7 @@ where
exportDocument programPath executable
>>- \_ -> makeExecutable programPath
>>- \_ -> callProcess () [] programPath [] (Just temporaryDirectory)
>>* [OnAction ActionClose (ifStable return)] //Pause after command...
)
) @! ()
where
......
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