aboutsummaryrefslogtreecommitdiff
path: root/transform/schema-dump.scm
diff options
context:
space:
mode:
authorMunyoki Kilyungi2024-10-17 14:05:59 +0300
committerMunyoki Kilyungi2024-10-17 14:05:59 +0300
commit1574ec727d3ae9ce51b984a5e5c73f2350a42c19 (patch)
tree9655e53776a38bc2dd8cbb0c440a9cdc6387016b /transform/schema-dump.scm
parenta3e1dd74b44524083348bbf0ce77e2f1cba66523 (diff)
downloadgn-transform-databases-1574ec727d3ae9ce51b984a5e5c73f2350a42c19.tar.gz
Rename schema-dump.scm -> schema.scm.
Signed-off-by: Munyoki Kilyungi <me@bonfacemunyoki.com>
Diffstat (limited to 'transform/schema-dump.scm')
-rw-r--r--transform/schema-dump.scm125
1 files changed, 0 insertions, 125 deletions
diff --git a/transform/schema-dump.scm b/transform/schema-dump.scm
deleted file mode 100644
index 18df5da..0000000
--- a/transform/schema-dump.scm
+++ /dev/null
@@ -1,125 +0,0 @@
-(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))
-
-
-(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 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)))