aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/test/aedifex/command/install.lux
blob: 2dbddeaa335d374901adc1880965a70f7b454dd7 (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
(.module:
  [lux #*
   ["_" test (#+ Test)]
   [abstract
    ["." monad (#+ do)]]
   [control
    ["." try (#+ Try) ("#\." functor)]
    ["." exception]
    [concurrency
     ["." promise (#+ Promise)]]
    [security
     ["!" capability]]]
   [data
    ["." maybe]
    ["." binary]
    ["." text ("#\." equivalence)
     ["%" format (#+ format)]
     ["." encoding]]
    [format
     ["." xml]]
    [collection
     ["." set (#+ Set)]]]
   [math
    ["." random (#+ Random)]]
   [world
    ["." file (#+ Path File)]]]
  [//
   ["@." version]
   [//
    ["@." profile]
    ["@." artifact]]]
  {#program
   ["." /
    ["/#" // #_
     ["#." clean]
     ["/#" // #_
      ["#" profile]
      ["#." action]
      ["#." pom]
      ["#." local]
      ["#." artifact
       ["#/." extension]]]]]})

(def: (make-sources! fs sources)
  (-> (file.System Promise) (Set Path) (Promise (Try Any)))
  (loop [sources (set.to-list sources)]
    (case sources
      #.Nil
      (|> []
          (\ try.monad wrap)
          (\ promise.monad wrap))
      
      (#.Cons head tail)
      (do (try.with promise.monad)
        [_ (: (Promise (Try Path))
              (file.make-directories promise.monad fs head))
         _ (: (Promise (Try (File Promise)))
              (file.get-file promise.monad fs (format head (\ fs separator) head ".lux")))]
        (recur tail)))))

(def: (execute! fs sample)
  (-> (file.System Promise) ///.Profile (Promise (Try Text)))
  (do ///action.monad
    [#let [console (@version.echo "")]
     _ (..make-sources! fs (get@ #///.sources sample))
     _ (: (Promise (Try Path))
          (file.make-directories promise.monad fs (///local.repository fs)))
     _ (/.do! console fs sample)]
    (!.use (\ console read-line) [])))

(def: #export test
  Test
  (<| (_.covering /._)
      (do {! random.monad}
        [identity @artifact.random
         sample (\ ! map (set@ #///.identity (#.Some identity))
                   @profile.random)]
        ($_ _.and
            (wrap (do {! promise.monad}
                    [#let [fs (file.mock (\ file.default separator))]
                     verdict (do ///action.monad
                               [logging (..execute! fs sample)
                                #let [artifact-path (format (///local.path fs identity)
                                                            (\ fs separator)
                                                            (///artifact.identity identity))
                                      library-path (format artifact-path ///artifact/extension.lux-library)
                                      pom-path (format artifact-path ///artifact/extension.pom)]

                                library-exists! (\ promise.monad map
                                                   exception.return
                                                   (file.file-exists? promise.monad fs library-path))
                                pom-exists! (\ promise.monad map
                                               exception.return
                                               (file.file-exists? promise.monad fs pom-path))]
                               (wrap (and (text\= //clean.success logging)
                                          library-exists!
                                          pom-exists!)))]
                    (_.cover' [/.do!]
                              (try.default false verdict))))
            (wrap (do {! promise.monad}
                    [#let [fs (file.mock (\ file.default separator))]
                     logging (..execute! fs (set@ #///.identity #.None sample))]
                    (_.cover' [/.failure]
                              (|> logging
                                  (try\map (text\= /.failure))
                                  (try.default false)))))
            ))))