blob: 739bd1a34ab64a5cf22c87cb6955eac18fe8e608 (
plain)
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
|
(.module:
[lux #*
["_" test (#+ Test)]
[abstract
["." monad (#+ do)]]
[control
["." try (#+ Try)]
[concurrency
["." promise (#+ Promise)]]
[security
["!" capability]]]
[data
[binary (#+ Binary)]
["." product]
["." text ("#\." equivalence)
["%" format (#+ format)]]
[number
["n" nat]]
[collection
["." list ("#\." functor)]
["." set]]]
[math
["." random (#+ Random)]]
[world
["." file (#+ Path File)]]]
[//
["@." version]
[//
["@." profile]
[//
[lux
[data
["_." binary]]]]]]
{#program
["." /
["//#" /// #_
["#" profile]
["#." action (#+ Action)]]]})
(def: node-name
(Random Text)
(random.ascii/alpha 10))
(def: (files prefix)
(-> Path (Random (List [Path Binary])))
(do {! random.monad}
[count (\ ! map (n.% 10) random.nat)
names (random.set text.hash count ..node-name)
contents (random.list count (_binary.random 100))]
(wrap (list.zip/2 (list\map (|>> (format prefix)) (set.to-list names))
contents))))
(def: (create-file! fs [path content])
(-> (file.System Promise) [Path Binary] (Promise (Try Any)))
(do {! (try.with promise.monad)}
[file (: (Promise (Try (File Promise)))
(file.get-file promise.monad fs path))]
(!.use (\ file over-write) content)))
(def: (create-directory! fs path files)
(-> (file.System Promise) Path (List [Path Binary]) (Promise (Try Any)))
(do {! (try.with promise.monad)}
[_ (: (Promise (Try Path))
(file.make-directories promise.monad fs path))
_ (monad.map ! (..create-file! fs) files)]
(wrap [])))
(def: (directory-exists? fs)
(-> (file.System Promise) Path (Promise (Try Bit)))
(|>> (file.directory-exists? promise.monad fs) (try.lift promise.monad)))
(def: (file-exists? fs)
(-> (file.System Promise) Path (Promise (Try Bit)))
(|>> (file.file-exists? promise.monad fs) (try.lift promise.monad)))
(def: (assets-exist? fs directory-path files)
(-> (file.System Promise) Path (List [Path Binary]) (Promise (Try Bit)))
(do {! (try.with promise.monad)}
[directory-exists? (..directory-exists? fs directory-path)
files-exist? (: (Action (List Bit))
(|> files
(list\map product.left)
(monad.map ///action.monad (..file-exists? fs))))]
(wrap (and directory-exists?
(list.every? (|>>) files-exist?)))))
(def: #export test
Test
(<| (_.covering /._)
(do {! random.monad}
[context ..node-name
target ..node-name
sub ..node-name
#let [fs (file.mock (\ file.default separator))
/ (\ fs separator)
target-path (format context / target)
sub-path (format target-path / sub)]
direct-files (..files (format target-path /))
sub-files (..files (format sub-path /))
dummy @profile.random]
($_ _.and
(wrap (do promise.monad
[#let [console (@version.echo "")]
verdict (do {! (try.with promise.monad)}
[_ (/.do! console fs (set@ #///.target #.None dummy))]
(\ ! map (text\= /.failure)
(!.use (\ console read-line) [])))]
(_.cover' [/.failure]
(try.default false verdict))))
(wrap (do promise.monad
[#let [console (@version.echo "")]
verdict (do {! (try.with promise.monad)}
[_ (..create-directory! fs target-path direct-files)
_ (..create-directory! fs sub-path sub-files)
context-exists!/pre (..directory-exists? fs context)
target-exists!/pre (..assets-exist? fs target-path direct-files)
sub-exists!/pre (..assets-exist? fs sub-path sub-files)
_ (/.do! console fs (set@ #///.target (#.Some target-path) dummy))
context-exists!/post (..directory-exists? fs context)
target-exists!/post (..assets-exist? fs target-path direct-files)
sub-exists!/post (..assets-exist? fs sub-path sub-files)
logging (!.use (\ console read-line) [])]
(wrap (and (and context-exists!/pre
context-exists!/post)
(and target-exists!/pre
(not target-exists!/post))
(and sub-exists!/pre
(not sub-exists!/post))
(text\= /.success logging))))]
(_.cover' [/.do! /.success]
(try.default false verdict))))
))))
|
