We planned to upgrade GitLab and Mattermost to the latest version this Friday morning (early). You may experience some downtime!

Commit 112d4089 authored by Bas Lijnse's avatar Bas Lijnse

Simplified events

git-svn-id: https://svn.cs.ru.nl/repos/iTask-system/branches/itwc-experiments@2159 63da3aa8-80fd-4f01-9db8-e6ea747a3da2
parent bd55b755
......@@ -82,12 +82,14 @@ Ext.define('itwc.controller.Controller',{
onAction: function(taskId, actionId) {
console.log("Action event", taskId, actionId);
var me = this,
params = {commitEvent: Ext.encode([taskId,actionId])};
params = {actionEvent: Ext.encode([taskId,actionId])};
me.sendMessage(params); //TEMPORARILY DUMB WITHOUT QUEUE AND TRACKING
},
//iTasks focus events
onFocus: function(taskId) {
console.log("Focus event", taskId);
var me = this,
params = {focusEvent: Ext.encode(taskId)};
me.sendMessage(params);
},
//Send a message to the server
sendMessage: function(msg) {
......
This diff is collapsed.
This diff is collapsed.
......@@ -42,7 +42,7 @@ callProcess :: !FilePath ![String] -> Task Int
callProcess cmd args = Task eval
where
//Start the external process
eval eEvent cEvent refresh repAs (TCInit taskId ts) iworld=:{build,dataDirectory,sdkDirectory,world}
eval event repAs (TCInit taskId ts) iworld=:{build,dataDirectory,sdkDirectory,world}
# outfile = dataDirectory </> "tmp-" +++ build </> (toString taskId +++ "-callprocess")
# runAsync = sdkDirectory </> "Tools" </> "RunAsync" </> (IF_POSIX_OR_WINDOWS "RunAsync" "RunAsync.exe")
# runAsyncArgs = [ "--taskid"
......@@ -56,13 +56,13 @@ where
# nstate = case res of
Error e = state taskId ts (Left e)
Ok _ = state taskId ts (Right outfile)
= eval eEvent cEvent refresh repAs nstate {IWorld|iworld & world = world}
= eval event repAs nstate {IWorld|iworld & world = world}
where
state :: TaskId TaskTime (Either OSError FilePath) -> TaskTree
state taskId taskTime val = TCBasic taskId taskTime (toJSON val) False
//Check for its result
eval eEvent cEvent refresh repAs state=:(TCBasic taskId lastEvent encv stable) iworld=:{world}
eval event repAs state=:(TCBasic taskId lastEvent encv stable) iworld=:{world}
| stable
= (ValueResult (Value (fromJust (fromJSON encv)) Stable) lastEvent (TaskRep {UIDef|controls=[],actions=[],attributes='Map'.newMap} []) state, iworld)
| otherwise
......@@ -98,7 +98,7 @@ where
Nothing
= (exception (CallFailed (3,"callProcess: Unknown exception")), {IWorld|iworld & world = world})
//Clean up
eval eEvent cEvent refresh repAs (TCDestroy (TCBasic taskId lastEvent encv stable)) iworld
eval event repAs (TCDestroy (TCBasic taskId lastEvent encv stable)) iworld
//TODO: kill runasync for this task and clean up tmp files
= (DestroyedResult,iworld)
......
......@@ -89,8 +89,8 @@ viewTask
externalTaskInterface :: [PublishedTask]
externalTaskInterface
= [publish "/external/tasklist" WebApp viewTaskList
,publish "/external/task" WebApp viewTask
= [publish "/external/tasklist" WebApp (\_ -> viewTaskList)
,publish "/external/task" WebApp (\_ -> viewTask)
]
// MANAGEMENT TASKS
......
......@@ -21,6 +21,8 @@ URL_PREFIX :== ""
, defaultFormat :: ServiceFormat
}
:: TaskWrapper = E.a: TaskWrapper (HTTPRequest -> Task a) & iTask a
//* The format in which a task is presented.
:: ServiceFormat
= WebApp
......@@ -39,13 +41,14 @@ engine :: publish -> [(!String -> Bool,!HTTPRequest *IWorld -> (!HTTPResponse, !
/**
* Wraps a task together with a url to make it publishable by the engine
*/
publish :: String ServiceFormat (Task a) -> PublishedTask | iTask a
publish :: String ServiceFormat (HTTPRequest -> Task a) -> PublishedTask | iTask a
class Publishable a
where
publishAll :: !a -> [PublishedTask]
instance Publishable (Task a) | iTask a
instance Publishable (HTTPRequest -> Task a) | iTask a
instance Publishable [PublishedTask]
/**
......
......@@ -114,13 +114,17 @@ handleStopRequest req iworld = ({newHTTPResponse & rsp_headers = fromList [("X-S
path2name path = last (split "/" path)
publish :: String ServiceFormat (Task a) -> PublishedTask | iTask a
publish :: String ServiceFormat (HTTPRequest -> Task a) -> PublishedTask | iTask a
publish url format task = {url = url, task = TaskWrapper task, defaultFormat = format}
instance Publishable (Task a) | iTask a
where
publishAll task = [publish "/" WebApp task]
publishAll task = [publish "/" WebApp (\_ -> task)]
instance Publishable (HTTPRequest -> Task a) | iTask a
where
publishAll task = [publish "/" WebApp task]
instance Publishable [PublishedTask]
where
publishAll list = list
......
......@@ -22,14 +22,13 @@ derive gGetRecordFields Task
derive gPutRecordFields Task
// Tasks
:: Task a = Task !((Maybe EditEvent) (Maybe CommitEvent) RefreshFlag TaskRepOpts TaskTree *IWorld -> *(!TaskResult a, !*IWorld))
:: Task a = Task !(Event TaskRepOpts TaskTree *IWorld -> *(!TaskResult a, !*IWorld))
:: Event e = TaskEvent !TaskId !e //Event for a task within the process we are looking for
| LuckyEvent !InstanceNo !e //Event for any task who is willing to handle it (I am feeling lucky event)
:: EditEvent :== Event (!String,!JSONNode) //Datapath and new value
:: CommitEvent :== Event String //Action name
:: RefreshFlag :== Bool //Flag that indicates if events should not be applied
:: Event = EditEvent !TaskId !String !JSONNode //Update something in an interaction: Task id, edit name, value
| ActionEvent !TaskId !String //Progress in a step combinator: Task id, action id
| FocusEvent !TaskId //Update last event time without changing anything: Task id
| RefreshEvent //No event, just recalcalutate the entire task instance
:: TaskResult a = ValueResult !(TaskValue a) !TaskTime !TaskRep !TaskTree //If all goes well, a task computes its current value, an observable representation and a new task state
| ExceptionResult !Dynamic !String //If something went wrong, a task produces an exception value
......
......@@ -9,16 +9,16 @@ from iTasks import JSONEncode, JSONDecode, dynamicJSONEncode, dynamicJSONDeco
mkInstantTask :: (TaskId *IWorld -> (!TaskResult a,!*IWorld)) -> Task a | iTask a
mkInstantTask iworldfun = Task (evalOnce iworldfun)
where
evalOnce f _ _ _ repOpts (TCInit taskId ts) iworld = case f taskId iworld of
evalOnce f _ repOpts (TCInit taskId ts) iworld = case f taskId iworld of
(ValueResult (Value a Stable) _ _ _, iworld) = (ValueResult (Value a Stable) ts (finalizeRep repOpts rep) (TCStable taskId ts (DeferredJSON a)), iworld)
(ExceptionResult e s, iworld) = (ExceptionResult e s, iworld)
(_,iworld) = (exception "Instant task did not complete instantly", iworld)
evalOnce f _ _ _ repOpts state=:(TCStable taskId ts enc) iworld = case fromJSONOfDeferredJSON enc of
evalOnce f _ repOpts state=:(TCStable taskId ts enc) iworld = case fromJSONOfDeferredJSON enc of
Just a = (ValueResult (Value a Stable) ts (finalizeRep repOpts rep) state, iworld)
Nothing = (exception "Corrupt task result", iworld)
evalOnce f _ _ _ _ (TCDestroy _) iworld = (DestroyedResult,iworld)
evalOnce f _ _ (TCDestroy _) iworld = (DestroyedResult,iworld)
rep = TaskRep {UIDef|attributes= put TYPE_ATTRIBUTE "single" newMap,controls=[],actions=[]} []
......
......@@ -4,7 +4,7 @@ definition module TaskEval
*/
from SystemTypes import :: IWorld, :: TaskListItem, :: User, :: TaskId, :: SessionId
from Task import :: Task, :: TaskResult, :: Event, :: EditEvent, :: CommitEvent, :: RefreshFlag, :: TaskRepOpts
from Task import :: Task, :: TaskResult, :: Event, :: TaskRepOpts
from Shared import :: Shared
import Maybe, JSON_NG, Error
......@@ -31,25 +31,25 @@ createTaskInstance :: !InstanceNo !(Maybe SessionId) !InstanceNo !(Maybe User) !
* Create a new session task instance and evaluate its immediately
*
* @param The task to run as session
* @param An event
* @param The IWorld state
*
* @return The result of the targeted main task and the tasknr of the instance or an error
* @return The IWorld state
*/
createSessionInstance :: !(Task a) !(Maybe EditEvent) !(Maybe CommitEvent) !*IWorld -> (!MaybeErrorString (!TaskResult JSONNode, !InstanceNo, !SessionId), !*IWorld) | iTask a
createSessionInstance :: !(Task a) !Event !*IWorld -> (!MaybeErrorString (!TaskResult JSONNode, !InstanceNo, !SessionId), !*IWorld) | iTask a
/**
* Evaluate a session task instance
*
* @param The session id
* @param Optionally an edit event
* @param Optionally a commit event
* @param An event
* @param The IWorld state
*
* @return The result of the targeted main task or an error
* @return The IWorld state
*/
evalSessionInstance :: !SessionId !(Maybe EditEvent) !(Maybe CommitEvent) !*IWorld -> (!MaybeErrorString (!TaskResult JSONNode, !InstanceNo, !SessionId), !*IWorld)
evalSessionInstance :: !SessionId !Event !*IWorld -> (!MaybeErrorString (!TaskResult JSONNode, !InstanceNo, !SessionId), !*IWorld)
/**
* Create a stored task instance in the task pool (lazily without evaluating it)
......
......@@ -20,38 +20,38 @@ createTaskInstance instanceNo sessionId parent worker task mmeta pmeta iworld=:{
where
toJSONTask (Task eval) = Task eval`
where
eval` eEvent cEvent refresh repAs tree iworld = case eval eEvent cEvent refresh repAs tree iworld of
eval` event repOpts tree iworld = case eval event repOpts tree iworld of
(ValueResult val ts rep tree,iworld) = (ValueResult (fmap toJSON val) ts rep tree, iworld)
(ExceptionResult e str,iworld) = (ExceptionResult e str,iworld)
createSessionInstance :: !(Task a) !(Maybe EditEvent) !(Maybe CommitEvent) !*IWorld -> (!MaybeErrorString (!TaskResult JSONNode, !InstanceNo, !SessionId), !*IWorld) | iTask a
createSessionInstance task eEvent cEvent iworld=:{currentDateTime}
createSessionInstance :: !(Task a) !Event !*IWorld -> (!MaybeErrorString (!TaskResult JSONNode, !InstanceNo, !SessionId), !*IWorld) | iTask a
createSessionInstance task event iworld=:{currentDateTime}
# (sessionId,iworld) = newSessionId iworld
# (instanceId,iworld) = newInstanceId iworld
# worker = AnonymousUser sessionId
# ((meta,reduct,result,_), iworld)
= createTaskInstance instanceId (Just sessionId) 0 (Just worker) task noMeta {issuedAt=currentDateTime,issuedBy=worker,status=Unstable,firstEvent=Nothing,latestEvent=Nothing} iworld
# (mbRes,iworld) = evalAndStoreInstance eEvent cEvent False (meta,reduct,result) iworld
# (mbRes,iworld) = evalAndStoreInstance event (meta,reduct,result) iworld
# iworld = refreshOutdatedInstances iworld
= case loadSessionInstance sessionId iworld of
(Ok (meta,reduct,result),iworld)
# (mbRes,iworld) = evalAndStoreInstance eEvent cEvent False (meta,reduct,result) iworld
# (mbRes,iworld) = evalAndStoreInstance RefreshEvent (meta,reduct,result) iworld
= case mbRes of
Ok result = (Ok (result, instanceId, sessionId), iworld)
Error e = (Error e, iworld)
(Error e, iworld)
= (Error e, iworld)
evalSessionInstance :: !SessionId !(Maybe EditEvent) !(Maybe CommitEvent) !*IWorld -> (!MaybeErrorString (!TaskResult JSONNode, !InstanceNo, !SessionId), !*IWorld)
evalSessionInstance sessionId eEvent cEvent iworld
evalSessionInstance :: !SessionId !Event !*IWorld -> (!MaybeErrorString (!TaskResult JSONNode, !InstanceNo, !SessionId), !*IWorld)
evalSessionInstance sessionId event iworld
//Set session user
# iworld = {iworld & currentUser = AnonymousUser sessionId}
//Update current datetime in iworld
# iworld = updateCurrentDateTime iworld
//Evaluate the instance at which the targeted or refresh the session instance
# iworld = if (isJust eEvent || isJust cEvent)
(processEvent eEvent cEvent iworld)
(refreshSessionInstance sessionId iworld)
//Evaluate the instance at which the event is targeted or refresh the session instance
# iworld = case event of
RefreshEvent = refreshSessionInstance sessionId iworld
_ = processEvent event iworld
//Refresh affected tasks
# iworld = refreshOutdatedInstances iworld
//Evaluate session instance
......@@ -59,7 +59,7 @@ evalSessionInstance sessionId eEvent cEvent iworld
= case mbInstance of
Error e = (Error e, iworld)
Ok (meta,reduct,result)
# (mbRes,iworld) = evalAndStoreInstance eEvent cEvent True (meta,reduct,result) iworld
# (mbRes,iworld) = evalAndStoreInstance RefreshEvent (meta,reduct,result) iworld
# iworld = remOutdatedInstance meta.TIMeta.instanceNo iworld
= case mbRes of
Ok result = (Ok (result, meta.TIMeta.instanceNo, sessionId), iworld)
......@@ -70,23 +70,21 @@ where
# (dt,world) = currentDateTimeWorld world
= {IWorld|iworld & currentDateTime = dt, world = world}
processEvent :: !(Maybe EditEvent) !(Maybe CommitEvent) !*IWorld -> *IWorld
processEvent Nothing Nothing iworld
= iworld
processEvent eEvent cEvent iworld
= case loadTaskInstance (instanceNo eEvent cEvent) iworld of
processEvent :: !Event !*IWorld -> *IWorld
processEvent RefreshEvent iworld = iworld
processEvent event iworld
= case loadTaskInstance (instanceNo event) iworld of
(Error _,iworld) = iworld
(Ok (meta,reduct,result),iworld)
//Eval the targeted instance first
# (_,iworld) = evalAndStoreInstance eEvent cEvent False (meta,reduct,result) iworld
# (_,iworld) = evalAndStoreInstance event (meta,reduct,result) iworld
= iworld
where
instanceNo (Just (TaskEvent (TaskId no _) _)) _ = no
instanceNo _ (Just (TaskEvent (TaskId no _) _)) = no
instanceNo (Just (LuckyEvent no _)) _ = no
instanceNo _ (Just (LuckyEvent no _)) = no
instanceNo _ _ = 0 //Should not happen
instanceNo (EditEvent (TaskId no _) _ _) = no
instanceNo (ActionEvent (TaskId no _) _) = no
instanceNo (FocusEvent (TaskId no _)) = no
instanceNo _ = 0 //Should not happen...
createPersistentInstance :: !(Task a) !ManagementMeta !User !InstanceNo !*IWorld -> (!TaskId, !*IWorld) | iTask a
createPersistentInstance task meta issuer parent iworld=:{currentDateTime}
# (instanceId,iworld) = newInstanceId iworld
......@@ -95,10 +93,10 @@ createPersistentInstance task meta issuer parent iworld=:{currentDateTime}
= (TaskId instanceId 0, iworld)
//Evaluate a single task instance
evalAndStoreInstance :: !(Maybe EditEvent) !(Maybe CommitEvent) !RefreshFlag !(TIMeta,TIReduct,TIResult) !*IWorld -> (!MaybeErrorString (TaskResult JSONNode),!*IWorld)
evalAndStoreInstance _ _ _ inst=:(meta=:{TIMeta|worker=Nothing},_,_) iworld
evalAndStoreInstance :: !Event !(TIMeta,TIReduct,TIResult) !*IWorld -> (!MaybeErrorString (TaskResult JSONNode),!*IWorld)
evalAndStoreInstance _ inst=:(meta=:{TIMeta|worker=Nothing},_,_) iworld
= (Error "Can't evalutate a task instance with no worker set", iworld)
evalAndStoreInstance editEvent commitEvent refresh (meta=:{TIMeta|instanceNo,parent,worker=Just worker,progress},reduct=:{TIReduct|task=Task eval,nextTaskNo=curNextTaskNo,nextTaskTime,tree,shares,lists},result=:TIValue val _) iworld=:{currentUser,currentInstance,nextTaskNo,taskTime,localShares,localLists}
evalAndStoreInstance event (meta=:{TIMeta|instanceNo,parent,worker=Just worker,progress},reduct=:{TIReduct|task=Task eval,nextTaskNo=curNextTaskNo,nextTaskTime,tree,shares,lists},result=:TIValue val _) iworld=:{currentUser,currentInstance,nextTaskNo,taskTime,localShares,localLists}
//Eval instance
# repAs = {TaskRepOpts|useLayout=Nothing,modLayout=Nothing,appFinalLayout=True}
//Update current process id & eval stack in iworld
......@@ -108,7 +106,7 @@ evalAndStoreInstance editEvent commitEvent refresh (meta=:{TIMeta|instanceNo,par
# iworld = clearShareRegistrations instanceNo iworld
# iworld = remOutdatedInstance instanceNo iworld
//Apply task's eval function and take updated nextTaskId from iworld
# (result,iworld) = eval editEvent commitEvent refresh repAs tree iworld
# (result,iworld) = eval event repAs tree iworld
# (updNextTaskNo,iworld) = getNextTaskNo iworld
# (shares,iworld) = getLocalShares iworld
# (lists,iworld) = getLocalLists iworld
......@@ -146,9 +144,9 @@ where
taskrep (ValueResult _ _ rep _) = rep
taskrep (ExceptionResult _ _) = TaskRep {UIDef|controls=[],actions=[],attributes='Map'.newMap} []
evalAndStoreInstance _ _ _ (_,_,TIException e msg) iworld
evalAndStoreInstance _ (_,_,TIException e msg) iworld
= (Ok (ExceptionResult e msg), iworld)
evalAndStoreInstance _ _ _ _ iworld
evalAndStoreInstance _ _ iworld
= (Ok (exception "Could not unpack instance state"), iworld)
//Evaluate tasks marked as outdated in the task pool
......@@ -167,7 +165,7 @@ refreshInstance instanceNo iworld
= case loadTaskInstance instanceNo iworld of
(Error _,iworld) = iworld
(Ok (meta,reduct,result),iworld)
# (_,iworld) = evalAndStoreInstance Nothing Nothing False (meta,reduct,result) iworld
# (_,iworld) = evalAndStoreInstance RefreshEvent (meta,reduct,result) iworld
= iworld
refreshSessionInstance :: !SessionId !*IWorld -> *IWorld
......@@ -175,7 +173,7 @@ refreshSessionInstance sessionId iworld
= case loadSessionInstance sessionId iworld of
(Error _,iworld) = iworld
(Ok (meta,reduct,result),iworld)
# (_,iworld) = evalAndStoreInstance Nothing Nothing False (meta,reduct,result) iworld
# (_,iworld) = evalAndStoreInstance RefreshEvent (meta,reduct,result) iworld
= iworld
localShare :: !TaskId -> Shared a | iTask a
......
......@@ -2,7 +2,7 @@ implementation module TaskState
import SystemTypes, UIDefinition
from iTasks import JSONEncode, JSONDecode
from Task import :: Event, :: EditEvent, :: TaskTime, :: TaskResult(..), :: TaskRep(..), :: TaskServiceRep, :: TaskPart, :: TaskCompositionType
from Task import :: Event, :: TaskTime, :: TaskResult(..), :: TaskRep(..), :: TaskServiceRep, :: TaskPart, :: TaskCompositionType
from GenUpdate import :: UpdateMask
import JSON_NG
......
definition module UIDiff
import UIDefinition
from Task import :: EditEvent, :: Event
from Task import :: Event
:: UIUpdate
//Leaf updates
......@@ -19,6 +19,6 @@ from Task import :: EditEvent, :: Event
:: UIPath :== String
diffUIDefinitions :: ![UIControl] ![UIControl] !(Maybe EditEvent) -> [UIUpdate]
diffUIDefinitions :: ![UIControl] ![UIControl] !Event -> [UIUpdate]
encodeUIUpdates :: ![UIUpdate] -> JSONNode
\ No newline at end of file
......@@ -2,7 +2,7 @@ implementation module UIDiff
import StdBool, StdClass, StdList, StdEnum, StdMisc, StdTuple, sapldebug
import Text, Util, UIDefinition
from Task import :: EditEvent(..), :: Event(..)
from Task import :: Event(..)
:: DiffPath :== [DiffStep]
:: DiffStep = ItemStep !Int | MenuStep
......@@ -14,10 +14,10 @@ where
step (ItemStep i) = toString i
step (MenuStep) = "m"
diffUIDefinitions :: ![UIControl] ![UIControl] !(Maybe EditEvent) -> [UIUpdate]
diffUIDefinitions :: ![UIControl] ![UIControl] !Event -> [UIUpdate]
diffUIDefinitions old new event = [] //diffEditorDefinitions` [ItemStep 0] event old new
diffEditorDefinitions` :: !DiffPath !(Maybe EditEvent) !UIControl !UIControl -> [UIUpdate]
diffEditorDefinitions` :: !DiffPath !Event !UIControl !UIControl -> [UIUpdate]
//diffEditorDefinitions` path event (UIViewString osize oview) (UIViewString nsize nview) = []
//Fallback case, simply replace old by new
diffEditorDefinitions` [ItemStep parentIndex:parentPath] event old new = [UIReplace (toString parentPath) parentIndex new]
......
......@@ -8,4 +8,4 @@ from Engine import :: ServiceFormat
from IWorld import :: IWorld
import iTaskClass
webService :: !(Task a) !ServiceFormat !HTTPRequest !*IWorld -> (!HTTPResponse, !*IWorld) | iTask a
\ No newline at end of file
webService :: !(HTTPRequest -> Task a) !ServiceFormat !HTTPRequest !*IWorld -> (!HTTPResponse, !*IWorld) | iTask a
\ No newline at end of file
......@@ -15,7 +15,7 @@ import Engine, IWorld
derive JSONEncode ServiceResponsePart
webService :: !(Task a) !ServiceFormat !HTTPRequest !*IWorld -> (!HTTPResponse, !*IWorld) | iTask a
webService :: !(HTTPRequest -> Task a) !ServiceFormat !HTTPRequest !*IWorld -> (!HTTPResponse, !*IWorld) | iTask a
webService task defaultFormat req iworld=:{IWorld|timestamp,application}
= case format of
//Serve start page
......@@ -26,12 +26,12 @@ webService task defaultFormat req iworld=:{IWorld|timestamp,application}
//Load or create session context and edit / evaluate
# (mbResult, prevUI, iworld) = case sessionParam of
""
# (mbResult, iworld) = createSessionInstance task Nothing Nothing iworld
# (mbResult, iworld) = createSessionInstance (task req) RefreshEvent iworld
= (mbResult, [], iworld)
sessionId
//Check if there is a previous tui definition and check if it is still current
# (prevUI,iworld) = loadPrevUI sessionId guiVersion iworld
# (mbResult, iworld) = evalSessionInstance sessionId editEvent commitEvent iworld
# (mbResult, iworld) = evalSessionInstance sessionId event iworld
= (mbResult,prevUI,iworld)
# (json, iworld) = case mbResult of
Error err
......@@ -51,7 +51,7 @@ webService task defaultFormat req iworld=:{IWorld|timestamp,application}
(_, TaskRep {UIDef|controls} _)
= JSONObject [("success",JSONBool True)
,("session",JSONString sessionId)
,("updates", encodeUIUpdates (diffUIDefinitions prevUI (map fst controls) editEvent))
,("updates", encodeUIUpdates (diffUIDefinitions prevUI (map fst controls) event))
,("timestamp",toJSON timestamp)]
_
......@@ -67,9 +67,9 @@ webService task defaultFormat req iworld=:{IWorld|timestamp,application}
//Serve the task in easily accessable JSON representation
JSONService
# (mbResult,iworld) = case sessionParam of
"" = createSessionInstance task Nothing Nothing iworld
"" = createSessionInstance (task req) RefreshEvent iworld
sessionId
= evalSessionInstance sessionId Nothing Nothing iworld
= evalSessionInstance sessionId RefreshEvent iworld
= case mbResult of
Ok (ExceptionResult _ err,_,_)
= (errorResponse err, iworld)
......@@ -79,20 +79,12 @@ webService task defaultFormat req iworld=:{IWorld|timestamp,application}
= (jsonResponse (serviceBusyResponse rep actions (toList attributes)), iworld)
//Serve the task in a minimal JSON representation (only possible for non-parallel instantly completing tasks)
JSONPlain
//HACK: REALLY REALLY REALLY UGLY THAT IT IS NECCESARY TO EVAL TWICE
# (mbResult,iworld) = createSessionInstance task Nothing Nothing iworld
# (mbResult,iworld) = case mbResult of
(Ok (_,instanceId,sessionId))
# (luckyEdit,luckyCommit) = if (req.req_data == "")
(Nothing,Nothing)
(Just (LuckyEvent instanceId ("",fromString req.req_data)), Just (LuckyEvent instanceId ""))
= evalSessionInstance sessionId luckyEdit luckyCommit iworld
(Error e) = (Error e,iworld)
# (mbResult,iworld) = createSessionInstance (task req) RefreshEvent iworld
= case mbResult of
Ok (ExceptionResult _ err,_,_)
= (errorResponse err, iworld)
Ok (ValueResult (Value val Stable) _ _ _,_,_)
= (plainDoneResponse val, iworld)
Ok (ValueResult (Value val _) _ _ _,_,_)
= (jsonResponse val, iworld)
_
= (errorResponse "Requested service format not available for this task", iworld)
//Error unimplemented type
......@@ -108,20 +100,23 @@ where
formatParam = paramValue "format" req
sessionParam = paramValue "session" req
// downloadParam = paramValue "download" req
// uploadParam = paramValue "upload" req
versionParam = paramValue "version" req
editEventParam = paramValue "editEvent" req
editEvent = case (fromJSON (fromString editEventParam)) of
Just (task,path,value) = Just (TaskEvent (fromString task) (path,value))
_ = Nothing
commitEventParam = paramValue "commitEvent" req
commitEvent = case (fromJSON (fromString commitEventParam)) of
Just (task,action) = Just (TaskEvent (fromString task) action)
_ = Nothing
editEventParam = paramValue "editEvent" req
actionEventParam = paramValue "actionEvent" req
focusEventParam = paramValue "focusEvent" req
event = case (fromJSON (fromString editEventParam)) of
Just (taskId,name,value) = EditEvent (fromString taskId) name value
_ = case (fromJSON (fromString actionEventParam)) of
Just (taskId,actionId) = ActionEvent (fromString taskId) actionId
_ = case (fromJSON (fromString focusEventParam)) of
Just taskId = FocusEvent (fromString taskId)
_ = RefreshEvent
guiVersion = toInt versionParam
jsonResponse json
......@@ -141,8 +136,6 @@ where
serviceErrorResponse e
= JSONObject [("status",JSONString "error"),("error",JSONString e)]
plainDoneResponse val = jsonResponse val
appStartResponse appName = {newHTTPResponse & rsp_data = toString (appStartPage appName)}
appStartPage appName = HtmlTag [] [head,body]
......
......@@ -17,4 +17,3 @@ class iTask a
, TC a
:: Container a c = Container a & iTask c // container for context restrictions
:: TaskWrapper = E.a: TaskWrapper (Task a) & iTask a
\ No newline at end of file
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