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
  , custom
  , man1
  , man5
  ) where

import Mdoc.Prelude

import Data.FileEmbed
import Data.Text.Encoding (decodeUtf8)
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

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

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

custom :: MonadIO m => FilePath -> m Template
custom = compileMustacheFile

man1 :: Template
man1 =
  either (error . errorBundlePretty) id
    $ compileMustacheText "man1"
    $ decodeUtf8 $(embedFile "data/man1.template")

man5 :: Template
man5 =
  either (error . errorBundlePretty) id
    $ compileMustacheText "man5"
    $ decodeUtf8 $(embedFile "data/man5.template")

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

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