Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
Menu
Open sidebar
clpm
clpm
Commits
faf971d8
Commit
faf971d8
authored
Sep 03, 2021
by
Eric Timmons
Browse files
Start work on clpmfile api-version 0.4
Add :git directive
parent
c38af9b4
Pipeline
#4596
passed with stages
in 29 minutes and 42 seconds
Changes
7
Pipelines
2
Hide whitespace changes
Inline
Side-by-side
clpm/bundle.lisp
View file @
faf971d8
...
...
@@ -33,7 +33,7 @@
(
with-open-file
(
s
(
clpmfile-pathname
clpmfile
)
:direction
:output
:if-exists
if-exists
)
(
write-string
";;; -*- Mode: common-lisp; -*-"
s
)
(
terpri
s
)
(
prin1
'
(
:api-version
"0.
3
"
)
s
)
(
prin1
'
(
:api-version
"0.
4
"
)
s
)
(
terpri
s
)
(
terpri
s
)
(
dolist
(
source
(
sources
))
...
...
clpm/clpmfile.lisp
View file @
faf971d8
...
...
@@ -23,6 +23,8 @@
(
defvar
*clpmfile-version*
)
(
defgeneric
clpmfile-pathname
(
clpmfile
))
(
defmethod
clpmfile-pathname
((
clpmfile
context
))
...
...
@@ -105,6 +107,32 @@ source."
:name
asd-file
:why
t
))))))
(
defmethod
parse-clpmfile-form
(
clpmfile
(
type
(
eql
:git
))
args
)
"Parse a :git statement from a clpmfile into a vcs-project-requirement
instance."
(
unless
(
equal
*clpmfile-version*
"0.4"
)
(
error
"This form requires API-VERSION 0.3"
))
(
destructuring-bind
(
name
&key
repository
branch
commit
tag
systems
)
args
(
assert
repository
)
(
let*
((
repo-description
(
list
:git
:repository
repository
))
(
repo
(
make-repo-from-description
repo-description
))
(
vcs-sources-ht
(
context-vcs-sources-ht
clpmfile
))
(
source
(
ensure-gethash
(
repo-to-form
repo
)
vcs-sources-ht
(
make-source
'vcs-source
:repo
repo-description
:project-name
name
))))
(
assert
(
xor
branch
commit
tag
))
(
push
(
make-instance
'vcs-project-requirement
:systems
systems
:name
name
:source
source
:branch
branch
:commit
commit
:tag
tag
:why
t
)
(
context-requirements
clpmfile
)))))
(
defmethod
parse-clpmfile-form
(
clpmfile
(
type
(
eql
:github
))
args
)
"Parse a :github statement from a clpmfile into a vcs-project-requirement
...
...
@@ -198,12 +226,15 @@ instance."
(
defun
read-clpmfile-from-stream
(
stream
pathname
)
(
let
((
clpmfile
(
make-instance
'context
:name
pathname
))
(
source-allowed-p
t
))
(
source-allowed-p
t
)
*clpmfile-version*
)
(
uiop:with-safe-io-syntax
()
;; The first form in the stream must be an API declaration.
(
let
((
f
(
read
stream
nil
)))
(
unless
(
equal
f
'
(
:api-version
"0.3"
))
(
error
"Unknown clpmfile API version"
)))
(
unless
(
or
(
equal
f
'
(
:api-version
"0.3"
))
(
equal
f
'
(
:api-version
"0.4"
)))
(
error
"Unknown clpmfile API version"
))
(
setf
*clpmfile-version*
(
second
f
)))
(
with-forms-from-stream
(
stream
form
)
(
destructuring-bind
(
type
.
args
)
form
(
when
(
and
(
eql
type
:source
)
...
...
clpm/context.lisp
View file @
faf971d8
...
...
@@ -133,14 +133,14 @@ can be named, global contexts, or anonymous."))
(
defun
copy-context
(
context
)
(
make-instance
'context
:name
(
context-name
context
)
:releases
(
copy-list
(
context-releases
context
))
:requirements
(
copy-list
(
context-requirements
context
))
:reverse-dependencies
(
copy-alist
(
context-reverse-dependencies
context
))
:user-sources
(
copy-list
(
context-user-sources
context
))
:fs-sources-ht
(
copy-hash-table
(
context-fs-sources-ht
context
))
:vcs-sources-ht
(
copy-hash-table
(
context-vcs-sources-ht
context
))
:system-releases
(
copy-tree
(
context-system-releases
context
))))
:name
(
context-name
context
)
:releases
(
copy-list
(
context-releases
context
))
:requirements
(
copy-list
(
context-requirements
context
))
:reverse-dependencies
(
copy-alist
(
context-reverse-dependencies
context
))
:user-sources
(
copy-list
(
context-user-sources
context
))
:fs-sources-ht
(
copy-hash-table
(
context-fs-sources-ht
context
))
:vcs-sources-ht
(
copy-hash-table
(
context-vcs-sources-ht
context
))
:system-releases
(
copy-tree
(
context-system-releases
context
))))
(
defun
global-context-pathname
(
name
)
(
clpm-data-pathname
(
list
"contexts"
name
)))
...
...
@@ -493,7 +493,8 @@ in place with the same name. Return the new requirement if it was modified."
(
uiop:with-safe-io-syntax
()
;; The first form in the stream must be an API declaration.
(
let
((
f
(
read
stream
nil
)))
(
unless
(
equal
f
'
(
:api-version
"0.3"
))
(
unless
(
or
(
equal
f
'
(
:api-version
"0.3"
))
(
equal
f
'
(
:api-version
"0.4"
)))
(
error
"Unknown context API version"
)))
(
let
((
out
(
make-instance
'context
:name
name
)))
...
...
@@ -550,7 +551,7 @@ in place with the same name. Return the new requirement if it was modified."
(
*print-pretty*
t
)
(
*print-right-margin*
nil
))
(
write-header
"This is autogenerated by CLPM. Do not edit by hand."
stream
)
(
format
stream
"~S~%~%"
'
(
:api-version
"0.
3
"
))
(
format
stream
"~S~%~%"
'
(
:api-version
"0.
4
"
))
;; Sources
(
write-section-header
"sources"
stream
)
...
...
clpm/repos.lisp
View file @
faf971d8
...
...
@@ -9,7 +9,8 @@
#:clpm/repos/git
#:clpm/repos/github
#:clpm/repos/gitlab
#:clpm/repos/local-git-override
)
#:clpm/repos/local-git-override
#:clpm/repos/plain-git
)
(
:reexport
#:clpm/repos/defs
)
(
:reexport
#:clpm/repos/git
)
(
:reexport
#:clpm/repos/github
)
...
...
@@ -22,6 +23,8 @@
(
defun
make-repo-from-description
(
desc
)
(
destructuring-bind
(
repo-type
&rest
args
)
desc
(
ecase
repo-type
(
:git
(
apply
#'
make-instance
'plain-git-repo
args
))
(
:github
(
apply
#'
make-instance
'github-repo
args
))
(
:gitlab
...
...
clpm/repos/git.lisp
View file @
faf971d8
...
...
@@ -18,7 +18,9 @@
(
:export
#:git-repo
#:git-repo-credentials
#:git-repo-local-dir
#:git-repo-uri-string
))
#:git-repo-uri-string
#:git-uri/real-host
#:parse-git-uri
))
(
in-package
#:clpm/repos/git
)
...
...
@@ -36,7 +38,7 @@
;; * URI parsing
(
defclass
git-uri
(
uri
)
(
defclass
git-uri
(
puri:
uri
)
((
user-name
:initform
nil
:accessor
git-uri/user-name
)
...
...
@@ -69,6 +71,8 @@
:ssh
)
(
"file"
:file
)
(
"git"
:git
)
(
t
:scp
)))
;; Implicit file protocol
...
...
@@ -87,7 +91,7 @@
(
:scp
(
puri:parse-uri
(
convert-scp-to-ssh
uri-string
)
:class
'git-uri
))
((
:http
:https
:ssh
:file
)
((
:http
:https
:ssh
:file
:git
)
(
puri:parse-uri
uri-string
:class
'git-uri
)))))
...
...
clpm/repos/plain-git.lisp
0 → 100644
View file @
faf971d8
;;;; Git repositories not hosted on a forge
;;;;
;;;; This software is part of CLPM. See README.org for more information. See
;;;; LICENSE for license information.
(
uiop:define-package
#:clpm/repos/plain-git
(
:use
#:cl
#:alexandria
#:anaphora
#:clpm/cache
#:clpm/data
#:clpm/repos/defs
#:clpm/repos/git
#:split-sequence
)
(
:import-from
#:puri
)
(
:export
#:plain-git-repo
))
(
in-package
#:clpm/repos/plain-git
)
(
defclass
plain-git-repo
(
git-repo
)
((
repository
:initarg
:repository
:reader
git-repo-uri-string
)))
(
defmethod
git-repo-credentials
((
repo
plain-git-repo
))
nil
)
(
defun
split-path
(
path
)
(
aprog1
(
split-sequence
#\/
path
)
(
dolist
(
segment
it
)
(
assert
(
not
(
equal
""
segment
)))
(
assert
(
not
(
starts-with
#\.
segment
))))))
(
defmethod
git-repo-local-dir
((
repo
plain-git-repo
))
"The cache directory for this repo is based on the hostname."
(
let*
((
uri
(
parse-git-uri
(
git-repo-uri-string
repo
)))
(
host
(
git-uri/real-host
uri
))
(
path
(
puri:uri-path
uri
))
(
path-with.git
(
if
(
not
(
ends-with-subseq
".git"
path
))
(
uiop:strcat
path
".git"
)
path
))
(
split-path
(
split-path
path-with.git
)))
(
clpm-cache-pathname
`
(
"vcs"
,
(
if
(
eql
(
puri:uri-scheme
uri
)
:file
)
"gitfs"
"git"
)
,@
(
when
(
not
(
null
host
))
(
list
host
))
,@
split-path
)
:ensure-directory
t
)))
(
defmethod
repo-lib-base-pathname
((
repo
plain-git-repo
))
(
let*
((
uri
(
parse-git-uri
(
git-repo-uri-string
repo
)))
(
host
(
git-uri/real-host
uri
))
(
path
(
puri:uri-path
uri
))
(
path-with.git
(
if
(
not
(
ends-with-subseq
".git"
path
))
(
uiop:strcat
path
".git"
)
path
))
(
split-path
(
split-path
path-with.git
)))
(
clpm-data-pathname
`
(
"vcs"
,
(
if
(
eql
(
puri:uri-scheme
uri
)
:file
)
"gitfs"
"git"
)
,@
(
when
(
not
(
null
host
))
(
list
host
))
,@
split-path
)
:ensure-directory
t
)))
(
defmethod
repo-to-form
((
repo
plain-git-repo
))
`
(
:git
:repository
,
(
git-repo-uri-string
repo
)))
docs/bundle.org
View file @
faf971d8
...
...
@@ -28,7 +28,7 @@ with zero configuration or helpers needed (other than ASDF, of course).
consists of a series of directives where each directive is a list starting
with a keyword. The directives are described below. Additionally, the first
directive in the file must be the ~:api-version~ directive. This document
describes version "0.
3
".
describes version "0.
4
".
*** ~:api-version~
...
...
@@ -37,7 +37,7 @@ with zero configuration or helpers needed (other than ASDF, of course).
file is described in. Example:
#+begin_src common-lisp
(:api-version "0.
3
")
(:api-version "0.
4
")
#+end_src
*** ~:source~
...
...
@@ -92,6 +92,27 @@ with zero configuration or helpers needed (other than ASDF, of course).
(such as ~((>= "1.1") (< "2"))~).
*** ~:git~
The git directive specifies a requirement that must be satisfied by a git
repository hosted at an arbitrary location. Unless specified otherwise,
every explicitly defined system (and their dependencies) are included in
the bundle.
#+begin_src common-lisp
(name &key repository branch commit tag systems)
#+end_src
+ ~name~ :: must be a string, unique in the file.
+ ~:repository~ :: must be a string, the url of the repository.
+ ~:branch~ :: If specified, must be a string naming the branch to use. If
none of branch, commit, or tag are specified, the branch defaults to the
default branch from the server.
+ ~:commit~ :: If specified, must be a string naming the commit to use.
+ ~:tag~ :: If specified, must be a string naming the tag to use.
+ ~:systems~ :: A list naming the systems to require in the bundle. If NIL,
all systems are required.
*** ~:github~
The github directive specifies a requirement that must be satisfied by a git
...
...
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new file
.
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment