aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/test/aedifex/command/install.lux
blob: 5800bca6daef58c980386589c31180244156bcd5 (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
(.module:
  [lux #*
   ["_" test (#+ Test)]
   [abstract
    ["." monad (#+ do)]]
   [control
    ["." try (#+ Try) ("#\." functor)]
    ["." exception]
    [concurrency
     ["." promise (#+ Promise)]]
    [parser
     ["." environment]]]
   [data
    ["." binary]
    ["." text ("#\." equivalence)
     ["%" format (#+ format)]]
    [collection
     ["." set (#+ Set)]]]
   [math
    ["." random]]
   [world
    ["." file]
    ["." program (#+ Program)]]]
  [//
   ["$." version]
   [//
    ["$." profile]
    ["$." artifact]]]
  {#program
   ["." /
    ["/#" // #_
     ["/#" // #_
      ["#" profile]
      ["#." action (#+ Action)]
      ["#." local]
      ["#." artifact
       ["#/." extension]]
      ["#." repository #_
       ["#/." local]]]]]})

(def: #export (make_sources! fs sources)
  (-> (file.System Promise) (Set file.Path) (Action (List Any)))
  (let [/ (\ fs separator)
        ! ///action.monad]
    (|> sources
        set.to_list
        (monad.map ! (function (_ head)
                       (do !
                         [_ (: (Promise (Try Any))
                               (file.make_directories promise.monad fs head))]
                         (: (Promise (Try Any))
                            (file.make_file promise.monad fs (binary.create 0) (format head / head ".lux")))))))))

(def: (execute! program fs sample)
  (-> (Program Promise) (file.System Promise) ///.Profile (Promise (Try Text)))
  (do ///action.monad
    [#let [console ($version.echo "")]
     _ (..make_sources! fs (get@ #///.sources sample))
     _ (/.do! console fs (///repository/local.repository program fs) sample)]
    (\ console read_line [])))

(def: #export test
  Test
  (<| (_.covering /._)
      (do {! random.monad}
        [identity $artifact.random
         sample (\ ! map (set@ #///.identity (#.Some identity))
                   $profile.random)
         home (random.ascii/alpha 5)
         working_directory (random.ascii/alpha 5)]
        ($_ _.and
            (wrap (do {! promise.monad}
                    [#let [fs (file.mock (\ file.default separator))
                           program (program.async (program.mock environment.empty home working_directory))

                           artifact_path (///local.uri (get@ #///artifact.version identity) identity)
                           library_path (format artifact_path ///artifact/extension.lux_library)
                           pom_path (format artifact_path ///artifact/extension.pom)]
                     verdict (do {! ///action.monad}
                               [succeeded! (\ ! map (text\= /.success)
                                              (..execute! program fs sample))
                                library_exists! (|> library_path
                                                    (\ fs file?)
                                                    (\ promise.monad map exception.return))
                                pom_exists! (|> pom_path
                                                (\ fs file?)
                                                (\ promise.monad map exception.return))]
                               (wrap (and succeeded!
                                          library_exists!
                                          pom_exists!)))]
                    (_.cover' [/.do! /.success]
                              (try.default false verdict))))
            (wrap (do {! promise.monad}
                    [#let [fs (file.mock (\ file.default separator))
                           program (program.async (program.mock environment.empty home working_directory))]
                     logging (..execute! program fs (set@ #///.identity #.None sample))]
                    (_.cover' [/.failure]
                              (|> logging
                                  (try\map (text\= /.failure))
                                  (try.default false)))))
            ))))