From 1574ec727d3ae9ce51b984a5e5c73f2350a42c19 Mon Sep 17 00:00:00 2001 From: Munyoki Kilyungi Date: Thu, 17 Oct 2024 14:05:59 +0300 Subject: Rename schema-dump.scm -> schema.scm. Signed-off-by: Munyoki Kilyungi --- transform/schema-dump.scm | 125 ------------------------------------------- transform/schema.scm | 131 ++++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 131 insertions(+), 125 deletions(-) delete mode 100644 transform/schema-dump.scm create mode 100644 transform/schema.scm (limited to 'transform') 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 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))) diff --git a/transform/schema.scm b/transform/schema.scm new file mode 100644 index 0000000..cdfc834 --- /dev/null +++ b/transform/schema.scm @@ -0,0 +1,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
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))) -- cgit v1.2.3