IO.icl 6.43 KB
Newer Older
1 2
implementation module iTasks.WF.Tasks.IO

3 4 5 6
import iTasks.Internal.SDS
import iTasks.Internal.Util
import iTasks.SDS.Combinators.Common
import iTasks.SDS.Definition
7
import iTasks.WF.Definition
Mart Lubbers's avatar
Mart Lubbers committed
8
import iTasks.WF.Derives
9
import iTasks.UI.Definition
10
import iTasks.UI.Editor
11

12 13 14 15 16 17
import iTasks.Internal.IWorld
import iTasks.Internal.Task
import iTasks.Internal.TaskState
import iTasks.Internal.TaskEval
import iTasks.Internal.TaskServer
import iTasks.Internal.Generic.Visualization
18
import iTasks.Internal.Generic.Defaults
Mart Lubbers's avatar
Mart Lubbers committed
19
import iTasks.WF.Tasks.Core
20

21
import System.Process
22
import Text, Text.GenJSON, StdString, StdInt, StdBool, StdList, StdTuple, Data.Tuple, Data.Func, StdFunc
23
import qualified Data.Map as DM
24
import qualified Data.Set as DS
25 26 27

:: ExitCode = ExitCode !Int
:: ExternalProcessHandlers l r w =
28 29 30 31 32
    { 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                ))
33 34
    }

35 36 37 38 39 40 41
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)

42
externalProcess :: !Timespec !FilePath ![String] !(Maybe FilePath) !(Maybe ProcessPtyOptions) !(Shared sds1 [String]) !(Shared sds2 ([String], [String])) -> Task Int | RWShared sds1 & RWShared sds2
Mart Lubbers's avatar
Mart Lubbers committed
43
externalProcess poll cmd args dir mopts sdsin sdsout = Task evalinit
44
where
Mart Lubbers's avatar
Mart Lubbers committed
45 46 47
	evalinit DestroyEvent _ iworld
		= (DestroyedResult, iworld)
	evalinit event evalOpts=:{TaskEvalOpts|taskId} iworld
48
		= case liftOSErr (maybe (runProcessIO cmd args dir) (runProcessPty cmd args dir) mopts) iworld of
Mart Lubbers's avatar
Mart Lubbers committed
49 50
			(Error e, iworld)  = (ExceptionResult e, iworld)
			(Ok phpio, iworld) = eval phpio event evalOpts iworld
51

Mart Lubbers's avatar
Mart Lubbers committed
52
	eval (ph, pio) DestroyEvent {TaskEvalOpts|taskId} iworld
Mart Lubbers's avatar
Mart Lubbers committed
53 54 55 56 57
		# iworld = clearTaskSDSRegistrations ('DS'.singleton taskId) iworld
		= apIWTransformer iworld
		$       liftOSErr (terminateProcess ph)
		>-= \_->liftOSErr (closeProcessIO pio)
		>-= \_->tuple (Ok DestroyedResult)
58
	//TODO: Support async sdss
Mart Lubbers's avatar
Mart Lubbers committed
59
	eval (ph, pio) event {taskId,lastEval} iworld
Mart Lubbers's avatar
Mart Lubbers committed
60
		| not (isRefreshForTask event taskId)
Mart Lubbers's avatar
Mart Lubbers committed
61
			= (ValueResult NoValue (mkTaskEvalInfo lastEval) (mkUIIfReset event rep) (Task (eval (ph, pio))), iworld)
Mart Lubbers's avatar
Mart Lubbers committed
62
		= apIWTransformer iworld $
Haye Böhm's avatar
Haye Böhm committed
63
			read sdsout EmptyContext                    >-= \(ReadingDone (stdoutq, stderrq))->
64 65 66
			liftOSErr (readPipeNonBlocking pio.stdOut)  >-= \stdoutData->
			liftOSErr (readPipeNonBlocking pio.stdErr)  >-= \stderrData->
			(if (stdoutData == "" && stderrData == "")
Haye Böhm's avatar
Haye Böhm committed
67
				(tuple (Ok WritingDone))
68 69
				(write (stdoutq ++ filter ((<>)"") [stdoutData]
				       ,stderrq ++ filter ((<>)"") [stderrData]
Haye Böhm's avatar
Haye Böhm committed
70
				       ) sdsout EmptyContext))          >-= \WritingDone->
71
			liftOSErr (checkProcess ph)                 >-= \mexitcode->case mexitcode of
Mart Lubbers's avatar
Mart Lubbers committed
72
				(Just i) = tuple (Ok (ValueResult (Value i True) (mkTaskEvalInfo lastEval) (mkUIIfReset event rep) (treturn i)))
73 74
				Nothing =
					readRegister taskId clock                            >-= \_->
Haye Böhm's avatar
Haye Böhm committed
75
					readRegister taskId sdsin                            >-= \(ReadingDone stdinq)->
76
					liftOSErr (writePipe (concat stdinq) pio.stdIn)      >-= \_->
Haye Böhm's avatar
Haye Böhm committed
77
					(if (stdinq =: []) (tuple (Ok WritingDone)) (write [] sdsin EmptyContext)) >-= \WritingDone ->
Mart Lubbers's avatar
Mart Lubbers committed
78
					tuple (Ok (ValueResult NoValue (mkTaskEvalInfo lastEval) (mkUIIfReset event rep)
Mart Lubbers's avatar
Mart Lubbers committed
79
						(Task (eval (ph, pio)))))
80

81
	rep = stringDisplay ("External process: " <+++ cmd)
82
	clock = sdsFocus {start=zero,interval=poll} iworldTimespec
83

84
tcplisten :: !Int !Bool !(sds () r w) (ConnectionHandlers l r w) -> Task [l] | iTask l & iTask r & iTask w & RWShared sds
Mart Lubbers's avatar
Mart Lubbers committed
85
tcplisten port removeClosed sds handlers = Task eval
86
where
Mart Lubbers's avatar
Mart Lubbers committed
87
	evalinit DestroyEvent _ iworld = (DestroyedResult, iworld)
Mart Lubbers's avatar
Mart Lubbers committed
88
	evalinit event evalOpts=:{TaskEvalOpts|taskId} iworld
Mart Lubbers's avatar
Mart Lubbers committed
89 90 91 92 93 94 95 96 97
		= case addListener taskId port removeClosed (wrapConnectionTask handlers sds) iworld of
			(Error e, iworld) = (ExceptionResult e, iworld)
			(Ok _, iworld) = eval event evalOpts iworld

	eval DestroyEvent {TaskEvalOpts|taskId} iworld=:{ioStates}
		# ioStates = case 'DM'.get taskId ioStates of
			Just (IOActive values)  = 'DM'.put taskId (IODestroyed values) ioStates
			_                       = ioStates
		= (DestroyedResult,{iworld & ioStates = ioStates})
Mart Lubbers's avatar
Mart Lubbers committed
98
	eval event evalOpts=:{TaskEvalOpts|taskId,lastEval} iworld=:{ioStates}
Mart Lubbers's avatar
Mart Lubbers committed
99 100 101 102
		= case 'DM'.get taskId ioStates of
			Just (IOException e) = (ExceptionResult (exception e), iworld)
			Just (IOActive values)
				# value = Value [l \\ (_,(l :: l^,_)) <- 'DM'.toList values] False
Mart Lubbers's avatar
Mart Lubbers committed
103 104
				= (ValueResult value (mkTaskEvalInfo lastEval) (mkUIIfReset event (rep port)) (Task eval), iworld)
			Nothing = (ValueResult (Value [] False) (mkTaskEvalInfo lastEval) (mkUIIfReset event (rep port)) (Task eval), iworld)
105

106
	rep port = stringDisplay ("Listening for connections on port "<+++ port)
107

108 109
tcpconnect :: !String !Int !(Maybe Timeout) !(sds () r w) (ConnectionHandlers l r w) -> Task l | iTask l & iTask r & iTask w & RWShared sds
tcpconnect host port timeout sds handlers = Task evalinit
110
where
Mart Lubbers's avatar
Mart Lubbers committed
111 112 113
	//We cannot make ioStates local since the engine uses it
	evalinit DestroyEvent _ iworld
		= (DestroyedResult, iworld)
Mart Lubbers's avatar
Mart Lubbers committed
114
	evalinit event eo=:{TaskEvalOpts|taskId} iworld
115
		= case addConnection taskId host port timeout (wrapConnectionTask handlers sds) iworld of
Mart Lubbers's avatar
Mart Lubbers committed
116 117 118 119
			(Error e,iworld) = (ExceptionResult e, iworld)
			(Ok _,iworld) = eval event eo iworld

	eval DestroyEvent evalOpts=:{TaskEvalOpts|taskId} iworld=:{ioStates}
120
		# ioStates = case 'DM'.get taskId ioStates of
Mart Lubbers's avatar
Mart Lubbers committed
121 122 123 124
			Just (IOActive values)  = 'DM'.put taskId (IODestroyed values) ioStates
			_                       = ioStates
		= (DestroyedResult, {iworld & ioStates = ioStates})

Mart Lubbers's avatar
Mart Lubbers committed
125
	eval event evalOpts=:{TaskEvalOpts|taskId,lastEval} iworld=:{ioStates}
Mart Lubbers's avatar
Mart Lubbers committed
126
		= case 'DM'.get taskId ioStates of
Mart Lubbers's avatar
Mart Lubbers committed
127
			Nothing = (ValueResult NoValue (mkTaskEvalInfo lastEval) (mkUIIfReset event rep) (Task eval), iworld)
Mart Lubbers's avatar
Mart Lubbers committed
128 129 130
			Just (IOActive values)
				= case 'DM'.get 0 values of
					Just (l :: l^, s)
Mart Lubbers's avatar
Mart Lubbers committed
131
						= (ValueResult (Value l s) (mkTaskEvalInfo lastEval) (mkUIIfReset event rep) (Task eval), iworld)
Mart Lubbers's avatar
Mart Lubbers committed
132 133 134 135
					_
						= (ExceptionResult (exception "Corrupt IO task result"),iworld)
			Just (IOException e)
				= (ExceptionResult (exception e),iworld)
136

137
	rep = stringDisplay ("TCP client " <+++ host <+++ ":" <+++ port)