diff options
author | Pjotr Prins | 2023-11-15 07:46:12 +0100 |
---|---|---|
committer | Pjotr Prins | 2023-11-15 07:46:12 +0100 |
commit | 58acb7ccf46881708f7552ad303fb156603c29d2 (patch) | |
tree | 3138cc8484d6e934bc901110f2580bc041574668 | |
parent | 12e43794a12a94e45c25cadf5d167697c16c4f5f (diff) | |
download | gn-guile-58acb7ccf46881708f7552ad303fb156603c29d2.tar.gz |
Return list of BXD
-rwxr-xr-x | .guix-shell | 2 | ||||
-rw-r--r-- | gn/db/mysql.scm | 22 | ||||
-rw-r--r-- | gn/db/sparql.scm | 9 | ||||
-rw-r--r-- | scripts/precompute/README.md | 4 | ||||
-rwxr-xr-x | scripts/precompute/precompute-hits.scm | 34 |
5 files changed, 58 insertions, 13 deletions
diff --git a/.guix-shell b/.guix-shell index 645b8c6..502f4b1 100755 --- a/.guix-shell +++ b/.guix-shell @@ -1,6 +1,6 @@ #!/bin/bash # -# . .guix-shell -- guile -L .. --fresh-auto-compile --listen=1970 +# . .guix-shell -- guile -L . --fresh-auto-compile --listen=1970 echo "Create a shell to run tools. In the container" diff --git a/gn/db/mysql.scm b/gn/db/mysql.scm index c84605d..e35cc69 100644 --- a/gn/db/mysql.scm +++ b/gn/db/mysql.scm @@ -1,3 +1,7 @@ +#! + Module for handling SQL DB primitives. Note that GN queries should go into gn/data +!# + (define-module (gn db mysql) #:use-module (json) #:use-module (ice-9 match) @@ -5,11 +9,19 @@ #:use-module (ice-9 iconv) #:use-module (ice-9 receive) #:use-module (ice-9 string-fun) + #:use-module (rnrs base) + #:use-module (dbi dbi) #:export ( - open-db - ) -) + db-check + )) -(define open-db - #t) +(define (db-check db) + "Use DBI-style handle to report an error" + (match (dbi-get_status db) + ((stat . msg) (if (= stat 0) + #t + (begin + (display msg) + (newline) + (assert stat)))))) diff --git a/gn/db/sparql.scm b/gn/db/sparql.scm index c413b9a..b7d94f3 100644 --- a/gn/db/sparql.scm +++ b/gn/db/sparql.scm @@ -1,3 +1,12 @@ +#! + +Module for handling SPARQL primitives. + +Note that GN queries should go into gn/data - this is currently not +the case. + +!# + (define-module (gn db sparql) #:use-module (json) #:use-module (ice-9 match) diff --git a/scripts/precompute/README.md b/scripts/precompute/README.md index c1f2efc..4c4dc87 100644 --- a/scripts/precompute/README.md +++ b/scripts/precompute/README.md @@ -5,3 +5,7 @@ Some work on precompute is documented [here](https://issues.genenetwork.org/topi # Install and run See the header of [precompute-hits.scm](precompute-hits.scm). + +# Development + +My preferred way of developing is tunneling mysql from a remote, running guile3 in a separate guix shell and geiser-connect from emacs. See my [guix-shell](../../.guix-shell). diff --git a/scripts/precompute/precompute-hits.scm b/scripts/precompute/precompute-hits.scm index 7986f6a..fed05ba 100755 --- a/scripts/precompute/precompute-hits.scm +++ b/scripts/precompute/precompute-hits.scm @@ -1,20 +1,40 @@ #! Run from base dir with -. .guix-shell -- guile -L . -s ./scripts/precompute/precompute-hits.scm +.guix-shell -- guile -L . -s ./scripts/precompute/precompute-hits.scm !# (use-modules (dbi dbi) (gn db mysql) + (rnrs base) + (ice-9 match) ) ;; potentially you want to test connection with mysql client: ;; -;; mysql -uwebqtlout -pwebqtlout -A -h 127.0.0.1 -P 3306 +;; mysql -uwebqtlout -pwebqtlout -A -h 127.0.0.1 -P 3306 db_webqtl -e "show tables;" ;; -(define db_webqtl (dbi-open "mysql" "webqtlout:webqtlout:db_webqtl:tcp:127.0.0.1:3306")) -(dbi-query db_webqtl "SELECT * FROM ProbeSetXRef LIMIT 3") -(display (dbi-get_status db_webqtl)) -(let [(row (dbi-get_row db_webqtl))] +(define db (dbi-open "mysql" "webqtlout:webqtlout:db_webqtl:tcp:127.0.0.1:3306")) +(db-check db) +(dbi-query db "SELECT * FROM ProbeSetXRef LIMIT 3") +(db-check db) +; (display (dbi-get_status db_webqtl)) +(let [(row (dbi-get_row db))] (display row) -) + ) + +(dbi-query db "SELECT StrainId,Strain.Name FROM Strain, StrainXRef WHERE StrainXRef.StrainId = Strain.Id AND StrainXRef.InbredSetId = 1 AND Used_for_mapping='Y' ORDER BY StrainId;") +(db-check db) + +(define (get-rows db) + (let [(row (dbi-get_row db))] + (if row + (begin + (display row) + (get-rows db) + ) + #f + ) + )) + +(get-rows db) |