Pretty.hs

-- |
--
-- Module      : Mdoc.Pretty
-- Copyright   : (c) 2026 Patrick Brisbin
-- License     : AGPL-3
-- Maintainer  : pbrisbin@gmail.com
-- Stability   : experimental
-- Portability : POSIX
module Mdoc.Pretty
  ( -- * @--color@ option
    Color (..)
  , readColor
  , showColor

    -- * Annotations used in this project
  , Ann (..)
  , annToAnsi

    -- * Re-exports
  , module Prettyprinter

    -- * Rendering
  , putDoc
  , renderDoc
  , renderColor
  , renderPlain
  ) where

import Mdoc.Prelude

import Data.Text.IO qualified as T
import Prettyprinter
import Prettyprinter.Render.Terminal (AnsiStyle, bold, color, colorDull)
import Prettyprinter.Render.Terminal qualified as Ansi
import Prettyprinter.Render.Text qualified as Text
import System.IO (Handle, hIsTerminalDevice)

data Ann
  = AnnComment
  | AnnCommand
  | AnnKeyword
  | AnnSymbol
  | AnnArgument
  | AnnQuote
  | AnnQuoted
  | AnnSpecial
  | AnnFile
  | AnnDiffAddition
  | AnnDiffDeletion
  | AnnDiffContext

data Color
  = ColorAuto
  | ColorAlways
  | ColorNever

readColor :: String -> Either String Color
readColor = \case
  "auto" -> Right ColorAuto
  "always" -> Right ColorAlways
  "never" -> Right ColorNever
  other -> Left $ "Unknown color: " <> other <> ", expected auto|always|never"

showColor :: Color -> String
showColor = \case
  ColorAuto -> "auto"
  ColorAlways -> "always"
  ColorNever -> "never"

putDoc :: MonadIO m => Color -> Handle -> Doc Ann -> m ()
putDoc c h doc = do
  useColor <- case c of
    ColorAuto -> liftIO $ hIsTerminalDevice h
    ColorAlways -> pure True
    ColorNever -> pure False

  liftIO $ T.hPutStr h $ renderDoc useColor doc

renderDoc :: Bool -> Doc Ann -> Text
renderDoc useColor doc
  | useColor = renderColor doc
  | otherwise = renderPlain doc

renderColor :: Doc Ann -> Text
renderColor =
  (<> "\n")
    . Ansi.renderStrict
    . layoutPretty defaultLayoutOptions
    . reAnnotate annToAnsi

renderPlain :: Doc Ann -> Text
renderPlain =
  (<> "\n")
    . Text.renderStrict
    . layoutPretty defaultLayoutOptions

annToAnsi :: Ann -> AnsiStyle
annToAnsi = \case
  AnnComment -> colorDull Ansi.White
  AnnCommand -> colorDull Ansi.Blue
  AnnKeyword -> color Ansi.Black
  AnnSymbol -> colorDull Ansi.White
  AnnArgument -> colorDull Ansi.Green
  AnnQuote -> colorDull Ansi.White
  AnnQuoted -> colorDull Ansi.Green
  AnnSpecial -> colorDull Ansi.Magenta
  AnnFile -> bold
  AnnDiffAddition -> colorDull Ansi.Green
  AnnDiffDeletion -> colorDull Ansi.Red
  AnnDiffContext -> colorDull Ansi.White