Template.hs

{-# LANGUAGE TemplateHaskell #-}

-- |
--
-- Module      : Mdoc.Template
-- Copyright   : (c) 2026 Patrick Brisbin
-- License     : AGPL-3
-- Maintainer  : pbrisbin@gmail.com
-- Stability   : experimental
-- Portability : POSIX
module Mdoc.Template
  ( Template
  , RenderResult (..)
  , renderTemplate
  , renderTemplateThrow

    -- * Warnings
  , MustacheWarning
  , putMustacheWarnings
  , displayMustacheWarnings
  , displayMustacheWarning

    -- * Templates
  , man1
  , man5
  , custom
  ) where

import Mdoc.Prelude

import Data.Text.Lazy.Encoding (encodeUtf8)
import Mdoc.Data.Named
import Mdoc.Input
import Mdoc.Parse
import Mdoc.Syntax
import System.IO (hPutStrLn, stderr)
import Text.Mustache
import Text.Mustache.Compile.TH qualified as TH

data RenderResult
  = Rendered Mdoc
  | RenderedWarnings (NonEmpty MustacheWarning) Mdoc
  | RenderedError ParseError

renderTemplate :: Template -> Named -> RenderResult
renderTemplate t named =
  let
    (warnings, rendered) = renderMustacheW t $ toJSON named
    parsed = parseMdocBytes "<input>" $ encodeUtf8 rendered
  in
    case parsed of
      Left err -> RenderedError err
      Right mdoc -> case nonEmpty warnings of
        Nothing -> Rendered mdoc
        Just ne -> RenderedWarnings ne mdoc

-- | 'renderTemplate' and throw on 'RenderedError'
--
-- Warnings are written to @stderr@ but are not fatal.
renderTemplateThrow :: MonadIO m => Template -> Named -> m Mdoc
renderTemplateThrow t named = case renderTemplate t named of
  Rendered mdoc -> pure mdoc
  RenderedWarnings ne mdoc -> mdoc <$ putMustacheWarnings ne
  RenderedError err -> throwIO err

-- | Built-in template for rendering a 'Named' in section 1
--
-- @SYNOPSIS@ and @DESCRIPTION@ for options/commands, and @ENVIRONMENT@.
man1 :: Template
man1 = $(TH.compileMustacheDir "man1" "data")

-- | Built-in template for rendering a 'Named' in section 5
--
-- No @SYNOPSIS@ and a @DESCRIPTION@ of configs.
man5 :: Template
man5 = $(TH.compileMustacheDir "man5" "data")

-- | Load a custom template and make our partials available
--
-- This makes it easier to define your template while re-using chunks of ours.
--
-- NB. Our top-level templates are also available; this allows a convenient way
-- to simply add an epilogue:
--
-- @
-- \." templates/custom.1.mustache
-- {{>man1}}
-- SEE ALSO
-- .Xr bash 1
-- @
custom :: MonadIO m => FilePath -> m Template
custom p = (<> man1) <$> compileMustacheFile p

putMustacheWarnings :: MonadIO m => NonEmpty MustacheWarning -> m ()
putMustacheWarnings = liftIO . hPutStrLn stderr . displayMustacheWarnings

displayMustacheWarnings :: NonEmpty MustacheWarning -> String
displayMustacheWarnings =
  unlines
    . ("Mustache template warnings:" :)
    . map (("- " <>) . displayMustacheWarning)
    . toList