|
definition:
|
editForm :: String -> Entity -> [Relationship] -> [Entity] -> CFuncDecl
editForm erdname entity@(Entity entityName attrlist) relationships allEntities =
cmtfunc ("A WUI form to edit a " ++ entityName ++ " entity.\n" ++
"The default values for the fields are stored in '" ++
snd (controllerStoreName entityName "edit") ++ "'.")
(controllerFormName entityName "edit") 0
Public
(emptyClassType $ applyTC (htmlModule "HtmlFormDef")
[editTupleType erdname entity relationships allEntities])
[simpleRule []
(applyF (wuiModule "pwui2FormDef")
[string2ac $ showQName $ controllerFormName entityName "edit",
constF (controllerStoreName entityName "edit"),
wuiFun, storeFun, renderFun])]
where
manyToManyEntities = manyToMany allEntities (Entity entityName attrlist)
manyToOneEntities = manyToOne (Entity entityName attrlist) relationships
arity1 = 2 + length manyToOneEntities * 2 + length manyToManyEntities
wuiFun =
let relatedVars vart = map (\ (name, varId) ->
vart (varId, "related" ++ name))
(zip manyToOneEntities [2..])
possibleVars vart =
map (\ ((ename,erel), varId) ->
vart (varId, "possible" ++ erel ++ ename ++ "s"))
(zip (map (\n -> (n,"")) manyToOneEntities ++ manyToManyEntities)
[2..])
in CLambda
[tuplePattern
([CPVar (1,"_"), CPVar (1, lowerFirst entityName)] ++
relatedVars CPVar ++ possibleVars CPVar)] $
applyF (viewModuleName entityName, "w" ++ entityName ++ "Type")
([cvar (lowerFirst entityName)] ++
relatedVars CVar ++ possibleVars CVar)
storeFun =
let evar = (1, lowerFirst entityName ++ "ToEdit")
entvar = (2, "entity")
in
CLambda [CPVar (0,"_"),
CPAs entvar
(tuplePattern
([CPVar evar] ++
map (\i -> CPVar (i+2,"_"))
[1 .. length manyToManyEntities]))]
(applyF checkAuthorizationFunc
[applyF (enauthModName,lowerFirst entityName ++ "OperationAllowed")
[applyF (authorizationModule,"UpdateEntity") [CVar evar]],
CLambda [CPVar (0,"_")]
(applyF (spiceyModule,"transactionController")
[applyF (model erdname,"runT")
[applyF (transFunctionName entityName "update")
[CVar entvar]],
applyF (pre "const")
[doExpr
[CSExpr $ applyF (spiceyModule,"setPageMessage")
[string2ac $ entityName ++ " updated"],
CSExpr $ applyF (spiceyModule,"nextInProcessOr")
[applyF (spiceyModule,"redirectController")
[applyF (spiceyModule,"showRoute") [CVar evar]],
constF (pre "Nothing")]]]])])
renderFun =
CLambda [tuplePattern
(map CPVar (sinfovar : entvar :
map (\v -> (v,"_")) [3 .. arity1]))] $
applyF (spiceyModule,"renderWUI")
[CVar sinfovar,
string2ac $ "Edit " ++ entityName,
string2ac "Change",
applyF (spiceyModule,"listRoute") [CVar entvar],
constF (pre "()")
]
where sinfovar = (1, "sinfo")
entvar = (2, "entity")
|