    {-# LANGUAGE RecordWildCards #-}
    {-# 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
      )
    where

    import Control.Monad (when)
    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)

    import Data.Bits ((.&.))
    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
    supportsNoColors :: Bool
        , 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
    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 outFd :: Fd
    outFd ptr :: Ptr Word8
    ptr len :: Int
    len count :: Int
    count
        | Int
    len Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <  0  = String -> IO Int
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail "fdWriteAll: len is less than 0"
        | Int
    len Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == 0  = Int -> IO Int
    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 t :: Output
    t cap :: CapExpression
    cap capParams :: [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 -> IO Output
    reserveTerminal :: String -> Fd -> IO Output
    reserveTerminal termName :: String
    termName outFd :: Fd
    outFd = do
        Terminal
    ti <- String -> IO Terminal
    Terminfo.setupTerm String
    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 -> String -> IO (Maybe CapExpression)
    probeCap Terminal
    ti "setaf"
        Maybe CapExpression
    msetf <- Terminal -> String -> IO (Maybe CapExpression)
    probeCap Terminal
    ti "setf"
        let (noColors :: Bool
    noColors, useAlt :: Bool
    useAlt, setForeCap :: CapExpression
    setForeCap)
                = case Maybe CapExpression
    msetaf of
                    Just setaf :: CapExpression
    setaf -> (Bool
    False, Bool
    False, CapExpression
    setaf)
                    Nothing -> case Maybe CapExpression
    msetf of
                        Just setf :: CapExpression
    setf -> (Bool
    False, Bool
    True, CapExpression
    setf)
                        Nothing -> (Bool
    True, Bool
    True, String -> CapExpression
    forall a. HasCallStack => String -> a
    error (String -> CapExpression) -> String -> CapExpression
    forall a b. (a -> b) -> a -> b
    $ "no fore color support for terminal " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    termName)
        Maybe CapExpression
    msetab <- Terminal -> String -> IO (Maybe CapExpression)
    probeCap Terminal
    ti "setab"
        Maybe CapExpression
    msetb <- Terminal -> String -> IO (Maybe CapExpression)
    probeCap Terminal
    ti "setb"
        let set_back_cap :: CapExpression
    set_back_cap
                = case Maybe CapExpression
    msetab of
                    Nothing -> case Maybe CapExpression
    msetb of
                        Just setb :: CapExpression
    setb -> CapExpression
    setb
                        Nothing -> String -> CapExpression
    forall a. HasCallStack => String -> a
    error (String -> CapExpression) -> String -> CapExpression
    forall a b. (a -> b) -> a -> b
    $ "no back color support for terminal " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    termName
                    Just setab :: CapExpression
    setab -> CapExpression
    setab

        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 m :: Mode
    m newStatus :: 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
                      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
                      _ -> () -> IO ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
            terminfoModeStatus :: Mode -> IO Bool
    terminfoModeStatus m :: Mode
    m =
                case Mode
    m of
                    Hyperlink -> IORef Bool -> IO Bool
    forall a. IORef a -> IO a
    readIORef IORef Bool
    hyperlinkModeStatus
                    _ -> Bool -> IO Bool
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    False
            terminfoModeSupported :: Mode -> Bool
    terminfoModeSupported Hyperlink = Bool
    True
            terminfoModeSupported _ = Bool
    False

        TerminfoCaps
    terminfoCaps <- (Maybe CapExpression
     -> Maybe CapExpression
     -> CapExpression
     -> Maybe CapExpression
     -> Maybe CapExpression
     -> Bool
     -> Bool
     -> CapExpression
     -> CapExpression
     -> CapExpression
     -> CapExpression
     -> CapExpression
     -> DisplayAttrCaps
     -> Maybe CapExpression
     -> TerminfoCaps)
    -> IO
         (Maybe CapExpression
          -> Maybe CapExpression
          -> CapExpression
          -> Maybe CapExpression
          -> Maybe CapExpression
          -> Bool
          -> Bool
          -> CapExpression
          -> CapExpression
          -> CapExpression
          -> CapExpression
          -> CapExpression
          -> DisplayAttrCaps
          -> Maybe CapExpression
          -> TerminfoCaps)
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Maybe CapExpression
    -> Maybe CapExpression
    -> CapExpression
    -> Maybe CapExpression
    -> Maybe CapExpression
    -> Bool
    -> Bool
    -> CapExpression
    -> CapExpression
    -> CapExpression
    -> CapExpression
    -> CapExpression
    -> DisplayAttrCaps
    -> Maybe CapExpression
    -> TerminfoCaps
    TerminfoCaps
            IO
      (Maybe CapExpression
       -> Maybe CapExpression
       -> CapExpression
       -> Maybe CapExpression
       -> Maybe CapExpression
       -> Bool
       -> Bool
       -> CapExpression
       -> CapExpression
       -> CapExpression
       -> CapExpression
       -> CapExpression
       -> DisplayAttrCaps
       -> Maybe CapExpression
       -> TerminfoCaps)
    -> IO (Maybe CapExpression)
    -> IO
         (Maybe CapExpression
          -> CapExpression
          -> Maybe CapExpression
          -> Maybe CapExpression
          -> Bool
          -> Bool
          -> CapExpression
          -> CapExpression
          -> CapExpression
          -> CapExpression
          -> CapExpression
          -> DisplayAttrCaps
          -> Maybe CapExpression
          -> TerminfoCaps)
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Terminal -> String -> IO (Maybe CapExpression)
    probeCap Terminal
    ti "smcup"
            IO
      (Maybe CapExpression
       -> CapExpression
       -> Maybe CapExpression
       -> Maybe CapExpression
       -> Bool
       -> Bool
       -> CapExpression
       -> CapExpression
       -> CapExpression
       -> CapExpression
       -> CapExpression
       -> DisplayAttrCaps
       -> Maybe CapExpression
       -> TerminfoCaps)
    -> IO (Maybe CapExpression)
    -> IO
         (CapExpression
          -> Maybe CapExpression
          -> Maybe CapExpression
          -> Bool
          -> Bool
          -> CapExpression
          -> CapExpression
          -> CapExpression
          -> CapExpression
          -> CapExpression
          -> DisplayAttrCaps
          -> Maybe CapExpression
          -> TerminfoCaps)
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Terminal -> String -> IO (Maybe CapExpression)
    probeCap Terminal
    ti "rmcup"
            IO
      (CapExpression
       -> Maybe CapExpression
       -> Maybe CapExpression
       -> Bool
       -> Bool
       -> CapExpression
       -> CapExpression
       -> CapExpression
       -> CapExpression
       -> CapExpression
       -> DisplayAttrCaps
       -> Maybe CapExpression
       -> TerminfoCaps)
    -> IO CapExpression
    -> IO
         (Maybe CapExpression
          -> Maybe CapExpression
          -> Bool
          -> Bool
          -> CapExpression
          -> CapExpression
          -> CapExpression
          -> CapExpression
          -> CapExpression
          -> DisplayAttrCaps
          -> Maybe CapExpression
          -> TerminfoCaps)
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Terminal -> String -> IO CapExpression
    requireCap Terminal
    ti "cup"
            IO
      (Maybe CapExpression
       -> Maybe CapExpression
       -> Bool
       -> Bool
       -> CapExpression
       -> CapExpression
       -> CapExpression
       -> CapExpression
       -> CapExpression
       -> DisplayAttrCaps
       -> Maybe CapExpression
       -> TerminfoCaps)
    -> IO (Maybe CapExpression)
    -> IO
         (Maybe CapExpression
          -> Bool
          -> Bool
          -> CapExpression
          -> CapExpression
          -> CapExpression
          -> CapExpression
          -> CapExpression
          -> DisplayAttrCaps
          -> Maybe CapExpression
          -> TerminfoCaps)
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Terminal -> String -> IO (Maybe CapExpression)
    probeCap Terminal
    ti "cnorm"
            IO
      (Maybe CapExpression
       -> Bool
       -> Bool
       -> CapExpression
       -> CapExpression
       -> CapExpression
       -> CapExpression
       -> CapExpression
       -> DisplayAttrCaps
       -> Maybe CapExpression
       -> TerminfoCaps)
    -> IO (Maybe CapExpression)
    -> IO
         (Bool
          -> Bool
          -> CapExpression
          -> CapExpression
          -> CapExpression
          -> CapExpression
          -> CapExpression
          -> DisplayAttrCaps
          -> Maybe CapExpression
          -> TerminfoCaps)
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Terminal -> String -> IO (Maybe CapExpression)
    probeCap Terminal
    ti "civis"
            IO
      (Bool
       -> Bool
       -> CapExpression
       -> CapExpression
       -> CapExpression
       -> CapExpression
       -> CapExpression
       -> DisplayAttrCaps
       -> Maybe CapExpression
       -> TerminfoCaps)
    -> IO Bool
    -> IO
         (Bool
          -> CapExpression
          -> CapExpression
          -> CapExpression
          -> CapExpression
          -> CapExpression
          -> DisplayAttrCaps
          -> Maybe CapExpression
          -> TerminfoCaps)
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Bool -> IO Bool
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Bool
    noColors
            IO
      (Bool
       -> CapExpression
       -> CapExpression
       -> CapExpression
       -> CapExpression
       -> CapExpression
       -> DisplayAttrCaps
       -> Maybe CapExpression
       -> TerminfoCaps)
    -> IO Bool
    -> IO
         (CapExpression
          -> CapExpression
          -> CapExpression
          -> CapExpression
          -> CapExpression
          -> DisplayAttrCaps
          -> Maybe CapExpression
          -> TerminfoCaps)
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Bool -> IO Bool
    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 (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> CapExpression -> IO CapExpression
    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 (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> CapExpression -> IO CapExpression
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure CapExpression
    set_back_cap
            IO
      (CapExpression
       -> CapExpression
       -> CapExpression
       -> DisplayAttrCaps
       -> Maybe CapExpression
       -> TerminfoCaps)
    -> IO CapExpression
    -> IO
         (CapExpression
          -> CapExpression
          -> DisplayAttrCaps
          -> Maybe CapExpression
          -> TerminfoCaps)
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Terminal -> String -> IO CapExpression
    requireCap Terminal
    ti "sgr0"
            IO
      (CapExpression
       -> CapExpression
       -> DisplayAttrCaps
       -> Maybe CapExpression
       -> TerminfoCaps)
    -> IO CapExpression
    -> IO
         (CapExpression
          -> DisplayAttrCaps -> Maybe CapExpression -> TerminfoCaps)
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Terminal -> String -> IO CapExpression
    requireCap Terminal
    ti "clear"
            IO
      (CapExpression
       -> DisplayAttrCaps -> Maybe CapExpression -> TerminfoCaps)
    -> IO CapExpression
    -> IO (DisplayAttrCaps -> Maybe CapExpression -> TerminfoCaps)
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Terminal -> String -> IO CapExpression
    requireCap Terminal
    ti "el"
            IO (DisplayAttrCaps -> Maybe CapExpression -> TerminfoCaps)
    -> IO DisplayAttrCaps -> IO (Maybe CapExpression -> TerminfoCaps)
    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 (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Terminal -> String -> IO (Maybe CapExpression)
    probeCap Terminal
    ti "bel"
        let t :: Output
    t = Output :: String
    -> IO ()
    -> IO ()
    -> IO ()
    -> IO DisplayRegion
    -> (ByteString -> IO ())
    -> Int
    -> Bool
    -> (Mode -> Bool)
    -> (Mode -> Bool -> IO ())
    -> (Mode -> IO Bool)
    -> IORef AssumedState
    -> (Output -> DisplayRegion -> IO DisplayContext)
    -> IO ()
    -> IO Bool
    -> Output
    Output
                { terminalID :: String
    terminalID = String
    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 (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
                , 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 []
                , displayBounds :: IO DisplayRegion
    displayBounds = do
                    DisplayRegion
    rawSize <- Fd -> IO DisplayRegion
    getWindowSize Fd
    outFd
                    case DisplayRegion
    rawSize of
                        (w :: Int
    w, h :: Int
    h)  | Int
    w Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < 0 Bool -> Bool -> Bool
    || Int
    h Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < 0 -> String -> IO DisplayRegion
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail (String -> IO DisplayRegion) -> String -> IO DisplayRegion
    forall a b. (a -> b) -> a -> b
    $ "getwinsize returned < 0 : " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ DisplayRegion -> String
    forall a. Show a => a -> String
    show DisplayRegion
    rawSize
                                | Bool
    otherwise      -> DisplayRegion -> IO DisplayRegion
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Int
    w,Int
    h)
                , outputByteBuffer :: ByteString -> IO ()
    outputByteBuffer = \outBytes :: ByteString
    outBytes -> do
                    let (fptr :: ForeignPtr Word8
    fptr, offset :: Int
    offset, len :: 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 :: 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 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
    $ String -> IO ()
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail (String -> IO ()) -> String -> IO ()
    forall a b. (a -> b) -> a -> b
    $ "Graphics.Vty.Output: outputByteBuffer "
                      String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ "length mismatch. " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Int -> String
    forall a. Show a => a -> String
    show Int
    len String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ " /= " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Int -> String
    forall a. Show a => a -> String
    show Int
    actualLen
                      String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ " Please report this bug to vty project."
                , contextColorCount :: Int
    contextColorCount
                    = case TerminfoCaps -> Bool
    supportsNoColors TerminfoCaps
    terminfoCaps of
                        False -> case Terminal -> Capability Int -> Maybe Int
    forall a. Terminal -> Capability a -> Maybe a
    Terminfo.getCapability Terminal
    ti (String -> Capability Int
    Terminfo.tiGetNum "colors" ) of
                            Nothing -> 8
                            Just v :: Int
    v -> Int -> Int
    forall a. Enum a => Int -> a
    toEnum Int
    v
                        True -> 1
                , 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
                -- I think fix would help assure tActual is the only
                -- reference. I was having issues tho.
                , mkDisplayContext :: Output -> DisplayRegion -> IO DisplayContext
    mkDisplayContext = \tActual :: Output
    tActual -> Output -> TerminfoCaps -> DisplayRegion -> IO DisplayContext
    terminfoDisplayContext Output
    tActual TerminfoCaps
    terminfoCaps
                }
            sendCap :: (TerminfoCaps -> CapExpression) -> [CapParam] -> IO ()
    sendCap s :: TerminfoCaps -> CapExpression
    s = Output -> CapExpression -> [CapParam] -> IO ()
    sendCapToTerminal Output
    t (TerminfoCaps -> CapExpression
    s TerminfoCaps
    terminfoCaps)
            maybeSendCap :: (TerminfoCaps -> Maybe CapExpression) -> [CapParam] -> IO ()
    maybeSendCap s :: 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 (m :: * -> *) a. Monad m => a -> m a
    return Output
    t

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

    probeCap :: Terminfo.Terminal -> String -> IO (Maybe CapExpression)
    probeCap :: Terminal -> String -> IO (Maybe CapExpression)
    probeCap ti :: Terminal
    ti capName :: String
    capName
        = case Terminal -> Capability String -> Maybe String
    forall a. Terminal -> Capability a -> Maybe a
    Terminfo.getCapability Terminal
    ti (String -> Capability String
    Terminfo.tiGetStr String
    capName) of
            Nothing     -> Maybe CapExpression -> IO (Maybe CapExpression)
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe CapExpression
    forall a. Maybe a
    Nothing
            Just capStr :: String
    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
    <$> String -> IO CapExpression
    parseCap String
    capStr

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

    currentDisplayAttrCaps :: Terminfo.Terminal -> IO DisplayAttrCaps
    currentDisplayAttrCaps :: Terminal -> IO DisplayAttrCaps
    currentDisplayAttrCaps ti :: Terminal
    ti
        =   (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
          -> DisplayAttrCaps)
    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
    -> DisplayAttrCaps
    DisplayAttrCaps
        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 (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Terminal -> String -> IO (Maybe CapExpression)
    probeCap Terminal
    ti "sgr"
        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 (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Terminal -> String -> IO (Maybe CapExpression)
    probeCap Terminal
    ti "smso"
        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 (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Terminal -> String -> IO (Maybe CapExpression)
    probeCap Terminal
    ti "rmso"
        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 (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Terminal -> String -> IO (Maybe CapExpression)
    probeCap Terminal
    ti "sitm"
        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 (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Terminal -> String -> IO (Maybe CapExpression)
    probeCap Terminal
    ti "ritm"
        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 (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Terminal -> String -> IO (Maybe CapExpression)
    probeCap Terminal
    ti "smul"
        IO
      (Maybe CapExpression
       -> Maybe CapExpression
       -> Maybe CapExpression
       -> Maybe CapExpression
       -> DisplayAttrCaps)
    -> IO (Maybe CapExpression)
    -> IO
         (Maybe CapExpression
          -> Maybe CapExpression -> Maybe CapExpression -> DisplayAttrCaps)
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Terminal -> String -> IO (Maybe CapExpression)
    probeCap Terminal
    ti "rmul"
        IO
      (Maybe CapExpression
       -> Maybe CapExpression -> Maybe CapExpression -> DisplayAttrCaps)
    -> IO (Maybe CapExpression)
    -> IO
         (Maybe CapExpression -> Maybe CapExpression -> DisplayAttrCaps)
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Terminal -> String -> IO (Maybe CapExpression)
    probeCap Terminal
    ti "rev"
        IO (Maybe CapExpression -> Maybe CapExpression -> DisplayAttrCaps)
    -> IO (Maybe CapExpression)
    -> IO (Maybe CapExpression -> DisplayAttrCaps)
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Terminal -> String -> IO (Maybe CapExpression)
    probeCap Terminal
    ti "dim"
        IO (Maybe CapExpression -> DisplayAttrCaps)
    -> IO (Maybe CapExpression) -> IO DisplayAttrCaps
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Terminal -> String -> IO (Maybe CapExpression)
    probeCap Terminal
    ti "bold"

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

    getWindowSize :: Fd -> IO (Int,Int)
    getWindowSize :: Fd -> IO DisplayRegion
    getWindowSize fd :: Fd
    fd = do
        (a :: CLong
    a,b :: CLong
    b) <- (CLong -> CLong -> (CLong, CLong)
    forall a. Integral a => a -> a -> (a, a)
    `divMod` 65536) (CLong -> (CLong, CLong)) -> IO CLong -> IO (CLong, CLong)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    `fmap` Fd -> IO CLong
    c_getWindowSize Fd
    fd
        DisplayRegion -> IO DisplayRegion
    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)

    terminfoDisplayContext :: Output -> TerminfoCaps -> DisplayRegion -> IO DisplayContext
    terminfoDisplayContext :: Output -> TerminfoCaps -> DisplayRegion -> IO DisplayContext
    terminfoDisplayContext tActual :: Output
    tActual terminfoCaps :: TerminfoCaps
    terminfoCaps r :: DisplayRegion
    r = DisplayContext -> IO DisplayContext
    forall (m :: * -> *) a. Monad m => a -> m a
    return DisplayContext
    dc
        where dc :: DisplayContext
    dc = DisplayContext :: Output
    -> DisplayRegion
    -> (Int -> Int -> Write)
    -> Write
    -> Write
    -> (Bool -> FixedAttr -> Attr -> DisplayAttrDiff -> Write)
    -> (Bool -> Write)
    -> Write
    -> IO ()
    -> DisplayContext
    DisplayContext
                { contextDevice :: Output
    contextDevice = Output
    tActual
                , contextRegion :: DisplayRegion
    contextRegion = DisplayRegion
    r
                , writeMoveCursor :: Int -> Int -> Write
    writeMoveCursor = \x :: Int
    x y :: 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
                    Nothing -> String -> Write
    forall a. HasCallStack => String -> a
    error "this terminal does not support show cursor"
                    Just c :: CapExpression
    c -> CapExpression -> [CapParam] -> Write
    writeCapExpr CapExpression
    c []
                , writeHideCursor :: Write
    writeHideCursor = case TerminfoCaps -> Maybe CapExpression
    civis TerminfoCaps
    terminfoCaps of
                    Nothing -> String -> Write
    forall a. HasCallStack => String -> a
    error "this terminal does not support hide cursor"
                    Just c :: 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 = \urlsEnabled :: 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)
                , writeRowEnd :: Write
    writeRowEnd = CapExpression -> [CapParam] -> Write
    writeCapExpr (TerminfoCaps -> CapExpression
    clearEol TerminfoCaps
    terminfoCaps) []
                , inlineHack :: IO ()
    inlineHack = () -> IO ()
    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 url :: ByteString
    url) =
        (Word8 -> Write) -> [Word8] -> Write
    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 "\x1b]8;;") Write -> Write -> Write
    forall a. Monoid a => a -> a -> a
    `mappend`
        (Word8 -> Write) -> [Word8] -> Write
    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 (0x07 :: Word8)
    writeURLEscapes EndLink =
        (Word8 -> Write) -> [Word8] -> Write
    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 "\x1b]8;;\a")
    writeURLEscapes 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 dc :: DisplayContext
    dc terminfoCaps :: TerminfoCaps
    terminfoCaps urlsEnabled :: Bool
    urlsEnabled prevAttr :: FixedAttr
    prevAttr reqAttr :: Attr
    reqAttr diffs :: 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.
            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 caps :: [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 (t :: * -> *) m a.
    (Foldable t, Monoid m) =>
    (a -> m) -> t a -> m
    foldMap (\cap :: 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 state :: 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 -> DisplayAttrCaps)
    -> TerminfoCaps -> DisplayAttrCaps
    forall a b. (a -> b) -> a -> b
    $ 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
    setColors
            -- Otherwise the display colors are not changing or changing
            -- between two non-default points.
            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 caps :: [CapExpression]
    caps -> (CapExpression -> Write) -> [CapExpression] -> Write
    forall (t :: * -> *) m a.
    (Foldable t, Monoid m) =>
    (a -> m) -> t a -> m
    foldMap (\cap :: CapExpression
    cap -> CapExpression -> [CapParam] -> Write
    writeCapExpr CapExpression
    cap []) [CapExpression]
    caps
                                         Write -> Write -> Write
    forall a. Monoid a => a -> a -> a
    `mappend`
                                         (TerminfoCaps -> CapExpression) -> DisplayColorDiff -> Write
    writeColorDiff TerminfoCaps -> CapExpression
    setForeColor (DisplayAttrDiff -> DisplayColorDiff
    foreColorDiff DisplayAttrDiff
    diffs)
                                         Write -> Write -> Write
    forall a. Monoid a => a -> a -> a
    `mappend`
                                         (TerminfoCaps -> CapExpression) -> DisplayColorDiff -> Write
    writeColorDiff TerminfoCaps -> CapExpression
    setBackColor (DisplayAttrDiff -> DisplayColorDiff
    backColorDiff DisplayAttrDiff
    diffs)
                    -- implicitly resets the colors to the defaults
                    SetState state :: 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
    setColors
        where
            urlAttrs :: Bool -> Write
    urlAttrs True = URLDiff -> Write
    writeURLEscapes (DisplayAttrDiff -> URLDiff
    urlDiff DisplayAttrDiff
    diffs)
            urlAttrs False = Write
    forall a. Monoid a => a
    mempty
            colorMap :: Color -> Int
    colorMap = case TerminfoCaps -> Bool
    useAltColorMap TerminfoCaps
    terminfoCaps of
                            False -> Color -> Int
    ansiColorIndex
                            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 sitm :: 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
            setColors :: Write
    setColors =
                (case FixedAttr -> Maybe Color
    fixedForeColor FixedAttr
    attr of
                    Just c :: Color
    c -> CapExpression -> [CapParam] -> Write
    writeCapExpr (TerminfoCaps -> CapExpression
    setForeColor 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]
                    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 c :: Color
    c -> CapExpression -> [CapParam] -> Write
    writeCapExpr (TerminfoCaps -> CapExpression
    setBackColor 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]
                    Nothing -> Write
    forall a. Monoid a => a
    mempty)
            writeColorDiff :: (TerminfoCaps -> CapExpression) -> DisplayColorDiff -> Write
    writeColorDiff _f :: TerminfoCaps -> CapExpression
    _f NoColorChange
                = Write
    forall a. Monoid a => a
    mempty
            writeColorDiff _f :: TerminfoCaps -> CapExpression
    _f ColorToDefault
                = String -> Write
    forall a. HasCallStack => String -> a
    error "ColorToDefault is not a possible case for applyColorDiffs"
            writeColorDiff f :: TerminfoCaps -> CapExpression
    f (SetColor c :: Color
    c)
                = CapExpression -> [CapParam] -> Write
    writeCapExpr (TerminfoCaps -> CapExpression
    f 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]

    -- | 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 pallete to use and
    -- computes the index into the full 256 color pallete.
    ansiColorIndex :: Color -> Int
    ansiColorIndex :: Color -> Int
    ansiColorIndex (ISOColor v :: Word8
    v) = Word8 -> Int
    forall a. Enum a => a -> Int
    fromEnum Word8
    v
    ansiColorIndex (Color240 v :: Word8
    v) = 16 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Word8 -> Int
    forall a. Enum a => a -> Int
    fromEnum Word8
    v

    -- | For terminals without setaf/setab
    --
    -- See table in `man terminfo`
    -- Will error if not in table.
    altColorIndex :: Color -> Int
    altColorIndex :: Color -> Int
    altColorIndex (ISOColor 0) = 0
    altColorIndex (ISOColor 1) = 4
    altColorIndex (ISOColor 2) = 2
    altColorIndex (ISOColor 3) = 6
    altColorIndex (ISOColor 4) = 1
    altColorIndex (ISOColor 5) = 5
    altColorIndex (ISOColor 6) = 3
    altColorIndex (ISOColor 7) = 7
    altColorIndex (ISOColor v :: Word8
    v) = Word8 -> Int
    forall a. Enum a => a -> Int
    fromEnum Word8
    v
    altColorIndex (Color240 v :: Word8
    v) = 16 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Word8 -> Int
    forall a. Enum a => a -> Int
    fromEnum Word8
    v

    {- | 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
    applyReverseVideo :: Bool
        , DisplayAttrState -> Bool
    applyBlink :: Bool
        , DisplayAttrState -> Bool
    applyDim :: Bool
        , DisplayAttrState -> Bool
    applyBold :: Bool
        }

    sgrArgsForState :: DisplayAttrState -> [CapParam]
    sgrArgsForState :: DisplayAttrState -> [CapParam]
    sgrArgsForState attrState :: DisplayAttrState
    attrState = (Bool -> CapParam) -> [Bool] -> [CapParam]
    forall a b. (a -> b) -> [a] -> [b]
    map (\b :: Bool
    b -> if Bool
    b then 1 else 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 caps :: DisplayAttrCaps
    caps s :: Word8
    s diffs :: [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
            ( 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]
    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
            ( True, 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.
            ( True, 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 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 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 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 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 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 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 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 RemoveReverseVideo = Bool
    True
            noEnterExitCap ApplyBlink = Bool
    True
            noEnterExitCap RemoveBlink = Bool
    True
            noEnterExitCap 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 RemoveDim = Bool
    True
            noEnterExitCap 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 RemoveBold = Bool
    True
            enterExitCap :: StyleStateChange -> CapExpression
    enterExitCap 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 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 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 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 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 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 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 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 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 _ = String -> CapExpression
    forall a. HasCallStack => String -> a
    error "enterExitCap applied to diff that was known not to have one."

    stateForStyle :: Style -> DisplayAttrState
    stateForStyle :: Word8 -> DisplayAttrState
    stateForStyle s :: Word8
    s = DisplayAttrState :: Bool
    -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> DisplayAttrState
    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
        , 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 s :: 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
    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 op :: a
    op flag :: Word8
    flag
                = if 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]