dotfiles/dot_guile

;; -*- mode: Scheme; fill-column: 78; -*-

(define-macro (try function)
  `(catch 'quit (lambda () ,function) (const #f)))

(define (system->string command)
  (let* ((port ((@@ (ice-9 popen) open-pipe) command OPEN_READ))
         (output ((@@ (ice-9 rdelim) read-string) port)))
    ((@@ (ice-9 popen) close-pipe) port)
    output))

(define (system->string* . args)
  (let* ((port (apply (@@ (ice-9 popen) open-pipe*) OPEN_READ args))
         (output ((@@ (ice-9 rdelim) read-string) port)))
    ((@@ (ice-9 popen) close-pipe) port)
    output))

(define (expand-file-name path)
  (system->string (string-join (list "readlink" "-nf" path))))

(cond ((false-if-exception (resolve-interface '(ice-9 readline)))
       =>
       (lambda (module)
         ;; Enable completion and input history at the REPL.
         ((module-ref module 'activate-readline))))
      (else
       (display "Consider installing the 'guile-readline' package for
convenient interactive line editing and input history.\n\n")))

      (unless (getenv "INSIDE_EMACS")
        (cond ((false-if-exception (resolve-interface '(ice-9 colorized)))
               =>
               (lambda (module)
                 ;; Enable completion and input history at the REPL.
                 ((module-ref module 'activate-colorized))))
              (else
               (display "Consider installing the 'guile-colorized' package
for a colorful Guile experience.\n\n"))))

(use-modules (srfi srfi-1))
(when (string-prefix? "guix" (last (string-split (getcwd) #\/)))
  (use-modules (guix)
               (guix build utils)
               (guix store)

               (system repl command)

               (ice-9 pretty-print)))
(define c
  (if (string-prefix? "guix" (last (string-split (getcwd) #\/)))
      (open-connection)
      #f))
(when (string-prefix? "guix" (last (string-split (getcwd) #\/)))
  (define-meta-command ((xref guix) repl arg)
    "xref SYMBOL
Find symbol in GUILE_PATH"
    (pk (symbol-location arg)))
  (define-meta-command ((gnu guix) repl arg)
    "gnu MODULE
Invoke (use-modules (gnu packages MODULE))"
    (cond ((false-if-exception (resolve-interface `(gnu packages ,arg)))
           =>
           (lambda (module)
             ;; Enable completion and input history at the REPL.
             (module-use! (current-module) module)))
          (else
           (display "Missing module.\n\n")))))

(define (ssh-node host)
  (use-modules (ssh session)
               (ssh auth)
               (ssh dist)
               (ssh dist node))
  (define session
    (make-session #:host host))
  (connect! session)
  (userauth-public-key/auto! session)
  (make-node session))