implementation module TaskStore import StdEnv, Maybe import IWorld, TaskState, Task, Store, Util, Text, Time, Random, JSON_NG, UIDefinition, Map import SharedDataSource import SerializationGraphCopy //TODO: Make switchable from within iTasks module //Derives required for storage of TUI definitions derive JSONEncode TaskRep, TaskCompositionType derive JSONEncode UIDef, UIAction, UIControl, UISizeOpts, UIViewOpts, UIEditOpts, UIActionOpts, UIChoiceOpts, UILayoutOpts derive JSONEncode UIProgressOpts, UISliderOpts, UIGridOpts, UIGoogleMapOpts, UIGoogleMapMarker, UIGoogleMapOptions, UIIconOpts, UILabelOpts, UITabOpts, UITaskletOpts, UITreeNode derive JSONEncode UIMenuButtonOpts, UIButtonOpts, UIContainerOpts, UIPanelOpts, UIFieldSetOpts, UIWindowOpts derive JSONEncode UISize, UIMinSize, UIDirection, UIHAlign, UIVAlign, UISideSizes, UIMenuItem, ProgressAmount derive JSONDecode TaskRep, TaskCompositionType derive JSONDecode UIDef, UIAction, UIControl, UISizeOpts, UIViewOpts, UIEditOpts, UIActionOpts, UIChoiceOpts, UILayoutOpts derive JSONDecode UIProgressOpts, UISliderOpts, UIGoogleMapOpts, UIGoogleMapMarker, UIGoogleMapOptions, UIGridOpts, UIIconOpts, UILabelOpts, UITabOpts, UITaskletOpts, UITreeNode derive JSONDecode UIMenuButtonOpts, UIButtonOpts, UIContainerOpts, UIPanelOpts, UIFieldSetOpts, UIWindowOpts derive JSONDecode UISize, UIMinSize, UIDirection, UIHAlign, UIVAlign, UISideSizes, UIMenuItem, ProgressAmount INCREMENT :== "increment" PERSISTENT_INDEX :== "persistent-index" OUTDATED_INDEX :== "outdated-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" newSessionId :: !*IWorld -> (!SessionId,!*IWorld) newSessionId iworld=:{IWorld|world,timestamp} # (Clock c, world) = clock world = (toString (take 32 [toChar (97 + abs (i rem 26)) \\ i <- genRandInt (toInt timestamp+c)]) , {IWorld|iworld & world = world}) newInstanceId :: !*IWorld -> (!InstanceNo,!*IWorld) newInstanceId iworld # (mbNewTid,iworld) = loadValue NS_TASK_INSTANCES INCREMENT iworld = case mbNewTid of Just tid # iworld = storeValue NS_TASK_INSTANCES INCREMENT (tid+1) iworld = (tid,iworld) Nothing # iworld = storeValue NS_TASK_INSTANCES INCREMENT 2 iworld //store the next value (2) = (1,iworld) //return the first value (1) newDocumentId :: !*IWorld -> (!DocumentId, !*IWorld) newDocumentId iworld=:{world,timestamp} # (Clock c,world) = clock world = (toString (take 32 [toChar (97 + abs (i rem 26)) \\ i <- genRandInt (toInt timestamp+c)]) ,{iworld & world = world}) storeTaskInstance :: !TaskInstance !*IWorld -> *IWorld storeTaskInstance (meta=:{TIMeta|instanceNo,sessionId},reduct,result,rep) iworld //Store all parts # iworld = storeValue NS_TASK_INSTANCES (meta_store instanceNo) meta iworld # iworld = storeValue NS_TASK_INSTANCES (reduct_store instanceNo) reduct iworld # iworld = storeValue NS_TASK_INSTANCES (result_store instanceNo) result iworld # iworld = storeValue NS_TASK_INSTANCES (rep_store instanceNo) rep iworld = case sessionId of Just sessionId = updateSessionInstanceIndex (put sessionId instanceNo) iworld Nothing = updatePersistentInstanceIndex (replace (instanceToTaskListItem meta rep)) iworld where replace item [] = [item] replace item [i:is] = if (item.TaskListItem.taskId == i.TaskListItem.taskId) [item:is] [i:replace item is] instanceToTaskListItem :: !TIMeta !TIRep -> TaskListItem a instanceToTaskListItem {TIMeta|instanceNo,progress,management} (TaskRep {UIDef|attributes} _) = {taskId = TaskId instanceNo 0, value = NoValue, taskMeta = toList attributes, progressMeta = Just progress, managementMeta = Just management} loadTaskInstance :: !InstanceNo !*IWorld -> (!MaybeErrorString (TIMeta,TIReduct,TIResult), !*IWorld) loadTaskInstance instanceNo iworld # (meta,iworld) = loadValue NS_TASK_INSTANCES (meta_store instanceNo) iworld # (reduct,iworld) = loadValue NS_TASK_INSTANCES (reduct_store instanceNo) iworld # (result,iworld) = loadValue NS_TASK_INSTANCES (result_store instanceNo) iworld = case (meta,reduct,result) of (Just meta,Just reduct,Just result) = (Ok (meta,reduct,result),iworld) _ = (Error ("Could not load instance state of task " +++ toString instanceNo),iworld) loadSessionInstance :: !SessionId !*IWorld -> (!MaybeErrorString (TIMeta,TIReduct,TIResult), !*IWorld) loadSessionInstance sessionId iworld=:{sessions} = case get sessionId sessions of Just topno = loadTaskInstance topno iworld _ = (Error ("Could not load session " +++ sessionId), iworld) loadTaskMeta :: !InstanceNo !*IWorld -> (!MaybeErrorString TIMeta, !*IWorld) loadTaskMeta instanceNo iworld # (meta,iworld) = loadValue NS_TASK_INSTANCES (meta_store instanceNo) iworld = (maybe (Error ("Could not load meta state of task " +++ toString instanceNo)) Ok meta, iworld) loadTaskReduct :: !InstanceNo !*IWorld -> (!MaybeErrorString TIReduct, !*IWorld) loadTaskReduct instanceNo iworld # (reduct,iworld) = loadValue NS_TASK_INSTANCES (reduct_store instanceNo) iworld = (maybe (Error ("Could not load reduct state of task " +++ toString instanceNo)) Ok reduct, iworld) loadTaskResult :: !InstanceNo !*IWorld -> (!MaybeErrorString TIResult, !*IWorld) loadTaskResult instanceNo iworld # (result,iworld) = loadValue NS_TASK_INSTANCES (result_store instanceNo) iworld = (maybe (Error ("Could not load result state of task " +++ toString instanceNo)) Ok result, iworld) loadTaskRep :: !InstanceNo !*IWorld -> (!MaybeErrorString TIRep, !*IWorld) loadTaskRep instanceNo iworld # (rep,iworld) = loadValue NS_TASK_INSTANCES (rep_store instanceNo) iworld = (maybe (Error ("Could not load ui representation state of task " +++ toString instanceNo)) Ok rep, iworld) storeTaskMeta :: !InstanceNo !TIMeta !*IWorld -> *IWorld storeTaskMeta instanceNo meta iworld = storeValue NS_TASK_INSTANCES (meta_store instanceNo) meta iworld storeTaskReduct :: !InstanceNo !TIReduct !*IWorld -> *IWorld storeTaskReduct instanceNo reduct iworld = storeValue NS_TASK_INSTANCES (reduct_store instanceNo) reduct iworld storeTaskResult :: !InstanceNo !TIResult !*IWorld -> *IWorld storeTaskResult instanceNo result iworld = storeValue NS_TASK_INSTANCES (result_store instanceNo) result iworld storeTaskRep :: !InstanceNo !TIRep !*IWorld -> *IWorld storeTaskRep instanceNo rep iworld = storeValue NS_TASK_INSTANCES (rep_store instanceNo) rep iworld deleteTaskInstance :: !InstanceNo !*IWorld -> *IWorld deleteTaskInstance instanceNo iworld # iworld = deleteValue NS_TASK_INSTANCES (meta_store instanceNo) iworld # iworld = deleteValue NS_TASK_INSTANCES (reduct_store instanceNo) iworld # iworld = deleteValue NS_TASK_INSTANCES (result_store instanceNo) iworld # iworld = deleteValue NS_TASK_INSTANCES (rep_store instanceNo) iworld # iworld = updatePersistentInstanceIndex (delete instanceNo) iworld = iworld where delete id list = [ i \\ i <- list | i.TaskListItem.taskId <> TaskId id 0] createDocument :: !String !String !String !*IWorld -> (!MaybeError FileError Document, !*IWorld) createDocument name mime content iworld # (documentId, iworld) = newDocumentId iworld # document = {Document|documentId = documentId, contentUrl = "?download="+++documentId, name = name, mime = mime, size = size content} # iworld = storeBlob NS_DOCUMENT_CONTENT (documentId +++ "-data") content iworld # iworld = storeValue NS_DOCUMENT_CONTENT (documentId +++ "-meta") document iworld = (Ok document,iworld) createDocumentWith :: !String !String (*File -> *File) !*IWorld -> (!MaybeError FileError Document, !*IWorld) createDocumentWith name mime f iworld = createDocument name mime "FIXME" iworld //TODO make it possible to apply the function during creation loadDocumentContent :: !DocumentId !*IWorld -> (!Maybe String, !*IWorld) loadDocumentContent documentId iworld = loadBlob NS_DOCUMENT_CONTENT (documentId +++ "-data") iworld loadDocumentMeta :: !DocumentId !*IWorld -> (!Maybe Document, !*IWorld) loadDocumentMeta documentId iworld = loadValue NS_DOCUMENT_CONTENT (documentId +++ "-meta") iworld documentLocation :: !DocumentId !*IWorld -> (!FilePath,!*IWorld) documentLocation documentId iworld=:{build,dataDirectory} = (storePath dataDirectory build NS_DOCUMENT_CONTENT (documentId +++ "_data.bin"),iworld) updateTaskInstanceMeta :: !InstanceNo !(TIMeta -> TIMeta) !*IWorld -> *IWorld updateTaskInstanceMeta instanceNo f iworld = case loadValue NS_TASK_INSTANCES (meta_store instanceNo) iworld of (Nothing,iworld) = iworld (Just meta,iworld) # iworld = storeValue NS_TASK_INSTANCES (meta_store instanceNo) (f meta) iworld # iworld = addOutdatedInstances [instanceNo] iworld = iworld setTaskWorker :: !User !InstanceNo !*IWorld -> *IWorld setTaskWorker worker instanceNo iworld = updateTaskInstanceMeta instanceNo (set worker) iworld where set worker inst=:{TIMeta|worker=Nothing} = {TIMeta|inst & worker = Just worker} set _ inst = inst addTaskInstanceObserver :: !InstanceNo !InstanceNo !*IWorld -> *IWorld addTaskInstanceObserver observer instanceNo iworld = updateTaskInstanceMeta instanceNo (add observer) iworld where add observer meta=:{TIMeta|observers} = {TIMeta|meta & observers = removeDup (observers ++ [observer])} addOutdatedInstances :: ![InstanceNo] !*IWorld -> *IWorld addOutdatedInstances outdated iworld = updateOutdatedInstanceIndex (removeDup o ((++) outdated)) iworld remOutdatedInstance :: !InstanceNo !*IWorld -> *IWorld remOutdatedInstance rem iworld = updateOutdatedInstanceIndex (filter ((<>) rem)) iworld nextOutdatedInstance :: !*IWorld -> (!Maybe InstanceNo,!*IWorld) nextOutdatedInstance iworld # (index,iworld) = loadValue NS_TASK_INSTANCES OUTDATED_INDEX iworld = case index of Just [next:_] = (Just next,iworld) _ = (Nothing,iworld) addShareRegistration :: !BasicShareId !InstanceNo !*IWorld -> *IWorld addShareRegistration shareId instanceNo iworld # (mbRegs,iworld) = loadValue NS_TASK_INSTANCES SHARE_REGISTRATIONS iworld # regs = fromMaybe newMap mbRegs # sregs = fromMaybe [] (get shareId regs) # regs = put shareId (removeDup (sregs ++ [instanceNo])) regs = storeValue NS_TASK_INSTANCES SHARE_REGISTRATIONS regs iworld clearShareRegistrations :: !InstanceNo !*IWorld -> *IWorld clearShareRegistrations instanceNo iworld # (mbRegs,iworld) = loadValue NS_TASK_INSTANCES SHARE_REGISTRATIONS iworld # regs = maybe newMap (fromList o clear instanceNo o toList) mbRegs = storeValue NS_TASK_INSTANCES SHARE_REGISTRATIONS regs iworld where clear :: InstanceNo [(BasicShareId,[InstanceNo])] -> [(BasicShareId,[InstanceNo])] clear no regs = [(shareId,removeMember no insts) \\ (shareId,insts) <- regs] addOutdatedOnShareChange :: !BasicShareId !*IWorld -> *IWorld addOutdatedOnShareChange shareId iworld # (mbRegs,iworld) = loadValue NS_TASK_INSTANCES SHARE_REGISTRATIONS iworld # regs = fromMaybe newMap mbRegs = case get shareId regs of Just outdated=:[_:_] # iworld = addOutdatedInstances outdated iworld # regs = del shareId regs = storeValue NS_TASK_INSTANCES SHARE_REGISTRATIONS regs iworld _ = iworld storeCurUI :: !SessionId !Int !UIDef !*IWorld -> *IWorld storeCurUI sid version def iworld=:{IWorld|uis} = {IWorld|iworld & uis = put sid (version,def) uis} loadPrevUI :: !SessionId !Int !*IWorld -> (!Maybe UIDef, !*IWorld) loadPrevUI sid version iworld=:{IWorld|uis} = case get sid uis of Just (prev,def) | version == (prev + 1) = (Just def, iworld) _ = (Nothing, iworld) saveUICache :: !*IWorld -> *IWorld saveUICache iworld=:{IWorld|uis} = storeValue NS_TASK_INSTANCES "ui-cache" uis iworld restoreUICache :: !*IWorld -> *IWorld restoreUICache iworld # (mbUis,iworld) = loadValue NS_TASK_INSTANCES "ui-cache" iworld = case mbUis of Just uis = {IWorld|iworld & uis = uis} _ = iworld updateSessionInstanceIndex :: !((Map SessionId InstanceNo)-> (Map SessionId InstanceNo)) !*IWorld -> *IWorld updateSessionInstanceIndex f iworld=:{sessions} = {IWorld|iworld & sessions = f sessions} updatePersistentInstanceIndex :: !([TaskListItem Void] -> [TaskListItem Void]) !*IWorld -> *IWorld updatePersistentInstanceIndex f iworld # (index,iworld) = loadValue NS_TASK_INSTANCES PERSISTENT_INDEX iworld # iworld = storeValue NS_TASK_INSTANCES PERSISTENT_INDEX (f (fromMaybe [] index)) iworld = iworld updateOutdatedInstanceIndex :: ([Int] -> [Int]) !*IWorld -> *IWorld updateOutdatedInstanceIndex f iworld # (index,iworld) = loadValue NS_TASK_INSTANCES OUTDATED_INDEX iworld # iworld = storeValue NS_TASK_INSTANCES OUTDATED_INDEX (sortBy (>) (removeDup (f (fromMaybe [] index)))) iworld = iworld