Commit a62977a6 authored by Bas Lijnse's avatar Bas Lijnse

Added more precise information for notification of task administration shares

parent 5ab0e259
......@@ -201,8 +201,8 @@ where
= get currentUser @ userRoles
>>- \roles ->
forever
( enterChoiceWithSharedAs [ChooseFromGrid snd] (worklist roles) (appSnd (\{WorklistRow|parentTask} -> isNothing parentTask))
>>* (continuations roles taskList)
( enterChoiceWithSharedAs [ChooseFromGrid snd] (worklist roles) (appSnd (\{WorklistRow|parentTask} -> isNothing parentTask))
>>* continuations roles taskList
)
worklist roles = if (isMember "admin" roles) allWork myWork
......@@ -331,7 +331,7 @@ where
//the 'catalogId' that is stored in the incompatible task instance's properties
findReplacement taskId
= get ((sdsFocus taskId (taskListEntryMeta topLevelTasks)) |*| workflows)
@ \(taskListEntry,catalog) -> maybe Nothing (lookup catalog) ('DM'.get "catalogId" taskListEntry.TaskListItem.attributes)
@ \(taskListEntry,catalog) -> maybe Nothing (lookup catalog) ('DM'.get "catalogId" taskListEntry.TaskListItem.managementAttributes)
where
lookup [wf=:{Workflow|path}:wfs] (JSONString cid) = if (path == cid) (Just wf) (lookup wfs (JSONString cid))
lookup [] _ = Nothing
......@@ -344,8 +344,8 @@ appendOnce identity task slist
(appendTask Embedded (removeWhenStable (task <<@ ("name", JSONString name) <<@ ("order", JSONInt (maxOrder items + 1)))) slist @! ())
where
name = toString identity
maxOrder items = foldr max 0 [maybe 0 (\(JSONInt i) -> i) ('DM'.get "order" attributes) \\ {TaskListItem|attributes} <- items]
hasName name {TaskListItem|attributes} = maybe False ((==) (JSONString name)) ('DM'.get "name" attributes)
maxOrder items = foldr max 0 [maybe 0 (\(JSONInt i) -> i) ('DM'.get "order" taskAttributes) \\ {TaskListItem|taskAttributes} <- items]
hasName name {TaskListItem|taskAttributes} = maybe False ((==) (JSONString name)) ('DM'.get "name" taskAttributes)
checkItems name [] = False
checkItems name [i:is] = hasName name i || checkItems name is
......
......@@ -8,7 +8,7 @@ import Data.Map.GenJSON
import iTasks.UI.Definition, iTasks.UI.Editor, iTasks.UI.Editor.Controls, iTasks.UI.Editor.Modifiers
import iTasks.UI.Layout.Default
from iTasks.WF.Definition import :: TaskListItem(..)
from iTasks.WF.Definition import :: TaskListItem(..), fullTaskListFilter
import iTasks.Extensions.DateTime
import System.Time
......@@ -164,11 +164,11 @@ processesForCurrentUser = mapRead readPrj ((currentProcesses >*| currentUser))
where
readPrj (items,user) = filter (forWorker user) items
forWorker user {TaskListItem|attributes} = case 'DM'.get "user" attributes of
forWorker user {TaskListItem|managementAttributes} = case 'DM'.get "user" managementAttributes of
Just (JSONString uid1) = case user of
(AuthenticatedUser uid2 _ _) = uid1 == uid2
_ = False
Nothing = case 'DM'.get "role" attributes of
Nothing = case 'DM'.get "role" managementAttributes of
Just (JSONString role) = case user of
(AuthenticatedUser _ roles _) = isMember role roles
_ = False
......@@ -234,19 +234,18 @@ where
processControl tlist
= viewSharedInformation [ViewAs toView] (sdsFocus filter tlist) @? const NoValue
where
filter = {TaskListFilter|onlySelf=False,onlyTaskId = Nothing, notTaskId=Nothing, onlyIndex = Just [1],onlyAttribute=Nothing
,includeValue=False,includeAttributes=True,includeProgress=True}
filter = {TaskListFilter|fullTaskListFilter & onlyIndex =Just [1], includeProgress=True}
toView (_,[{TaskListItem|value,attributes}:_]) =
{ assignedTo = mkAssignedTo attributes
, firstWorkedOn = fmap (timestampToGmDateTime o timespecToStamp) (maybe Nothing fromJSON ('DM'.get "firstEvent" attributes))
, lastWorkedOn = fmap (timestampToGmDateTime o timespecToStamp) (maybe Nothing fromJSON ('DM'.get "lastEvent" attributes))
toView (_,[{TaskListItem|value,taskAttributes,managementAttributes}:_]) =
{ assignedTo = mkAssignedTo managementAttributes
, firstWorkedOn = fmap (timestampToGmDateTime o timespecToStamp) (maybe Nothing fromJSON ('DM'.get "firstEvent" taskAttributes))
, lastWorkedOn = fmap (timestampToGmDateTime o timespecToStamp) (maybe Nothing fromJSON ('DM'.get "lastEvent" taskAttributes))
, taskStatus = case value of
(Value _ True) -> "Task done"
_ -> "In progres..."
}
toView (_,[{TaskListItem|attributes}:_]) =
{ assignedTo = mkAssignedTo attributes
toView (_,[{TaskListItem|managementAttributes}:_]) =
{ assignedTo = mkAssignedTo managementAttributes
, firstWorkedOn = Nothing
, lastWorkedOn = Nothing
, taskStatus = "No progress"
......
......@@ -17,8 +17,8 @@ import Text
from Data.Map import newMap, member, del
derive gText TaskId, TaskListFilter, ExtendedTaskListFilter
derive JSONEncode TaskId, TaskListFilter, ExtendedTaskListFilter
derive gText TaskId, TaskListFilter
derive JSONEncode TaskId, TaskListFilter
derive gDefault TaskId, TaskListFilter
everyTick :: (*IWorld -> *(MaybeError TaskException (), *IWorld)) -> Task ()
......@@ -84,8 +84,8 @@ stopOnStable = everyTick \iworld->case read (sdsFocus selection taskListMetaData
= (Error (exception "Unexpeced SDS state"),iworld)
(Error e, iworld) = (Error e, iworld)
where
selection = (TaskId 0 0, TaskId 0 0,{TaskListFilter|defaultValue & includeAttributes=True,includeProgress=True}
,{ExtendedTaskListFilter|defaultValue & includeStartup=True})
selection = (TaskId 0 0, TaskId 0 0,{TaskListFilter|fullTaskListFilter & includeProgress=True}
,{ExtendedTaskListFilter|fullExtendedTaskListFilter & includeStartup=True, includeSessions=False, includeDetached=False})
isStable {TaskMeta|valuestatus} = valuestatus =: Stable
isSystem {TaskMeta|taskAttributes} = member "system" taskAttributes
......
......@@ -95,7 +95,7 @@ where
# (nextTaskNo,iworld) = getNextTaskNo iworld
# (mbErr,iworld) = if destroyed
(Ok (),iworld) //Only update progress when something changed
(case (modify (updateProgress clock newResult nextTaskNo nextTaskTime) (sdsFocus instanceNo taskInstance) EmptyContext iworld) of
(case (modify (updateProgress clock newResult nextTaskNo nextTaskTime) (sdsFocus (instanceNo,False,True,False) taskInstance) EmptyContext iworld) of
(Error e, iworld) = (Error e, iworld)
(Ok _, iworld) = (Ok (), iworld) )
| mbErr=:(Error _)
......@@ -140,13 +140,13 @@ where
= (Error description, iworld)
determineInstanceType instanceNo iworld
# (meta, iworld) = 'SDS'.read (sdsFocus instanceNo taskInstance) EmptyContext iworld
# (meta, iworld) = 'SDS'.read (sdsFocus (instanceNo,False,False,False) taskInstance) EmptyContext iworld
| isError meta = (SessionInstance,iworld)
# {TaskMeta|instanceType} = directResult (fromOk meta)
= (instanceType,iworld)
determineInstanceProgress instanceNo iworld
# (meta,iworld) = 'SDS'.read (sdsFocus instanceNo taskInstance) EmptyContext iworld
# (meta,iworld) = 'SDS'.read (sdsFocus (instanceNo,False,False,False) taskInstance) EmptyContext iworld
| isError meta = ({defaultValue & nextTaskNo=1, nextTaskTime=1},iworld)
= (directResult (fromOk meta),iworld)
......
......@@ -23,8 +23,6 @@ import iTasks.SDS.Definition
import iTasks.WF.Definition
import iTasks.WF.Derives
derive gText ExtendedTaskListFilter
derive JSONEncode ExtendedTaskListFilter
derive gDefault TaskId, TaskListFilter
//Helper type that holds the mainloop instances during a select call
//in these mainloop instances the unique listeners and read channels
......
......@@ -31,10 +31,11 @@ from System.FilePath import :: FilePath
//FIXME: Extensions should not be imported in core
from iTasks.Extensions.Document import :: Document, :: DocumentId
derive JSONEncode TaskMeta
derive JSONDecode TaskMeta
derive JSONEncode TaskMeta, ExtendedTaskListFilter
derive JSONDecode TaskMeta, ExtendedTaskListFilter
derive gDefault TaskMeta, ExtendedTaskListFilter
derive gText ExtendedTaskListFilter
//Persistent context of active tasks
//Split up version of task instance information
......@@ -100,10 +101,11 @@ derive gDefault TaskMeta, ExtendedTaskListFilter
, includeStartup :: !Bool
//Extra horizontal filtering options
, includeTaskReduct :: !Bool
, includeTaskIO :: !Bool
}
//Predefined filters
fullTaskList :: TaskListFilter
fullExtendedTaskListFilter :: ExtendedTaskListFilter
mergeTaskAttributes :: !(!TaskAttributes,!TaskAttributes) -> TaskAttributes
......@@ -133,15 +135,16 @@ taskInstanceParallelTaskList :: SDSLens (TaskId,TaskListFilter) (TaskId,[T
taskInstanceParallelTaskListValues :: SDSLens (TaskId,TaskListFilter) (Map TaskId (TaskValue a)) (Map TaskId (TaskValue a)) | iTask a
taskInstanceParallelTaskListTasks :: SDSLens (TaskId,TaskListFilter) (Map TaskId (Task a)) (Map TaskId (Task a)) | iTask a
taskInstanceParallelTaskListItem :: SDSLens (TaskId,TaskId) TaskMeta TaskMeta
taskInstanceParallelTaskListItem :: SDSLens (TaskId,TaskId,Bool) TaskMeta TaskMeta
taskInstanceParallelTaskListValue :: SDSLens (TaskId,TaskId) (TaskValue a) (TaskValue a) | iTask a
taskInstanceParallelTaskListTask :: SDSLens (TaskId,TaskId) (Task a) (Task a) | iTask a
//Interface used during the evalation of toplevel tasks
//Filtered views on the instance index
taskInstance :: SDSLens InstanceNo TaskMeta TaskMeta
taskInstance :: SDSLens (InstanceNo,Bool,Bool,Bool) TaskMeta TaskMeta
taskInstanceAttributes :: SDSLens InstanceNo (TaskAttributes,TaskAttributes) (TaskAttributes,TaskAttributes)
taskInstanceValue :: SDSLens InstanceNo (TaskValue DeferredJSON) (TaskValue DeferredJSON)
taskInstanceTask :: SDSLens InstanceNo (Task DeferredJSON) (Task DeferredJSON)
......
This diff is collapsed.
......@@ -15,6 +15,8 @@ import iTasks.Engine
import iTasks.Internal.Task, iTasks.Internal.TaskState, iTasks.Internal.TaskEval, iTasks.Internal.TaskIO
import iTasks.UI.Definition, iTasks.Internal.Util, iTasks.Internal.HtmlUtil, iTasks.Internal.IWorld
import iTasks.SDS.Combinators.Common
import iTasks.WF.Derives
import Crypto.Hash.SHA1, Text.Encodings.Base64, Text.Encodings.MIME
import Text.HTML
......@@ -432,15 +434,22 @@ where
(Just x,q) = [x:toList q]
verifyInstances :: [(InstanceNo,String)] *IWorld -> (![(InstanceNo,String)],![InstanceNo],![InstanceNo],!*IWorld)
verifyInstances instances iworld = foldl verify ([],[],[],iworld) instances
verifyInstances instances iworld
# tfilter = {TaskListFilter|fullTaskListFilter & onlyTaskId = Just [TaskId no 0 \\ (no,_) <- instances]}
# focus = (TaskId 0 0, TaskId 0 0,tfilter,fullExtendedTaskListFilter)
= case 'SDS'.read (sdsFocus focus taskListMetaData) 'SDS'.EmptyContext iworld of
(Ok (ReadingDone (_,metas)), iworld)
# metas = 'DM'.fromList [(no,m) \\ m=:{TaskMeta|taskId=TaskId no _} <- metas]
# (active,removed,revoked) = foldr (verify metas) ([],[],[]) instances
= (active,removed,revoked,iworld)
(_,iworld) = ([],map fst instances,[],iworld)
where
verify (active,removed,revoked,iworld) (instanceNo,viewportKey)
= case 'SDS'.read (sdsFocus instanceNo taskInstance) 'SDS'.EmptyContext iworld of
(Ok (ReadingDone {TaskMeta|instanceKey=Just key}),iworld)
= if (viewportKey == key)
([(instanceNo,viewportKey):active],removed,revoked,iworld)
(active,removed,[instanceNo:revoked],iworld)
(_,iworld) = (active,[instanceNo:removed],revoked,iworld)
verify metas (instanceNo,viewportKey) (active,removed,revoked) = case 'DM'.get instanceNo metas of
(Just {TaskMeta|instanceKey=Just key})
= if (viewportKey == key) ([(instanceNo,key):active],removed,revoked)
(active,removed,[instanceNo:revoked])
_
= (active,[instanceNo:removed],revoked)
eventsResponse messages
= {okResponse & rsp_headers = [("Content-Type","text/event-stream"),("Cache-Control","no-cache")]
......
......@@ -15,6 +15,7 @@ import Data.Maybe, Data.Error, Data.Either, StdString
import Text.GenJSON
import System.FilePath
import iTasks.Internal.SDS
import iTasks.Internal.TaskState
import iTasks.WF.Derives
sdsFocus :: !p !(sds p r w) -> (SDSLens p` r w) | gText{|*|} p & JSONEncode{|*|} p & TC p & TC r & TC w & RWShared sds
......@@ -161,23 +162,22 @@ where
taskListState :: !(SharedTaskList a) -> SDSLens () [TaskValue a] () | TC a
taskListState tasklist = mapRead (\(_,items) -> [value \\ {TaskListItem|value} <- items]) (toReadOnly (sdsFocus listFilter tasklist))
where
listFilter = {onlyIndex=Nothing,onlyTaskId=Nothing,notTaskId=Nothing,onlySelf=False,onlyAttribute=Nothing,includeValue=True,includeAttributes=False,includeProgress=False}
listFilter = {TaskListFilter|fullTaskListFilter & includeValue=True}
taskListMeta :: !(SharedTaskList a) -> SDSLens () [TaskListItem a] [(TaskId,TaskAttributes)] | TC a
taskListMeta tasklist = mapRead (\(_,items) -> items) (sdsFocus listFilter tasklist)
where
listFilter = {onlyIndex=Nothing,onlyTaskId=Nothing,notTaskId=Nothing,onlySelf=False,onlyAttribute=Nothing,includeValue=True,includeAttributes=True,includeProgress=True}
listFilter = {TaskListFilter|fullTaskListFilter & includeTaskAttributes=True,includeManagementAttributes=True,includeProgress=True}
taskListIds :: !(SharedTaskList a) -> SDSLens () [TaskId] () | TC a
taskListIds tasklist = mapRead prj (toReadOnly (sdsFocus listFilter tasklist))
taskListIds tasklist = mapRead prj (toReadOnly (sdsFocus fullTaskListFilter tasklist))
where
listFilter = {onlyIndex=Nothing,onlyTaskId=Nothing,notTaskId=Nothing,onlySelf=False,onlyAttribute=Nothing,includeValue=False,includeAttributes=False,includeProgress=False}
prj (_,items) = [taskId \\ {TaskListItem|taskId} <- items]
taskListEntryMeta :: !(SharedTaskList a) -> SDSLens TaskId (TaskListItem a) TaskAttributes | TC a
taskListEntryMeta tasklist = mapSingle (sdsSplit "taskListEntryMeta" param read write (Just reducer) tasklist)
where
param p = ({onlyIndex=Nothing,onlyTaskId=Just [p],notTaskId=Nothing,onlySelf=False,onlyAttribute=Nothing,includeValue=True,includeAttributes=True,includeProgress=True},p)
param p = ({fullTaskListFilter & onlyTaskId=Just [p],includeTaskAttributes=True,includeManagementAttributes=True,includeProgress=True},p)
read p (_,items) = [i \\ i=:{TaskListItem|taskId} <- items | taskId == p]
write p _ attributes = ([(p,a) \\ a <- attributes], const ((==) p))
reducer _ l = Ok (snd (unzip l))
......@@ -185,27 +185,27 @@ where
taskListSelfId :: !(SharedTaskList a) -> SDSLens () TaskId () | TC a
taskListSelfId tasklist = mapRead (\(_,items) -> hd [taskId \\ {TaskListItem|taskId,self} <- items | self]) (toReadOnly (sdsFocus listFilter tasklist))
where
listFilter = {onlyIndex=Nothing,onlyTaskId=Nothing,notTaskId=Nothing,onlySelf=True,onlyAttribute=Nothing,includeValue=False,includeAttributes=False,includeProgress=False}
listFilter = {TaskListFilter|fullTaskListFilter & onlySelf=True}
taskListSelfManagement :: !(SharedTaskList a) -> SimpleSDSLens TaskAttributes | TC a
taskListSelfManagement tasklist = mapReadWriteError (toPrj,fromPrj) (Just reducer) (sdsFocus listFilter tasklist)
where
toPrj (_,items) = case [m \\ m=:{TaskListItem|taskId,self} <- items | self] of
[] = Error (exception "Task id not found in self management share")
[{TaskListItem|attributes}:_] = Ok attributes
[{TaskListItem|managementAttributes}:_] = Ok managementAttributes
fromPrj attributes (_,[{TaskListItem|taskId}])
= Ok (Just [(taskId,attributes)])
listFilter = {onlyIndex=Nothing,onlyTaskId=Nothing,notTaskId=Nothing,onlySelf=True,onlyAttribute=Nothing,includeValue=False,includeAttributes=True,includeProgress=False}
listFilter = {TaskListFilter|fullTaskListFilter & onlySelf=True}
reducer _ [(_,attr)] = Ok attr
taskListItemValue :: !(SharedTaskList a) -> SDSLens (Either Int TaskId) (TaskValue a) () | TC a
taskListItemValue tasklist = mapReadError read (toReadOnly (sdsTranslate "taskListItemValue" listFilter tasklist))
where
listFilter (Left index) = {onlyIndex=Just [index],onlyTaskId=Nothing,notTaskId=Nothing,onlySelf=False,onlyAttribute=Nothing,includeValue=True,includeAttributes=False,includeProgress=False}
listFilter (Right taskId) = {onlyIndex=Nothing,onlyTaskId=Just [taskId],notTaskId=Nothing,onlySelf=False,onlyAttribute=Nothing,includeValue=True,includeAttributes=False,includeProgress=False}
listFilter (Left index) = {TaskListFilter| fullTaskListFilter & onlyIndex=Just [index],includeValue=True}
listFilter (Right taskId) = {TaskListFilter| fullTaskListFilter & onlyTaskId=Just [taskId],includeValue=True}
read (_,items) = case [value \\ {TaskListItem|value} <- items] of
vs=:[v:_] = (Ok v)
......
......@@ -23,8 +23,6 @@ from StdFunc import id, o, const
import qualified Data.Map as DM
derive gText ExtendedTaskListFilter
derive JSONEncode ExtendedTaskListFilter
derive gDefault TaskListFilter, TaskId
NS_SYSTEM_DATA :== "SystemData"
......@@ -101,7 +99,7 @@ allTaskInstances :: SDSSequence () [TaskInstance] ()
allTaskInstances= sdsSequence "allTaskInstances" param1 param2 read (SDSWriteConst write1) (SDSWriteConst write2) currentTaskInstanceNo taskListMetaData
where
param1 _ = ()
param2 _ selfNo = (TaskId 0 0,TaskId selfNo 0,fullTaskList,defaultValue)
param2 _ selfNo = (TaskId 0 0,TaskId selfNo 0, fullTaskListFilter,fullExtendedTaskListFilter)
read _ selfNo = Right $ \(_,(_,meta)) -> map taskInstanceFromMetaData meta
write1 _ _ = Ok Nothing
write2 _ _ = Ok Nothing
......@@ -110,9 +108,10 @@ detachedTaskInstances :: SDSSequence () [TaskInstance] ()
detachedTaskInstances = sdsSequence "detachedTaskInstances" param1 param2 read (SDSWriteConst write1) (SDSWriteConst write2) currentTaskInstanceNo taskListMetaData
where
param1 _ = ()
param2 _ selfNo = (TaskId 0 0,TaskId selfNo 0,fullTaskList,efilter)
param2 _ selfNo = (TaskId 0 0,TaskId selfNo 0,tfilter,efilter)
where
efilter = {ExtendedTaskListFilter|defaultValue & includeSessions = False, includeDetached = True, includeStartup = False}
tfilter = {TaskListFilter|fullTaskListFilter & includeProgress = True, includeManagementAttributes = True}
efilter = {ExtendedTaskListFilter|fullExtendedTaskListFilter & includeSessions = False, includeDetached = True, includeStartup = False}
read _ selfNo = Right $ \(_,(_,meta)) -> map taskInstanceFromMetaData meta
write1 _ _ = Ok Nothing
......
This diff is collapsed.
......@@ -89,7 +89,8 @@ instance toInstanceNo TaskId
, detached :: !Bool
, self :: !Bool
, value :: !TaskValue a
, attributes :: !TaskAttributes
, taskAttributes :: !TaskAttributes
, managementAttributes :: !TaskAttributes
}
:: TaskListFilter =
......@@ -99,12 +100,15 @@ instance toInstanceNo TaskId
, notTaskId :: !Maybe [TaskId]
, onlyAttribute :: !Maybe (!String,!JSONNode)
, onlySelf :: !Bool
//What to include
, includeValue :: !Bool
, includeAttributes :: !Bool
, includeProgress :: !Bool
//What to be notified for
, includeValue :: !Bool
, includeTaskAttributes :: !Bool
, includeManagementAttributes :: !Bool
, includeProgress :: !Bool
}
fullTaskListFilter :: TaskListFilter
//The iTask context restriction contains all generic functions that need to
//be available for a type to be used in tasks
class iTask a
......
......@@ -59,3 +59,8 @@ instance toInstanceNo TaskId where toInstanceNo (TaskId no _) = no
derive gDefault TaskListFilter, TaskId
fullTaskListFilter :: TaskListFilter
fullTaskListFilter =
{TaskListFilter|onlyIndex=Nothing,onlyTaskId=Nothing,notTaskId=Nothing,onlyAttribute=Nothing,onlySelf=False
,includeValue=False,includeTaskAttributes=False,includeManagementAttributes=False,includeProgress=False}
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