{- |
Module                  : DrCabal.Terminal
Copyright               : (c) 2022 Dmitrii Kovanikov
SPDX-License-Identifier : MPL-2.0
Maintainer              : Dmitrii Kovanikov <kovanikov@gmail.com>
Stability               : Experimental
Portability             : Portable

Utility functions to work with the terminal output.
-}

module DrCabal.Terminal
    ( getTerminalWidth
    , clearScreen
    , withAlternateBuffer
    ) where

import Colourista.Short (u)
import Control.Exception (bracket)
import System.Console.ANSI (clearFromCursorToScreenEnd, cursorUpLine)

import qualified System.Console.Terminal.Size as Terminal


{- | Get the width of the current terminal.

This function exits the process with the message if it can't get the
width of the current terminal.
-}
getTerminalWidth :: IO Int
getTerminalWidth :: IO Int
getTerminalWidth = forall n. Integral n => IO (Maybe (Window n))
Terminal.size forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Just (Terminal.Window Int
_height Int
width) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
width
    Maybe (Window Int)
Nothing -> do
        forall (m :: * -> *). MonadIO m => Text -> m ()
putText forall a b. (a -> b) -> a -> b
$ forall t. IsText t "unlines" => [t] -> t
unlines
            [ Text
"Error getting the terminal width. If you see this error, open an issue"
            , Text
"in the 'dr-cabal' issue tracker and provide as many details as possible"
            , Text
""
            , Text
"  * " forall a. Semigroup a => a -> a -> a
<> forall str. (IsString str, Semigroup str) => str -> str
u Text
"https://github.com/chshersh/dr-cabal/issues/new"
            ]
        forall (m :: * -> *) a. MonadIO m => m a
exitFailure

{- | Clears the the @screenHeight@ number of lines in the screen. Pass
the number of lines in the output to clear the entire screen.
-}
clearScreen :: Int -> IO ()
clearScreen :: Int -> IO ()
clearScreen Int
screenHeight = do
    -- https://github.com/UnkindPartition/ansi-terminal/issues/141
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
screenHeight forall a. Ord a => a -> a -> Bool
> Int
0) forall a b. (a -> b) -> a -> b
$
        Int -> IO ()
cursorUpLine Int
screenHeight
    IO ()
clearFromCursorToScreenEnd

{- | Run action in the alternate buffer and return to the normal
screen after exception or SIGINT.

__NOTE:__ This function always returns to the normal screen after the
action. If you want to print something to the normal screen use the
result of the given action afterwards.
-}
withAlternateBuffer :: IO a -> IO a
withAlternateBuffer :: forall a. IO a -> IO a
withAlternateBuffer IO a
action = forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket
    IO ()
useAlternateScreenBuffer
    (\()
_ -> IO ()
useNormalScreenBuffer)
    (\()
_ -> IO a
action)

-- TODO: use functions from 'ansi-terminal'
useAlternateScreenBuffer :: IO ()
useAlternateScreenBuffer :: IO ()
useAlternateScreenBuffer = forall (m :: * -> *). MonadIO m => String -> m ()
putStrLn String
"\ESC[?1049h\ESC[H"

-- TODO: use functions from 'ansi-terminal'
useNormalScreenBuffer :: IO ()
useNormalScreenBuffer :: IO ()
useNormalScreenBuffer = forall (m :: * -> *). MonadIO m => String -> m ()
putStrLn String
"\ESC[?1049l"