{-# 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
    Maybe Terminal
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 -> Maybe b
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
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")
    Maybe String
colorterm <- String -> IO (Maybe String)
lookupEnv String
"COLORTERM"
    ColorMode -> IO ColorMode
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ColorMode -> IO ColorMode) -> ColorMode -> IO ColorMode
forall a b. (a -> b) -> a -> b
$ if
        | Int
termColors Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<  Int
8               -> ColorMode
NoColor
        | Int
termColors Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<  Int
16              -> ColorMode
ColorMode8
        | Int
termColors Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
16              -> ColorMode
ColorMode16
        | Int
termColors Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<  Int
256             -> Word8 -> ColorMode
ColorMode240 (Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
termColors Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
- Word8
16)
        | Maybe String
colorterm Maybe String -> Maybe String -> Bool
forall a. Eq a => a -> a -> Bool
== String -> Maybe String
forall a. a -> Maybe a
Just String
"truecolor" -> ColorMode
FullColor
        | Maybe String
colorterm Maybe String -> Maybe String -> Bool
forall a. Eq a => a -> a -> Bool
== String -> Maybe String
forall a. a -> Maybe a
Just String
"24bit"     -> ColorMode
FullColor
        | Bool
otherwise                     -> Word8 -> ColorMode
ColorMode240 Word8
240