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