guile-zenity/examples/guix-helper.scm

(use-modules (zenity))

(let* ((info (or (zenity-forms "Guix Package Helper"
                                "Package information:"
                                '((entry . "package name")
                                  (entry . "version")
                                  (entry . "source code url")
                                  (entry . "[git commit id]")
                                  (entry . "synopsis")
                                  (entry . "home page")))
                 (exit)))
       (package-name (list-ref info 0))
       (version (list-ref info 1))
       (source-url (list-ref info 2))
       (commit (list-ref info 3))
       (synopsis (list-ref info 4))
       (home-page (list-ref info 5))
       (method (if (equal? commit "")
                   'url-fetch
                   'git-fetch))
       (inputs (or (zenity-entry "List some of the inputs (separated by a space):")
                   #f))
       (license (or (zenity-list "Guix Package Helper"
                                 '("License")
                                 (map list
                                      '("gpl1" "gpl1+" "gpl2" "gpl2+" "gpl3" "gpl3+"
                                        "bsd-2" "bsd-3" "bsd-4"
                                        "x11" "x11-style"
                                        "non-copyleft" "unlicense"))
                                 #:height 400)
                    (exit)))
       (build-system/tests (or (zenity-list "Guix Package Helper"
                                            '("Build System")
                                            (map list
                                                 '("trivial-build-system (no tests)"
                                                   "gnu-build-system"
                                                   "gnu-build-system (disable tests)"
                                                   "cmake-build-system"
                                                   "cmake-build-system (disable tests)"))
                                            #:height 400)
                               (exit)))
       (build-system (string-split (car build-system/tests) #\space))
       (tests? (not (string-index (car build-system/tests) #\space))))
  (newline)
  (format #t "(define-public ~a~%" package-name)
  (format #t "  (package~%")
  (format #t "    (name ~s)~%" package-name)
  (format #t "    (version ~s)~%" version)
  (format #t "    (source (origin~%")
  (format #t "               (method ~a)~%" method)
  (case method
    ((url-fetch)
     (format #t "               (uri ~s)~%" source-url))
    ((git-fetch)
     (format #t "               (uri (git-reference~%")
     (format #t "                    (url ~s)~%" source-url)
     (format #t "                    (commit ~s))~%" commit)))
  (format #t "               (sha256~%")
  (format #t "                (base32~%")
  (format #t "                 ~s))))~%" "")
  (format #t "    (build-system ~a)~%" (car build-system))
  (unless tests?
    (format #t "    (arguments~%")
    (format #t "     `(#:tests? #f))~%"))
  (when inputs
    (format #t "    (inputs~%")
    (let ((indent "     `("))
      (for-each (lambda (input)
                  (format #t "~a(~s ,~a)~%" indent input input)
                  (set! indent "       "))
                (string-split inputs #\space))
      (format #t "~a))~%" indent)))
  (format #t "    (synopsis ~s)~%" synopsis)
  (format #t "    (description ~s)~%" "TODO")
  (format #t "    (home-page ~s)~%" home-page)
  (format #t "    (license ~a)))~%" (string-append "license:" (car license)))
  (newline)
  (exit))