diff --git a/src/Database/Design/Ampersand/FSpec/FSpec.hs b/src/Database/Design/Ampersand/FSpec/FSpec.hs index c02ef866ce..4ecec726cf 100644 --- a/src/Database/Design/Ampersand/FSpec/FSpec.hs +++ b/src/Database/Design/Ampersand/FSpec/FSpec.hs @@ -22,7 +22,7 @@ module Database.Design.Ampersand.FSpec.FSpec , lookupCpt, getConceptTableFor , RelStore(..) , metaValues - , SqlAttribute(..) + , SqlAttribute(..),isPrimaryKey,isForeignKey , Typology(..) , Interface(..) , Object(..) @@ -316,7 +316,7 @@ data RelStore , rsSrcAtt :: SqlAttribute , rsTrgAtt :: SqlAttribute } deriving (Show, Typeable) -data SqlAttributeUsage = TableKey Bool A_Concept -- The SQL-attribute is the (primary) key of the table. (The boolean tells whether or not it is primary) +data SqlAttributeUsage = PrimaryKey A_Concept | ForeignKey A_Concept -- The SQL-attribute is a reference (containing the primary key value of) a TblSQL | PlainAttr -- None of the above deriving (Eq, Show) @@ -340,6 +340,15 @@ instance ConceptStructure SqlAttribute where concs f = [target e' |let e'=attExpr f,isSur e'] expressionsIn f = expressionsIn (attExpr f) +isPrimaryKey :: SqlAttribute -> Bool +isPrimaryKey att = case attUse att of + PrimaryKey _ -> True + _ -> False +isForeignKey :: SqlAttribute -> Bool +isForeignKey att = case attUse att of + ForeignKey _ -> True + _ -> False + showSQL :: TType -> String showSQL tt = case tt of diff --git a/src/Database/Design/Ampersand/FSpec/ShowHS.hs b/src/Database/Design/Ampersand/FSpec/ShowHS.hs index 832b457741..87f5f95d98 100644 --- a/src/Database/Design/Ampersand/FSpec/ShowHS.hs +++ b/src/Database/Design/Ampersand/FSpec/ShowHS.hs @@ -163,9 +163,9 @@ instance ShowHS SqlAttribute where indentB = indentA++" " -- adding the width of ", attExpr = " instance ShowHS SqlAttributeUsage where - showHS _ _ (TableKey isPrimary aCpt) = "TableKey " ++show isPrimary++" "++showHSName aCpt - showHS _ _ (ForeignKey aCpt) = "ForeignKey "++showHSName aCpt - showHS _ _ PlainAttr = "PlainAttr " + showHS _ _ (PrimaryKey aCpt) = "PrimaryKey "++showHSName aCpt + showHS _ _ (ForeignKey aCpt) = "ForeignKey "++showHSName aCpt + showHS _ _ PlainAttr = "PlainAttr " instance ShowHS TType where showHS _ indent tt = indent ++ show tt diff --git a/src/Database/Design/Ampersand/FSpec/ToFSpec/ADL2Plug.hs b/src/Database/Design/Ampersand/FSpec/ToFSpec/ADL2Plug.hs index a64d63df8f..9eabb43905 100644 --- a/src/Database/Design/Ampersand/FSpec/ToFSpec/ADL2Plug.hs +++ b/src/Database/Design/Ampersand/FSpec/ToFSpec/ADL2Plug.hs @@ -89,7 +89,7 @@ makeGeneratedSqlPlugs opts context calcProps = conceptTables ++ linkTables , attType = repr cpt , attUse = if cpt == tableKey && repr cpt == Object -- For scalars, we do not want a primary key. This is a workaround fix for issue #341 - then TableKey True cpt + then PrimaryKey cpt else PlainAttr , attNull = not . isTot $ expr , attDBNull = cpt /= tableKey diff --git a/src/Database/Design/Ampersand/Output/ToPandoc/ChapterDataAnalysis.hs b/src/Database/Design/Ampersand/Output/ToPandoc/ChapterDataAnalysis.hs index dfaaefd05d..ec0a71ad0f 100644 --- a/src/Database/Design/Ampersand/Output/ToPandoc/ChapterDataAnalysis.hs +++ b/src/Database/Design/Ampersand/Output/ToPandoc/ChapterDataAnalysis.hs @@ -304,35 +304,22 @@ chpDataAnalysis fSpec = (theBlocks, thePictures) showAttributes atts = bulletList (map showAttribute atts) where showAttribute att = ---FIXME 20140525: Onderstaande code vervangen door afl te leiden van `attUse`. Daar zit deze info al in verwerkt! - let isPrimaryKey = case attExpr att of - e@EDcI{} -> e==attExpr (head atts) -- The first attribute represents the most general concept - _ -> False - mForeignKey = case attExpr att of - EIsc (EDcI c,_) -> Just c - _ -> Nothing - in para ( (strong.text.attName) att + para ( (strong.text.attName) att <> linebreak - <> (if isPrimaryKey - then case fsLang fSpec of - Dutch -> "Dit attribuut is de primaire sleutel. " - English -> "This attribute is the primary key. " - else - case mForeignKey of - Just c -> case fsLang fSpec of - Dutch -> "Dit attribuut verwijst naar een voorkomen in de tabel " - English -> "This attribute is a foreign key to " - <> (text.name) c - Nothing -- (no foreign key...) - -> --if isBool - --then - --else - (case fsLang fSpec of - Dutch -> "Dit attribuut implementeert " - English -> "This attribute implements " - <> primExpr2pandocMath (fsLang fSpec) (attExpr att) - <> "." - ) + <> (case attUse att of + PrimaryKey _ -> case fsLang fSpec of + Dutch -> "Dit attribuut is de primaire sleutel. " + English -> "This attribute is the primary key. " + ForeignKey c -> case fsLang fSpec of + Dutch -> "Dit attribuut verwijst naar een voorkomen in de tabel " + English -> "This attribute is a foreign key to " + <> (text.name) c + PlainAttr -> ( case fsLang fSpec of + Dutch -> "Dit attribuut implementeert " + English -> "This attribute implements " + <> primExpr2pandocMath (fsLang fSpec) (attExpr att) + <> "." + ) ) <> linebreak <> (code.show.attType) att diff --git a/src/Database/Design/Ampersand/Prototype/Generate.hs b/src/Database/Design/Ampersand/Prototype/Generate.hs index 42f866c0b4..a6956572ec 100644 --- a/src/Database/Design/Ampersand/Prototype/Generate.hs +++ b/src/Database/Design/Ampersand/Prototype/Generate.hs @@ -58,9 +58,8 @@ generateDBstructQueries fSpec withComment <>[" ) ENGINE="<>dbEngine] ): [ ["CREATE INDEX "<>show (tsName ts<>"_"<>name fld)<>" ON "<>show (tsName ts)<>" ("<>show (name fld)<>")"] - | fld <- case tsflds ts of - _:xs -> xs - _ -> fatal 55 $ "A table with no fields found! ("<>show (tsName ts)<>")" + | fld <- tsflds ts + , not (isPrimaryKey fld) , suitableAsKey (attType fld) ] fld2sql :: SqlAttribute -> String @@ -108,9 +107,9 @@ plug2TableSpec plug (BinSQL{}, _) -> [] (TblSQL{}, primFld) -> case attUse primFld of - TableKey isPrim _ -> ["PRIMARY " <> "KEY (" <> (show . attName) primFld <> ")" | isPrim] - ForeignKey c -> fatal 195 ("ForeignKey "<>name c<>"not expected here!") - PlainAttr -> [] + PrimaryKey _ -> ["PRIMARY KEY (`" <> (show . attName) primFld <> "`)" ] + ForeignKey c -> fatal 195 ("ForeignKey "<>name c<>"not expected here!") + PlainAttr -> [] , tsEngn = dbEngine } diff --git a/src/Database/Design/Ampersand/Prototype/PHP.hs b/src/Database/Design/Ampersand/Prototype/PHP.hs index fc588bdf77..ff3b12b5d4 100644 --- a/src/Database/Design/Ampersand/Prototype/PHP.hs +++ b/src/Database/Design/Ampersand/Prototype/PHP.hs @@ -80,9 +80,7 @@ plug2TableSpec plug (BinSQL{}, _) -> [] (_, primAtt) -> case attUse primAtt of - TableKey isPrim _ -> [ (if isPrim then "PRIMARY " else "") - <> "KEY (`"<>Text.pack (attName primAtt)<>"`)" - ] + PrimaryKey _ -> [ "PRIMARY KEY (`"<>Text.pack (attName primAtt)<>"`)"] ForeignKey c -> fatal 195 ("ForeignKey "<>name c<>"not expected here!") PlainAttr -> [] , "InnoDB DEFAULT CHARACTER SET UTF8 DEFAULT COLLATE UTF8_BIN")