Commit 2fb8b418 authored by Michael Hanus 's avatar Michael Hanus
Browse files

Some code generation refactoring

parent 85b9126c
......@@ -5,18 +5,18 @@
--- a controller to start selected user processes.
--------------------------------------------------------------------------
module Controller.SpiceySystemController
module Controller.SpiceySystem
(loginController,processListController,historyController)
where
import ReadNumeric
import Config.UserProcesses
import System.Spicey
import System.Session
import Config.UserProcesses
import System.Processes
import View.SpiceySystemView
import System.Authentication
import View.SpiceySystem
import Controller.DefaultController
-----------------------------------------------------------------------------
......
......@@ -5,7 +5,7 @@
--- and a view of a list of user processes.
--------------------------------------------------------------------------
module View.SpiceySystemView
module View.SpiceySystem
( loginView, processListView, historyView )
where
......
......@@ -12,7 +12,7 @@ import Spicey.GenerationHelper
-- Name of entity-specific authorization module:
enauthModName :: String
enauthModName = "Controller.AuthorizedControllers"
enauthModName = "System.AuthorizedActions"
-- Name of module defining the default controller:
defCtrlModName :: String
......@@ -731,43 +731,6 @@ generateDefaultController _ (Entity ename _:_) = simpleCurryProg
]
[] -- opdecls
------------------------------------------------------------------------
-- Generate all default authorizations.
generateAuthorizations :: String -> [Entity] -> CurryProg
generateAuthorizations erdname entities = simpleCurryProg
enauthModName
[authorizationModule, sessionInfoModule, erdname] -- imports
[] -- typedecls
-- functions
(map operationAllowed entities)
[] -- opdecls
where
operationAllowed (Entity entityName _) =
stCmtFunc
("Checks whether the application of an operation to a "++entityName++"\n"++
"entity is allowed.")
(enauthModName, lowerFirst entityName ++ "OperationAllowed")
1
Public
(applyTC (authorizationModule,"AccessType") [baseType (erdname,entityName)]
~> baseType (sessionInfoModule,"UserSessionInfo")
~> ioType (baseType (authorizationModule,"AccessResult")))
[simpleRule [CPVar (1,"at"), CPVar (2,"_")]
(CCase CRigid (CVar (1,"at"))
[cBranch (CPComb (authorizationModule,"ListEntities") []) allowed,
cBranch (CPComb (authorizationModule,"NewEntity") []) allowed,
cBranch (CPComb (authorizationModule,"ShowEntity") [CPVar (3,"_")]) allowed,
cBranch (CPComb (authorizationModule,"DeleteEntity") [CPVar (3,"_")]) allowed,
cBranch (CPComb (authorizationModule,"UpdateEntity") [CPVar (3,"_")]) allowed])]
-- Expression implemented access allowed
allowed = applyF (pre "return") [constF (authorizationModule,"AccessGranted")]
-- Expression implemented access denied
--exprDenied = applyF (pre "return")
-- [applyF (authorizationModule,"AccessDenied")
-- [string2ac "Operation not allowed!"]]
------------------------------------------------------------------------
-- Auxiliaries:
......
......@@ -10,7 +10,7 @@ import Spicey.GenerationHelper
generateRoutesForERD :: ERD -> CurryProg
generateRoutesForERD (ERD _ entities _) =
let spiceySysCtrl = "Controller.SpiceySystemController" in
let spiceySysCtrl = "Controller.SpiceySystem" in
simpleCurryProg
mappingModuleName
([spiceyModule, "System.Routes", spiceySysCtrl, dataModuleName] ++
......
......@@ -71,6 +71,12 @@ createControllers _ (ERD name entities relationship) path _ = do
(showCProg (generateControllersForEntity erdname allEntities
(Entity ename attrlist) relationships))
createAuthorizations :: String -> ERD -> String -> String -> IO ()
createAuthorizations _ (ERD name entities _) path _ = do
let targetfile = path </> "AuthorizedActions.curry"
putStrLn $ "Generating default action authorization '" ++ targetfile ++ "'..."
writeFile targetfile (showCProg (generateAuthorizations name entities))
createHtmlHelpers :: String -> ERD -> String -> String -> IO ()
createHtmlHelpers _ (ERD name entities relationship) path _ =
saveToHtml name (getEntities erdt) (getRelationships erdt)
......@@ -108,3 +114,43 @@ createRoutes _ erd path _ = do
hClose dmfileh
------------------------------------------------------------------------
-- Generate all default authorizations.
generateAuthorizations :: String -> [Entity] -> CurryProg
generateAuthorizations erdname entities = simpleCurryProg
enauthModName
[authorizationModule, sessionInfoModule, erdname] -- imports
[] -- typedecls
-- functions
(map operationAllowed entities)
[] -- opdecls
where
operationAllowed (Entity entityName _) =
stCmtFunc
("Checks whether the application of an operation to a "++entityName++"\n"++
"entity is allowed.")
(enauthModName, lowerFirst entityName ++ "OperationAllowed")
1
Public
(applyTC (authorizationModule,"AccessType") [baseType (erdname,entityName)]
~> baseType (sessionInfoModule,"UserSessionInfo")
~> ioType (baseType (authorizationModule,"AccessResult")))
[simpleRule [CPVar (1,"at"), CPVar (2,"_")]
(CCase CRigid (CVar (1,"at"))
[cBranch (CPComb (authorizationModule,"ListEntities") []) allowed,
cBranch (CPComb (authorizationModule,"NewEntity") []) allowed,
cBranch (CPComb (authorizationModule,"ShowEntity") [CPVar (3,"_")])
allowed,
cBranch (CPComb (authorizationModule,"DeleteEntity") [CPVar (3,"_")])
allowed,
cBranch (CPComb (authorizationModule,"UpdateEntity") [CPVar (3,"_")])
allowed])]
-- Expression implemented access allowed
allowed = applyF (pre "return") [constF (authorizationModule,"AccessGranted")]
-- Expression implemented access denied
--exprDenied = applyF (pre "return")
-- [applyF (authorizationModule,"AccessDenied")
-- [string2ac "Operation not allowed!"]]
------------------------------------------------------------------------
\ No newline at end of file
......@@ -6,7 +6,7 @@ import Database.ERD ( ERD, readERDTermFile )
import Database.ERD.Goodies ( erdName, storeERDFromProgram )
import Directory
import Distribution
import FilePath ( (</>) )
import FilePath ( (</>), takeFileName )
import List ( isSuffixOf, last )
import System ( setEnviron, system, getArgs, exitWith )
......@@ -16,7 +16,7 @@ import Spicey.Scaffolding
systemBanner :: String
systemBanner =
let bannerText = "Spicey Web Framework (Version " ++ packageVersion ++
" of 14/01/18)"
" of 25/01/18)"
bannerLine = take (length bannerText) (repeat '-')
in bannerLine ++ "\n" ++ bannerText ++ "\n" ++ bannerLine
......@@ -52,13 +52,14 @@ spiceyStructure pkgname =
ResourceFile NoExec "SessionInfo.curry",
ResourceFile NoExec "Authorization.curry",
ResourceFile NoExec "Authentication.curry",
ResourceFile NoExec "Processes.curry" ],
ResourceFile NoExec "Processes.curry",
GeneratedFromERD createAuthorizations ],
Directory "View" [
ResourceFile NoExec "SpiceySystemView.curry",
ResourceFile NoExec ("View" </> "SpiceySystem.curry"),
GeneratedFromERD createViews,
GeneratedFromERD createHtmlHelpers ],
Directory "Controller" [
ResourceFile NoExec "SpiceySystemController.curry",
ResourceFile NoExec ("Controller" </> "SpiceySystem.curry"),
GeneratedFromERD createControllers ],
Directory "Model" [
GeneratedFromERD createModels ],
......@@ -110,13 +111,6 @@ replacePackageName pn (c:cs)
= pn ++ replacePackageName pn (drop 12 cs)
| otherwise = c : replacePackageName pn cs
copyFileLocal :: FileMode -> String -> String -> String -> IO ()
copyFileLocal fmode path resource_dir filename = do
let infile = resource_dir </> filename
let outfile = path </> filename
system $ "cp \"" ++ infile ++ "\" \"" ++ outfile ++ "\""
setFileMode fmode outfile
-- checks if given path exists (file or directory) and executes
-- given action if not
ifNotExistsDo :: String -> IO () -> IO ()
......@@ -132,11 +126,13 @@ createStructure :: String -> String -> ERD -> String -> String -> DirTree
-> IO ()
createStructure target_path resource_dir _ _ _
(ResourceFile fmode filename) = do
let full_path = target_path </> filename
ifNotExistsDo full_path $ do
putStrLn $ "Creating file '" ++ full_path ++ "'..."
copyFileLocal fmode target_path resource_dir filename
let infile = resource_dir </> filename
targetfile = target_path </> takeFileName filename
ifNotExistsDo targetfile $ do
putStrLn $ "Creating file '" ++ targetfile ++ "'..."
system $ "cp \"" ++ infile ++ "\" \"" ++ targetfile ++ "\""
setFileMode fmode targetfile
createStructure target_path resource_dir _ _ _
(ResourcePatchFile fmode filename f) = do
let full_path = target_path </> filename
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment