remove some silly derived Ord instances

termbox-bindings-hs/CHANGELOG.md

@@ -5,7 +5,9 @@
 - Make `Show` instance of `Tb_key` not call `error` on unknown keys
 - Hide representation of `Tb_event_mod`
 - Improve `Show` instance of `Tb_event_mod`
-- Delete `tb_attr`
+- Add `Exception` instance for `Tb_init_error`
+- Remove `tb_attr`
+- Remove `Ord` instances of `Tb_cell`, `Tb_event`, `Tb_event_mod`, `Tb_event_type`, `Tb_init_error`
 
 ## [0.1.1] - November 5, 2023
 

termbox-bindings-hs/src/Termbox/Bindings/Hs/Internal/Cell.hs

@@ -18,7 +18,7 @@ data Tb_cell = Tb_cell
     -- | Background color and attributes.
     bg :: {-# UNPACK #-} !Tb_color_and_attrs
   }
-  deriving stock (Eq, Generic, Ord, Show)
+  deriving stock (Eq, Generic, Show)
 
 cellToCCell :: Tb_cell -> Termbox.Tb_cell
 cellToCCell Tb_cell {ch, fg = Tb_color_and_attrs fg, bg = Tb_color_and_attrs bg} =

termbox-bindings-hs/src/Termbox/Bindings/Hs/Internal/ColorAndAttrs.hs

@@ -23,7 +23,7 @@ import qualified Termbox.Bindings.C as Termbox
 -- | A color and attributes.
 newtype Tb_color_and_attrs
   = Tb_color_and_attrs Word16
-  deriving stock (Eq, Ord, Show)
+  deriving stock (Eq, Show)
 
 instance Monoid Tb_color_and_attrs where
   mempty = Tb_color_and_attrs 0

termbox-bindings-hs/src/Termbox/Bindings/Hs/Internal/Event.hs

@@ -24,7 +24,7 @@ data Tb_event = Tb_event
     x :: {-# UNPACK #-} !Int32,
     y :: {-# UNPACK #-} !Int32
   }
-  deriving stock (Eq, Generic, Ord, Show)
+  deriving stock (Eq, Generic, Show)
 
 ceventToEvent :: Termbox.Tb_event -> Tb_event
 ceventToEvent Termbox.Tb_event {type_, mod, key, ch, w, h, x, y} =

termbox-bindings-hs/src/Termbox/Bindings/Hs/Internal/EventMod.hs

@@ -13,7 +13,7 @@ import qualified Termbox.Bindings.C
 -- | An event modifier.
 newtype Tb_event_mod
   = Tb_event_mod Word8
-  deriving stock (Eq, Ord)
+  deriving stock (Eq)
 
 instance Show Tb_event_mod where
   show = \case

termbox-bindings-hs/src/Termbox/Bindings/Hs/Internal/EventType.hs

@@ -9,12 +9,12 @@ module Termbox.Bindings.Hs.Internal.EventType
 where
 
 import Data.Word (Word8)
-import qualified Termbox.Bindings.C
+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 (Eq, Ord)
+  deriving stock (Eq)
 
 instance Show Tb_event_type where
   show = \case
@@ -24,21 +24,21 @@ instance Show Tb_event_type where
 
 pattern TB_EVENT_KEY :: Tb_event_type
 pattern TB_EVENT_KEY <-
-  ((== Tb_event_type Termbox.Bindings.C._TB_EVENT_KEY) -> True)
+  ((== Tb_event_type _TB_EVENT_KEY) -> True)
   where
-    TB_EVENT_KEY = Tb_event_type Termbox.Bindings.C._TB_EVENT_KEY
+    TB_EVENT_KEY = Tb_event_type _TB_EVENT_KEY
 
 pattern TB_EVENT_MOUSE :: Tb_event_type
 pattern TB_EVENT_MOUSE <-
-  ((== Tb_event_type Termbox.Bindings.C._TB_EVENT_MOUSE) -> True)
+  ((== Tb_event_type _TB_EVENT_MOUSE) -> True)
   where
-    TB_EVENT_MOUSE = Tb_event_type Termbox.Bindings.C._TB_EVENT_MOUSE
+    TB_EVENT_MOUSE = Tb_event_type _TB_EVENT_MOUSE
 
 pattern TB_EVENT_RESIZE :: Tb_event_type
 pattern TB_EVENT_RESIZE <-
-  ((== Tb_event_type Termbox.Bindings.C._TB_EVENT_RESIZE) -> True)
+  ((== Tb_event_type _TB_EVENT_RESIZE) -> True)
   where
-    TB_EVENT_RESIZE = Tb_event_type Termbox.Bindings.C._TB_EVENT_RESIZE
+    TB_EVENT_RESIZE = Tb_event_type _TB_EVENT_RESIZE
 
 -- N.B. This requires Tb_event_type to remain abstract
 {-# COMPLETE TB_EVENT_KEY, TB_EVENT_MOUSE, TB_EVENT_RESIZE #-}

termbox-bindings-hs/src/Termbox/Bindings/Hs/Internal/InitError.hs

@@ -8,13 +8,15 @@ module Termbox.Bindings.Hs.Internal.InitError
   )
 where
 
+import Control.Exception (Exception)
 import Foreign.C.Types (CInt)
-import qualified Termbox.Bindings.C
+import Termbox.Bindings.C (_TB_EFAILED_TO_OPEN_TTY, _TB_EPIPE_TRAP_ERROR, _TB_EUNSUPPORTED_TERMINAL)
 
 -- | A 'tb_init' error.
 newtype Tb_init_error
   = Tb_init_error CInt
-  deriving stock (Eq, Ord)
+  deriving stock (Eq)
+  deriving anyclass (Exception)
 
 instance Show Tb_init_error where
   show = \case
@@ -24,20 +26,21 @@ instance Show Tb_init_error where
 
 pattern TB_EFAILED_TO_OPEN_TTY :: Tb_init_error
 pattern TB_EFAILED_TO_OPEN_TTY <-
-  ((== Tb_init_error Termbox.Bindings.C._TB_EFAILED_TO_OPEN_TTY) -> True)
+  ((== Tb_init_error _TB_EFAILED_TO_OPEN_TTY) -> True)
   where
-    TB_EFAILED_TO_OPEN_TTY = Tb_init_error Termbox.Bindings.C._TB_EFAILED_TO_OPEN_TTY
+    TB_EFAILED_TO_OPEN_TTY = Tb_init_error _TB_EFAILED_TO_OPEN_TTY
 
 pattern TB_EPIPE_TRAP_ERROR :: Tb_init_error
 pattern TB_EPIPE_TRAP_ERROR <-
   ((== Tb_init_error Termbox.Bindings.C._TB_EPIPE_TRAP_ERROR) -> True)
   where
-    TB_EPIPE_TRAP_ERROR = Tb_init_error Termbox.Bindings.C._TB_EPIPE_TRAP_ERROR
+    TB_EPIPE_TRAP_ERROR = Tb_init_error _TB_EPIPE_TRAP_ERROR
 
 pattern TB_EUNSUPPORTED_TERMINAL :: Tb_init_error
 pattern TB_EUNSUPPORTED_TERMINAL <-
-  ((== Tb_init_error Termbox.Bindings.C._TB_EUNSUPPORTED_TERMINAL) -> True)
+  ((== Tb_init_error _TB_EUNSUPPORTED_TERMINAL) -> True)
   where
-    TB_EUNSUPPORTED_TERMINAL = Tb_init_error Termbox.Bindings.C._TB_EUNSUPPORTED_TERMINAL
+    TB_EUNSUPPORTED_TERMINAL = Tb_init_error _TB_EUNSUPPORTED_TERMINAL
 
+-- N.B. This requires Tb_init_error to remain abstract
 {-# COMPLETE TB_EFAILED_TO_OPEN_TTY, TB_EPIPE_TRAP_ERROR, TB_EUNSUPPORTED_TERMINAL #-}

termbox-bindings-hs/termbox-bindings-hs.cabal

@@ -36,7 +36,8 @@ library
     termbox-bindings-c ^>= 0.1,
   default-extensions:
     BlockArguments
-    DeriveGeneric,
+    DeriveAnyClass
+    DeriveGeneric
     DerivingStrategies
     DuplicateRecordFields
     GeneralizedNewtypeDeriving

termbox/src/Termbox/Internal/Mouse.hs

@@ -13,7 +13,16 @@ module Termbox.Internal.Mouse
 where
 
 import GHC.Generics (Generic)
-import qualified Termbox.Bindings.Hs
+import Termbox.Bindings.Hs
+  ( Tb_key
+      ( TB_KEY_MOUSE_LEFT,
+        TB_KEY_MOUSE_MIDDLE,
+        TB_KEY_MOUSE_RELEASE,
+        TB_KEY_MOUSE_RIGHT,
+        TB_KEY_MOUSE_WHEEL_DOWN,
+        TB_KEY_MOUSE_WHEEL_UP
+      ),
+  )
 import Termbox.Internal.Pos (Pos)
 
 -- | A mouse event.
@@ -25,7 +34,7 @@ data Mouse = Mouse
 
 -- | A mouse button.
 newtype MouseButton
-  = MouseButton Termbox.Bindings.Hs.Tb_key
+  = MouseButton Tb_key
   deriving stock (Eq, Ord)
 
 instance Show MouseButton where
@@ -38,21 +47,21 @@ instance Show MouseButton where
     WheelUp -> "WheelUp"
 
 pattern LeftClick :: MouseButton
-pattern LeftClick = MouseButton Termbox.Bindings.Hs.TB_KEY_MOUSE_LEFT
+pattern LeftClick = MouseButton TB_KEY_MOUSE_LEFT
 
 pattern MiddleClick :: MouseButton
-pattern MiddleClick = MouseButton Termbox.Bindings.Hs.TB_KEY_MOUSE_MIDDLE
+pattern MiddleClick = MouseButton TB_KEY_MOUSE_MIDDLE
 
 pattern RightClick :: MouseButton
-pattern RightClick = MouseButton Termbox.Bindings.Hs.TB_KEY_MOUSE_RIGHT
+pattern RightClick = MouseButton TB_KEY_MOUSE_RIGHT
 
 pattern ReleaseClick :: MouseButton
-pattern ReleaseClick = MouseButton Termbox.Bindings.Hs.TB_KEY_MOUSE_RELEASE
+pattern ReleaseClick = MouseButton TB_KEY_MOUSE_RELEASE
 
 pattern WheelDown :: MouseButton
-pattern WheelDown = MouseButton Termbox.Bindings.Hs.TB_KEY_MOUSE_WHEEL_DOWN
+pattern WheelDown = MouseButton TB_KEY_MOUSE_WHEEL_DOWN
 
 pattern WheelUp :: MouseButton
-pattern WheelUp = MouseButton Termbox.Bindings.Hs.TB_KEY_MOUSE_WHEEL_UP
+pattern WheelUp = MouseButton TB_KEY_MOUSE_WHEEL_UP
 
 {-# COMPLETE LeftClick, MiddleClick, ReleaseClick, RightClick, WheelDown, WheelUp #-}