bundle.lisp 4.66 KB
Newer Older
Eric Timmons's avatar
Eric Timmons committed
1
2
3
4
5
6
7
;;;; bundle functionality
;;;;
;;;; This software is part of CLPM. See README.org for more information. See
;;;; LICENSE for license information.

(uiop:define-package #:clpm/bundle
    (:use #:cl
8
          #:alexandria
Eric Timmons's avatar
Eric Timmons committed
9
          #:clpm/clpmfile
10
          #:clpm/config
Eric Timmons's avatar
Eric Timmons committed
11
          #:clpm/context
12
          #:clpm/context-queries
13
          #:clpm/exec
Eric Timmons's avatar
Eric Timmons committed
14
15
          #:clpm/install
          #:clpm/log
16
          #:clpm/session
Eric Timmons's avatar
Cleanup    
Eric Timmons committed
17
          #:clpm/source)
Eric Timmons's avatar
Cleanup    
Eric Timmons committed
18
  (:export #:bundle-exec
Eric Timmons's avatar
Eric Timmons committed
19
           #:bundle-init
20
           #:bundle-install
Eric Timmons's avatar
Eric Timmons committed
21
           #:bundle-output-translations
22
           #:bundle-source-registry
Eric Timmons's avatar
Cleanup    
Eric Timmons committed
23
           #:bundle-update))
Eric Timmons's avatar
Eric Timmons committed
24
25
26
27
28

(in-package #:clpm/bundle)

(setup-logger)

Eric Timmons's avatar
Eric Timmons committed
29
(defun bundle-init (&key clpmfile (if-exists :error) asds)
Eric Timmons's avatar
Eric Timmons committed
30
31
  (with-standard-io-syntax
    (let ((*print-case* :downcase))
Eric Timmons's avatar
Eric Timmons committed
32
      (with-open-file (s (clpmfile-pathname clpmfile) :direction :output :if-exists if-exists)
Eric Timmons's avatar
Eric Timmons committed
33
34
35
36
37
38
39
40
41
42
43
44
        (write-string ";;; -*- Mode: common-lisp; -*-" s)
        (terpri s)
        (prin1 '(:api-version "0.3") s)
        (terpri s)
        (terpri s)
        (dolist (source (sources))
          (prin1 `(:source ,@(source-to-form source)) s)
          (terpri s))
        (terpri s)
        (dolist (asd asds)
          (prin1 `(:asd ,asd) s)
          (terpri s)))))
Eric Timmons's avatar
Eric Timmons committed
45
  (clpmfile-pathname clpmfile))
Eric Timmons's avatar
Eric Timmons committed
46

Eric Timmons's avatar
Eric Timmons committed
47
(defun bundle-install (&key clpmfile (validate (constantly t)) no-resolve)
Eric Timmons's avatar
Eric Timmons committed
48
49
  "Given a clpmfile instance, install all releases from its lock file, creating
the lock file if necessary."
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
  (with-clpm-session ()
    (with-context (lockfile (clpmfile-pathname clpmfile))
      (let ((clpmfile (get-clpmfile clpmfile)))
        (unless (config-value :local)
          (dolist (s (context-sources clpmfile))
            (unless (source-can-lazy-sync-p s)
              (sync-source s))))
        (if no-resolve
            (mapc #'install-release (context-releases lockfile))
            (progn
              ;; Nuke the lockfile's requirements so that we pick up deletions
              ;; from the clpmfile.
              (setf (context-requirements lockfile) nil)
              (setf (context-user-sources lockfile) (context-user-sources clpmfile))
              (setf lockfile (install-requirements (context-requirements clpmfile)
                                                   :context lockfile
                                                   :validate validate
                                                   :update-projects (config-table-keys :bundle :local)
                                                   :save-context-p t)))))
Eric Timmons's avatar
Eric Timmons committed
69
70
      lockfile)))

Eric Timmons's avatar
Cleanup    
Eric Timmons committed
71
(defun bundle-source-registry (&key clpmfile with-client-p)
72
73
  (source-registry :with-client-p with-client-p :ignore-inherited-source-registry t
                   :context (clpmfile-pathname clpmfile)))
74

Eric Timmons's avatar
Eric Timmons committed
75
76
77
(defun bundle-update (&key clpmfile
                        update-projects (validate (constantly t))
                        update-systems)
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
  (with-clpm-session ()
    (with-context (lockfile (clpmfile-pathname clpmfile))
      (let ((clpmfile (get-clpmfile clpmfile)))
        (unless (config-value :local)
          (dolist (s (context-sources clpmfile))
            (unless (source-can-lazy-sync-p s)
              (sync-source s))))
        ;; Map all update systems to their projects.
        (dolist (system update-systems)
          (when-let* ((system-release (find system (context-system-releases lockfile)
                                            :key (compose #'system-name #'system-release-system)
                                            :test #'equal))
                      (release (system-release-release system-release))
                      (project-name (project-name (release-project release))))
            (pushnew project-name update-projects :test #'equal)))
        ;; Nuke the lockfile's requirements so that we pick up deletions
        ;; from the clpmfile.
        (setf (context-requirements lockfile) nil)
        (setf (context-user-sources lockfile) (context-user-sources clpmfile))
        (install-requirements (context-requirements clpmfile)
                              :context lockfile
                              :validate validate
                              :update-projects (or update-projects t)
                              :save-context-p t)))))
Eric Timmons's avatar
Eric Timmons committed
102
103
104
105
106
107
108
109
110
111

(defun bundle-exec (command args &key clpmfile
                                   with-client-p)
  "exec(3) (or approximate if system doesn't have exec) a COMMAND in bundle's context

COMMAND must be a string naming the command to run.

ARGS must be a list of strings containing the arguments to pass to the command.

If WITH-CLIENT-P is non-NIL, the clpm-client system is available."
112
113
  (exec command args :with-client-p with-client-p
                     :context (clpmfile-pathname clpmfile)))