Commit b3978372 authored by Michael Hanus 's avatar Michael Hanus

Resource files restructured, redirection controllers added, type class for routing added

parent 4cb7d355
......@@ -22,7 +22,6 @@ import HTML.Session
import System.Processes
import System.Authentication
import View.SpiceySystem
import Controller.DefaultController
-----------------------------------------------------------------------------
--- Controller for login/logout.
......@@ -33,10 +32,8 @@ loginController = do
return [formExp loginFormDef]
loginFormDef :: HtmlFormDef (Maybe String)
loginFormDef =
formDefWithID "Controller.SpiceySystem.loginFormDef"
(getSessionData loginViewData Nothing)
(loginView defaultController)
loginFormDef = formDefWithID "Controller.SpiceySystem.loginFormDef"
(getSessionData loginViewData Nothing) loginView
--- The data processed by the login form.
loginViewData :: Global (SessionStore (Maybe String))
......
......@@ -15,9 +15,10 @@ module System.SessionInfo (
) where
import Global
import HTML.Session
import Config.Storage
import Config.Storage ( inDataDir )
--------------------------------------------------------------------------
--- The data associated to a user session.
......
......@@ -4,7 +4,9 @@
--------------------------------------------------------------------------
module System.Spicey (
Controller, EntityController(..), applyControllerOn,
Controller, EntityController(..), showRoute, editRoute, deleteRoute,
applyControllerOn,
redirectController,
nextController, nextControllerForData,
confirmDeletionPage,
transactionController,
......@@ -54,11 +56,29 @@ type ViewBlock = [HtmlExp]
--- Spicey.getControllerParams inside the controller.
type Controller = IO ViewBlock
--- The type class `EntityController` provides the application
--- of a controller to some entity identified by a key string.
--- The type class `EntityController` contains:
--- * the application of a controller to some entity identified by a key string
--- * an operation to construct a URL route for an entity w.r.t. to a route
--- string
class EntityController a where
controllerOnKey :: String -> (a -> Controller) -> Controller
entityRoute :: String -> a -> String
--- Returns the URL route to show a given entity.
showRoute :: EntityController a => a -> String
showRoute = entityRoute "show"
--- Returns the URL route to edit a given entity.
editRoute :: EntityController a => a -> String
editRoute = entityRoute "edit"
--- Returns the URL route to delete a given entity.
deleteRoute :: EntityController a => a -> String
deleteRoute = entityRoute "delete"
--- Reads an entity for a given key and applies a controller to it.
applyControllerOn :: Maybe enkey -> (enkey -> IO en)
......@@ -67,6 +87,11 @@ applyControllerOn Nothing _ _ = displayUrlError
applyControllerOn (Just userkey) getuser usercontroller =
getuser userkey >>= usercontroller
--- A controller to redirect to an URL starting with "?"
--- (see implementation of `getPage`).
redirectController :: String -> Controller
redirectController url = return [HtmlText url]
nextController :: Controller -> _ -> IO HtmlPage
nextController controller _ = do
view <- controller
......@@ -160,18 +185,18 @@ showControllerURL ctrlurl params = '?' : ctrlurl ++ concatMap ('/':) params
--- @param sinfo - the UserSessionInfo to select the language
--- @param title - the title of the WUI form
--- @param buttontag - the text on the submit button
--- @param cancelctrl - the controller called if submission is cancelled
--- @param cancelurl - the URL selected if submission is cancelled
--- @param envpar - environment parameters (e.g., user session data)
--- @param hexp - the HTML expression representing the WUI form
--- @param handler - the handler for submitting data
renderWUI :: UserSessionInfo -> String -> String -> Controller
renderWUI :: UserSessionInfo -> String -> String -> String
-> a -> HtmlExp -> (CgiEnv -> Controller) -> [HtmlExp]
renderWUI _ title buttontag cancelctrl _ hexp handler =
renderWUI _ title buttontag cancelurl _ hexp handler =
[h1 [htxt title],
hexp,
breakline,
primButton buttontag (\env -> handler env >>= getPage),
defaultButton "Cancel" (nextController (cancelOperation >> cancelctrl))]
hrefButton cancelurl [htxt "Cancel"]]
--- A WUI for manipulating CalendarTime entities.
......@@ -243,15 +268,14 @@ spiceyFooter =
[image "images/spicey-logo.png" "Spicey"]
`addAttr` ("target","_blank"),
htxt "Framework"]]
--- Transforms a view into an HTML form by adding the basic page layout.
--- If the view is an empty text or a text starting with "?",
--- generates a redirection page.
getPage :: ViewBlock -> IO HtmlPage
getPage viewblock = case viewblock of
[HtmlText ""] ->
return $ HtmlPage "forward to Spicey"
[pageMetaInfo [("http-equiv","refresh"),
("content","1; url=spicey.cgi")]]
[par [htxt "You will be forwarded..."]]
[HtmlText ""] -> return $ redirectPage "spicey.cgi"
[HtmlText ('?':route)] -> return $ redirectPage ('?':route)
_ -> do
routemenu <- getRouteMenu
msg <- getPageMessage
......@@ -361,7 +385,7 @@ spTable items = table items `addClass` "table table-hover table-condensed"
--- Definition of the session state to store the page message (a string).
pageMessage :: Global (SessionStore String)
pageMessage = global emptySessionStore Temporary
pageMessage = global emptySessionStore (Persistent (inDataDir "pageMessage"))
--- Gets the page message and delete it.
getPageMessage :: IO String
......@@ -380,7 +404,7 @@ setPageMessage msg = putSessionData pageMessage msg
--- Definition of the session state to store the last URL (as a string).
lastUrls :: Global (SessionStore [String])
lastUrls = global emptySessionStore Temporary
lastUrls = global emptySessionStore (Persistent (inDataDir "lastUrls"))
--- Gets the list of URLs of the current session.
getLastUrls :: IO [String]
......
......@@ -10,7 +10,7 @@ module View.SpiceySystem
where
import HTML.Base
import HTML.Styles.Bootstrap3 (defaultButton, primButton)
import HTML.Styles.Bootstrap3 (defaultButton, hrefButton, primButton)
import Config.UserProcesses
import System.Processes
......@@ -21,15 +21,15 @@ import System.Authentication
--- Generates a form for login/logout.
--- If the passed login name is the empty string,
--- we offer a login dialog, otherwise a logout dialog.
loginView :: Controller -> Maybe String -> [HtmlExp]
loginView controller currlogin =
loginView :: Maybe String -> [HtmlExp]
loginView currlogin =
case currlogin of
Nothing -> [h3 [htxt "Login as:"],
textField loginfield "",
defaultButton "Login" loginHandler]
Just _ -> [h3 [htxt "Really logout?"],
primButton "Logout" (logoutHandler True),
defaultButton "Cancel" (logoutHandler False)]
primButton "Logout" logoutHandler,
hrefButton "?" [htxt "Cancel"]]
where
loginfield free
......@@ -40,12 +40,11 @@ loginView controller currlogin =
then done
else do loginToSession loginname
setPageMessage ("Logged in as: "++loginname)
nextInProcessOr controller Nothing >>= getPage
nextInProcessOr (redirectController "?") Nothing >>= getPage
logoutHandler confirm _ = do
if confirm then logoutFromSession >> setPageMessage "Logged out"
else done
nextInProcessOr controller Nothing >>= getPage
logoutHandler _ = do
logoutFromSession >> setPageMessage "Logged out"
nextInProcessOr (redirectController "?") Nothing >>= getPage
-----------------------------------------------------------------------------
--- A view for all processes contained in a given process specification.
......
......@@ -33,14 +33,14 @@ generateControllersForEntity erdname allEntities
[ "Global", "Maybe", "Time"
, "HTML.Base", "HTML.Session", "HTML.WUI"
, erdname
, "Config.Storage" , "Config.UserProcesses"
, "Config.EntityRoutes", "Config.Storage" , "Config.UserProcesses"
, sessionInfoModule, authorizationModule, enauthModName, spiceyModule
, entitiesToHtmlModule erdname
, viewModuleName ename
]
Nothing -- defaultdecl
[] -- classdecls
[controllerInstDecl erdname entity] -- instdecls
[] -- instdecls
[newEntityType erdname entity relationships allEntities] -- typedecls
-- functions
(
......@@ -82,25 +82,6 @@ generateControllersForEntity erdname allEntities
[] -- opdecls
-- Generates the instance declaration for a controller.
controllerInstDecl :: String -> Entity -> CInstanceDecl
controllerInstDecl erdname (Entity entityName _) =
CInstance (spiceyModule,"EntityController")
(CContext [])
(baseType (erdname, entityName))
[cfunc (spiceyModule,"controllerOnKey") 1 Private
(CQualType (CContext [((spiceyModule,"EntityController"),tvara)])
(stringType ~> (tvara ~> controllerType) ~> controllerType))
[simpleRule [CPVar (2,"s")]
(applyF (spiceyModule,"applyControllerOn")
[readKey, getEntityOp])]]
where
tvara = CTVar (0,"a")
readKey = applyF (erdname, "read" ++ entityName ++ "Key") [CVar (2,"s")]
getEntityOp = applyF (pre ".")
[constF (erdname, "runJustT"),
constF (erdname, "get" ++ entityName)]
-- erdname: name of the entity-relationship-specification
-- entity: the entity to generate a controller for
type ControllerGenerator = String -> Entity -> [Relationship] -> [Entity]
......@@ -228,6 +209,7 @@ newForm erdname entity@(Entity entityName attrlist) relationships allEntities =
manyToManyEntities = manyToMany allEntities (Entity entityName attrlist)
manyToOneEntities = manyToOne (Entity entityName attrlist) relationships
arity1 = 1 + length manyToOneEntities + length manyToManyEntities
listEntityURL = '?' : entityName ++ "/list"
wuiFun =
CLambda
......@@ -252,7 +234,8 @@ newForm erdname entity@(Entity entityName attrlist) relationships allEntities =
[applyF (transFunctionName entityName "create")
[CVar entvar]],
applyF (spiceyModule,"nextInProcessOr")
[callEntityListController entityName,
[applyF (spiceyModule,"redirectController")
[string2ac listEntityURL],
constF (pre "Nothing")]])])
renderFun =
......@@ -262,7 +245,7 @@ newForm erdname entity@(Entity entityName attrlist) relationships allEntities =
[CVar sinfovar,
string2ac $ "Create new " ++ entityName,
string2ac "Create",
constF (controllerFunctionName entityName "list"),
string2ac listEntityURL,
constF (pre "()")
]
where sinfovar = (1, "sinfo")
......@@ -441,6 +424,7 @@ editForm erdname entity@(Entity entityName attrlist) relationships allEntities =
manyToManyEntities = manyToMany allEntities (Entity entityName attrlist)
manyToOneEntities = manyToOne (Entity entityName attrlist) relationships
arity1 = 2 + length manyToOneEntities * 2 + length manyToManyEntities
listEntityURL = '?' : entityName ++ "/list"
wuiFun =
CLambda
......@@ -476,7 +460,8 @@ editForm erdname entity@(Entity entityName attrlist) relationships allEntities =
[applyF (transFunctionName entityName "update")
[CVar entvar]],
applyF (spiceyModule,"nextInProcessOr")
[callEntityListController entityName,
[applyF (spiceyModule,"redirectController")
[string2ac listEntityURL],
constF (pre "Nothing")]])])
renderFun =
......@@ -486,7 +471,7 @@ editForm erdname entity@(Entity entityName attrlist) relationships allEntities =
[CVar sinfovar,
string2ac $ "Edit " ++ entityName,
string2ac "Change",
constF (controllerFunctionName entityName "list"),
string2ac listEntityURL,
constF (pre "()")
]
where sinfovar = (1, "sinfo")
......@@ -598,6 +583,7 @@ destroyController :: ControllerGenerator
destroyController erdname (Entity entityName _) _ _ =
let entlc = lowerFirst entityName -- entity name in lowercase
entvar = (0, entlc) -- entity parameter for controller
listEntityURL = '?' : entityName ++ "/list"
in
controllerFunction
("Deletes a given " ++ entityName ++ " entity\n" ++
......@@ -614,7 +600,8 @@ destroyController erdname (Entity entityName _) _ _ =
[applyF (erdname,"runT")
[applyF (transFunctionName entityName "delete")
[CVar entvar]],
constF (controllerFunctionName entityName "list")]])]
applyF (spiceyModule,"redirectController")
[string2ac listEntityURL]]])]
--- Generates a transaction to delete an entity.
deleteTransaction :: ControllerGenerator
......@@ -741,12 +728,6 @@ showController erdname (Entity entityName attrList) relationships allEntities =
)
]
-- Code to call the list controller of an entity where the current
-- URL parameters are passed to this list controller.
callEntityListController :: String -> CExpr
callEntityListController entityName =
constF (controllerFunctionName entityName "list")
manyToManyAddOrRemove :: String -> Entity -> [String] -> [Entity] -> [CFuncDecl]
manyToManyAddOrRemove erdname (Entity entityName _) entities allEntities =
(map (addOrRemoveFunction "add" "new" entityName) entities) ++
......@@ -938,25 +919,6 @@ relationshipsForEntityName ename rels = filter endsIn rels
where
endsIn (Relationship _ ends) = any (\ (REnd n _ _) -> ename == n) ends
------------------------------------------------------------------------
-- Generate the module defining the default controller.
generateDefaultController :: String -> [Entity] -> CurryProg
generateDefaultController _ (Entity ename _:_) = simpleCurryProg
defCtrlModName
[controllerModuleName ename, spiceyModule] -- imports
[] -- typedecls
-- functions
[stCmtFunc
"The default controller of the application."
(defCtrlModName,"defaultController")
1
Public
controllerType
[simpleRule []
(constF (controllerModuleName ename, "main"++ename++"Controller"))]
]
[] -- opdecls
------------------------------------------------------------------------
-- Auxiliaries:
......
{-# OPTIONS_CYMAKE -Wno-incomplete-patterns #-}
module Spicey.EntityRoutesGeneration where
import Char(toLower)
import AbstractCurry.Types
import AbstractCurry.Build
import Database.ERD
import Database.ERD.Goodies
import Spicey.GenerationHelper
-- "main"-function
generateRoutesForEntity :: String -> [Entity] -> CurryProg
generateRoutesForEntity erdname allEntities =
CurryProg
"Config.EntityRoutes"
-- imports:
[ "System.Spicey", erdname ]
Nothing -- defaultdecl
[] -- classdecls
(map (controllerInstDecl erdname) allEntities) -- instdecls
[] -- typedecls
-- functions
[]
[] -- opdecls
-- Generates the instance declaration for a controller.
controllerInstDecl :: String -> Entity -> CInstanceDecl
controllerInstDecl erdname (Entity entityName _) =
CInstance (spiceyModule,"EntityController")
(CContext [])
entityType
[stFunc (spiceyModule,"controllerOnKey") 1 Private
(stringType ~> (entityType ~> controllerType) ~> controllerType)
[simpleRule [CPVar (2,"s")]
(applyF (spiceyModule,"applyControllerOn")
[readKey, getEntityOp])],
stFunc (spiceyModule,"entityRoute") 2 Private
(stringType ~> entityType ~> stringType)
[simpleRule [CPVar rvar, CPVar entvar]
(applyF (pre "concat")
[list2ac
[string2ac $ '?' : entityName ++ "/",
CVar rvar,
string2ac "/",
applyF (erdname, "show" ++ entityName ++ "Key")
[CVar entvar]]])]]
where
entityType = baseType (erdname, entityName)
rvar = (1,"r")
entvar = (2,"ent")
readKey = applyF (erdname, "read" ++ entityName ++ "Key") [CVar (2,"s")]
getEntityOp = applyF (pre ".")
[constF (erdname, "runJustT"),
constF (erdname, "get" ++ entityName)]
------------------------------------------------------------------------
......@@ -74,7 +74,7 @@ mappingModuleName = "Config.ControllerMapping"
--- Name of EntitiesToHtml module.
entitiesToHtmlModule :: String -> String
entitiesToHtmlModule erdname = "View." ++ erdname ++ "EntitiesToHtml"
entitiesToHtmlModule erdname = "View.EntitiesToHtml"
bootstrapModule :: String
bootstrapModule = "HTML.Styles.Bootstrap3"
......
......@@ -18,6 +18,7 @@ import Database.ERD.Goodies
import Spicey.ControllerGeneration
import Spicey.EntitiesToHtmlGeneration
import Spicey.EntityRoutesGeneration
import Spicey.GenerationHelper
import Spicey.RouteGeneration
import Spicey.Transformation
......@@ -40,8 +41,8 @@ getEntities (ERD _ entities _) = entities
createViews :: String -> ERD -> String -> String -> IO ()
createViews _ (ERD name entities relationship) path _ =
mapIO_ (saveView name (getEntities erdt) (getRelationships erdt))
(filter (not . Spicey.GenerationHelper.isGenerated) (getEntities erdt))
mapM_ (saveView name (getEntities erdt) (getRelationships erdt))
(filter (not . Spicey.GenerationHelper.isGenerated) (getEntities erdt))
where
erdt = transform (ERD name entities relationship)
......@@ -52,13 +53,18 @@ createViews _ (ERD name entities relationship) path _ =
(showCProg (generateViewsForEntity erdname allEntities
(Entity ename attrlist) relationships))
createEntityRoutes :: String -> ERD -> String -> String -> IO ()
createEntityRoutes _ (ERD name entities _) path _ = do
putStrLn "Generating enitity routes 'Config.EntityRoutes.curry'..."
writeFile (path </> "EntityRoutes.curry")
(showCProg (generateRoutesForEntity name entities))
createControllers :: String -> ERD -> String -> String -> IO ()
createControllers _ (ERD name entities relationship) path _ = do
mapIO_ (saveController name (getEntities erdt) (getRelationships erdt))
(filter (not . Spicey.GenerationHelper.isGenerated) (getEntities erdt))
mapM_ (saveController name (getEntities erdt) (getRelationships erdt))
(filter (not . Spicey.GenerationHelper.isGenerated) (getEntities erdt))
putStrLn "Generating default controller authorization 'AuthorizedControllers.curry'..."
writeFile (path </> "DefaultController.curry")
(showCProg (generateDefaultController name entities))
where
erdt = transform (ERD name entities relationship)
......@@ -83,21 +89,20 @@ createHtmlHelpers _ (ERD name entities relationship) path _ =
saveToHtml :: String -> [Entity] -> [Relationship] -> IO ()
saveToHtml erdname allEntities relationships = do
putStrLn $ "Saving 'View."++entitiesToHtmlModule erdname++".curry'..."
fileh <- openFile (path </> erdname++"EntitiesToHtml.curry") WriteMode
putStrLn $ "Saving 'View." ++ entitiesToHtmlModule erdname ++ ".curry'..."
fileh <- openFile (path </> "EntitiesToHtml.curry") WriteMode
hPutStr fileh (showCProg (generateToHtml erdname allEntities relationships))
hClose fileh
-- Uses Curry's `ertools` for ERD to Curry transformation
-- Uses Curry package `ertools` for ERD to Curry transformation
createModels :: String -> ERD -> String -> String -> IO ()
createModels term_path erd path db_path = do
createModels termpath erd path dbpath = do
let erdname = erdName erd
dbfile = if null db_path then erdname ++ ".db"
else db_path
aterm_path <- getAbsolutePath term_path
dbfile = if null dbpath then erdname ++ ".db"
else dbpath
curdir <- getCurrentDirectory
setCurrentDirectory path
erd2cdbiWithDBandERD dbfile term_path
erd2cdbiWithDBandERD dbfile termpath
setCurrentDirectory curdir
createRoutes :: String -> ERD -> String -> String -> IO ()
......
......@@ -16,7 +16,7 @@ import Spicey.Scaffolding
systemBanner :: String
systemBanner =
let bannerText = "Spicey Web Framework (Version " ++ packageVersion ++
" of 21/10/19)"
" of 24/10/19)"
bannerLine = take (length bannerText) (repeat '-')
in bannerLine ++ "\n" ++ bannerText ++ "\n" ++ bannerLine
......@@ -46,12 +46,12 @@ spiceyStructure pkgname =
Directory "src" [
ResourceFile NoExec "Main.curry",
Directory "System" [
ResourceFile NoExec "Spicey.curry",
ResourceFile NoExec "Routes.curry",
ResourceFile NoExec "SessionInfo.curry",
ResourceFile NoExec "Authorization.curry",
ResourceFile NoExec "Authentication.curry",
ResourceFile NoExec "Processes.curry",
ResourceFile NoExec $ "System" </> "Spicey.curry",
ResourceFile NoExec $ "System" </> "Routes.curry",
ResourceFile NoExec $ "System" </> "SessionInfo.curry",
ResourceFile NoExec $ "System" </> "Authorization.curry",
ResourceFile NoExec $ "System" </> "Authentication.curry",
ResourceFile NoExec $ "System" </> "Processes.curry",
GeneratedFromERD createAuthorizations ],
Directory "View" [
ResourceFile NoExec $ "View" </> "SpiceySystem.curry",
......@@ -65,35 +65,36 @@ spiceyStructure pkgname =
Directory "Config" [
ResourceFile NoExec $ "Config" </> "Storage.curry",
ResourceFile NoExec $ "Config" </> "UserProcesses.curry",
GeneratedFromERD createRoutes ]
GeneratedFromERD createRoutes,
GeneratedFromERD createEntityRoutes ]
],
Directory "data" [
ResourceFile NoExec $ "data" </> "htaccess"
],
Directory "public" [
ResourceFile NoExec "index.html",
ResourceFile NoExec "favicon.ico",
ResourceFile NoExec $ "public" </> "index.html",
ResourceFile NoExec $ "public" </> "favicon.ico",
Directory "css" [
ResourceFile NoExec "bootstrap.min.css",
ResourceFile NoExec "spicey.css"
ResourceFile NoExec $ "css" </> "bootstrap.min.css",
ResourceFile NoExec $ "css" </> "spicey.css"
],
Directory "js" [
ResourceFile NoExec "bootstrap.min.js",
ResourceFile NoExec "jquery.min.js"
ResourceFile NoExec $ "js" </> "bootstrap.min.js",
ResourceFile NoExec $ "js" </> "jquery.min.js"
],
Directory "fonts" [
ResourceFile NoExec "glyphicons-halflings-regular.eot",
ResourceFile NoExec "glyphicons-halflings-regular.svg",
ResourceFile NoExec "glyphicons-halflings-regular.ttf",
ResourceFile NoExec "glyphicons-halflings-regular.woff",
ResourceFile NoExec "glyphicons-halflings-regular.woff2"
ResourceFile NoExec $ "fonts" </> "glyphicons-halflings-regular.eot",
ResourceFile NoExec $ "fonts" </> "glyphicons-halflings-regular.svg",
ResourceFile NoExec $ "fonts" </> "glyphicons-halflings-regular.ttf",
ResourceFile NoExec $ "fonts" </> "glyphicons-halflings-regular.woff",
ResourceFile NoExec $ "fonts" </> "glyphicons-halflings-regular.woff2"
],
Directory "images" [
ResourceFile NoExec "spicey-logo.png",
ResourceFile NoExec "text.png",
ResourceFile NoExec "time.png",
ResourceFile NoExec "number.png",
ResourceFile NoExec "foreign.png"
ResourceFile NoExec $ "images" </> "spicey-logo.png",
ResourceFile NoExec $ "images" </> "text.png",
ResourceFile NoExec $ "images" </> "time.png",
ResourceFile NoExec $ "images" </> "number.png",
ResourceFile NoExec $ "images" </> "foreign.png"
]
]
]
......@@ -143,13 +144,13 @@ createStructure target_path resource_dir _ _ _
setFileMode fmode targetfile
createStructure target_path resource_dir erd _ _
(ResourcePatchFile fmode filename f) = do
(ResourcePatchFile fmode filename patchfun) = do
let full_path = target_path </> filename
ifNotExistsDo full_path $ do
putStrLn ("Creating file '" ++ full_path ++ "'...")
cnt <- readFile (resource_dir </> filename)
let outfile = target_path </> filename
writeFile outfile (f erd cnt)
writeFile outfile (patchfun erd cnt)
setFileMode fmode outfile
createStructure target_path resource_dir erd termfile db_path
......
......@@ -19,7 +19,8 @@ generateViewsForEntity erdname allEntities
[ "Sort", "Time"
, "HTML.Base", bootstrapModule, "HTML.WUI"
, erdname
, spiceyModule, sessionInfoModule
, "Config.EntityRoutes"
, sessionInfoModule, spiceyModule
, entitiesToHtmlModule erdname] -- imports
[] -- typedecls
-- functions
......@@ -306,86 +307,82 @@ showView erdname (Entity entityName attrlist) relationships allEntities =
--- Create operation for the "list entities" view.
listView :: ViewGenerator
listView erdname (Entity entityName attrlist) _ _ =
let infovar = (0, "sinfo")
entsvar = (1, (lowerFirst entityName)++"s")
envar = (2, lowerFirst entityName)
showkey = applyF (erdname,"show"++entityName++"Key") [CVar envar]
in
viewFunction
("Supplies a list view for a given list of "++entityName++" entities.\n"++
"Shows also show/edit/delete buttons if the user is logged in.\n"++
"The arguments are the session info and the list of "++entityName++
" entities.\n")
entityName "list" 1
-- function type
(userSessionInfoType ~> listType (baseType (erdname,entityName))
~> viewBlockType)
[CRule
[CPVar infovar, CPVar entsvar]
(CSimpleRhs
(applyF (pre ":") [
applyF (html "h1")
[list2ac [applyF (html "htxt")
[string2ac $ entityName ++ " list"]]],
list2ac [
applyF (spiceyModule, "spTable") [
applyF (pre "++") [
list2ac [
applyF (pre "take") [
CLit (CIntc (length attrlist)),
constF (entitiesToHtmlModule erdname,
lowerFirst entityName++"LabelList")
]
],
applyF (pre "map") [
constF (viewModuleName entityName,"list"++entityName),
applyF ("Sort","mergeSortBy") [
constF (viewModuleName entityName,"leq"++entityName),
CVar entsvar
]
viewFunction
("Supplies a list view for a given list of "++entityName++" entities.\n"++
"Shows also show/edit/delete buttons if the user is logged in.\n"++
"The arguments are the session info and the list of "++entityName++
" entities.\n")
entityName "list" 1
-- function type
(userSessionInfoType ~> listType (baseType (erdname,entityName))
~> viewBlockType)
[CRule
[CPVar infovar, CPVar entsvar]
(CSimpleRhs
(applyF (pre ":") [
applyF (html "h1")
[list2ac [applyF (html "htxt")
[string2ac $ entityName ++ " list"]]],
list2ac [
applyF (spiceyModule, "spTable") [
applyF (pre "++") [
list2ac [
applyF (pre "take") [
CLit (CIntc (length attrlist)),
constF (entitiesToHtmlModule erdname,
lowerFirst entityName++"LabelList")
]
],
applyF (pre "map") [
constF (viewModuleName entityName,"list"++entityName),
applyF ("Sort","mergeSortBy") [
constF (viewModuleName entityName,"leq"++entityName),
CVar entsvar
]
]
]
]
]
)
[CLocalFunc (stFunc
(viewModuleName entityName, "list"++entityName) 2 Private
(ctvar entityName ~> listType viewBlockType)
[simpleRule [CPVar envar]
(applyF (pre "++") [
applyF (entitiesToHtmlModule erdname,
lowerFirst entityName++"ToListView")
[cvar $ lowerFirst entityName],
applyF (pre "if_then_else")
[applyF (pre "==")
[applyF (sessionInfoModule,"userLoginOfSession")
[CVar infovar],
constF (pre "Nothing")],
list2ac [],
]
)
[CLocalFunc (stFunc
<