rework Tb_output_mode a bit

awkward-squad · Nov 15, 2023 · 7d51d35 · 7d51d35
1 parent c3a6222
commit 7d51d35
Show file tree

Hide file tree

Showing 6 changed files with 40 additions and 30 deletions.
diff --git a/termbox-bindings-hs/CHANGELOG.md b/termbox-bindings-hs/CHANGELOG.md
@@ -2,6 +2,7 @@
 
 - Rework `Tb_attr` and `Tb_color` into `Tb_color_and_attrs`
 - Rework `Tb_select_input_mode` and `Tb_input_mode`
+- Rework `Tb_select_output_mode` and `Tb_output_mode`
 - Make `mod` field of `Tb_event` a `Maybe Tb_event_mod` rather than a `Tb_event_mod`
 - Make `Show` instance of `Tb_key` not call `error` on unknown keys
 - Hide representation of `Tb_event_mod`

diff --git a/termbox-bindings-hs/src/Termbox/Bindings/Hs.hs b/termbox-bindings-hs/src/Termbox/Bindings/Hs.hs
@@ -16,8 +16,12 @@ module Termbox.Bindings.Hs
     tb_init_file,
     tb_shutdown,
 
-    -- ** Get or set input or output mode
+    -- ** Get or set input mode
+    tb_get_input_mode,
     tb_select_input_mode,
+
+    -- ** Get or set output mode
+    tb_get_output_mode,
     tb_select_output_mode,
 
     -- ** Get terminal dimensions
@@ -148,8 +152,7 @@ module Termbox.Bindings.Hs
         TB_KEY_TAB
       ),
     Tb_output_mode
-      ( TB_OUTPUT_CURRENT,
-        TB_OUTPUT_216,
+      ( TB_OUTPUT_216,
         TB_OUTPUT_256,
         TB_OUTPUT_GRAYSCALE,
         TB_OUTPUT_NORMAL
@@ -179,6 +182,8 @@ import Termbox.Bindings.Hs.Internal.EventMod (Tb_event_mod (..))
 import Termbox.Bindings.Hs.Internal.EventType (Tb_event_type (..))
 import Termbox.Bindings.Hs.Internal.Functions
   ( tb_change_cell,
+    tb_get_input_mode,
+    tb_get_output_mode,
     tb_height,
     tb_init,
     tb_init_fd,

diff --git a/termbox-bindings-hs/src/Termbox/Bindings/Hs/Internal/Functions.hs b/termbox-bindings-hs/src/Termbox/Bindings/Hs/Internal/Functions.hs
@@ -1,6 +1,7 @@
 module Termbox.Bindings.Hs.Internal.Functions
   ( tb_change_cell,
     tb_get_input_mode,
+    tb_get_output_mode,
     tb_height,
     tb_init,
     tb_init_fd,
@@ -53,6 +54,11 @@ tb_get_input_mode :: IO Tb_input_mode
 tb_get_input_mode =
   coerce Termbox.tb_select_input_mode Termbox._TB_INPUT_CURRENT
 
+-- | Get the output mode.
+tb_get_output_mode :: IO Tb_output_mode
+tb_get_output_mode =
+  coerce Termbox.tb_select_output_mode Termbox._TB_OUTPUT_CURRENT
+
 -- | Get the terminal height.
 tb_height :: IO Int
 tb_height =
@@ -128,13 +134,13 @@ tb_put_cell cx cy cell =
 
 -- | Set the input mode.
 tb_select_input_mode :: Tb_input_mode -> IO ()
-tb_select_input_mode =
-  void . coerce @(CInt -> IO CInt) @(Tb_input_mode -> IO Tb_input_mode) Termbox.tb_select_input_mode
+tb_select_input_mode (Tb_input_mode mode) =
+  void (Termbox.tb_select_input_mode mode)
 
--- | Get or set the output mode.
-tb_select_output_mode :: Tb_output_mode -> IO Tb_output_mode
-tb_select_output_mode =
-  coerce Termbox.tb_select_output_mode
+-- | Set the output mode.
+tb_select_output_mode :: Tb_output_mode -> IO ()
+tb_select_output_mode (Tb_output_mode mode) =
+  void (Termbox.tb_select_output_mode mode)
 
 -- | Set the foreground and background attributes that 'tb_clear' clears the back buffer with.
 tb_set_clear_attributes ::

diff --git a/termbox-bindings-hs/src/Termbox/Bindings/Hs/Internal/InitError.hs b/termbox-bindings-hs/src/Termbox/Bindings/Hs/Internal/InitError.hs
@@ -15,8 +15,8 @@ import Termbox.Bindings.C (_TB_EFAILED_TO_OPEN_TTY, _TB_EPIPE_TRAP_ERROR, _TB_EU
 -- | A 'tb_init' error.
 newtype Tb_init_error
   = Tb_init_error CInt
-  deriving stock (Eq)
   deriving anyclass (Exception)
+  deriving stock (Eq)
 
 instance Show Tb_init_error where
   show = \case

diff --git a/termbox-bindings-hs/src/Termbox/Bindings/Hs/Internal/OutputMode.hs b/termbox-bindings-hs/src/Termbox/Bindings/Hs/Internal/OutputMode.hs
@@ -1,7 +1,6 @@
 module Termbox.Bindings.Hs.Internal.OutputMode
   ( Tb_output_mode
       ( Tb_output_mode,
-        TB_OUTPUT_CURRENT,
         TB_OUTPUT_216,
         TB_OUTPUT_256,
         TB_OUTPUT_GRAYSCALE,
@@ -11,7 +10,12 @@ module Termbox.Bindings.Hs.Internal.OutputMode
 where
 
 import Foreign.C.Types (CInt)
-import qualified Termbox.Bindings.C
+import Termbox.Bindings.C
+  ( _TB_OUTPUT_216,
+    _TB_OUTPUT_256,
+    _TB_OUTPUT_GRAYSCALE,
+    _TB_OUTPUT_NORMAL,
+  )
 
 -- | The output mode.
 newtype Tb_output_mode
@@ -20,40 +24,34 @@ newtype Tb_output_mode
 
 instance Show Tb_output_mode where
   show = \case
-    TB_OUTPUT_CURRENT -> "TB_OUTPUT_CURRENT"
     TB_OUTPUT_216 -> "TB_OUTPUT_216"
     TB_OUTPUT_256 -> "TB_OUTPUT_256"
     TB_OUTPUT_GRAYSCALE -> "TB_OUTPUT_GRAYSCALE"
     TB_OUTPUT_NORMAL -> "TB_OUTPUT_NORMAL"
 
-pattern TB_OUTPUT_CURRENT :: Tb_output_mode
-pattern TB_OUTPUT_CURRENT <-
-  ((== Tb_output_mode Termbox.Bindings.C._TB_OUTPUT_CURRENT) -> True)
-  where
-    TB_OUTPUT_CURRENT = Tb_output_mode Termbox.Bindings.C._TB_OUTPUT_CURRENT
-
 pattern TB_OUTPUT_216 :: Tb_output_mode
 pattern TB_OUTPUT_216 <-
-  ((== Tb_output_mode Termbox.Bindings.C._TB_OUTPUT_216) -> True)
+  ((== Tb_output_mode _TB_OUTPUT_216) -> True)
   where
-    TB_OUTPUT_216 = Tb_output_mode Termbox.Bindings.C._TB_OUTPUT_216
+    TB_OUTPUT_216 = Tb_output_mode _TB_OUTPUT_216
 
 pattern TB_OUTPUT_256 :: Tb_output_mode
 pattern TB_OUTPUT_256 <-
-  ((== Tb_output_mode Termbox.Bindings.C._TB_OUTPUT_256) -> True)
+  ((== Tb_output_mode _TB_OUTPUT_256) -> True)
   where
-    TB_OUTPUT_256 = Tb_output_mode Termbox.Bindings.C._TB_OUTPUT_256
+    TB_OUTPUT_256 = Tb_output_mode _TB_OUTPUT_256
 
 pattern TB_OUTPUT_GRAYSCALE :: Tb_output_mode
 pattern TB_OUTPUT_GRAYSCALE <-
-  ((== Tb_output_mode Termbox.Bindings.C._TB_OUTPUT_GRAYSCALE) -> True)
+  ((== Tb_output_mode _TB_OUTPUT_GRAYSCALE) -> True)
   where
-    TB_OUTPUT_GRAYSCALE = Tb_output_mode Termbox.Bindings.C._TB_OUTPUT_GRAYSCALE
+    TB_OUTPUT_GRAYSCALE = Tb_output_mode _TB_OUTPUT_GRAYSCALE
 
 pattern TB_OUTPUT_NORMAL :: Tb_output_mode
 pattern TB_OUTPUT_NORMAL <-
-  ((== Tb_output_mode Termbox.Bindings.C._TB_OUTPUT_NORMAL) -> True)
+  ((== Tb_output_mode _TB_OUTPUT_NORMAL) -> True)
   where
-    TB_OUTPUT_NORMAL = Tb_output_mode Termbox.Bindings.C._TB_OUTPUT_NORMAL
+    TB_OUTPUT_NORMAL = Tb_output_mode _TB_OUTPUT_NORMAL
 
-{-# COMPLETE TB_OUTPUT_CURRENT, TB_OUTPUT_216, TB_OUTPUT_256, TB_OUTPUT_GRAYSCALE, TB_OUTPUT_NORMAL #-}
+-- N.B. This requires Tb_output_mode to remain abstract
+{-# COMPLETE TB_OUTPUT_216, TB_OUTPUT_256, TB_OUTPUT_GRAYSCALE, TB_OUTPUT_NORMAL #-}
diff --git a/termbox/src/Termbox/Internal/Main.hs b/termbox/src/Termbox/Internal/Main.hs
@@ -41,11 +41,11 @@ initialize =
         TB_EUNSUPPORTED_TERMINAL -> UnsupportedTerminal
     Right () -> do
       tb_select_input_mode _TB_INPUT_MOUSE
-      _ <- tb_select_output_mode TB_OUTPUT_256
+      tb_select_output_mode TB_OUTPUT_256
       pure (Right ())
 
 -- | Shut down a @termbox@ program.
 finalize :: IO ()
 finalize = do
-  _ <- tb_select_output_mode TB_OUTPUT_NORMAL
+  tb_select_output_mode TB_OUTPUT_NORMAL
   tb_shutdown