prototype the build script

1 files changed, 63 insertions, 29 deletions

diff --git a/com/simatime/bild.scm b/com/simatime/bild.scm
index 11403e8..604a545 100644..100755
--- a/com/simatime/bild.scm
+++ b/com/simatime/bild.scm
@@ -1,5 +1,14 @@
+#!/usr/bin/env bash
+exec guile -e "(@ (com simatime bild) main)" -s "$0" "$@"
+!#
 ;; bild - a simple build tool
 ;;
+;;; Notice:
+;;
+;; This is under active development. For now this is just a convenience wrapper
+;; around `nix build`. The below commentary describes how this tool *should*
+;; work.
+;;
 ;;; Commentary:
 ;;
 ;; Design constraints
@@ -89,8 +98,6 @@
 ;;
 ;; Once the build command template is filled out, we can create the nix expression.
 ;;
-;; TODO
-;;
 ;; Questions
 ;;
 ;; - how to import (third-party) dependencies?
@@ -103,43 +110,70 @@
 ;;   - e.g. that ghcjs and ghc take the same input files...
 ;;   - say you have a .md file, you want to bild it to pdf, html, and more. What do?
 ;;   - i guess the nix file could return a set of drvs instead of a single drv
-;;   - the top of the file should
+;;
+;; TODO
+;; - stream output from 'nix build' subprocess
+;; - get rid of guile notes during execution
+;; - ns<->path macro
+;; - support list (scheme namespace) in ns<->path fns
 ;;
 ;;; Code:
 
 (define-module (com simatime bild)
-  #:use-module ((ice-9 ftw) #:prefix ftw:)
+  #:use-module ((ice-9 popen) #:prefix popen/)
+  #:use-module ((ice-9 format) #:select (format))
   #:export (ns?
-            ns->path))
+            ns->path
+            path->ns
+            main))
+
+(define-syntax fmt
+  (syntax-rules ()
+    ((fmt s args ...)
+     (format #f s args ...))))
+
+(define (main args)
+  (let* ((root (sh/exec "git rev-parse --show-toplevel"))
+         (target (cadr args))
+         (path (ns->path target)))
+    (display (fmt ":: bild ~a...\r" target))
+    (sh/exec (fmt "nix build -f ~a/default.nix -o ~a/_bild/~a ~a"
+                  root root path target))
+    (display (fmt ":: bilt ~a" target))))
 
 (define ns? symbol?)
 
 (define (ns->path ns)
-  ;; in place of a spec
-  (when (ns? ns)
-    (string-fold
-     (lambda (a b)
-       (if (eq? a #\.)
-           (string-concatenate (list b (string #\/)))
-           (string-concatenate (list b (string a)))))
-     ""
-     (symbol->string ns))))
+  (let ((to-path (lambda (s) (string/replace s #\. #\/))))
+    (cond
+     ((symbol? ns) (to-path (symbol->string ns)))
+     ((string? ns) (to-path ns))
+     (else (error "ns should be a string or symbol")))))
 
-(define ns->module-name (ns)
-  TODO)
+(define (path->ns path)
+  (let ((to-ns (lambda (s) (string/replace s #\/ #\.))))
+    (cond
+     ((symbol? path) (to-ns (symbol->string path)))
+     ((string? path) (to-ns path))
+     (else (error "path should be a string or symbol")))))
 
-(define (ns sym)
-  (define-module (ns->module-name)))
+
+;;
+;; general funs, to be moved to a core lib
+;;
 
-(define (prn a) (display a) (newline))
+(define (string/replace s match replacement)
+  (string-fold
+   (lambda (a b)
+     (let ((next-char (if (eq? a match)
+                          replacement
+                          a)))
+       (string-concatenate (list b (string next-char)))))
+   ""
+   s))
 
-;; todo
-;;
-;; - find buildable files given a namespace
-;; - select a build method based on ext
-;; - run the build
-(define (find-buildable ns)
-  (ftw:ftw ns
-           (lambda (a b c)
-             (map prn (list a b c))
-             #t)))
+(define (sh/exec cmd)
+  (let* ((port (popen/open-input-pipe cmd))
+         (ret (read port)))
+    (popen/close-pipe port)
+    ret))