Commit c2ce79ec authored by Bas Lijnse's avatar Bas Lijnse

Cleaned up use of attributes and updated examples and tests

parent dcc3e143
Pipeline #34865 passed with stage
in 6 minutes and 59 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
......@@ -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)
......
......@@ -199,7 +199,7 @@ 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
......
......@@ -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 @! ()
......
......@@ -5,7 +5,6 @@ import StdMisc, Data.Tuple, Text, Data.Either, Data.Functor, Data.Func
import iTasks.Internal.SDS
import iTasks.Internal.Serialization
import iTasks.Internal.Store
from iTasks.Internal.TaskState import :: ValueStatus(..)
from StdFunc import seq
import qualified Data.Map as DM
import Data.Map.GenJSON
......@@ -54,11 +53,11 @@ where
notSelf ownPid {TaskInstance|instanceNo} = (TaskId instanceNo 0) <> ownPid
notSelf ownPid _ = False
notHidden {TaskInstance|attributes} = case 'DM'.get "hidden" attributes of (Just (JSONBool True)) = False ; _ = True
notHidden {TaskInstance|managementAttributes} = case 'DM'.get "hidden" managementAttributes of (Just (JSONBool True)) = False ; _ = True
isActive {TaskInstance|value} = value =: Unstable
mkRow {TaskInstance|instanceNo,attributes,listId} =
mkRow {TaskInstance|instanceNo,taskAttributes,managementAttributes,listId} =
{WorklistRow
|taskNr = Just (toString instanceNo)
,title = fmap (\(JSONString x) -> x) ('DM'.get "title" attributes)
......@@ -69,6 +68,8 @@ where
,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
......
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
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
CHUNK_SIZE :== 1048576 // 1M
......
......@@ -181,7 +181,7 @@ where
write _ () = Ok Nothing
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
......@@ -191,6 +191,8 @@ where
(AuthenticatedUser _ roles _) = isMember role roles
_ = False
Nothing = True
where
attributes = 'DM'.union managementAttributes taskAttributes
taskInstancesForCurrentUser :: SDSSequence () [TaskInstance] ()
taskInstancesForCurrentUser
......
......@@ -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
......
......@@ -87,7 +87,7 @@ where
selection = (TaskId 0 0, TaskId 0 0,{TaskListFilter|fullTaskListFilter & includeProgress=True}
,{ExtendedTaskListFilter|fullExtendedTaskListFilter & includeStartup=True, includeSessions=False, includeDetached=False})
isStable {TaskMeta|valuestatus} = valuestatus =: Stable
isStable {TaskMeta|status} = fromRight False status
isSystem {TaskMeta|taskAttributes} = member "system" taskAttributes
printStdErr :: v !*IWorld -> *IWorld | gText{|*|} v
......
......@@ -17,7 +17,7 @@ import iTasks.Internal.SDS
from iTasks.UI.Layout import :: LUI, :: LUIMoves, :: LUIMoveID, :: LUIEffectStage, :: LUINo
from iTasks.Util.DeferredJSON import :: DeferredJSON(..)
from iTasks.Internal.TaskState import :: TaskMeta(..) , :: InstanceType(..), :: TaskChange(..), :: ValueStatus(..)
from iTasks.Internal.TaskState import :: TaskMeta(..) , :: InstanceType(..), :: TaskChange(..)
import iTasks.Internal.TaskEval
from iTasks.SDS.Combinators.Common import toDynamic
......
......@@ -21,7 +21,7 @@ import qualified iTasks.Internal.SDS as SDS
from iTasks.SDS.Combinators.Common import sdsFocus, >*|, mapReadWrite, mapReadWriteError
from StdFunc import const, o
derive gEq TaskMeta, InstanceType, TaskChange, ValueStatus
derive gEq TaskMeta, InstanceType, TaskChange
mkEvalOpts :: TaskEvalOpts
mkEvalOpts =
......@@ -63,11 +63,9 @@ where
// Determine the task type (startup,session,local)
# (type,iworld) = determineInstanceType instanceNo iworld
// Determine the progress of the instance
# (curProgress=:{TaskMeta|nextTaskTime,nextTaskNo,valuestatus,attachedTo},iworld) = determineInstanceProgress instanceNo iworld
# (curProgress=:{TaskMeta|nextTaskTime,nextTaskNo,status,attachedTo},iworld) = determineInstanceProgress instanceNo iworld
//Check exception
| valuestatus =: (Exception _)
# (Exception description) = valuestatus
= exitWithException instanceNo description iworld
| status =: (Left _) = let (Left message) = status in exitWithException instanceNo message iworld
//Evaluate instance
# (currentSession,currentAttachment) = case (type,attachedTo) of
(SessionInstance,_) = (Just instanceNo,[])
......@@ -164,9 +162,9 @@ where
, nextTaskTime = nextTaskTime + 1
}
= case result of
(ExceptionResult (_,msg)) = {TaskMeta|meta & valuestatus = Exception msg}
(ValueResult (Value _ stable) _ _ _) = {TaskMeta|meta & valuestatus = if stable Stable Unstable}
_ = {TaskMeta|meta & valuestatus = Unstable }
(ExceptionResult (_,msg)) = {TaskMeta|meta & status = Left msg}
(ValueResult (Value _ stable) _ _ _) = {TaskMeta|meta & status = Right stable}
_ = {TaskMeta|meta & status = Right False}
getAttributeChanges :: !UIChange -> [UIAttributeChange]
getAttributeChanges (ChangeUI changes _) = changes
......
......@@ -55,12 +55,12 @@ derive gText ExtendedTaskListFilter
//Static information
{ taskId :: !TaskId //Unique global identification
, instanceType :: !InstanceType //There are 3 types of tasks: startup tasks, sessions, and persistent tasks
, build :: !String //Application build version when the instance was created
, build :: !String //* Application build version when the instance was created
, createdAt :: !Timespec
//Evaluation information
, nextTaskNo :: !TaskNo //* Local task number counter
, nextTaskTime :: !TaskTime //* Local task time (incremented at every evaluation)
, valuestatus :: !ValueStatus
, status :: !Either String Bool //* Exception message, or stability
, nextTaskNo :: !TaskNo //* Local task number counter
, nextTaskTime :: !TaskTime //* Local task time (incremented at every evaluation)
, attachedTo :: ![TaskId]
, connectedTo :: !Maybe String
, instanceKey :: !Maybe InstanceKey //* Random token that a client gets to have (temporary) access to the task instance
......@@ -91,7 +91,6 @@ derive gText ExtendedTaskListFilter
= RemoveTask //Mark for removal from the set on the next evaluation
| ReplaceTask !Dynamic //Replace the task on the next evaluation
:: ValueStatus = Stable | Unstable | Exception !String
//Internally we need more options to filter task list data
:: ExtendedTaskListFilter =
......@@ -107,8 +106,6 @@ derive gText ExtendedTaskListFilter
//Predefined filters
fullExtendedTaskListFilter :: ExtendedTaskListFilter
mergeTaskAttributes :: !(!TaskAttributes,!TaskAttributes) -> TaskAttributes
//Fresh identifier generation
newInstanceNo :: !*IWorld -> (!MaybeError TaskException InstanceNo,!*IWorld)
newInstanceKey :: !*IWorld -> (!InstanceKey,!*IWorld)
......@@ -148,18 +145,15 @@ taskInstanceAttributes :: SDSLens InstanceNo (TaskAttributes,TaskAttributes) (T
taskInstanceValue :: SDSLens InstanceNo (TaskValue DeferredJSON) (TaskValue DeferredJSON)
taskInstanceTask :: SDSLens InstanceNo (Task DeferredJSON) (Task DeferredJSON)
// === Evaluation state of instances: === //FIXME: Isolate as separate concern to separate
taskInstanceShares :: SDSLens InstanceNo (Maybe (Map TaskId DeferredJSON)) (Maybe (Map TaskId DeferredJSON))
//Interface used in task combinators
//Shared source
localShare :: SDSLens TaskId a a | iTask a
//Locally shared data
taskInstanceShares :: SDSLens InstanceNo (Maybe (Map TaskId DeferredJSON)) (Maybe (Map TaskId DeferredJSON))
//Public interface used by parallel tasks
parallelTaskList :: SDSLens (!TaskId,!TaskId,!TaskListFilter) (!TaskId,![TaskListItem a]) [(TaskId,TaskAttributes)] | iTask a
topLevelTaskList :: SDSLens TaskListFilter (!TaskId,![TaskListItem a]) [(TaskId,TaskAttributes)] | iTask a
localShare :: SDSLens TaskId a a | iTask a
//Conversion to task lists
toTaskListItem :: !TaskId !TaskMeta -> TaskListItem a
......
......@@ -48,14 +48,14 @@ from Control.Applicative import class Alternative(<|>)
import Data.GenEq
import qualified Control.Monad
derive JSONEncode TaskMeta, InstanceType, TaskChange, TaskResult, TaskEvalInfo, ExtendedTaskListFilter, ValueStatus
derive JSONDecode TaskMeta, InstanceType, TaskChange, TaskResult, TaskEvalInfo, ExtendedTaskListFilter, ValueStatus
derive JSONEncode TaskMeta, InstanceType, TaskChange, TaskResult, TaskEvalInfo, ExtendedTaskListFilter
derive JSONDecode TaskMeta, InstanceType, TaskChange, TaskResult, TaskEvalInfo, ExtendedTaskListFilter
derive gDefault InstanceType, TaskId, ValueStatus, TaskListFilter
derive gDefault InstanceType, TaskId, TaskListFilter
gDefault{|TaskMeta|}
= {taskId= TaskId 0 0,instanceType=gDefault{|*|},build="",createdAt=gDefault{|*|},nextTaskNo=1,nextTaskTime=1
,valuestatus=Unstable,attachedTo=[],connectedTo=Nothing,instanceKey=Nothing
,status=Right False,attachedTo=[],connectedTo=Nothing,instanceKey=Nothing
,firstEvent=Nothing,lastEvent=Nothing, lastIO = Nothing
,taskAttributes='DM'.newMap,managementAttributes='DM'.newMap,unsyncedAttributes = 'DS'.newSet
,change = Nothing, initialized = False}
......@@ -72,9 +72,6 @@ fullExtendedTaskListFilter :: ExtendedTaskListFilter
fullExtendedTaskListFilter =
{includeSessions=True,includeDetached=True,includeStartup=True,includeTaskReduct=False,includeTaskIO=False}
mergeTaskAttributes :: !(!TaskAttributes,!TaskAttributes) -> TaskAttributes
mergeTaskAttributes (explicit,implicit) = 'DM'.union explicit implicit
encodeTaskValue :: (TaskValue a) -> TaskValue DeferredJSON | iTask a
encodeTaskValue (Value dec stable) = Value (DeferredJSON dec) stable
encodeTaskValue NoValue = NoValue
......@@ -153,7 +150,7 @@ createDetachedTaskInstance task evalOpts instanceNo attributes listId refreshImm
# task = if autoLayout (ApplyLayout defaultSessionLayout @>> task) task
# (instanceKey,iworld) = newInstanceKey iworld
# mbListId = if (listId == TaskId 0 0) Nothing (Just listId)
# meta = {defaultValue & taskId = TaskId instanceNo 0, valuestatus = Unstable, instanceType=PersistentInstance mbListId,build=appVersion
# meta = {defaultValue & taskId = TaskId instanceNo 0, instanceType=PersistentInstance mbListId,build=appVersion
,createdAt=clock,managementAttributes=attributes, instanceKey=Just instanceKey}
= 'SDS'.write meta (sdsFocus (instanceNo,False,False,False) taskInstance) 'SDS'.EmptyContext iworld
`b` \iworld -> 'SDS'.write (task @ DeferredJSON) (sdsFocus instanceNo taskInstanceTask) 'SDS'.EmptyContext iworld
......@@ -390,7 +387,7 @@ where
write2 _ ws = Ok $ Just ws
toTaskListItem :: !TaskId !TaskMeta -> TaskListItem a
toTaskListItem selfId {TaskMeta|taskId=taskId=:(TaskId instanceNo taskNo),instanceType,valuestatus
toTaskListItem selfId {TaskMeta|taskId=taskId=:(TaskId instanceNo taskNo),instanceType
,attachedTo,instanceKey,firstEvent,lastEvent,taskAttributes,managementAttributes}
# listId = case instanceType of (PersistentInstance (Just listId)) = listId ; _ = (TaskId 0 0)
= {TaskListItem|taskId = taskId, listId = listId, detached = taskNo == 0, self = taskId == selfId
......
......@@ -14,22 +14,23 @@ from System.FilePath import :: FilePath
from Data.Map import :: Map
from Data.Maybe import :: Maybe
from iTasks.Internal.TaskState import :: ValueStatus //FIXME Don't import internal types
//* Types to view the server's internal table of running task instances
:: TaskInstance =
{ instanceNo :: !InstanceNo //* Unique global identification
, instanceKey :: !Maybe InstanceKey //* Random string that a client needs to provide to access the task instance
, session :: !Bool //* Is this a session
, listId :: !TaskId //* Reference to parent tasklist
, build :: !String //* Application build version when the instance was created
, issuedAt :: !Timespec //* When was the task created
, attributes :: !TaskAttributes //* Arbitrary meta-data
, value :: !ValueStatus //* Status of the task value
, firstEvent :: !Maybe Timespec //*When was the first work done on this task
, lastEvent :: !Maybe Timespec //* When was the last event on this task
{ instanceNo :: !InstanceNo //* Unique global identification
, instanceKey :: !Maybe InstanceKey //* Random string that a client needs to provide to access the task instance
, value :: !ValueStatus //* Status of the task value
, session :: !Bool //* Is this a session
, listId :: !TaskId //* Reference to parent tasklist
, build :: !String //* Application build version when the instance was created
, issuedAt :: !Timespec //* When was the task created
, taskAttributes :: !TaskAttributes //* Computed task meta-data
, managementAttributes :: !TaskAttributes //* Arbitrary meta-data
, firstEvent :: !Maybe Timespec //* When was the first work done on this task
, lastEvent :: !Maybe Timespec //* When was the last event on this task
}
:: ValueStatus = Stable | Unstable | Exception !String
// Date & time (in task server's local timezone)
currentDateTime :: SDSParallel () DateTime ()
currentTime :: SDSLens () Time ()
......
......@@ -72,13 +72,19 @@ where
efilter = {ExtendedTaskListFilter|defaultValue & includeSessions = False, includeDetached = True, includeStartup = False}
taskInstanceFromMetaData :: TaskMeta -> TaskInstance
taskInstanceFromMetaData {TaskMeta|taskId=taskId=:(TaskId instanceNo _),instanceType,build,createdAt,valuestatus,instanceKey,firstEvent,lastEvent,taskAttributes,managementAttributes}
# session = (instanceType =: SessionInstance )
# listId = case instanceType of
taskInstanceFromMetaData {TaskMeta|taskId=taskId=:(TaskId instanceNo _),instanceType,build,createdAt,status
,instanceKey,firstEvent,lastEvent,taskAttributes,managementAttributes}
= {TaskInstance|instanceNo = instanceNo, instanceKey = instanceKey, session = session, listId = listId, build = build
,taskAttributes = taskAttributes, managementAttributes = managementAttributes, value = value
,issuedAt = createdAt, firstEvent = firstEvent, lastEvent = lastEvent}
where
session = (instanceType =: SessionInstance )
listId = case instanceType of
(PersistentInstance (Just listId)) = listId
_ = (TaskId 0 0)
= {TaskInstance|instanceNo = instanceNo, instanceKey = instanceKey, session = session, listId = listId, build = build
,attributes = mergeTaskAttributes (taskAttributes,managementAttributes), value = valuestatus, issuedAt = createdAt, firstEvent = firstEvent, lastEvent = lastEvent}
value = case status of
(Left msg) = Exception msg
(Right stable) = if stable Stable Unstable
currentTaskInstanceNo :: SDSSource () InstanceNo ()
currentTaskInstanceNo = createReadOnlySDS (\() iworld=:{current={taskInstance}} -> (taskInstance,iworld))
......@@ -91,7 +97,7 @@ where
where
tfilter no = {TaskListFilter|defaultValue & onlyTaskId = Just [TaskId no 0]}
read no selfNo = Right $ \(_,(_,[{TaskMeta|taskAttributes,managementAttributes}])) -> mergeTaskAttributes (taskAttributes,managementAttributes)
read no selfNo = Right $ \(_,(_,[{TaskMeta|taskAttributes,managementAttributes}])) -> 'DM'.union managementAttributes taskAttributes
write1 _ _ = Ok Nothing
write2 _ (_,[meta]) update = Ok $ Just $ [{TaskMeta|meta & managementAttributes = 'DM'.union update meta.TaskMeta.managementAttributes}]
......@@ -137,7 +143,7 @@ where
where
tfilter no = {TaskListFilter|defaultValue & onlyTaskId = Just [TaskId no 0]}
read no selfNo = Right $ \(_,(_,[{TaskMeta|taskAttributes,managementAttributes}])) -> mergeTaskAttributes (taskAttributes,managementAttributes)
read no selfNo = Right $ \(_,(_,[{TaskMeta|taskAttributes,managementAttributes}])) -> 'DM'.union managementAttributes taskAttributes
write1 _ _ = Ok Nothing
write2 no (_,[meta]) update = Ok $ Just $ [{TaskMeta|meta & managementAttributes = 'DM'.union update meta.TaskMeta.managementAttributes}]
......
definition module iTasks.Util.Testing
import iTasks
import iTasks.Util.Trace
from iTasks.Internal.TaskStore import :: TaskOutputMessage(..)
from iTasks.Internal.TaskIO import :: TaskOutputMessage(..)
from Testing.TestEvents import :: EndEventType
from Text.GenPrint import generic gPrint, :: PrintState, class PrintOutput
......
......@@ -10,7 +10,8 @@ import iTasks.Extensions.Development.Codebase
import Data.Func, Data.Either, Data.Error
from iTasks.Internal.IWorld import createIWorld, destroyIWorld, ::IWorld{options}
from iTasks.Internal.TaskStore import createSessionTaskInstance, taskInstanceOutput, :: TaskOutput, :: TaskOutputMessage
from iTasks.Internal.TaskState import createSessionTaskInstance
from iTasks.Internal.TaskIO import taskInstanceOutput, :: TaskOutput, :: TaskOutputMessage
from iTasks.Internal.TaskEval import evalTaskInstance
from iTasks.Internal.Store import emptyStore
from iTasks.Internal.Util import toCanonicalPath
......
......@@ -300,7 +300,7 @@ initParallelTask evalOpts listId parType parTask iworld=:{options,clock,current=
, createdAt = clock
, nextTaskNo = 0
, nextTaskTime = 0
, valuestatus = Unstable
, status = Right False
, attachedTo = []
, connectedTo = Nothing
, instanceKey = Nothing
......@@ -445,7 +445,7 @@ where
| mbError =:(Error _) = (Error (fromError mbError), iworld)
//Write meta data
# (mbError,iworld) = modify
(\meta -> {TaskMeta|meta & valuestatus = valueStatus val,
(\meta -> {TaskMeta|meta & status = valueStatus val,
taskAttributes = taskAttributeUpdate meta.TaskMeta.taskAttributes, initialized = True})
(sdsFocus (listId,taskId,valueChanged) taskInstanceParallelTaskListItem)
EmptyContext iworld
......@@ -459,8 +459,8 @@ where
where
(TaskId instanceNo taskNo) = taskId
valueStatus (Value _ True) = Stable
valueStatus _ = Unstable
valueStatus (Value _ True) = Right True
valueStatus _ = Right False
//Retrieve result of detached parallel task
evalDetachedParallelTask :: !TaskId !Event !TaskEvalOpts !TaskMeta !*IWorld -> *(MaybeError TaskException (TaskResult a), *IWorld) | iTask a
......@@ -703,7 +703,7 @@ where
evalinit event evalOpts=:{TaskEvalOpts|taskId} iworld=:{current={attachmentChain}}
# (mbMeta,iworld) = read (sdsFocus (instanceNo,False,False,False) taskInstance) EmptyContext iworld
| mbMeta =: (Error _) = (ExceptionResult (fromError mbMeta),iworld)
# (Ok (ReadingDone meta=:{TaskMeta|build,instanceKey,valuestatus,attachedTo})) = mbMeta
# (Ok (ReadingDone meta=:{TaskMeta|build,instanceKey,status,attachedTo})) = mbMeta
//Check if the task is already in use
| (not (attachedTo =: [])) && (not steal)
= eval (ASInUse (hd attachedTo)) build instanceKey event evalOpts iworld
......@@ -714,7 +714,7 @@ where
//Clear all input and output of that instance
# (_,iworld) = write 'DQ'.newQueue (sdsFocus instanceNo taskInstanceOutput) EmptyContext iworld
# (_,iworld) = modify (\('DQ'.Queue a b) -> 'DQ'.Queue [(i,e) \\(i,e)<- a| i <> instanceNo][(i,e) \\(i,e)<- b| i <> instanceNo]) taskEvents EmptyContext iworld
= eval (ASAttached (valuestatus =: Stable)) build (Just newKey) event evalOpts iworld
= eval (ASAttached (status =: (Right True))) build (Just newKey) event evalOpts iworld
eval _ _ _ DestroyEvent evalOpts=:{TaskEvalOpts|taskId} iworld
# iworld = clearTaskSDSRegistrations ('DS'.singleton taskId) iworld
......@@ -733,11 +733,11 @@ where
# (progress,iworld) = readRegister taskId (sdsFocus focus taskListMetaData) iworld
//Determine state of the instance
# curStatus = case progress of
(Ok (ReadingDone (_,[progress=:{TaskMeta|attachedTo=[attachedId:_],valuestatus}])))
(Ok (ReadingDone (_,[progress=:{TaskMeta|attachedTo=[attachedId:_],status}])))
| build <> appVersion = ASIncompatible
| valuestatus =: (Exception _) = ASExcepted "unable to read progress"
| status =: (Left _) = ASExcepted "unable to read progress"
| attachedId <> taskId = ASInUse attachedId
= ASAttached (valuestatus =: Stable)
= ASAttached (status =: (Right True))
_ = ASDeleted
//Determine UI change
# change = determineUIChange event curStatus prevStatus instanceNo instanceKey
......
......@@ -107,6 +107,7 @@ instance toInstanceNo TaskId