Browse Source

update with WIP AST/code generator, fix tar mistake

pull/1/head
Wesley Kerfoot 7 years ago
parent
commit
e158dda244
  1. 1
      .gitignore
  2. 4
      main.rkt
  3. 2
      src/bolt.rkt
  4. 2
      src/directory.rkt
  5. 27
      src/shell_env.rkt
  6. 42
      src/unparse.rkt
  7. 29
      src/utils.rkt

1
.gitignore

@ -3,3 +3,4 @@ remote-shell
*~
\#*
compiled
test.sh

4
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"))

2
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"

2
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)

27
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))

42
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)))))

29
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))
Loading…
Cancel
Save