module Termbox.Bindings.Hs.Internal.EventType
  ( Tb_event_type
      ( Tb_event_type,
        TB_EVENT_KEY,
        TB_EVENT_MOUSE,
        TB_EVENT_RESIZE
      ),
  )
where

import Data.Word (Word8)
import Termbox.Bindings.C (_TB_EVENT_KEY, _TB_EVENT_MOUSE, _TB_EVENT_RESIZE)

-- | An event type.
newtype Tb_event_type
  = Tb_event_type Word8
  deriving stock (Tb_event_type -> Tb_event_type -> Bool
(Tb_event_type -> Tb_event_type -> Bool)
-> (Tb_event_type -> Tb_event_type -> Bool) -> Eq Tb_event_type
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Tb_event_type -> Tb_event_type -> Bool
== :: Tb_event_type -> Tb_event_type -> Bool
$c/= :: Tb_event_type -> Tb_event_type -> Bool
/= :: Tb_event_type -> Tb_event_type -> Bool
Eq)

instance Show Tb_event_type where
  show :: Tb_event_type -> String
show = \case
    Tb_event_type
TB_EVENT_KEY -> String
"TB_EVENT_KEY"
    Tb_event_type
TB_EVENT_MOUSE -> String
"TB_EVENT_MOUSE"
    Tb_event_type
TB_EVENT_RESIZE -> String
"TB_EVENT_RESIZE"

pattern TB_EVENT_KEY :: Tb_event_type
pattern $mTB_EVENT_KEY :: forall {r}. Tb_event_type -> ((# #) -> r) -> ((# #) -> r) -> r
$bTB_EVENT_KEY :: Tb_event_type
TB_EVENT_KEY <-
  ((== Tb_event_type _TB_EVENT_KEY) -> True)
  where
    TB_EVENT_KEY = Word8 -> Tb_event_type
Tb_event_type Word8
_TB_EVENT_KEY

pattern TB_EVENT_MOUSE :: Tb_event_type
pattern $mTB_EVENT_MOUSE :: forall {r}. Tb_event_type -> ((# #) -> r) -> ((# #) -> r) -> r
$bTB_EVENT_MOUSE :: Tb_event_type
TB_EVENT_MOUSE <-
  ((== Tb_event_type _TB_EVENT_MOUSE) -> True)
  where
    TB_EVENT_MOUSE = Word8 -> Tb_event_type
Tb_event_type Word8
_TB_EVENT_MOUSE

pattern TB_EVENT_RESIZE :: Tb_event_type
pattern $mTB_EVENT_RESIZE :: forall {r}. Tb_event_type -> ((# #) -> r) -> ((# #) -> r) -> r
$bTB_EVENT_RESIZE :: Tb_event_type
TB_EVENT_RESIZE <-
  ((== Tb_event_type _TB_EVENT_RESIZE) -> True)
  where
    TB_EVENT_RESIZE = Word8 -> Tb_event_type
Tb_event_type Word8
_TB_EVENT_RESIZE

-- N.B. This requires Tb_event_type to remain abstract
{-# COMPLETE TB_EVENT_KEY, TB_EVENT_MOUSE, TB_EVENT_RESIZE #-}