{-# LANGUAGE RecordWildCards, CPP #-}
-- | This module provides a function to build an 'Output' for Windows

-- terminals.

--

-- This module is exposed for testing purposes only; applications should

-- never need to import this directly.

module Graphics.Vty.Platform.Windows.Output
  ( buildOutput
  )
where

import Graphics.Vty.Config
import Graphics.Vty.Platform.Windows.Settings
import Graphics.Vty.Platform.Windows.Output.Color (detectColorMode)
import Graphics.Vty.Platform.Windows.Output.XTermColor as XTermColor
import Graphics.Vty.Platform.Windows.Output.TerminfoBased as TerminfoBased
import Graphics.Vty.Output

import Data.List (isPrefixOf)

-- | Returns an `Output` for the terminal specified in `WindowsSettings`.

--

-- The specific Output implementation used is hidden from the API user.

-- All terminal implementations are assumed to perform more, or less,

-- the same. Currently, all implementations use terminfo for at least

-- some terminal specific information.

--

-- If a terminal implementation is developed for a terminal without

-- terminfo support then Vty should work as expected on that terminal.

--

-- Selection of a terminal is done as follows:

--

--      * If TERM starts with "xterm", "screen" or "tmux", use XTermColor.

--      * otherwise use the TerminfoBased driver.

buildOutput :: VtyUserConfig -> WindowsSettings -> IO Output
buildOutput :: VtyUserConfig -> WindowsSettings -> IO Output
buildOutput VtyUserConfig
config WindowsSettings
settings = do
    let outHandle :: Handle
outHandle = WindowsSettings -> Handle
settingOutputFd WindowsSettings
settings
        termName :: String
termName = WindowsSettings -> String
settingTermName WindowsSettings
settings

    ColorMode
colorMode <- case VtyUserConfig -> Maybe ColorMode
configPreferredColorMode VtyUserConfig
config of
        Maybe ColorMode
Nothing -> String -> IO ColorMode
detectColorMode String
termName
        Just ColorMode
m -> ColorMode -> IO ColorMode
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ColorMode
m

    if String -> Bool
isXtermLike String
termName
        then String -> Handle -> ColorMode -> IO Output
forall (m :: * -> *).
(Applicative m, MonadIO m) =>
String -> Handle -> ColorMode -> m Output
XTermColor.reserveTerminal String
termName Handle
outHandle ColorMode
colorMode
        -- Not an xterm-like terminal. try for generic terminfo.

        else String -> Handle -> ColorMode -> IO Output
TerminfoBased.reserveTerminal String
termName Handle
outHandle ColorMode
colorMode


isXtermLike :: String -> Bool
isXtermLike :: String -> Bool
isXtermLike String
termName =
    (String -> Bool) -> [String] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
termName) [String]
xtermLikeTerminalNamePrefixes

xtermLikeTerminalNamePrefixes :: [String]
xtermLikeTerminalNamePrefixes :: [String]
xtermLikeTerminalNamePrefixes =
    [ String
"xterm"
    , String
"screen"
    , String
"tmux"
    , String
"rxvt"
    ]