From 3b4d01035f214ac57ac1517b719e2b0f0f092411 Mon Sep 17 00:00:00 2001 From: Eric Bavier Date: Thu, 10 Sep 2015 15:39:44 -0500 Subject: guix: packages: Add origin-actual-file-name. * guix/scripts/graph.scm (uri->file-name, node-full-name): Move origin file name logic to... * guix/packages.scm (origin-actual-file-name): ...here. * tests/packages.scm ("origin-actual-file-name") ("origin-actual-file-name, file-name"): New tests. --- guix/packages.scm | 22 ++++++++++++++++++++++ 1 file changed, 22 insertions(+) (limited to 'guix/packages.scm') diff --git a/guix/packages.scm b/guix/packages.scm index e466ffeda0..edcb53ec93 100644 --- a/guix/packages.scm +++ b/guix/packages.scm @@ -37,6 +37,7 @@ (define-module (guix packages) #:use-module (srfi srfi-26) #:use-module (srfi srfi-34) #:use-module (srfi srfi-35) + #:use-module (web uri) #:re-export (%current-system %current-target-system search-path-specification) ;for convenience @@ -46,6 +47,7 @@ (define-module (guix packages) origin-method origin-sha256 origin-file-name + origin-actual-file-name origin-patches origin-patch-flags origin-patch-inputs @@ -188,6 +190,26 @@ (define-syntax base32 ((_ str) #'(nix-base32-string->bytevector str))))) +(define (origin-actual-file-name origin) + "Return the file name of ORIGIN, either its 'file-name' field or the file +name of its URI." + (define (uri->file-name uri) + ;; Return the 'base name' of URI or URI itself, where URI is a string. + (let ((path (and=> (string->uri uri) uri-path))) + (if path + (basename path) + uri))) + + (or (origin-file-name origin) + (match (origin-uri origin) + ((head . tail) + (uri->file-name head)) + ((? string? uri) + (uri->file-name uri)) + (else + ;; git, svn, cvs, etc. reference + #f)))) + (define %supported-systems ;; This is the list of system types that are supported. By default, we ;; expect all packages to build successfully here. -- cgit v1.2.3