aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/test/lux/control/remember.lux
blob: bd9833aec72ccb4a4cd4f3511b8357bf4134ada8 (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
(.module:
  [library
   [lux #*
    ["_" test (#+ Test)]
    ["." meta]
    [abstract
     ["." monad (#+ do)]]
    [control
     ["." io]
     ["." try (#+ Try)]
     ["." exception]
     [parser
      ["<c>" code]]]
    [data
     ["." product]
     ["." text
      ["%" format (#+ format)]]]
    [math
     [number (#+ hex)]
     ["." random (#+ Random) ("#\." monad)]]
    [time
     ["." date (#+ Date)]
     ["." instant]
     ["." duration]]
    ["." macro
     ["." code]
     ["." syntax (#+ syntax:)]]]]
  [\\library
   ["." /]])

(def: deadline (Random Date) random.date)
(def: message (Random Text) (random\map %.bit random.bit))
(def: focus (Random Code) (random\map code.bit random.bit))

(def: (to_remember macro deadline message focus)
  (-> Name Date Text (Maybe Code) Code)
  (` ((~ (code.identifier macro))
      (~ (code.text (%.date deadline)))
      (~ (code.text message))
      (~+ (case focus
            #.None (list)
            (#.Some focus) (list focus))))))

(def: (attempt computation)
  (All [a] (-> (Meta a) (Meta (Try a))))
  (function (_ compiler)
    (case (computation compiler)
      (#try.Success [compiler output])
      (#try.Success [compiler (#try.Success output)])

      (#try.Failure error)
      (#try.Success [compiler (#try.Failure error)]))))

(def: (test_failure deadline message focus failure)
  (-> Date Text (Maybe Code) Text Bit)
  (and (text.contains? (%.date deadline) failure)
       (text.contains? message failure)
       (case focus
         #.None
         true
         
         (#.Some focus)
         (text.contains? (%.code focus) failure))))

(syntax: (test_macro {macro <c>.identifier} {extra <c>.text})
  (let [now (io.run instant.now)
        today (instant.date now)
        yesterday (instant.date (instant.shift (duration.inverse duration.week) now))
        tomorrow (instant.date (instant.shift duration.week now))
        prng (random.pcg32 [(hex "0123456789ABCDEF")
                            (instant.to_millis now)])
        message (product.right (random.run prng ..message))
        expected (product.right (random.run prng ..focus))]
    (do meta.monad
      [should_fail0 (..attempt (macro.expansion (to_remember macro yesterday message #.None)))
       should_fail1 (..attempt (macro.expansion (to_remember macro yesterday message (#.Some expected))))
       should_succeed0 (..attempt (macro.expansion (to_remember macro tomorrow message #.None)))
       should_succeed1 (..attempt (macro.expansion (to_remember macro tomorrow message (#.Some expected))))]
      (in (list (code.bit (and (case should_fail0
                                 (#try.Failure error)
                                 (and (test_failure yesterday message #.None error)
                                      (text.contains? extra error))

                                 _
                                 false)
                               (case should_fail1
                                 (#try.Failure error)
                                 (and (test_failure yesterday message (#.Some expected) error)
                                      (text.contains? extra error))

                                 _
                                 false)
                               (case should_succeed0
                                 (^ (#try.Success (list)))
                                 true

                                 _
                                 false)
                               (case should_succeed1
                                 (^ (#try.Success (list actual)))
                                 (is? expected actual)

                                 _
                                 false)
                               )))))))

(def: #export test
  Test
  (<| (_.covering /._)
      (do random.monad
        [deadline ..deadline
         message ..message
         focus ..focus]
        ($_ _.and
            (_.cover [/.must_remember]
                     (and (test_failure deadline message #.None
                                        (exception.construct /.must_remember [deadline deadline message #.None]))
                          (test_failure deadline message (#.Some focus)
                                        (exception.construct /.must_remember [deadline deadline message (#.Some focus)]))))
            (_.cover [/.remember]
                     (..test_macro /.remember ""))
            (_.cover [/.to_do]
                     (..test_macro /.to_do "TODO"))
            (_.cover [/.fix_me]
                     (..test_macro /.fix_me "FIXME"))
            ))))