From 573c9178b551ffb417222730e614aea99e67f999 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Sun, 30 Oct 2011 00:00:20 +0000 Subject: [PATCH] gnupdate: Make `nix-prefetch-url' memoizing. * maintainers/scripts/gnu/gnupdate (memoize): New procedure. (nix-prefetch-url): Use it. svn path=/nixpkgs/trunk/; revision=30109 --- maintainers/scripts/gnu/gnupdate | 46 +++++++++++++++++++++----------- 1 file changed, 31 insertions(+), 15 deletions(-) diff --git a/maintainers/scripts/gnu/gnupdate b/maintainers/scripts/gnu/gnupdate index c33fc00e7aeb..eabe3e581d8a 100755 --- a/maintainers/scripts/gnu/gnupdate +++ b/maintainers/scripts/gnu/gnupdate @@ -328,21 +328,36 @@ replaced by the result of their application to DERIVATIONS, a vhash." status #f))) -(define (nix-prefetch-url url) - ;; Download URL in the Nix store and return the base32-encoded SHA256 hash - ;; of the file at URL - (let* ((pipe (open-pipe* OPEN_READ "nix-prefetch-url" url)) - (hash (read-line pipe))) - (if (or (pipe-failed? pipe) - (eof-object? hash)) - (values #f #f) - (let* ((pipe (open-pipe* OPEN_READ "nix-store" "--print-fixed-path" - "sha256" hash (basename url))) - (path (read-line pipe))) - (if (or (pipe-failed? pipe) - (eof-object? path)) - (values #f #f) - (values (string-trim-both hash) (string-trim-both path))))))) +(define (memoize proc) + "Return a memoizing version of PROC." + (let ((cache (make-hash-table))) + (lambda args + (let ((results (hash-ref cache args))) + (if results + (apply values results) + (let ((results (call-with-values (lambda () + (apply proc args)) + list))) + (hash-set! cache args results) + (apply values results))))))) + +(define nix-prefetch-url + (memoize + (lambda (url) + "Download URL in the Nix store and return the base32-encoded SHA256 hash of +the file at URL." + (let* ((pipe (open-pipe* OPEN_READ "nix-prefetch-url" url)) + (hash (read-line pipe))) + (if (or (pipe-failed? pipe) + (eof-object? hash)) + (values #f #f) + (let* ((pipe (open-pipe* OPEN_READ "nix-store" "--print-fixed-path" + "sha256" hash (basename url))) + (path (read-line pipe))) + (if (or (pipe-failed? pipe) + (eof-object? path)) + (values #f #f) + (values (string-trim-both hash) (string-trim-both path))))))))) (define (update-nix-expression file old-version old-hash @@ -926,6 +941,7 @@ pairs. Example: (\"mit-scheme-9.0.1\" . \"/gnu/mit-scheme/stable.pkg/9.0.1\"). gnu-packages)) (define (fetch-gnu project directory version archive-type) + "Download PROJECT's tarball over FTP." (let* ((server (ftp-server/directory project)) (base (string-append project "-" version ".tar." archive-type)) (url (string-append "ftp://" server "/" directory "/" base))