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

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

-- | @termbox@ initialization errors.
data InitError
  = FailedToOpenTTY
  | PipeTrapError
  | UnsupportedTerminal
  deriving anyclass (Show InitError
Typeable InitError
(Typeable InitError, Show InitError) =>
(InitError -> SomeException)
-> (SomeException -> Maybe InitError)
-> (InitError -> String)
-> Exception InitError
SomeException -> Maybe InitError
InitError -> String
InitError -> SomeException
forall e.
(Typeable e, Show e) =>
(e -> SomeException)
-> (SomeException -> Maybe e) -> (e -> String) -> Exception e
$ctoException :: InitError -> SomeException
toException :: InitError -> SomeException
$cfromException :: SomeException -> Maybe InitError
fromException :: SomeException -> Maybe InitError
$cdisplayException :: InitError -> String
displayException :: InitError -> String
Exception)
  deriving stock (Int -> InitError -> ShowS
[InitError] -> ShowS
InitError -> String
(Int -> InitError -> ShowS)
-> (InitError -> String)
-> ([InitError] -> ShowS)
-> Show InitError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> InitError -> ShowS
showsPrec :: Int -> InitError -> ShowS
$cshow :: InitError -> String
show :: InitError -> String
$cshowList :: [InitError] -> ShowS
showList :: [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 a. IO a -> IO a) -> IO (Either InitError a))
-> IO (Either InitError a)
forall b. ((forall a. IO a -> IO a) -> IO b) -> IO b
mask \forall a. IO a -> IO a
unmask ->
    IO (Either InitError ())
initialize IO (Either InitError ())
-> (Either InitError () -> IO (Either InitError a))
-> IO (Either InitError a)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Left InitError
err -> Either InitError a -> IO (Either InitError a)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (InitError -> Either InitError a
forall a b. a -> Either a b
Left InitError
err)
      Right () -> do
        a
result <- IO a -> IO a
forall a. IO a -> IO a
unmask IO a
action IO a -> IO () -> IO a
forall a b. IO a -> IO b -> IO a
`onException` IO ()
finalize
        IO ()
finalize
        Either InitError a -> IO (Either InitError a)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> Either InitError a
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 ())
tb_init IO (Either Tb_init_error ())
-> (Either Tb_init_error () -> IO (Either InitError ()))
-> IO (Either InitError ())
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Left Tb_init_error
err ->
      (Either InitError () -> IO (Either InitError ())
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either InitError () -> IO (Either InitError ()))
-> (InitError -> Either InitError ())
-> InitError
-> IO (Either InitError ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InitError -> Either InitError ()
forall a b. a -> Either a b
Left) case Tb_init_error
err of
        Tb_init_error
TB_EFAILED_TO_OPEN_TTY -> InitError
FailedToOpenTTY
        Tb_init_error
TB_EPIPE_TRAP_ERROR -> InitError
PipeTrapError
        Tb_init_error
TB_EUNSUPPORTED_TERMINAL -> InitError
UnsupportedTerminal
    Right () -> do
      Tb_input_mode -> IO ()
tb_select_input_mode Tb_input_mode
_TB_INPUT_MOUSE
      Tb_output_mode -> IO ()
tb_select_output_mode Tb_output_mode
TB_OUTPUT_256
      Either InitError () -> IO (Either InitError ())
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (() -> Either InitError ()
forall a b. b -> Either a b
Right ())

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