implementation module FormFlowStorage import iTasks from StdFunc import o import FormData, FlowData, TaskContainer derive class iTask FormStore, FlowStore derive bimap Maybe, (,) :: FormStore = { formName :: !String , formType :: !String , form :: !Form , formDBRef :: !DBRef FormStore } :: FlowStore = { flowName :: !String , flowType :: !String , flow :: !Flow , flowDBRef :: !DBRef FlowStore } // ************************************************* instance DB FormStore where databaseId :: DBId [FormStore] databaseId = mkDBId "FormStore" getItemId :: FormStore -> DBRef FormStore getItemId a = a.formDBRef setItemId :: (DBRef FormStore) FormStore -> FormStore setItemId dbref a = {a & formDBRef = dbref} instance DB FlowStore where databaseId :: DBId [FlowStore] databaseId = mkDBId "FlowStore" getItemId :: FlowStore -> DBRef FlowStore getItemId a = a.flowDBRef setItemId :: (DBRef FlowStore) FlowStore -> FlowStore setItemId dbref a = {a & flowDBRef = dbref} readAllForms :: Task [FormStore] readAllForms = dbReadAll readAllFlows :: Task [FlowStore] readAllFlows = dbReadAll newFormName :: !Form -> Task (!String, !Form) newFormName form = enterInformation "New form" "Give name of new Form:" >>= \name -> readAllForms >>= \allForms -> case [this \\ this <- allForms | this.formName == name] of [] -> getDefaultValue >>= \item -> dbCreateItem {item & form = form, formType = showDynType form.formDyn, formName = name} >>| return (name,form) found -> requestConfirmation "Form exists" ("Name already exists, do you want to overwrite" +++ (hd found).formType) >>= \ok -> if ok (return (name,form)) (newFormName form) newFlowName :: !Flow -> Task (!String, !Flow) newFlowName flow = enterInformation "New flow" "Give name of new flow:" >>= \name -> readAllFlows >>= \allFlows -> case [this \\ this <- allFlows | this.flowName == name] of [] -> getDefaultValue >>= \item -> dbCreateItem {item & flow = flow, flowType = showDynType flow.flowDyn, flowName = name} >>| return (name,flow) found -> requestConfirmation "Flow exists" ("Name already exists, do you want to overwrite" +++ (hd found).flowType ) >>= \ok -> if ok (return (name,flow)) (newFlowName flow) chooseForm :: Task (!String, !Form) chooseForm = readAllForms >>= \all -> let names = [showName this \\ this <- all] in case names of [] -> updateInformation "No forms" "No Forms stored !" Void >>| return ("", emptyForm) names -> enterChoice "Choose form" "Choose Form you want to use:" names >>= \choice -> return (hd [(this.formName, this.form) \\ this <- all | showName this == choice]) where showName this = this.formName +++ " :: " +++ this.formType chooseFlow :: Task (!String, !Flow) chooseFlow = readAllFlows >>= \all -> let names = [showName this \\ this <- all] in case names of [] -> updateInformation "No flows" "No Flows stored !" Void >>| return ("", emptyFlow) names -> enterChoice "Choose flow" "Choose Flow you want to use:" names >>= \choice -> return (hd [(this.flowName, this.flow) \\ this <- all | showName this == choice]) where showName this = this.flowName +++ " :: " +++ this.flowType newName fun f = enterInformation "New name" "Type in another name " >>= \name -> fun (name, f) storeForm :: !(String, !Form) -> Task (!String, !Form) // item assumed to be in store storeForm (name, form) = readAllForms >>= \all -> return (hd [this \\ this <- all | this.formName == name]) >>= \formStore -> dbUpdateItem {formStore & formType = showDynType form.formDyn, form = form} >>| return (name,form) storeFlow :: !(String, !Flow) -> Task (!String, !Flow) // item assumed to be in store storeFlow (name, flow) = readAllFlows >>= \all -> return (hd [this \\ this <- all | this.flowName == name]) >>= \flowStore -> dbUpdateItem {flowStore & flowName = name, flowType = showDynType flow.flowDyn, flow = flow} >>| return (name,flow) findValue :: String -> Task Dynamic findValue name = readAllForms >>= \all -> examine [this.form.formDyn \\ this <- all | this.formName == name] where examine [] = throw ("Cannot find Form with name " +++ name) examine [form =: (DV0 v :: DV0 a) :_] = return (dynamic DT (return v) :: DT a) // turn value into task as well examine [form:_] = throw (typeErrorMess "Form has ilegal type:" form ) findFlow :: String -> Task Dynamic findFlow name = readAllFlows >>= \all -> examine [this.flow \\ this <- all | this.flowName == name] where examine [] = throw ("Cannot find Flow with name " +++ name) examine [flow:_] = return flow.flowDyn