From e158dda244d469a78e39f43366cc58af399180cd Mon Sep 17 00:00:00 2001
From: Wesley Kerfoot <wjak56@gmail.com>
Date: Sat, 5 May 2018 14:44:44 -0400
Subject: [PATCH] update with WIP AST/code generator, fix tar mistake

---
 .gitignore        |  1 +
 main.rkt          |  4 ++--
 src/bolt.rkt      |  2 +-
 src/directory.rkt |  2 +-
 src/shell_env.rkt | 27 ++-------------------------
 src/unparse.rkt   | 42 ++++++++++++++++++++++++++++++++++++++++++
 src/utils.rkt     | 29 +++++++++++++++++++++++++++++
 7 files changed, 78 insertions(+), 29 deletions(-)
 create mode 100644 src/unparse.rkt
 create mode 100644 src/utils.rkt

diff --git a/.gitignore b/.gitignore
index 7c9eeed..bcb59c3 100644
--- a/.gitignore
+++ b/.gitignore
@@ -3,3 +3,4 @@ remote-shell
 *~
 \#*
 compiled
+test.sh
diff --git a/main.rkt b/main.rkt
index e979ff7..2f6739e 100644
--- a/main.rkt
+++ b/main.rkt
@@ -1,4 +1,4 @@
 #lang racket/base
 
-(require "bolt.rkt")
-(provide (all-from-out "bolt.rkt"))
+(require "./src/bolt.rkt")
+(provide (all-from-out "./src/bolt.rkt"))
diff --git a/src/bolt.rkt b/src/bolt.rkt
index 6cda9a6..89a362d 100755
--- a/src/bolt.rkt
+++ b/src/bolt.rkt
@@ -69,7 +69,7 @@
        (as-user
          (format "cd ~a && ~a ~a"
                  (cwd)
-                 (format-vars)
+                 (format-vars (shell-env))
                  cmd)
          )
        #:failure-log "/tmp/test.log"
diff --git a/src/directory.rkt b/src/directory.rkt
index 83e22e3..3cf1e68 100644
--- a/src/directory.rkt
+++ b/src/directory.rkt
@@ -13,7 +13,7 @@
     (format "/tmp/~a.tar.gz"
             (clean-path directory)))
 
-  (system* tar "-zcvf" path directory)
+  (system* tar "-zcvf" path "-C" directory ".")
   path)
 
 (define (remove-tmp path)
diff --git a/src/shell_env.rkt b/src/shell_env.rkt
index 23d53f7..0d5a643 100644
--- a/src/shell_env.rkt
+++ b/src/shell_env.rkt
@@ -1,5 +1,7 @@
 #lang racket
 
+(require "utils.rkt")
+
 (define default-shell-vars
   #hash(
         ("LANG" . "en_US.UTF-8")))
@@ -7,24 +9,6 @@
 (define shell-env
   (make-parameter default-shell-vars))
 
-(define (remove-dups xs ys)
-  (define dups
-    (set-intersect (map car xs)
-                   (map car ys)))
-  (define new-xs
-    (filter-not
-      (compose1
-        (lambda (x) (member x dups))
-        car)
-      xs))
-    new-xs)
-
-(define (merge-hash h1 h2)
-  (define h1-vs (hash->list h1))
-  (define h2-vs  (hash->list h2))
-  (define new-h2-vs (remove-dups h2-vs h1-vs))
-  (make-hash (append new-h2-vs h1-vs)))
-
 (define (merge-hashes . hs)
   (foldl merge-hash #hash() hs))
 
@@ -35,13 +19,6 @@
       (shell-env)
       (make-hash vars))))
 
-(define (format-vars)
-  (string-join
-    (hash-map
-      (shell-env)
-      (lambda (k v)
-        (format "export ~a=~a;" k v)))))
-
 (define-syntax join-shell-vars
   (syntax-rules ()
     [(join-shell-vars (k v))
diff --git a/src/unparse.rkt b/src/unparse.rkt
new file mode 100644
index 0000000..1d9f446
--- /dev/null
+++ b/src/unparse.rkt
@@ -0,0 +1,42 @@
+#lang racket
+
+(require "utils.rkt")
+
+(define default-env
+  #hash(
+        ("LANG" . "en_US.UTF-8")))
+(struct
+  UserCommand
+  (username cmd))
+
+(struct
+  WithDirectoryCommand
+  (directory cmd))
+
+(struct
+  ExecCommand
+  (command env))
+
+(define (printshell stx)
+  (match stx
+    [(WithDirectoryCommand directory cmd)
+     (format "cd ~a; ~a" directory (printshell cmd))]
+
+    [(UserCommand username cmd)
+     (format "sudo -u ~a sh -c '~a'"
+             username
+             (printshell cmd))]
+
+    [(ExecCommand command env)
+     (define funcname (gensym))
+     (format "function ~a { ~a ~a; }; ~a"
+             funcname
+             (format-vars env)
+             command
+             funcname)]))
+
+(displayln
+  (printshell
+    (WithDirectoryCommand "/home/wes"
+        (UserCommand "wes"
+          (ExecCommand "echo $LANG" default-env)))))
diff --git a/src/utils.rkt b/src/utils.rkt
new file mode 100644
index 0000000..b116db8
--- /dev/null
+++ b/src/utils.rkt
@@ -0,0 +1,29 @@
+#lang racket
+
+(define (remove-dups xs ys)
+  (define dups
+    (set-intersect (map car xs)
+                   (map car ys)))
+  (define new-xs
+    (filter-not
+      (compose1
+        (lambda (x) (member x dups))
+        car)
+      xs))
+    new-xs)
+
+(define (merge-hash h1 h2)
+  (define h1-vs (hash->list h1))
+  (define h2-vs  (hash->list h2))
+  (define new-h2-vs (remove-dups h2-vs h1-vs))
+  (make-hash (append new-h2-vs h1-vs)))
+
+(define (format-vars env)
+  (string-join
+    (hash-map
+      env
+      (lambda (k v)
+        (format "export ~a=~a;" k v)))))
+
+(provide
+  (all-defined-out))