stdlib/source/test/lux/world/input/keyboard.lux


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
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172

(.require
 [library
  [lux (.except)
   [abstract
    [monad (.only do)]]
   [control
    ["[0]" maybe]]
   [data
    ["[0]" bit (.use "[1]#[0]" equivalence)]
    [collection
     ["[0]" list]
     ["[0]" set (.only Set)]]]
   [math
    ["[0]" random (.only Random)]
    [number
     ["n" nat]]]
   [meta
    [macro
     ["[0]" template]]]
   [test
    ["_" property (.only Test)]]]]
 [\\library
  ["[0]" /]])

(with_expansions [<groups> (these [keys/commands
                                   [/.back_space
                                    /.enter
                                    /.shift
                                    /.control
                                    /.alt
                                    /.caps_lock
                                    /.escape
                                    /.space
                                    /.page_up
                                    /.page_down
                                    /.end
                                    /.home
                                    /.delete
                                    /.num_lock
                                    /.scroll_lock
                                    /.print_screen
                                    /.insert
                                    /.windows

                                    /.left
                                    /.up
                                    /.right
                                    /.down]]
                                  
                                  [keys/letters
                                   [/.a
                                    /.b
                                    /.c
                                    /.d
                                    /.e
                                    /.f
                                    /.g
                                    /.h
                                    /.i
                                    /.j
                                    /.k
                                    /.l
                                    /.m
                                    /.n
                                    /.o
                                    /.p
                                    /.q
                                    /.r
                                    /.s
                                    /.t
                                    /.u
                                    /.v
                                    /.w
                                    /.x
                                    /.y
                                    /.z]]
                                  
                                  [keys/num_pad
                                   [/.num_pad_0
                                    /.num_pad_1
                                    /.num_pad_2
                                    /.num_pad_3
                                    /.num_pad_4
                                    /.num_pad_5
                                    /.num_pad_6
                                    /.num_pad_7
                                    /.num_pad_8
                                    /.num_pad_9]]

                                  [keys/functions
                                   [/.f1
                                    /.f2
                                    /.f3
                                    /.f4
                                    /.f5
                                    /.f6
                                    /.f7
                                    /.f8
                                    /.f9
                                    /.f10
                                    /.f11
                                    /.f12
                                    /.f13
                                    /.f14
                                    /.f15
                                    /.f16
                                    /.f17
                                    /.f18
                                    /.f19
                                    /.f20
                                    /.f21
                                    /.f22
                                    /.f23
                                    /.f24]])]
  (def listing
    (List /.Key)
    (list.together (`` (list (,, (with_template [<definition> <keys>]
                                   [((is (-> Any (List /.Key))
                                         (function (_ _)
                                           (`` (list (,, (template.spliced <keys>))))))
                                     [])]
                                   
                                   <groups>))))))

  (def catalogue
    (Set /.Key)
    (set.of_list n.hash ..listing))

  (def verdict
    (n.= (list.size ..listing)
         (set.size ..catalogue)))

  (with_template [<definition> <keys>]
    [(def <definition>
       Test
       (_.coverage <keys>
         ..verdict))]
    
    <groups>)

  (def .public random
    (Random /.Key)
    (let [count (list.size ..listing)]
      (do [! random.monad]
        [choice (of ! each (n.% count) random.nat)]
        (in (maybe.trusted (list.item choice ..listing))))))

  (def .public test
    Test
    (<| (_.covering /._)
        (_.for [/.Key])
        (`` (all _.and
                 (,, (with_template [<definition> <keys>]
                       [<definition>]
                       
                       <groups>))

                 (_.for [/.Press /.#input /.#pressed?]
                        (`` (all _.and
                                 (,, (with_template [<pressed?> <function>]
                                       [(do random.monad
                                          [key ..random
                                           .let [sample (<function> key)]]
                                          (_.coverage [<function>]
                                            (and (bit#= <pressed?> (the /.#pressed? sample))
                                                 (n.= key (the /.#input sample)))))]

                                       [#0 /.release]
                                       [#1 /.press]
                                       ))
                                 )))
                 )))))