Commit 46f9f49d authored by Michael Hanus's avatar Michael Hanus
Browse files

Database/ERD* added

parent 0fbde6f9
------------------------------------------------------------------------------
--- This module contains the definition of data types to represent
--- entity/relationship diagrams and an I/O operation to read them
--- from a term file.
---
--- @author Michael Hanus, Marion Mueller
--- @version June 2016
--- @category database
------------------------------------------------------------------------------
module Database.ERD
( ERD(..), ERDName, Entity(..), EName, Entity(..)
, Attribute(..), AName, Key(..), Null, Domain(..)
, Relationship(..), REnd(..), RName, Role, Cardinality(..), MaxValue(..)
, readERDTermFile
) where
import ReadShowTerm(readUnqualifiedTerm)
import Time
--- Data type to represent entity/relationship diagrams.
data ERD = ERD ERDName [Entity] [Relationship]
type ERDName = String -- used as the name of the generated module
data Entity = Entity EName [Attribute]
type EName = String
data Attribute = Attribute AName Domain Key Null
type AName = String
data Key = NoKey
| PKey
| Unique
type Null = Bool
data Domain = IntDom (Maybe Int)
| FloatDom (Maybe Float)
| CharDom (Maybe Char)
| StringDom (Maybe String)
| BoolDom (Maybe Bool)
| DateDom (Maybe ClockTime)
| UserDefined String (Maybe String)
| KeyDom String -- for foreign keys
data Relationship = Relationship RName [REnd]
type RName = String
data REnd = REnd EName Role Cardinality
type Role = String
--- Cardinality of a relationship w.r.t. some entity.
--- The cardinality is either a fixed number (e.g., (Exactly 1)
--- representing the cardinality (1,1))
--- or an interval (e.g., (Between 1 (Max 4)) representing the
--- cardinality (1,4), or (Between 0 Infinite) representing the
--- cardinality (0,n)).
data Cardinality = Exactly Int
| Between Int MaxValue
--- The upper bound of a cardinality which is either a finite number
--- or infinite.
data MaxValue = Max Int | Infinite
--- Read an ERD specification from a file containing a single ERD term.
readERDTermFile :: String -> IO ERD
readERDTermFile termfilename = do
putStrLn $ "Reading ERD term from file " ++ termfilename ++ "..."
termstring <- readFile termfilename
return (updateERDTerm (readUnqualifiedTerm ["Database.ERD","Prelude"]
termstring))
--- Transforms an ERD term possible containing old, outdated, information.
--- In particular, translate (Range ...) into (Between ...).
updateERDTerm :: ERD -> ERD
updateERDTerm (ERD name es rs) = ERD name es (map updateRel rs)
where
updateRel (Relationship r ends) = Relationship r (map updateEnd ends)
updateEnd (REnd n r c) = REnd n r (updateCard c)
updateCard (Exactly n) = Exactly n
updateCard (Between min (Max m)) =
if min<=m
then Between min (Max m)
else error ("ERD: Illegal cardinality " ++ show (Between min (Max m)))
updateCard (Between min Infinite) = Between min Infinite
{-
-- Example ERD term:
(ERD "Uni"
[Entity "Student" [Attribute "MatNum" (IntDom Nothing) PKey False,
Attribute "Name" (StringDom Nothing) NoKey False,
Attribute "Firstname" (StringDom Nothing) NoKey False,
Attribute "Email" (UserDefined "MyModule.Email" Nothing)
NoKey True],
Entity "Lecture" [Attribute "Id" (IntDom Nothing) PKey False,
Attribute "Title" (StringDom Nothing) Unique False,
Attribute "Hours" (IntDom (Just 4)) NoKey False],
Entity "Lecturer" [Attribute "Id" (IntDom Nothing) PKey False,
Attribute "Name" (StringDom Nothing) NoKey False,
Attribute "Firstname" (StringDom Nothing) NoKey False],
Entity "Group" [Attribute "Time" (StringDom Nothing) NoKey False]]
[Relationship "Teaching"
[REnd "Lecturer" "taught_by" (Exactly 1),
REnd "Lecture" "teaches" (Between 0 Infinite)],
Relationship "Participation"
[REnd "Student" "participated_by" (Between 0 Infinite),
REnd "Lecture" "participates" (Between 0 Infinite)],
Relationship "Membership"
[REnd "Student" "consists_of" (Exactly 3),
REnd "Group" "member_of" (Between 0 Infinite)]])
-}
------------------------------------------------------------------------------
--- This module contains some useful operations on the data types representing
--- entity/relationship diagrams
---
--- @author Michael Hanus
--- @version June 2016
--- @category database
------------------------------------------------------------------------------
module Database.ERDGoodies
( erdName, entityName, isEntityNamed, entityAttributes
, hasForeignKey, foreignKeyAttributes
, attributeName, attributeDomain, hasDefault
, isForeignKey, isNullAttribute
, cardMinimum, cardMaximum
, showERD, combineIds
) where
import Char(isUpper)
import Database.ERD
import List(intersperse)
import Maybe
--- The name of an ERD.
erdName :: ERD -> String
erdName (ERD name _ _) = name
--- The name of an entity.
entityName :: Entity -> String
entityName (Entity n _) = n
--- Is this an entity with a given name?
isEntityNamed :: String -> Entity -> Bool
isEntityNamed n e = entityName e == n
--- Has the entity an attribute with a foreign key for a given entity name?
hasForeignKey :: String -> Entity -> Bool
hasForeignKey ename (Entity _ attrs) = any isForeignKeyWithName attrs
where
isForeignKeyWithName (Attribute _ d _ _) = case d of KeyDom n -> n==ename
_ -> False
--- Returns the attributes that are a foreign key of a given entity name.
foreignKeyAttributes :: String -> [Attribute] -> [Attribute]
foreignKeyAttributes ename attrs = filter isForeignKeyWithName attrs
where
isForeignKeyWithName (Attribute _ d _ _) = case d of KeyDom n -> n==ename
_ -> False
--- Returns the names of the foreign key attributes for a given entity name.
foreignKeyAttrNames :: String -> [Attribute] -> [String]
foreignKeyAttrNames ename attrs =
map attributeName (filter isForeignKeyWithName attrs)
where
isForeignKeyWithName (Attribute _ d _ _) = case d of KeyDom n -> n==ename
_ -> False
--- The attributes of an entity
entityAttributes :: Entity -> [Attribute]
entityAttributes (Entity _ attrs) = attrs
--- The name of an attribute.
attributeName :: Attribute -> String
attributeName (Attribute name _ _ _) = name
--- The domain of an attribute.
attributeDomain :: Attribute -> Domain
attributeDomain (Attribute _ d _ _) = d
--- Has an attribute domain a default value?
hasDefault :: Domain -> Bool
hasDefault (IntDom d) = isJust d
hasDefault (FloatDom d) = isJust d
hasDefault (StringDom d) = isJust d
hasDefault (BoolDom d) = isJust d
hasDefault (DateDom d) = isJust d
hasDefault (UserDefined _ d) = isJust d
---- Is an attribute a (generated) foreign key?
isForeignKey :: Attribute -> Bool
isForeignKey (Attribute _ d _ _) = case d of KeyDom _ -> True
_ -> False
--- Has an attribute a null value?
isNullAttribute :: Attribute -> Bool
isNullAttribute (Attribute _ _ _ isnull) = isnull
--- The minimum value of a cardinality.
cardMinimum :: Cardinality -> Int
cardMinimum (Exactly i) = i
cardMinimum (Between i _) = i
--- The maximum value of a cardinality (provided that it is not infinite).
cardMaximum :: Cardinality -> Int
cardMaximum (Exactly i) = i
cardMaximum (Between _ (Max i)) = i
--- A simple pretty printer for ERDs.
showERD :: Int -> ERD -> String
showERD n (ERD en es rs) = "ERD " ++ showString en ++ lb n ++
" [" ++ concat (intersperse ("," ++ lb (n+2)) (map (showEs (n+2)) es)) ++ "]"
++ lb n ++
" [" ++ concat (intersperse ("," ++ lb (n+2)) (map (showRs (n+2)) rs)) ++ "]"
showEs n (Entity en attrs) = "Entity " ++ showString en ++ lb (n+7) ++
"[" ++ concat (intersperse ("," ++ lb (n+8)) (map showWOBrackets attrs)) ++"]"
showRs n (Relationship rn ends) =
"Relationship " ++ showString rn ++ lb (n+13) ++
"[" ++ concat (intersperse ("," ++ lb (n+14)) (map showWOBrackets ends)) ++"]"
showWOBrackets t = stripBrackets (show t)
where
stripBrackets (c:cs) = if c=='(' then reverse (tail (reverse cs)) else c:cs
showString s = "\""++s++"\""
lb n = "\n" ++ take n (repeat ' ')
--- Combines a non-empty list of identifiers into a single identifier.
--- Used in ERD transformation and code generation to create
--- names for combined objects, e.g., relationships and foreign keys.
combineIds :: [String] -> String
combineIds (name:names) = name ++ concatMap maybeAddUnderscore names
where
maybeAddUnderscore [] = "_"
maybeAddUnderscore s@(c:_) = if isUpper c then s else '_' : s
Supports Markdown
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