{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE ScopedTypeVariables #-}
-- | Best-effort terminfo-based color mode detection.
--
-- This module is exposed for testing purposes only; applications should
-- never need to import this directly.
module Graphics.Vty.Platform.Unix.Output.Color
  ( detectColorMode
  )
where

import System.Environment (lookupEnv)

import qualified System.Console.Terminfo as Terminfo
import Control.Exception (catch)
import Data.Maybe

import Graphics.Vty.Attributes.Color

detectColorMode :: String -> IO ColorMode
detectColorMode :: String -> IO ColorMode
detectColorMode String
termName' = do
    term <- IO (Maybe Terminal)
-> (SetupTermError -> IO (Maybe Terminal)) -> IO (Maybe Terminal)
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
catch (Terminal -> Maybe Terminal
forall a. a -> Maybe a
Just (Terminal -> Maybe Terminal) -> IO Terminal -> IO (Maybe Terminal)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO Terminal
Terminfo.setupTerm String
termName')
                  (\(SetupTermError
_ :: Terminfo.SetupTermError) -> Maybe Terminal -> IO (Maybe Terminal)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Terminal
forall a. Maybe a
Nothing)
    let getCap Capability b
cap = Maybe Terminal
term Maybe Terminal -> (Terminal -> Maybe b) -> Maybe b
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Terminal
t -> Terminal -> Capability b -> Maybe b
forall a. Terminal -> Capability a -> Maybe a
Terminfo.getCapability Terminal
t Capability b
cap
        termColors = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
0 (Maybe Int -> Int) -> Maybe Int -> Int
forall a b. (a -> b) -> a -> b
$ Capability Int -> Maybe Int
forall {b}. Capability b -> Maybe b
getCap (String -> Capability Int
Terminfo.tiGetNum String
"colors")
    colorterm <- lookupEnv "COLORTERM"
    return $ if
        | termColors <  8               -> NoColor
        | termColors <  16              -> ColorMode8
        | termColors == 16              -> ColorMode16
        | termColors <  256             -> ColorMode240 (fromIntegral termColors - 16)
        | colorterm == Just "truecolor" -> FullColor
        | colorterm == Just "24bit"     -> FullColor
        | otherwise                     -> ColorMode240 240