{- | The @--health@ report.

Prints what termtab has decided about notation rendering: which terminal
graphics protocol it will use (and why), the environment signals it read, and
whether the bundled Bravura font actually loads and rasterizes. Lets you verify
detection without launching the TUI.
-}
module Termtab.Graphics.Health (runHealthCheck) where

import Codec.Picture (imageHeight, imageWidth)
import Control.Exception (SomeException, try)
import Data.Word (Word8)
import Numeric (showHex)
import System.Environment (lookupEnv)

import Termtab.Graphics.Detect
import Termtab.Graphics.FreeType
import Termtab.Graphics.TermColor (queryForegroundColor)

-- | Result of trying to load and rasterize a glyph from the Bravura font.
data FontStatus
    = -- | @TERMTAB_BRAVURA_FONT@ isn't set.
      FontUnset
    | {- | The font path was set but loading\/rasterizing failed, with the
      exception's rendered message.
      -}
      FontError FilePath String
    | {- | Loaded and rasterized successfully: path, glyph width, height,
      and advance (all in pixels).
      -}
      FontOk FilePath Int Int Int

{- | Entry point for @termtab --health@: gather protocol detection, ink
color, and font status, then print the assembled 'report'.
-}
runHealthCheck :: IO ()
runHealthCheck :: IO ()
runHealthCheck = do
    info <- IO DetectionInfo
detectProtocolInfo
    fg <- queryForegroundColor
    font <- checkFont
    mapM_ putStrLn (report info fg font)

-- | Format the full health-check report as one line per list element.
report :: DetectionInfo -> Maybe (Word8, Word8, Word8) -> FontStatus -> [String]
report :: DetectionInfo
-> Maybe (Word8, Word8, Word8) -> FontStatus -> [String]
report DetectionInfo
info Maybe (Word8, Word8, Word8)
fg FontStatus
font =
    [ String
"termtab health check"
    , String
"===================="
    , String
""
    , String
"Terminal graphics"
    , String
"  TERM             = " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Maybe String -> String
orUnset (DetectionInfo -> Maybe String
diTerm DetectionInfo
info)
    , String
"  TERM_PROGRAM     = " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Maybe String -> String
orUnset (DetectionInfo -> Maybe String
diTermProgram DetectionInfo
info)
    , String
"  KITTY_WINDOW_ID  = " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Maybe String -> String
orUnset (DetectionInfo -> Maybe String
diKittyWindowId DetectionInfo
info)
    , String
"  TERMTAB_GRAPHICS = " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Maybe String -> String
orUnset (DetectionInfo -> Maybe String
diOverride DetectionInfo
info)
    , String
"  -> protocol: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> GraphicsProtocol -> String
showProtocol (DetectionInfo -> GraphicsProtocol
diProtocol DetectionInfo
info)
    , String
"     reason:   " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> DetectionInfo -> String
diReason DetectionInfo
info
    , String
"  ink color (OSC 10 foreground): " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
-> ((Word8, Word8, Word8) -> String)
-> Maybe (Word8, Word8, Word8)
-> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"(no reply — will use default ink)" (Word8, Word8, Word8) -> String
fmtColor Maybe (Word8, Word8, Word8)
fg
    , String
""
    , String
"Notation font (Bravura)"
    ]
        [String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
<> FontStatus -> [String]
fontLines FontStatus
font
        [String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
<> [ String
""
           , String
"Notation rendering: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> GraphicsProtocol -> FontStatus -> String
summary (DetectionInfo -> GraphicsProtocol
diProtocol DetectionInfo
info) FontStatus
font
           ]

fontLines :: FontStatus -> [String]
fontLines :: FontStatus -> [String]
fontLines FontStatus
FontUnset =
    [ String
"  TERMTAB_BRAVURA_FONT = (unset)"
    , String
"  status: font path not configured — set TERMTAB_BRAVURA_FONT or use the Nix devshell"
    ]
fontLines (FontError String
path String
err) =
    [ String
"  TERMTAB_BRAVURA_FONT = " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
path
    , String
"  status: FAILED to load — " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
err
    ]
fontLines (FontOk String
path Int
w Int
h Int
adv) =
    [ String
"  TERMTAB_BRAVURA_FONT = " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
path
    , String
"  status: OK"
    , String
"  test glyph U+E0A4 (notehead): "
        String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
w
        String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"x"
        String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
h
        String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" px, advance "
        String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
adv
        String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" px"
    ]

-- | One-line bottom-line summary of what will actually happen.
summary :: GraphicsProtocol -> FontStatus -> String
summary :: GraphicsProtocol -> FontStatus -> String
summary GraphicsProtocol
TextOnly FontStatus
_ =
    String
"DISABLED — terminal has no graphics support; notation falls back to the Unicode text staff"
summary GraphicsProtocol
proto (FontOk String
_ Int
_ Int
_ Int
_) =
    String
"ENABLED — TabAndNotation renders Bravura images via the " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> GraphicsProtocol -> String
showProtocol GraphicsProtocol
proto
summary GraphicsProtocol
proto FontStatus
_ =
    String
"DEGRADED — "
        String -> String -> String
forall a. Semigroup a => a -> a -> a
<> GraphicsProtocol -> String
showProtocol GraphicsProtocol
proto
        String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" is available but Bravura did not load; notation falls back to the Unicode text staff"

-- | Load Bravura and rasterize a notehead, capturing any failure.
checkFont :: IO FontStatus
checkFont :: IO FontStatus
checkFont = do
    mPath <- String -> IO (Maybe String)
lookupEnv String
"TERMTAB_BRAVURA_FONT"
    case mPath of
        Maybe String
Nothing -> FontStatus -> IO FontStatus
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure FontStatus
FontUnset
        Just String
path -> do
            result <-
                IO (Int, Int, Int) -> IO (Either SomeException (Int, Int, Int))
forall e a. Exception e => IO a -> IO (Either e a)
try (String -> IO (Int, Int, Int)
rasterizeTestGlyph String
path) ::
                    IO (Either SomeException (Int, Int, Int))
            pure $ case result of
                Left SomeException
err -> String -> String -> FontStatus
FontError String
path (SomeException -> String
forall a. Show a => a -> String
show SomeException
err)
                Right (Int
w, Int
h, Int
adv) -> String -> Int -> Int -> Int -> FontStatus
FontOk String
path Int
w Int
h Int
adv

-- | Rasterize the SMuFL black notehead; returns its dimensions and advance.
rasterizeTestGlyph :: FilePath -> IO (Int, Int, Int)
rasterizeTestGlyph :: String -> IO (Int, Int, Int)
rasterizeTestGlyph String
path =
    String -> (FontFace -> IO (Int, Int, Int)) -> IO (Int, Int, Int)
forall a. String -> (FontFace -> IO a) -> IO a
withFontFace String
path ((FontFace -> IO (Int, Int, Int)) -> IO (Int, Int, Int))
-> (FontFace -> IO (Int, Int, Int)) -> IO (Int, Int, Int)
forall a b. (a -> b) -> a -> b
$ \FontFace
face -> do
        mg <- FontFace -> Int -> Char -> IO (Maybe GlyphBitmap)
renderGlyph FontFace
face Int
40 Char
'\xE0A4'
        case mg of
            Maybe GlyphBitmap
Nothing -> String -> IO (Int, Int, Int)
forall a. HasCallStack => String -> a
error String
"FreeType could not render the test glyph"
            Just GlyphBitmap
gb ->
                let img :: Image Word8
img = GlyphBitmap -> Image Word8
gbImage GlyphBitmap
gb
                 in (Int, Int, Int) -> IO (Int, Int, Int)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Image Word8 -> Int
forall a. Image a -> Int
imageWidth Image Word8
img, Image Word8 -> Int
forall a. Image a -> Int
imageHeight Image Word8
img, GlyphBitmap -> Int
gbAdvance GlyphBitmap
gb)

-- | Human-readable name for a 'GraphicsProtocol', for the report.
showProtocol :: GraphicsProtocol -> String
showProtocol :: GraphicsProtocol -> String
showProtocol GraphicsProtocol
Kitty = String
"Kitty graphics protocol"
showProtocol GraphicsProtocol
Sixel = String
"Sixel"
showProtocol GraphicsProtocol
TextOnly = String
"Unicode text (no graphics)"

-- | Render an optional environment variable value, or @\"(unset)\"@.
orUnset :: Maybe String -> String
orUnset :: Maybe String -> String
orUnset = String -> (String -> String) -> Maybe String -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"(unset)" String -> String
forall a. a -> a
id

-- | Format an RGB triple as a @#rrggbb@ hex string.
fmtColor :: (Word8, Word8, Word8) -> String
fmtColor :: (Word8, Word8, Word8) -> String
fmtColor (Word8
r, Word8
g, Word8
b) = Char
'#' Char -> String -> String
forall a. a -> [a] -> [a]
: (Word8 -> String) -> [Word8] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Word8 -> String
forall {p}. Integral p => p -> String
hex2 [Word8
r, Word8
g, Word8
b]
  where
    hex2 :: p -> String
hex2 p
w = let s :: String
s = p -> String -> String
forall a. Integral a => a -> String -> String
showHex p
w String
"" in if String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
s Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
2 then Char
'0' Char -> String -> String
forall a. a -> [a] -> [a]
: String
s else String
s