Commit edabf80a authored by Michael Hanus 's avatar Michael Hanus
Browse files

Spicey web framework now uses the cdbi package for database access so that one...

Spicey web framework now uses the cdbi package for database access so that one can use embedded SQL statements in the Curry code.
parent 65017a29
Welcome to the Spicey web application framework!
The Spicey Web Application Framework
====================================
To generate an application, follow the steps below.
......@@ -36,3 +37,8 @@ To generate an application, follow the steps below.
6. After the successful compilation, the application is executable
in a web browser by loading `<URL of web dir>/spicey.cgi`.
Note that the database is generated with the `cdbi` package.
Hence, one can also use embedded SQL statements when further developing
the Curry code. The syntax and use of such embedded SQL statements
is described in the Curry preprocessor.
......@@ -29,7 +29,7 @@ the executable \code{spiceup} into the directory \code{\$HOME/.cpm/bin}.
Hence it is recommended to add this directory to your path
in order to execute Spicey as described below.
\subsection{Usage}
\subsection{Basic usage}
The idea of this tool, which is part of the distribution of \CYS,
is described in detail in \cite{HanusKoschnicke14TPLP}.
......@@ -97,3 +97,15 @@ where the compiled cgi programs should be stored, and run
After the successful compilation and deployment of all files,
the application is executable
in a web browser by selecting the URL \code{<URL of web dir>/spicey.cgi}.
\subsection{Further remarks}
The application generated by Spicey is a schematic initial implementation.
It provides an appropriate basic programming structure but
it can be extended in various ways.
In particular, one can also use embedded SQL statements when
further developing the Curry code, since the underlying database
access operations are generated with the \code{cdbi} package.
The syntax and use of such embedded SQL statements
is described in the Curry preprocessor.
{
"name": "spicey",
"version": "2.1.0",
"version": "3.0.0",
"author": "Michael Hanus <mh@informatik.uni-kiel.de>",
"synopsis": "A web application framework for Curry",
"category": [ "Web", "Database" ],
......
......@@ -26,13 +26,14 @@ The directory structure of this package as follows
src/Model/
This directory contains the implementation of the data model, i.e.,
it contains the Curry module <MODEL>.curry implementing the access
to the database which are generated from the ER description. If you
want to add more complex integrity constraints on update operations,
you should extend the Curry code in this module.
In addition to the Curry programs, this directory also contains
to the database which are generated from the ER description.
In addition to the Curry program, this directory also contains
the term files of the original and transformed ER description
(files `<MODEL>_ERD.term` and `<MODEL>_ERDT.term`) and the
Curry file of the original ER description (file `<MODEL>_ERD.curry`).
(files `<MODEL>_ERD.term` and `<MODEL>_ERDT.term`),
Curry file of the original ER description (file `<MODEL>_ERD.curry`),
and the info file `<MODEL>_SQLCode.info` which is used by
the Curry preprocessor when SQL queries are embedded in the source
code.
src/Controller/
This directory contains the implementation of the various
......
......@@ -17,7 +17,7 @@ module System.Spicey (
nextInProcessOr,
stringToHtml, maybeStringToHtml,
intToHtml,maybeIntToHtml, floatToHtml, maybeFloatToHtml,
boolToHtml, maybeBoolToHtml, calendarTimeToHtml, maybeCalendarTimeToHtml,
boolToHtml, maybeBoolToHtml, dateToHtml, maybeDateToHtml,
userDefinedToHtml, maybeUserDefinedToHtml,
spTable,
setPageMessage, getPageMessage,
......@@ -31,7 +31,7 @@ import ReadShowTerm(readsQTerm)
import System
import Time
import Database.KeyDatabaseSQLite
import Database.CDBI.Connection ( SQLResult )
import HTML.Base
import HTML.Styles.Bootstrap3
import WUI
......@@ -99,11 +99,11 @@ 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 :: IO (Either _ TError) -> Controller -> Controller
transactionController :: IO (SQLResult _) -> Controller -> Controller
transactionController trans controller = do
transResult <- trans
either (\_ -> controller)
(\error -> displayError (showTError error))
either (\error -> displayError (show error))
(\_ -> controller)
transResult
--- If we are in a process, execute the next process depending on
......@@ -178,14 +178,16 @@ renderWuiForm wuispec initdata controller cancelcontroller title buttontag =
--- A WUI for manipulating CalendarTime entities.
--- It is based on a WUI for dates, i.e., the time is ignored.
wDateType :: WuiSpec CalendarTime
wDateType :: WuiSpec ClockTime
wDateType = transformWSpec (tuple2date,date2tuple) wDate
where
tuple2date :: (Int, Int, Int) -> CalendarTime
tuple2date (day, month, year) = CalendarTime year month day 0 0 0 0
tuple2date :: (Int, Int, Int) -> ClockTime
tuple2date (day, month, year) =
toClockTime (CalendarTime year month day 0 0 0 0)
date2tuple :: CalendarTime -> (Int, Int, Int)
date2tuple( CalendarTime year month day _ _ _ _) = (day, month, year)
date2tuple :: ClockTime -> (Int, Int, Int)
date2tuple ct = let CalendarTime year month day _ _ _ _ = toUTCTime ct
in (day, month, year)
--- A WUI for manipulating date entities.
wDate :: WuiSpec (Int, Int, Int)
......@@ -332,12 +334,12 @@ boolToHtml b = textstyle "type_bool" (show b)
maybeBoolToHtml :: Maybe Bool -> HtmlExp
maybeBoolToHtml b = textstyle "type_bool" (maybe "" show b)
calendarTimeToHtml :: CalendarTime -> HtmlExp
calendarTimeToHtml ct = textstyle "type_calendartime" (toDayString ct)
dateToHtml :: ClockTime -> HtmlExp
dateToHtml ct = textstyle "type_calendartime" (toDayString (toUTCTime ct))
maybeCalendarTimeToHtml :: Maybe CalendarTime -> HtmlExp
maybeCalendarTimeToHtml ct =
textstyle "type_calendartime" (maybe "" toDayString ct)
maybeDateToHtml :: Maybe ClockTime -> HtmlExp
maybeDateToHtml ct =
textstyle "type_calendartime" (maybe "" (toDayString . toUTCTime) ct)
userDefinedToHtml :: Show a => a -> HtmlExp
userDefinedToHtml ud = textstyle "type_string" (show ud)
......
......@@ -5,8 +5,8 @@
"synopsis": "Web application 'XXXPKGNAMEXXX' generated by Spicey",
"category": [ "Web" ],
"dependencies": {
"cdbi" : ">= 2.0.0",
"html" : ">= 2.0.0",
"keydb": ">= 2.0.0",
"wui" : ">= 2.0.0"
},
"compilerCompatibility": {
......
......@@ -27,7 +27,7 @@ generateControllersForEntity erdname allEntities
simpleCurryProg
(controllerModuleName ename)
-- imports:
[ spiceyModule, "Database.KeyDatabaseSQLite", "HTML.Base", "Time"
[ spiceyModule, "HTML.Base", "Time"
, erdname, viewModuleName ename
, "Maybe", sessionInfoModule, authorizationModule, enauthModName
, "Config.UserProcesses",
......@@ -117,7 +117,7 @@ mainController erdname (Entity entityName _) _ _ =
where
readKey = applyF (erdname,"read"++entityName++"Key") [CVar (2,"s")]
getEntityOp = applyF (pre ".")
[constF (db "runJustT"),
[constF (erdname,"runJustT"),
constF (erdname,"get"++entityName)]
-- generates a controller to show a form to create a new entity
......@@ -128,8 +128,8 @@ newController erdname (Entity entityName attrList) relationships allEntities =
let
manyToManyEntities = manyToMany allEntities (Entity entityName attrList)
manyToOneEntities = manyToOne (Entity entityName attrList) relationships
withCTime = hasCalendarTimeAttribute attrList
infovar = (0, "sinfo")
withCTime = hasDateAttribute attrList
infovar = (0,"sinfo")
ctimevar = (1,"ctime")
in
controllerFunction
......@@ -147,14 +147,14 @@ newController erdname (Entity entityName attrList) relationships allEntities =
(map
(\ (ename, num) ->
CSPat (CPVar (num,"all"++ename++"s"))
(applyF (db "runQ")
(applyF (erdname,"runQ")
[constF (erdname,"queryAll"++ename++"s")])
)
(zip (manyToOneEntities ++ manyToManyEntities) [2..])
) ++
(if withCTime
then [CSPat (CPVar ctimevar)
(constF ("Time","getLocalTime"))]
(constF ("Time","getClockTime"))]
else []) ++
[
CSExpr (
......@@ -167,7 +167,7 @@ newController erdname (Entity entityName attrList) relationships allEntities =
[2..]) ++
[CLambda [CPVar (200,"entity")]
(applyF (spiceyModule,"transactionController")
[applyF (db "runT")
[applyF (erdname,"runT")
[applyF (transFunctionName entityName "create")
[CVar (200,"entity")]],
applyF (spiceyModule,"nextInProcessOr")
......@@ -200,7 +200,7 @@ createTransaction erdname (Entity entityName attrList) relationships allEntities
(tupleType (map attrType notGeneratedAttributes ++
map ctvar manyToOneEntities ++
map (listType . ctvar) manyToManyEntities)
~> applyTC (db "Transaction") [baseType (pre "()")])
~> applyTC (dbconn "DBAction") [baseType (pre "()")])
[simpleRule
[tuplePattern
(map (\ (param, varId) -> CPVar (varId, param))
......@@ -208,8 +208,8 @@ createTransaction erdname (Entity entityName attrList) relationships allEntities
map (\e -> (lowerFirst e) ++ "s") manyToManyEntities)
[1..]))
] -- parameterlist for controller
(applyF (db "|>>")
[foldr1 (\a b -> applyF (db "|>>=") [a,b])
(applyF (dbconn ">+")
[foldr1 (\a b -> applyF (dbconn ">+=") [a,b])
([applyF (entityConstructorFunction erdname (Entity entityName attrList) relationships)
(map (\ ((Attribute name dom key null), varId) ->
if (isForeignKey (Attribute name dom key null))
......@@ -224,7 +224,7 @@ createTransaction erdname (Entity entityName attrList) relationships allEntities
)
] ++ (map (\name -> applyF (controllerModuleName entityName, "add"++(linkTableName entityName name allEntities)) [cvar ((lowerFirst name)++"s")]) manyToManyEntities)
),
applyF (db "returnT") [constF (pre "()")]]
applyF (dbconn "ok") [constF (pre "()")]]
)]
editController :: ControllerGenerator
......@@ -250,7 +250,7 @@ editController erdname (Entity entityName attrList) relationships allEntities =
(map
(\ (ename, num) ->
CSPat (CPVar (num,"all"++ename++"s"))
(applyF (db "runQ")
(applyF (erdname,"runQ")
[constF (erdname,"queryAll"++ename++"s")])
)
(zip (manyToOneEntities ++ manyToManyEntities) [1..])
......@@ -258,7 +258,7 @@ editController erdname (Entity entityName attrList) relationships allEntities =
(map
(\ (ename, num) -> CSPat (CPVar (num,(lowerFirst (fst $ relationshipName entityName ename relationships))++ename))
(
applyF (db "runJustT") [
applyF (erdname,"runJustT") [
applyF (controllerModuleName entityName,"get"++(fst $ relationshipName entityName ename relationships)++ename) [CVar pvar]
]
)
......@@ -268,7 +268,7 @@ editController erdname (Entity entityName attrList) relationships allEntities =
(map
(\ (ename, num) -> CSPat (CPVar (num,(lowerFirst (linkTableName entityName ename allEntities))++ename++"s"))
(
applyF (db "runJustT") [
applyF (erdname,"runJustT") [
applyF (controllerModuleName entityName,"get"++entityName++ename++"s") [CVar pvar]
]
)
......@@ -301,7 +301,7 @@ editController erdname (Entity entityName attrList) relationships allEntities =
[1..])) ++
[CLambda [CPVar (200,"entity")]
(applyF (spiceyModule,"transactionController")
[applyF (db "runT")
[applyF (erdname,"runT")
[applyF (transFunctionName entityName "update")
[CVar (200,"entity")]],
applyF (spiceyModule,"nextInProcessOr")
......@@ -330,7 +330,7 @@ updateTransaction erdname (Entity entityName attrList) _ allEntities =
2 Private
(tupleType ([baseType (erdname, entityName)] ++
map (\name -> listType (ctvar name)) manyToManyEntities)
~> applyTC (db "Transaction") [baseType (pre "()")]
~> applyTC (dbconn "DBAction") [baseType (pre "()")]
)
[simpleRule
[tuplePattern
......@@ -341,11 +341,11 @@ updateTransaction erdname (Entity entityName attrList) _ allEntities =
manyToManyEntities)
[1..])))
] -- parameter list for controller
(foldr1 (\a b -> applyF (db "|>>") [a,b])
(foldr1 (\a b -> applyF (dbconn ">+") [a,b])
([applyF (erdname, "update"++entityName)
[cvar (lowerFirst entityName)]] ++
(map (\name ->
applyF (db "|>>=") [
applyF (dbconn ">+=") [
applyF (controllerModuleName entityName,"get"++entityName++name++"s") [cvar (lowerFirst entityName)],
CLambda [CPVar(0, "old"++(linkTableName entityName name allEntities)++name++"s")] (applyF (controllerModuleName entityName, "remove"++(linkTableName entityName name allEntities)) [cvar ("old"++(linkTableName entityName name allEntities)++name++"s"), cvar (lowerFirst entityName)])
]
......@@ -385,7 +385,7 @@ deleteController erdname (Entity entityName _) _ _ =
[CVar entvar],
string2ac "\"?"]]]]]],
applyF (spiceyModule,"transactionController")
[applyF (db "runT")
[applyF (erdname,"runT")
[applyF (transFunctionName entityName "delete")
[CVar entvar]],
constF (controllerFunctionName entityName "list")],
......@@ -404,12 +404,12 @@ deleteTransaction erdname (Entity entityName attrList) _ allEntities =
(transFunctionName entityName "delete")
1 Private
(baseType (erdname, entityName) ~>
applyTC (db "Transaction") [baseType (pre "()")])
applyTC (dbconn "DBAction") [baseType (pre "()")])
[simpleRule
[CPVar entvar] -- entity parameter for controller
(foldr1 (\a b -> applyF (db "|>>") [a,b])
(foldr1 (\a b -> applyF (dbconn ">+") [a,b])
(map (\name ->
applyF (db "|>>=")
applyF (dbconn ">+=")
[applyF (controllerModuleName entityName,
"get"++entityName++name++"s")
[CVar entvar],
......@@ -441,7 +441,7 @@ listController erdname (Entity entityName _) _ _ =
CLambda [CPVar infovar] $
CDoExpr (
[CSPat (CPVar entsvar)
(applyF (db "runQ")
(applyF (erdname,"runQ")
[constF (erdname,"queryAll"++entityName++"s")]),
CSExpr (applyF (pre "return")
[applyF (viewFunctionName entityName "list")
......@@ -474,7 +474,7 @@ showController erdname (Entity entityName attrList) relationships allEntities =
CSPat (CPVar (num,lowerFirst
(fst $ relationshipName entityName
ename relationships) ++ ename))
(applyF (db "runJustT")
(applyF (erdname,"runJustT")
[applyF (controllerModuleName entityName,
"get"++ fst (relationshipName
entityName ename relationships)
......@@ -488,7 +488,7 @@ showController erdname (Entity entityName attrList) relationships allEntities =
CSPat (CPVar (num,lowerFirst (linkTableName entityName
ename allEntities)
++ename++"s"))
(applyF (db "runJustT")
(applyF (erdname,"runJustT")
[applyF (controllerModuleName entityName,
"get"++entityName++ename++"s")
[CVar pvar]])
......@@ -535,10 +535,10 @@ manyToManyAddOrRemove erdname (Entity entityName _) entities allEntities =
(controllerModuleName e1, funcPrefix++(linkTableName e1 e2 allEntities))
2
Private
(listType (ctvar e2) ~> ctvar e1 ~> applyTC (db "Transaction")
(listType (ctvar e2) ~> ctvar e1 ~> applyTC (dbconn "DBAction")
[tupleType []])
[simpleRule [CPVar (0, (lowerFirst e2)++"s"), CPVar (1, (lowerFirst e1))]
(applyF (db "mapT_")
(applyF (dbconn "mapDBAction_")
[CLambda [CPVar(2, "t")]
(applyF (erdname, dbFuncPrefix++(linkTableName e1 e2 allEntities))
[applyF (erdname, (lowerFirst e1)++"Key") [cvar (lowerFirst e1)],
......@@ -558,8 +558,8 @@ getAll erdname (Entity entityName _) entities _ =
Private
(ioType (listType (ctvar foreignEntity)))
[simpleRule []
(applyF (db "runQ")
[applyF (db "queryAll")
(applyF (erdname,"runQ")
[applyF (erdname,"queryAll")
[CLambda [CPVar(0, take 1 (lowerFirst foreignEntity) )]
(CLetDecl [(CLocalVars [(1,"key")])]
(applyF (erdname, lowerFirst foreignEntity)
......@@ -581,9 +581,10 @@ manyToManyGetRelated erdname (Entity entityName _) entities allEntities =
(controllerModuleName entityName, "get"++(linkTableName entityName foreignEntity allEntities)++foreignEntity++"s")
0
Private
(ctvar entityName ~> applyTC (db "Query") [listType (ctvar foreignEntity)])
(ctvar entityName ~> applyTC (dbconn "DBAction")
[listType (ctvar foreignEntity)])
[simpleRule [CPVar (1, (take 1 $ lowerFirst entityName)++foreignEntity)]
(applyF (db "queryAll")
(applyF (erdname,"queryAll")
[CLambda [CPVar(0, take 1 (lowerFirst foreignEntity) )]
(CLetDecl
[CLocalVars [(1,(take 1 $ lowerFirst entityName)++"key"),
......@@ -618,7 +619,7 @@ manyToOneGetRelated erdname (Entity entityName _) entities _ relationships =
"get"++rname++foreignEntity)
0
Private
((ctvar entityName) ~> applyTC (db "Transaction") [ctvar foreignEntity])
((ctvar entityName) ~> applyTC (dbconn "DBAction") [ctvar foreignEntity])
[simpleRule [CPVar argvar]
(applyF (erdname,"get"++foreignEntity)
[applyF (erdname,fkeysel) [CVar argvar]])]
......
......@@ -202,6 +202,6 @@ domainToString domain =
CharDom _ -> "char"
StringDom _ -> "string"
BoolDom _ -> "bool"
DateDom _ -> "calendarTime"
DateDom _ -> "date"
UserDefined _ _ -> "userDefined"
KeyDom _ -> "key"
\ No newline at end of file
......@@ -20,9 +20,9 @@ upperFirst [] = [] -- this case should not occur, but one never knows...
------------------------------------------------------------------------
--- Converts a string into a qualified name of the module
--- "Database.KeyDatabaseSQLite".
db :: String -> QName
db f = ("Database.KeyDatabaseSQLite", f)
--- "Database.CDBI.Connection".
dbconn :: String -> QName
dbconn f = ("Database.CDBI.Connection", f)
--- Converts a string into a qualified name of the module "HTML.Base".
html :: String -> QName
......@@ -181,7 +181,7 @@ attrType (Attribute _ t k False) =
(FloatDom _) -> ctvar "Float"
(StringDom _ ) -> ctvar "String"
(BoolDom _) -> ctvar "Bool"
(DateDom _) -> ctvar "CalendarTime"
(DateDom _) -> ctvar "ClockTime"
(UserDefined s _)-> ctvar s
(KeyDom _) -> ctvar "Key"
_ -> ctvar "Int"
......@@ -192,7 +192,7 @@ attrType (Attribute _ t k True) =
(FloatDom _) -> maybeType (ctvar "Float")
(StringDom _ ) -> ctvar "String"
(BoolDom _) -> maybeType (ctvar "Bool")
(DateDom _) -> maybeType (ctvar "CalendarTime")
(DateDom _) -> maybeType (ctvar "ClockTime")
(UserDefined s _)-> maybeType (ctvar s)
(KeyDom _) -> maybeType (ctvar "Key")
_ -> maybeType (ctvar "Int")
......@@ -217,8 +217,9 @@ attrDefaultValues defaultctime attrs = map defaultValue attrs
BoolDom (Just b) -> addJust (constF (pre (if b then "True" else "False")))
DateDom Nothing -> nothingOrDefault
DateDom (Just (CalendarTime y mo d h m s tz))
-> addJust (applyF ("Time", "CalendarTime")
(map (CLit . CIntc) [y,mo,d,h,m,s,tz]))
-> addJust (applyF ("Time", "toClockTime")
[applyF ("Time", "CalendarTime")
(map (CLit . CIntc) [y,mo,d,h,m,s,tz])])
UserDefined _ _ -> nothingOrDefault
KeyDom _ -> nothingOrDefault
_ -> error "GenerationHelper.attrDefaultValues: unknown domain for attribute"
......@@ -253,10 +254,10 @@ isStringDom dom = case dom of
StringDom _ -> True
_ -> False
hasCalendarTimeAttribute :: [Attribute] -> Bool
hasCalendarTimeAttribute = any isCalendarTime
hasDateAttribute :: [Attribute] -> Bool
hasDateAttribute = any isDate
where
isCalendarTime (Attribute _ domain _ _) = case domain of
isDate (Attribute _ domain _ _) = case domain of
DateDom _ -> True
_ -> False
......@@ -306,7 +307,8 @@ widgetFor domain null =
if null
then applyF (spiceyModule,"wUncheckMaybe")
[domainDefaultValue
(applyF ("Time", "CalendarTime")
(map (CLit . CIntc) [2016,1,1,0,0,0,0]))
(applyF ("Time", "toClockTime")
[applyF ("Time", "CalendarTime")
(map (CLit . CIntc) [2018,1,1,0,0,0,0])])
domain, e]
else e
......@@ -12,7 +12,7 @@ import FilePath ( (</>) )
import IO
import System(system)
import ERD2Curry ( erd2curryWithDBandERD )
import ERD2Curry ( erd2cdbiWithDBandERD )
import Database.ERD.Goodies
import Spicey.ControllerGeneration
......@@ -86,13 +86,15 @@ createHtmlHelpers _ (ERD name entities relationship) path _ =
-- uses Curry's ertools for ERD to Curry transformation
createModels :: String -> ERD -> String -> String -> IO ()
createModels term_path erd path db_path = do
let dbfile = if null db_path then erdName erd ++ ".db"
let erdname = erdName erd
dbfile = if null db_path then erdname ++ ".db"
else db_path
erd2curryWithDBandERD dbfile term_path
let orgerdfile = erdName erd ++ "_ERD.term"
transerdfile = erdName erd ++ "_ERDT.term"
curryfile = erdName erd ++ ".curry"
system $ unwords ["mv", transerdfile, curryfile, "ERDGeneric.curry", path]
erd2cdbiWithDBandERD dbfile term_path
let orgerdfile = erdname ++ "_ERD.term"
transerdfile = erdname ++ "_ERDT.term"
curryfile = erdname ++ ".curry"
infofile = erdname ++ "_SQLCode.info"
system $ unwords ["mv", transerdfile, curryfile, infofile, path]
system $ unwords ["cp", term_path, path </> orgerdfile]
done
......
......@@ -16,7 +16,7 @@ import Spicey.Scaffolding
systemBanner :: String
systemBanner =
let bannerText = "Spicey Web Framework (Version " ++ packageVersion ++
" of 03/01/18)"
" of 04/01/18)"
bannerLine = take (length bannerText) (repeat '-')
in bannerLine ++ "\n" ++ bannerText ++ "\n" ++ bannerLine
......
......@@ -356,7 +356,7 @@ blankView _ (Entity entityName attrlist) relationships allEntities =
let
manyToManyEntities = manyToMany allEntities (Entity entityName attrlist)
manyToOneEntities = manyToOne (Entity entityName attrlist) relationships
withCTime = hasCalendarTimeAttribute attrlist
withCTime = hasDateAttribute attrlist
infovar = (0, "sinfo")
in
viewFunction
......@@ -366,7 +366,7 @@ blankView _ (Entity entityName attrlist) relationships allEntities =
( -- function type
userSessionInfoType ~>
foldr CFuncType viewBlockType (
(if withCTime then [baseType ("Time","CalendarTime")] else []) ++
(if withCTime then [baseType ("Time","ClockTime")] else []) ++
(map (\e -> listType (ctvar e))
(manyToOneEntities ++ manyToManyEntities)) ++ -- possible values
[entityInterface attrlist manyToOneEntities manyToManyEntities
......
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