|
definition:
|
newForm :: String -> Entity -> [Relationship] -> [Entity] -> CFuncDecl
newForm erdname entity@(Entity entityName attrlist) relationships allEntities =
cmtfunc ("A WUI form to create a new " ++ entityName ++ " entity.\n" ++
"The default values for the fields are stored in '" ++
snd (controllerStoreName entityName "new") ++ "'.")
(controllerFormName entityName "new") 0
Public
(emptyClassType $ applyTC (htmlModule "HtmlFormDef")
[newTupleType entity relationships allEntities])
[simpleRule []
(applyF (wuiModule "pwui2FormDef")
[string2ac $ showQName $ controllerFormName entityName "new",
constF (controllerStoreName entityName "new"),
wuiFun, storeFun, renderFun])]
where
manyToManyEntities = map (\ (ent,rel) -> rel ++ ent)
(manyToMany allEntities
(Entity entityName attrlist))
manyToOneEntities = manyToOne (Entity entityName attrlist) relationships
arity1 = 1 + length manyToOneEntities + length manyToManyEntities
listEntityURL = '?' : entityName ++ "/list"
wuiFun =
CLambda
[tuplePattern
([CPVar (1,"_")] ++
map (\ (name, varId) -> CPVar(varId,("possible"++name++"s")))
(zip (manyToOneEntities++manyToManyEntities) [2..]))] $
applyF (viewModuleName entityName, "w" ++ entityName)
(map (\ (name, varId) -> CVar(varId,("possible"++name++"s")))
(zip (manyToOneEntities ++ manyToManyEntities) [2..]) )
storeFun =
let entvar = (1, "entity")
newentvar = (2, "newentity")
in
CLambda [CPVar (0,"_"), CPVar entvar]
(applyF checkAuthorizationFunc
[applyF (enauthModName, lowerFirst entityName ++ "OperationAllowed")
[constF (authorizationModule,"NewEntity")],
CLambda [CPVar (0,"_")]
(applyF (spiceyModule,"transactionController")
[applyF (model erdname,"runT")
[applyF (transFunctionName entityName "create")
[CVar entvar]],
CLambda [CPVar newentvar]
(doExpr
[CSExpr $ applyF (spiceyModule,"setPageMessage")
[string2ac $ "New " ++ entityName ++ " created"],
CSExpr $ applyF (spiceyModule,"nextInProcessOr")
[applyF (spiceyModule,"redirectController")
[applyF (spiceyModule,"showRoute") [CVar newentvar]],
constF (pre "Nothing")]])])])
renderFun =
CLambda [tuplePattern
(map CPVar (sinfovar : map (\v -> (v,"_")) [2 .. arity1]))] $
letExpr
[CLocalPat
(CPVar entvar)
(simpleRhs (simpleTyped (constF (pre "failed"))
(baseType (model erdname, entityName))))]
(applyF (spiceyModule,"renderWUI")
[CVar sinfovar,
string2ac $ "Create new " ++ entityName,
string2ac "Create",
applyF (spiceyModule,"listRoute") [CVar entvar],
constF (pre "()")
])
where sinfovar = (1, "sinfo")
entvar = (2, "phantom")
|