-
Notifications
You must be signed in to change notification settings - Fork 0
/
testing.clj
151 lines (131 loc) · 4.97 KB
/
testing.clj
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
(ns pathological.testing
(:refer-clojure :exclude [name])
(:require
[pathological.files :as f]
[pathological.file-systems :as fs])
(:import
[com.google.common.jimfs Configuration
Feature
Jimfs
PathNormalization
PathType]
[java.util UUID]))
(def ^:dynamic *features*
{:links Feature/LINKS
:symbolic-links Feature/SYMBOLIC_LINKS
:secure-directory-stream Feature/SECURE_DIRECTORY_STREAM
:file-channel Feature/FILE_CHANNEL})
(def ^:dynamic *attribute-views*
{:basic "basic"
:owner "owner"
:posix "posix"
:unix "unix"
:dos "dos"
:acl "acl"
:user "user"})
(def ^:dynamic *path-normalizations*
{:case-fold-ascii PathNormalization/CASE_FOLD_ASCII
:case-fold-unicode PathNormalization/CASE_FOLD_UNICODE
:none PathNormalization/NONE
:nfc PathNormalization/NFC
:nfd PathNormalization/NFD})
(def ^:dynamic *path-types*
{:unix (PathType/unix)
:windows (PathType/windows)})
(defn random-file-system-name []
(str (UUID/randomUUID)))
(defn lookup-for [var]
(fn [value] (or (get var value) value)))
(def ->feature (lookup-for *features*))
(def ->attribute-view (lookup-for *attribute-views*))
(def ->path-type (lookup-for *path-types*))
(def ->path-normalization (lookup-for *path-normalizations*))
(defn ->attribute-views [attribute-views]
(let [attribute-views (map ->attribute-view attribute-views)
[first & others] attribute-views]
[first (into-array String others)]))
(defn ->features [features]
(let [features (map ->feature features)
features (into-array Feature features)]
features))
(defn ->roots [[first-root & other-roots]]
[first-root (into-array String other-roots)])
(defn ->path-normalizations [path-normalizations]
(let [path-normalizations (map ->path-normalization path-normalizations)
[first & others] path-normalizations]
[first (into-array PathNormalization others)]))
(defn configuration
[{:keys [path-type
roots
working-directory
name-canonical-normalization
path-equality-uses-canonical-form?
attribute-views
features]
:or {name-canonical-normalization #{}
path-equality-uses-canonical-form? false}}]
(let [path-type (->path-type path-type)
features (->features features)
[first-root other-roots] (->roots roots)
[first-attribute-view other-attribute-views]
(->attribute-views attribute-views)
[first-path-normalization other-path-normalizations]
(->path-normalizations name-canonical-normalization)
builder
(-> (Configuration/builder path-type)
(.setWorkingDirectory working-directory)
(.setPathEqualityUsesCanonicalForm path-equality-uses-canonical-form?)
(.setSupportedFeatures features))
builder (if first-root
(.setRoots builder first-root other-roots)
builder)
builder (if first-attribute-view
(.setAttributeViews builder
first-attribute-view other-attribute-views)
builder)
builder (if first-path-normalization
(.setNameCanonicalNormalization builder
first-path-normalization other-path-normalizations)
builder)]
(.build builder)))
(defn unix-configuration
[& {:as overrides}]
(configuration
(merge
{:path-type :unix
:roots ["/"]
:working-directory "/"
:attribute-views #{:basic :owner :posix :unix}
:features #{:links
:symbolic-links
:secure-directory-stream
:file-channel}}
overrides)))
(defn windows-configuration
[& {:as overrides}]
(configuration
(merge
{:path-type :windows
:roots ["C:\\"]
:working-directory "C:\\"
:name-canonical-normalization #{:case-fold-ascii}
:path-equality-uses-canonical-form? true
:attribute-views #{:basic}
:features #{:links
:symbolic-links
:file-channel}}
overrides)))
(defn new-in-memory-file-system
([] (new-in-memory-file-system (random-file-system-name)))
([name] (new-in-memory-file-system name (unix-configuration)))
([name configuration] (new-in-memory-file-system name configuration []))
([name configuration definition]
(let [file-system (Jimfs/newFileSystem name configuration)]
(f/populate-file-tree
(first (fs/root-directories file-system))
definition)
file-system))
([name configuration path definition]
(let [file-system (Jimfs/newFileSystem name configuration)]
(f/populate-file-tree path definition)
file-system)))