You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
 
 
 
 
 
 

694 lines
25 KiB

  1. ;;; GNU Guix --- Functional package management for GNU
  2. ;;; Copyright © 2012, 2013, 2014 Ludovic Courtès <ludo@gnu.org>
  3. ;;; Copyright © 2013 Mark H Weaver <mhw@netris.org>
  4. ;;; Copyright © 2013 Nikita Karetnikov <nikita@karetnikov.org>
  5. ;;;
  6. ;;; This file is part of GNU Guix.
  7. ;;;
  8. ;;; GNU Guix is free software; you can redistribute it and/or modify it
  9. ;;; under the terms of the GNU General Public License as published by
  10. ;;; the Free Software Foundation; either version 3 of the License, or (at
  11. ;;; your option) any later version.
  12. ;;;
  13. ;;; GNU Guix is distributed in the hope that it will be useful, but
  14. ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
  15. ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  16. ;;; GNU General Public License for more details.
  17. ;;;
  18. ;;; You should have received a copy of the GNU General Public License
  19. ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
  20. (define-module (guix ui)
  21. #:use-module (guix utils)
  22. #:use-module (guix store)
  23. #:use-module (guix config)
  24. #:use-module (guix packages)
  25. #:use-module (guix build-system)
  26. #:use-module (guix derivations)
  27. #:use-module ((guix build utils) #:select (mkdir-p))
  28. #:use-module ((guix licenses) #:select (license? license-name))
  29. #:use-module (srfi srfi-1)
  30. #:use-module (srfi srfi-11)
  31. #:use-module (srfi srfi-19)
  32. #:use-module (srfi srfi-26)
  33. #:use-module (srfi srfi-34)
  34. #:use-module (srfi srfi-35)
  35. #:use-module (srfi srfi-37)
  36. #:autoload (ice-9 ftw) (scandir)
  37. #:use-module (ice-9 match)
  38. #:use-module (ice-9 format)
  39. #:use-module (ice-9 regex)
  40. #:export (_
  41. N_
  42. P_
  43. leave
  44. show-version-and-exit
  45. show-bug-report-information
  46. string->number*
  47. size->number
  48. show-what-to-build
  49. call-with-error-handling
  50. with-error-handling
  51. read/eval
  52. read/eval-package-expression
  53. location->string
  54. switch-symlinks
  55. config-directory
  56. fill-paragraph
  57. string->recutils
  58. package->recutils
  59. package-specification->name+version+output
  60. string->generations
  61. string->duration
  62. args-fold*
  63. run-guix-command
  64. program-name
  65. guix-warning-port
  66. warning
  67. guix-main))
  68. ;;; Commentary:
  69. ;;;
  70. ;;; User interface facilities for command-line tools.
  71. ;;;
  72. ;;; Code:
  73. (define %gettext-domain
  74. ;; Text domain for strings used in the tools.
  75. "guix")
  76. (define %package-text-domain
  77. ;; Text domain for package synopses and descriptions.
  78. "guix-packages")
  79. (define _ (cut gettext <> %gettext-domain))
  80. (define N_ (cut ngettext <> <> <> %gettext-domain))
  81. (define P_ (cut gettext <> %package-text-domain))
  82. (define-syntax-rule (define-diagnostic name prefix)
  83. "Create a diagnostic macro (i.e., NAME), which will prepend PREFIX to all
  84. messages."
  85. (define-syntax name
  86. (lambda (x)
  87. (define (augmented-format-string fmt)
  88. (string-append "~:[~*~;guix ~a: ~]~a" (syntax->datum fmt)))
  89. (syntax-case x ()
  90. ((name (underscore fmt) args (... ...))
  91. (and (string? (syntax->datum #'fmt))
  92. (free-identifier=? #'underscore #'_))
  93. (with-syntax ((fmt* (augmented-format-string #'fmt))
  94. (prefix (datum->syntax x prefix)))
  95. #'(format (guix-warning-port) (gettext fmt*)
  96. (program-name) (program-name) prefix
  97. args (... ...))))
  98. ((name (N-underscore singular plural n) args (... ...))
  99. (and (string? (syntax->datum #'singular))
  100. (string? (syntax->datum #'plural))
  101. (free-identifier=? #'N-underscore #'N_))
  102. (with-syntax ((s (augmented-format-string #'singular))
  103. (p (augmented-format-string #'plural))
  104. (prefix (datum->syntax x prefix)))
  105. #'(format (guix-warning-port)
  106. (ngettext s p n %gettext-domain)
  107. (program-name) (program-name) prefix
  108. args (... ...))))))))
  109. (define-diagnostic warning "warning: ") ; emit a warning
  110. (define-diagnostic report-error "error: ")
  111. (define-syntax-rule (leave args ...)
  112. "Emit an error message and exit."
  113. (begin
  114. (report-error args ...)
  115. (exit 1)))
  116. (define (install-locale)
  117. "Install the current locale settings."
  118. (catch 'system-error
  119. (lambda _
  120. (setlocale LC_ALL ""))
  121. (lambda args
  122. (warning (_ "failed to install locale: ~a~%")
  123. (strerror (system-error-errno args))))))
  124. (define (initialize-guix)
  125. "Perform the usual initialization for stand-alone Guix commands."
  126. (install-locale)
  127. (textdomain %gettext-domain)
  128. ;; Ignore SIGPIPE. If the daemon closes the connection, we prefer to be
  129. ;; notified via an EPIPE later.
  130. (sigaction SIGPIPE SIG_IGN)
  131. (setvbuf (current-output-port) _IOLBF)
  132. (setvbuf (current-error-port) _IOLBF))
  133. (define* (show-version-and-exit #:optional (command (car (command-line))))
  134. "Display version information for COMMAND and `(exit 0)'."
  135. (simple-format #t "~a (~a) ~a~%"
  136. command %guix-package-name %guix-version)
  137. (display (_ "Copyright (C) 2014 the Guix authors
  138. License GPLv3+: GNU GPL version 3 or later <http://gnu.org/licenses/gpl.html>
  139. This is free software: you are free to change and redistribute it.
  140. There is NO WARRANTY, to the extent permitted by law.
  141. "))
  142. (exit 0))
  143. (define (show-bug-report-information)
  144. (format #t (_ "
  145. Report bugs to: ~a.") %guix-bug-report-address)
  146. (format #t (_ "
  147. ~a home page: <~a>") %guix-package-name %guix-home-page-url)
  148. (display (_ "
  149. General help using GNU software: <http://www.gnu.org/gethelp/>"))
  150. (newline))
  151. (define (string->number* str)
  152. "Like `string->number', but error out with an error message on failure."
  153. (or (string->number str)
  154. (leave (_ "~a: invalid number~%") str)))
  155. (define (size->number str)
  156. "Convert STR, a storage measurement representation such as \"1024\" or
  157. \"1MiB\", to a number of bytes. Raise an error if STR could not be
  158. interpreted."
  159. (define unit-pos
  160. (string-rindex str char-set:digit))
  161. (define unit
  162. (and unit-pos (substring str (+ 1 unit-pos))))
  163. (let* ((numstr (if unit-pos
  164. (substring str 0 (+ 1 unit-pos))
  165. str))
  166. (num (string->number numstr)))
  167. (unless num
  168. (leave (_ "invalid number: ~a~%") numstr))
  169. ((compose inexact->exact round)
  170. (* num
  171. (match unit
  172. ("KiB" (expt 2 10))
  173. ("MiB" (expt 2 20))
  174. ("GiB" (expt 2 30))
  175. ("TiB" (expt 2 40))
  176. ("KB" (expt 10 3))
  177. ("MB" (expt 10 6))
  178. ("GB" (expt 10 9))
  179. ("TB" (expt 10 12))
  180. ("" 1)
  181. (_
  182. (leave (_ "unknown unit: ~a~%") unit)))))))
  183. (define (call-with-error-handling thunk)
  184. "Call THUNK within a user-friendly error handler."
  185. (guard (c ((package-input-error? c)
  186. (let* ((package (package-error-package c))
  187. (input (package-error-invalid-input c))
  188. (location (package-location package))
  189. (file (location-file location))
  190. (line (location-line location))
  191. (column (location-column location)))
  192. (leave (_ "~a:~a:~a: package `~a' has an invalid input: ~s~%")
  193. file line column
  194. (package-full-name package) input)))
  195. ((package-cross-build-system-error? c)
  196. (let* ((package (package-error-package c))
  197. (loc (package-location package))
  198. (system (package-build-system package)))
  199. (leave (_ "~a: ~a: build system `~a' does not support cross builds~%")
  200. (location->string loc)
  201. (package-full-name package)
  202. (build-system-name system))))
  203. ((nix-connection-error? c)
  204. (leave (_ "failed to connect to `~a': ~a~%")
  205. (nix-connection-error-file c)
  206. (strerror (nix-connection-error-code c))))
  207. ((nix-protocol-error? c)
  208. ;; FIXME: Server-provided error messages aren't i18n'd.
  209. (leave (_ "build failed: ~a~%")
  210. (nix-protocol-error-message c)))
  211. ((message-condition? c)
  212. ;; Normally '&message' error conditions have an i18n'd message.
  213. (leave (_ "~a~%") (gettext (condition-message c)))))
  214. ;; Catch EPIPE and the likes.
  215. (catch 'system-error
  216. thunk
  217. (lambda (key proc format-string format-args . rest)
  218. (leave (_ "~a: ~a~%") proc
  219. (apply format #f format-string format-args))))))
  220. (define %guix-user-module
  221. ;; Module in which user expressions are evaluated.
  222. ;; Compute lazily to avoid circularity with (guix gexp).
  223. (delay
  224. (let ((module (make-module)))
  225. (beautify-user-module! module)
  226. ;; Use (guix gexp) so that one can use #~ & co.
  227. (module-use! module (resolve-interface '(guix gexp)))
  228. module)))
  229. (define (read/eval str)
  230. "Read and evaluate STR, raising an error if something goes wrong."
  231. (let ((exp (catch #t
  232. (lambda ()
  233. (call-with-input-string str read))
  234. (lambda args
  235. (leave (_ "failed to read expression ~s: ~s~%")
  236. str args)))))
  237. (catch #t
  238. (lambda ()
  239. (eval exp (force %guix-user-module)))
  240. (lambda args
  241. (leave (_ "failed to evaluate expression `~a': ~s~%")
  242. exp args)))))
  243. (define (read/eval-package-expression str)
  244. "Read and evaluate STR and return the package it refers to, or exit an
  245. error."
  246. (match (read/eval str)
  247. ((? package? p) p)
  248. (_
  249. (leave (_ "expression ~s does not evaluate to a package~%")
  250. str))))
  251. (define* (show-what-to-build store drv
  252. #:key dry-run? (use-substitutes? #t))
  253. "Show what will or would (depending on DRY-RUN?) be built in realizing the
  254. derivations listed in DRV. Return #t if there's something to build, #f
  255. otherwise. When USE-SUBSTITUTES?, check and report what is prerequisites are
  256. available for download."
  257. (define (built-or-substitutable? drv)
  258. (let ((out (derivation->output-path drv)))
  259. ;; If DRV has zero outputs, OUT is #f.
  260. (or (not out)
  261. (or (valid-path? store out)
  262. (and use-substitutes?
  263. (has-substitutes? store out))))))
  264. (let*-values (((build download)
  265. (fold2 (lambda (drv build download)
  266. (let-values (((b d)
  267. (derivation-prerequisites-to-build
  268. store drv
  269. #:use-substitutes?
  270. use-substitutes?)))
  271. (values (append b build)
  272. (append d download))))
  273. '() '()
  274. drv))
  275. ((build) ; add the DRV themselves
  276. (delete-duplicates
  277. (append (map derivation-file-name
  278. (remove built-or-substitutable? drv))
  279. (map derivation-input-path build))))
  280. ((download) ; add the references of DOWNLOAD
  281. (if use-substitutes?
  282. (delete-duplicates
  283. (append download
  284. (remove (cut valid-path? store <>)
  285. (append-map
  286. substitutable-references
  287. (substitutable-path-info store
  288. download)))))
  289. download)))
  290. ;; TODO: Show the installed size of DOWNLOAD.
  291. (if dry-run?
  292. (begin
  293. (format (current-error-port)
  294. (N_ "~:[The following derivation would be built:~%~{ ~a~%~}~;~]"
  295. "~:[The following derivations would be built:~%~{ ~a~%~}~;~]"
  296. (length build))
  297. (null? build) build)
  298. (format (current-error-port)
  299. (N_ "~:[The following file would be downloaded:~%~{ ~a~%~}~;~]"
  300. "~:[The following files would be downloaded:~%~{ ~a~%~}~;~]"
  301. (length download))
  302. (null? download) download))
  303. (begin
  304. (format (current-error-port)
  305. (N_ "~:[The following derivation will be built:~%~{ ~a~%~}~;~]"
  306. "~:[The following derivations will be built:~%~{ ~a~%~}~;~]"
  307. (length build))
  308. (null? build) build)
  309. (format (current-error-port)
  310. (N_ "~:[The following file will be downloaded:~%~{ ~a~%~}~;~]"
  311. "~:[The following files will be downloaded:~%~{ ~a~%~}~;~]"
  312. (length download))
  313. (null? download) download)))
  314. (pair? build)))
  315. (define-syntax with-error-handling
  316. (syntax-rules ()
  317. "Run BODY within a user-friendly error condition handler."
  318. ((_ body ...)
  319. (call-with-error-handling
  320. (lambda ()
  321. body ...)))))
  322. (define (location->string loc)
  323. "Return a human-friendly, GNU-standard representation of LOC."
  324. (match loc
  325. (#f (_ "<unknown location>"))
  326. (($ <location> file line column)
  327. (format #f "~a:~a:~a" file line column))))
  328. (define (switch-symlinks link target)
  329. "Atomically switch LINK, a symbolic link, to point to TARGET. Works
  330. both when LINK already exists and when it does not."
  331. (let ((pivot (string-append link ".new")))
  332. (symlink target pivot)
  333. (rename-file pivot link)))
  334. (define (config-directory)
  335. "Return the name of the configuration directory, after making sure that it
  336. exists. Honor the XDG specs,
  337. <http://standards.freedesktop.org/basedir-spec/basedir-spec-latest.html>."
  338. (let ((dir (and=> (or (getenv "XDG_CONFIG_HOME")
  339. (and=> (getenv "HOME")
  340. (cut string-append <> "/.config")))
  341. (cut string-append <> "/guix"))))
  342. (catch 'system-error
  343. (lambda ()
  344. (mkdir-p dir)
  345. dir)
  346. (lambda args
  347. (let ((err (system-error-errno args)))
  348. ;; ERR is necessarily different from EEXIST.
  349. (leave (_ "failed to create configuration directory `~a': ~a~%")
  350. dir (strerror err)))))))
  351. (define* (fill-paragraph str width #:optional (column 0))
  352. "Fill STR such that each line contains at most WIDTH characters, assuming
  353. that the first character is at COLUMN.
  354. When STR contains a single line break surrounded by other characters, it is
  355. converted to a space; sequences of more than one line break are preserved."
  356. (define (maybe-break chr result)
  357. (match result
  358. ((column newlines chars)
  359. (case chr
  360. ((#\newline)
  361. `(,column ,(+ 1 newlines) ,chars))
  362. (else
  363. (let* ((spaces (if (and (pair? chars) (eqv? (car chars) #\.)) 2 1))
  364. (chars (case newlines
  365. ((0) chars)
  366. ((1)
  367. (append (make-list spaces #\space) chars))
  368. (else
  369. (append (make-list newlines #\newline) chars))))
  370. (column (case newlines
  371. ((0) column)
  372. ((1) (+ spaces column))
  373. (else 0))))
  374. (let ((chars (cons chr chars))
  375. (column (+ 1 column)))
  376. (if (> column width)
  377. (let*-values (((before after)
  378. (break (cut eqv? #\space <>) chars))
  379. ((len)
  380. (length before)))
  381. (if (<= len width)
  382. `(,len
  383. 0
  384. ,(if (null? after)
  385. before
  386. (append before
  387. (cons #\newline
  388. (drop-while (cut eqv? #\space <>)
  389. after)))))
  390. `(,column 0 ,chars))) ; unbreakable
  391. `(,column 0 ,chars)))))))))
  392. (match (string-fold maybe-break
  393. `(,column 0 ())
  394. str)
  395. ((_ _ chars)
  396. (list->string (reverse chars)))))
  397. ;;;
  398. ;;; Packages.
  399. ;;;
  400. (define (string->recutils str)
  401. "Return a version of STR where newlines have been replaced by newlines
  402. followed by \"+ \", which makes for a valid multi-line field value in the
  403. `recutils' syntax."
  404. (list->string
  405. (string-fold-right (lambda (chr result)
  406. (if (eqv? chr #\newline)
  407. (cons* chr #\+ #\space result)
  408. (cons chr result)))
  409. '()
  410. str)))
  411. (define* (package->recutils p port
  412. #:optional (width (or (and=> (getenv "WIDTH")
  413. string->number)
  414. 80)))
  415. "Write to PORT a `recutils' record of package P, arranging to fit within
  416. WIDTH columns."
  417. (define (description->recutils str)
  418. (let ((str (P_ str)))
  419. (string->recutils
  420. (fill-paragraph str width
  421. (string-length "description: ")))))
  422. (define (dependencies->recutils packages)
  423. (let ((list (string-join (map package-full-name
  424. (sort packages package<?)) " ")))
  425. (string->recutils
  426. (fill-paragraph list width
  427. (string-length "dependencies: ")))))
  428. (define (package<? p1 p2)
  429. (string<? (package-full-name p1) (package-full-name p2)))
  430. ;; Note: Don't i18n field names so that people can post-process it.
  431. (format port "name: ~a~%" (package-name p))
  432. (format port "version: ~a~%" (package-version p))
  433. (format port "dependencies: ~a~%"
  434. (match (package-direct-inputs p)
  435. (((labels inputs . _) ...)
  436. (dependencies->recutils (filter package? inputs)))))
  437. (format port "location: ~a~%"
  438. (or (and=> (package-location p) location->string)
  439. (_ "unknown")))
  440. ;; Note: Starting from version 1.6 or recutils, hyphens are not allowed in
  441. ;; field identifiers.
  442. (format port "homepage: ~a~%" (package-home-page p))
  443. (format port "license: ~a~%"
  444. (match (package-license p)
  445. (((? license? licenses) ...)
  446. (string-join (map license-name licenses)
  447. ", "))
  448. ((? license? license)
  449. (license-name license))
  450. (x
  451. (_ "unknown"))))
  452. (format port "synopsis: ~a~%"
  453. (string-map (match-lambda
  454. (#\newline #\space)
  455. (chr chr))
  456. (or (and=> (package-synopsis p) P_)
  457. "")))
  458. (format port "description: ~a~%"
  459. (and=> (package-description p) description->recutils))
  460. (newline port))
  461. (define (string->generations str)
  462. "Return the list of generations matching a pattern in STR. This function
  463. accepts the following patterns: \"1\", \"1,2,3\", \"1..9\", \"1..\", \"..9\"."
  464. (define (maybe-integer)
  465. (let ((x (string->number str)))
  466. (and (integer? x)
  467. x)))
  468. (define (maybe-comma-separated-integers)
  469. (let ((lst (delete-duplicates
  470. (map string->number
  471. (string-split str #\,)))))
  472. (and (every integer? lst)
  473. lst)))
  474. (cond ((maybe-integer)
  475. =>
  476. list)
  477. ((maybe-comma-separated-integers)
  478. =>
  479. identity)
  480. ((string-match "^([0-9]+)\\.\\.([0-9]+)$" str)
  481. =>
  482. (lambda (match)
  483. (let ((s (string->number (match:substring match 1)))
  484. (e (string->number (match:substring match 2))))
  485. (and (every integer? (list s e))
  486. (<= s e)
  487. (iota (1+ (- e s)) s)))))
  488. ((string-match "^([0-9]+)\\.\\.$" str)
  489. =>
  490. (lambda (match)
  491. (let ((s (string->number (match:substring match 1))))
  492. (and (integer? s)
  493. `(>= ,s)))))
  494. ((string-match "^\\.\\.([0-9]+)$" str)
  495. =>
  496. (lambda (match)
  497. (let ((e (string->number (match:substring match 1))))
  498. (and (integer? e)
  499. `(<= ,e)))))
  500. (else #f)))
  501. (define (string->duration str)
  502. "Return the duration matching a pattern in STR. This function accepts the
  503. following patterns: \"1d\", \"1w\", \"1m\"."
  504. (define (hours->duration hours match)
  505. (make-time time-duration 0
  506. (* 3600 hours (string->number (match:substring match 1)))))
  507. (cond ((string-match "^([0-9]+)d$" str)
  508. =>
  509. (lambda (match)
  510. (hours->duration 24 match)))
  511. ((string-match "^([0-9]+)w$" str)
  512. =>
  513. (lambda (match)
  514. (hours->duration (* 24 7) match)))
  515. ((string-match "^([0-9]+)m$" str)
  516. =>
  517. (lambda (match)
  518. (hours->duration (* 24 30) match)))
  519. (else #f)))
  520. (define* (package-specification->name+version+output spec
  521. #:optional (output "out"))
  522. "Parse package specification SPEC and return three value: the specified
  523. package name, version number (or #f), and output name (or OUTPUT). SPEC may
  524. optionally contain a version number and an output name, as in these examples:
  525. guile
  526. guile-2.0.9
  527. guile:debug
  528. guile-2.0.9:debug
  529. "
  530. (let*-values (((name sub-drv)
  531. (match (string-rindex spec #\:)
  532. (#f (values spec output))
  533. (colon (values (substring spec 0 colon)
  534. (substring spec (+ 1 colon))))))
  535. ((name version)
  536. (package-name->name+version name)))
  537. (values name version sub-drv)))
  538. ;;;
  539. ;;; Command-line option processing.
  540. ;;;
  541. (define (args-fold* options unrecognized-option-proc operand-proc . seeds)
  542. "A wrapper on top of `args-fold' that does proper user-facing error
  543. reporting."
  544. (catch 'misc-error
  545. (lambda ()
  546. (apply args-fold options unrecognized-option-proc
  547. operand-proc seeds))
  548. (lambda (key proc msg args . rest)
  549. ;; XXX: MSG is not i18n'd.
  550. (leave (_ "invalid argument: ~a~%")
  551. (apply format #f msg args)))))
  552. (define (show-guix-usage)
  553. (format (current-error-port)
  554. (_ "Try `guix --help' for more information.~%"))
  555. (exit 1))
  556. (define (command-files)
  557. "Return the list of source files that define Guix sub-commands."
  558. (define directory
  559. (and=> (search-path %load-path "guix.scm")
  560. (compose (cut string-append <> "/guix/scripts")
  561. dirname)))
  562. (define dot-scm?
  563. (cut string-suffix? ".scm" <>))
  564. ;; In Guile 2.0.5 `scandir' would return "." and ".." regardless even though
  565. ;; they don't match `dot-scm?'. Work around it by doing additional
  566. ;; filtering.
  567. (if directory
  568. (filter dot-scm? (scandir directory dot-scm?))
  569. '()))
  570. (define (commands)
  571. "Return the list of Guix command names."
  572. (map (compose (cut string-drop-right <> 4)
  573. basename)
  574. (command-files)))
  575. (define (show-guix-help)
  576. (define (internal? command)
  577. (member command '("substitute-binary" "authenticate" "offload")))
  578. (format #t (_ "Usage: guix COMMAND ARGS...
  579. Run COMMAND with ARGS.\n"))
  580. (newline)
  581. (format #t (_ "COMMAND must be one of the sub-commands listed below:\n"))
  582. (newline)
  583. ;; TODO: Display a synopsis of each command.
  584. (format #t "~{ ~a~%~}" (sort (remove internal? (commands))
  585. string<?))
  586. (show-bug-report-information))
  587. (define program-name
  588. ;; Name of the command-line program currently executing, or #f.
  589. (make-parameter #f))
  590. (define (run-guix-command command . args)
  591. "Run COMMAND with the given ARGS. Report an error when COMMAND is not
  592. found."
  593. (define module
  594. (catch 'misc-error
  595. (lambda ()
  596. (resolve-interface `(guix scripts ,command)))
  597. (lambda -
  598. (format (current-error-port)
  599. (_ "guix: ~a: command not found~%") command)
  600. (show-guix-usage))))
  601. (let ((command-main (module-ref module
  602. (symbol-append 'guix- command))))
  603. (parameterize ((program-name command))
  604. (apply command-main args))))
  605. (define guix-warning-port
  606. (make-parameter (current-warning-port)))
  607. (define (guix-main arg0 . args)
  608. (initialize-guix)
  609. (let ()
  610. (define (option? str) (string-prefix? "-" str))
  611. (match args
  612. (()
  613. (format (current-error-port)
  614. (_ "guix: missing command name~%"))
  615. (show-guix-usage))
  616. ((or ("-h") ("--help"))
  617. (show-guix-help))
  618. (("--version")
  619. (show-version-and-exit "guix"))
  620. (((? option? o) args ...)
  621. (format (current-error-port)
  622. (_ "guix: unrecognized option '~a'~%") o)
  623. (show-guix-usage))
  624. ((command args ...)
  625. (apply run-guix-command
  626. (string->symbol command)
  627. args)))))
  628. ;;; ui.scm ends here