Core.icl 7.39 KB
Newer Older
1
implementation module iTasks.WF.Tasks.Core
2

Mart Lubbers's avatar
Mart Lubbers committed
3
import iTasks.SDS.Sources.Core
Mart Lubbers's avatar
Mart Lubbers committed
4
import iTasks.WF.Derives
5 6 7
import iTasks.WF.Definition
import iTasks.UI.Definition
import iTasks.SDS.Definition
8 9 10 11 12
import iTasks.Internal.Task
import iTasks.Internal.TaskState
import iTasks.Internal.TaskEval
import iTasks.Internal.IWorld
import qualified iTasks.Internal.SDS as SDS
13
import iTasks.Internal.AsyncSDS
14
import iTasks.Internal.Util
15

16
import Data.Error, Data.Maybe, Data.Func, Data.Either, Data.Tuple
17
import Text.GenJSON
18
import StdString, StdBool, StdInt, StdMisc, StdFunc
19
import qualified Data.Set as DS
20 21
import qualified Data.Map as DM

22 23 24 25
treturn :: !a -> (Task a) | iTask a
treturn a  = mkInstantTask (\taskId iworld-> (Ok a, iworld))

throw :: !e -> Task a | iTask a & iTask, toString e
Mart Lubbers's avatar
Mart Lubbers committed
26
throw e = mkInstantTask (\taskId iworld -> (Error (exception e), iworld))
27 28

appWorld :: !(*World -> *World) -> Task ()
29
appWorld fun = accWorld $ tuple () o fun
30

31
accWorld :: !(*World -> *(a, *World)) -> Task a | iTask a
32
accWorld fun = accWorldError (appFst Ok o fun) \_->""
33

34
accWorldError :: !(*World -> (MaybeError e a, *World)) !(e -> err) -> Task a | iTask a & TC, toString err
35 36
accWorldError fun errf = mkInstantTask eval
where
Mart Lubbers's avatar
Mart Lubbers committed
37
	eval taskId iworld=:{IWorld|world}
Mart Lubbers's avatar
Mart Lubbers committed
38
		# (res,world) = fun world
39
		= case res of
Mart Lubbers's avatar
Mart Lubbers committed
40 41
			Error e = (Error (exception (errf e)), {IWorld|iworld & world = world})
			Ok v    = (Ok v, {IWorld|iworld & world = world})
42

43
accWorldOSError :: !(*World -> (MaybeOSError a, *World)) -> Task a | iTask a
44 45
accWorldOSError fun = accWorldError fun OSException

46 47 48 49
instance toString OSException
where
	toString (OSException (_,err)) = "Error performing OS operation: " +++ err

50
interactRW :: !(sds () r w) (InteractionHandlers l r w v) (Editor v) -> Task (l,v)
51
	| iTask l & iTask r & iTask v & TC r & TC w & RWShared sds
52
interactRW shared handlers editor
Mart Lubbers's avatar
Mart Lubbers committed
53
	= Task (readRegisterCompletely shared NoValue (\event->mkUIIfReset event (asyncSDSLoaderUI Read)) (evalInteractInit shared handlers editor modifyCompletely))
54

55 56 57
interactR :: (sds () r w) (InteractionHandlers l r w v) (Editor v) -> Task (l,v)
	| iTask l & iTask r & iTask v & TC r & TC w & Registrable sds
interactR shared handlers editor
Mart Lubbers's avatar
Mart Lubbers committed
58
	= Task (readRegisterCompletely shared NoValue (\event->mkUIIfReset event (asyncSDSLoaderUI Read)) (evalInteractInit shared handlers editor \_ _->modifyCompletely (\()->undef) nullShare))
Mart Lubbers's avatar
Mart Lubbers committed
59

60
//This initializes the editor state and continues with the actual interact task
Mart Lubbers's avatar
Mart Lubbers committed
61
evalInteractInit sds handlers editor writefun r event evalOpts=:{TaskEvalOpts|taskId} iworld
Mart Lubbers's avatar
Mart Lubbers committed
62
	//Get initial value
63 64 65 66 67 68 69
	# (l, mode) = handlers.onInit r
	# v = case mode of
		Enter    = Nothing
		Update x = Just x
		View x   = Just x
	= case initEditorState taskId mode editor iworld of
		(Ok st, iworld)
70
			= evalInteract l v st (mode=:View _) sds handlers editor writefun event evalOpts iworld
Mart Lubbers's avatar
Mart Lubbers committed
71
		(Error e, iworld) = (ExceptionResult e, iworld)
72

Mart Lubbers's avatar
Mart Lubbers committed
73 74 75 76 77 78 79
initEditorState :: TaskId (EditMode v) (Editor v) !*IWorld -> (MaybeError TaskException EditState, !*IWorld)
initEditorState taskId mode editor iworld = withVSt taskId
	( \vst -> case editor.Editor.genUI 'DM'.newMap [] (uniqueMode mode) vst of
		(Ok (_, st), vst) = (Ok st,               vst)
		(Error e,    vst) = (Error $ exception e, vst)
	) iworld

Mart Lubbers's avatar
Mart Lubbers committed
80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101
evalInteract ::
	l
	(Maybe v)
	EditState
	Bool
	(sds () r w)
	(InteractionHandlers l r w v)
	(Editor v)
	(
		(r -> w)
		(sds () r w)
		(TaskValue (l,v))
		(Event -> UIChange)
		(w -> Event -> TaskEvalOpts -> *IWorld -> *(TaskResult (l,v),*IWorld))
		Event
		TaskEvalOpts
		*IWorld
		-> *(TaskResult (l,v),*IWorld))
	Event
	TaskEvalOpts
	*IWorld
	-> *(TaskResult (l,v),*IWorld)
102 103
	| iTask l & iTask r & iTask v & TC r & TC w & Registrable sds
evalInteract _ _ _ _ _ _ _ _ DestroyEvent {TaskEvalOpts|taskId} iworld
Mart Lubbers's avatar
Mart Lubbers committed
104
	= (DestroyedResult, 'SDS'.clearTaskSDSRegistrations ('DS'.singleton taskId) iworld)
Mart Lubbers's avatar
Mart Lubbers committed
105
evalInteract l v st mode sds handlers editor writefun event=:(EditEvent eTaskId name edit) evalOpts=:{taskId,lastEval} iworld
Mart Lubbers's avatar
Mart Lubbers committed
106 107 108 109 110 111
	| eTaskId == taskId
		# (res, iworld) = withVSt taskId (editor.Editor.onEdit [] (s2dp name,edit) st) iworld
		= case res of
			Ok (change, st)
				= case editor.Editor.valueFromState st of
					Just nv
112
						# (l, mbf) = handlers.InteractionHandlers.onEdit nv l
Mart Lubbers's avatar
Mart Lubbers committed
113 114 115
						= case mbf of
							//We have an update function
							Just f = writefun f sds NoValue (\_->change)
116 117 118
								// We cannot just do this because this will loop endlessly:
								// (\_->evalInteract l (Just v) st mode sds handlers editor writefun)
								// Therefore we delay it by returning the continuation in a value instead of directly:
Mart Lubbers's avatar
Mart Lubbers committed
119
								(\w event {TaskEvalOpts|lastEval} iworld->
Mart Lubbers's avatar
Mart Lubbers committed
120
									(ValueResult
121
										(Value (l, nv) False)
Mart Lubbers's avatar
Mart Lubbers committed
122
										(mkTaskEvalInfo lastEval)
Mart Lubbers's avatar
Mart Lubbers committed
123
										change
124
										(Task (evalInteract l (Just nv) st mode sds handlers editor writefun))
Mart Lubbers's avatar
Mart Lubbers committed
125 126 127 128 129
									, iworld))
								event evalOpts iworld
							//There is no update function
							Nothing
								= (ValueResult
130
									(Value (l, nv) False)
Mart Lubbers's avatar
Mart Lubbers committed
131
									(mkTaskEvalInfo lastEval)
Mart Lubbers's avatar
Mart Lubbers committed
132
									change
133
									(Task (evalInteract l (Just nv) st mode sds handlers editor writefun))
Mart Lubbers's avatar
Mart Lubbers committed
134 135 136 137
								, iworld)
					Nothing
						= (ValueResult
							(maybe NoValue (\v->Value (l, v) False) v)
Mart Lubbers's avatar
Mart Lubbers committed
138
							(mkTaskEvalInfo lastEval)
Mart Lubbers's avatar
Mart Lubbers committed
139
							change
140
							(Task (evalInteract l v st mode sds handlers editor writefun))
Mart Lubbers's avatar
Mart Lubbers committed
141 142
						, iworld)
			Error e = (ExceptionResult (exception e), iworld)
Mart Lubbers's avatar
Mart Lubbers committed
143
evalInteract l v st mode sds handlers editor writefun ResetEvent evalOpts=:{taskId,lastEval} iworld
Mart Lubbers's avatar
Mart Lubbers committed
144 145
	# resetMode = case (mode, v) of
		(True, Just v) = View v
146
		(True, _)      = abort "view mode without value\n"
Mart Lubbers's avatar
Mart Lubbers committed
147 148 149 150
		(_, Nothing)   = Enter
		(_, Just v)    = Update v
	= case withVSt taskId (editor.Editor.genUI 'DM'.newMap [] resetMode) iworld of
		(Error e, iworld) = (ExceptionResult (exception e), iworld)
151 152
		(Ok (UI type attr items, st), iworld)
			# change = ReplaceUI (UI type (addClassAttr "interact" attr) items)
Mart Lubbers's avatar
Mart Lubbers committed
153 154
			# mbv = editor.Editor.valueFromState st
			# v = maybe v Just mbv
Mart Lubbers's avatar
Mart Lubbers committed
155
			= (ValueResult
Mart Lubbers's avatar
Mart Lubbers committed
156
				(maybe NoValue (\v->Value (l, v) False) v)
Mart Lubbers's avatar
Mart Lubbers committed
157
				(mkTaskEvalInfo lastEval)
158 159
				change
				(Task (evalInteract l v st mode sds handlers editor writefun))
Mart Lubbers's avatar
Mart Lubbers committed
160
			, iworld)
Mart Lubbers's avatar
Mart Lubbers committed
161
evalInteract l v st mode sds handlers editor writefun event=:(RefreshEvent taskIds _) evalOpts=:{taskId,lastEval} iworld
Mart Lubbers's avatar
Mart Lubbers committed
162
	| 'DS'.member taskId taskIds
Mart Lubbers's avatar
Mart Lubbers committed
163
		= readRegisterCompletely sds (maybe NoValue (\v->Value (l, v) False) v) (\e->mkUIIfReset e (asyncSDSLoaderUI Read))
Mart Lubbers's avatar
Mart Lubbers committed
164 165 166 167
			(\r event evalOpts iworld
				# (l, v, mbf) = handlers.InteractionHandlers.onRefresh r l v
				= case withVSt taskId (editor.Editor.onRefresh [] v st) iworld of
					(Error e, iworld) = (ExceptionResult (exception e), iworld)
168 169
					(Ok (change, st), iworld)
						# v = editor.Editor.valueFromState st
Mart Lubbers's avatar
Mart Lubbers committed
170 171
						= case mbf of
							Just f = writefun f sds NoValue (\_->change)
172
								(\_->evalInteract l v st mode sds handlers editor writefun)
Mart Lubbers's avatar
Mart Lubbers committed
173 174 175
								event evalOpts iworld
							Nothing
								= (ValueResult
176
									(maybe NoValue (\v -> Value (l, v) False) v)
Mart Lubbers's avatar
Mart Lubbers committed
177
									(mkTaskEvalInfo lastEval)
Mart Lubbers's avatar
Mart Lubbers committed
178
									change
179
									(Task (evalInteract l v st mode sds handlers editor writefun))
Mart Lubbers's avatar
Mart Lubbers committed
180 181 182
								, iworld)
			)
			event evalOpts iworld
Mart Lubbers's avatar
Mart Lubbers committed
183
evalInteract l v st mode sds handlers editor writefun event {lastEval} iworld
Mart Lubbers's avatar
Mart Lubbers committed
184
	//An event for a sibling?
Mart Lubbers's avatar
Mart Lubbers committed
185 186
	= (ValueResult
		(maybe NoValue (\v->Value (l, v) False) v)
Mart Lubbers's avatar
Mart Lubbers committed
187
		(mkTaskEvalInfo lastEval)
Mart Lubbers's avatar
Mart Lubbers committed
188
		NoChange
189
		(Task (evalInteract l v st mode sds handlers editor writefun))
Mart Lubbers's avatar
Mart Lubbers committed
190
	, iworld)
Mart Lubbers's avatar
Mart Lubbers committed
191

192
uniqueMode :: (EditMode a) -> *(EditMode a)
193 194 195
uniqueMode mode = case mode of
	Enter    = Enter
	Update x = Update x
196
	View x   = View x