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 ...@@ -22,7 +22,6 @@ import HTML.Session
import System.Processes import System.Processes
import System.Authentication import System.Authentication
import View.SpiceySystem import View.SpiceySystem
import Controller.DefaultController
----------------------------------------------------------------------------- -----------------------------------------------------------------------------
--- Controller for login/logout. --- Controller for login/logout.
...@@ -33,10 +32,8 @@ loginController = do ...@@ -33,10 +32,8 @@ loginController = do
return [formExp loginFormDef] return [formExp loginFormDef]
loginFormDef :: HtmlFormDef (Maybe String) loginFormDef :: HtmlFormDef (Maybe String)
loginFormDef = loginFormDef = formDefWithID "Controller.SpiceySystem.loginFormDef"
formDefWithID "Controller.SpiceySystem.loginFormDef" (getSessionData loginViewData Nothing) loginView
(getSessionData loginViewData Nothing)
(loginView defaultController)
--- The data processed by the login form. --- The data processed by the login form.
loginViewData :: Global (SessionStore (Maybe String)) loginViewData :: Global (SessionStore (Maybe String))
......
...@@ -15,9 +15,10 @@ module System.SessionInfo ( ...@@ -15,9 +15,10 @@ module System.SessionInfo (
) where ) where
import Global import Global
import HTML.Session import HTML.Session
import Config.Storage import Config.Storage ( inDataDir )
-------------------------------------------------------------------------- --------------------------------------------------------------------------
--- The data associated to a user session. --- The data associated to a user session.
......
...@@ -4,7 +4,9 @@ ...@@ -4,7 +4,9 @@
-------------------------------------------------------------------------- --------------------------------------------------------------------------
module System.Spicey ( module System.Spicey (
Controller, EntityController(..), applyControllerOn, Controller, EntityController(..), showRoute, editRoute, deleteRoute,
applyControllerOn,
redirectController,
nextController, nextControllerForData, nextController, nextControllerForData,
confirmDeletionPage, confirmDeletionPage,
transactionController, transactionController,
...@@ -54,11 +56,29 @@ type ViewBlock = [HtmlExp] ...@@ -54,11 +56,29 @@ type ViewBlock = [HtmlExp]
--- Spicey.getControllerParams inside the controller. --- Spicey.getControllerParams inside the controller.
type Controller = IO ViewBlock 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 class EntityController a where
controllerOnKey :: String -> (a -> Controller) -> Controller 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. --- Reads an entity for a given key and applies a controller to it.
applyControllerOn :: Maybe enkey -> (enkey -> IO en) applyControllerOn :: Maybe enkey -> (enkey -> IO en)
...@@ -67,6 +87,11 @@ applyControllerOn Nothing _ _ = displayUrlError ...@@ -67,6 +87,11 @@ applyControllerOn Nothing _ _ = displayUrlError
applyControllerOn (Just userkey) getuser usercontroller = applyControllerOn (Just userkey) getuser usercontroller =
getuser userkey >>= 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 -> _ -> IO HtmlPage
nextController controller _ = do nextController controller _ = do
view <- controller view <- controller
...@@ -160,18 +185,18 @@ showControllerURL ctrlurl params = '?' : ctrlurl ++ concatMap ('/':) params ...@@ -160,18 +185,18 @@ showControllerURL ctrlurl params = '?' : ctrlurl ++ concatMap ('/':) params
--- @param sinfo - the UserSessionInfo to select the language --- @param sinfo - the UserSessionInfo to select the language
--- @param title - the title of the WUI form --- @param title - the title of the WUI form
--- @param buttontag - the text on the submit button --- @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 envpar - environment parameters (e.g., user session data)
--- @param hexp - the HTML expression representing the WUI form --- @param hexp - the HTML expression representing the WUI form
--- @param handler - the handler for submitting data --- @param handler - the handler for submitting data
renderWUI :: UserSessionInfo -> String -> String -> Controller renderWUI :: UserSessionInfo -> String -> String -> String
-> a -> HtmlExp -> (CgiEnv -> Controller) -> [HtmlExp] -> a -> HtmlExp -> (CgiEnv -> Controller) -> [HtmlExp]
renderWUI _ title buttontag cancelctrl _ hexp handler = renderWUI _ title buttontag cancelurl _ hexp handler =
[h1 [htxt title], [h1 [htxt title],
hexp, hexp,
breakline, breakline,
primButton buttontag (\env -> handler env >>= getPage), primButton buttontag (\env -> handler env >>= getPage),
defaultButton "Cancel" (nextController (cancelOperation >> cancelctrl))] hrefButton cancelurl [htxt "Cancel"]]
--- A WUI for manipulating CalendarTime entities. --- A WUI for manipulating CalendarTime entities.
...@@ -243,15 +268,14 @@ spiceyFooter = ...@@ -243,15 +268,14 @@ spiceyFooter =
[image "images/spicey-logo.png" "Spicey"] [image "images/spicey-logo.png" "Spicey"]
`addAttr` ("target","_blank"), `addAttr` ("target","_blank"),
htxt "Framework"]] htxt "Framework"]]
--- Transforms a view into an HTML form by adding the basic page layout. --- 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 -> IO HtmlPage
getPage viewblock = case viewblock of getPage viewblock = case viewblock of
[HtmlText ""] -> [HtmlText ""] -> return $ redirectPage "spicey.cgi"
return $ HtmlPage "forward to Spicey" [HtmlText ('?':route)] -> return $ redirectPage ('?':route)
[pageMetaInfo [("http-equiv","refresh"),
("content","1; url=spicey.cgi")]]
[par [htxt "You will be forwarded..."]]
_ -> do _ -> do
routemenu <- getRouteMenu routemenu <- getRouteMenu
msg <- getPageMessage msg <- getPageMessage
...@@ -361,7 +385,7 @@ spTable items = table items `addClass` "table table-hover table-condensed" ...@@ -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). --- Definition of the session state to store the page message (a string).
pageMessage :: Global (SessionStore String) pageMessage :: Global (SessionStore String)
pageMessage = global emptySessionStore Temporary pageMessage = global emptySessionStore (Persistent (inDataDir "pageMessage"))
--- Gets the page message and delete it. --- Gets the page message and delete it.
getPageMessage :: IO String getPageMessage :: IO String
...@@ -380,7 +404,7 @@ setPageMessage msg = putSessionData pageMessage msg ...@@ -380,7 +404,7 @@ setPageMessage msg = putSessionData pageMessage msg
--- Definition of the session state to store the last URL (as a string). --- Definition of the session state to store the last URL (as a string).
lastUrls :: Global (SessionStore [String]) lastUrls :: Global (SessionStore [String])
lastUrls = global emptySessionStore Temporary lastUrls = global emptySessionStore (Persistent (inDataDir "lastUrls"))
--- Gets the list of URLs of the current session. --- Gets the list of URLs of the current session.
getLastUrls :: IO [String] getLastUrls :: IO [String]
......
...@@ -10,7 +10,7 @@ module View.SpiceySystem ...@@ -10,7 +10,7 @@ module View.SpiceySystem
where where
import HTML.Base import HTML.Base
import HTML.Styles.Bootstrap3 (defaultButton, primButton) import HTML.Styles.Bootstrap3 (defaultButton, hrefButton, primButton)
import Config.UserProcesses import Config.UserProcesses
import System.Processes import System.Processes
...@@ -21,15 +21,15 @@ import System.Authentication ...@@ -21,15 +21,15 @@ import System.Authentication
--- Generates a form for login/logout. --- Generates a form for login/logout.
--- If the passed login name is the empty string, --- If the passed login name is the empty string,
--- we offer a login dialog, otherwise a logout dialog. --- we offer a login dialog, otherwise a logout dialog.
loginView :: Controller -> Maybe String -> [HtmlExp] loginView :: Maybe String -> [HtmlExp]
loginView controller currlogin = loginView currlogin =
case currlogin of case currlogin of
Nothing -> [h3 [htxt "Login as:"], Nothing -> [h3 [htxt "Login as:"],
textField loginfield "", textField loginfield "",
defaultButton "Login" loginHandler] defaultButton "Login" loginHandler]
Just _ -> [h3 [htxt "Really logout?"], Just _ -> [h3 [htxt "Really logout?"],
primButton "Logout" (logoutHandler True), primButton "Logout" logoutHandler,
defaultButton "Cancel" (logoutHandler False)] hrefButton "?" [htxt "Cancel"]]
where where
loginfield free loginfield free
...@@ -40,12 +40,11 @@ loginView controller currlogin = ...@@ -40,12 +40,11 @@ loginView controller currlogin =
then done then done
else do loginToSession loginname else do loginToSession loginname
setPageMessage ("Logged in as: "++loginname) setPageMessage ("Logged in as: "++loginname)
nextInProcessOr controller Nothing >>= getPage nextInProcessOr (redirectController "?") Nothing >>= getPage
logoutHandler confirm _ = do logoutHandler _ = do
if confirm then logoutFromSession >> setPageMessage "Logged out" logoutFromSession >> setPageMessage "Logged out"
else done nextInProcessOr (redirectController "?") Nothing >>= getPage
nextInProcessOr controller Nothing >>= getPage
----------------------------------------------------------------------------- -----------------------------------------------------------------------------
--- A view for all processes contained in a given process specification. --- A view for all processes contained in a given process specification.
......
...@@ -33,14 +33,14 @@ generateControllersForEntity erdname allEntities ...@@ -33,14 +33,14 @@ generateControllersForEntity erdname allEntities
[ "Global", "Maybe", "Time" [ "Global", "Maybe", "Time"
, "HTML.Base", "HTML.Session", "HTML.WUI" , "HTML.Base", "HTML.Session", "HTML.WUI"
, erdname , erdname
, "Config.Storage" , "Config.UserProcesses" , "Config.EntityRoutes", "Config.Storage" , "Config.UserProcesses"
, sessionInfoModule, authorizationModule, enauthModName, spiceyModule , sessionInfoModule, authorizationModule, enauthModName, spiceyModule
, entitiesToHtmlModule erdname , entitiesToHtmlModule erdname
, viewModuleName ename , viewModuleName ename
] ]
Nothing -- defaultdecl Nothing -- defaultdecl
[] -- classdecls [] -- classdecls
[controllerInstDecl erdname entity] -- instdecls [] -- instdecls
[newEntityType erdname entity relationships allEntities] -- typedecls [newEntityType erdname entity relationships allEntities] -- typedecls
-- functions -- functions
( (
...@@ -82,25 +82,6 @@ generateControllersForEntity erdname allEntities ...@@ -82,25 +82,6 @@ generateControllersForEntity erdname allEntities
[] -- opdecls [] -- 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 -- erdname: name of the entity-relationship-specification
-- entity: the entity to generate a controller for -- entity: the entity to generate a controller for
type ControllerGenerator = String -> Entity -> [Relationship] -> [Entity] type ControllerGenerator = String -> Entity -> [Relationship] -> [Entity]
...@@ -228,6 +209,7 @@ newForm erdname entity@(Entity entityName attrlist) relationships allEntities = ...@@ -228,6 +209,7 @@ newForm erdname entity@(Entity entityName attrlist) relationships allEntities =
manyToManyEntities = manyToMany allEntities (Entity entityName attrlist) manyToManyEntities = manyToMany allEntities (Entity entityName attrlist)
manyToOneEntities = manyToOne (Entity entityName attrlist) relationships manyToOneEntities = manyToOne (Entity entityName attrlist) relationships
arity1 = 1 + length manyToOneEntities + length manyToManyEntities arity1 = 1 + length manyToOneEntities + length manyToManyEntities
listEntityURL = '?' : entityName ++ "/list"
wuiFun = wuiFun =
CLambda CLambda
...@@ -252,7 +234,8 @@ newForm erdname entity@(Entity entityName attrlist) relationships allEntities = ...@@ -252,7 +234,8 @@ newForm erdname entity@(Entity entityName attrlist) relationships allEntities =
[applyF (transFunctionName entityName "create") [applyF (transFunctionName entityName "create")
[CVar entvar]], [CVar entvar]],
applyF (spiceyModule,"nextInProcessOr") applyF (spiceyModule,"nextInProcessOr")
[callEntityListController entityName, [applyF (spiceyModule,"redirectController")
[string2ac listEntityURL],
constF (pre "Nothing")]])]) constF (pre "Nothing")]])])
renderFun = renderFun =
...@@ -262,7 +245,7 @@ newForm erdname entity@(Entity entityName attrlist) relationships allEntities = ...@@ -262,7 +245,7 @@ newForm erdname entity@(Entity entityName attrlist) relationships allEntities =
[CVar sinfovar, [CVar sinfovar,
string2ac $ "Create new " ++ entityName, string2ac $ "Create new " ++ entityName,
string2ac "Create", string2ac "Create",
constF (controllerFunctionName entityName "list"), string2ac listEntityURL,
constF (pre "()") constF (pre "()")
] ]
where sinfovar = (1, "sinfo") where sinfovar = (1, "sinfo")
...@@ -441,6 +424,7 @@ editForm erdname entity@(Entity entityName attrlist) relationships allEntities = ...@@ -441,6 +424,7 @@ editForm erdname entity@(Entity entityName attrlist) relationships allEntities =
manyToManyEntities = manyToMany allEntities (Entity entityName attrlist) manyToManyEntities = manyToMany allEntities (Entity entityName attrlist)
manyToOneEntities = manyToOne (Entity entityName attrlist) relationships manyToOneEntities = manyToOne (Entity entityName attrlist) relationships
arity1 = 2 + length manyToOneEntities * 2 + length manyToManyEntities arity1 = 2 + length manyToOneEntities * 2 + length manyToManyEntities
listEntityURL = '?' : entityName ++ "/list"
wuiFun = wuiFun =
CLambda CLambda
...@@ -476,7 +460,8 @@ editForm erdname entity@(Entity entityName attrlist) relationships allEntities = ...@@ -476,7 +460,8 @@ editForm erdname entity@(Entity entityName attrlist) relationships allEntities =
[applyF (transFunctionName entityName "update") [applyF (transFunctionName entityName "update")
[CVar entvar]], [CVar entvar]],
applyF (spiceyModule,"nextInProcessOr") applyF (spiceyModule,"nextInProcessOr")
[callEntityListController entityName, [applyF (spiceyModule,"redirectController")
[string2ac listEntityURL],
constF (pre "Nothing")]])]) constF (pre "Nothing")]])])
renderFun = renderFun =
...@@ -486,7 +471,7 @@ editForm erdname entity@(Entity entityName attrlist) relationships allEntities = ...@@ -486,7 +471,7 @@ editForm erdname entity@(Entity entityName attrlist) relationships allEntities =
[CVar sinfovar, [CVar sinfovar,
string2ac $ "Edit " ++ entityName, string2ac $ "Edit " ++ entityName,
string2ac "Change", string2ac "Change",
constF (controllerFunctionName entityName "list"), string2ac listEntityURL,
constF (pre "()") constF (pre "()")
] ]
where sinfovar = (1, "sinfo") where sinfovar = (1, "sinfo")
...@@ -598,6 +583,7 @@ destroyController :: ControllerGenerator ...@@ -598,6 +583,7 @@ destroyController :: ControllerGenerator
destroyController erdname (Entity entityName _) _ _ = destroyController erdname (Entity entityName _) _ _ =
let entlc = lowerFirst entityName -- entity name in lowercase let entlc = lowerFirst entityName -- entity name in lowercase
entvar = (0, entlc) -- entity parameter for controller entvar = (0, entlc) -- entity parameter for controller
listEntityURL = '?' : entityName ++ "/list"
in in
controllerFunction controllerFunction
("Deletes a given " ++ entityName ++ " entity\n" ++ ("Deletes a given " ++ entityName ++ " entity\n" ++
...@@ -614,7 +600,8 @@ destroyController erdname (Entity entityName _) _ _ = ...@@ -614,7 +600,8 @@ destroyController erdname (Entity entityName _) _ _ =
[applyF (erdname,"runT") [applyF (erdname,"runT")
[applyF (transFunctionName entityName "delete") [applyF (transFunctionName entityName "delete")
[CVar entvar]], [CVar entvar]],
constF (controllerFunctionName entityName "list")]])] applyF (spiceyModule,"redirectController")
[string2ac listEntityURL]]])]
--- Generates a transaction to delete an entity. --- Generates a transaction to delete an entity.
deleteTransaction :: ControllerGenerator deleteTransaction :: ControllerGenerator
...@@ -741,12 +728,6 @@ showController erdname (Entity entityName attrList) relationships allEntities = ...@@ -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 :: String -> Entity -> [String] -> [Entity] -> [CFuncDecl]
manyToManyAddOrRemove erdname (Entity entityName _) entities allEntities = manyToManyAddOrRemove erdname (Entity entityName _) entities allEntities =
(map (addOrRemoveFunction "add" "new" entityName) entities) ++ (map (addOrRemoveFunction "add" "new" entityName) entities) ++
...@@ -938,25 +919,6 @@ relationshipsForEntityName ename rels = filter endsIn rels ...@@ -938,25 +919,6 @@ relationshipsForEntityName ename rels = filter endsIn rels
where where
endsIn (Relationship _ ends) = any (\ (REnd n _ _) -> ename == n) ends 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: -- 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" ...@@ -74,7 +74,7 @@ mappingModuleName = "Config.ControllerMapping"
--- Name of EntitiesToHtml module. --- Name of EntitiesToHtml module.
entitiesToHtmlModule :: String -> String entitiesToHtmlModule :: String -> String
entitiesToHtmlModule erdname = "View." ++ erdname ++ "EntitiesToHtml" entitiesToHtmlModule erdname = "View.EntitiesToHtml"
bootstrapModule :: String bootstrapModule :: String
bootstrapModule = "HTML.Styles.Bootstrap3" bootstrapModule = "HTML.Styles.Bootstrap3"
......
...@@ -18,6 +18,7 @@ import Database.ERD.Goodies ...@@ -18,6 +18,7 @@ import Database.ERD.Goodies
import Spicey.ControllerGeneration import Spicey.ControllerGeneration
import Spicey.EntitiesToHtmlGeneration import Spicey.EntitiesToHtmlGeneration
import Spicey.EntityRoutesGeneration
import Spicey.GenerationHelper import Spicey.GenerationHelper
import Spicey.RouteGeneration import Spicey.RouteGeneration
import Spicey.Transformation import Spicey.Transformation
...@@ -40,8 +41,8 @@ getEntities (ERD _ entities _) = entities ...@@ -40,8 +41,8 @@ getEntities (ERD _ entities _) = entities
createViews :: String -> ERD -> String -> String -> IO () createViews :: String -> ERD -> String -> String -> IO ()
createViews _ (ERD name entities relationship) path _ = createViews _ (ERD name entities relationship) path _ =
mapIO_ (saveView name (getEntities erdt) (getRelationships erdt)) mapM_ (saveView name (getEntities erdt) (getRelationships erdt))
(filter (not . Spicey.GenerationHelper.isGenerated) (getEntities erdt)) (filter (not . Spicey.GenerationHelper.isGenerated) (getEntities erdt))
where where
erdt = transform (ERD name entities relationship) erdt = transform (ERD name entities relationship)
...@@ -52,13 +53,18 @@ createViews _ (ERD name entities relationship) path _ = ...@@ -52,13 +53,18 @@ createViews _ (ERD name entities relationship) path _ =
(showCProg (generateViewsForEntity erdname allEntities (showCProg (generateViewsForEntity erdname allEntities
(Entity ename attrlist) relationships)) (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 :: String -> ERD -> String -> String -> IO ()
createControllers _ (ERD name entities relationship) path _ = do createControllers _ (ERD name entities relationship) path _ = do