/
erdiagram.rkt
43 lines (37 loc) · 1.02 KB
/
erdiagram.rkt
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
#lang racket
(require pict
"dot.rkt"
"digraph.rkt")
(provide (contract-out
[er-diagram (-> list? list? pict?)]))
(define (er-diagram tables relations)
(define vertices
(map table->vertex tables))
(define edges
(map relation->edge relations))
(define digraph
(make-digraph
(append vertices edges)
#:splines "ortho"))
(digraph->pict digraph))
(define (table->vertex table)
(define title (first table))
(define attrs (second table))
(define label
(string-append "{" title "|"
(string-join attrs "\\n")
"}"))
`(,title #:label ,label
#:shape "record"
#:width "2"))
(define (relation->edge relation)
(match relation
[(list head tail t-arity h-arity)
(list (list head tail)
'#:dir "both"
'#:arrowhead (arity-shape h-arity)
'#:arrowtail (arity-shape t-arity))]))
(define (arity-shape arity)
(match arity
[(quasiquote 'many) "crow"]
[(quasiquote 'one) "none"]))