RunOnClient.icl 5.92 KB
Newer Older
1
implementation module iTasks.Internal.Client.RunOnClient
2 3

import StdMisc
4
import iTasks
5 6 7
import iTasks.Internal.TaskStore
import iTasks.Internal.TaskEval
import iTasks.Internal.IWorld
8
import iTasks.UI.Definition
9
import qualified iTasks.Internal.SDS as SDS
10

11
from Data.Map import qualified newMap, toList, fromList, get
12
from Data.List import find
13
from Data.Queue as DQ import qualified newQueue, dequeue
14

15
import iTasks.Extensions.DateTime
Bas Lijnse's avatar
Bas Lijnse committed
16
import System.Time, Math.Random
17
import Text.GenJSON
18 19 20

:: TaskState a = 
			{ instanceNo :: !InstanceNo
21
			, sessionId  :: !String
22 23 24 25
			, taskId     :: !Maybe TaskId
			, task		 :: !Task a			
			, value		 :: !Maybe (TaskValue JSONNode)
			}
26 27

runOnClient :: !(Task m) -> Task m | iTask m
28 29
runOnClient task = task
/*
30 31
	# roc_tasklet =
		{ Tasklet 
32 33
		| genUI				= roc_generator task
		, resultFunc		= gen_res
34 35
		, tweakUI			= id
		}
36 37
 
	= mkTask roc_tasklet
38
*/
39 40 41
gen_res {TaskState|value=Nothing} = NoValue
gen_res {TaskState|value=Just NoValue} = NoValue
gen_res {TaskState|value=Just (Value json stability)} = Value (fromJust (fromJSON json)) stability
42

43
/*
44
roc_generator :: !(Task m) !TaskId (Maybe (TaskState m)) !*IWorld -> *(!TaskletGUI (TaskState m), !TaskState m, !*IWorld) | iTask m
45
roc_generator task (TaskId instanceNo _) _ iworld=:{current={sessionInstance=Just currentInstance}}
46
    # currentSession = "SESSIONID-" +++ toString currentInstance
47
	# gui = TaskletTUI {TaskletTUI|instanceNo = instanceNo, controllerFunc = controllerFunc}
48 49 50 51 52 53 54
	# state = 	{ TaskState
				| instanceNo = instanceNo
				, sessionId  = currentSession
				, taskId 	 = Nothing
				, task		 = task
				, value 	 = Nothing}
	= (gui, state, iworld)
55
*/
56
// Init
57
controllerFunc _ st=:{TaskState | sessionId, instanceNo, task, taskId = Nothing} Nothing Nothing Nothing iworld
Jurriën Stutterheim's avatar
Jurriën Stutterheim committed
58 59 60
	# (mbTaskId, iworld) = createClientTaskInstance task sessionId instanceNo iworld
    = case mbTaskId of
        Ok taskId
61
	      # (mbResult,iworld)  = evalTaskInstance instanceNo ResetEvent iworld
Jurriën Stutterheim's avatar
Jurriën Stutterheim committed
62
	      = case mbResult of
63
	      	Ok _ 
64
	      				= (Nothing, {TaskState | st & taskId = Just taskId}, iworld)
Jurriën Stutterheim's avatar
Jurriën Stutterheim committed
65 66
	      	_			= (Nothing, {TaskState | st & taskId = Just taskId}, iworld)
        _ = (Nothing, st, iworld)
67
/* FIXME
68
// Refresh
69
controllerFunc _ st=:{TaskState | sessionId, instanceNo, task, taskId = Just t} Nothing Nothing Nothing iworld
70
	# (mbResult,iworld)	= evalTaskInstance instanceNo (RefreshEvent "Client refresh") iworld
71
	= case mbResult of
72 73
		Ok (_,value)
					= (Nothing, {TaskState | st & value = Just value}, iworld)
74
		Error msg	= abort ("controllerFunc: " +++ msg)
75
// Focus
76
controllerFunc _ st=:{TaskState | sessionId, instanceNo, task, taskId = Just t} Nothing Nothing Nothing iworld
77
	# iworld = trace_n "c_focus" iworld
78
	# (mbResult,iworld)	= evalTaskInstance instanceNo (FocusEvent t) iworld
79
	= case mbResult of
80 81
		Ok (_,value)
					= (Nothing, {TaskState | st & value = Just value}, iworld)
82
		Error msg	= abort ("controllerFunc: " +++ msg)
83
*/
84
// Edit
85 86
controllerFunc taskId st=:{TaskState | sessionId, instanceNo} Nothing (Just name) (Just jsonval) iworld
	# (mbResult,iworld)	= evalTaskInstance instanceNo (EditEvent taskId name (fromString jsonval)) iworld
87
	= case mbResult of
88
		Ok value
89
					= (Nothing, {TaskState | st & value = Just value}, iworld)
90
		Error msg	= abort ("controllerFunc: " +++ msg)
91
// Action
92 93
controllerFunc taskId st=:{TaskState | sessionId, instanceNo} Nothing (Just name) Nothing iworld
	# (mbResult,iworld)	= evalTaskInstance instanceNo (ActionEvent taskId name) iworld
94
	= case mbResult of
95
		Ok value
96
					= (Nothing, {TaskState | st & value = Just value}, iworld)
97
		Error msg	= abort ("controllerFunc: " +++ msg)
98 99 100 101

newWorld :: *World
newWorld = undef

102
getUIUpdates :: !*IWorld -> (!Maybe [(InstanceNo, [String])], *IWorld)
103
getUIUpdates iworld
104 105 106
	= case 'SDS'.read taskOutput iworld of
		(Ok output,iworld)
			= case 'Data.Map'.toList output of
107
				[] = (Nothing,iworld)
108 109 110
				output
					# (_,iworld) = 'SDS'.write 'Data.Map'.newMap taskOutput iworld
					= (Just (map getUpdates output), iworld)
111 112
		(_,iworld)
			= (Nothing, iworld)
113
where
114
	getUpdates (instanceNo,upds) = (instanceNo, [toString (encodeUIChanges [c \\ TOUIChange c <- toList upds])])
115 116 117 118
	toList q = case 'DQ'.dequeue q of //TODO SHOULD BE IN Data.Queue
		(Nothing,q) 	= []
		(Just x,q) 		= [x:toList q]

119 120
createClientIWorld :: !String !InstanceNo -> *IWorld
createClientIWorld serverURL currentInstance
Bas Lijnse's avatar
Bas Lijnse committed
121
        # world = newWorld
122
        # (timestamp=:(Timestamp seed),world) = time world
123
		= {IWorld
124 125 126 127 128 129 130 131
		  |options =  { appName = "application"
	                    , appPath = locundef "appDirectory"
 	                    , appVersion = locundef "appVersion"
 	                    , serverPort = 80
                        , serverUrl = locundef "serverUrl"
	                    , keepaliveTime = locundef "keepaliveTime"
                        , sessionTime = locundef "sessionTime"
                        , persistTasks = False
Bas Lijnse's avatar
Bas Lijnse committed
132
						, autoLayout = True
133 134 135 136
	                    , webDirPath  = locundef "webDirectory"
	                    , storeDirPath = locundef "dataDirectory"
	                    , tempDirPath = locundef "tempDirectory"
	                    , saplDirPath = locundef "saplDirectory"}				
137
          ,clock = timestamp
138
          ,current =
139
            {taskTime			= 0
140 141 142 143 144
		    ,taskInstance	    = currentInstance
		    ,sessionInstance	= Just currentInstance
		    ,attachmentChain    = []
		    ,nextTaskNo			= 6666
          }
145
          ,sdsNotifyRequests    = []
146
          ,memoryShares         = 'Data.Map'.newMap
Bas Lijnse's avatar
Bas Lijnse committed
147 148
          ,readCache            = 'Data.Map'.newMap
          ,writeCache           = 'Data.Map'.newMap
149
		  ,exposedShares		= 'Data.Map'.newMap
150
		  ,jsCompilerState		= locundef "jsCompilerState"
151
		  ,shutdown				= Nothing
Bas Lijnse's avatar
Bas Lijnse committed
152
          ,random               = genRandInt seed
153 154
          ,ioTasks              = {done=[],todo=[]}
		  ,ioStates             = 'Data.Map'.newMap
Bas Lijnse's avatar
Bas Lijnse committed
155
		  ,world				= world
156
		  ,resources			= []
157
		  ,onClient				= True
158 159 160
		  }
where
	locundef var = abort ("IWorld structure is not avalaible at client side. Reference: "+++var)