{-# LANGUAGE ScopedTypeVariables #-}

module Text.Colour.Capabilities.FromEnv where

import Control.Exception
import qualified System.Console.Terminfo as Terminfo
import System.Environment (lookupEnv)
import System.IO
import Text.Colour.Capabilities

-- | Try to detect how many colours the terminal can handle.
--
-- This is based on the @colors@ capability of the terminfo detected based on the @TERM@ environment variable.
-- If the terminal can handle 8-bit colours and also has the @COLORTERM@ environment variable set to @24bit@ or @truecolor@, then this function will return 'With24BitColours'.
getTerminalCapabilitiesFromEnv :: IO TerminalCapabilities
getTerminalCapabilitiesFromEnv :: IO TerminalCapabilities
getTerminalCapabilitiesFromEnv = do
  Maybe Terminal
mTerm <- (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
<$> IO Terminal
Terminfo.setupTermFromEnv) IO (Maybe Terminal)
-> (SetupTermError -> IO (Maybe Terminal)) -> IO (Maybe Terminal)
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` (\(SetupTermError
_ :: Terminfo.SetupTermError) -> Maybe Terminal -> IO (Maybe Terminal)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Terminal
forall a. Maybe a
Nothing)
  case Maybe Terminal
mTerm of
    Maybe Terminal
Nothing -> TerminalCapabilities -> IO TerminalCapabilities
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TerminalCapabilities
WithoutColours
    Just Terminal
term -> do
      -- To support https://no-color.org/
      Maybe String
mnc <- String -> IO (Maybe String)
lookupEnv String
"NO_COLOR"
      case Maybe String
mnc of
        Just String
_ -> TerminalCapabilities -> IO TerminalCapabilities
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TerminalCapabilities
WithoutColours
        Maybe String
Nothing -> do
          -- To support 24-bit colour:
          -- https://unix.stackexchange.com/questions/450365/check-if-terminal-supports-24-bit-true-color
          Maybe String
mct <- String -> IO (Maybe String)
lookupEnv String
"COLORTERM"
          TerminalCapabilities -> IO TerminalCapabilities
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TerminalCapabilities -> IO TerminalCapabilities)
-> TerminalCapabilities -> IO TerminalCapabilities
forall a b. (a -> b) -> a -> b
$ case Maybe String
mct of
            Just String
"truecolor" -> TerminalCapabilities
With24BitColours
            Just String
"24bit" -> TerminalCapabilities
With24BitColours
            Maybe String
_ ->
              case Terminal -> Capability Int -> Maybe Int
forall a. Terminal -> Capability a -> Maybe a
Terminfo.getCapability Terminal
term (String -> Capability Int
Terminfo.tiGetNum String
"colors") of
                Maybe Int
Nothing -> TerminalCapabilities
WithoutColours
                Just Int
c
                  | Int
c Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
256 -> TerminalCapabilities
With24BitColours
                  | Int
c Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
256 -> TerminalCapabilities
With8BitColours
                  | Int
c Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
8 -> TerminalCapabilities
With8Colours
                  | Bool
otherwise -> TerminalCapabilities
WithoutColours

-- | Try to detect how many colours a given handle can handle.
--
-- This function does the same as 'getTerminalCapabilitiesFromEnv' but returns 'WithoutColours' is not a terminal device.
getTerminalCapabilitiesFromHandle :: Handle -> IO TerminalCapabilities
getTerminalCapabilitiesFromHandle :: Handle -> IO TerminalCapabilities
getTerminalCapabilitiesFromHandle Handle
h = do
  Bool
isTerm <- Handle -> IO Bool
hIsTerminalDevice Handle
h
  if Bool
isTerm
    then IO TerminalCapabilities
getTerminalCapabilitiesFromEnv
    else TerminalCapabilities -> IO TerminalCapabilities
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TerminalCapabilities
WithoutColours