Commit dd69ae62 authored by Bas Lijnse's avatar Bas Lijnse

Cleanup of expiry times

git-svn-id: https://svn.cs.ru.nl/repos/iTask-system/trunk@2379 63da3aa8-80fd-4f01-9db8-e6ea747a3da2
parent 1ffb398c
......@@ -220,14 +220,13 @@ where
(Nothing,iworld=:{localLists})
//Destruction is ok, build parallel result
# rep = parallelRep desc taskId repOpts entries
# expiry = parallelExpiry entries
# values = map (toValueAndTime o fst) entries
# stable = all (isStable o snd) values
# ts = foldr max 0 [ts:map fst values]
# ts = case event of
(FocusEvent focusId) = if (focusId == taskId) taskTime ts
_ = ts
= (ValueResult (Value values stable) {TaskInfo|lastEvent=ts,expiresIn=expiry} (finalizeRep repOpts rep) (TCParallel taskId ts),{iworld & localLists = 'Map'.put taskId (map fst entries) localLists})
= (ValueResult (Value values stable) {TaskInfo|lastEvent=ts} (finalizeRep repOpts rep) (TCParallel taskId ts),{iworld & localLists = 'Map'.put taskId (map fst entries) localLists})
//Cleanup
eval event repOpts (TCDestroy (TCParallel taskId ts)) iworld=:{localLists}
# entries = fromMaybe [] ('Map'.get taskId localLists)
......@@ -306,14 +305,6 @@ where
# parts = [(uiDefSetAttribute LAST_EVENT_ATTRIBUTE (toString lastEvent) (uiDefSetAttribute CREATED_AT_ATTRIBUTE (toString createdAt) (uiDefSetAttribute TASK_ATTRIBUTE (toString entryId) def)))
\\ ({TaskListEntry|entryId,state=EmbeddedState _ _,result=TIValue val _,createdAt,lastEvent,removed=False},Just (TaskRep def _)) <- entries | not (isStable val)]
= TaskRep (after (layout.Layout.parallel (toPrompt desc) parts)) []
parallelExpiry :: [(!TaskListEntry,!Maybe TaskRep)] -> Maybe Int
parallelExpiry entries = minimum [exp \\ ({TaskListEntry|expiresIn=Just exp},_) <- entries]
where
//If we have multiple tasks in parallel, the lowest expiry determines the expiry of the set
minimum [] = Nothing
minimum [e] = Just e
minimum [e:es] = let (Just mines) = minimum es in Just (if (e < mines) e mines)
isStable (Value _ stable) = stable
isStable _ = False
......@@ -337,14 +328,14 @@ appendTaskToList taskId=:(TaskId parent _) (parType,parTask) iworld=:{taskTime,c
# (taskIda=:TaskId instanceNo _,iworld) = createTopTaskInstance task management currentUser parent iworld
= (taskIda,DetachedState instanceNo progress management, iworld)
# result = TIValue NoValue taskTime
# entry = {entryId = taskIda, state = state, result = result, attributes = 'Map'.newMap, createdAt = taskTime, lastEvent = taskTime, expiresIn = Nothing, removed = False}
# entry = {entryId = taskIda, state = state, result = result, attributes = 'Map'.newMap, createdAt = taskTime, lastEvent = taskTime, removed = False}
# iworld = storeTaskList taskId (list ++ [entry]) iworld
= (taskIda, iworld)
updateListEntryEmbeddedResult :: !TaskId !TaskId (TaskResult a) !*IWorld -> (!TaskListEntry,!*IWorld) | iTask a
updateListEntryEmbeddedResult listId entryId result iworld
= updateListEntry listId entryId (\e=:{TaskListEntry|state,lastEvent} ->
{TaskListEntry|e & state = newTree state result, result = serialize result, attributes = newAttr result, lastEvent = maxTime lastEvent result, expiresIn = expiresIn result}) iworld
{TaskListEntry|e & state = newTree state result, result = serialize result, attributes = newAttr result, lastEvent = maxTime lastEvent result}) iworld
where
serialize (ValueResult val {TaskInfo|lastEvent} _ _) = TIValue (fmap toJSON val) lastEvent
serialize (ExceptionResult e str) = TIException e str
......@@ -358,9 +349,6 @@ where
maxTime cur (ValueResult _ {TaskInfo|lastEvent} _ _) = max cur lastEvent
maxTime cur _ = cur
expiresIn (ValueResult _ {TaskInfo|expiresIn} _ _) = expiresIn
expiresIn _ = Nothing
updateListEntryDetachedResult :: !TaskId !TaskId TIResult !ProgressMeta !ManagementMeta !TaskMeta !*IWorld -> (!TaskListEntry,!*IWorld)
updateListEntryDetachedResult listId entryId result progress management attributes iworld
= updateListEntry listId entryId update iworld
......@@ -474,18 +462,18 @@ where
# layout = repLayout repOpts
= case (meta,result,rep) of
(_,Ok (TIValue (Value _ True) _),_)
= (ValueResult (Value WOFinished True) {TaskInfo|lastEvent=ts,expiresIn=Nothing} (finalizeRep repOpts noRep) tree, iworld)
= (ValueResult (Value WOFinished True) {TaskInfo|lastEvent=ts} (finalizeRep repOpts noRep) tree, iworld)
(_,Ok (TIException _ _),_)
= (ValueResult (Value WOExcepted True) {TaskInfo|lastEvent=ts,expiresIn=Nothing} (finalizeRep repOpts noRep) tree, iworld)
= (ValueResult (Value WOExcepted True) {TaskInfo|lastEvent=ts} (finalizeRep repOpts noRep) tree, iworld)
(Ok meta=:{TIMeta|worker=Just worker},_,Ok (TaskRep def parts))
| worker == currentUser
# rep = finalizeRep repOpts (TaskRep (layout.Layout.workOn def meta) parts)
= (ValueResult (Value WOActive False) {TaskInfo|lastEvent=ts,expiresIn=Nothing} rep tree, iworld)
= (ValueResult (Value WOActive False) {TaskInfo|lastEvent=ts} rep tree, iworld)
| otherwise
# rep = finalizeRep repOpts (TaskRep (layout.Layout.workOn (inUseDef worker) meta) parts)
= (ValueResult (Value (WOInUse worker) False) {TaskInfo|lastEvent=ts,expiresIn=Nothing} rep tree, iworld)
= (ValueResult (Value (WOInUse worker) False) {TaskInfo|lastEvent=ts} rep tree, iworld)
_
= (ValueResult (Value WODeleted True) {TaskInfo|lastEvent=ts,expiresIn=Nothing} (finalizeRep repOpts noRep) tree, iworld)
= (ValueResult (Value WODeleted True) {TaskInfo|lastEvent=ts} (finalizeRep repOpts noRep) tree, iworld)
eval event repOpts (TCDestroy (TCBasic taskId _ _ _)) iworld=:{currentInstance}
= (DestroyedResult,iworld)
......
......@@ -9,11 +9,6 @@ from IWorld import :: IWorld(..)
from SystemData import topLevelTasks
from Map import qualified get
//Expiry time for tasks that use shared values
SHARE_EXPIRY :== 10000
return :: !a -> (Task a) | iTask a
return a = mkInstantTask (\taskId iworld-> (Ok a, iworld))
......@@ -60,7 +55,7 @@ where
eval event repOpts (TCInit taskId=:(TaskId instanceNo _) ts) iworld
# (val,iworld) = 'SharedDataSource'.readRegister instanceNo shared iworld
# res = case val of
Ok val = ValueResult (Value val False) {TaskInfo|lastEvent=ts,expiresIn=Just SHARE_EXPIRY} (finalizeRep repOpts (TaskRep (UIControlSequence {UIControlSequence|attributes=newMap,controls=[],direction=Vertical}) [])) (TCInit taskId ts)
Ok val = ValueResult (Value val False) {TaskInfo|lastEvent=ts} (finalizeRep repOpts (TaskRep (UIControlSequence {UIControlSequence|attributes=newMap,controls=[],direction=Vertical}) [])) (TCInit taskId ts)
Error e = exception (SharedException e)
= (res,iworld)
eval event repAs (TCDestroy _) iworld = (DestroyedResult,iworld)
......@@ -98,7 +93,7 @@ where
# validity = verifyMaskedValue nv nmask
# (rep,iworld) = visualizeView taskId repOpts nv validity desc iworld
# value = if (isValidMask validity) (Value nl False) NoValue
= (ValueResult value {TaskInfo|lastEvent=nts,expiresIn=Just SHARE_EXPIRY} (finalizeRep repOpts rep) (TCInteract2 taskId nts (toJSON nl) (toJSON nr) nmask), iworld)
= (ValueResult value {TaskInfo|lastEvent=nts} (finalizeRep repOpts rep) (TCInteract2 taskId nts (toJSON nl) (toJSON nr) nmask), iworld)
eval event repOpts (TCDestroy _) iworld = (DestroyedResult,iworld)
refresh_fun l nr nv nmask valid
......@@ -140,7 +135,7 @@ where
# validity = verifyMaskedValue nv nmask
# (rep,iworld) = visualizeView taskId repOpts nv validity desc iworld
# value = if (isValidMask validity) (Value nl False) NoValue
= (ValueResult value {TaskInfo|lastEvent=nts,expiresIn=Just SHARE_EXPIRY} (finalizeRep repOpts rep) (TCInteract2 taskId nts (toJSON nl) (toJSON nr) nmask), iworld)
= (ValueResult value {TaskInfo|lastEvent=nts} (finalizeRep repOpts rep) (TCInteract2 taskId nts (toJSON nl) (toJSON nr) nmask), iworld)
eval event repOpts (TCDestroy _) iworld = (DestroyedResult,iworld)
refresh_fun l nr nv nmask valid
......@@ -179,7 +174,7 @@ where
# validity = verifyMaskedValue nv nmask
# (rep,iworld) = visualizeView taskId repOpts nv validity desc iworld
# value = if (isValidMask validity) (Value nl False) NoValue
= (ValueResult value {TaskInfo|lastEvent=nts,expiresIn=Just SHARE_EXPIRY} (finalizeRep repOpts rep) (TCInteract2 taskId nts (toJSON nl) (toJSON nr) nmask), iworld)
= (ValueResult value {TaskInfo|lastEvent=nts} (finalizeRep repOpts rep) (TCInteract2 taskId nts (toJSON nl) (toJSON nr) nmask), iworld)
eval event repOpts (TCDestroy _) iworld = (DestroyedResult,iworld)
refresh_fun r
......@@ -207,7 +202,7 @@ where
# validity = verifyMaskedValue nv nmask
# (rep,iworld) = visualizeView taskId repOpts nv validity desc iworld
# value = if (isValidMask validity) (Value nl False) NoValue
= (ValueResult value {TaskInfo|lastEvent=nts,expiresIn=Nothing} (finalizeRep repOpts rep) (TCInteract1 taskId nts (toJSON nv) nmask), iworld)
= (ValueResult value {TaskInfo|lastEvent=nts} (finalizeRep repOpts rep) (TCInteract1 taskId nts (toJSON nv) nmask), iworld)
eval event repOpts (TCDestroy _) iworld = (DestroyedResult,iworld)
refresh_fun l v m ok
......@@ -237,7 +232,7 @@ where
# validity = verifyMaskedValue nv nmask
# (rep,iworld) = visualizeView taskId repOpts nv validity desc iworld
# value = if (isValidMask validity) (Value nl False) NoValue
= (ValueResult value {TaskInfo|lastEvent=nts,expiresIn=Nothing} (finalizeRep repOpts rep) (TCInteract1 taskId nts (toJSON nl) nmask), iworld)
= (ValueResult value {TaskInfo|lastEvent=nts} (finalizeRep repOpts rep) (TCInteract1 taskId nts (toJSON nl) nmask), iworld)
eval event repOpts (TCDestroy _) iworld = (DestroyedResult,iworld)
refresh_fun l v m ok
......@@ -266,7 +261,7 @@ where
# validity = verifyMaskedValue nv nmask
# (rep,iworld) = visualizeView taskId repOpts nv validity desc iworld
# value = if (isValidMask validity) (Value nl False) NoValue
= (ValueResult value {TaskInfo|lastEvent=nts,expiresIn=Nothing} (finalizeRep repOpts rep) (TCInteract1 taskId nts (toJSON nl) nmask), iworld)
= (ValueResult value {TaskInfo|lastEvent=nts} (finalizeRep repOpts rep) (TCInteract1 taskId nts (toJSON nl) nmask), iworld)
eval event repOpts (TCDestroy _) iworld = (DestroyedResult,iworld)
interact :: !d !(ReadOnlyShared r) (r -> (l,v,InteractionMask)) (l r v InteractionMask Bool -> (l,v,InteractionMask))
......@@ -298,7 +293,7 @@ where
# validity = verifyMaskedValue nv nmask
# (rep,iworld) = visualizeView taskId repOpts nv validity desc iworld
# value = if (isValidMask validity) (Value nl False) NoValue
= (ValueResult value {TaskInfo|lastEvent=nts,expiresIn=Just SHARE_EXPIRY} (finalizeRep repOpts rep) (TCInteract taskId nts (toJSON nl) (toJSON nr) (toJSON nv) nmask), iworld)
= (ValueResult value {TaskInfo|lastEvent=nts} (finalizeRep repOpts rep) (TCInteract taskId nts (toJSON nl) (toJSON nr) (toJSON nv) nmask), iworld)
eval event repOpts (TCDestroy _) iworld = (DestroyedResult,iworld)
......
......@@ -18,8 +18,6 @@ from Email import qualified sendEmail
from Email import :: Email(..), :: EmailOption(..)
from StdFunc import o
PROCESS_EXPIRY :== 1000
:: AsyncResult =
{ success :: !Bool
, exitcode :: !Int
......@@ -65,7 +63,7 @@ where
//Check for its result
eval event repOpts state=:(TCBasic taskId lastEvent encv stable) iworld=:{world}
| stable
= (ValueResult (Value (fromJust (fromJSON encv)) True) {TaskInfo|lastEvent=lastEvent,expiresIn=Just PROCESS_EXPIRY} (TaskRep (UIControlSequence {UIControlSequence|attributes='Map'.newMap,controls=[],direction=Vertical}) []) state, iworld)
= (ValueResult (Value (fromJust (fromJSON encv)) True) {TaskInfo|lastEvent=lastEvent} (TaskRep (UIControlSequence {UIControlSequence|attributes='Map'.newMap,controls=[],direction=Vertical}) []) state, iworld)
| otherwise
= case fromJSON encv of
Just (Right outfile)
......@@ -80,7 +78,7 @@ where
# prompt = toPrompt desc
# editor = {UIControlSequence| attributes = 'Map'.newMap, controls = controls, direction = Vertical}
# rep = TaskRep (UIControlSequence (layout.Layout.interact prompt editor)) []
= (ValueResult (Value status False) {TaskInfo|lastEvent=lastEvent,expiresIn=Just PROCESS_EXPIRY} rep state,iworld)
= (ValueResult (Value status False) {TaskInfo|lastEvent=lastEvent} rep state,iworld)
# (res, world) = 'File'.readFile outfile world
| isError res
//Failed to read file
......@@ -92,7 +90,7 @@ where
Just async
| async.AsyncResult.success
# result = CompletedProcess async.AsyncResult.exitcode
= (ValueResult (Value result True) {TaskInfo|lastEvent=lastEvent,expiresIn=Just PROCESS_EXPIRY} (TaskRep (UIControlSequence {UIControlSequence|attributes = 'Map'.newMap,controls = [],direction = Vertical}) []) (TCBasic taskId lastEvent (toJSON result) True), {IWorld|iworld & world = world})
= (ValueResult (Value result True) {TaskInfo|lastEvent=lastEvent} (TaskRep (UIControlSequence {UIControlSequence|attributes = 'Map'.newMap,controls = [],direction = Vertical}) []) (TCBasic taskId lastEvent (toJSON result) True), {IWorld|iworld & world = world})
| otherwise
= (exception (CallFailed (async.AsyncResult.exitcode,"callProcess: " +++ async.AsyncResult.message)), {IWorld|iworld & world = world})
//Error during initialization
......
......@@ -37,7 +37,6 @@ derive gPutRecordFields Task
:: TaskInfo =
{ lastEvent :: TaskTime //When was the last edit, action or focus event in this task
// , lastValueChange :: TaskTime //When was the last time this task's value changed
, expiresIn :: Maybe Int //Guideline for the maximum amount of time to wait before automatically refreshing (in milliseconds)
}
:: TaskRepOpts =
......
......@@ -10,11 +10,11 @@ mkInstantTask :: (TaskId *IWorld -> (!MaybeError (Dynamic,String) a,!*IWorld)) -
mkInstantTask iworldfun = Task (evalOnce iworldfun)
where
evalOnce f _ repOpts (TCInit taskId ts) iworld = case f taskId iworld of
(Ok a,iworld) = (ValueResult (Value a True) {lastEvent=ts,expiresIn=Nothing} (finalizeRep repOpts rep) (TCStable taskId ts (DeferredJSON a)), iworld)
(Ok a,iworld) = (ValueResult (Value a True) {lastEvent=ts} (finalizeRep repOpts rep) (TCStable taskId ts (DeferredJSON a)), iworld)
(Error (e,s), iworld) = (ExceptionResult e s, iworld)
evalOnce f _ repOpts state=:(TCStable taskId ts enc) iworld = case fromJSONOfDeferredJSON enc of
Just a = (ValueResult (Value a True) {lastEvent=ts,expiresIn=Nothing} (finalizeRep repOpts rep) state, iworld)
Just a = (ValueResult (Value a True) {lastEvent=ts} (finalizeRep repOpts rep) state, iworld)
Nothing = (exception "Corrupt task result", iworld)
evalOnce f _ _ (TCDestroy _) iworld = (DestroyedResult,iworld)
......
......@@ -65,7 +65,6 @@ derive JSONDecode DeferredJSON
, attributes :: !Map String String //Stored attributes of last evaluation
, createdAt :: !TaskTime //Time the entry was added to the set (used by layouts to highlight new items)
, lastEvent :: !TaskTime //Last modified time
, expiresIn :: !Maybe Int //Optional expiration advice (in ms)
, removed :: !Bool //Flag for marking this entry as 'removed', actual removal is done by the controlling parallel combinator
}
......
......@@ -21,13 +21,9 @@ derive JSONDecode UIControlSequence, UIActionSet, UIControlGroup, UIAbstractCont
derive JSONDecode UIMenuButtonOpts, UIButtonOpts, UIContainerOpts, UIPanelOpts, UIFieldSetOpts, UIWindowOpts, UIViewportOpts
derive JSONDecode UISize, UIMinSize, UIDirection, UIHAlign, UIVAlign, UISideSizes, UIMenuItem
//derive gDefault TIMeta//, TIReduct, TIResult, TaskListEntry, TaskTree//, TaskRep, DeferredJSON, InteractionMask
INCREMENT :== "increment"
PERSISTENT_INDEX :== "persistent-index"
SHARE_REGISTRATIONS :== "share-registrations"
meta_store t = toString t +++ "-meta"
reduct_store t = toString t +++ "-reduct"
result_store t = toString t +++ "-result"
rep_store t = toString t +++ "-rep"
......
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