Commit 7dde9908 authored by Mart Lubbers's avatar Mart Lubbers

Remove external processes from the core

External processes now just register for the clock with a polling rate
parent fde2f9d1
implementation module BasicAPIExamples
import iTasks
import System.Process
import System.Time
import iTasks.Extensions.Admin.UserAdmin
import iTasks.Extensions.Admin.ServerAdmin
import iTasks.Extensions.Admin.StoreAdmin
......@@ -10,7 +12,7 @@ import iTasks.Extensions.Currency
import iTasks.Extensions.Contact
import iTasks.Extensions.DateTime
import iTasks.Extensions.Clock
import Text, Text.HTML, StdArray
import Text, Text.HTML, StdArray, StdMisc
import iTasks.Internal.Tonic
//import ligrettoTOP
//import iTaskGraphics, editletGraphics, edgehog
......@@ -102,10 +104,6 @@ Start world
where
title = "iTasks Example Collection"
//* utility functions
undef = undef
//hasValue tf (Value v _) = Just (tf v)
//hasValue _ _ = Nothing
......@@ -282,7 +280,7 @@ editSharedList store
>>* [ OnAction (Action "Append") (hasValue (showAndDo append))
, OnAction (Action "Delete") (hasValue (showAndDo delete))
, OnAction (Action "Edit") (hasValue (showAndDo edit))
, OnAction (Action "Clear") (always (showAndDo append (-1,undef)))
, OnAction (Action "Clear") (always (showAndDo append (-1, undef)))
, OnAction (Action "Quit") (always (return ()))
]
where
......@@ -712,21 +710,11 @@ add_cell new turn board
externalProcessExample =
enterInformation "Enter the path to the external process. To for instance open a shell run '/bin/bash' or 'c:\\Windows\\System32\\cmd.exe'." [] >>= \path ->
withShared
Nothing
( \sds -> ( externalProcess () path [] Nothing sds handlers Nothing gEditor{|*|} <<@ ApplyLayout (removeSubUIs (SelectByPath [])) >&>
viewSharedInformation "Process output" []
) -&&-
forever (enterInformation "Enter data to send to StdIn" [] >>= \data -> set (Just (data +++ "\n")) sds)
)
where
handlers = { onStartup = \ _ -> (Ok "", Nothing, [], False)
, onOutData = onData
, onErrData = onData
, onShareChange = \ l _ -> (Ok l, Nothing, [], False)
, onExit = \_ l _ -> (Ok l, Nothing)
}
onData data l mbOutput = (Ok (l +++ data +++ "\n"), Just Nothing, maybeToList mbOutput, False)
withShared [] \stdin->
withShared ([], []) \stdouterr->
(externalProcess {tv_sec=0,tv_nsec=100000000} path [] Nothing stdin stdouterr (Just defaultPtyOptions) <<@ NoUserInterface)
-|| viewSharedInformation "Output" [] stdouterr
-|| forever (enterInformation "Data to send to stdin" [] >>= \l->upd (\ls->ls ++ [l +++ "\n"]) stdin)
//* Customizing interaction with views
......
......@@ -35,4 +35,4 @@ where
onExit (ExitCode exitCode) info _ = (Ok {ProcessInformation|info & status = CompletedProcess exitCode}, Nothing)
callInstantProcess :: !FilePath ![String] !(Maybe FilePath) -> Task Int
callInstantProcess cmd args dir = accWorldError (\world -> 'System.Process'.callProcess cmd args dir world) CallFailed
callInstantProcess cmd args dir = accWorldError (\world -> 'System.Process'.callProcess cmd args dir world) CallFailed
......@@ -9,11 +9,10 @@ from Data.Queue import :: Queue
from StdFile import class FileSystem
from System.Time import :: Timestamp, :: Timespec
from Text.GenJSON import :: JSONNode
from System.Process import :: ProcessHandle, :: ProcessIO
from iTasks.Engine import :: EngineOptions
from iTasks.UI.Definition import :: UI, :: UIType
from iTasks.Internal.TaskState import :: ParallelTaskState, :: TIMeta, :: DeferredJSON
from iTasks.Internal.Task import :: ExternalProcessTask, :: ConnectionTask, :: BackgroundTask
from iTasks.Internal.Task import :: ConnectionTask, :: BackgroundTask
from iTasks.Internal.TaskEval import :: TaskTime
from iTasks.WF.Definition import :: TaskValue, :: Event, :: TaskId, :: InstanceNo, :: TaskNo
......@@ -78,7 +77,6 @@ CLEAN_HOME_VAR :== "CLEAN_HOME"
:: *IOTaskInstance
= ListenerInstance !ListenerInstanceOpts !*TCP_Listener
| ConnectionInstance !ConnectionInstanceOpts !*TCP_DuplexChannel
| ExternalProcessInstance !ExternalProcessInstanceOpts !ProcessHandle !ProcessIO
| BackgroundInstance !BackgroundInstanceOpts !BackgroundTask
:: ListenerInstanceOpts =
......@@ -99,12 +97,6 @@ CLEAN_HOME_VAR :== "CLEAN_HOME"
:: ConnectionId :== Int
:: ExternalProcessInstanceOpts =
{ taskId :: !TaskId //Reference to the task that started the external process
, connectionId :: !ConnectionId //Unique connection id (per listener/outgoing connection)
, externalProcessTask :: !ExternalProcessTask //The io task definition that defines how the process IO is handled
}
:: BackgroundInstanceOpts =
{ bgInstId :: !BackgroundTaskId
}
......
......@@ -11,7 +11,6 @@ from iTasks.WF.Combinators.Core import :: TaskListItem, :: ParallelTaskType
from iTasks.Extensions.DateTime import :: Time, :: Date, :: DateTime, toTime, toDate
from iTasks.Internal.TaskEval import :: TaskTime
from iTasks.Engine import :: EngineOptions(..)
from System.Process import :: ProcessHandle, :: ProcessIO
import Data.Integer
import iTasks.SDS.Combinators.Common
......
......@@ -5,7 +5,7 @@ definition module iTasks.Internal.Task
import iTasks.WF.Definition
from iTasks.Internal.Tonic.AbsSyn import :: ExprId (..)
from iTasks.WF.Tasks.IO import :: ExternalProcessHandlers, :: ConnectionHandlers
from iTasks.WF.Tasks.IO import :: ConnectionHandlers
from iTasks.Internal.TaskState import :: TaskTree
from iTasks.SDS.Definition import :: SDS, :: RWShared
......@@ -44,20 +44,6 @@ derive gEq Task
, onDisconnect :: !( l r *IWorld -> *(!MaybeErrorString l, Maybe w, !*IWorld))
}
//Low-level task that handles external processes
:: ExternalProcessTask = ExternalProcessTask !(ExternalProcessHandlers Dynamic Dynamic Dynamic) !(RWShared () Dynamic Dynamic)
/*
:: ExitCode = ExitCode !Int
:: ExternalProcessHandlers l r w =
{ onStartup :: !( r -> (!MaybeErrorString l, !Maybe w, ![String], !Bool))
, onOutData :: !(String l r -> (!MaybeErrorString l, !Maybe w, ![String], !Bool))
, onErrData :: !(String l r -> (!MaybeErrorString l, !Maybe w, ![String], !Bool))
, onShareChange :: !( l r -> (!MaybeErrorString l, !Maybe w, ![String], !Bool))
, onExit :: !(ExitCode l r -> (!MaybeErrorString l, !Maybe w ))
}
*/
//Background computation tasks
:: BackgroundTask = BackgroundTask !(*IWorld -> *(!MaybeError TaskException (), !*IWorld))
......@@ -67,10 +53,6 @@ derive gEq Task
wrapConnectionTask :: (ConnectionHandlers l r w) (RWShared () r w) -> ConnectionTask | TC l & TC r & TC w
wrapIWorldConnectionTask :: (ConnectionHandlersIWorld l r w) (RWShared () r w) -> ConnectionTask | TC l & TC r & TC w
/**
* Wraps a set of handlers and a shared source as an external process task
*/
wrapExternalProcTask :: !(ExternalProcessHandlers l r w) !(RWShared () r w) -> ExternalProcessTask | TC l & TC r & TC w & iTask l
/**
* Create a task that finishes instantly
......
......@@ -88,31 +88,6 @@ where
# (mbl, mbw, env) = onDisconnect l r env
= (toDyn <$> mbl, toDyn <$> mbw, env)
wrapExternalProcTask :: !(ExternalProcessHandlers l r w) !(RWShared () r w) -> ExternalProcessTask | TC l & TC r & TC w & iTask l
wrapExternalProcTask {onStartup, onOutData, onErrData, onShareChange, onExit} sds = ExternalProcessTask
{onStartup = onStartup`, onOutData = onOutData`, onErrData = onErrData`, onShareChange = onShareChange`, onExit = onExit`}
(toDynamic sds)
where
onStartup` (r :: r^)
# (mbl, mbw, out, close) = onStartup r
= (toDyn <$> mbl, toDyn <$> mbw, out, close)
onOutData` data (l :: l^) (r :: r^)
# (mbl, mbw, out, close) = onOutData data l r
= (toDyn <$> mbl, toDyn <$> mbw, out, close)
onErrData` data (l :: l^) (r :: r^)
# (mbl, mbw, out, close) = onErrData data l r
= (toDyn <$> mbl, toDyn <$> mbw, out, close)
onShareChange` (l :: l^) (r :: r^)
# (mbl, mbw, out, close) = onShareChange l r
= (toDyn <$> mbl, toDyn <$> mbw, out, close)
onExit` eCode (l :: l^) (r :: r^)
# (mbl, mbw) = onExit eCode l r
= (toDyn <$> mbl, toDyn <$> mbw)
mkInstantTask :: (TaskId *IWorld -> (!MaybeError (Dynamic,String) a,!*IWorld)) -> Task a | iTask a
mkInstantTask iworldfun = Task (evalOnce iworldfun)
where
......
......@@ -6,11 +6,10 @@ from TCPIP import class ChannelEnv, :: IPAddress, :: Timeout
from Internet.HTTP import :: HTTPRequest, :: HTTPResponse
from System.FilePath import :: FilePath
from System.Process import :: ProcessPtyOptions
from Data.Error import :: MaybeError
from iTasks.WF.Definition import :: TaskId
from iTasks.Internal.IWorld import :: IWorld, :: BackgroundTaskId
from iTasks.Internal.Task import :: ExternalProcessTask, :: ConnectionTask, :: BackgroundTask, :: TaskException
from iTasks.Internal.Task import :: ConnectionTask, :: BackgroundTask, :: TaskException
from iTasks.Engine import :: TaskWrapper
//Core task server loop
......@@ -22,9 +21,6 @@ addListener :: !TaskId !Int !Bool !ConnectionTask !*IWorld -> (!MaybeError TaskE
//Dynamically add a connection
addConnection :: !TaskId !String !Int !ConnectionTask !*IWorld -> (!MaybeError TaskException Dynamic,!*IWorld)
//Dynamically add an external process
addExternalProc :: !TaskId !FilePath ![String] !(Maybe FilePath) !ExternalProcessTask (Maybe ProcessPtyOptions) !IWorld -> (!MaybeError TaskException Dynamic, !*IWorld)
//Dynamically add a background task
addBackgroundTask :: !BackgroundTask !*IWorld -> (!MaybeError TaskException BackgroundTaskId,!*IWorld)
......
......@@ -4,8 +4,6 @@ import StdFile, StdBool, StdInt, StdClass, StdList, StdMisc, StdArray, StdTuple,
import Data.Maybe, Data.Functor, Data.Func, Data.Error, System.Time, Text, Data.Tuple
from StdFunc import seq
from Data.Map import :: Map (..)
import qualified System.Process as Process
from System.Process import :: ProcessIO (..), :: ReadPipe, :: WritePipe
import System.CommandLine
import qualified Data.List as DL
import qualified Data.Map as DM
......@@ -26,7 +24,6 @@ import iTasks.SDS.Combinators.Common
:: *IOTaskInstanceDuringSelect
= ListenerInstanceDS !ListenerInstanceOpts
| ConnectionInstanceDS !ConnectionInstanceOpts !*TCP_SChannel
| ExternalProcessInstanceDS !ExternalProcessInstanceOpts !ProcessHandle !ProcessIO
| BackgroundInstanceDS !BackgroundInstanceOpts !BackgroundTask
serve :: ![TaskWrapper] ![(!Int,!ConnectionTask)] ![BackgroundTask] (*IWorld -> (!Maybe Timeout,!*IWorld)) *IWorld -> *IWorld
......@@ -111,7 +108,6 @@ toSelectSet [i:is]
= case i of
ListenerInstance opts l = (False,[l:ls],rs,[ListenerInstanceDS opts:is])
ConnectionInstance opts {rChannel,sChannel} = (False,ls,[rChannel:rs],[ConnectionInstanceDS opts sChannel:is])
ExternalProcessInstance opts pHandle pIO = (e, ls, rs, [ExternalProcessInstanceDS opts pHandle pIO : is])
BackgroundInstance opts bt = (e,ls,rs,[BackgroundInstanceDS opts bt:is])
/* Restore the list of main loop instances.
......@@ -147,10 +143,6 @@ where
| otherwise
# (is,ch) = fromSelectSet` (i+1) numListeners numSeenListeners (numSeenReceivers+1) ls rs [(c,what):ch] is
= ([ConnectionInstance opts {rChannel=rChannel,sChannel=sChannel}:is],ch)
//External process task
fromSelectSet` i numListeners numSeenListeners numSeenReceivers ls rs ch [ExternalProcessInstanceDS opts pHandle pIO : is]
# (is,ch) = fromSelectSet` (i+1) numListeners numSeenListeners numSeenReceivers ls rs ch is
= ([ExternalProcessInstance opts pHandle pIO:is],ch)
//Background tasks
fromSelectSet` i numListeners numSeenListeners numSeenReceivers ls rs ch [BackgroundInstanceDS opts bt:is]
# (is,ch) = fromSelectSet` (i+1) numListeners numSeenListeners numSeenReceivers ls rs ch is
......@@ -242,42 +234,6 @@ process i chList iworld=:{ioTasks={done, todo=[ConnectionInstance opts duplexCha
where
(ConnectionTask handlers sds) = opts.ConnectionInstanceOpts.connectionTask
process i chList iworld=:{ioTasks={done, todo=[ExternalProcessInstance opts pHandle pIO:todo]}}
# iworld = {iworld & ioTasks = {done = done, todo = todo}}
# iworld = processIOTask
i chList opts.ExternalProcessInstanceOpts.taskId opts.ExternalProcessInstanceOpts.connectionId
False sds externalProcessIOOps onClose onData onShareChange onTick
(\(pHandle, pIO) -> ExternalProcessInstance opts pHandle pIO) (pHandle, pIO) iworld
= process (i+1) chList iworld
where
(ExternalProcessTask handlers sds) = opts.externalProcessTask
onData :: !((!ProcessOutChannel, !String)) !Dynamic !Dynamic !*IWorld
-> (!MaybeErrorString Dynamic, !Maybe Dynamic, ![String], !Bool, !*IWorld)
onData (channel, data) l r iworld
# handler = case channel of
StdOut = handlers.onOutData
StdErr = handlers.onErrData
# (mbl, mbw, out, close) = handler data l r
= (mbl, mbw, out, close, iworld)
onShareChange :: !Dynamic !Dynamic !*IWorld
-> (!MaybeErrorString Dynamic, !Maybe Dynamic, ![String], !Bool, !*IWorld)
onShareChange l r iworld
# (mbl, mbw, out, close) = handlers.ExternalProcessHandlers.onShareChange l r
= (mbl, mbw, out, close, iworld)
// do nothing to external proc tasks
onTick :: !Dynamic !Dynamic !*IWorld
-> (!MaybeErrorString Dynamic, !Maybe Dynamic, ![String], !Bool, !*IWorld)
onTick l r iworld
= (Ok l, Nothing, [], False, iworld)
onClose :: !ExitCode !Dynamic !Dynamic !*IWorld -> (!MaybeErrorString Dynamic, !Maybe Dynamic, !*IWorld)
onClose exitCode l r iworld
# (mbl, mbw) = handlers.onExit exitCode l r
= (mbl, mbw, iworld)
process i chList iworld=:{ioTasks={done,todo=[BackgroundInstance opts bt=:(BackgroundTask eval):todo]}}
# (mbe,iworld=:{ioTasks={done,todo}}) = eval {iworld & ioTasks = {done=done,todo=todo}}
| mbe =: (Error _) = abort (snd (fromError mbe)) //TODO Handle the error without an abort
......@@ -285,7 +241,7 @@ process i chList iworld=:{ioTasks={done,todo=[BackgroundInstance opts bt=:(Backg
process i chList iworld=:{ioTasks={done,todo=[t:todo]}}
= process (i+1) chList {iworld & ioTasks={done=[t:done],todo=todo}}
// Definitions of IO tasks (tcp connections, external processes, ...)
// Definitions of IO tasks (tcp connections)
:: IOTaskOperations ioChannels readData closeInfo =
{ readData :: !(Int [(Int, SelectResult)] *(!ioChannels, !*IWorld) -> *(!IOData readData closeInfo, !ioChannels, !*IWorld))
......@@ -324,50 +280,6 @@ where
# world = closeChannel sChannel world
= {iworld & world = world}
:: ProcessOutChannel = StdOut | StdErr
externalProcessIOOps :: IOTaskOperations (!ProcessHandle, !ProcessIO) (!ProcessOutChannel, !String) ExitCode
externalProcessIOOps = {readData = readData, writeData = writeData, closeIO = closeIO}
where
readData :: !Int
![(Int, SelectResult)]
!(!(!ProcessHandle, !ProcessIO), !*IWorld)
-> (!IOData (!ProcessOutChannel, !String) ExitCode, !(!ProcessHandle, !ProcessIO), !*IWorld)
readData _ _ ((pHandle, pIO), iworld)
// try to read StdOut
# (mbData, world) = 'Process'.readPipeNonBlocking pIO.stdOut iworld.world
= case mbData of
Error _ = abort "TODO: handle error"
Ok data
| data == ""
// try to read StdErr
# (mbData, world) = 'Process'.readPipeNonBlocking pIO.stdErr iworld.world
= case mbData of
Error _ = abort "TODO: handle error"
Ok data
| data == ""
# (mbMbRetCode, world) = 'Process'.checkProcess pHandle world
= case mbMbRetCode of
Error _ = abort "TODO: handle error"
Ok Nothing = (IODNoData, (pHandle, pIO), {iworld & world = world})
Ok (Just ec) = (IODClosed (ExitCode ec), (pHandle, pIO), {iworld & world = world})
| otherwise = (IODData (StdErr, data), (pHandle, pIO), {iworld & world = world})
| otherwise = (IODData (StdOut, data), (pHandle, pIO), {iworld & world = world})
writeData :: !String !(!(!ProcessHandle, !ProcessIO), !*IWorld) -> (!(!ProcessHandle, !ProcessIO), !*IWorld)
writeData data ((pHandle, pIO), iworld)
# (mbErr, world) = 'Process'.writePipe data pIO.stdIn iworld.world
= case mbErr of
Error e = abort "TODO: handle error"
_ = ((pHandle, pIO), {iworld & world = world})
closeIO :: !(!(!ProcessHandle, !ProcessIO), !*IWorld) -> *IWorld
closeIO ((pHandle, pIO), iworld)
# (mbErr1, world) = 'Process'.terminateProcess pHandle iworld.world
# (mbErr2, world) = 'Process'.closeProcessIO pIO world
// TODO: handle errors
= {iworld & world = world}
processIOTask :: !Int
![(Int, SelectResult)]
!TaskId
......@@ -550,29 +462,6 @@ where
# opts = {ConnectionInstanceOpts|taskId = taskId, connectionId = 0, remoteHost = ip, connectionTask = connectionTask, removeOnClose = False}
= ConnectionInstance opts channel
addExternalProc :: !TaskId !FilePath ![String] !(Maybe FilePath) !ExternalProcessTask (Maybe 'Process'.ProcessPtyOptions) !IWorld -> (!MaybeError TaskException Dynamic, !*IWorld)
addExternalProc taskId cmd args dir extProcTask=:(ExternalProcessTask handlers sds) mopts iworld
= addIOTask taskId sds init externalProcessIOOps onInitHandler mkIOTaskInstance iworld
where
init :: !*IWorld -> (!MaybeErrorString (!(), (!ProcessHandle, !ProcessIO)), !*IWorld)
init iworld
# (mbRes, world) = case mopts of
Nothing = 'Process'.runProcessIO cmd args dir iworld.world
Just opts = 'Process'.runProcessPty cmd args dir opts iworld.world
= case mbRes of
Error (_, e) = (Error e, {iworld & world = world})
Ok proc = (Ok ((), proc), {iworld & world = world})
onInitHandler :: !() !Dynamic !*IWorld -> (!MaybeErrorString Dynamic, !Maybe Dynamic, ![String], !Bool, !*IWorld)
onInitHandler _ r iworld
# (mbl, mbw, out, close) = handlers.ExternalProcessHandlers.onStartup r
= (mbl, mbw, out, close, iworld)
mkIOTaskInstance :: !() !(!ProcessHandle, !ProcessIO) -> *IOTaskInstance
mkIOTaskInstance _ (pHandle, pIO)
# opts = {ExternalProcessInstanceOpts|taskId = taskId, connectionId = 0, externalProcessTask = extProcTask}
= ExternalProcessInstance opts pHandle pIO
addIOTask :: !TaskId
!(RWShared () Dynamic Dynamic)
!(*IWorld -> (!MaybeErrorString (!initInfo, !.ioChannels), !*IWorld))
......@@ -646,6 +535,3 @@ halt exitCode iworld=:{ioTasks={todo=[ConnectionInstance _ {rChannel,sChannel}:t
= halt exitCode {iworld & ioTasks = {todo=todo,done=done}}
halt exitCode iworld=:{ioTasks={todo=[BackgroundInstance _ _ :todo],done},world}
= halt exitCode {iworld & ioTasks= {todo=todo,done=done}}
halt exitCode iworld=:{ioTasks={todo=[ExternalProcessInstance _ _ _ :todo],done},world}
= halt exitCode {iworld & ioTasks= {todo=todo,done=done}}
definition module iTasks.Internal.Util
from iTasks.WF.Definition import :: TaskResult
from iTasks.WF.Definition import :: TaskException
from StdClass import class Eq
from Data.Error import :: MaybeErrorString, :: MaybeError
from Data.Map import :: Map
from Data.Maybe import :: Maybe
from System.FilePath import :: FilePath
from iTasks.Extensions.DateTime import :: DateTime
from iTasks.Internal.IWorld import :: IWorld
from StdOverloaded import class <
from System.Time import :: Tm
from System.OSError import :: OSError, :: OSErrorCode, :: OSErrorMessage, :: MaybeOSError
......@@ -22,3 +25,11 @@ recursiveDelete :: FilePath *World -> *(MaybeOSError (), *World)
//Create a directory and its parent directories
ensureDir :: FilePath *World -> (!Bool,*World)
//Bind a possibly failing iworld function to another
(>-=) infixl 1 :: (*env -> *(MaybeError e a, *env)) (a -> *(*env -> (MaybeError e b, *env))) *env -> (MaybeError e b, *env)
//Lift a world function to an iworld function
liftIWorld :: (*World -> *(.a, *World)) *IWorld -> *(.a, *IWorld)
//Apply an IWorld transformer and transform the result to a taskresult
apIWTransformer :: *env (*env -> *(MaybeError TaskException (TaskResult a), *env)) -> *(TaskResult a, *env)
......@@ -3,6 +3,8 @@ implementation module iTasks.Internal.Util
import StdBool, StdChar, StdList, StdFile, StdMisc, StdArray, StdString, StdTuple, StdFunc, StdGeneric, StdOrdList
import Data.Maybe, Data.Tuple, Data.Func, System.Time, System.OS, Text, System.FilePath, System.Directory, Text.GenJSON, Data.Error, Data.GenEq
import Data.Error, System.OSError, System.File
import iTasks.Internal.IWorld
import iTasks.WF.Definition
from iTasks.Internal.IWorld import :: IWorld{current}, :: TaskEvalState
from iTasks.Extensions.DateTime import :: Date{..}, :: Time{..}, :: DateTime(..)
import qualified Control.Monad as M
......@@ -68,3 +70,19 @@ where
| isError res = (False,world) //Can't create the directory
= create next rest world //Created the directory, continue
(>-=) infixl 1 :: (*env -> *(MaybeError e a, *env)) (a -> *(*env -> (MaybeError e b, *env))) *env -> (MaybeError e b, *env)
(>-=) a b w
# (mca, w) = a w
= case mca of
Error e = (Error e, w)
Ok a = (b a) w
liftIWorld :: (*World -> *(.a, *World)) *IWorld -> *(.a, *IWorld)
liftIWorld f iworld
# (a, world) = f iworld.world
= (a, {iworld & world=world})
apIWTransformer :: *env (*env -> *(MaybeError TaskException (TaskResult a), *env)) -> *(TaskResult a, *env)
apIWTransformer iw f = case f iw of
(Error e, iw) = (ExceptionResult e, iw)
(Ok tv, iw) = (tv, iw)
......@@ -4,7 +4,7 @@ definition module iTasks.WF.Tasks.IO
* Either by running external programs, creating network clients and servers, or exchanging files
*/
import iTasks.WF.Definition
from iTasks.SDS.Definition import :: RWShared, :: SDS
from iTasks.SDS.Definition import :: RWShared, :: SDS, :: Shared
from iTasks.UI.Prompt import class toPrompt
from System.FilePath import :: FilePath
from System.Process import :: ProcessPtyOptions
......@@ -17,27 +17,19 @@ from Data.Error import :: MaybeError, :: MaybeErrorString
, onDisconnect :: !( l r -> (!MaybeErrorString l, Maybe w ))
}
:: ExitCode = ExitCode !Int
:: ExternalProcessHandlers l r w =
{ onStartup :: !( r -> (!MaybeErrorString l, !Maybe w, ![String], !Bool))
, onOutData :: !(String l r -> (!MaybeErrorString l, !Maybe w, ![String], !Bool))
, onErrData :: !(String l r -> (!MaybeErrorString l, !Maybe w, ![String], !Bool))
, onShareChange :: !( l r -> (!MaybeErrorString l, !Maybe w, ![String], !Bool))
, onExit :: !(ExitCode l r -> (!MaybeErrorString l, !Maybe w ))
}
/**
* Execute an external process. This task's value becomes stable when the process is terminated.
* @param Path to the executable
* @param a list of command-line arguments
* @param (optional) startup directory
* @param A reference to shared data the task has access to
* @param A flag whether to open a pseudotty
* @param The event handler functions
* @param Optionally the pseudotty settings
* @param An editor for visualizing the local state
*/
externalProcess :: !d !FilePath ![String] !(Maybe FilePath) !(SDS () r w) !(ExternalProcessHandlers l r w) !(Maybe ProcessPtyOptions) !(Editor l) -> Task l | toPrompt d & iTask l & TC r & TC w
* Execute an external process. Data placed in the stdin sds is sent to the process, data received is placed in the (stdout, stderr) sds.
*
* @param Poll rate
* @param Path to executable
* @param Command line arguments
* @param Startup directory
* @param Stdin queue
* @param (stdout, stderr) queue
* @param Pseudotty settings
* @result Task returning the exit code on termination
*/
externalProcess :: !Timespec !FilePath ![String] !(Maybe FilePath) !(Shared [String]) !(Shared ([String], [String])) !(Maybe ProcessPtyOptions) -> Task Int
/**
* Connect to an external system using TCP. This task's value becomes stable when the connection is closed
......
implementation module iTasks.WF.Tasks.IO
import iTasks.Internal.SDS
import iTasks.Internal.Util
import iTasks.SDS.Combinators.Common
import iTasks.SDS.Definition
import iTasks.WF.Definition
import iTasks.UI.Definition
import iTasks.UI.Editor
......@@ -14,7 +18,7 @@ import iTasks.Internal.Generic.Visualization
import iTasks.Internal.Generic.Defaults
import System.Process
import Text, Text.GenJSON, StdString, StdInt
import Text, Text.GenJSON, StdString, StdInt, StdBool, StdList, StdTuple
import qualified Data.Map as DM
import qualified Data.Set as DS
......@@ -34,65 +38,61 @@ import qualified Data.Set as DS
, onExit :: !(ExitCode l r -> (!MaybeErrorString l, !Maybe w ))
}
externalProcess :: !d !FilePath ![String] !(Maybe FilePath) !(SDS () r w) !(ExternalProcessHandlers l r w) !(Maybe ProcessPtyOptions) !(Editor l) -> Task l | toPrompt d & iTask l & TC r & TC w
externalProcess prompt cmd args dir sds handlers mopts editor = Task eval
import StdMisc, Data.Tuple, StdFunc, Data.Func
derive JSONEncode ProcessHandle, ProcessIO
derive JSONDecode ProcessHandle, ProcessIO
liftOSErr f iw = case (liftIWorld f) iw of
(Error (_, e), iw) = (Error (exception e), iw)
(Ok a, iw) = (Ok a, iw)
externalProcess :: !Timespec !FilePath ![String] !(Maybe FilePath) !(Shared [String]) !(Shared ([String], [String])) !(Maybe ProcessPtyOptions) -> Task Int
externalProcess poll cmd args dir sdsin sdsout mopts = Task eval
where
eval event evalOpts tree=:(TCInit taskId ts) iworld
= case addExternalProc taskId cmd args dir (wrapExternalProcTask handlers sds) mopts iworld of
(Error e, iworld)
= (ExceptionResult e, iworld)
(Ok (initialValue :: l^), iworld)
= case resetUI taskId initialValue iworld of
(Ok (change,mask), iworld)
# tree = TCBasic taskId ts (toJSON (initialValue,mask)) False
= (ValueResult (Value initialValue False) (info ts) change tree, iworld)
(Error e, iworld) = (ExceptionResult (exception e),iworld)
(Ok _, iworld)
= (ExceptionResult (exception "Corrupt IO task init in externalProcess"), iworld)
eval event evalOpts tree=:(TCBasic taskId ts encodedLocalValue _) iworld=:{ioStates}
= case 'DM'.get taskId ioStates of
Nothing
= (ValueResult NoValue (info ts) NoChange tree, iworld)
Just (IOActive values)
= case 'DM'.get 0 values of
Just (ioStateValue :: l^, stable) = case event of
(RefreshEvent taskIds _ )| 'DS'.member taskId taskIds
= case refreshUI taskId (fromJSON encodedLocalValue) ioStateValue iworld of
(Ok (change,mask), nextValue, iworld)
# tree = TCBasic taskId ts (toJSON (nextValue,mask)) stable
= (ValueResult (Value ioStateValue stable) (info ts) change tree, iworld)
(Error e, nextValue, iworld) = (ExceptionResult (exception e),iworld)
_ = case resetUI taskId ioStateValue iworld of
(Ok (change,mask),iworld)
# tree = TCBasic taskId ts (toJSON (ioStateValue,mask)) stable
= (ValueResult (Value ioStateValue stable) (info ts) change tree, iworld)
(Error e,iworld) = (ExceptionResult (exception e),iworld)
_
= (ExceptionResult (exception "Corrupt IO task result in externalProcess"),iworld)
Just (IOException e)
= (ExceptionResult (exception e),iworld)
fjson = mb2error (exception "Corrupt taskstate") o fromJSON
eval event evalOpts tree=:(TCDestroy (TCBasic taskId ts _ _)) iworld=:{ioStates}
# ioStates = case 'DM'.get taskId ioStates of
Just (IOActive values) = 'DM'.put taskId (IODestroyed values) ioStates
_ = ioStates
= (DestroyedResult</