|
definition:
|
generateStartpointDataForERD :: ERD -> CurryProg
generateStartpointDataForERD (ERD _ entities _) = simpleCurryProg
dataModuleName
[authenticationModule] -- imports
[
CType (dataModuleName, "ControllerReference") Public []
([simpleCCons (dataModuleName, "ProcessListController") Public [],
simpleCCons (dataModuleName, "LoginController") Public []] ++
map controllerReferencesForEntity entities) [],
urlMatchType,
routeType
] -- typedecls
[stCmtFunc
("This constant specifies the association of URLs to controllers.\n"++
"Controllers are identified here by constants of type\n"++
"ControllerReference. The actual mapping of these constants\n"++
"into the controller operations is specified in the module\n"++
"`Config.ControllerMapping`.")
(dataModuleName, "getRoutes")
0
Public
(ioType routeMappingType)
[simpleRule []
(CDoExpr
[CSPat (CPVar (1,"login"))
(constF (authenticationModule,"getSessionLogin")),
CSExpr $ applyF (pre "return")
[list2ac (
[tupleExpr
[string2ac "Processes",
applyF (dataModuleName, "Exact")
[string2ac "spiceyProcesses"],
constF (dataModuleName, "ProcessListController")]
] ++
concatMap startpointsForEntity entities ++
[tupleExpr
[applyF (pre "maybe")
[string2ac "Login",
applyF (pre "const") [string2ac "Logout"],
CVar (1,"login")],
applyF (dataModuleName, "Exact") [string2ac "login"],
constF (dataModuleName, "LoginController")],
tupleExpr
[string2ac "default",
constF (dataModuleName, "Always"),
constF (dataModuleName,
firstEntityName entities ++ "Controller")]
]
)
]
]
)]
] -- functions
[] -- opdecls
where
firstEntityName :: [Entity] -> String
firstEntityName ((Entity entityName _):_) = entityName
firstEntityName [] = error "RouteGeneration.firstEntityName: empty list arg"
route :: String -> String -> String -> String -> CExpr
route desc url uparam controllerDef =
tupleExpr [string2ac desc,
applyF (dataModuleName, "Prefix")
[string2ac url, string2ac uparam],
constF (dataModuleName, controllerDef)]
startpointsForEntity :: Entity -> [CExpr]
startpointsForEntity (Entity entityName _) =
map (\pre -> route (pre ++ " " ++ entityName)
entityName
(lowerFirst pre)
(entityName ++ "Controller"))
controllerPrefixes
urlMatchType :: CTypeDecl
urlMatchType =
CType (dataModuleName, "UrlMatch") Public [] [
simpleCCons (dataModuleName, "Exact") Public [stringType],
simpleCCons (dataModuleName, "Prefix") Public [stringType,stringType],
simpleCCons (dataModuleName, "Matcher") Public [stringType ~> boolType],
simpleCCons (dataModuleName, "Always") Public []
] []
routeMappingType :: CTypeExpr
routeMappingType = listType (baseType (dataModuleName,"Route"))
routeType :: CTypeDecl
routeType =
CTypeSyn (dataModuleName, "Route") Public []
(tupleType [stringType,
baseType (dataModuleName, "UrlMatch"),
baseType (dataModuleName, "ControllerReference")])
controllerReferencesForEntity :: Entity -> CConsDecl
controllerReferencesForEntity (Entity entityName _) =
simpleCCons (dataModuleName, entityName++"Controller") Public []
|