summaryrefslogtreecommitdiff
path: root/lib/Wayland/Object.lean
blob: 6c5dbb7c721975e05063949f1c6bc25ee5b7846c (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
import Wayland.Display

namespace Wayland

def InterfaceName : Type := String
  deriving Repr, BEq

def OpCode : Type := UInt32
  deriving Repr, BEq

structure Object (ι : InterfaceName) where

structure NewID (ι : InterfaceName) where

class ArgumentMarshaller (m : Type → Type) extends Monad m where
  marshalInt                        : Int32             → m Unit
  marshalUInt                       : UInt32            → m Unit
  marshalFixed                      : Float32           → m Unit
  marshalString                     : Option String     → m Unit
  marshalObject {ι : InterfaceName} : Option (Object ι) → m Unit
  marshalNewID {ι : InterfaceName}  : NewID ι           → m Unit
  marshalArray                      : ByteArray         → m Unit
  marshalFD                         : Int32             → m Unit

class ArgumentDemarshaller (m : Type → Type) extends Monad m where
  demarshalInt                        : m Int32
  demarshalUInt                       : m UInt32
  demarshalFixed                      : m Float32
  demarshalString                     : m (Option String)
  demarshalObject {ι : InterfaceName} : m (Option (Object ι))
  demarshalNewID {ι : InterfaceName}  : m (NewID ι)
  demarshalArray                      : m ByteArray
  demarshalFD                         : m Int32

inductive Nullability where
  | nullable
  | notNull

inductive Argument where
  | int : Argument
  | uint : Argument
  | fixed : Argument
  | string : Nullability → Argument
  | object : Nullability → InterfaceName → Argument
  | newID : InterfaceName → Argument
  | array : Argument
  | fd : Argument

structure Message where
  name : String
  args : Array Argument
  since : UInt32
  isDestructor : Bool

class Request (α : Type) where
  messages : Array Message
  signature : α → Message
  marshal {m : Type → Type} [ArgumentMarshaller m] : α → m OpCode

class Event (α : Type) where
  messages : Array Message
  signature : α → Message
  demarshal {m : Type → Type} [ArgumentDemarshaller m] : OpCode → m α

class Interface (ι : InterfaceName) where
  request : Type
  [requestClass : Request request]
  event : Type
  [eventClass : Event event]
  version : UInt32

variable {σ : Type} {ι : InterfaceName}

def Object.send [iface : Interface ι] (obj : Object ι) (req : iface.request) : DisplayM σ Unit := sorry
def Object.listen [iface : Interface ι] (obj : Object ι) (handler : iface.event → DisplayM σ Unit) : DisplayM σ Unit := sorry

-- def WLDisplay.name : InterfaceName := "wl_display"
-- abbrev WLDisplay : Type := Object WLDisplay.name

-- inductive WLDisplay.Request where
--   | sync : Request

-- inductive WLDisplay.Event where
--   | error : Event

-- instance : Request WLDisplay.Request := sorry
-- instance : Event WLDisplay.Event := sorry
-- instance : Interface WLDisplay.name where
--   request := WLDisplay.Request
--   event := WLDisplay.Event
--   version := 1

-- def test (disp : WLDisplay) : DisplayM σ Unit := do
--   disp.listen fun
--     | .error => DisplayM.liftIO (IO.println "error!")
--   disp.send .sync

end Wayland