-- | This module provides data type to describe runtime terminal settings,

-- and a function to obtain default values for those settings.

module Graphics.Vty.Platform.Windows.Settings
  ( WindowsSettings(..)
  , defaultSettings
  )
where

import Data.Maybe ( fromMaybe ) 
import System.Environment ( lookupEnv )
import System.IO ( Handle, stdin, stdout )

-- | Runtime library settings for interacting with Windows terminals.

data WindowsSettings = WindowsSettings
  { WindowsSettings -> Handle
settingInputFd :: Handle
  -- ^ The input file descriptor to use.

  , WindowsSettings -> Handle
settingOutputFd :: Handle
  -- ^ The output file descriptor to use.

  , WindowsSettings -> String
settingTermName :: String
  -- ^ The terminal name used to look up terminfo capabilities.

  }
  deriving (Int -> WindowsSettings -> ShowS
[WindowsSettings] -> ShowS
WindowsSettings -> String
(Int -> WindowsSettings -> ShowS)
-> (WindowsSettings -> String)
-> ([WindowsSettings] -> ShowS)
-> Show WindowsSettings
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> WindowsSettings -> ShowS
showsPrec :: Int -> WindowsSettings -> ShowS
$cshow :: WindowsSettings -> String
show :: WindowsSettings -> String
$cshowList :: [WindowsSettings] -> ShowS
showList :: [WindowsSettings] -> ShowS
Show, WindowsSettings -> WindowsSettings -> Bool
(WindowsSettings -> WindowsSettings -> Bool)
-> (WindowsSettings -> WindowsSettings -> Bool)
-> Eq WindowsSettings
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: WindowsSettings -> WindowsSettings -> Bool
== :: WindowsSettings -> WindowsSettings -> Bool
$c/= :: WindowsSettings -> WindowsSettings -> Bool
/= :: WindowsSettings -> WindowsSettings -> Bool
Eq)

-- | Description of reasonable default settings for a Windows environment

defaultSettings :: IO WindowsSettings
defaultSettings :: IO WindowsSettings
defaultSettings = do
    Maybe String
mb <- String -> IO (Maybe String)
lookupEnv String
termVariable
    let termName :: String
termName = String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
"xterm-256color" Maybe String
mb

    WindowsSettings -> IO WindowsSettings
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (WindowsSettings -> IO WindowsSettings)
-> WindowsSettings -> IO WindowsSettings
forall a b. (a -> b) -> a -> b
$ WindowsSettings { settingInputFd :: Handle
settingInputFd  = Handle
stdin
                             , settingOutputFd :: Handle
settingOutputFd  = Handle
stdout
                             , settingTermName :: String
settingTermName  = String
termName
                             }

-- | The TERM environment variable

termVariable :: String
termVariable :: String
termVariable = String
"TERM"