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

Code refactoring in System.Spicey to support compatibility with new DB scheme

parent c4e53de4
......@@ -49,7 +49,7 @@ run:
.PHONY: deploy
deploy:
mkdir -p $(WEBSERVERDIR)
$(CPM) exec $(CURRYBIN)/curry makecgi -standalone -m main -o $(WEBSERVERDIR)/spicey.cgi Main.curry
$(CPM) exec $(CURRYBIN)/curry makecgi -cpm -standalone -m main -o $(WEBSERVERDIR)/spicey.cgi Main.curry
# copy other files (style sheets, images,...)
cp -r public/* $(WEBSERVERDIR)
chmod -R go+rX $(WEBSERVERDIR)
......
......@@ -59,11 +59,11 @@ type ViewBlock = [HtmlExp]
type Controller = IO ViewBlock
--- Reads an entity for a given key and applies a controller to it.
applyControllerOn :: Maybe enkey -> (enkey -> Transaction en)
applyControllerOn :: Maybe enkey -> (enkey -> IO en)
-> (en -> Controller) -> Controller
applyControllerOn Nothing _ _ = displayError "Illegal URL"
applyControllerOn (Just userkey) getuser usercontroller =
runJustT (getuser userkey) >>= usercontroller
getuser userkey >>= usercontroller
nextController :: Controller -> _ -> IO HtmlForm
nextController controller _ = do
......@@ -99,9 +99,9 @@ confirmController question yescontroller nocontroller = do
--- transaction error is shown.
--- @param trans - the transaction to be executed
--- @param controller - the controller executed in case of success
transactionController :: (Transaction _) -> Controller -> Controller
transactionController :: IO (Either _ TError) -> Controller -> Controller
transactionController trans controller = do
transResult <- runT trans
transResult <- trans
either (\_ -> controller)
(\error -> displayError (showTError error))
transResult
......
......@@ -95,18 +95,18 @@ mainController erdname (Entity entityName _) _ _ =
(constF (controllerFunctionName entityName "new")),
cBranch (listPattern [stringPattern "show", CPVar (2,"s")])
(applyF (spiceyModule,"applyControllerOn")
[applyF (erdname,"read"++entityName++"Key") [CVar (2,"s")],
constF (erdname,"get"++entityName),
[readKey,
getEntityOp,
constF (controllerFunctionName entityName "show")]),
cBranch (listPattern [stringPattern "edit", CPVar (2,"s")])
(applyF (spiceyModule,"applyControllerOn")
[applyF (erdname,"read"++entityName++"Key") [CVar (2,"s")],
constF (erdname,"get"++entityName),
[readKey,
getEntityOp,
constF (controllerFunctionName entityName "edit")]),
cBranch (listPattern [stringPattern "delete", CPVar (2,"s")])
(applyF (spiceyModule,"applyControllerOn")
[applyF (erdname,"read"++entityName++"Key") [CVar (2,"s")],
constF (erdname,"get"++entityName),
[readKey,
getEntityOp,
constF (controllerFunctionName entityName "delete")]),
cBranch (CPVar (3,"_"))
(applyF (spiceyModule, "displayError")
......@@ -114,6 +114,11 @@ mainController erdname (Entity entityName _) _ _ =
)
]
)]
where
readKey = applyF (erdname,"read"++entityName++"Key") [CVar (2,"s")]
getEntityOp = applyF (pre ".")
[constF (db "runJustT"),
constF (erdname,"get"++entityName)]
-- generates a controller to show a form to create a new entity
-- the input is then passed to the create controller
......@@ -162,8 +167,9 @@ newController erdname (Entity entityName attrList) relationships allEntities =
[2..]) ++
[CLambda [CPVar (200,"entity")]
(applyF (spiceyModule,"transactionController")
[applyF (transFunctionName entityName "create")
[CVar (200,"entity")],
[applyF (db "runT")
[applyF (transFunctionName entityName "create")
[CVar (200,"entity")]],
applyF (spiceyModule,"nextInProcessOr")
[callEntityListController entityName,
constF (pre "Nothing")]]),
......@@ -295,8 +301,9 @@ editController erdname (Entity entityName attrList) relationships allEntities =
[1..])) ++
[CLambda [CPVar (200,"entity")]
(applyF (spiceyModule,"transactionController")
[applyF (transFunctionName entityName "update")
[CVar (200,"entity")],
[applyF (db "runT")
[applyF (transFunctionName entityName "update")
[CVar (200,"entity")]],
applyF (spiceyModule,"nextInProcessOr")
[callEntityListController entityName,
constF (pre "Nothing")]]),
......@@ -378,8 +385,9 @@ deleteController erdname (Entity entityName _) _ _ =
[CVar entvar],
string2ac "\"?"]]]]]],
applyF (spiceyModule,"transactionController")
[applyF (transFunctionName entityName "delete")
[CVar entvar],
[applyF (db "runT")
[applyF (transFunctionName entityName "delete")
[CVar entvar]],
constF (controllerFunctionName entityName "list")],
applyF (controllerFunctionName entityName "show")
[CVar entvar]]])]
......
......@@ -16,7 +16,7 @@ import Spicey.Scaffolding
systemBanner :: String
systemBanner =
let bannerText = "Spicey Web Framework (Version " ++ packageVersion ++
" of 11/10/17)"
" of 03/01/18)"
bannerLine = take (length bannerText) (repeat '-')
in bannerLine ++ "\n" ++ bannerText ++ "\n" ++ bannerLine
......
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