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

CDBI: eDescription renamed to e_CDBI_Description to avoid name clashes with ER...

CDBI: eDescription renamed to e_CDBI_Description to avoid name clashes with ER model, string with null values: Maybe type omitted
parent 41e2535a
......@@ -6,14 +6,14 @@ import Time
createTestData :: IO ()
createTestData = do
conn <- connectSQLite "Uni.db"
result <- ((insertEntries studentList studentDescription) >+
(insertEntries lectureList lectureDescription) >+
(insertEntries lecturerList lecturerDescription) >+
(insertEntries placeList placeDescription) >+
(insertEntries timeList timeDescription) >+
(insertEntries examList examDescription) >+
(insertEntries resultList resultDescription) >+
(insertEntries participList participationDescription) >+
result <- ((insertEntries studentList student_CDBI_Description) >+
(insertEntries lectureList lecture_CDBI_Description) >+
(insertEntries lecturerList lecturer_CDBI_Description) >+
(insertEntries placeList place_CDBI_Description) >+
(insertEntries timeList time_CDBI_Description) >+
(insertEntries examList exam_CDBI_Description) >+
(insertEntries resultList result_CDBI_Description) >+
(insertEntries participList participation_CDBI_Description) >+
(insertEntryCombined sse1 sseDescription)
) conn
case result of
......@@ -36,10 +36,10 @@ lecturer3 = Lecturer (LecturerID 3) "Hansen" "Frank"
-- Lectures
lectureList = [lecture1, lecture2, lecture3]
lecture1 = Lecture (LectureID 1) "Fortgeschrittene Programmierung"
(Just "Funktionale und Deklarative Programmierung wird vertieft.") (LecturerID 1)
lecture2 = Lecture (LectureID 2) "Technische Informatik" Nothing (LecturerID 2)
"Funktionale und Deklarative Programmierung wird vertieft." (LecturerID 1)
lecture2 = Lecture (LectureID 2) "Technische Informatik" "" (LecturerID 2)
lecture3 = Lecture (LectureID 3) "Datenbanken"
(Just "Theoretische Grundlagen rund um Datenbanken und SQL wird den Studenten näher gebracht.") (LecturerID 3)
"Theoretische Grundlagen rund um Datenbanken und SQL wird den Studenten näher gebracht." (LecturerID 3)
-- Places
placeList = [place1, place2]
......@@ -71,13 +71,13 @@ result6 = Result (ResultID 6) 1 (Just 5.0) (Just 20) (StudentID 4) (ExamID 1)
result7 = Result (ResultID 7) 2 (Just 5.0) (Just 39) (StudentID 4) (ExamID 2)
result8 = Result (ResultID 8) 1 (Just 5.0) (Just 49) (StudentID 4) (ExamID 3)
cd = combineDescriptions studentDescription 0 examDescription 0
cd = combineDescriptions student_CDBI_Description 0 exam_CDBI_Description 0
(\st ex -> (StudentStudentExam _ st ex))
(\(StudentStudentExam _ st ex) -> (st, ex))
data StudentStudentExam = StudentStudentExam Student Student Exam
sseDescription =
addDescription studentDescription 1
addDescription student_CDBI_Description 1
(\st1 (StudentStudentExam _ st2 ex) -> (StudentStudentExam st1 st2 ex))
(\(StudentStudentExam st _ _) -> st) cd
......
......@@ -19,5 +19,5 @@ Show the database with sqlite3:
Testing some queries:
> curry :l SelectExamples
...> testS1
...> queryS1
......@@ -232,9 +232,9 @@ getTwoEntStr :: String -> [Table] -> PM [CExpr]
getTwoEntStr mModel ((Table name1 _ al1):(Table name2 _ al2):_)=
(cleanPM [(applyF
(mCDBI, "combineDescriptions")
[(constF (mModel, ((firstLow name1)++"Description"))),
[(constF (mModel, entity2Description name1)),
(cvar(show al1)),
(constF (mModel, ((firstLow name2)++"Description"))),
(constF (mModel, entity2Description name2)),
(cvar (show al2)),
(CLambda [(cpvar "e1"), (cpvar "e2")]
(applyF (pre "(,)") [(cvar "e1"), (cvar "e2")])),
......@@ -245,7 +245,7 @@ getThreeEntStr :: String -> [Table] -> PM [CExpr]
getThreeEntStr mModel ((Table name1 _ al1):(Table name2 _ al2):(Table name3 _ al3):_)=
(cleanPM
[(applyF (mCDBI, "addDescription")
[(constF (mModel, ((firstLow name3)++"Description"))),
[(constF (mModel, entity2Description name3)),
(cvar(show al3)),
(CLambda [(cpvar "e3"),
(tuplePattern [(cpvar "e1"),
......@@ -259,9 +259,9 @@ getThreeEntStr mModel ((Table name1 _ al1):(Table name2 _ al2):(Table name3 _ al
(cpvar "e3")])]
(cvar "e3")),
(applyF (mCDBI, "combineDescriptions")
[(constF (mModel, ((firstLow name1)++"Description"))),
[(constF (mModel, entity2Description name1)),
(cvar(show al1)),
(constF (mModel, ((firstLow name2)++"Description"))),
(constF (mModel, entity2Description name2)),
(cvar(show al2)),
(CLambda [(cpvar "e1"), (cpvar "e2")]
(applyF (pre "(,,)") [(cvar "e1"),
......@@ -677,7 +677,7 @@ transInsertValues mModel ((Column _ _ _ nl _):cs) (v:vs) =
-- Traslation of table name as used in update, insert and delete.
transTableName :: String -> Table -> PM CExpr
transTableName mModel (Table tab _ _) =
cleanPM (constF (mModel, ((firstLow tab)++"Description ")))
cleanPM (constF (mModel, entity2Description tab))
-- Translation of values as used in insert statements.
transValue :: String -> Value -> Bool -> CExpr
......@@ -934,4 +934,8 @@ firstUp (s:str) = (toUpper s):str
firstLow :: String -> String
firstLow [] = []
firstLow (s:str) = (toLower s):str
\ No newline at end of file
-- Translates an entity name into its description operation
-- generated by ERD2CDBI.
entity2Description :: String -> String
entity2Description name = firstLow name ++ "_CDBI_Description"
--- ----------------------------------------------------------------------------
--- This module creates all the needed datatypes, a SQLite database from an
--- x_ERDT.term (An ER-Model that was translated by erd2curry) and a .info-file
--- needed by currypp when preprocessing SQL
--- This module creates all datatypes to represent the entities and
--- relations of a relational (SQLite) database corresponding to a
--- logical ER model specified in a file `x_ERDT.term` (which is
--- a transformed ER-Model that was translated by erd2curry).
--- It produces a Curry program `x_CDBI.curry` and a file
--- `x_SQLCODE.info` that is used when embedded SQL statements are
--- translated by the Curry preprocessor `currypp`.
---
--- @author Mike Tallarek, extensions by Julia Krone
--- @version 0.2
......@@ -36,7 +40,7 @@ main = do
args <- getArgs
case args of
[erdfname, dbPath] -> do erdterm <- translateERD2ERDT erdfname
writeCDBI erdterm dbPath
writeCDBI erdfname erdterm dbPath
_ -> showUsageString
showUsageString :: IO ()
......@@ -62,20 +66,22 @@ translateERD2ERDT erdfname = do
-- Write all the data so CDBI can be used, create a database
-- when option is set and a .info file
writeCDBI :: ERD -> String -> IO ()
writeCDBI (ERD name ents rels) dbPath = do
file <- openFile (name++"_CDBI"++".curry") WriteMode
let imports = [ "Time"
writeCDBI :: String -> ERD -> String -> IO ()
writeCDBI erdfname (ERD name ents rels) dbPath = do
let cdbiFile = name++"_CDBI"++".curry"
imports = [ "Time"
, "Database.CDBI.ER"
, "Database.CDBI.Criteria"
, "Database.CDBI.Connection"
, "Database.CDBI.Description"]
let typeDecls = foldr ((++) . (getEntityTypeDecls (name++"_CDBI"))) [] ents
let funcDecls = foldr ((++) . (getEntityFuncDecls (name++"_CDBI"))) [] ents
hPutStrLn file
(pPrint (ppCurryProg defaultOptions
(CurryProg (name++"_CDBI") imports typeDecls funcDecls [])))
hClose file
typeDecls = foldr ((++) . (getEntityTypeDecls (name++"_CDBI"))) [] ents
funcDecls = foldr ((++) . (getEntityFuncDecls (name++"_CDBI"))) [] ents
writeFile cdbiFile $
"--- This file has been generated from `"++erdfname++"`\n"++
"--- and contains definition for all entities and relations\n"++
"--- specified in this model.\n\n"++
pPrint (ppCurryProg defaultOptions
(CurryProg (name++"_CDBI") imports typeDecls funcDecls []))
infofilehandle <- openFile (name++"_SQLCode.info") WriteMode
writeParserFile infofilehandle name ents rels dbPath
hClose infofilehandle
......@@ -299,7 +305,7 @@ getEntityFuncDecls mName ent =
-- Generates an entity-description based on an entity.
writeDescription :: String -> Entity -> CFuncDecl
writeDescription mName (Entity name@(n:ns) attrs) =
cfunc (mName, (((toLower n) : ns) ++ "Description" ))
cfunc (mName, (((toLower n) : ns) ++ "_CDBI_Description" ))
0
Public
(CTCons (mDescription, "EntityDescription") [baseType (mName, name)])
......@@ -490,7 +496,7 @@ writeAttrRightOneTwo _ (Attribute (a:b) (CharDom _) _ True) =
writeAttrRightOneTwo _ (Attribute (a:b) (StringDom _) _ False) =
applyE (CSymbol (mConnection, "SQLString")) [cvar ((toLower a):b)]
writeAttrRightOneTwo _ (Attribute (a:b) (StringDom _) _ True) =
applyF (mDescription, "sqlStringOrNull") [cvar ((toLower a):b)]
applyF (mDescription, "sqlString") [cvar ((toLower a):b)]
writeAttrRightOneTwo _ (Attribute (a:b) (BoolDom _) _ False) =
applyE (CSymbol (mConnection, "SQLBool")) [cvar ((toLower a):b)]
writeAttrRightOneTwo _ (Attribute (a:b) (BoolDom _) _ True) =
......@@ -530,7 +536,7 @@ writeAttrRightThree _ _ (Attribute (a:b) (FloatDom _) NoKey True) =
writeAttrRightThree _ _ (Attribute (a:b) (CharDom _) NoKey True) =
applyF (mDescription, "charOrNothing") [cvar ((toLower a):b)]
writeAttrRightThree _ _ (Attribute (a:b) (StringDom _) NoKey True) =
applyF (mDescription, "stringOrNothing") [cvar ((toLower a):b)]
applyF (mDescription, "fromStringOrNull") [cvar ((toLower a):b)]
writeAttrRightThree _ _ (Attribute (a:b) (BoolDom _) NoKey True) =
applyF (mDescription, "boolOrNothing") [cvar ((toLower a):b)]
writeAttrRightThree _ _ (Attribute (a:b) (DateDom _) NoKey True) =
......@@ -545,7 +551,7 @@ writeAttrRightThree _ _ (Attribute (a:b) (FloatDom _) Unique True) =
writeAttrRightThree _ _ (Attribute (a:b) (CharDom _) Unique True) =
applyF (mDescription, "charOrNothing") [cvar ((toLower a):b)]
writeAttrRightThree _ _ (Attribute (a:b) (StringDom _) Unique True) =
applyF (mDescription, "stringOrNothing") [cvar ((toLower a):b)]
applyF (mDescription, "fromStringOrNull") [cvar ((toLower a):b)]
writeAttrRightThree _ _ (Attribute (a:b) (BoolDom _) Unique True) =
applyF (mDescription, "boolOrNothing") [cvar ((toLower a):b)]
writeAttrRightThree _ _ (Attribute (a:b) (DateDom _) Unique True) =
......@@ -573,23 +579,19 @@ writeAttributes mName name (Attribute a (IntDom _) _ False) =
case a of
"Key" -> baseType (mName , (name++"ID"))
_ -> intType
writeAttributes _ _ (Attribute _ (FloatDom _) _ True) = maybeType floatType
writeAttributes _ _ (Attribute _ (FloatDom _) _ False) = floatType
writeAttributes _ _ (Attribute _ (CharDom _) _ True) =
maybeType (baseType (pre "Char"))
writeAttributes _ _ (Attribute _ (CharDom _) _ False) = (baseType (pre "Char"))
writeAttributes _ _ (Attribute _ (StringDom _) _ True) = maybeType stringType
writeAttributes _ _ (Attribute _ (StringDom _) _ False) = stringType
writeAttributes _ _ (Attribute _ (BoolDom _) _ True) = maybeType boolType
writeAttributes _ _ (Attribute _ (BoolDom _) _ False) = boolType
writeAttributes _ _ (Attribute _ (DateDom _) _ True) =
maybeType (baseType ("Time", "ClockTime"))
writeAttributes _ _ (Attribute _ (DateDom _) _ False) =
(baseType ("Time", "ClockTime"))
writeAttributes mName _ (Attribute _ (KeyDom k) _ True) =
maybeType (baseType (mName ,(k++"ID")))
writeAttributes mName _ (Attribute _ (KeyDom k) _ False) =
(baseType (mName ,(k++"ID")))
writeAttributes _ _ (Attribute _ (FloatDom _) _ null) =
addMaybeIfNull null floatType
writeAttributes _ _ (Attribute _ (CharDom _) _ null) =
addMaybeIfNull null (baseType (pre "Char"))
writeAttributes _ _ (Attribute _ (StringDom _) _ _) = stringType
writeAttributes _ _ (Attribute _ (BoolDom _) _ n) = addMaybeIfNull n boolType
writeAttributes _ _ (Attribute _ (DateDom _) _ null) =
addMaybeIfNull null (baseType ("Time", "ClockTime"))
writeAttributes mName _ (Attribute _ (KeyDom k) _ null) =
addMaybeIfNull null (baseType (mName ,(k++"ID")))
addMaybeIfNull :: Bool -> CTypeExpr -> CTypeExpr
addMaybeIfNull isnull texp = if isnull then maybeType texp else texp
-- Generates attribute types to create an entity-description.
writeTypes :: Attribute -> CExpr
......
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