module Termbox.Bindings.Hs.Internal.InputMode
  ( Tb_input_mode
      ( Tb_input_mode,
        TB_INPUT_CURRENT,
        TB_INPUT_ALT,
        TB_INPUT_ESC,
        TB_INPUT_MOUSE
      ),
  )
where

import Foreign.C.Types (CInt)
import qualified Termbox.Bindings.C

-- | The input mode.
newtype Tb_input_mode
  = Tb_input_mode CInt
  deriving stock (Tb_input_mode -> Tb_input_mode -> Bool
(Tb_input_mode -> Tb_input_mode -> Bool)
-> (Tb_input_mode -> Tb_input_mode -> Bool) -> Eq Tb_input_mode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Tb_input_mode -> Tb_input_mode -> Bool
== :: Tb_input_mode -> Tb_input_mode -> Bool
$c/= :: Tb_input_mode -> Tb_input_mode -> Bool
/= :: Tb_input_mode -> Tb_input_mode -> Bool
Eq, Eq Tb_input_mode
Eq Tb_input_mode =>
(Tb_input_mode -> Tb_input_mode -> Ordering)
-> (Tb_input_mode -> Tb_input_mode -> Bool)
-> (Tb_input_mode -> Tb_input_mode -> Bool)
-> (Tb_input_mode -> Tb_input_mode -> Bool)
-> (Tb_input_mode -> Tb_input_mode -> Bool)
-> (Tb_input_mode -> Tb_input_mode -> Tb_input_mode)
-> (Tb_input_mode -> Tb_input_mode -> Tb_input_mode)
-> Ord Tb_input_mode
Tb_input_mode -> Tb_input_mode -> Bool
Tb_input_mode -> Tb_input_mode -> Ordering
Tb_input_mode -> Tb_input_mode -> Tb_input_mode
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_input_mode -> Tb_input_mode -> Ordering
compare :: Tb_input_mode -> Tb_input_mode -> Ordering
$c< :: Tb_input_mode -> Tb_input_mode -> Bool
< :: Tb_input_mode -> Tb_input_mode -> Bool
$c<= :: Tb_input_mode -> Tb_input_mode -> Bool
<= :: Tb_input_mode -> Tb_input_mode -> Bool
$c> :: Tb_input_mode -> Tb_input_mode -> Bool
> :: Tb_input_mode -> Tb_input_mode -> Bool
$c>= :: Tb_input_mode -> Tb_input_mode -> Bool
>= :: Tb_input_mode -> Tb_input_mode -> Bool
$cmax :: Tb_input_mode -> Tb_input_mode -> Tb_input_mode
max :: Tb_input_mode -> Tb_input_mode -> Tb_input_mode
$cmin :: Tb_input_mode -> Tb_input_mode -> Tb_input_mode
min :: Tb_input_mode -> Tb_input_mode -> Tb_input_mode
Ord)

instance Show Tb_input_mode where
  show :: Tb_input_mode -> String
show = \case
    Tb_input_mode
TB_INPUT_CURRENT -> String
"TB_INPUT_CURRENT"
    Tb_input_mode
TB_INPUT_ALT -> String
"TB_INPUT_ALT"
    Tb_input_mode
TB_INPUT_ESC -> String
"TB_INPUT_ESC"
    Tb_input_mode
TB_INPUT_MOUSE -> String
"TB_INPUT_MOUSE"

pattern TB_INPUT_CURRENT :: Tb_input_mode
pattern $mTB_INPUT_CURRENT :: forall {r}. Tb_input_mode -> ((# #) -> r) -> ((# #) -> r) -> r
$bTB_INPUT_CURRENT :: Tb_input_mode
TB_INPUT_CURRENT <-
  ((== Tb_input_mode Termbox.Bindings.C._TB_INPUT_CURRENT) -> True)
  where
    TB_INPUT_CURRENT = CInt -> Tb_input_mode
Tb_input_mode CInt
Termbox.Bindings.C._TB_INPUT_CURRENT

pattern TB_INPUT_ALT :: Tb_input_mode
pattern $mTB_INPUT_ALT :: forall {r}. Tb_input_mode -> ((# #) -> r) -> ((# #) -> r) -> r
$bTB_INPUT_ALT :: Tb_input_mode
TB_INPUT_ALT <-
  ((== Tb_input_mode Termbox.Bindings.C._TB_INPUT_ALT) -> True)
  where
    TB_INPUT_ALT = CInt -> Tb_input_mode
Tb_input_mode CInt
Termbox.Bindings.C._TB_INPUT_ALT

pattern TB_INPUT_ESC :: Tb_input_mode
pattern $mTB_INPUT_ESC :: forall {r}. Tb_input_mode -> ((# #) -> r) -> ((# #) -> r) -> r
$bTB_INPUT_ESC :: Tb_input_mode
TB_INPUT_ESC <-
  ((== Tb_input_mode Termbox.Bindings.C._TB_INPUT_ESC) -> True)
  where
    TB_INPUT_ESC = CInt -> Tb_input_mode
Tb_input_mode CInt
Termbox.Bindings.C._TB_INPUT_ESC

pattern TB_INPUT_MOUSE :: Tb_input_mode
pattern $mTB_INPUT_MOUSE :: forall {r}. Tb_input_mode -> ((# #) -> r) -> ((# #) -> r) -> r
$bTB_INPUT_MOUSE :: Tb_input_mode
TB_INPUT_MOUSE <-
  ((== Tb_input_mode Termbox.Bindings.C._TB_INPUT_MOUSE) -> True)
  where
    TB_INPUT_MOUSE = CInt -> Tb_input_mode
Tb_input_mode CInt
Termbox.Bindings.C._TB_INPUT_MOUSE

{-# COMPLETE TB_INPUT_CURRENT, TB_INPUT_ALT, TB_INPUT_ESC, TB_INPUT_MOUSE #-}