start working on c bindings for libwayland

1 files changed, 92 insertions, 0 deletions

diff --git a/wayland/Wayland/Server/System.hsc b/wayland/Wayland/Server/System.hsc
new file mode 100644
index 0000000..d86f59a
--- /dev/null
+++ b/wayland/Wayland/Server/System.hsc
@@ -0,0 +1,92 @@
+{-# LANGUAGE ForeignFunctionInterface #-}
+
+module Wayland.Server.System
+  ( WLMessage(..)
+  , WLInterface(..)
+  , WLDisplay(WLDisplay)
+  , wlDisplayCreate
+  , wlDisplayDestroy
+  , wlDisplayAddSocketAuto
+  , wlDisplayRun
+  , wlDisplayTerminate
+  ) where
+
+#include <wayland-server.h>
+
+import Foreign (Ptr, Storable(..))
+import Foreign.C (CString, CInt)
+
+data WLMessage
+  = WLMessage { msgName      :: CString
+              , msgSignature :: CString
+              , msgTypes     :: Ptr (Ptr WLInterface)
+              }
+
+data WLInterface
+  = WLInterface { ifName        :: CString
+                , ifVersion     :: CInt
+                , ifMethodCount :: CInt
+                , ifMethods     :: Ptr WLMessage
+                , ifEventCount  :: CInt
+                , ifEvents      :: Ptr WLMessage
+                }
+
+newtype WLDisplay = WLDisplay (Ptr WLDisplay)
+
+foreign import ccall "wl_display_create"
+  wlDisplayCreate :: IO WLDisplay
+
+foreign import ccall "wl_display_destroy"
+  wlDisplayDestroy :: WLDisplay -> IO ()
+
+foreign import ccall "wl_display_add_socket_auto"
+  wlDisplayAddSocketAuto :: WLDisplay -> IO CString
+
+foreign import ccall "wl_display_run"
+  wlDisplayRun :: WLDisplay -> IO ()
+
+foreign import ccall "wl_display_terminate"
+  wlDisplayTerminate :: WLDisplay -> IO ()
+
+instance Storable WLMessage where
+  sizeOf    _ = #{size struct wl_message}
+  alignment _ = #{alignment struct wl_message}
+  peek p = do
+    name      <- #{peek struct wl_message, name}      p
+    signature <- #{peek struct wl_message, signature} p
+    types     <- #{peek struct wl_message, types}     p
+    return $ WLMessage { msgName      = name
+                       , msgSignature = signature
+                       , msgTypes     = types
+                       }
+  poke p m = do
+    #{poke struct wl_message, name}      p $ msgName      m
+    #{poke struct wl_message, signature} p $ msgSignature m
+    #{poke struct wl_message, types}     p $ msgTypes     m
+    return ()
+
+instance Storable WLInterface where
+  sizeOf    _ = #{size struct wl_interface}
+  alignment _ = #{alignment struct wl_interface}
+  peek p = do
+    name        <- #{peek struct wl_interface, name}         p
+    version     <- #{peek struct wl_interface, version}      p
+    methodCount <- #{peek struct wl_interface, method_count} p
+    methods     <- #{peek struct wl_interface, methods}      p
+    eventCount  <- #{peek struct wl_interface, event_count}  p
+    events      <- #{peek struct wl_interface, events}       p
+    return $ WLInterface { ifName        = name
+                         , ifVersion     = version
+                         , ifMethodCount = methodCount
+                         , ifMethods     = methods
+                         , ifEventCount  = eventCount
+                         , ifEvents      = events
+                         }
+  poke p m = do
+    #{poke struct wl_interface, name}         p $ ifName        m
+    #{poke struct wl_interface, version}      p $ ifVersion     m
+    #{poke struct wl_interface, method_count} p $ ifMethodCount m
+    #{poke struct wl_interface, methods}      p $ ifMethods     m
+    #{poke struct wl_interface, event_count}  p $ ifEventCount  m
+    #{poke struct wl_interface, events}       p $ ifEvents      m
+    return ()