(use-modules (ice-9 vlist)
(ice-9 match)
(srfi srfi-1)
(srfi srfi-11)
(guix packages)
(guix transformations)
(guix utils)
(gnu packages base)
(gnu packages package-management)
(gnu packages gnupg)
(gnu packages guile-xyz)
(gnu packages tex)
(gnu packages perl)
(gnu packages rsync)
(gnu packages ssh)
(gnu packages version-control))
(define* (package-input-rewriting/spec* replacements
#:key
(deep? #t)
(cut? (const #f)))
"This is just like PACKAGE-INPUT-REWRITING/SPEC but takes an extra
argument CUT?, a procedure that takes the package value and
returns a boolean to determine whether rewriting should continue."
(define table
(fold (lambda (replacement table)
(match replacement
((spec . proc)
(let-values (((name version)
(package-name->name+version spec)))
(vhash-cons name (list version proc) table)))))
vlist-null
replacements))
(define (find-replacement package)
(vhash-fold* (lambda (item proc)
(or proc
(match item
((#f proc)
proc)
((version proc)
(and (version-prefix? version
(package-version package))
proc)))))
#f
(package-name package)
table))
(define replacement-property
(gensym " package-replacement"))
(define (rewrite p)
(if (assq-ref (package-properties p) replacement-property)
p
(match (find-replacement p)
(#f p)
(proc
(let ((new (proc p)))
(package/inherit new
(properties `((,replacement-property . #t)
,@(package-properties new)))))))))
(define (cut?* p)
(or (assq-ref (package-properties p) replacement-property)
(find-replacement p)
(cut? p)))
(package-mapping rewrite cut?*
#:deep? deep?))
(define latest-guix
((options->transformation
'((with-git-url . "guix=file:///home/rekado/dev/gx/branches/master")
(with-commit . "guix=caa7fd47c08913120da1e734f7a574e44dbb572e")))
guix))
(define guix-guile
(and=> (assoc-ref (package-native-inputs guix) "guile") car))
(define with-guix-guile-instead-of-any-guile
(package-input-rewriting/spec*
`(("guile" . ,(const guix-guile)))
#:deep? #false
#:cut?
(lambda (p)
(not (or (string=? (package-name p) "gwl")
(string-prefix? "guile-"
(package-name p)))))))
(define-public guile-commonmark/fixed
(package
(inherit guile-commonmark)
(arguments
'(#:phases
(modify-phases %standard-phases
(add-after 'unpack 'fix-tests-when-building-with-guile-3.0.5
(lambda _
(substitute* (find-files "tests" "\\.scm$")
(("\\(exit.*") ""))
#t)))))))
(define guile-lib/htmlprag-fixed
(package
(inherit guile-lib)
(arguments
(substitute-keyword-arguments (package-arguments guile-lib)
((#:phases phases '%standard-phases)
`(modify-phases ,phases
(add-before 'build 'fix-htmlprag
(lambda _
(substitute* "src/htmlprag.scm"
(("^[[:blank:]]*\\(p[[:blank:]]+\\. \\(body td th\\)\\).*")
""))
#t))
(add-before 'check 'skip-known-failure
(lambda _
(setenv "XFAIL_TESTS" "htmlprag.scm")
#t))))))))
(define with-fixed-commonmark
(package-input-rewriting/spec*
`(("guile-commonmark" . ,(const guile-commonmark/fixed)))
#:deep? #false
#:cut?
(lambda (p)
(not (or (string=? (package-name p) "gwl")
(string-prefix? "guile-"
(package-name p)))))))
(define-public gwl/devel
((compose with-guix-guile-instead-of-any-guile
with-fixed-commonmark)
(package
(inherit gwl)
(source #f)
(arguments
'(#:make-flags
'("GUILE_AUTO_COMPILE=0")))
(inputs
`(("guix" ,latest-guix)
("guile" ,guix-guile)
("guile-commonmark" ,guile-commonmark)
("guile-config" ,guile-config)
("guile-gcrypt" ,guile-gcrypt)
("guile-pfds" ,guile-pfds)
("guile-syntax-highlight" ,guile-syntax-highlight)
("guile-wisp" ,guile-wisp)))
(native-inputs
`(("texlive" ,texlive-tiny) ("sed" ,sed)
("perl" ,perl)
("git" ,git-minimal)
("guile-lib" ,guile-lib/htmlprag-fixed)
("rsync" ,rsync)
("ssh" ,openssh)
,@(package-native-inputs gwl))))))
gwl/devel