{-# OPTIONS_GHC -Wno-missing-export-lists #-}
module Montis.Foreign.WlRoots where

import Foreign (IntPtr, Ptr, Word32, intPtrToPtr, ptrToIntPtr, nullPtr)
import Text.Read

data WlrKeyboard

data WlrPointer

data WlrPointerButtonEvent

data WlrSeat

data WlrInputDevice

data WlrEventKeyboardKey

data WlrXdgSurface

data WlrXWaylandSurface

data Surface
  = XdgSurface (Ptr WlrXdgSurface)
  | XWaylandSurface (Ptr WlrXWaylandSurface)
  deriving (Ord, Eq)

instance Show Surface where
  show (XdgSurface p) = show (XdgSerializeSurface (ptrToIntPtr p))
  show (XWaylandSurface p) = show (XWaylandSerializeSurface (ptrToIntPtr p))

instance Read Surface where
  readPrec = fmap toSurf readPrec
    where
      toSurf (XdgSerializeSurface ip) = XdgSurface (intPtrToPtr ip)
      toSurf (XWaylandSerializeSurface ip) = XWaylandSurface (intPtrToPtr ip)

-- | Type which exists specifically to derive instances of read and show.
data SerializableSurface
  = XdgSerializeSurface IntPtr
  | XWaylandSerializeSurface IntPtr
  deriving (Read, Show)

class ForeignSurface a where
  toSurface :: Ptr a -> Surface

instance ForeignSurface WlrXdgSurface where
  toSurface = XdgSurface

instance ForeignSurface WlrXWaylandSurface where
  toSurface = XWaylandSurface

guardNull :: Ptr a -> Maybe (Ptr a)
guardNull p | p == nullPtr = Nothing
guardNull p = Just p

foreign import ccall "wlr_seat_set_keyboard" wlrSeatSetKeyboard ::
    Ptr WlrSeat -> Ptr WlrInputDevice -> IO ()

foreign import ccall "wlr_seat_get_keyboard" wlrSeatGetKeyboard ::
    Ptr WlrSeat -> IO (Ptr WlrKeyboard)

foreign import ccall "wlr_keyboard_get_modifiers" wlrKeyboardGetModifiers ::
    Ptr WlrKeyboard -> IO Word32

foreign import ccall "wlr_seat_keyboard_notify_key"
  wlrSeatKeyboardNotifyKey ::
    Ptr WlrSeat -> Word32 -> Word32 -> Word32 -> IO ()