-
Notifications
You must be signed in to change notification settings - Fork 2
/
main.zuo
242 lines (223 loc) · 9.68 KB
/
main.zuo
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
#lang zuo
(provide-targets targets-at)
(require zuo/shell)
(define env (runtime-env))
(define (targets-at at-dir [vars (hash)])
(define (lookup key [default ""])
(hash-ref vars key default))
(define links (path->complete-path (lookup 'LINKS "links")))
(define at-home
(make-at-dir (cdr (or (assoc "HOME" (hash-ref env 'env))
(error "HOME not set in environment")))))
(define at-xdg-config
;; TODO: read XDG vars
(make-at-dir (at-home ".config")))
(define at-links
(make-at-dir (at-dir links)))
(define ~/.ssh (at-home ".ssh"))
(define dirs
(list (at-xdg-config) (at-xdg-config "swi-prolog") ~/.ssh))
(define brewfile (lookup 'BREWFILE (at-dir "brew" "Brewfile")))
(define features (string-read (lookup 'FEATURES "git-extras brew-install rust")))
(define user-gitk (at-xdg-config "git" "gitk"))
(define dracula-gitk (at-dir "Dracula" "gitk" "gitk"))
(define alacritty-terminfo-url
"https://raw.githubusercontent.com/alacritty/alacritty/master/extra/alacritty.info")
(define brew-url
"https://raw.githubusercontent.com/Homebrew/install/HEAD/install.sh")
(define terminfo
(at-home ".local" "share" "terminfo"))
(define tmux-terminfo
(build-path terminfo "74" "tmux-256color"))
(define targets
`([:target default ()
,(lambda (token)
(alert "targets:")
(for-each (lambda (t)
(alert (~a " " (list-ref t 1))))
(filter (lambda (t)
(equal? (car t) ':target))
targets))
(alert "features:")
(for-each (lambda (f)
(alert (~a " " f)))
'(git-extras brew-install rust)))]
[:target install (dirs symlink zcompile ,@features) ,void]
[:target update (pull-master update-submodules symlink brew-check vimtags rust zcompile) ,void]
[:target vimtags ()
,(lambda (token)
(shell/wait "vim +':helptags ALL' +q"))]
[:target ,brewfile ()
,(lambda (dest token)
(shell/wait "brew bundle dump --force" (~a "--file=" (string->shell dest))))]
[:target ,tmux-terminfo ()
,(lambda (dest token)
(rm* dest)
(shell/wait
"zsh -c"
(string->shell
(build-shell
`("/usr/bin/tic -x -o" ,(string->shell terminfo)
"=($(brew --prefix ncurses)/bin/infocmp -x tmux-256color |"
" sed -E 's/pairs#(0x10000|65536)/pairs#32767/')")))))]
[:target dirs ()
,(lambda (token)
(for-each mkdir-p dirs)
(shell/wait "chmod u=rwx,go=" (string->shell ~/.ssh)))]
[:target git-extras (,user-gitk) ,void]
[:target ,user-gitk (,dracula-gitk)
,(lambda (dest token)
(define dest-dir (car (split-path dest)))
(when dest-dir
(mkdir-p dest-dir))
(cp* dracula-gitk dest))]
[:target brew-install ()
,(lambda (token)
(unless (find-executable-path "brew")
(shell/wait (shell-subst "/bin/bash -c $(curl -fsSL ${url})"
(hash 'url (string->shell brew-url))))))]
[:target brew-setup ()
,(lambda (token)
(define brew-prefix (string-trim (shell/output "brew --prefix") "\n"))
(define brew/bin/zsh (~a (string->shell brew-prefix) "/bin/zsh"))
(for-each
shell/wait
`(["brew bundle install" ,(~a "--file=" (string->shell brewfile))]
["grep" ,brew/bin/zsh "/etc/shells"
"|| sudo sh -c" ,(string->shell
(build-shell `["echo" ,brew/bin/zsh ">> /etc/shells"]))]
["chsh -s" ,brew/bin/zsh "$USER"])))]
[:target rust ("rust_packages")
,(lambda (token)
(when (find-executable-path "cargo")
(for-each
(lambda (package)
(shell/wait "cargo install" package))
(filter non-empty-string?
(string-split (file->string "rust_packages") "\n")))))]
[:target pull-master ()
,(lambda (token)
(for-each
shell/wait
`(["git checkout master"]
["git pull --autostash"])))]
[:target update-submodules ()
,(lambda (token)
(for-each
shell/wait
`(["git submodule sync"]
["git submodule update --recursive"])))]
[:target brew-check (,brewfile)
,(lambda (token)
(shell/wait/no-verify "brew bundle check" (~a "--file=" (string->shell brewfile))))]
[:target zcompile (,(at-links "zcompile"))
,(lambda (token)
(when (find-executable-path "zsh")
(shell/wait (at-links "zcompile"))))]
[:target compile-vim (,(at-links "bin/compile-vim"))
,(lambda (token)
(shell/wait "bash -c 'type readarray'")
(shell/wait (at-links "bin/compile-vim")))]
[:target symlink ()
,(lambda (token)
(for-each
(lambda (dest-symbol)
(define dest-raw (symbol->string dest-symbol))
(define src (at-links (hash-ref the-links dest-symbol)))
(define dest (at-home dest-raw))
(alert (~a "rm -rf " dest))
(rm* dest)
(symlink src #;<- dest)
(alert (~a dest " -> " src)))
(hash-keys the-links)))]
[:target gc-submodules ()
,(lambda (token)
(shell/wait "git submodule foreach" (string->shell "git gc --aggressive --prune=now")))]
[:target symlink-racket-paths ()
,(lambda (token)
(define paths
(car
(string-read
(shell/output `("racket -I racket/base -e"
,(string->shell
(string-join
'("(require setup/dirs)"
"(write (map path->bytes"
" (list (find-user-console-bin-dir)"
" (find-user-man-dir))))")))))
0
"$(racket -I racket/base -e ...)")))
(define bin-dir (car paths))
(define man-dir (cadr paths))
(define racket-bin (at-home ".racket-bin"))
(define racket-man (at-home ".racket-man"))
(for-each make-racket-link
(list (racket-link racket-bin bin-dir)
(racket-link racket-man man-dir))))]))
(make-targets targets))
(define the-links
;; vim: `!iicolumn -t<enter>` and `gsii` will help
(hash
'.bash "bash"
'.bash_profile "bash_profile"
'.bashrc "bashrc"
'.bin "bin"
'.clisprc.lisp "clisprc.lisp"
'.clojure "clojure"
'.config/alacritty "config/alacritty"
'.config/http-prompt "config/http-prompt"
'.config/swi-prolog/init.pl "config/swi-prolog/init.pl"
'.ctags.d "ctags.d"
'.gdbinit "gdbinit"
'.git_template "git_template"
'.gitattributes "gitattributes"
'.gitconfig "gitconfig"
'.gitignore_global "gitignore_global"
'.gitshrc "gitshrc"
'.inputrc "inputrc"
'.irbrc "irbrc"
'.jupyter "jupyter"
'.latexmkrc "latexmkrc"
'.markdownlintrc "markdownlintrc"
'.newsboat "newsboat"
'.pryrc "pryrc"
'.pythonrc "pythonrc"
'.rgrc "rgrc"
'.ssh/config "ssh/config"
'.tmux.conf "tmux.conf"
'.vim "vim"
'.zsh "zsh"
'.zshenv "zshenv"
'.zshfns "zshfns"
'.zshrc "zshrc"
))
(struct racket-link [src dest])
(define (make-racket-link rl)
(define src (racket-link-src rl))
(define dest (racket-link-dest rl))
(rm* src)
(symlink dest #;<- src)
(alert (~a src " -> " dest)))
(define (shell/output command-tree [options (hash)])
(define options*
(hash-remove options 'no-thread?))
(define wait
(cond
[(hash-ref options 'no-thread? #f) process-wait]
[else thread-process-wait]))
(define p
(shell command-tree (hash-set options 'stdout 'pipe)))
(define proc (hash-ref p 'process))
(wait proc)
(unless (= 0 (process-status proc))
(error 'shell/output "command failed:\n" command-tree))
(define stdout (hash-ref p 'stdout))
(fd-read stdout eof))
(define (shell/wait/no-verify . args)
(displayln (build-shell args))
(define p (apply shell args))
(thread-process-wait (hash-ref p 'process)))
(define (empty-string? s)
(string=? "" s))
(define (non-empty-string? s)
(not (empty-string? s)))