Commit 13ed3303 authored by Camil Staps's avatar Camil Staps 🙂

Merge branch '342-tuning-task-attributes' into 'master'

Resolve "Tuning task attributes"

Closes #311, #313, and #342

See merge request !324
parents 1874319e 0a8c4152
Pipeline #35774 passed with stage
in 6 minutes and 55 seconds
......@@ -54,33 +54,33 @@ actionStatusByNo :: SDSLens InstanceNo ActionStatus ActionStatus
actionStatusByNo = sdsProject (SDSLensRead read) (SDSLensWrite write) Nothing taskInstanceByNo
where
read item = Ok (thd3 (toActionStatus item))
write {TaskInstance|attributes} status = Ok (Just (fromActionStatus status attributes))
write {TaskInstance|managementAttributes} status = Ok (Just (fromActionStatus status managementAttributes))
numActionsByContact :: SDSLens ContactNo Int ()
numActionsByContact = mapRead length actionStatusesByContact
toActionStatuses :: [TaskInstance] -> [(InstanceNo,InstanceNo,ActionStatus)]
toActionStatuses items = (map toActionStatus items)
toActionStatuses items = map toActionStatus items
toActionStatusesTL :: [TaskListItem a] -> [(InstanceNo,InstanceNo,ActionStatus)]
toActionStatusesTL items = [toActionStatusTL i \\ i=:{TaskListItem|progress=Just _} <- items]
toActionStatusesTL items = map toActionStatusTL items
toActionStatus :: TaskInstance -> (InstanceNo,InstanceNo,ActionStatus)
toActionStatus {TaskInstance|instanceNo=tNo,listId=(TaskId lNo _),attributes}
# title = maybe "-" (\(JSONString s) -> s) ('DM'.get "title" attributes)
# description = fmap (\(JSONString s) -> s) ('DM'.get "description" attributes)
# progress = fromMaybe ActionActive (maybe Nothing fromJSON ('DM'.get "action-progress" attributes))
# incidents = fromMaybe [] (maybe Nothing fromJSON ('DM'.get "action-incidents" attributes))
# contacts = fromMaybe [] (maybe Nothing fromJSON ('DM'.get "action-contacts" attributes))
toActionStatus {TaskInstance|instanceNo=tNo,listId=(TaskId lNo _),managementAttributes}
# title = maybe "-" (\(JSONString s) -> s) ('DM'.get "title" managementAttributes)
# description = fmap (\(JSONString s) -> s) ('DM'.get "description" managementAttributes)
# progress = fromMaybe ActionActive (maybe Nothing fromJSON ('DM'.get "action-progress" managementAttributes))
# incidents = fromMaybe [] (maybe Nothing fromJSON ('DM'.get "action-incidents" managementAttributes))
# contacts = fromMaybe [] (maybe Nothing fromJSON ('DM'.get "action-contacts" managementAttributes))
= (tNo,lNo,{ActionStatus|title=title,description=description,progress=progress,incidents=incidents,contacts=contacts})
toActionStatusTL :: (TaskListItem a) -> (InstanceNo,InstanceNo,ActionStatus)
toActionStatusTL {TaskListItem|taskId=(TaskId tNo _),listId=(TaskId lNo _),attributes}
# title = maybe "-" (\(JSONString s) -> s) ('DM'.get "title" attributes)
# description = fmap (\(JSONString s) -> s) ('DM'.get "description" attributes)
# progress = fromMaybe ActionActive (maybe Nothing fromJSON ('DM'.get "action-progress" attributes))
# incidents = fromMaybe [] (maybe Nothing fromJSON ('DM'.get "action-incidents" attributes))
# contacts = fromMaybe [] (maybe Nothing fromJSON ('DM'.get "action-contacts" attributes))
toActionStatusTL {TaskListItem|taskId=(TaskId tNo _),listId=(TaskId lNo _),managementAttributes}
# title = maybe "-" (\(JSONString s) -> s) ('DM'.get "title" managementAttributes)
# description = fmap (\(JSONString s) -> s) ('DM'.get "description" managementAttributes)
# progress = fromMaybe ActionActive (maybe Nothing fromJSON ('DM'.get "action-progress" managementAttributes))
# incidents = fromMaybe [] (maybe Nothing fromJSON ('DM'.get "action-incidents" managementAttributes))
# contacts = fromMaybe [] (maybe Nothing fromJSON ('DM'.get "action-contacts" managementAttributes))
= (tNo,lNo,{ActionStatus|title=title,description=description,progress=progress,incidents=incidents,contacts=contacts})
fromActionStatus :: ActionStatus TaskAttributes -> TaskAttributes
......@@ -99,14 +99,13 @@ toSelfActionStatus (_,items) = case [i \\ i=:{TaskListItem|taskId,self} <- items
fromSelfActionStatus :: ActionStatus (TaskList a) -> MaybeError TaskException (Maybe [(TaskId,TaskAttributes)])
fromSelfActionStatus status (_,items) = case [i \\ i=:{TaskListItem|taskId,self} <- items | self] of
[{TaskListItem|taskId,attributes}:_] = Ok (Just [(taskId,fromActionStatus status attributes)])
_ = Error (exception "Task id not found in self management share")
[{TaskListItem|taskId,managementAttributes}:_] = Ok (Just [(taskId,fromActionStatus status managementAttributes)])
_ = Error (exception "Task id not found in self management share")
selfActionStatus :: (SharedTaskList a) -> SimpleSDSLens ActionStatus | iTask a
selfActionStatus list = sdsFocus taskListFilter (mapReadWriteError (toSelfActionStatus,fromSelfActionStatus) Nothing list)
where
taskListFilter = {TaskListFilter|onlyIndex=Nothing,onlyTaskId=Nothing,onlySelf=False
,includeValue=False,includeAttributes=True,includeProgress=False}
taskListFilter = {TaskListFilter|fullTaskListFilter & includeManagementAttributes=True}
actionItemStatistics :: [ActionStatus] -> ActionStatistics
actionItemStatistics items = foldr count {numPlanned=0,numActive=0,numCompleted=0,numFailed=0,numCanceled=0} items
......@@ -349,14 +348,14 @@ listItemTask (title,plan) status
@! ()
where
items initActions initContacts initIncidents
= [(Detached (initAttributes identity (initStatus meta)) True, configureDelayed configer task)
= [(Detached True 'DM'.newMap, configureDelayed (initAttributes identity (initStatus meta)) configer task )
\\ item=:{CatalogAction|identity,meta,tasks=ActionTasks configer task} <- initActions]
where
configureDelayed configer task list
configureDelayed attr configer task list
= configer initContacts initIncidents
>>= \(config,status) ->
set status (selfActionStatus list)
>>| task config (selfActionStatus list)
>>| task config (selfActionStatus list) <<@ attr
initStatus {ItemMeta|title,description}
= {ActionStatus|title=title,description=description,progress=ActionActive,contacts=initContacts,incidents=initIncidents}
......@@ -592,7 +591,7 @@ where
//Look in action the catalog for an entry that has the identity
findReplacement taskId
= get (sdsFocus taskId (taskListEntryMeta topLevelTasks) |*| actionCatalog)
@ \(taskListEntry,catalog) -> maybe Nothing (lookup catalog) ('DM'.get "actionitem-identity" taskListEntry.TaskListItem.attributes)
@ \(taskListEntry,catalog) -> maybe Nothing (lookup catalog) ('DM'.get "actionitem-identity" taskListEntry.TaskListItem.managementAttributes)
where
lookup [] match = Nothing
lookup [{CatalogAction|identity,tasks}:cfs] match = if ((JSONString identity) == match) (Just tasks) (lookup cfs match)
......@@ -746,7 +745,7 @@ where
addAction :: String ActionStatus (SharedTaskList a) ((SimpleSDSLens ActionStatus) -> Task ()) -> Task TaskId | iTask a
addAction identity initStatus list task
= logActionAdded initStatus
>>| appendTask (Detached attributes True) (\l -> (task (selfActionStatus l) @? const NoValue)) list
>>| appendTask (Detached True attributes) (\l -> (task (selfActionStatus l)) @? const NoValue) list
where
attributes = initAttributes identity initStatus
......@@ -755,7 +754,7 @@ addSubActionItem :: [ContactNo] [IncidentNo] CatalogAction (SharedTaskList a) ->
addSubActionItem initContacts initIncidents item=:{CatalogAction|identity,tasks=ActionTasks configer task} list
= (configer initContacts initIncidents
>>? \(config,initStatus) ->
appendTask (Detached (initAttributes identity initStatus) True) (\list -> task config (selfActionStatus list) @? const NoValue) list
appendTask (Detached True (initAttributes identity initStatus)) (\list -> (task config (selfActionStatus list)) @? const NoValue) list
) <<@ InWindow
addTopActionItem :: [ContactNo] [IncidentNo] -> Task (Maybe TaskId)
......
......@@ -199,13 +199,13 @@ where
taskPid = mapRead find (sdsFocus ("name",JSONString identity) taskInstancesByAttribute)
where
find instances = case [(instanceNo,value) \\ {TaskInstance|instanceNo,value,attributes} <- instances | hasName identity attributes] of
find instances = case [(instanceNo,value) \\ {TaskInstance|instanceNo,value,taskAttributes} <- instances | hasName identity taskAttributes] of
[(i,v):_] = Just (TaskId i 0,v)
_ = Nothing
hasName name attributes = maybe False ((==) (JSONString name)) ('DM'.get "name" attributes)
startTask _ = appendTask (Detached ('DM'.singleton "name" (JSONString identity)) True) (removeWhenStable (task @! ())) topLevelTasks @! ()
startTask _ = appendTask (Detached True 'DM'.newMap) (removeWhenStable ((task <<@ ("name",JSONString identity)) @! ())) topLevelTasks @! ()
stopTask (Just (taskId,_)) = removeTask taskId topLevelTasks @! ()
removeWhenStable t l = t >>* [OnValue (ifStable (\_ -> get (taskListSelfId l) >>- \id -> removeTask id l @? const NoValue))]
......
......@@ -17,8 +17,8 @@ addOnceToWorkspace identity task workspace
_ = return ()
where
find identity [] = Nothing
find identity [p=:{TaskListItem|taskId,attributes}:ps]
| maybe False ((==) (JSONString identity)) ('DM'.get "name" attributes) = Just taskId
= find identity ps
find identity [p=:{TaskListItem|taskId,taskAttributes}:ps]
| maybe False ((==) (JSONString identity)) ('DM'.get "name" taskAttributes) = Just taskId
= find identity ps
removeWhenStable t l = t >>* [OnValue (ifStable (\_ -> get (taskListSelfId l) >>- \id -> removeTask id l @? const NoValue))]
......@@ -25,7 +25,6 @@ derive class iTask ObjectType, ActorStatus, Availability, ActorHealth, ActorEner
derive class iTask Cable, Priority, Network, Device, CableType, DeviceKind, CommandAim, Capability, CapabilityExpr
derive gEditor Set
derive gDefault Set
derive gText Set
derive JSONEncode Set
derive JSONDecode Set
......
......@@ -154,29 +154,28 @@ viewNotifications = viewSharedInformation [ViewAs (join ", ")] currentNotificati
tasksToDo :: SDSLens () [(TaskId, WorklistRow)] ()
tasksToDo = taskForCurrentUser isToDo
where
isToDo {TaskListItem|attributes} = fmap (\(JSONInt x) -> x == toInt Immediate) ('DM'.get "priority" attributes) == Just True
isToDo {TaskListItem|managementAttributes} = fmap (\(JSONInt x) -> x == toInt Immediate) ('DM'.get "priority" managementAttributes) == Just True
incomingTasks :: SDSLens () [(TaskId, WorklistRow)] ()
incomingTasks = taskForCurrentUser isIncoming
where
isIncoming {TaskListItem|attributes} = fmap (\(JSONInt x) -> x /= toInt Immediate) ('DM'.get "priority" attributes) == Just True
isIncoming {TaskListItem|managementAttributes} = fmap (\(JSONInt x) -> x /= toInt Immediate) ('DM'.get "priority" managementAttributes) == Just True
taskForCurrentUser f = toReadOnly (mapRead (\(procs, ownPid) -> [(p.TaskListItem.taskId, mkRow p) \\ p <- procs | show ownPid p && isActive p && f p]) (processesForCurrentUser |*| currentTopTask))
show ownPid {TaskListItem|taskId,progress=Just _} = taskId /= ownPid
show ownPid _ = False
show ownPid {TaskListItem|taskId} = taskId /= ownPid
isActive {TaskListItem|progress=Just {InstanceProgress|value}} = value === Unstable
isActive {TaskListItem|value} = value =: (Value _ False)
mkRow {TaskListItem|taskId,attributes} =
mkRow {TaskListItem|taskId,managementAttributes} =
{ WorklistRow
| taskNr = Just (toString taskId)
, title = fmap toString ('DM'.get "title" attributes)
, priority = fmap toString ('DM'.get "priority" attributes)
, createdBy = fmap toString ('DM'.get "createdBy" attributes)
, date = fmap toString ('DM'.get "createdAt" attributes)
, deadline = fmap toString ('DM'.get "completeBefore" attributes)
, createdFor = fmap toString ('DM'.get "createdFor" attributes)
, title = fmap toString ('DM'.get "title" managementAttributes)
, priority = fmap toString ('DM'.get "priority" managementAttributes)
, createdBy = fmap toString ('DM'.get "createdBy" managementAttributes)
, date = fmap toString ('DM'.get "createdAt" managementAttributes)
, deadline = fmap toString ('DM'.get "completeBefore" managementAttributes)
, createdFor = fmap toString ('DM'.get "createdFor" managementAttributes)
, parentTask = Nothing
}
......@@ -17,8 +17,8 @@ addOnceToWorkspace identity task workspace
_ = return ()
find identity [] = Nothing
find identity [p=:{TaskListItem|taskId,attributes}:ps]
| maybe False ((==) (JSONString identity)) ('DM'.get "name" attributes) = Just taskId
find identity [p=:{TaskListItem|taskId,taskAttributes}:ps]
| maybe False ((==) (JSONString identity)) ('DM'.get "name" taskAttributes) = Just taskId
= find identity ps
removeWhenStable t l = t >>* [OnValue (ifStable (\_ -> get (taskListSelfId l) >>- \id -> removeTask id l @? const NoValue))]
......@@ -29,9 +29,9 @@ removeFromWorkspace identity workspace
>>- \items -> case find identity items of
Nothing = return ()
where names = map getName items
getName {TaskListItem|taskId,attributes} | isJust mbname = let (Just (JSONString name)) = mbname in name
getName {TaskListItem|taskId,taskAttributes} | isJust mbname = let (Just (JSONString name)) = mbname in name
| otherwise = "noname"
where mbname = 'DM'.get "name" attributes
where mbname = 'DM'.get "name" taskAttributes
appstr [] = ""
appstr [e:es] = e +++ " " +++ appstr es
(Just taskId) = removeTask taskId workspace @! ()
......@@ -12,6 +12,11 @@ import C2.Apps.ShipAdventure.Types
import Data.Map.GenJSON
import Data.Functor
derive gEditor Set
derive gText Set
derive JSONEncode Set
derive JSONDecode Set
dOffRegisterEntity :: [User -> Task Entity]
dOffRegisterEntity = []
......@@ -56,12 +61,6 @@ damagePrediction
resetSections = set 'DS'.newSet disabledSections >>| damagePrediction
isDisabled c3d disSects = 'DS'.member c3d disSects
derive gEditor Set
derive gDefault Set
derive gText Set
derive JSONEncode Set
derive JSONDecode Set
showCommandAims :: Task ()
showCommandAims = Hint "Current Command Aims" @>> viewSharedInformation [] commandAims @! ()
......
......@@ -19,7 +19,8 @@ import iTasks.Internal.IWorld
import iTasks.Internal.SDS
import iTasks.Internal.SDSService
import iTasks.Internal.TaskServer
import iTasks.Internal.TaskStore
import iTasks.Internal.TaskState
import iTasks.Internal.TaskIO
import iTasks.Internal.Util
import iTasks.SDS.Sources.System
import iTasks.WF.Combinators.Common
......
......@@ -48,24 +48,35 @@ allWork = workList detachedTaskInstances
workList instances = mapRead projection (instances |*| currentTopTask)
where
projection (instances,ownPid)
= [(TaskId i.TaskInstance.instanceNo 0, mkRow i) \\ i <- instances | notSelf ownPid i && isActive i]
= [(TaskId i.TaskInstance.instanceNo 0, mkRow i) \\ i <- instances | notSelf ownPid i && isActive i && notHidden i]
notSelf ownPid {TaskInstance|instanceNo} = (TaskId instanceNo 0) <> ownPid
notSelf ownPid _ = False
isActive {TaskInstance|value} = value === Unstable
notHidden {TaskInstance|managementAttributes} = case 'DM'.get "hidden" managementAttributes of (Just (JSONBool True)) = False ; _ = True
mkRow {TaskInstance|instanceNo,attributes,listId} =
isActive {TaskInstance|value} = value =: Unstable
mkRow {TaskInstance|instanceNo,taskAttributes,managementAttributes,listId} =
{WorklistRow
|taskNr = Just (toString instanceNo)
,title = fmap (\(JSONString x) -> x) ('DM'.get "title" attributes)
,priority = fmap (\(JSONInt x) -> toString x) ('DM'.get "priority" attributes)
,createdBy = fmap toString ('DM'.get "createdBy" attributes)
,date = fmap toString ('DM'.get "createdAt" attributes)
,deadline = fmap toString ('DM'.get "completeBefore" attributes)
,createdFor = fmap toString ('DM'.get "createdFor" attributes)
,createdBy = fmap (toString o toUserConstraint) ('DM'.get "createdBy" attributes)
,date = fmap (toString o toDateTime) ('DM'.get "createdAt" attributes)
,deadline = fmap (toString o toDateTime) ('DM'.get "completeBefore" attributes)
,createdFor = fmap (toString o toUserConstraint) ('DM'.get "createdFor" attributes)
,parentTask = if (listId == TaskId 0 0) Nothing (Just (toString listId))
}
where
attributes = 'DM'.union managementAttributes taskAttributes
//Fix Overloading
toUserConstraint :: JSONNode -> UserConstraint
toUserConstraint json = fromJust $ fromJSON json
toDateTime :: JSONNode -> DateTime
toDateTime json = fromJust $ fromJSON json
// SHARES
// Available workflows
......@@ -191,8 +202,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
......@@ -321,7 +332,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
......@@ -334,8 +345,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
......
implementation module iTasks.Extensions.CSVFile
import StdBool, StdList, System.FilePath, Text, Text.CSV, System.File, Data.Error
import iTasks, iTasks.Extensions.TextFile
import iTasks.Internal.IWorld, iTasks.Internal.Task, iTasks.Internal.TaskState, iTasks.Internal.TaskStore
import iTasks.Internal.IWorld, iTasks.Internal.Task, iTasks.Internal.TaskState
import iTasks, iTasks.Extensions.TextFile, iTasks.Extensions.Document
importCSVFile :: !FilePath -> Task [[String]]
importCSVFile filename = mkInstantTask eval
......
......@@ -3,7 +3,7 @@ implementation module iTasks.Extensions.Document
import iTasks.WF.Definition
import iTasks.UI.Editor.Controls, iTasks.UI.Editor.Modifiers
import iTasks.Internal.Task, iTasks.Internal.IWorld, iTasks.Internal.TaskStore
import iTasks.Internal.Task, iTasks.Internal.IWorld, iTasks.Internal.TaskState
import StdBool, StdString, StdFile, StdArray, StdInt
import Text.GenJSON, Text.Encodings.MIME, Text.HTML, System.FilePath, System.File, System.OSError, Data.Error
......
implementation module iTasks.Extensions.JSONFile
import StdBool, StdList, StdFile, StdArray, System.FilePath, System.File, Data.Error, Text.GenJSON, StdString
import iTasks.Internal.IWorld, iTasks.Internal.Task, iTasks.Internal.TaskState, iTasks.Internal.TaskStore
import iTasks.Internal.IWorld, iTasks.Internal.Task, iTasks.Internal.TaskState
import iTasks.Extensions.Document
:: JSONParseException = CannotParse !String
instance toString JSONParseException
......
implementation module iTasks.Extensions.TextFile
import StdBool, StdList, StdFile, StdArray, System.FilePath, Text, System.File, Data.Error, StdString, Data.Func
import iTasks.Internal.IWorld, iTasks.Internal.Task, iTasks.Internal.TaskState, iTasks.Internal.TaskStore
import StdBool, StdList, StdFile, StdArray, StdString, System.FilePath, Text, System.File, Data.Error, Data.Func
import iTasks.Internal.IWorld, iTasks.Internal.Task, iTasks.Internal.TaskState
import iTasks.Extensions.Document
CHUNK_SIZE :== 1048576 // 1M
......
......@@ -8,8 +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 :: InstanceProgress(..)
from iTasks.WF.Combinators.Core import :: TaskListItem(..)
from iTasks.WF.Definition import :: TaskListItem(..), fullTaskListFilter
import iTasks.Extensions.DateTime
import System.Time
......@@ -126,14 +125,14 @@ where
derive class iTask Credentials
currentUser :: SimpleSDSLens User
currentUser = sdsLens "currentUser" id (SDSRead userFromAttr) (SDSWrite userToAttr) (SDSNotify notify) Nothing currentTaskInstanceAttributes
currentUser = sdsLens "currentUser" id (SDSRead userFromAttr) (SDSWrite userToAttr) (SDSNotifyConst notify) Nothing currentTaskInstanceAttributes
where
notify _ _ _ = const (const True)
notify _ _ _ _ = False
taskInstanceUser :: SDSLens InstanceNo User User
taskInstanceUser = sdsLens "taskInstanceUser" id (SDSRead userFromAttr) (SDSWrite userToAttr) (SDSNotify notify) Nothing taskInstanceAttributesByNo
taskInstanceUser = sdsLens "taskInstanceUser" id (SDSRead userFromAttr) (SDSWrite userToAttr) (SDSNotifyConst notify) Nothing taskInstanceAttributesByNo
where
notify _ _ _ = const (const True)
notify _ _ _ _ = False
userFromAttr :: a TaskAttributes -> MaybeError TaskException User
userFromAttr _ attr = case 'DM'.get "auth-user" attr of
......@@ -149,7 +148,7 @@ userToAttr _ attr (AuthenticatedUser userId userRoles userTitle)
# attr = 'DM'.put "auth-user" (JSONString userId) attr
# attr = if (isEmpty userRoles) ('DM'.del "auth-roles" attr) ('DM'.put "auth-roles" (JSONString (join "," userRoles)) attr)
# attr = maybe ('DM'.del "auth-title" attr) (\title -> 'DM'.put "auth-title" (JSONString title) attr) userTitle
= Ok (Just attr)
= Ok (Just attr)
userToAttr _ attr _
//Remove user properties
# attr = 'DM'.del "auth-user" attr
......@@ -165,24 +164,24 @@ 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
Nothing = True
taskInstancesForUser :: SDSLens User [TaskInstance] ()
taskInstancesForUser = sdsLens "taskInstancesForUser" (const ()) (SDSRead read) (SDSWriteConst write) (SDSNotify notify) Nothing detachedTaskInstances
taskInstancesForUser = sdsLens "taskInstancesForUser" (const ()) (SDSRead read) (SDSWriteConst write) (SDSNotifyConst notify) Nothing detachedTaskInstances
where
read u instances = Ok (filter (forUser u) instances)
write _ () = Ok Nothing
notify _ _ _ = const (const False)
notify _ _ _ _ = False
forUser user {TaskInstance|attributes} = case 'DM'.get "user" attributes of
forUser user {TaskInstance|taskAttributes,managementAttributes} = case 'DM'.get "user" attributes of
Just (JSONString uid1) = case user of
(AuthenticatedUser uid2 _ _) = uid1 == uid2
_ = False
......@@ -192,6 +191,8 @@ where
(AuthenticatedUser _ roles _) = isMember role roles
_ = False
Nothing = True
where
attributes = 'DM'.union managementAttributes taskAttributes
taskInstancesForCurrentUser :: SDSSequence () [TaskInstance] ()
taskInstancesForCurrentUser
......@@ -229,26 +230,24 @@ workAs asUser task
*/
assign :: !TaskAttributes !(Task a) -> Task a | iTask a
assign attr task
= parallel [(Embedded, \s -> processControl s),(Detached attr False, const task)] []
= parallel [(Embedded, \s -> processControl s),(Detached False attr, const task)] []
@? result
where
processControl tlist
= viewSharedInformation [ViewAs toView] (sdsFocus filter tlist) @? const NoValue
where
filter = {TaskListFilter|onlySelf=False,onlyTaskId = Nothing, onlyIndex = Just [1]
,includeValue=False,includeAttributes=True,includeProgress=True}
toView (_,[{TaskListItem|progress=Just p,attributes}:_]) =
{ assignedTo = mkAssignedTo attributes
, firstWorkedOn = fmap (timestampToGmDateTime o timespecToStamp) p.InstanceProgress.firstEvent
, lastWorkedOn = fmap (timestampToGmDateTime o timespecToStamp) p.InstanceProgress.lastEvent
, taskStatus = case p.InstanceProgress.value of
Unstable -> "In progres..."
Stable -> "Task done"
(Exception _) -> "Something went wrong"
filter = {TaskListFilter|fullTaskListFilter & onlyIndex =Just [1], includeProgress=True}
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"
......
definition module iTasks.Internal.AsyncSDS
from iTasks.Internal.TaskState import :: AsyncAction
import iTasks.SDS.Definition
from iTasks.WF.Definition import :: TaskId, :: TaskValue, :: Event, :: TaskEvalOpts, :: TaskResult
from iTasks.Internal.IWorld import :: IOState, :: IOStates
from iTasks.Internal.SDS import :: SDSIdentity, :: SDSNotifyRequest
:: AsyncAction = Read | Write | Modify
:: SDSRequest p r w = E. sds: SDSReadRequest !(sds p r w) p & gText{|*|} p & TC p & TC r & TC w & Readable sds
/*
* sds: SDS to read
......
......@@ -608,7 +608,9 @@ getTaskIdByAttribute key value = get attrb
where
attrb = mapRead find (sdsFocus (key,value) taskInstancesByAttribute)
find instances = case [instanceNo \\ {TaskInstance|instanceNo,attributes} <- instances | hasValue key value attributes] of
find instances
= case [instanceNo \\ {TaskInstance|instanceNo,taskAttributes,managementAttributes}
<- instances | hasValue key value ('DM'.union managementAttributes taskAttributes)] of
[i:_] = Just i
_ = Nothing
......
......@@ -6,9 +6,9 @@ import StdEnv
import iTasks.Engine
import iTasks.Internal.IWorld
import iTasks.Internal.TaskEval
import iTasks.Internal.TaskIO
import iTasks.Internal.TaskServer
import iTasks.Internal.TaskState
import iTasks.Internal.TaskStore
import iTasks.Internal.Util
import iTasks.SDS.Combinators.Common
import iTasks.UI.Definition
......@@ -17,6 +17,10 @@ import Text
from Data.Map import newMap, member, del
derive gText TaskId, TaskListFilter
derive JSONEncode TaskId, TaskListFilter
derive gDefault TaskId, TaskListFilter
everyTick :: (*IWorld -> *(MaybeError TaskException (), *IWorld)) -> Task ()
everyTick f = Task eval
where
......@@ -36,45 +40,29 @@ where
//When we run the built-in HTTP server we need to do active garbage collection of instances that were created for sessions
removeOutdatedSessions :: Task ()
removeOutdatedSessions = everyTick \iworld=:{IWorld|options}->
case read (sdsFocus {InstanceFilter|defaultValue & includeSessions=True} filteredInstanceIndex) EmptyContext iworld of
(Ok (ReadingDone index), iworld) = checkAll (removeIfOutdated options) index iworld
removeOutdatedSessions = everyTick \iworld=:{IWorld|options} ->
case read (sdsFocus (TaskId 0 0,TaskId 0 0, defaultValue, onlySessions) taskListMetaData) EmptyContext iworld of
(Ok (ReadingDone (_,index)), iworld) = checkAll (removeIfOutdated options) index iworld
(Error e, iworld) = (Error e, iworld)
where
onlySessions = {ExtendedTaskListFilter|defaultValue &includeSessions=True,includeDetached=False,includeStartup=False}