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
|
#lang zuo
;; This module implements a simple version of the `tree` program,
;; which shows the content of a directory in tree form.
;; Another script could use this `tree` function...
(provide tree)
;; ... but if this script is the main one passed to Zuo,
;; then the `main` submodule is run, which parses command-line
;; arguments and call `tree`.
(module+ main
;; Imitates Racket's `command-line` form, but we have to explicitly
;; thread through `accum`, because there's no state
(command-line
:init (hash) ; initial accumulator (but `(hash)` is the default, anyway)
:once-each
;; Each flag clause starts with the accumulator id
[accum ("-a") "Include names that start with `.`"
(hash-set accum 'all? #t)]
[accum ("-h") "Show file sizes human-readable"
(hash-set accum 'h-size? #t)]
:args ([dir "."])
(lambda (accum) ; args handler as procedure to receive the accumulator
(if (directory-exists? dir)
(tree dir
(hash-ref accum 'all? #f)
(hash-ref accum 'h-size? #f))
(error (~a (hash-ref (runtime-env) 'script)
": no such directory: "
dir))))))
;; Recur using `ls` to get a directory's content
(define (tree dir show-all? show-size?)
(displayln dir)
(let tree ([dir dir] [depth 0])
(define elems (sort (ls dir) string<?))
(let in-dir ([elems (if show-all? elems (filter not-dot? elems))])
(unless (null? elems)
(define elem (car elems))
(define elem-path (build-path dir elem))
(define s (stat elem-path))
(let loop ([depth depth])
(unless (= depth 0)
(display "│ ")
(loop (- depth 1))))
(if (null? (cdr elems))
(display "└─ ")
(display "├─ "))
(when show-size?
(display (~a "[" (human-readable (hash-ref s 'size)) "] ")))
(displayln elem)
(when (eq? (hash-ref s 'type) 'dir)
(tree elem-path (+ depth 1)))
(in-dir (cdr elems))))))
(define not-dot?
(let ([dot? (glob->matcher ".*")])
(lambda (s) (not (dot? s)))))
;; Arithmetic is not Zuo's strong suit, since it supports only
;; 64-bit signed integers
(define (human-readable n)
(define (decimal n)
(define d (quotient 1024 10))
(define dec (quotient (+ (modulo n 1024) (quotient d 2)) d))
(~a (quotient n (* 1024)) "." dec))
(define s
(cond
[(< n 1024) (~a n)]
[(< n (quotient (* 1024 1024) 10)) (~a (decimal n) "K")]
[else (~a (decimal (quotient n 1024)) "M")]))
(if (< (string-length s) 4)
(~a (substring " " (string-length s)) s)
s))
|
