    {-# LANGUAGE FlexibleInstances #-}
    {-# LANGUAGE OverloadedStrings #-}
    {-# LANGUAGE CPP #-}
    {-# OPTIONS_GHC -D_XOPEN_SOURCE=500 -fno-warn-warnings-deprecations #-}
    {-# CFILES gwinsz.c #-}

    -- | Terminfo-based terminal output driver.
    --
    -- Copyright Corey O'Connor (coreyoconnor@gmail.com)
    module Graphics.Vty.Output.TerminfoBased
      ( reserveTerminal
      , setWindowSize
      )
    where

    import Control.Monad (when)
    import Data.Bits (shiftL, (.&.))
    import qualified Data.ByteString as BS
    import Data.ByteString.Internal (toForeignPtr)
    import Data.Terminfo.Parse
    import Data.Terminfo.Eval

    import Graphics.Vty.Attributes
    import Graphics.Vty.Image (DisplayRegion)
    import Graphics.Vty.DisplayAttributes
    import Graphics.Vty.Output.Interface

    import Blaze.ByteString.Builder (Write, writeToByteString, writeStorable, writeWord8)

    import Data.IORef
    import Data.Maybe (isJust, isNothing, fromJust)
    import Data.Word

    #if !MIN_VERSION_base(4,8,0)
    import Data.Foldable (foldMap)
    #endif

    import Foreign.C.Types ( CInt(..), CLong(..) )
    import Foreign.ForeignPtr (withForeignPtr)
    import Foreign.Ptr (Ptr, plusPtr)

    import qualified System.Console.Terminfo as Terminfo
    import System.Posix.IO (fdWriteBuf)
    import System.Posix.Types (Fd(..))

    data TerminfoCaps = TerminfoCaps
        { TerminfoCaps -> Maybe CapExpression
    smcup :: Maybe CapExpression
        , TerminfoCaps -> Maybe CapExpression
    rmcup :: Maybe CapExpression
        , TerminfoCaps -> CapExpression
    cup :: CapExpression
        , TerminfoCaps -> Maybe CapExpression
    cnorm :: Maybe CapExpression
        , TerminfoCaps -> Maybe CapExpression
    civis :: Maybe CapExpression
        , TerminfoCaps -> Bool
    useAltColorMap :: Bool
        , TerminfoCaps -> CapExpression
    setForeColor :: CapExpression
        , TerminfoCaps -> CapExpression
    setBackColor :: CapExpression
        , TerminfoCaps -> CapExpression
    setDefaultAttr :: CapExpression
        , TerminfoCaps -> CapExpression
    clearScreen :: CapExpression
        , TerminfoCaps -> CapExpression
    clearEol :: CapExpression
        , TerminfoCaps -> DisplayAttrCaps
    displayAttrCaps :: DisplayAttrCaps
        , TerminfoCaps -> Maybe CapExpression
    ringBellAudio :: Maybe CapExpression
        }

    data DisplayAttrCaps = DisplayAttrCaps
        { DisplayAttrCaps -> Maybe CapExpression
    setAttrStates :: Maybe CapExpression
        , DisplayAttrCaps -> Maybe CapExpression
    enterStandout :: Maybe CapExpression
        , DisplayAttrCaps -> Maybe CapExpression
    exitStandout :: Maybe CapExpression
        , DisplayAttrCaps -> Maybe CapExpression
    enterItalic :: Maybe CapExpression
        , DisplayAttrCaps -> Maybe CapExpression
    exitItalic :: Maybe CapExpression
        , DisplayAttrCaps -> Maybe CapExpression
    enterStrikethrough :: Maybe CapExpression
        , DisplayAttrCaps -> Maybe CapExpression
    exitStrikethrough :: Maybe CapExpression
        , DisplayAttrCaps -> Maybe CapExpression
    enterUnderline :: Maybe CapExpression
        , DisplayAttrCaps -> Maybe CapExpression
    exitUnderline :: Maybe CapExpression
        , DisplayAttrCaps -> Maybe CapExpression
    enterReverseVideo :: Maybe CapExpression
        , DisplayAttrCaps -> Maybe CapExpression
    enterDimMode :: Maybe CapExpression
        , DisplayAttrCaps -> Maybe CapExpression
    enterBoldMode :: Maybe CapExpression
        }

    -- kinda like:
    -- https://code.google.com/p/vim/source/browse/src/fileio.c#10422
    -- fdWriteBuf will throw on error. Unless the error is EINTR. On EINTR
    -- the write will be retried.
    fdWriteAll :: Fd -> Ptr Word8 -> Int -> Int -> IO Int
    fdWriteAll :: Fd -> Ptr Word8 -> Int -> Int -> IO Int
    fdWriteAll Fd
    outFd Ptr Word8
    ptr Int
    len Int
    count
        | Int
    len Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <  Int
    0  = [Char] -> IO Int
    forall a. [Char] -> IO a
    forall (m :: * -> *) a. MonadFail m => [Char] -> m a
    fail [Char]
    "fdWriteAll: len is less than 0"
        | Int
    len Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    0  = Int -> IO Int
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Int
    count
        | Bool
    otherwise = do
            Int
    writeCount <- ByteCount -> Int
    forall a. Enum a => a -> Int
    fromEnum (ByteCount -> Int) -> IO ByteCount -> IO Int
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Fd -> Ptr Word8 -> ByteCount -> IO ByteCount
    fdWriteBuf Fd
    outFd Ptr Word8
    ptr (Int -> ByteCount
    forall a. Enum a => Int -> a
    toEnum Int
    len)
            let len' :: Int
    len' = Int
    len Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    writeCount
                ptr' :: Ptr b
    ptr' = Ptr Word8
    ptr Ptr Word8 -> Int -> Ptr b
    forall a b. Ptr a -> Int -> Ptr b
    `plusPtr` Int
    writeCount
                count' :: Int
    count' = Int
    count Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    writeCount
            Fd -> Ptr Word8 -> Int -> Int -> IO Int
    fdWriteAll Fd
    outFd Ptr Word8
    forall {b}. Ptr b
    ptr' Int
    len' Int
    count'

    sendCapToTerminal :: Output -> CapExpression -> [CapParam] -> IO ()
    sendCapToTerminal :: Output -> CapExpression -> [CapParam] -> IO ()
    sendCapToTerminal Output
    t CapExpression
    cap [CapParam]
    capParams = do
        Output -> ByteString -> IO ()
    outputByteBuffer Output
    t (ByteString -> IO ()) -> ByteString -> IO ()
    forall a b. (a -> b) -> a -> b
    $ Write -> ByteString
    writeToByteString (Write -> ByteString) -> Write -> ByteString
    forall a b. (a -> b) -> a -> b
    $ CapExpression -> [CapParam] -> Write
    writeCapExpr CapExpression
    cap [CapParam]
    capParams

    -- | Constructs an output driver that uses terminfo for all control
    -- codes. While this should provide the most compatible terminal,
    -- terminfo does not support some features that would increase
    -- efficiency and improve compatibility:
    --
    --  * determining the character encoding supported by the terminal.
    --    Should this be taken from the LANG environment variable?
    --
    --  * Providing independent string capabilities for all display
    --    attributes.
    reserveTerminal :: String -> Fd -> ColorMode -> IO Output
    reserveTerminal :: [Char] -> Fd -> ColorMode -> IO Output
    reserveTerminal [Char]
    termName Fd
    outFd ColorMode
    colorMode = do
        Terminal
    ti <- [Char] -> IO Terminal
    Terminfo.setupTerm [Char]
    termName
        -- assumes set foreground always implies set background exists.
        -- if set foreground is not set then all color changing style
        -- attributes are filtered.
        Maybe CapExpression
    msetaf <- Terminal -> [Char] -> IO (Maybe CapExpression)
    probeCap Terminal
    ti [Char]
    "setaf"
        Maybe CapExpression
    msetf <- Terminal -> [Char] -> IO (Maybe CapExpression)
    probeCap Terminal
    ti [Char]
    "setf"
        let (Bool
    useAlt, CapExpression
    setForeCap)
                = case Maybe CapExpression
    msetaf of
                    Just CapExpression
    setaf -> (Bool
    False, CapExpression
    setaf)
                    Maybe CapExpression
    Nothing -> case Maybe CapExpression
    msetf of
                        Just CapExpression
    setf -> (Bool
    True, CapExpression
    setf)
                        Maybe CapExpression
    Nothing -> (Bool
    True, [Char] -> CapExpression
    forall a. HasCallStack => [Char] -> a
    error ([Char] -> CapExpression) -> [Char] -> CapExpression
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "no fore color support for terminal " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    termName)
        Maybe CapExpression
    msetab <- Terminal -> [Char] -> IO (Maybe CapExpression)
    probeCap Terminal
    ti [Char]
    "setab"
        Maybe CapExpression
    msetb <- Terminal -> [Char] -> IO (Maybe CapExpression)
    probeCap Terminal
    ti [Char]
    "setb"
        let setBackCap :: CapExpression
    setBackCap
                = case Maybe CapExpression
    msetab of
                    Just CapExpression
    setab -> CapExpression
    setab
                    Maybe CapExpression
    Nothing -> case Maybe CapExpression
    msetb of
                        Just CapExpression
    setb -> CapExpression
    setb
                        Maybe CapExpression
    Nothing -> [Char] -> CapExpression
    forall a. HasCallStack => [Char] -> a
    error ([Char] -> CapExpression) -> [Char] -> CapExpression
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "no back color support for terminal " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    termName

        IORef Bool
    hyperlinkModeStatus <- Bool -> IO (IORef Bool)
    forall a. a -> IO (IORef a)
    newIORef Bool
    False
        IORef AssumedState
    newAssumedStateRef <- AssumedState -> IO (IORef AssumedState)
    forall a. a -> IO (IORef a)
    newIORef AssumedState
    initialAssumedState

        let terminfoSetMode :: Mode -> Bool -> IO ()
    terminfoSetMode Mode
    m Bool
    newStatus = do
              Bool
    curStatus <- Mode -> IO Bool
    terminfoModeStatus Mode
    m
              Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Bool
    newStatus Bool -> Bool -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Bool
    curStatus) (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $
                  case Mode
    m of
                      Mode
    Hyperlink -> do
                          IORef Bool -> Bool -> IO ()
    forall a. IORef a -> a -> IO ()
    writeIORef IORef Bool
    hyperlinkModeStatus Bool
    newStatus
                          IORef AssumedState -> AssumedState -> IO ()
    forall a. IORef a -> a -> IO ()
    writeIORef IORef AssumedState
    newAssumedStateRef AssumedState
    initialAssumedState
                      Mode
    _ -> () -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
            terminfoModeStatus :: Mode -> IO Bool
    terminfoModeStatus Mode
    m =
                case Mode
    m of
                    Mode
    Hyperlink -> IORef Bool -> IO Bool
    forall a. IORef a -> IO a
    readIORef IORef Bool
    hyperlinkModeStatus
                    Mode
    _ -> Bool -> IO Bool
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    False
            terminfoModeSupported :: Mode -> Bool
    terminfoModeSupported Mode
    Hyperlink = Bool
    True
            terminfoModeSupported Mode
    _ = Bool
    False

        TerminfoCaps
    terminfoCaps <- (Maybe CapExpression
     -> Maybe CapExpression
     -> CapExpression
     -> Maybe CapExpression
     -> Maybe CapExpression
     -> Bool
     -> CapExpression
     -> CapExpression
     -> CapExpression
     -> CapExpression
     -> CapExpression
     -> DisplayAttrCaps
     -> Maybe CapExpression
     -> TerminfoCaps)
    -> IO
         (Maybe CapExpression
          -> Maybe CapExpression
          -> CapExpression
          -> Maybe CapExpression
          -> Maybe CapExpression
          -> Bool
          -> CapExpression
          -> CapExpression
          -> CapExpression
          -> CapExpression
          -> CapExpression
          -> DisplayAttrCaps
          -> Maybe CapExpression
          -> TerminfoCaps)
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Maybe CapExpression
    -> Maybe CapExpression
    -> CapExpression
    -> Maybe CapExpression
    -> Maybe CapExpression
    -> Bool
    -> CapExpression
    -> CapExpression
    -> CapExpression
    -> CapExpression
    -> CapExpression
    -> DisplayAttrCaps
    -> Maybe CapExpression
    -> TerminfoCaps
    TerminfoCaps
            IO
      (Maybe CapExpression
       -> Maybe CapExpression
       -> CapExpression
       -> Maybe CapExpression
       -> Maybe CapExpression
       -> Bool
       -> CapExpression
       -> CapExpression
       -> CapExpression
       -> CapExpression
       -> CapExpression
       -> DisplayAttrCaps
       -> Maybe CapExpression
       -> TerminfoCaps)
    -> IO (Maybe CapExpression)
    -> IO
         (Maybe CapExpression
          -> CapExpression
          -> Maybe CapExpression
          -> Maybe CapExpression
          -> Bool
          -> CapExpression
          -> CapExpression
          -> CapExpression
          -> CapExpression
          -> CapExpression
          -> DisplayAttrCaps
          -> Maybe CapExpression
          -> TerminfoCaps)
    forall a b. IO (a -> b) -> IO a -> IO b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Terminal -> [Char] -> IO (Maybe CapExpression)
    probeCap Terminal
    ti [Char]
    "smcup"
            IO
      (Maybe CapExpression
       -> CapExpression
       -> Maybe CapExpression
       -> Maybe CapExpression
       -> Bool
       -> CapExpression
       -> CapExpression
       -> CapExpression
       -> CapExpression
       -> CapExpression
       -> DisplayAttrCaps
       -> Maybe CapExpression
       -> TerminfoCaps)
    -> IO (Maybe CapExpression)
    -> IO
         (CapExpression
          -> Maybe CapExpression
          -> Maybe CapExpression
          -> Bool
          -> CapExpression
          -> CapExpression
          -> CapExpression
          -> CapExpression
          -> CapExpression
          -> DisplayAttrCaps
          -> Maybe CapExpression
          -> TerminfoCaps)
    forall a b. IO (a -> b) -> IO a -> IO b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Terminal -> [Char] -> IO (Maybe CapExpression)
    probeCap Terminal
    ti [Char]
    "rmcup"
            IO
      (CapExpression
       -> Maybe CapExpression
       -> Maybe CapExpression
       -> Bool
       -> CapExpression
       -> CapExpression
       -> CapExpression
       -> CapExpression
       -> CapExpression
       -> DisplayAttrCaps
       -> Maybe CapExpression
       -> TerminfoCaps)
    -> IO CapExpression
    -> IO
         (Maybe CapExpression
          -> Maybe CapExpression
          -> Bool
          -> CapExpression
          -> CapExpression
          -> CapExpression
          -> CapExpression
          -> CapExpression
          -> DisplayAttrCaps
          -> Maybe CapExpression
          -> TerminfoCaps)
    forall a b. IO (a -> b) -> IO a -> IO b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Terminal -> [Char] -> IO CapExpression
    requireCap Terminal
    ti [Char]
    "cup"
            IO
      (Maybe CapExpression
       -> Maybe CapExpression
       -> Bool
       -> CapExpression
       -> CapExpression
       -> CapExpression
       -> CapExpression
       -> CapExpression
       -> DisplayAttrCaps
       -> Maybe CapExpression
       -> TerminfoCaps)
    -> IO (Maybe CapExpression)
    -> IO
         (Maybe CapExpression
          -> Bool
          -> CapExpression
          -> CapExpression
          -> CapExpression
          -> CapExpression
          -> CapExpression
          -> DisplayAttrCaps
          -> Maybe CapExpression
          -> TerminfoCaps)
    forall a b. IO (a -> b) -> IO a -> IO b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Terminal -> [Char] -> IO (Maybe CapExpression)
    probeCap Terminal
    ti [Char]
    "cnorm"
            IO
      (Maybe CapExpression
       -> Bool
       -> CapExpression
       -> CapExpression
       -> CapExpression
       -> CapExpression
       -> CapExpression
       -> DisplayAttrCaps
       -> Maybe CapExpression
       -> TerminfoCaps)
    -> IO (Maybe CapExpression)
    -> IO
         (Bool
          -> CapExpression
          -> CapExpression
          -> CapExpression
          -> CapExpression
          -> CapExpression
          -> DisplayAttrCaps
          -> Maybe CapExpression
          -> TerminfoCaps)
    forall a b. IO (a -> b) -> IO a -> IO b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Terminal -> [Char] -> IO (Maybe CapExpression)
    probeCap Terminal
    ti [Char]
    "civis"
            IO
      (Bool
       -> CapExpression
       -> CapExpression
       -> CapExpression
       -> CapExpression
       -> CapExpression
       -> DisplayAttrCaps
       -> Maybe CapExpression
       -> TerminfoCaps)
    -> IO Bool
    -> IO
         (CapExpression
          -> CapExpression
          -> CapExpression
          -> CapExpression
          -> CapExpression
          -> DisplayAttrCaps
          -> Maybe CapExpression
          -> TerminfoCaps)
    forall a b. IO (a -> b) -> IO a -> IO b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Bool -> IO Bool
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Bool
    useAlt
            IO
      (CapExpression
       -> CapExpression
       -> CapExpression
       -> CapExpression
       -> CapExpression
       -> DisplayAttrCaps
       -> Maybe CapExpression
       -> TerminfoCaps)
    -> IO CapExpression
    -> IO
         (CapExpression
          -> CapExpression
          -> CapExpression
          -> CapExpression
          -> DisplayAttrCaps
          -> Maybe CapExpression
          -> TerminfoCaps)
    forall a b. IO (a -> b) -> IO a -> IO b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> CapExpression -> IO CapExpression
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure CapExpression
    setForeCap
            IO
      (CapExpression
       -> CapExpression
       -> CapExpression
       -> CapExpression
       -> DisplayAttrCaps
       -> Maybe CapExpression
       -> TerminfoCaps)
    -> IO CapExpression
    -> IO
         (CapExpression
          -> CapExpression
          -> CapExpression
          -> DisplayAttrCaps
          -> Maybe CapExpression
          -> TerminfoCaps)
    forall a b. IO (a -> b) -> IO a -> IO b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> CapExpression -> IO CapExpression
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure CapExpression
    setBackCap
            IO
      (CapExpression
       -> CapExpression
       -> CapExpression
       -> DisplayAttrCaps
       -> Maybe CapExpression
       -> TerminfoCaps)
    -> IO CapExpression
    -> IO
         (CapExpression
          -> CapExpression
          -> DisplayAttrCaps
          -> Maybe CapExpression
          -> TerminfoCaps)
    forall a b. IO (a -> b) -> IO a -> IO b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Terminal -> [Char] -> IO CapExpression
    requireCap Terminal
    ti [Char]
    "sgr0"
            IO
      (CapExpression
       -> CapExpression
       -> DisplayAttrCaps
       -> Maybe CapExpression
       -> TerminfoCaps)
    -> IO CapExpression
    -> IO
         (CapExpression
          -> DisplayAttrCaps -> Maybe CapExpression -> TerminfoCaps)
    forall a b. IO (a -> b) -> IO a -> IO b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Terminal -> [Char] -> IO CapExpression
    requireCap Terminal
    ti [Char]
    "clear"
            IO
      (CapExpression
       -> DisplayAttrCaps -> Maybe CapExpression -> TerminfoCaps)
    -> IO CapExpression
    -> IO (DisplayAttrCaps -> Maybe CapExpression -> TerminfoCaps)
    forall a b. IO (a -> b) -> IO a -> IO b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Terminal -> [Char] -> IO CapExpression
    requireCap Terminal
    ti [Char]
    "el"
            IO (DisplayAttrCaps -> Maybe CapExpression -> TerminfoCaps)
    -> IO DisplayAttrCaps -> IO (Maybe CapExpression -> TerminfoCaps)
    forall a b. IO (a -> b) -> IO a -> IO b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Terminal -> IO DisplayAttrCaps
    currentDisplayAttrCaps Terminal
    ti
            IO (Maybe CapExpression -> TerminfoCaps)
    -> IO (Maybe CapExpression) -> IO TerminfoCaps
    forall a b. IO (a -> b) -> IO a -> IO b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Terminal -> [Char] -> IO (Maybe CapExpression)
    probeCap Terminal
    ti [Char]
    "bel"
        let t :: Output
    t = Output
                { terminalID :: [Char]
    terminalID = [Char]
    termName
                , releaseTerminal :: IO ()
    releaseTerminal = do
                    (TerminfoCaps -> CapExpression) -> [CapParam] -> IO ()
    sendCap TerminfoCaps -> CapExpression
    setDefaultAttr []
                    (TerminfoCaps -> Maybe CapExpression) -> [CapParam] -> IO ()
    maybeSendCap TerminfoCaps -> Maybe CapExpression
    cnorm []
                , supportsBell :: IO Bool
    supportsBell = Bool -> IO Bool
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Bool -> IO Bool) -> Bool -> IO Bool
    forall a b. (a -> b) -> a -> b
    $ Maybe CapExpression -> Bool
    forall a. Maybe a -> Bool
    isJust (Maybe CapExpression -> Bool) -> Maybe CapExpression -> Bool
    forall a b. (a -> b) -> a -> b
    $ TerminfoCaps -> Maybe CapExpression
    ringBellAudio TerminfoCaps
    terminfoCaps
                , supportsItalics :: IO Bool
    supportsItalics = Bool -> IO Bool
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Bool -> IO Bool) -> Bool -> IO Bool
    forall a b. (a -> b) -> a -> b
    $ (Maybe CapExpression -> Bool
    forall a. Maybe a -> Bool
    isJust (Maybe CapExpression -> Bool) -> Maybe CapExpression -> Bool
    forall a b. (a -> b) -> a -> b
    $ DisplayAttrCaps -> Maybe CapExpression
    enterItalic (TerminfoCaps -> DisplayAttrCaps
    displayAttrCaps TerminfoCaps
    terminfoCaps)) Bool -> Bool -> Bool
    &&
                                             (Maybe CapExpression -> Bool
    forall a. Maybe a -> Bool
    isJust (Maybe CapExpression -> Bool) -> Maybe CapExpression -> Bool
    forall a b. (a -> b) -> a -> b
    $ DisplayAttrCaps -> Maybe CapExpression
    exitItalic (TerminfoCaps -> DisplayAttrCaps
    displayAttrCaps TerminfoCaps
    terminfoCaps))
                , supportsStrikethrough :: IO Bool
    supportsStrikethrough = Bool -> IO Bool
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Bool -> IO Bool) -> Bool -> IO Bool
    forall a b. (a -> b) -> a -> b
    $ (Maybe CapExpression -> Bool
    forall a. Maybe a -> Bool
    isJust (Maybe CapExpression -> Bool) -> Maybe CapExpression -> Bool
    forall a b. (a -> b) -> a -> b
    $ DisplayAttrCaps -> Maybe CapExpression
    enterStrikethrough (TerminfoCaps -> DisplayAttrCaps
    displayAttrCaps TerminfoCaps
    terminfoCaps)) Bool -> Bool -> Bool
    &&
                                                   (Maybe CapExpression -> Bool
    forall a. Maybe a -> Bool
    isJust (Maybe CapExpression -> Bool) -> Maybe CapExpression -> Bool
    forall a b. (a -> b) -> a -> b
    $ DisplayAttrCaps -> Maybe CapExpression
    exitStrikethrough (TerminfoCaps -> DisplayAttrCaps
    displayAttrCaps TerminfoCaps
    terminfoCaps))
                , ringTerminalBell :: IO ()
    ringTerminalBell = (TerminfoCaps -> Maybe CapExpression) -> [CapParam] -> IO ()
    maybeSendCap TerminfoCaps -> Maybe CapExpression
    ringBellAudio []
                , reserveDisplay :: IO ()
    reserveDisplay = do
                    -- If there is no support for smcup: Clear the screen
                    -- and then move the mouse to the home position to
                    -- approximate the behavior.
                    (TerminfoCaps -> Maybe CapExpression) -> [CapParam] -> IO ()
    maybeSendCap TerminfoCaps -> Maybe CapExpression
    smcup []
                    (TerminfoCaps -> CapExpression) -> [CapParam] -> IO ()
    sendCap TerminfoCaps -> CapExpression
    clearScreen []
                , releaseDisplay :: IO ()
    releaseDisplay = do
                    (TerminfoCaps -> Maybe CapExpression) -> [CapParam] -> IO ()
    maybeSendCap TerminfoCaps -> Maybe CapExpression
    rmcup []
                    (TerminfoCaps -> Maybe CapExpression) -> [CapParam] -> IO ()
    maybeSendCap TerminfoCaps -> Maybe CapExpression
    cnorm []
                , setDisplayBounds :: (Int, Int) -> IO ()
    setDisplayBounds = \(Int
    w, Int
    h) ->
                    Fd -> (Int, Int) -> IO ()
    setWindowSize Fd
    outFd (Int
    w, Int
    h)
                , displayBounds :: IO (Int, Int)
    displayBounds = do
                    (Int, Int)
    rawSize <- Fd -> IO (Int, Int)
    getWindowSize Fd
    outFd
                    case (Int, Int)
    rawSize of
                        (Int
    w, Int
    h)  | Int
    w Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < Int
    0 Bool -> Bool -> Bool
    || Int
    h Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < Int
    0 -> [Char] -> IO (Int, Int)
    forall a. [Char] -> IO a
    forall (m :: * -> *) a. MonadFail m => [Char] -> m a
    fail ([Char] -> IO (Int, Int)) -> [Char] -> IO (Int, Int)
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "getwinsize returned < 0 : " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ (Int, Int) -> [Char]
    forall a. Show a => a -> [Char]
    show (Int, Int)
    rawSize
                                | Bool
    otherwise      -> (Int, Int) -> IO (Int, Int)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Int
    w,Int
    h)
                , outputByteBuffer :: ByteString -> IO ()
    outputByteBuffer = \ByteString
    outBytes -> do
                    let (ForeignPtr Word8
    fptr, Int
    offset, Int
    len) = ByteString -> (ForeignPtr Word8, Int, Int)
    toForeignPtr ByteString
    outBytes
                    Int
    actualLen <- ForeignPtr Word8 -> (Ptr Word8 -> IO Int) -> IO Int
    forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
    withForeignPtr ForeignPtr Word8
    fptr
                                 ((Ptr Word8 -> IO Int) -> IO Int)
    -> (Ptr Word8 -> IO Int) -> IO Int
    forall a b. (a -> b) -> a -> b
    $ \Ptr Word8
    ptr -> Fd -> Ptr Word8 -> Int -> Int -> IO Int
    fdWriteAll Fd
    outFd (Ptr Word8
    ptr Ptr Word8 -> Int -> Ptr Word8
    forall a b. Ptr a -> Int -> Ptr b
    `plusPtr` Int
    offset) Int
    len Int
    0
                    Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Int -> Int
    forall a. Enum a => Int -> a
    toEnum Int
    len Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Int
    actualLen) (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ [Char] -> IO ()
    forall a. [Char] -> IO a
    forall (m :: * -> *) a. MonadFail m => [Char] -> m a
    fail ([Char] -> IO ()) -> [Char] -> IO ()
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "Graphics.Vty.Output: outputByteBuffer "
                      [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    "length mismatch. " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Int -> [Char]
    forall a. Show a => a -> [Char]
    show Int
    len [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    " /= " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Int -> [Char]
    forall a. Show a => a -> [Char]
    show Int
    actualLen
                      [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    " Please report this bug to vty project."
                , supportsCursorVisibility :: Bool
    supportsCursorVisibility = Maybe CapExpression -> Bool
    forall a. Maybe a -> Bool
    isJust (Maybe CapExpression -> Bool) -> Maybe CapExpression -> Bool
    forall a b. (a -> b) -> a -> b
    $ TerminfoCaps -> Maybe CapExpression
    civis TerminfoCaps
    terminfoCaps
                , supportsMode :: Mode -> Bool
    supportsMode = Mode -> Bool
    terminfoModeSupported
                , setMode :: Mode -> Bool -> IO ()
    setMode = Mode -> Bool -> IO ()
    terminfoSetMode
                , getModeStatus :: Mode -> IO Bool
    getModeStatus = Mode -> IO Bool
    terminfoModeStatus
                , assumedStateRef :: IORef AssumedState
    assumedStateRef = IORef AssumedState
    newAssumedStateRef
                , outputColorMode :: ColorMode
    outputColorMode = ColorMode
    colorMode
                -- I think fix would help assure tActual is the only
                -- reference. I was having issues tho.
                , mkDisplayContext :: Output -> (Int, Int) -> IO DisplayContext
    mkDisplayContext = (Output -> TerminfoCaps -> (Int, Int) -> IO DisplayContext
    `terminfoDisplayContext` TerminfoCaps
    terminfoCaps)
                }
            sendCap :: (TerminfoCaps -> CapExpression) -> [CapParam] -> IO ()
    sendCap TerminfoCaps -> CapExpression
    s = Output -> CapExpression -> [CapParam] -> IO ()
    sendCapToTerminal Output
    t (TerminfoCaps -> CapExpression
    s TerminfoCaps
    terminfoCaps)
            maybeSendCap :: (TerminfoCaps -> Maybe CapExpression) -> [CapParam] -> IO ()
    maybeSendCap TerminfoCaps -> Maybe CapExpression
    s = Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Maybe CapExpression -> Bool
    forall a. Maybe a -> Bool
    isJust (Maybe CapExpression -> Bool) -> Maybe CapExpression -> Bool
    forall a b. (a -> b) -> a -> b
    $ TerminfoCaps -> Maybe CapExpression
    s TerminfoCaps
    terminfoCaps) (IO () -> IO ()) -> ([CapParam] -> IO ()) -> [CapParam] -> IO ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (TerminfoCaps -> CapExpression) -> [CapParam] -> IO ()
    sendCap (Maybe CapExpression -> CapExpression
    forall a. HasCallStack => Maybe a -> a
    fromJust (Maybe CapExpression -> CapExpression)
    -> (TerminfoCaps -> Maybe CapExpression)
    -> TerminfoCaps
    -> CapExpression
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . TerminfoCaps -> Maybe CapExpression
    s)
        Output -> IO Output
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Output
    t

    requireCap :: Terminfo.Terminal -> String -> IO CapExpression
    requireCap :: Terminal -> [Char] -> IO CapExpression
    requireCap Terminal
    ti [Char]
    capName
        = case Terminal -> Capability [Char] -> Maybe [Char]
    forall a. Terminal -> Capability a -> Maybe a
    Terminfo.getCapability Terminal
    ti ([Char] -> Capability [Char]
    Terminfo.tiGetStr [Char]
    capName) of
            Maybe [Char]
    Nothing     -> [Char] -> IO CapExpression
    forall a. [Char] -> IO a
    forall (m :: * -> *) a. MonadFail m => [Char] -> m a
    fail ([Char] -> IO CapExpression) -> [Char] -> IO CapExpression
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "Terminal does not define required capability \"" [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    capName [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    "\""
            Just [Char]
    capStr -> [Char] -> IO CapExpression
    parseCap [Char]
    capStr

    probeCap :: Terminfo.Terminal -> String -> IO (Maybe CapExpression)
    probeCap :: Terminal -> [Char] -> IO (Maybe CapExpression)
    probeCap Terminal
    ti [Char]
    capName
        = case Terminal -> Capability [Char] -> Maybe [Char]
    forall a. Terminal -> Capability a -> Maybe a
    Terminfo.getCapability Terminal
    ti ([Char] -> Capability [Char]
    Terminfo.tiGetStr [Char]
    capName) of
            Maybe [Char]
    Nothing     -> Maybe CapExpression -> IO (Maybe CapExpression)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe CapExpression
    forall a. Maybe a
    Nothing
            Just [Char]
    capStr -> CapExpression -> Maybe CapExpression
    forall a. a -> Maybe a
    Just (CapExpression -> Maybe CapExpression)
    -> IO CapExpression -> IO (Maybe CapExpression)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [Char] -> IO CapExpression
    parseCap [Char]
    capStr

    parseCap :: String -> IO CapExpression
    parseCap :: [Char] -> IO CapExpression
    parseCap [Char]
    capStr = do
        case [Char] -> Either ParseError CapExpression
    parseCapExpression [Char]
    capStr of
            Left ParseError
    e -> [Char] -> IO CapExpression
    forall a. [Char] -> IO a
    forall (m :: * -> *) a. MonadFail m => [Char] -> m a
    fail ([Char] -> IO CapExpression) -> [Char] -> IO CapExpression
    forall a b. (a -> b) -> a -> b
    $ ParseError -> [Char]
    forall a. Show a => a -> [Char]
    show ParseError
    e
            Right CapExpression
    cap -> CapExpression -> IO CapExpression
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return CapExpression
    cap

    currentDisplayAttrCaps :: Terminfo.Terminal -> IO DisplayAttrCaps
    currentDisplayAttrCaps :: Terminal -> IO DisplayAttrCaps
    currentDisplayAttrCaps Terminal
    ti
        =   (Maybe CapExpression
     -> Maybe CapExpression
     -> Maybe CapExpression
     -> Maybe CapExpression
     -> Maybe CapExpression
     -> Maybe CapExpression
     -> Maybe CapExpression
     -> Maybe CapExpression
     -> Maybe CapExpression
     -> Maybe CapExpression
     -> Maybe CapExpression
     -> Maybe CapExpression
     -> DisplayAttrCaps)
    -> IO
         (Maybe CapExpression
          -> Maybe CapExpression
          -> Maybe CapExpression
          -> Maybe CapExpression
          -> Maybe CapExpression
          -> Maybe CapExpression
          -> Maybe CapExpression
          -> Maybe CapExpression
          -> Maybe CapExpression
          -> Maybe CapExpression
          -> Maybe CapExpression
          -> Maybe CapExpression
          -> DisplayAttrCaps)
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Maybe CapExpression
    -> Maybe CapExpression
    -> Maybe CapExpression
    -> Maybe CapExpression
    -> Maybe CapExpression
    -> Maybe CapExpression
    -> Maybe CapExpression
    -> Maybe CapExpression
    -> Maybe CapExpression
    -> Maybe CapExpression
    -> Maybe CapExpression
    -> Maybe CapExpression
    -> DisplayAttrCaps
    DisplayAttrCaps
        IO
      (Maybe CapExpression
       -> Maybe CapExpression
       -> Maybe CapExpression
       -> Maybe CapExpression
       -> Maybe CapExpression
       -> Maybe CapExpression
       -> Maybe CapExpression
       -> Maybe CapExpression
       -> Maybe CapExpression
       -> Maybe CapExpression
       -> Maybe CapExpression
       -> Maybe CapExpression
       -> DisplayAttrCaps)
    -> IO (Maybe CapExpression)
    -> IO
         (Maybe CapExpression
          -> Maybe CapExpression
          -> Maybe CapExpression
          -> Maybe CapExpression
          -> Maybe CapExpression
          -> Maybe CapExpression
          -> Maybe CapExpression
          -> Maybe CapExpression
          -> Maybe CapExpression
          -> Maybe CapExpression
          -> Maybe CapExpression
          -> DisplayAttrCaps)
    forall a b. IO (a -> b) -> IO a -> IO b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Terminal -> [Char] -> IO (Maybe CapExpression)
    probeCap Terminal
    ti [Char]
    "sgr"
        IO
      (Maybe CapExpression
       -> Maybe CapExpression
       -> Maybe CapExpression
       -> Maybe CapExpression
       -> Maybe CapExpression
       -> Maybe CapExpression
       -> Maybe CapExpression
       -> Maybe CapExpression
       -> Maybe CapExpression
       -> Maybe CapExpression
       -> Maybe CapExpression
       -> DisplayAttrCaps)
    -> IO (Maybe CapExpression)
    -> IO
         (Maybe CapExpression
          -> Maybe CapExpression
          -> Maybe CapExpression
          -> Maybe CapExpression
          -> Maybe CapExpression
          -> Maybe CapExpression
          -> Maybe CapExpression
          -> Maybe CapExpression
          -> Maybe CapExpression
          -> Maybe CapExpression
          -> DisplayAttrCaps)
    forall a b. IO (a -> b) -> IO a -> IO b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Terminal -> [Char] -> IO (Maybe CapExpression)
    probeCap Terminal
    ti [Char]
    "smso"
        IO
      (Maybe CapExpression
       -> Maybe CapExpression
       -> Maybe CapExpression
       -> Maybe CapExpression
       -> Maybe CapExpression
       -> Maybe CapExpression
       -> Maybe CapExpression
       -> Maybe CapExpression
       -> Maybe CapExpression
       -> Maybe CapExpression
       -> DisplayAttrCaps)
    -> IO (Maybe CapExpression)
    -> IO
         (Maybe CapExpression
          -> Maybe CapExpression
          -> Maybe CapExpression
          -> Maybe CapExpression
          -> Maybe CapExpression
          -> Maybe CapExpression
          -> Maybe CapExpression
          -> Maybe CapExpression
          -> Maybe CapExpression
          -> DisplayAttrCaps)
    forall a b. IO (a -> b) -> IO a -> IO b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Terminal -> [Char] -> IO (Maybe CapExpression)
    probeCap Terminal
    ti [Char]
    "rmso"
        IO
      (Maybe CapExpression
       -> Maybe CapExpression
       -> Maybe CapExpression
       -> Maybe CapExpression
       -> Maybe CapExpression
       -> Maybe CapExpression
       -> Maybe CapExpression
       -> Maybe CapExpression
       -> Maybe CapExpression
       -> DisplayAttrCaps)
    -> IO (Maybe CapExpression)
    -> IO
         (Maybe CapExpression
          -> Maybe CapExpression
          -> Maybe CapExpression
          -> Maybe CapExpression
          -> Maybe CapExpression
          -> Maybe CapExpression
          -> Maybe CapExpression
          -> Maybe CapExpression
          -> DisplayAttrCaps)
    forall a b. IO (a -> b) -> IO a -> IO b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Terminal -> [Char] -> IO (Maybe CapExpression)
    probeCap Terminal
    ti [Char]
    "sitm"
        IO
      (Maybe CapExpression
       -> Maybe CapExpression
       -> Maybe CapExpression
       -> Maybe CapExpression
       -> Maybe CapExpression
       -> Maybe CapExpression
       -> Maybe CapExpression
       -> Maybe CapExpression
       -> DisplayAttrCaps)
    -> IO (Maybe CapExpression)
    -> IO
         (Maybe CapExpression
          -> Maybe CapExpression
          -> Maybe CapExpression
          -> Maybe CapExpression
          -> Maybe CapExpression
          -> Maybe CapExpression
          -> Maybe CapExpression
          -> DisplayAttrCaps)
    forall a b. IO (a -> b) -> IO a -> IO b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Terminal -> [Char] -> IO (Maybe CapExpression)
    probeCap Terminal
    ti [Char]
    "ritm"
        IO
      (Maybe CapExpression
       -> Maybe CapExpression
       -> Maybe CapExpression
       -> Maybe CapExpression
       -> Maybe CapExpression
       -> Maybe CapExpression
       -> Maybe CapExpression
       -> DisplayAttrCaps)
    -> IO (Maybe CapExpression)
    -> IO
         (Maybe CapExpression
          -> Maybe CapExpression
          -> Maybe CapExpression
          -> Maybe CapExpression
          -> Maybe CapExpression
          -> Maybe CapExpression
          -> DisplayAttrCaps)
    forall a b. IO (a -> b) -> IO a -> IO b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Terminal -> [Char] -> IO (Maybe CapExpression)
    probeCap Terminal
    ti [Char]
    "smxx"
        IO
      (Maybe CapExpression
       -> Maybe CapExpression
       -> Maybe CapExpression
       -> Maybe CapExpression
       -> Maybe CapExpression
       -> Maybe CapExpression
       -> DisplayAttrCaps)
    -> IO (Maybe CapExpression)
    -> IO
         (Maybe CapExpression
          -> Maybe CapExpression
          -> Maybe CapExpression
          -> Maybe CapExpression
          -> Maybe CapExpression
          -> DisplayAttrCaps)
    forall a b. IO (a -> b) -> IO a -> IO b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Terminal -> [Char] -> IO (Maybe CapExpression)
    probeCap Terminal
    ti [Char]
    "rmxx"
        IO
      (Maybe CapExpression
       -> Maybe CapExpression
       -> Maybe CapExpression
       -> Maybe CapExpression
       -> Maybe CapExpression
       -> DisplayAttrCaps)
    -> IO (Maybe CapExpression)
    -> IO
         (Maybe CapExpression
          -> Maybe CapExpression
          -> Maybe CapExpression
          -> Maybe CapExpression
          -> DisplayAttrCaps)
    forall a b. IO (a -> b) -> IO a -> IO b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Terminal -> [Char] -> IO (Maybe CapExpression)
    probeCap Terminal
    ti [Char]
    "smul"
        IO
      (Maybe CapExpression
       -> Maybe CapExpression
       -> Maybe CapExpression
       -> Maybe CapExpression
       -> DisplayAttrCaps)
    -> IO (Maybe CapExpression)
    -> IO
         (Maybe CapExpression
          -> Maybe CapExpression -> Maybe CapExpression -> DisplayAttrCaps)
    forall a b. IO (a -> b) -> IO a -> IO b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Terminal -> [Char] -> IO (Maybe CapExpression)
    probeCap Terminal
    ti [Char]
    "rmul"
        IO
      (Maybe CapExpression
       -> Maybe CapExpression -> Maybe CapExpression -> DisplayAttrCaps)
    -> IO (Maybe CapExpression)
    -> IO
         (Maybe CapExpression -> Maybe CapExpression -> DisplayAttrCaps)
    forall a b. IO (a -> b) -> IO a -> IO b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Terminal -> [Char] -> IO (Maybe CapExpression)
    probeCap Terminal
    ti [Char]
    "rev"
        IO (Maybe CapExpression -> Maybe CapExpression -> DisplayAttrCaps)
    -> IO (Maybe CapExpression)
    -> IO (Maybe CapExpression -> DisplayAttrCaps)
    forall a b. IO (a -> b) -> IO a -> IO b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Terminal -> [Char] -> IO (Maybe CapExpression)
    probeCap Terminal
    ti [Char]
    "dim"
        IO (Maybe CapExpression -> DisplayAttrCaps)
    -> IO (Maybe CapExpression) -> IO DisplayAttrCaps
    forall a b. IO (a -> b) -> IO a -> IO b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Terminal -> [Char] -> IO (Maybe CapExpression)
    probeCap Terminal
    ti [Char]
    "bold"

    foreign import ccall "gwinsz.h vty_c_get_window_size" c_getWindowSize :: Fd -> IO CLong

    getWindowSize :: Fd -> IO (Int,Int)
    getWindowSize :: Fd -> IO (Int, Int)
    getWindowSize Fd
    fd = do
        (CLong
    a,CLong
    b) <- (CLong -> CLong -> (CLong, CLong)
    forall a. Integral a => a -> a -> (a, a)
    `divMod` CLong
    65536) (CLong -> (CLong, CLong)) -> IO CLong -> IO (CLong, CLong)
    forall a b. (a -> b) -> IO a -> IO b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    `fmap` Fd -> IO CLong
    c_getWindowSize Fd
    fd
        (Int, Int) -> IO (Int, Int)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (CLong -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral CLong
    b, CLong -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral CLong
    a)

    foreign import ccall "gwinsz.h vty_c_set_window_size" c_setWindowSize :: Fd -> CLong -> IO ()

    setWindowSize :: Fd -> (Int, Int) -> IO ()
    setWindowSize :: Fd -> (Int, Int) -> IO ()
    setWindowSize Fd
    fd (Int
    w, Int
    h) = do
        let val :: Int
    val = (Int
    h Int -> Int -> Int
    forall a. Bits a => a -> Int -> a
    `shiftL` Int
    16) Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    w
        Fd -> CLong -> IO ()
    c_setWindowSize Fd
    fd (CLong -> IO ()) -> CLong -> IO ()
    forall a b. (a -> b) -> a -> b
    $ Int -> CLong
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int
    val

    terminfoDisplayContext :: Output -> TerminfoCaps -> DisplayRegion -> IO DisplayContext
    terminfoDisplayContext :: Output -> TerminfoCaps -> (Int, Int) -> IO DisplayContext
    terminfoDisplayContext Output
    tActual TerminfoCaps
    terminfoCaps (Int, Int)
    r = DisplayContext -> IO DisplayContext
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return DisplayContext
    dc
        where dc :: DisplayContext
    dc = DisplayContext
                { contextDevice :: Output
    contextDevice = Output
    tActual
                , contextRegion :: (Int, Int)
    contextRegion = (Int, Int)
    r
                , writeMoveCursor :: Int -> Int -> Write
    writeMoveCursor = \Int
    x Int
    y -> CapExpression -> [CapParam] -> Write
    writeCapExpr (TerminfoCaps -> CapExpression
    cup TerminfoCaps
    terminfoCaps) [Int -> CapParam
    forall a. Enum a => Int -> a
    toEnum Int
    y, Int -> CapParam
    forall a. Enum a => Int -> a
    toEnum Int
    x]
                , writeShowCursor :: Write
    writeShowCursor = case TerminfoCaps -> Maybe CapExpression
    cnorm TerminfoCaps
    terminfoCaps of
                    Maybe CapExpression
    Nothing -> [Char] -> Write
    forall a. HasCallStack => [Char] -> a
    error [Char]
    "this terminal does not support show cursor"
                    Just CapExpression
    c -> CapExpression -> [CapParam] -> Write
    writeCapExpr CapExpression
    c []
                , writeHideCursor :: Write
    writeHideCursor = case TerminfoCaps -> Maybe CapExpression
    civis TerminfoCaps
    terminfoCaps of
                    Maybe CapExpression
    Nothing -> [Char] -> Write
    forall a. HasCallStack => [Char] -> a
    error [Char]
    "this terminal does not support hide cursor"
                    Just CapExpression
    c -> CapExpression -> [CapParam] -> Write
    writeCapExpr CapExpression
    c []
                , writeSetAttr :: Bool -> FixedAttr -> Attr -> DisplayAttrDiff -> Write
    writeSetAttr = DisplayContext
    -> TerminfoCaps
    -> Bool
    -> FixedAttr
    -> Attr
    -> DisplayAttrDiff
    -> Write
    terminfoWriteSetAttr DisplayContext
    dc TerminfoCaps
    terminfoCaps
                , writeDefaultAttr :: Bool -> Write
    writeDefaultAttr = \Bool
    urlsEnabled ->
                    CapExpression -> [CapParam] -> Write
    writeCapExpr (TerminfoCaps -> CapExpression
    setDefaultAttr TerminfoCaps
    terminfoCaps) [] Write -> Write -> Write
    forall a. Monoid a => a -> a -> a
    `mappend`
                    (if Bool
    urlsEnabled then URLDiff -> Write
    writeURLEscapes URLDiff
    EndLink else Write
    forall a. Monoid a => a
    mempty) Write -> Write -> Write
    forall a. Monoid a => a -> a -> a
    `mappend`
                    (case DisplayAttrCaps -> Maybe CapExpression
    exitStrikethrough (DisplayAttrCaps -> Maybe CapExpression)
    -> DisplayAttrCaps -> Maybe CapExpression
    forall a b. (a -> b) -> a -> b
    $ TerminfoCaps -> DisplayAttrCaps
    displayAttrCaps TerminfoCaps
    terminfoCaps of
                        Just CapExpression
    cap -> CapExpression -> [CapParam] -> Write
    writeCapExpr CapExpression
    cap []
                        Maybe CapExpression
    Nothing -> Write
    forall a. Monoid a => a
    mempty
                    )
                , writeRowEnd :: Write
    writeRowEnd = CapExpression -> [CapParam] -> Write
    writeCapExpr (TerminfoCaps -> CapExpression
    clearEol TerminfoCaps
    terminfoCaps) []
                , inlineHack :: IO ()
    inlineHack = () -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
                }

    -- | Write the escape sequences that are used in some terminals to
    -- include embedded hyperlinks. As of yet, this information isn't
    -- included in termcap or terminfo, so this writes them directly
    -- instead of looking up the appropriate capabilities.
    writeURLEscapes :: URLDiff -> Write
    writeURLEscapes :: URLDiff -> Write
    writeURLEscapes (LinkTo ByteString
    url) =
        (Word8 -> Write) -> [Word8] -> Write
    forall m a. Monoid m => (a -> m) -> [a] -> m
    forall (t :: * -> *) m a.
    (Foldable t, Monoid m) =>
    (a -> m) -> t a -> m
    foldMap Word8 -> Write
    forall a. Storable a => a -> Write
    writeStorable (ByteString -> [Word8]
    BS.unpack ByteString
    "\x1b]8;;") Write -> Write -> Write
    forall a. Monoid a => a -> a -> a
    `mappend`
        (Word8 -> Write) -> [Word8] -> Write
    forall m a. Monoid m => (a -> m) -> [a] -> m
    forall (t :: * -> *) m a.
    (Foldable t, Monoid m) =>
    (a -> m) -> t a -> m
    foldMap Word8 -> Write
    forall a. Storable a => a -> Write
    writeStorable (ByteString -> [Word8]
    BS.unpack ByteString
    url) Write -> Write -> Write
    forall a. Monoid a => a -> a -> a
    `mappend`
        Word8 -> Write
    forall a. Storable a => a -> Write
    writeStorable (Word8
    0x07 :: Word8)
    writeURLEscapes URLDiff
    EndLink =
        (Word8 -> Write) -> [Word8] -> Write
    forall m a. Monoid m => (a -> m) -> [a] -> m
    forall (t :: * -> *) m a.
    (Foldable t, Monoid m) =>
    (a -> m) -> t a -> m
    foldMap Word8 -> Write
    forall a. Storable a => a -> Write
    writeStorable (ByteString -> [Word8]
    BS.unpack ByteString
    "\x1b]8;;\a")
    writeURLEscapes URLDiff
    NoLinkChange =
        Write
    forall a. Monoid a => a
    mempty

    -- | Portably setting the display attributes is a giant pain in the ass.
    --
    -- If the terminal supports the sgr capability (which sets the on/off
    -- state of each style directly; and, for no good reason, resets the
    -- colors to the default) this procedure is used:
    --
    --  0. set the style attributes. This resets the fore and back color.
    --
    --  1, If a foreground color is to be set then set the foreground color
    --
    --  2. likewise with the background color
    --
    -- If the terminal does not support the sgr cap then: if there is a
    -- change from an applied color to the default (in either the fore or
    -- back color) then:
    --
    --  0. reset all display attributes (sgr0)
    --
    --  1. enter required style modes
    --
    --  2. set the fore color if required
    --
    --  3. set the back color if required
    --
    -- Entering the required style modes could require a reset of the
    -- display attributes. If this is the case then the back and fore colors
    -- always need to be set if not default.
    --
    -- This equation implements the above logic.
    --
    -- Note that this assumes the removal of color changes in the
    -- display attributes is done as expected with noColors == True. See
    -- `limitAttrForDisplay`.
    --
    -- Note that this optimizes for fewer state changes followed by fewer
    -- bytes.
    terminfoWriteSetAttr :: DisplayContext -> TerminfoCaps -> Bool -> FixedAttr -> Attr -> DisplayAttrDiff -> Write
    terminfoWriteSetAttr :: DisplayContext
    -> TerminfoCaps
    -> Bool
    -> FixedAttr
    -> Attr
    -> DisplayAttrDiff
    -> Write
    terminfoWriteSetAttr DisplayContext
    dc TerminfoCaps
    terminfoCaps Bool
    urlsEnabled FixedAttr
    prevAttr Attr
    reqAttr DisplayAttrDiff
    diffs =
        Bool -> Write
    urlAttrs Bool
    urlsEnabled Write -> Write -> Write
    forall a. Monoid a => a -> a -> a
    `mappend` case (DisplayAttrDiff -> DisplayColorDiff
    foreColorDiff DisplayAttrDiff
    diffs DisplayColorDiff -> DisplayColorDiff -> Bool
    forall a. Eq a => a -> a -> Bool
    == DisplayColorDiff
    ColorToDefault) Bool -> Bool -> Bool
    || (DisplayAttrDiff -> DisplayColorDiff
    backColorDiff DisplayAttrDiff
    diffs DisplayColorDiff -> DisplayColorDiff -> Bool
    forall a. Eq a => a -> a -> Bool
    == DisplayColorDiff
    ColorToDefault) of
            -- The only way to reset either color, portably, to the default
            -- is to use either the set state capability or the set default
            -- capability.
            Bool
    True -> do
                case DisplayAttrCaps -> Word8 -> [StyleStateChange] -> DisplayAttrSeq
    reqDisplayCapSeqFor (TerminfoCaps -> DisplayAttrCaps
    displayAttrCaps TerminfoCaps
    terminfoCaps)
                                         (FixedAttr -> Word8
    fixedStyle FixedAttr
    attr)
                                         (Word8 -> [StyleStateChange]
    styleToApplySeq (Word8 -> [StyleStateChange]) -> Word8 -> [StyleStateChange]
    forall a b. (a -> b) -> a -> b
    $ FixedAttr -> Word8
    fixedStyle FixedAttr
    attr) of
                    -- only way to reset a color to the defaults
                    EnterExitSeq [CapExpression]
    caps -> DisplayContext -> Bool -> Write
    writeDefaultAttr DisplayContext
    dc Bool
    urlsEnabled
                                         Write -> Write -> Write
    forall a. Monoid a => a -> a -> a
    `mappend`
                                         (CapExpression -> Write) -> [CapExpression] -> Write
    forall m a. Monoid m => (a -> m) -> [a] -> m
    forall (t :: * -> *) m a.
    (Foldable t, Monoid m) =>
    (a -> m) -> t a -> m
    foldMap (\CapExpression
    cap -> CapExpression -> [CapParam] -> Write
    writeCapExpr CapExpression
    cap []) [CapExpression]
    caps
                                         Write -> Write -> Write
    forall a. Monoid a => a -> a -> a
    `mappend`
                                         Write
    setColors
                    -- implicitly resets the colors to the defaults
                    SetState DisplayAttrState
    state -> CapExpression -> [CapParam] -> Write
    writeCapExpr (Maybe CapExpression -> CapExpression
    forall a. HasCallStack => Maybe a -> a
    fromJust (Maybe CapExpression -> CapExpression)
    -> Maybe CapExpression -> CapExpression
    forall a b. (a -> b) -> a -> b
    $ DisplayAttrCaps -> Maybe CapExpression
    setAttrStates
                                                             (DisplayAttrCaps -> Maybe CapExpression)
    -> DisplayAttrCaps -> Maybe CapExpression
    forall a b. (a -> b) -> a -> b
    $ TerminfoCaps -> DisplayAttrCaps
    displayAttrCaps TerminfoCaps
    terminfoCaps
                                                   )
                                                   (DisplayAttrState -> [CapParam]
    sgrArgsForState DisplayAttrState
    state)
                                      Write -> Write -> Write
    forall a. Monoid a => a -> a -> a
    `mappend` Write
    setItalics
                                      Write -> Write -> Write
    forall a. Monoid a => a -> a -> a
    `mappend` Write
    setStrikethrough
                                      Write -> Write -> Write
    forall a. Monoid a => a -> a -> a
    `mappend` Write
    setColors
            -- Otherwise the display colors are not changing or changing
            -- between two non-default points.
            Bool
    False -> do
                -- Still, it could be the case that the change in display
                -- attributes requires the colors to be reset because the
                -- required capability was not available.
                case DisplayAttrCaps -> Word8 -> [StyleStateChange] -> DisplayAttrSeq
    reqDisplayCapSeqFor (TerminfoCaps -> DisplayAttrCaps
    displayAttrCaps TerminfoCaps
    terminfoCaps)
                                         (FixedAttr -> Word8
    fixedStyle FixedAttr
    attr)
                                         (DisplayAttrDiff -> [StyleStateChange]
    styleDiffs DisplayAttrDiff
    diffs) of
                    -- Really, if terminals were re-implemented with modern
                    -- concepts instead of bowing down to 40 yr old dumb
                    -- terminal requirements this would be the only case
                    -- ever reached! Changes the style and color states
                    -- according to the differences with the currently
                    -- applied states.
                    EnterExitSeq [CapExpression]
    caps -> (CapExpression -> Write) -> [CapExpression] -> Write
    forall m a. Monoid m => (a -> m) -> [a] -> m
    forall (t :: * -> *) m a.
    (Foldable t, Monoid m) =>
    (a -> m) -> t a -> m
    foldMap (\CapExpression
    cap -> CapExpression -> [CapParam] -> Write
    writeCapExpr CapExpression
    cap []) [CapExpression]
    caps
                                         Write -> Write -> Write
    forall a. Monoid a => a -> a -> a
    `mappend`
                                         ColorSide -> DisplayColorDiff -> Write
    writeColorDiff ColorSide
    Foreground (DisplayAttrDiff -> DisplayColorDiff
    foreColorDiff DisplayAttrDiff
    diffs)
                                         Write -> Write -> Write
    forall a. Monoid a => a -> a -> a
    `mappend`
                                         ColorSide -> DisplayColorDiff -> Write
    writeColorDiff ColorSide
    Background (DisplayAttrDiff -> DisplayColorDiff
    backColorDiff DisplayAttrDiff
    diffs)
                    -- implicitly resets the colors to the defaults
                    SetState DisplayAttrState
    state -> CapExpression -> [CapParam] -> Write
    writeCapExpr (Maybe CapExpression -> CapExpression
    forall a. HasCallStack => Maybe a -> a
    fromJust (Maybe CapExpression -> CapExpression)
    -> Maybe CapExpression -> CapExpression
    forall a b. (a -> b) -> a -> b
    $ DisplayAttrCaps -> Maybe CapExpression
    setAttrStates
                                                             (DisplayAttrCaps -> Maybe CapExpression)
    -> DisplayAttrCaps -> Maybe CapExpression
    forall a b. (a -> b) -> a -> b
    $ TerminfoCaps -> DisplayAttrCaps
    displayAttrCaps TerminfoCaps
    terminfoCaps
                                                   )
                                                   (DisplayAttrState -> [CapParam]
    sgrArgsForState DisplayAttrState
    state)
                                      Write -> Write -> Write
    forall a. Monoid a => a -> a -> a
    `mappend` Write
    setItalics
                                      Write -> Write -> Write
    forall a. Monoid a => a -> a -> a
    `mappend` Write
    setStrikethrough
                                      Write -> Write -> Write
    forall a. Monoid a => a -> a -> a
    `mappend` Write
    setColors
        where
            urlAttrs :: Bool -> Write
    urlAttrs Bool
    True = URLDiff -> Write
    writeURLEscapes (DisplayAttrDiff -> URLDiff
    urlDiff DisplayAttrDiff
    diffs)
            urlAttrs Bool
    False = Write
    forall a. Monoid a => a
    mempty
            colorMap :: Color -> Int
    colorMap = case TerminfoCaps -> Bool
    useAltColorMap TerminfoCaps
    terminfoCaps of
                            Bool
    False -> Color -> Int
    ansiColorIndex
                            Bool
    True -> Color -> Int
    altColorIndex
            attr :: FixedAttr
    attr = FixedAttr -> Attr -> FixedAttr
    fixDisplayAttr FixedAttr
    prevAttr Attr
    reqAttr

            -- italics can't be set via SGR, so here we manually
            -- apply the enter and exit sequences as needed after
            -- changing the SGR
            setItalics :: Write
    setItalics
              | Word8 -> Word8 -> Bool
    hasStyle (FixedAttr -> Word8
    fixedStyle FixedAttr
    attr) Word8
    italic
              , Just CapExpression
    sitm <- DisplayAttrCaps -> Maybe CapExpression
    enterItalic (TerminfoCaps -> DisplayAttrCaps
    displayAttrCaps TerminfoCaps
    terminfoCaps)
              = CapExpression -> [CapParam] -> Write
    writeCapExpr CapExpression
    sitm []
              | Bool
    otherwise = Write
    forall a. Monoid a => a
    mempty
            setStrikethrough :: Write
    setStrikethrough
              | Word8 -> Word8 -> Bool
    hasStyle (FixedAttr -> Word8
    fixedStyle FixedAttr
    attr) Word8
    strikethrough
              , Just CapExpression
    smxx <- DisplayAttrCaps -> Maybe CapExpression
    enterStrikethrough (TerminfoCaps -> DisplayAttrCaps
    displayAttrCaps TerminfoCaps
    terminfoCaps)
              = CapExpression -> [CapParam] -> Write
    writeCapExpr CapExpression
    smxx []
              | Bool
    otherwise = Write
    forall a. Monoid a => a
    mempty
            setColors :: Write
    setColors =
                (case FixedAttr -> Maybe Color
    fixedForeColor FixedAttr
    attr of
                    Just Color
    c -> ColorSide -> Color -> Write
    writeColor ColorSide
    Foreground Color
    c
                    Maybe Color
    Nothing -> Write
    forall a. Monoid a => a
    mempty)
                Write -> Write -> Write
    forall a. Monoid a => a -> a -> a
    `mappend`
                (case FixedAttr -> Maybe Color
    fixedBackColor FixedAttr
    attr of
                    Just Color
    c -> ColorSide -> Color -> Write
    writeColor ColorSide
    Background Color
    c
                    Maybe Color
    Nothing -> Write
    forall a. Monoid a => a
    mempty)
            writeColorDiff :: ColorSide -> DisplayColorDiff -> Write
    writeColorDiff ColorSide
    _side DisplayColorDiff
    NoColorChange
                = Write
    forall a. Monoid a => a
    mempty
            writeColorDiff ColorSide
    _side DisplayColorDiff
    ColorToDefault
                = [Char] -> Write
    forall a. HasCallStack => [Char] -> a
    error [Char]
    "ColorToDefault is not a possible case for applyColorDiffs"
            writeColorDiff ColorSide
    side (SetColor Color
    c)
                = ColorSide -> Color -> Write
    writeColor ColorSide
    side Color
    c

            writeColor :: ColorSide -> Color -> Write
    writeColor ColorSide
    side (RGBColor Word8
    r Word8
    g Word8
    b) =
                case Output -> ColorMode
    outputColorMode (DisplayContext -> Output
    contextDevice DisplayContext
    dc) of
                    ColorMode
    FullColor ->
                        ColorSide -> (Word8, Word8, Word8) -> Write
    hardcodeColor ColorSide
    side (Word8
    r, Word8
    g, Word8
    b)
                    ColorMode
    _ ->
                        [Char] -> Write
    forall a. HasCallStack => [Char] -> a
    error [Char]
    "clampColor should remove rgb colors in standard mode"
            writeColor ColorSide
    side Color
    c =
                CapExpression -> [CapParam] -> Write
    writeCapExpr (ColorSide -> TerminfoCaps -> CapExpression
    setSideColor ColorSide
    side TerminfoCaps
    terminfoCaps) [Int -> CapParam
    forall a. Enum a => Int -> a
    toEnum (Int -> CapParam) -> Int -> CapParam
    forall a b. (a -> b) -> a -> b
    $ Color -> Int
    colorMap Color
    c]

    -- a color can either be in the foreground or the background
    data ColorSide = Foreground | Background

    -- get the capability for drawing a color on a specific side
    setSideColor :: ColorSide -> TerminfoCaps -> CapExpression
    setSideColor :: ColorSide -> TerminfoCaps -> CapExpression
    setSideColor ColorSide
    Foreground = TerminfoCaps -> CapExpression
    setForeColor
    setSideColor ColorSide
    Background = TerminfoCaps -> CapExpression
    setBackColor

    hardcodeColor :: ColorSide -> (Word8, Word8, Word8) -> Write
    hardcodeColor :: ColorSide -> (Word8, Word8, Word8) -> Write
    hardcodeColor ColorSide
    side (Word8
    r, Word8
    g, Word8
    b) =
        -- hardcoded color codes are formatted as "\x1b[{side};2;{r};{g};{b}m"
        [Write] -> Write
    forall a. Monoid a => [a] -> a
    mconcat [ [Char] -> Write
    writeStr [Char]
    "\x1b[", Write
    sideCode, Write
    delimiter, Char -> Write
    writeChar Char
    '2', Write
    delimiter
                , Word8 -> Write
    writeColor Word8
    r, Write
    delimiter, Word8 -> Write
    writeColor Word8
    g, Write
    delimiter, Word8 -> Write
    writeColor Word8
    b
                , Char -> Write
    writeChar Char
    'm']
        where
            writeChar :: Char -> Write
    writeChar = Word8 -> Write
    writeWord8 (Word8 -> Write) -> (Char -> Word8) -> Char -> Write
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> Word8
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Int -> Word8) -> (Char -> Int) -> Char -> Word8
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Char -> Int
    forall a. Enum a => a -> Int
    fromEnum
            writeStr :: [Char] -> Write
    writeStr = [Write] -> Write
    forall a. Monoid a => [a] -> a
    mconcat ([Write] -> Write) -> ([Char] -> [Write]) -> [Char] -> Write
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Char -> Write) -> [Char] -> [Write]
    forall a b. (a -> b) -> [a] -> [b]
    map Char -> Write
    writeChar
            writeColor :: Word8 -> Write
    writeColor = [Char] -> Write
    writeStr ([Char] -> Write) -> (Word8 -> [Char]) -> Word8 -> Write
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Word8 -> [Char]
    forall a. Show a => a -> [Char]
    show
            delimiter :: Write
    delimiter = Char -> Write
    writeChar Char
    ';'
            -- 38/48 are used to set whether we should write to the
            -- foreground/background. I really don't want to know why.
            sideCode :: Write
    sideCode = case ColorSide
    side of
                ColorSide
    Foreground -> [Char] -> Write
    writeStr [Char]
    "38"
                ColorSide
    Background -> [Char] -> Write
    writeStr [Char]
    "48"

    -- | The color table used by a terminal is a 16 color set followed by a
    -- 240 color set that might not be supported by the terminal.
    --
    -- This takes a Color which clearly identifies which palette to use and
    -- computes the index into the full 256 color palette.
    ansiColorIndex :: Color -> Int
    ansiColorIndex :: Color -> Int
    ansiColorIndex (ISOColor Word8
    v) = Word8 -> Int
    forall a. Enum a => a -> Int
    fromEnum Word8
    v
    ansiColorIndex (Color240 Word8
    v) = Int
    16 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Word8 -> Int
    forall a. Enum a => a -> Int
    fromEnum Word8
    v
    ansiColorIndex (RGBColor Word8
    _ Word8
    _ Word8
    _) =
        [Char] -> Int
    forall a. HasCallStack => [Char] -> a
    error ([Char] -> Int) -> [Char] -> Int
    forall a b. (a -> b) -> a -> b
    $ [[Char]] -> [Char]
    unlines [ [Char]
    "Attempted to create color index from rgb color."
                        , [Char]
    "This is currently unsupported, and shouldn't ever happen"
                        ]

    -- | For terminals without setaf/setab
    --
    -- See table in `man terminfo`
    -- Will error if not in table.
    altColorIndex :: Color -> Int
    altColorIndex :: Color -> Int
    altColorIndex (ISOColor Word8
    0) = Int
    0
    altColorIndex (ISOColor Word8
    1) = Int
    4
    altColorIndex (ISOColor Word8
    2) = Int
    2
    altColorIndex (ISOColor Word8
    3) = Int
    6
    altColorIndex (ISOColor Word8
    4) = Int
    1
    altColorIndex (ISOColor Word8
    5) = Int
    5
    altColorIndex (ISOColor Word8
    6) = Int
    3
    altColorIndex (ISOColor Word8
    7) = Int
    7
    altColorIndex (ISOColor Word8
    v) = Word8 -> Int
    forall a. Enum a => a -> Int
    fromEnum Word8
    v
    altColorIndex (Color240 Word8
    v) = Int
    16 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Word8 -> Int
    forall a. Enum a => a -> Int
    fromEnum Word8
    v
    altColorIndex (RGBColor Word8
    _ Word8
    _ Word8
    _) =
        [Char] -> Int
    forall a. HasCallStack => [Char] -> a
    error ([Char] -> Int) -> [Char] -> Int
    forall a b. (a -> b) -> a -> b
    $ [[Char]] -> [Char]
    unlines [ [Char]
    "Attempted to create color index from rgb color."
                        , [Char]
    "This is currently unsupported, and shouldn't ever happen"
                        ]

    {- | The sequence of terminfo caps to apply a given style are determined
     - according to these rules.
     -
     -  1. The assumption is that it's preferable to use the simpler
     -  enter/exit mode capabilities than the full set display attribute
     -  state capability.
     -
     -  2. If a mode is supposed to be removed but there is not an exit
     -  capability defined then the display attributes are reset to defaults
     -  then the display attribute state is set.
     -
     -  3. If a mode is supposed to be applied but there is not an enter
     -  capability defined then then display attribute state is set if
     -  possible. Otherwise the mode is not applied.
     -
     -  4. If the display attribute state is being set then just update the
     -  arguments to that for any apply/remove.
     -}
    data DisplayAttrSeq
        = EnterExitSeq [CapExpression]
        | SetState DisplayAttrState

    data DisplayAttrState = DisplayAttrState
        { DisplayAttrState -> Bool
    applyStandout :: Bool
        , DisplayAttrState -> Bool
    applyUnderline :: Bool
        , DisplayAttrState -> Bool
    applyItalic :: Bool
        , DisplayAttrState -> Bool
    applyStrikethrough :: Bool
        , DisplayAttrState -> Bool
    applyReverseVideo :: Bool
        , DisplayAttrState -> Bool
    applyBlink :: Bool
        , DisplayAttrState -> Bool
    applyDim :: Bool
        , DisplayAttrState -> Bool
    applyBold :: Bool
        }

    sgrArgsForState :: DisplayAttrState -> [CapParam]
    sgrArgsForState :: DisplayAttrState -> [CapParam]
    sgrArgsForState DisplayAttrState
    attrState = (Bool -> CapParam) -> [Bool] -> [CapParam]
    forall a b. (a -> b) -> [a] -> [b]
    map (\Bool
    b -> if Bool
    b then CapParam
    1 else CapParam
    0)
        [ DisplayAttrState -> Bool
    applyStandout DisplayAttrState
    attrState
        , DisplayAttrState -> Bool
    applyUnderline DisplayAttrState
    attrState
        , DisplayAttrState -> Bool
    applyReverseVideo DisplayAttrState
    attrState
        , DisplayAttrState -> Bool
    applyBlink DisplayAttrState
    attrState
        , DisplayAttrState -> Bool
    applyDim DisplayAttrState
    attrState
        , DisplayAttrState -> Bool
    applyBold DisplayAttrState
    attrState
        , Bool
    False -- invis
        , Bool
    False -- protect
        , Bool
    False -- alt char set
        ]

    reqDisplayCapSeqFor :: DisplayAttrCaps -> Style -> [StyleStateChange] -> DisplayAttrSeq
    reqDisplayCapSeqFor :: DisplayAttrCaps -> Word8 -> [StyleStateChange] -> DisplayAttrSeq
    reqDisplayCapSeqFor DisplayAttrCaps
    caps Word8
    s [StyleStateChange]
    diffs
        -- if the state transition implied by any diff cannot be supported
        -- with an enter/exit mode cap then either the state needs to be set
        -- or the attribute change ignored.
        = case ((StyleStateChange -> Bool) -> [StyleStateChange] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any StyleStateChange -> Bool
    noEnterExitCap [StyleStateChange]
    diffs, Maybe CapExpression -> Bool
    forall a. Maybe a -> Bool
    isJust (Maybe CapExpression -> Bool) -> Maybe CapExpression -> Bool
    forall a b. (a -> b) -> a -> b
    $ DisplayAttrCaps -> Maybe CapExpression
    setAttrStates DisplayAttrCaps
    caps) of
            -- If all the diffs have an enter-exit cap then just use those
            ( Bool
    False, Bool
    _    ) -> [CapExpression] -> DisplayAttrSeq
    EnterExitSeq ([CapExpression] -> DisplayAttrSeq)
    -> [CapExpression] -> DisplayAttrSeq
    forall a b. (a -> b) -> a -> b
    $ (StyleStateChange -> CapExpression)
    -> [StyleStateChange] -> [CapExpression]
    forall a b. (a -> b) -> [a] -> [b]
    map StyleStateChange -> CapExpression
    enterExitCap [StyleStateChange]
    diffs
            -- If not all the diffs have an enter-exit cap and there is no
            -- set state cap then filter out all unsupported diffs and just
            -- apply the rest
            ( Bool
    True, Bool
    False ) -> [CapExpression] -> DisplayAttrSeq
    EnterExitSeq ([CapExpression] -> DisplayAttrSeq)
    -> [CapExpression] -> DisplayAttrSeq
    forall a b. (a -> b) -> a -> b
    $ (StyleStateChange -> CapExpression)
    -> [StyleStateChange] -> [CapExpression]
    forall a b. (a -> b) -> [a] -> [b]
    map StyleStateChange -> CapExpression
    enterExitCap
                                            ([StyleStateChange] -> [CapExpression])
    -> [StyleStateChange] -> [CapExpression]
    forall a b. (a -> b) -> a -> b
    $ (StyleStateChange -> Bool)
    -> [StyleStateChange] -> [StyleStateChange]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (Bool -> Bool
    not (Bool -> Bool)
    -> (StyleStateChange -> Bool) -> StyleStateChange -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . StyleStateChange -> Bool
    noEnterExitCap) [StyleStateChange]
    diffs
            -- if not all the diffs have an enter-exit can and there is a
            -- set state cap then just use the set state cap.
            ( Bool
    True, Bool
    True  ) -> DisplayAttrState -> DisplayAttrSeq
    SetState (DisplayAttrState -> DisplayAttrSeq)
    -> DisplayAttrState -> DisplayAttrSeq
    forall a b. (a -> b) -> a -> b
    $ Word8 -> DisplayAttrState
    stateForStyle Word8
    s
        where
            noEnterExitCap :: StyleStateChange -> Bool
    noEnterExitCap StyleStateChange
    ApplyStrikethrough = Maybe CapExpression -> Bool
    forall a. Maybe a -> Bool
    isNothing (Maybe CapExpression -> Bool) -> Maybe CapExpression -> Bool
    forall a b. (a -> b) -> a -> b
    $ DisplayAttrCaps -> Maybe CapExpression
    enterStrikethrough DisplayAttrCaps
    caps
            noEnterExitCap StyleStateChange
    RemoveStrikethrough = Maybe CapExpression -> Bool
    forall a. Maybe a -> Bool
    isNothing (Maybe CapExpression -> Bool) -> Maybe CapExpression -> Bool
    forall a b. (a -> b) -> a -> b
    $ DisplayAttrCaps -> Maybe CapExpression
    exitStrikethrough DisplayAttrCaps
    caps
            noEnterExitCap StyleStateChange
    ApplyItalic = Maybe CapExpression -> Bool
    forall a. Maybe a -> Bool
    isNothing (Maybe CapExpression -> Bool) -> Maybe CapExpression -> Bool
    forall a b. (a -> b) -> a -> b
    $ DisplayAttrCaps -> Maybe CapExpression
    enterItalic DisplayAttrCaps
    caps
            noEnterExitCap StyleStateChange
    RemoveItalic = Maybe CapExpression -> Bool
    forall a. Maybe a -> Bool
    isNothing (Maybe CapExpression -> Bool) -> Maybe CapExpression -> Bool
    forall a b. (a -> b) -> a -> b
    $ DisplayAttrCaps -> Maybe CapExpression
    exitItalic DisplayAttrCaps
    caps
            noEnterExitCap StyleStateChange
    ApplyStandout = Maybe CapExpression -> Bool
    forall a. Maybe a -> Bool
    isNothing (Maybe CapExpression -> Bool) -> Maybe CapExpression -> Bool
    forall a b. (a -> b) -> a -> b
    $ DisplayAttrCaps -> Maybe CapExpression
    enterStandout DisplayAttrCaps
    caps
            noEnterExitCap StyleStateChange
    RemoveStandout = Maybe CapExpression -> Bool
    forall a. Maybe a -> Bool
    isNothing (Maybe CapExpression -> Bool) -> Maybe CapExpression -> Bool
    forall a b. (a -> b) -> a -> b
    $ DisplayAttrCaps -> Maybe CapExpression
    exitStandout DisplayAttrCaps
    caps
            noEnterExitCap StyleStateChange
    ApplyUnderline = Maybe CapExpression -> Bool
    forall a. Maybe a -> Bool
    isNothing (Maybe CapExpression -> Bool) -> Maybe CapExpression -> Bool
    forall a b. (a -> b) -> a -> b
    $ DisplayAttrCaps -> Maybe CapExpression
    enterUnderline DisplayAttrCaps
    caps
            noEnterExitCap StyleStateChange
    RemoveUnderline = Maybe CapExpression -> Bool
    forall a. Maybe a -> Bool
    isNothing (Maybe CapExpression -> Bool) -> Maybe CapExpression -> Bool
    forall a b. (a -> b) -> a -> b
    $ DisplayAttrCaps -> Maybe CapExpression
    exitUnderline DisplayAttrCaps
    caps
            noEnterExitCap StyleStateChange
    ApplyReverseVideo = Maybe CapExpression -> Bool
    forall a. Maybe a -> Bool
    isNothing (Maybe CapExpression -> Bool) -> Maybe CapExpression -> Bool
    forall a b. (a -> b) -> a -> b
    $ DisplayAttrCaps -> Maybe CapExpression
    enterReverseVideo DisplayAttrCaps
    caps
            noEnterExitCap StyleStateChange
    RemoveReverseVideo = Bool
    True
            noEnterExitCap StyleStateChange
    ApplyBlink = Bool
    True
            noEnterExitCap StyleStateChange
    RemoveBlink = Bool
    True
            noEnterExitCap StyleStateChange
    ApplyDim = Maybe CapExpression -> Bool
    forall a. Maybe a -> Bool
    isNothing (Maybe CapExpression -> Bool) -> Maybe CapExpression -> Bool
    forall a b. (a -> b) -> a -> b
    $ DisplayAttrCaps -> Maybe CapExpression
    enterDimMode DisplayAttrCaps
    caps
            noEnterExitCap StyleStateChange
    RemoveDim = Bool
    True
            noEnterExitCap StyleStateChange
    ApplyBold = Maybe CapExpression -> Bool
    forall a. Maybe a -> Bool
    isNothing (Maybe CapExpression -> Bool) -> Maybe CapExpression -> Bool
    forall a b. (a -> b) -> a -> b
    $ DisplayAttrCaps -> Maybe CapExpression
    enterBoldMode DisplayAttrCaps
    caps
            noEnterExitCap StyleStateChange
    RemoveBold = Bool
    True
            enterExitCap :: StyleStateChange -> CapExpression
    enterExitCap StyleStateChange
    ApplyStrikethrough = Maybe CapExpression -> CapExpression
    forall a. HasCallStack => Maybe a -> a
    fromJust (Maybe CapExpression -> CapExpression)
    -> Maybe CapExpression -> CapExpression
    forall a b. (a -> b) -> a -> b
    $ DisplayAttrCaps -> Maybe CapExpression
    enterStrikethrough DisplayAttrCaps
    caps
            enterExitCap StyleStateChange
    RemoveStrikethrough = Maybe CapExpression -> CapExpression
    forall a. HasCallStack => Maybe a -> a
    fromJust (Maybe CapExpression -> CapExpression)
    -> Maybe CapExpression -> CapExpression
    forall a b. (a -> b) -> a -> b
    $ DisplayAttrCaps -> Maybe CapExpression
    exitStrikethrough DisplayAttrCaps
    caps
            enterExitCap StyleStateChange
    ApplyItalic = Maybe CapExpression -> CapExpression
    forall a. HasCallStack => Maybe a -> a
    fromJust (Maybe CapExpression -> CapExpression)
    -> Maybe CapExpression -> CapExpression
    forall a b. (a -> b) -> a -> b
    $ DisplayAttrCaps -> Maybe CapExpression
    enterItalic DisplayAttrCaps
    caps
            enterExitCap StyleStateChange
    RemoveItalic = Maybe CapExpression -> CapExpression
    forall a. HasCallStack => Maybe a -> a
    fromJust (Maybe CapExpression -> CapExpression)
    -> Maybe CapExpression -> CapExpression
    forall a b. (a -> b) -> a -> b
    $ DisplayAttrCaps -> Maybe CapExpression
    exitItalic DisplayAttrCaps
    caps
            enterExitCap StyleStateChange
    ApplyStandout = Maybe CapExpression -> CapExpression
    forall a. HasCallStack => Maybe a -> a
    fromJust (Maybe CapExpression -> CapExpression)
    -> Maybe CapExpression -> CapExpression
    forall a b. (a -> b) -> a -> b
    $ DisplayAttrCaps -> Maybe CapExpression
    enterStandout DisplayAttrCaps
    caps
            enterExitCap StyleStateChange
    RemoveStandout = Maybe CapExpression -> CapExpression
    forall a. HasCallStack => Maybe a -> a
    fromJust (Maybe CapExpression -> CapExpression)
    -> Maybe CapExpression -> CapExpression
    forall a b. (a -> b) -> a -> b
    $ DisplayAttrCaps -> Maybe CapExpression
    exitStandout DisplayAttrCaps
    caps
            enterExitCap StyleStateChange
    ApplyUnderline = Maybe CapExpression -> CapExpression
    forall a. HasCallStack => Maybe a -> a
    fromJust (Maybe CapExpression -> CapExpression)
    -> Maybe CapExpression -> CapExpression
    forall a b. (a -> b) -> a -> b
    $ DisplayAttrCaps -> Maybe CapExpression
    enterUnderline DisplayAttrCaps
    caps
            enterExitCap StyleStateChange
    RemoveUnderline = Maybe CapExpression -> CapExpression
    forall a. HasCallStack => Maybe a -> a
    fromJust (Maybe CapExpression -> CapExpression)
    -> Maybe CapExpression -> CapExpression
    forall a b. (a -> b) -> a -> b
    $ DisplayAttrCaps -> Maybe CapExpression
    exitUnderline DisplayAttrCaps
    caps
            enterExitCap StyleStateChange
    ApplyReverseVideo = Maybe CapExpression -> CapExpression
    forall a. HasCallStack => Maybe a -> a
    fromJust (Maybe CapExpression -> CapExpression)
    -> Maybe CapExpression -> CapExpression
    forall a b. (a -> b) -> a -> b
    $ DisplayAttrCaps -> Maybe CapExpression
    enterReverseVideo DisplayAttrCaps
    caps
            enterExitCap StyleStateChange
    ApplyDim = Maybe CapExpression -> CapExpression
    forall a. HasCallStack => Maybe a -> a
    fromJust (Maybe CapExpression -> CapExpression)
    -> Maybe CapExpression -> CapExpression
    forall a b. (a -> b) -> a -> b
    $ DisplayAttrCaps -> Maybe CapExpression
    enterDimMode DisplayAttrCaps
    caps
            enterExitCap StyleStateChange
    ApplyBold = Maybe CapExpression -> CapExpression
    forall a. HasCallStack => Maybe a -> a
    fromJust (Maybe CapExpression -> CapExpression)
    -> Maybe CapExpression -> CapExpression
    forall a b. (a -> b) -> a -> b
    $ DisplayAttrCaps -> Maybe CapExpression
    enterBoldMode DisplayAttrCaps
    caps
            enterExitCap StyleStateChange
    _ = [Char] -> CapExpression
    forall a. HasCallStack => [Char] -> a
    error [Char]
    "enterExitCap applied to diff that was known not to have one."

    stateForStyle :: Style -> DisplayAttrState
    stateForStyle :: Word8 -> DisplayAttrState
    stateForStyle Word8
    s = DisplayAttrState
        { applyStandout :: Bool
    applyStandout = Word8 -> Bool
    isStyleSet Word8
    standout
        , applyUnderline :: Bool
    applyUnderline = Word8 -> Bool
    isStyleSet Word8
    underline
        , applyItalic :: Bool
    applyItalic = Word8 -> Bool
    isStyleSet Word8
    italic
        , applyStrikethrough :: Bool
    applyStrikethrough = Word8 -> Bool
    isStyleSet Word8
    strikethrough
        , applyReverseVideo :: Bool
    applyReverseVideo = Word8 -> Bool
    isStyleSet Word8
    reverseVideo
        , applyBlink :: Bool
    applyBlink = Word8 -> Bool
    isStyleSet Word8
    blink
        , applyDim :: Bool
    applyDim = Word8 -> Bool
    isStyleSet Word8
    dim
        , applyBold :: Bool
    applyBold = Word8 -> Bool
    isStyleSet Word8
    bold
        }
        where isStyleSet :: Word8 -> Bool
    isStyleSet = Word8 -> Word8 -> Bool
    hasStyle Word8
    s

    styleToApplySeq :: Style -> [StyleStateChange]
    styleToApplySeq :: Word8 -> [StyleStateChange]
    styleToApplySeq Word8
    s = [[StyleStateChange]] -> [StyleStateChange]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat
        [ StyleStateChange -> Word8 -> [StyleStateChange]
    forall {a}. a -> Word8 -> [a]
    applyIfRequired StyleStateChange
    ApplyStandout Word8
    standout
        , StyleStateChange -> Word8 -> [StyleStateChange]
    forall {a}. a -> Word8 -> [a]
    applyIfRequired StyleStateChange
    ApplyUnderline Word8
    underline
        , StyleStateChange -> Word8 -> [StyleStateChange]
    forall {a}. a -> Word8 -> [a]
    applyIfRequired StyleStateChange
    ApplyItalic Word8
    italic
        , StyleStateChange -> Word8 -> [StyleStateChange]
    forall {a}. a -> Word8 -> [a]
    applyIfRequired StyleStateChange
    ApplyStrikethrough Word8
    strikethrough
        , StyleStateChange -> Word8 -> [StyleStateChange]
    forall {a}. a -> Word8 -> [a]
    applyIfRequired StyleStateChange
    ApplyReverseVideo Word8
    reverseVideo
        , StyleStateChange -> Word8 -> [StyleStateChange]
    forall {a}. a -> Word8 -> [a]
    applyIfRequired StyleStateChange
    ApplyBlink Word8
    blink
        , StyleStateChange -> Word8 -> [StyleStateChange]
    forall {a}. a -> Word8 -> [a]
    applyIfRequired StyleStateChange
    ApplyDim Word8
    dim
        , StyleStateChange -> Word8 -> [StyleStateChange]
    forall {a}. a -> Word8 -> [a]
    applyIfRequired StyleStateChange
    ApplyBold Word8
    bold
        ]
        where
            applyIfRequired :: a -> Word8 -> [a]
    applyIfRequired a
    op Word8
    flag
                = if Word8
    0 Word8 -> Word8 -> Bool
    forall a. Eq a => a -> a -> Bool
    == (Word8
    flag Word8 -> Word8 -> Word8
    forall a. Bits a => a -> a -> a
    .&. Word8
    s)
                    then []
                    else [a
    op]