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 qualified Termbox.Bindings.C

-- | 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, Eq Tb_event_type
Eq Tb_event_type =>
(Tb_event_type -> Tb_event_type -> Ordering)
-> (Tb_event_type -> Tb_event_type -> Bool)
-> (Tb_event_type -> Tb_event_type -> Bool)
-> (Tb_event_type -> Tb_event_type -> Bool)
-> (Tb_event_type -> Tb_event_type -> Bool)
-> (Tb_event_type -> Tb_event_type -> Tb_event_type)
-> (Tb_event_type -> Tb_event_type -> Tb_event_type)
-> Ord Tb_event_type
Tb_event_type -> Tb_event_type -> Bool
Tb_event_type -> Tb_event_type -> Ordering
Tb_event_type -> Tb_event_type -> Tb_event_type
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Tb_event_type -> Tb_event_type -> Ordering
compare :: Tb_event_type -> Tb_event_type -> Ordering
$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
$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
$cmax :: Tb_event_type -> Tb_event_type -> Tb_event_type
max :: Tb_event_type -> Tb_event_type -> Tb_event_type
$cmin :: Tb_event_type -> Tb_event_type -> Tb_event_type
min :: Tb_event_type -> Tb_event_type -> Tb_event_type
Ord)

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 Termbox.Bindings.C._TB_EVENT_KEY) -> True)
  where
    TB_EVENT_KEY = Word8 -> Tb_event_type
Tb_event_type Word8
Termbox.Bindings.C._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 Termbox.Bindings.C._TB_EVENT_MOUSE) -> True)
  where
    TB_EVENT_MOUSE = Word8 -> Tb_event_type
Tb_event_type Word8
Termbox.Bindings.C._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 Termbox.Bindings.C._TB_EVENT_RESIZE) -> True)
  where
    TB_EVENT_RESIZE = Word8 -> Tb_event_type
Tb_event_type Word8
Termbox.Bindings.C._TB_EVENT_RESIZE

{-# COMPLETE TB_EVENT_KEY, TB_EVENT_MOUSE, TB_EVENT_RESIZE #-}