{- |
     Author  : Michael Hanus, Jan Tikovsky, Kai-Oliver Prott
     Version : October 2025

     Operations to generate documentation in LaTeX format.
-}
module CurryDoc.Generators.TeX (generateTexDocs) where

import Curry.Compiler.Distribution
import Data.Char ( chr, isAlpha, isSpace )
import Data.List ( intercalate, intersperse )

import AbstractCurry.Types
import AbstractCurry.Select
import HTML.Base
import HTML.LaTeX  ( showLatexExps )
import HTML.Parser
import Text.Markdown

import CurryDoc.Options
import CurryDoc.Info

 -- TODO: The generated .tex does not have all the information that .html has.
 -- This has also been the case in prior versions.
 -- For example, the funcional dependencies of a class are not shown.

-- | Generates the documentation of a module in LaTeX format
generateTexDocs :: DocOptions -> CurryDoc -> IO String
generateTexDocs docopts (CurryDoc mname mhead ex _) =
  return $ "\\currymodule{"++mname++"}\n" ++
           genTexModule docopts mhead ++ "\n" ++
           genTexForExport docopts ex

-- Translate a documentation comment to LaTeX and use markdown translation
-- if necessary.
docStringToTex :: DocOptions -> String -> String
docStringToTex docopts cmt =
  if withMarkdown docopts
    then markdownText2LaTeX (replaceIdLinks cmt)
    else replaceIdLinks cmt

-- replace identifier hyperlinks in a string (i.e., enclosed in single quotes)
-- by code markdown:
replaceIdLinks :: String -> String
replaceIdLinks str = case str of
  []             -> []
  ('\\':'\'':cs) -> '\'' : replaceIdLinks cs
  (c:cs)          -> if c=='\'' then tryReplaceIdLink [] cs
                                else c : replaceIdLinks cs
 where
  tryReplaceIdLink ltxt [] = '\'' : reverse ltxt
  tryReplaceIdLink ltxt (c:cs)
   | isSpace c = '\'' : reverse ltxt ++ c : replaceIdLinks cs -- no space in id
   | c == '\'' = checkId (reverse ltxt) ++ replaceIdLinks cs
   | otherwise = tryReplaceIdLink (c:ltxt) cs

  checkId s = if ' ' `elem` s
                then '\'' : s ++ ['\'']
                else "`" ++ s ++ "`"

genTexForExport :: DocOptions -> [ExportEntry CurryDocDecl] -> String
genTexForExport _   []                                  = ""
genTexForExport doc (ExportSection c nesting ex : rest) =
  let innerTex = genTexForExport doc ex
      outerTex = genTexForExport doc rest
  in getSubsectionCommand nesting ++
     docStringToTex doc (commentString c) ++
     (if nesting > 1 then "~\\\\" else "") ++ "\n\n" ++
     innerTex ++ "\n\n" ++ outerTex
 where
  getSubsectionCommand n = case n of 1 -> "\\subsubsection*"
                                     2 -> "\\paragraph*"
                                     _ -> "\\subparagraph*"
genTexForExport doc (ExportEntryModule _ : rest) =
  genTexForExport doc rest -- TODO: show export of modules
genTexForExport doc (ExportEntry decl : rest)
  | isCurryDocFuncDecl  decl = genTexFunc  doc decl ++ "\n" ++ restTex
  | isCurryDocClassDecl decl = genTexClass doc decl ++ "\n" ++ restTex
  | otherwise                = genTexType  doc decl ++ "\n" ++ restTex
  where restTex = genTexForExport doc rest

-- generate TeX documentation for a function
genTexFunc :: DocOptions -> CurryDocDecl -> String
genTexFunc docopts d = case d of
  CurryDocFunctionDecl (fmod, fname) ty sig _ cs
    -> "\\curryfunctionstart{" ++ string2tex fname ++ "}{" ++
       "\\curryfuncsig{" ++ string2tex (showId fname) ++ "}{" ++
         showQualTexType docopts fmod ty ++ "}}\n" ++
         docStringToTex docopts(
           concatCommentStrings (map commentString
             (maybe [] getTypesigComments sig))) ++
         docStringToTex docopts
           (concatCommentStrings (map commentString cs)) ++
       "\\curryfunctionstop\n"
  _ -> ""

-- generate TeX documentation for a datatype
genTexType :: DocOptions -> CurryDocDecl -> String
genTexType docopts d = case d of
  CurryDocDataDecl (tcmod,tcons) vs insts _ constrs cs ->
    "\\currydatastart{" ++ tcons ++ "}\n" ++
    docStringToTex docopts
      (concatCommentStrings (map commentString cs)) ++
    (if null constrs
      then "\n\\currynocons"
      else "\n\\currydataconsstart\n" ++
           concatMap (genTexCons docopts tcons vs) constrs ++
           "\\currydataconsstop") ++
    (if null insts
      then "\n\\currynoinsts"
      else "\n\\currydatainstsstart\n" ++
           concatMap (genTexInst docopts tcmod) insts ++
           "\n\\currydatainstsstop")
  CurryDocNewtypeDecl (tcmod,tcons) vs insts cons cs ->
    "\\currynewtypestart{" ++ tcons ++ "}\n" ++
    docStringToTex docopts
      (concatCommentStrings (map commentString cs)) ++
    (maybe "\n\\currynocons"
           (\c -> "\n\\currydataconsstart\n" ++
                  genTexCons docopts tcons vs c ++
                  "\n\\currydataconsstop\n") cons) ++
    (if null insts
      then "\n\\currynoinsts"
      else "\n\\currydatainstsstart\n" ++
           concatMap (genTexInst docopts tcmod) insts ++
           "\n\\currydatainstsstop")
  CurryDocTypeDecl (tcmod,tcons) vs ty cs ->
    "\\currytypesynstart{" ++ tcons ++ "}{" ++
    (if tcons=="String" && tcmod=="Prelude"
     then "String = [Char]"
     else tcons ++ " " ++ unwords (map snd vs) ++ "="
           ++ showTexType docopts tcmod False ty) ++ "}\n" ++
    docStringToTex docopts
       (concatCommentStrings (map commentString cs)) ++
    "\\currytypesynstop\n\n"
  _ -> ""

genTexInst :: DocOptions -> String -> CurryDocInstanceDecl -> String
genTexInst docopts modname d = case d of
  CurryDocInstanceDecl (cmod, cname) cx ts _ _ ->
    "\n" ++
    (if null cxString then "" else cxString ++ " ") ++
    "\\textbf{" ++ cname ++ "} " ++
    unwords (map (\ty -> showTexType docopts modname
                           (isApplyType ty || isFunctionType ty) ty) ts) ++
    "\n\n"
    where cxString = showTexContext docopts cmod cx

-- generate Tex documentation for a constructor if it is exported:
genTexCons :: DocOptions -> String -> [CTVarIName] -> CurryDocCons -> String
genTexCons docopts vs ds (CurryDocConsOp (cmod, cname) ty1 ty2 ai cs) =
  genTexCons docopts vs ds (CurryDocConstr (cmod, "(" ++ cname ++ ")")
                             [ty1, ty2] ai cs) -- TODO: maybe different?
genTexCons docopts tcons vs (CurryDocConstr (cmod, cname) tys _ cs) =
 "\\curryconsstart{" ++ cname ++ "}{" ++
      concatMap (\t-> showTexType docopts cmod True t ++ " $\\to$ ") tys ++
      tcons ++ " " ++ unwords (map snd vs) ++ "}\n" ++
      docStringToTex docopts (concatCommentStrings (map commentString cs))
genTexCons docopts tcons vs (CurryDocRecord (cmod,cname) tys fs _ cs) =
 "\\curryconsstart{" ++ cname ++ "}{" ++
      concatMap (\t-> showTexType docopts cmod True t ++ " $\\to$ ") tys ++
      tcons ++ " " ++ unwords (map snd vs) ++ "}\n" ++
      docStringToTex docopts (concatCommentStrings (map commentString cs)) ++
      intercalate "\n" (map (genTexField docopts) fs)

-- generate Tex documentation for record fields
genTexField :: DocOptions -> CurryDocField -> String
genTexField docopts (CurryDocField (fmod,fname) ty _ cs) =
  "\\curryfieldstart{" ++ fname ++ "}{" ++
    fname ++ " :: " ++ showTexType docopts fmod False ty ++ "}" ++
    if null txt then [] else
      " : " ++ docStringToTex docopts txt
  where txt = concatCommentStrings (map commentString cs)

-- generate Tex documentation for a function:
genTexClass :: DocOptions -> CurryDocDecl -> String
genTexClass docopts d = case d of
  CurryDocClassDecl (cmod, cname) cx v _ ds cs
    -> "\\curryclassstart{" ++ cname ++ "}{" ++
       (if null cxString then "" else cxString ++ " ") ++
       "\\textbf{" ++ cname ++ "} " ++ unwords (map snd v) ++ "}\n" ++
       docStringToTex docopts
         (concatCommentStrings (map commentString cs)) ++ "\n" ++
       concatMap (genTexFunc docopts) ds ++
       "\\curryclassstop\n"
    where cxString = showTexContext docopts cmod cx
  _ -> ""

-- generate Tex documentation for a module:
genTexModule :: DocOptions -> ModuleHeader -> String
genTexModule docopts (ModuleHeader fields maincmt) =
  docStringToTex docopts maincmt ++
  concatMap fieldTex fields
  where fieldTex (typ, value) =
          "\\textbf{" ++ show typ ++ ": } " ++ value ++ "\n\n"

-- Pretty printer for qualified types in Curry syntax:
showQualTexType :: DocOptions -> String -> CQualTypeExpr -> String
showQualTexType opts mod (CQualType ctxt texp) =
  unwords [showTexContext opts mod ctxt, showTexType opts mod False texp]

showTexContext :: DocOptions -> String -> CContext -> String
showTexContext _ _ (CContext []) = ""
showTexContext opts mod (CContext [clscon]) =
  showTexConstraint opts mod clscon ++ " $\\Rightarrow$"
showTexContext opts mod (CContext ctxt@(_:_:_)) =
  bracketsIf True (intercalate ", " (map (showTexConstraint opts mod) ctxt))
    ++ " $\\Rightarrow$"

-- Pretty-print a single class constraint.
showTexConstraint :: DocOptions -> String -> CConstraint -> String
showTexConstraint opts mod (cn,texps) =
  "\\textbf{" ++ snd cn ++ "} " ++
  unwords (map (showTexType opts mod True) texps)

-- Pretty printer for types in Curry syntax as TeX string.
-- first argument is True iff brackets must be written around complex types
showTexType :: DocOptions -> String -> Bool -> CTypeExpr -> String
showTexType opts mod nested texp = case texp of
  CTVar (_,n) -> n
  CFuncType t1 t2 ->
    bracketsIf nested
      (showTexType opts mod (isFunctionalType t1) t1 ++" $\\to$ " ++
       showTexType opts mod False                 t2)
  CTCons tc -> showTexTConsType opts mod nested tc []
  CTApply t1 t2 ->
       maybe (bracketsIf nested $
                showTexType opts mod True t1 ++ " " ++
                showTexType opts mod True t2)
             (\ (tc,ts) -> showTexTConsType opts mod nested tc ts)
             (tconsArgsOfType texp)

showTexTConsType :: DocOptions -> String -> Bool -> QName -> [CTypeExpr]
                 -> String
showTexTConsType opts mod nested tc ts
 | ts==[]  = snd tc
 | tc==("Prelude","[]") && (head ts == CTCons ("Prelude","Char"))
   = "String"
 | tc==("Prelude","[]")
   = "[" ++ showTexType opts mod False (head ts) ++ "]" -- list type
 | take 2 (snd tc) == "(,"                      -- tuple type
   = "(" ++
     concat (intersperse "," (map (showTexType opts mod False) ts)) ++
     ")"
 | otherwise
   = bracketsIf nested
      (snd tc ++ " " ++
       concat (intersperse " " (map (showTexType opts mod True) ts)))

-- convert string into TeX:
string2tex :: String -> String
string2tex = concatMap char2tex
 where
  char2tex c | c==chr 228  = "\\\"a"
             | c==chr 246  = "\\\"o"
             | c==chr 252  = "\\\"u"
             | c==chr 196  = "\\\"A"
             | c==chr 214  = "\\\"O"
             | c==chr 220  = "\\\"U"
             | c==chr 223  = "\\ss{}"
             | c=='\\'     = "{\\symbol{92}}"
             | c=='^'      = "{\\symbol{94}}"
             | c=='~'      = "{\\symbol{126}}"
             | c=='<'      = "{$<$}"
             | c=='>'      = "{$>$}"
             | c=='_'      = "\\_"
             | c=='#'      = "\\#"
             | c=='$'      = "\\$"
             | c=='%'      = "\\%"
             | c=='{'      = "\\{"
             | c=='}'      = "\\}"
             | c=='&'      = "\\&"
             | otherwise   = [c]

bracketsIf :: Bool -> String -> String
bracketsIf False s = s
bracketsIf True  s = "("++s++")"

-- enclose a non-letter identifier in brackets:
showId :: String -> String
showId name = if isAlpha (head name) then name
                                     else ('(':name)++")"