aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/test/aedifex/command/pom.lux
blob: 624be95bd9bc86a97de9dcf61a2f0e94e3096373 (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
(.module:
  [library
   [lux #*
    ["_" test (#+ Test)]
    [abstract
     [monad (#+ do)]]
    [control
     ["." try ("#\." functor)]
     [concurrency
      ["." promise]]]
    [data
     ["." binary ("#\." equivalence)]
     ["." text ("#\." equivalence)
      [encoding
       ["." utf8]]]
     [format
      ["." xml]]]
    [math
     ["." random]]
    [world
     ["." file]]]]
  [//
   ["@." version]
   [//
    ["@." profile]]]
  [\\program
   ["." /
    ["//#" /// #_
     ["#" profile]
     ["#." action]
     ["#." pom]]]])

(def: #export test
  Test
  (<| (_.covering /._)
      (do random.monad
        [sample @profile.random
         #let [fs (file.mock (\ file.default separator))]]
        (wrap (do {! promise.monad}
                [#let [console (@version.echo "")]
                 outcome (/.do! console fs sample)]
                (case outcome
                  (#try.Success _)
                  (do !
                    [verdict (do ///action.monad
                               [expected (|> (///pom.write sample)
                                             (try\map (|>> (\ xml.codec encode)
                                                           (\ utf8.codec encode)))
                                             (\ ! wrap))
                                actual (\ fs read ///pom.file)

                                logging! (\ ///action.monad map
                                            (text\= /.success)
                                            (\ console read_line []))

                                #let [expected_content!
                                      (binary\= expected actual)]]
                               (wrap (and logging!
                                          expected_content!)))]
                    (_.cover' [/.do! /.success]
                              (try.default false verdict)))
                  
                  (#try.Failure error)
                  (_.cover' [/.do!]
                            (case (get@ #///.identity sample)
                              (#.Some _)
                              false

                              #.None
                              true))))))))