blob: cdfc834050a82014f0c6d5b1c5e74e2f081017c6 (
plain)
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
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
|
(define-module (transform schema)
#:use-module (ice-9 match)
#:use-module (srfi srfi-26)
#:use-module (transform sql)
#:use-module (transform triples)
#:use-module (transform strings)
#:use-module (transform table)
#:export (table-fields
get-tables-from-comments
schema-annotations
tables
schema
data-table))
(define (table-fields db table)
(format #t "* ~a~%" table)
(match (sql-find db
(select-query ((TableComments Comment))
(TableComments)
(format #f "WHERE TableName = '~a'" table)))
((("Comment" . comment))
(format #t "~a~%" comment)))
(sql-for-each (lambda (row)
(match row
((("TableField" . table-field)
("Foreign_Key" . foreign-key)
("Annotation" . annotation))
(format #t "** ~a~%" (substring table-field (1+ (string-length table))))
(unless (string-null? foreign-key)
(format #t "Foreign key to ~a~%" foreign-key))
(unless (string-null? annotation)
(display annotation)
(newline)))))
db
(select-query ((TableFieldAnnotation TableField)
(TableFieldAnnotation Foreign_Key)
(TableFieldAnnotation Annotation))
(TableFieldAnnotation)
(format #f "WHERE TableField LIKE '~a.%'" table)))
(newline))
(define (get-tables-from-comments db)
(sql-map (match-lambda
((("TableName" . table)) table))
db
(select-query ((TableComments TableName))
(TableComments))))
(define (schema-annotations db)
(call-with-target-database
(lambda (db)
(for-each (cut table-fields db <>)
(get-tables-from-comments db)))))
(define (tables connection-settings db)
"Return list of all tables in DB. Each element of the returned list
is a <table> object."
(map (lambda (table)
(set-table-columns table
(sql-map (lambda (row)
(make-column (assoc-ref row "Field")
(assoc-ref row "Type")))
db
(format #f "SHOW COLUMNS FROM ~a" (table-name table)))))
(sql-map (lambda (row)
(make-table (assoc-ref row "table_name")
;; FIXME: This is probably correct only for
;; MyISAM tables.
(assoc-ref row "data_length")
#f))
db
(select-query ((information_schema.tables table_name)
(information_schema.tables data_length))
(information_schema.tables)
(format #f "WHERE table_schema = '~a'"
(assq-ref connection-settings 'sql-database))))))
(define (schema db)
(let ((tables (tables db)))
(for-each (lambda (table)
(let ((table-id (string->identifier
"table"
;; We downcase table names in
;; identifiers. So, we distinguish
;; between the user and User tables.
(if (string=? (table-name table) "User")
"user2"
(table-name table)))))
(triple table-id 'rdf:type 'gn:sqlTable)
(triple table-id 'gn:name (table-name table))
(triple table-id 'gn:hasSize (table-size table))
(for-each (lambda (column)
(let ((column-id (column-id (table-name table)
(column-name column))))
(triple column-id 'rdf:type 'gn:sqlTableField)
(triple column-id 'gn:name (column-name column))
(triple column-id 'gn:sqlFieldType (column-type column))
(triple table-id 'gn:hasField column-id)))
(table-columns table))))
tables)))
(define* (data-table db table-name data-field
#:optional (default-directory ""))
(let ((directory (string-append default-directory "/" table-name))
(port #f)
(current-strain-id #f))
(unless (file-exists? directory)
(mkdir directory))
(sql-for-each (match-lambda
(((_ . strain-id)
(_ . value))
;; Close file if new strain.
(when (and port
(not (= current-strain-id strain-id)))
(close-port port)
(set! port #f))
;; If no file is open, open new file.
(unless port
(set! current-strain-id strain-id)
(let ((filename (string-append directory
"/" (number->string strain-id))))
(display filename (current-error-port))
(newline (current-error-port))
(set! port (open-output-file filename))))
(display value port)
(newline port)))
db
(format #f "SELECT StrainId, ~a FROM ~a ORDER BY StrainId"
data-field table-name))
(close-port port)))
|
