module Termbox.Internal.Main
  ( run,
    initialize,
    finalize,
    InitError (..),
  )
where

import Control.Exception (Exception, mask, onException)
import qualified Termbox.Bindings.Hs

-- | @termbox@ initialization errors.
data InitError
  = FailedToOpenTTY
  | PipeTrapError
  | UnsupportedTerminal
  deriving anyclass (Show InitError
Typeable InitError
SomeException -> Maybe InitError
InitError -> String
InitError -> SomeException
forall e.
Typeable e
-> Show e
-> (e -> SomeException)
-> (SomeException -> Maybe e)
-> (e -> String)
-> Exception e
displayException :: InitError -> String
$cdisplayException :: InitError -> String
fromException :: SomeException -> Maybe InitError
$cfromException :: SomeException -> Maybe InitError
toException :: InitError -> SomeException
$ctoException :: InitError -> SomeException
Exception)
  deriving stock (Int -> InitError -> ShowS
[InitError] -> ShowS
InitError -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InitError] -> ShowS
$cshowList :: [InitError] -> ShowS
show :: InitError -> String
$cshow :: InitError -> String
showsPrec :: Int -> InitError -> ShowS
$cshowsPrec :: Int -> InitError -> ShowS
Show)

-- | Initialize a @termbox@ program, and if that succeeds, run the provided action, then finalize the @termbox@ program.
run :: IO a -> IO (Either InitError a)
run :: forall a. IO a -> IO (Either InitError a)
run IO a
action =
  forall b. ((forall a. IO a -> IO a) -> IO b) -> IO b
mask \forall a. IO a -> IO a
unmask ->
    IO (Either InitError ())
initialize forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Left InitError
err -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b. a -> Either a b
Left InitError
err)
      Right () -> do
        a
result <- forall a. IO a -> IO a
unmask IO a
action forall a b. IO a -> IO b -> IO a
`onException` IO ()
finalize
        IO ()
finalize
        forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b. b -> Either a b
Right a
result)

-- | Initialize a @termbox@ program.
--
-- If @initialize@ succeeds, it must be paired with a call to 'finalize'.
initialize :: IO (Either InitError ())
initialize :: IO (Either InitError ())
initialize =
  IO (Either Tb_init_error ())
Termbox.Bindings.Hs.tb_init forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Left Tb_init_error
err ->
      (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left) case Tb_init_error
err of
        Tb_init_error
Termbox.Bindings.Hs.TB_EFAILED_TO_OPEN_TTY -> InitError
FailedToOpenTTY
        Tb_init_error
Termbox.Bindings.Hs.TB_EPIPE_TRAP_ERROR -> InitError
PipeTrapError
        Tb_init_error
Termbox.Bindings.Hs.TB_EUNSUPPORTED_TERMINAL -> InitError
UnsupportedTerminal
    Right () -> do
      Tb_input_mode
_ <- Tb_input_mode -> IO Tb_input_mode
Termbox.Bindings.Hs.tb_select_input_mode Tb_input_mode
Termbox.Bindings.Hs.TB_INPUT_MOUSE
      Tb_output_mode
_ <- Tb_output_mode -> IO Tb_output_mode
Termbox.Bindings.Hs.tb_select_output_mode Tb_output_mode
Termbox.Bindings.Hs.TB_OUTPUT_256
      forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b. b -> Either a b
Right ())

-- | Shut down a @termbox@ program.
finalize :: IO ()
finalize :: IO ()
finalize = do
  Tb_output_mode
_ <- Tb_output_mode -> IO Tb_output_mode
Termbox.Bindings.Hs.tb_select_output_mode Tb_output_mode
Termbox.Bindings.Hs.TB_OUTPUT_NORMAL
  IO ()
Termbox.Bindings.Hs.tb_shutdown