Commit | Line | Data |
---|---|---|
7f918cf1 CE |
1 | (* Copyright (C) 1999-2007 Henry Cejtin, Matthew Fluet, Suresh |
2 | * Jagannathan, and Stephen Weeks. | |
3 | * | |
4 | * MLton is released under a BSD-style license. | |
5 | * See the file MLton-LICENSE for details. | |
6 | *) | |
7 | ||
8 | structure Dir:> DIR = | |
9 | struct | |
10 | ||
11 | structure FS = OS.FileSys | |
12 | ||
13 | type t = string | |
14 | type file = string | |
15 | ||
16 | fun toString d = d | |
17 | ||
18 | val layout = Layout.str | |
19 | ||
20 | val root = "/" | |
21 | ||
22 | local | |
23 | open FS | |
24 | in | |
25 | val current = getDir | |
26 | val remove = rmDir | |
27 | val cd = chDir | |
28 | val cd = Trace.trace ("Dir.cd", layout, Unit.layout) cd | |
29 | val make = mkDir | |
30 | end | |
31 | ||
32 | fun isDir d = FS.isDir d handle OS.SysErr _ => false | |
33 | ||
34 | val doesExist = File.doesExist | |
35 | ||
36 | fun inDir (d, th) = | |
37 | let | |
38 | val cur = current () | |
39 | val () = cd d | |
40 | in | |
41 | Exn.finally (th, fn () => cd cur) | |
42 | end | |
43 | ||
44 | fun fold (d: t, a: 'a, f: string * 'a -> 'a): 'a = | |
45 | let | |
46 | val stream = FS.openDir d | |
47 | fun loop a = | |
48 | case FS.readDir stream of | |
49 | NONE => a | |
50 | | SOME s => loop (f (s, a)) | |
51 | in | |
52 | Exn.finally (fn () => loop a, fn () => FS.closeDir stream) | |
53 | end | |
54 | ||
55 | fun ls d = | |
56 | fold (d, ([], []), fn (x, (dirs, files)) => | |
57 | let | |
58 | val file = OS.Path.joinDirFile { dir=d, file=x } | |
59 | val file = FS.realPath file | |
60 | in | |
61 | if FS.isLink file | |
62 | then (dirs, files) | |
63 | else if isDir file | |
64 | then (x :: dirs, files) | |
65 | else (dirs, x :: files) | |
66 | end) | |
67 | ||
68 | val lsDirs = #1 o ls | |
69 | val lsFiles = #2 o ls | |
70 | ||
71 | fun removeR d = | |
72 | let | |
73 | val old = current () | |
74 | val _ = cd d | |
75 | (* loop removes everything in the current directory *) | |
76 | fun loop () = | |
77 | fold (".", (), fn (s, ()) => | |
78 | if isDir s | |
79 | then (cd s | |
80 | ; loop () | |
81 | ; cd ".." | |
82 | ; remove s) | |
83 | else File.remove s) | |
84 | val _ = loop () | |
85 | val _ = cd old | |
86 | val _ = remove d | |
87 | in | |
88 | () | |
89 | end | |
90 | ||
91 | fun inTemp thunk = | |
92 | let | |
93 | val d = concat [MLton.TextIO.tempPrefix "dir", Random.alphaNumString 6] | |
94 | val _ = make d | |
95 | in | |
96 | Exn.finally (fn () => inDir (d, fn _ => thunk ()), | |
97 | fn () => removeR d) | |
98 | end | |
99 | end |