summaryrefslogtreecommitdiff
path: root/tools/Scanner/Protocol.lean
blob: 183ef6a80a31f0db40303bb5e782894236b8ec73 (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
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
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
import Std.Data.TreeSet

namespace WaylandScanner

structure Description where
  summary : Option String
  body : Option String
  deriving Repr, BEq, Inhabited

def Description.ofSummary (s : String) : Description :=
  { summary := s
    body := .none }

/-! Identifiers, stored in their original representation (i.e., camel case). -/
def Identifier := String
  deriving Repr, BEq, Ord, Inhabited

def Identifier.quoted (ident : Identifier) : String :=
  let s : String := ident
  s!"\"{s}\""

private def Identifier.pascalCase' (parts : List String.Slice) : String :=
  parts
    |>.map (String.capitalize ∘ String.Slice.toString)
    |> String.join

private def sanitize (s : String) : String :=
  let isInvalid :=
    ((0 : String.Pos.Raw).get s).isDigit || s == "class"
  if isInvalid then "_" ++ s else s

def Identifier.pascalCase (ident : Identifier) : String :=
  ident
    |>.split "_"
    |>.toList
    |> pascalCase'
    |> sanitize

def Identifier.camelCase (ident : Identifier) : String :=
  match (ident.split "_").toList with
  | [] => ""
  | x::xs => sanitize (x.toString ++ pascalCase' xs)

namespace Raw

structure EnumEntryDesc where
  name : String
  value : Int
  description : Option Description
  since : Nat
  deprecatedSince : Option Nat
  deriving Repr, BEq, Inhabited

structure EnumDesc where
  name : String
  description : Option Description
  since : Nat
  bitfield : Bool
  entries: Array EnumEntryDesc
  deriving Repr, BEq, Inhabited

inductive ArgumentType where
  | int
  | uint
  | fixed
  | string
  | array
  | fd
  | newID
  | object
  deriving Repr, BEq, Inhabited

structure ArgumentDesc where
  name : String
  type : ArgumentType
  description : Option Description
  interface : Option String
  enum : Option String
  allowNull : Bool
  deriving Repr, BEq, Inhabited

inductive MessageType where
  | normal
  | destructor
  deriving Repr, BEq, Inhabited

structure MessageDesc where
  name : String
  opcode : Nat
  description : Option Description
  type : MessageType
  since : Nat
  deprecatedSince : Option Nat
  arguments : Array ArgumentDesc
  deriving Repr, BEq, Inhabited

structure InterfaceDesc where
  name : String
  version : Nat
  description : Option Description
  enums : Array EnumDesc
  requests : Array MessageDesc
  events : Array MessageDesc
  deriving Repr, BEq, Inhabited

structure ProtocolDesc where
  name : String
  copyright : Option String
  description : Option Description
  interfaces : Array InterfaceDesc
  deriving Repr, BEq, Inhabited

end Raw

namespace Client

structure InterfaceRef where
  protocol : Identifier
  interface : Identifier
  deriving Repr, BEq, Ord, Inhabited

structure EnumRef extends InterfaceRef where
  enum : Identifier
  deriving Repr, BEq, Ord, Inhabited

structure EnumEntryDesc where
  name : Identifier
  value : Int
  description : Option Description
  since : Nat
  deprecatedSince : Option Nat
  deriving Repr, BEq, Inhabited

structure EnumDesc where
  name : Identifier
  description : Option Description
  since : Nat
  bitfield : Bool
  entries: Array EnumEntryDesc
  deriving Repr, BEq, Inhabited

inductive Nullability where
  | nullable
  | notNull
  deriving Repr, BEq, Inhabited

def Nullability.ofAllowNull (allowNull : Bool) : Nullability :=
  if allowNull then .nullable else .notNull

inductive ArgumentType where
  | int (enum : Option EnumRef)
  | uint (enum : Option EnumRef)
  | fixed
  | string (nullability : Nullability)
  | array
  | fd
  | object (nullability : Nullability) (interface : Option InterfaceRef)
  deriving Repr, BEq, Inhabited

structure ArgumentDesc where
  name : Identifier
  type : ArgumentType
  description : Option Description
  deriving Repr, BEq, Inhabited

structure MessageDesc where
  name : Identifier
  opcode : Nat
  description : Option Description
  isDestructor : Bool
  since : Nat
  deprecatedSince : Option Nat
  arguments : Array ArgumentDesc
  rawArguments : Array Raw.ArgumentDesc
  deriving Repr, BEq, Inhabited

inductive ReturnType where
  | unit
  | object (type : Option InterfaceRef)
  deriving Repr, BEq, Inhabited

structure RequestDesc extends MessageDesc where
  returnType : ReturnType
  deriving Repr, BEq, Inhabited

structure EventDesc extends MessageDesc
  deriving Repr, BEq, Inhabited

structure InterfaceDesc where
  name : Identifier
  version : Nat
  description : Option Description
  enums : Array EnumDesc
  requests : Array RequestDesc
  events : Array EventDesc
  referencedInterfaces : Std.TreeSet InterfaceRef
  deriving Repr, BEq, Inhabited

structure ProtocolDesc where
  name : Identifier
  copyright : Option String
  description : Option Description
  interfaces : Array InterfaceDesc
  deriving Repr, BEq, Inhabited

end Client

end WaylandScanner