-- SPDX-FileCopyrightText: Copyright (c) 2025 Objectionary.com
-- SPDX-License-Identifier: MIT

module LaTeX (explainRules, programToLaTeX) where

import Data.List (intercalate)
import Data.Maybe (fromMaybe)
import qualified Yaml as Y
import Ast (Program)
import Pretty (PrintMode, prettyProgram', Encoding (ASCII))

programToLaTeX :: Program -> PrintMode -> String
programToLaTeX :: Program -> PrintMode -> String
programToLaTeX Program
prog PrintMode
mode = [String] -> String
unlines
  [
    String
"\\documentclass{article}",
    String
"\\usepackage{eolang}",
    String
"\\begin{document}",
    String
"\\begin{phiquation}",
    Program -> PrintMode -> Encoding -> String
prettyProgram' Program
prog PrintMode
mode Encoding
ASCII,
    String
"\\end{phiquation}",
    String
"\\end{document}"
  ]

-- @todo #114:30min Implement LaTeX conversion for rules.
--  Convert Rule data structure to LaTeX inference rule format.
--  Each rule should be formatted as a LaTeX inference rule with
--  pattern, result, and optional conditions.
--  Tests must be added for LaTeX conversion logic.
explainRule :: Y.Rule -> String
explainRule :: Rule -> String
explainRule Rule
rule = String
"\\rule{" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
"unnamed" (Rule -> Maybe String
Y.name Rule
rule) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"}"

-- @todo #114:30min Create LaTeX document wrapper.
--  Generate proper LaTeX document with tabular format for rules.
--  Each rule should be   in its own tabular environment.
--  Include tests for document structure generation.
explainRules :: [Y.Rule] -> String
explainRules :: [Rule] -> String
explainRules [Rule]
rules' =
  [String] -> String
unlines
    [ String
"\\documentclass{article}",
      String
"\\usepackage{amsmath}",
      String
"\\begin{document}"
    ]
    String -> String -> String
forall a. [a] -> [a] -> [a]
++ [String] -> String
unlines ((Rule -> String) -> [Rule] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Rule -> String
explainRule [Rule]
rules')
    String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\\end{document}"