mirrors
/
cuirass
mirror of https://notabug.org/mthl/cuirass.git
1
0
Fork 0
Code Issues Releases Wiki Activity

db: Forbid inserting the same specification twice. 

* src/schema.sql (Specifications): Make 'repo_name' the primary key.
(Stamps, Evaluations): Adapt.
* src/cuirass/database.scm (db-get-specifications): Likewise.
(db-add-specification): Ignore if SPEC has already been added.
* tests/database.scm (example-spec): Adapt.
pull/3/head
Mathieu Lirzin 2016-11-13 01:54:41 +01:00
parent a948f556eb
commit bfd395c09f
No known key found for this signature in database
GPG Key ID: 0ADEE10094604D37
3 changed files with 10 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
src/cuirass/database.scm
View File

@ -115,8 +115,8 @@ database object."
(define (db-add-specification db spec) (define (db-add-specification db spec)
"Store specification SPEC in database DB and return its ID." "Store specification SPEC in database DB and return its ID."
(apply sqlite-exec db "\ (apply sqlite-exec db "\
INSERT INTO Specifications (repo_name, url, load_path, file, proc, arguments, \ INSERT OR IGNORE INTO Specifications (repo_name, url, load_path, file, \
branch, tag, revision, no_compile_p) \ proc, arguments, branch, tag, revision, no_compile_p) \
VALUES ('~A', '~A', '~A', '~A', '~S', '~S', '~A', '~A', '~A', ~A);" VALUES ('~A', '~A', '~A', '~A', '~S', '~S', '~A', '~A', '~A', ~A);"
(append (append
(assq-refs spec '(#:name #:url #:load-path #:file #:proc #:arguments)) (assq-refs spec '(#:name #:url #:load-path #:file #:proc #:arguments))
@ -129,11 +129,10 @@ INSERT INTO Specifications (repo_name, url, load_path, file, proc, arguments, \
(specs '())) (specs '()))
(match rows (match rows
(() specs) (() specs)
((#(id name url load-path file proc args branch tag rev no-compile?) ((#(name url load-path file proc args branch tag rev no-compile?)
. rest) . rest)
(loop rest (loop rest
(cons `((#:id . ,id) (cons `((#:name . ,name)
(#:name . ,name)
(#:url . ,url) (#:url . ,url)
(#:load-path . ,load-path) (#:load-path . ,load-path)
(#:file . ,file) (#:file . ,file)

11
src/schema.sql
View File

@ -1,8 +1,7 @@
BEGIN TRANSACTION; BEGIN TRANSACTION;
CREATE TABLE Specifications ( CREATE TABLE Specifications (
id INTEGER NOT NULL PRIMARY KEY AUTOINCREMENT, repo_name TEXT NOT NULL PRIMARY KEY,
repo_name TEXT NOT NULL,
url TEXT NOT NULL, url TEXT NOT NULL,
load_path TEXT NOT NULL, load_path TEXT NOT NULL,
file TEXT NOT NULL, file TEXT NOT NULL,
@ -16,16 +15,16 @@ CREATE TABLE Specifications (
); );
CREATE TABLE Stamps ( CREATE TABLE Stamps (
specification INTEGER NOT NULL PRIMARY KEY, specification TEXT NOT NULL PRIMARY KEY,
stamp TEXT NOT NULL, stamp TEXT NOT NULL,
FOREIGN KEY (specification) REFERENCES Specifications (id) FOREIGN KEY (specification) REFERENCES Specifications (repo_name)
); );
CREATE TABLE Evaluations ( CREATE TABLE Evaluations (
id INTEGER NOT NULL PRIMARY KEY AUTOINCREMENT, id INTEGER NOT NULL PRIMARY KEY AUTOINCREMENT,
specification INTEGER NOT NULL, specification TEXT NOT NULL,
revision TEXT NOT NULL, revision TEXT NOT NULL,
FOREIGN KEY (specification) REFERENCES Specifications (id) FOREIGN KEY (specification) REFERENCES Specifications (repo_name)
); );
CREATE TABLE Derivations ( CREATE TABLE Derivations (

3
tests/database.scm
View File

@ -21,8 +21,7 @@
(srfi srfi-64)) (srfi srfi-64))
(define example-spec (define example-spec
'((#:id . 1) '((#:name . "guix")
(#:name . "guix")
(#:url . "git://git.savannah.gnu.org/guix.git") (#:url . "git://git.savannah.gnu.org/guix.git")
(#:load-path . ".") (#:load-path . ".")
(#:file . "/tmp/gnu-system.scm") (#:file . "/tmp/gnu-system.scm")