Commit 5a9e71fe authored by Rinus Plasmeijer's avatar Rinus Plasmeijer

polished code, added lots of consistence test

to do: type check all legal combinations of workflows one can dynamically define...

git-svn-id: https://svn.cs.ru.nl/repos/iTask-system/trunk@791 63da3aa8-80fd-4f01-9db8-e6ea747a3da2
parent 48273920
......@@ -5,77 +5,53 @@ from StdFunc import o
from EstherBackend import toStringDynamic
from StdMisc import abort
derive gPrint DynFormFlow, DynForm, DynFlow, FormType, FlowType, AssignInfo, DynFormFlowStore, Elem
derive gParse DynFormFlow, DynForm, DynFlow, FormType, FlowType, AssignInfo, DynFormFlowStore, Elem
derive gUpdate DynFormFlow, DynForm, DynFlow, FormType, FlowType, AssignInfo, DynFormFlowStore, Elem
derive gVisualize DynFormFlow, DynForm, DynFlow, FormType, FlowType, AssignInfo, DynFormFlowStore
derive gPrint Form, Flow, FormShape, FlowShape, AssignInfo, FormStore, FlowStore, Tup
derive gParse Form, Flow, FormShape, FlowShape, AssignInfo, FormStore, FlowStore, Tup
derive gUpdate Form, Flow, FormShape, FlowShape, AssignInfo, FormStore, FlowStore, Tup
derive gVisualize Form, Flow, FormShape, FlowShape, AssignInfo, FormStore, FlowStore
derive bimap Maybe, (,)
Start :: *World -> *World
Start w = startEngine dynFormEditor w
dynFormEditor :: [Workflow]
dynFormEditor
= [ { Workflow
| name = "Interactive Workflows / 1. FORM Editor"
, label = "FORM Editor"
, roles = []
, mainTask = loopFORM Nothing
}
,{ Workflow
| name = "Interactive Workflows / 2. FLOW Editor"
, label = "FLOW Editor"
, roles = []
, mainTask = loopFLOW Nothing
}
,{ Workflow
| name = "Interactive Workflows / 3. Show Definitions"
, label = "Show All Defintions"
, roles = []
, mainTask = showAll
}
,{ Workflow
| name = "Interactive Workflows / 4. Run FLOW"
, label = "Run Flow"
, roles = []
, mainTask = loopStart
}
]
Start w = startEngine dynEditor w
:: T a b = T !a & iTask b
:: T2 a b c = T2 !a & iTask b & iTask c
dynEditor :: [Workflow]
dynEditor
= [ workflow "Interactive Workflows/1. FORM Editor" noForm
, workflow "Interactive Workflows/2. FLOW Editor" noFlow
, workflow "Interactive Workflows/3. Show Definitions" showAll
, workflow "Interactive Workflows/4. Run FLOW" loopStart
]
:: T a b = T !a & iTask b
//:: T2 a b c = T2 !a & iTask b & iTask c
:: DynFormFlow = Form DynForm
| Flow DynFlow
| NoDynFormFlow
:: DynForm = { formType :: ![FormType]
, dynForm :: !Dynamic
:: Form = { formShape :: ![FormShape]
, formDyn :: !Dynamic
}
:: DynFlow = { flowType :: ![FlowType]
, dynFlow :: !Dynamic
:: Flow = { flowShape :: ![FlowShape]
, flowDyn :: !Dynamic
}
:: FormType = Integer
:: FormShape = Integer
| Real
| String
| Bool
| Tuple !(!FormType, !FormType)
| List !FormType
| Hide !FormType
| Option !FormType
| Labeled !(!String, !FormType)
| Tuple !(!FormShape, !FormShape)
| List !FormShape
| Hide !FormShape
| Option !FormShape
| Labeled !(!String, !FormShape)
| Notes
| Date
| Time
| Document
| GoogleMap
:: FlowType = Editor !String
:: FlowShape = Editor !String
| DisplayIt !String
| Return
| Assign !AssignInfo ![FlowType]
| Or !([FlowType], ![FlowType])
| And !([FlowType], ![FlowType])
| Assign !AssignInfo ![FlowShape]
| Or !([FlowShape], ![FlowShape])
| And !([FlowShape], ![FlowShape])
| FormFromStore !String
| FlowFromStore !String
| First
......@@ -83,133 +59,163 @@ dynFormEditor
:: AssignInfo = { idOfUser :: !Int
, taskName :: !String
}
:: DynFormFlowStore
= { dynFormFlowName :: !String
, dynFormFlowType :: !String
, dynFormFlow :: !DynFormFlow
, formDBRef :: !DBRef !DynFormFlowStore
:: FormStore = { formName :: !String
, formType :: !String
, form :: !Form
, formDBRef :: !DBRef !FormStore
}
emptyForm = { formType = []
, dynForm = dynamic T "Dynamic Form not defined!" :: T String String
:: FlowStore = { flowName :: !String
, flowType :: !String
, flow :: !Flow
, flowDBRef :: !DBRef !FlowStore
}
emptyForm = { formShape = []
, formDyn = dynamic T Void :: T Void Void
}
emptyFlow = { flowType = []
, dynFlow = dynamic T "Dynamic Flow not defined!" :: T String String
emptyFlow = { flowShape = []
, flowDyn = dynamic T Void :: T Void Void
}
// ------------
undef = undef
FormTypeNew :== "Form Type / New"
FormTypeEdit :== "Form Type / Edit"
FormNew :== "Form / New"
FormEdit :== "Form / Edit"
DynFormFlowRead :== "DynFormFlow / Read"
DynFormFlowStore :== "DynFormFlow / Store"
FlowNew :== "Flow Type / New"
FlowEdit :== "Flow Type / Edit"
FlowStart :== "Flow / Start"
Exit :== "Exit"
New :== ActionLabel "New"
Exit :== ActionLabel "Exit"
Read :== ActionLabel "Read"
ReadForm :== ActionLabel "Read Form"
ReadShape :== ActionLabel "Read Shape"
Store :== ActionLabel "Store"
StartFlow :== ActionLabel "Start Flow"
Check :== ActionLabel "Type Check"
Refresh :== ActionLabel "Refresh"
// 1. FORM Editor
loopFORM :: (Maybe DynForm) -> Task Void
loopFORM Nothing
= enterChoice "Welcome to the FORM Editor, make a choice ..." [FormTypeNew, DynFormFlowRead, Exit]
>>= \choice -> case choice of
FormTypeNew -> editFormTypes emptyForm >>= loopFORM
DynFormFlowRead -> readForm >>= loopFORM
_ -> return Void
loopFORM (Just form)
= enterChoice "FORM Editor, make a choice ..." [FormTypeNew, FormTypeEdit, FormNew, FormEdit
,DynFormFlowRead, DynFormFlowStore, Exit]
>>= \choice -> case choice of
FormTypeNew -> editFormTypes emptyForm >>= loopFORM
FormTypeEdit -> editFormTypes form >>= loopFORM
FormNew -> makeForm form >>= loopFORM
FormEdit -> editForm form >>= loopFORM
DynFormFlowRead -> readForm >>= loopFORM
DynFormFlowStore-> storeForm form >>| loopFORM (Just form)
_ -> return Void
noForm :: Task !Void
noForm
= showMessageA "FORM Editor, Welcome..." [New, ReadShape, ReadForm, Exit]
>>= \choice -> case choice of
New -> newFormName emptyForm >>= editFormShape
ReadForm -> readForm >>= editForm
ReadShape -> readForm >>= editFormShape
Exit -> return Void
editFormShape :: !(!String, !Form) -> Task Void
editFormShape (name, form)
= updateInformationA ("FORM SHAPE Editor of form *" +++ name +++ "* :") form.formShape [New, ReadShape, Exit] [ActionNext]
>>= \(choice,formShape) ->
case choice of
ActionNext -> shapeToForm formShape
>>= \formDyn -> editForm (name, {formShape = formShape, formDyn = formDyn})
New -> newFormName emptyForm >>= editFormShape
ReadShape -> readForm >>= editFormShape
_ -> return Void
editForm :: !(!String, !Form) -> Task Void
editForm (name,form=:{formDyn = (T v :: T a a)})
= updateInformationA ("FORM Editor of form *" +++ name +++ "* :") v [ActionPrevious] [New, ReadForm, Store, Exit]
>>= editForm2
where
editForm2 :: (Action,a) -> Task Void | iTask a
editForm2 (choice,nv)
# form2 = {form & formDyn = dynamic T nv :: T a^ a^}
= case choice of
ActionPrevious -> editFormShape (name, form)
New -> newFormName emptyForm >>= editForm
ReadForm -> readForm >>= editForm
Store -> storeForm (name,form2) >>= editForm
_ -> return Void
// 2. FLOW Editor
loopFLOW :: (Maybe DynFlow) -> Task Void
loopFLOW Nothing
= enterChoice "Welcome to the FLOW Editor, make a choice ..." [FlowNew, DynFormFlowRead, Exit]
>>= \choice -> case choice of
FlowNew -> makeFlow emptyFlow >>= loopFLOW o Just
DynFormFlowRead -> readFlow >>= loopFLOW
noFlow :: Task Void
noFlow
= showMessageA "FLOW Editor, Welcome..." [New, Read, Exit]
>>= \choice -> case choice of
New -> newFlowName emptyFlow >>= editFlowShape
Read -> readFlow >>= editFlowShape
_ -> return Void
editFlowShape :: !(!String, !Flow) -> Task Void
editFlowShape (name, flow)
= updateInformationA ("FLOW Editor of flow *" +++ name +++ "* :") flow.flowShape [New, Exit, Read] [Check, ActionNext]
>>= \(choice,flowShape) ->
case choice of
New -> newFlowName emptyFlow >>= editFlowShape
Read -> readFlow >>= editFlowShape
Check -> try (checkIt flowShape) (errorRaised flowShape) >>= \flow -> editFlowShape (name, flow)
ActionNext -> try (checkIt flowShape >>= \flow -> finalizeFlow (name,flow))
(\s -> errorRaised flowShape s >>= \flow -> editFlowShape (name, flow))
_ -> return Void
_ -> return Void
loopFLOW (Just flow)
= enterChoice "FORM Editor, make a choice ..." [FlowNew, FlowEdit
,DynFormFlowRead, DynFormFlowStore, Exit]
>>= \choice -> case choice of
FlowNew -> makeFlow emptyFlow >>= loopFLOW o Just
FlowEdit -> makeFlow flow >>= loopFLOW o Just
DynFormFlowRead -> readFlow >>= loopFLOW
DynFormFlowStore-> storeFlow flow >>| loopFLOW (Just flow)
where
checkIt :: ![FlowShape] -> Task Flow
checkIt flowShape
= checkFlows flowShape
>>= \flowDyn -> if (validType flowDyn)
(return {flowShape = flowShape, flowDyn = flowDyn})
(throw (dynErrorMess "Type is not a task !, " flowDyn))
>>| return {flowShape = flowShape, flowDyn = flowDyn}
validType :: Dynamic -> Bool
validType (T x :: T (Task a) a) = True
validType (T x :: T (a -> Task a) a) = True
validType (T x :: T (a -> Task b) (a,b)) = True
validType (f :: A.a: a -> Task a | iTask a) = True
validType d = False
errorRaised :: [FlowShape] String -> Task Flow
errorRaised flowShape s
= showMessage ("Type Error: " +++ s) >>| return {flow & flowShape = flowShape}
finalizeFlow :: !(!String, !Flow) -> Task Void
finalizeFlow (name, flow)
= showMessageA ("You may now store flow *" +++ name +++ "* :: " +++ showDynType flow.flowDyn) [ActionPrevious, Store, Exit]
>>= \(choice) ->
case choice of
// New -> newFlowName emptyFlow >>= editFlowShape
// Read -> readFlow >>= editFlowShape
ActionPrevious -> editFlowShape (name, flow)
Store -> storeFlow (name, flow) >>= editFlowShape
_ -> return Void
_ -> return Void
// ------------
loopStart :: Task Void
loopStart
= enterChoice "Run a stored flow, make a choice ..." [FlowStart, Exit]
>>= \choice -> case choice of
FlowStart -> startFlow >>| loopStart
Exit -> return Void
= enterInformationA "Press start to run a stored workflow..." [] [StartFlow, Exit]
>>= \(choice,Void) ->
case choice of
StartFlow -> startFlow >>| loopStart
Exit -> return Void
// ------------
editFormTypes :: DynForm -> Task (Maybe DynForm)
editFormTypes form
= updateInformation "Construct the shape of the form:" form.formType
>>= \formType -> case formType of
[] -> return Nothing
_ -> makeDynForm formType
>>= \dynForm -> editForm {formType = formType, dynForm = dynForm}
makeForm :: DynForm -> Task (Maybe DynForm)
makeForm form
= makeDynForm form.formType
>>= \dynForm -> editForm {form & dynForm = dynForm}
editForm :: DynForm -> Task (Maybe DynForm)
editForm form=:{dynForm = (T v :: T a a)}
= updateInformation "Set default values ..." v
>>= returnShow form.dynForm
startFlow :: Task Void
startFlow
= getCurrentUser
>>= \me -> readFlow
>>= \(_,flowDyn) -> evalFlow me flowDyn.flowDyn
where
returnShow :: Dynamic a -> Task (Maybe DynForm) | iTask a
returnShow d=:(T v :: T a^ b) nv = return (Just {form & dynForm = dynamic T nv :: T a^ a^})
returnShow _ nv = return Nothing
editForm form = return Nothing
evalFlow me (T t:: T (Task a) a) = spawnProcess me.userId True (t <<@ "dynamic flow")>>| return Void
evalFlow me (T v:: T a b) = showMessage (showDynValType "Result" (dynamic v :: a))
// evalFlow me (T2 v:: T2 a b c) = showMessage (showDynValType "Result" (dynamic v :: a))
evalFlow me d = showMessage (dynErrorMess "Eval" d)
// ------------
makeDynForm :: [FormType] -> Task Dynamic
makeDynForm bs = convertFormTypes bs >>= return o tupling
shapeToForm :: [FormShape] -> Task Dynamic
shapeToForm bs = convertFormShapes bs >>= return o tupling
where
tupling [] = dynamic T Void :: T Void Void
tupling [d] = d
tupling [d:ds] = case (d, tupling ds) of
(T d1 :: T a a, T d2 :: T b b) -> dynamic T (Elem d1 d2) :: T (Elem a b) (Elem a b)
_ -> abort "Fatal Error in makeDynForm !!!"
(T d1 :: T a a, T d2 :: T b b) -> dynamic T (Tup d1 d2) :: T (Tup a b) (Tup a b)
_ -> abort "Fatal Error in shapeToForm !!!"
convertFormTypes :: [FormType] -> Task [Dynamic]
convertFormTypes [] = return []
convertFormTypes [b:bs] = convert b >>= \d -> convertFormTypes bs >>= \ds -> return [d:ds]
convertFormShapes :: [FormShape] -> Task [Dynamic]
convertFormShapes [] = return []
convertFormShapes [b:bs] = convert b >>= \d -> convertFormShapes bs >>= \ds -> return [d:ds]
where
convert :: FormType -> Task Dynamic
convert :: FormShape -> Task Dynamic
convert Integer = getDefaultValue >>= \v -> return (dynamic T v :: T Int Int)
convert Real = getDefaultValue >>= \v -> return (dynamic T v :: T Real Real)
convert String = getDefaultValue >>= \v -> return (dynamic T v :: T String String)
......@@ -217,7 +223,8 @@ where
convert (Tuple (b1, b2)) = convert b1 >>= \db1 -> convert b2 >>= \db2 -> returnTuple db1 db2
where
returnTuple (T t1 :: T a a) (T t2 :: T b b)
= return (dynamic T2 (t1,t2) :: (T2 (a,b) a b))
= return (dynamic T (t1,t2) :: (T (a,b)(a,b)))
// = return (dynamic T2 (t1,t2) :: (T2 (a,b) a b))
convert (List b) = convert b >>= \dl -> returnList dl
where
returnList (T v :: T a a) = return (dynamic T [] :: T [a] [a])
......@@ -240,118 +247,30 @@ where
// ------------
instance DB DynFormFlowStore where
databaseId :: DBid [DynFormFlowStore]
databaseId = mkDBid "FormStore"
getItemId :: DynFormFlowStore -> DBRef DynFormFlowStore
getItemId a = a.formDBRef
setItemId :: (DBRef DynFormFlowStore) DynFormFlowStore -> DynFormFlowStore
setItemId dbref a = {a & formDBRef = dbref}
storeForm :: DynForm -> Task Void
storeForm dynForm = storeFormFlow (Form dynForm)
storeFlow :: DynFlow -> Task Void
storeFlow dynFlow = storeFormFlow (Flow dynFlow)
storeFormFlow :: DynFormFlow -> Task Void
storeFormFlow dynFormFlow
= enterInformation "Define name to store:"
>>= \extname -> dbReadAll
>>= \all -> if (isMember extname [this.dynFormFlowName \\ this <- all])
( requestConfirmation ("Name already exists, do you want to overwrite?")
>>= \ok -> if ok (updateItem all extname) (storeFormFlow dynFormFlow)
)
(storeItem extname)
where
showDynType2 (T x :: T a b) = showDynType (dynamic undef :: a)
showDynType2 (x :: a) = showDynType (dynamic undef :: a)
type = case dynFormFlow of
(Form dynForm) = showDynType dynForm.dynForm
(Flow dynFlow) = showDynType dynFlow.dynFlow
_ = "Error, Unknown Type !"
updateItem all name
= return (hd [this \\ this <- all | this.dynFormFlowName == name])
>>= \oform -> dbUpdateItem {oform & dynFormFlowName = name, dynFormFlowType = type, dynFormFlow = dynFormFlow}
>>| return Void
storeItem name
= dbCreateItem
>>= \oform -> dbUpdateItem {oform & dynFormFlowName = name, dynFormFlowType = type, dynFormFlow = dynFormFlow}
>>| return Void
readForm :: Task (Maybe DynForm)
readForm
= readstoreForm (\this -> case this.dynFormFlow of
(Form _) -> True
else -> False)
>>= \found -> case found of
(Form dynForm) -> return (Just dynForm)
_ -> return Nothing
readFlow :: Task (Maybe DynFlow)
readFlow
= readstoreForm (\this -> case this.dynFormFlow of
(Flow _) -> True
else -> False)
>>= \found -> case found of
(Flow dynFlow) -> return (Just dynFlow)
_ -> return Nothing
readstoreForm :: (DynFormFlowStore -> Bool) -> Task DynFormFlow
readstoreForm pred
= readAll
>>= \all -> let names = [showName this \\ this <- all | pred this] in
case names of
[] -> updateInformation "No definitions stored !" Void
>>| return NoDynFormFlow
names -> enterChoice "Choose definition you want to use:" names
>>= \choice -> return (hd [this.dynFormFlow \\ this <- all | showName this == choice])
where
showName this = this.dynFormFlowName +++ " :: " +++ this.dynFormFlowType
readAll :: Task [DynFormFlowStore]
readAll = dbReadAll
showAll :: Task Void
showAll
= readAll
>>= \all -> case all of
[] -> showMessage "There are no definitions stored yet."
all -> showMessageAbout "The following definitions have been stored:" all
= readAllForms
>>= \allForms -> readAllFlows
>>= \allFlows -> showMessageAboutA "Stored definitions:" (myForm allForms ++ myFlows allFlows) [Refresh, Exit]
>>= \choice -> case choice of
Refresh -> showAll
_ -> return Void
where
readAll :: Task [DynFormFlowStore]
readAll = dbReadAll
myForm allForms = ["Stored Forms:", "" : [form.formName +++ " :: " +++ form.formType \\ form <- allForms]]
myFlows allFlows = ["Stored Workflows:", "" : [flow.flowName +++ " :: " +++ flow.flowType \\ flow <- allFlows]]
// ------------
makeFlow :: DynFlow -> Task DynFlow
makeFlow flow
= updateInformation "Construct a flow:" flow.flowType
>>= \flowType -> try (checkIt flowType) (errorRaised flowType)
where
checkIt flowType
= checkFlows flowType
>>= \dynFlow -> showMessage ("Deduced type: " +++ showDynType dynFlow)
>>| return {flowType = flowType, dynFlow = dynFlow}
errorRaised :: [FlowType] String -> Task DynFlow
errorRaised flowType s
= showMessage s >>| return {flow & flowType = flowType}
checkFlows :: [FlowType] -> Task Dynamic
checkFlows :: [FlowShape] -> Task Dynamic
checkFlows [] = throw "Cannot apply empty flow."
checkFlows flows = mapMonad translate flows >>= \dyns -> return (applyFlows (hd dyns) (tl dyns))
where
mapMonad :: (!FlowType -> Task Dynamic) [FlowType] -> Task [Dynamic] // leaving out the type crashes the compiler !!!
mapMonad :: (!FlowShape -> Task Dynamic) [FlowShape] -> Task [Dynamic] // leaving out the type crashes the compiler !!!
mapMonad fun [] = return []
mapMonad fun [d:ds] = fun d >>= \nd -> mapMonad fun ds >>= \nds -> return [nd:nds]
translate :: !FlowType -> Task Dynamic
translate :: !FlowShape -> Task Dynamic
translate (Editor prompt) = return (dynamic (edit prompt):: A.a: a -> Task a | iTask a)
where
edit :: !String a -> Task a | iTask a
......@@ -402,74 +321,147 @@ where
findValue :: String -> Task Dynamic
findValue name
= dbReadAll
>>= \all -> examine [this \\ this <- all | this.dynFormFlowName == name]
= readAllForms
>>= \all -> examine [this.form.formDyn \\ this <- all | this.formName == name]
where
examine [] = throw ("Cannot find form value with name " +++ name)
examine [f:fs] = case f.dynFormFlow of
(Form form) = return form.dynForm
_ = throw ("Type Error: Value expected, flow found named " +++ name)
examine [] = throw ("Cannot find Form with name " +++ name)
examine [form =: (T v :: T a a) :_] = return (dynamic T (return v) :: T (Task a) a ) // turn value into task as well
examine [form:_] = throw (dynErrorMess "Form has ilegal type:" form )
findFlow :: String -> Task Dynamic
findFlow name
= dbReadAll
>>= \all -> examine [this \\ this <- all | this.dynFormFlowName == name]
= readAllFlows
>>= \all -> examine [this.flow \\ this <- all | this.flowName == name]
where
examine [] = throw ("Cannot find form value with name " +++ name)
examine [f:fs] = case f.dynFormFlow of
(Flow form) = return form.dynFlow
_ = throw ("Type Error: Value expected, flow found named " +++ name)
examine [] = throw ("Cannot find Flow with name " +++ name)
examine [flow:_] = return flow.flowDyn
applyFlows :: Dynamic [Dynamic] -> Dynamic
applyFlows dyn [] = dyn
applyFlows (T v :: T a a) [edit :: A.b: b -> Task b | iTask b : dyns] // edit value
= applyFlows (dynamic T (edit v) :: T (Task a) a) dyns
applyFlows (T t :: T (Task a) a) [(btb :: A.b: b -> Task b | iTask b ): dyns] // >>=
applyFlows (T t :: T (Task a) a) [(btb :: A.b: b -> Task b | iTask b ): dyns] // ta >>= edit
= applyFlows (dynamic T (t >>= btb) :: T (Task<