1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
----------------------------------------------------------------------
--- Functions to generate documentation in TeX format.
---
--- @author Michael Hanus
--- @version March 2021
----------------------------------------------------------------------

module CurryDoc.TeX where

import Data.Char
import Data.List
import Data.Maybe

import FlatCurry.Types
import FlatCurry.Files
import FlatCurry.Show   ( isClassContext )
import HTML.Base
import HTML.LaTeX       ( showLatexExps )
import HTML.Parser
import Text.Markdown

import CurryDoc.AnaInfo
import CurryDoc.Options
import CurryDoc.Read

--------------------------------------------------------------------------
-- Generates the documentation of a module in HTML format where the comments
-- are already analyzed.
generateTexDocs :: DocOptions -> AnaInfo -> String -> String
                -> [(SourceLine,String)] -> IO String
generateTexDocs docopts anainfo modname modcmts progcmts = do
  fcyname <- getFlatCurryFileInLoadPath modname
  putStrLn $ "Reading FlatCurry program \""++fcyname++"\"..."
  (Prog _ _ types functions _) <- readFlatCurryFile fcyname
  let textypes = concatMap (genTexType docopts progcmts) types
      texfuncs = concatMap (genTexFunc docopts progcmts anainfo) functions
      modcmt   = fst (splitComment modcmts)
  return $
     "\\currymodule{"++modname++"}\n" ++
     htmlString2Tex docopts modcmt ++ "\n" ++
     (if null textypes then ""
      else "\\currytypesstart\n" ++ textypes ++ "\\currytypesstop\n") ++
     (if null texfuncs then ""
      else "\\curryfuncstart\n" ++ texfuncs ++ "\\curryfuncstop\n")

--- Translate a documentation comment to LaTeX and use markdown translation
--- if necessary. If the string contains HTML tags, these are also
--- translated into LaTeX.
htmlString2Tex :: DocOptions -> String -> String
htmlString2Tex docopts cmt =
  if withMarkdown docopts
    then markdownText2LaTeX (replaceIdLinks cmt)
    else showLatexExps (parseHtmlString (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 ++ "`"

-- generate short HTML documentation for a function if it is exported
-- and not an internal operation to implement type classes:
genTexFunc :: DocOptions -> [(SourceLine,String)] -> _ -> FuncDecl -> String
genTexFunc docopts progcmts _ (Func (_,fname) _ fvis ftype _) =
  if fvis==Public && not (classOperations fname)
  then "\\curryfunctionstart{" ++ string2tex fname ++ "}{" ++
       "\\curryfuncsig{" ++ string2tex (showId fname) ++ "}{" ++
         showTexType False (stripForall ftype) ++ "}}\n" ++
         htmlString2Tex docopts
               (fst (splitComment (getFuncComment fname progcmts))) ++
       "\\curryfunctionstop\n"
  else ""
 where
  -- strip initial forall type quantifiers:
  stripForall texp = case texp of
    ForallType _ te -> te
    _               -> texp

  classOperations fn = take 6 fn `elem` ["_impl#","_inst#"]
                    || take 5 fn == "_def#" || take 7 fn == "_super#"

--- generate TeX documentation for a datatype if it is exported and
--- not a dictionary:
genTexType :: DocOptions -> [(SourceLine,String)] -> TypeDecl -> String
genTexType docopts progcmts (Type (_,tcons) tvis tvars constrs)
  | tvis==Public && not (isDict tcons)
  = let (datacmt,conscmts) = splitComment (getDataComment tcons progcmts)
    in "\\currydatastart{" ++ tcons ++ "}\n" ++
       htmlString2Tex docopts datacmt ++
       "\n\\currydatacons\n" ++
       concatMap (genHtmlCons docopts (getCommentType "cons" conscmts)
                              tcons tvars) constrs ++
       "\\currydatastop\n"
  | otherwise = ""
 where
  isDict fn = take 6 fn == "_Dict#"

genTexType docopts progcmts (TypeSyn (tcmod,tcons) tvis tvars texp)
  | tvis==Public
  = let (typecmt,_) = splitComment (getDataComment tcons progcmts)
    in "\\currytypesynstart{" ++ tcons ++ "}{" ++
       (if tcons=="String" && tcmod=="Prelude"
        then "String = [Char]"
        else tcons ++ concatMap (\(i,_) -> [' ', chr (97 + i)]) tvars ++
             " = " ++ showTexType False texp ) ++ "}\n" ++
       htmlString2Tex docopts typecmt ++ "\\currytypesynstop\n\n"
  | otherwise = ""

genTexType docopts progcmts
           (TypeNew (_,tcons) tvis tvars (NewCons cn cvis cte))
  | tvis==Public
  = let (datacmt,conscmts) = splitComment (getDataComment tcons progcmts)
    in "\\currynewtypestart{" ++ tcons ++ "}\n" ++
       htmlString2Tex docopts datacmt ++
       "\n\\currydatacons\n" ++
       genHtmlCons docopts (getCommentType "cons" conscmts) tcons tvars
                   (Cons cn 1 cvis [cte]) ++
       "\\currydatastop\n"
  | otherwise = ""

genHtmlCons :: DocOptions -> [String] -> String -> [(Int, a)] -> ConsDecl
            -> String
genHtmlCons docopts conscmts tcons tvars (Cons (_,cname) _ cvis argtypes) =
  if cvis==Public
  then "\\curryconsstart{" ++ cname ++ "}{" ++
       concatMap (\t->showTexType True t++" $\\to$ ") argtypes ++
                 tcons ++ concatMap (\(i,_) -> [' ', chr (97 + i)]) tvars ++
       "}\n" ++
       (maybe ""
              (\ (call,cmt) -> "{\\tt " ++ call ++ "}" ++
                               htmlString2Tex docopts cmt)
              (getConsComment conscmts cname))
       ++ "\n"
  else ""


-- Pretty printer for types in Curry syntax as TeX string.
-- first argument is True iff brackets must be written around complex types
showTexType :: Bool -> TypeExpr -> String
showTexType _ (TVar i) = [chr (97+i)]
showTexType nested (FuncType t1 t2) = brackets nested $
  maybe (showTexType (isFunctionType t1) t1 ++ " $\\to$ " ++
         showTexType False t2)
        (\ (cn,cts) -> unwords (cn : map (showTexType True) cts) ++
                       " $\\Rightarrow$ " ++ showTexType False t2)
        (isClassContext t1)
showTexType nested (TCons tc ts)
 | ts==[]  = snd tc
 | tc==("Prelude","[]") && (head ts == TCons ("Prelude","Char") [])
   = "String"
 | tc==("Prelude","[]")
   = "[" ++ showTexType False (head ts) ++ "]" -- list type
 | take 2 (snd tc) == "(,"                     -- tuple type
   = "(" ++ concat (intersperse "," (map (showTexType False) ts)) ++ ")"
 | otherwise
   = brackets nested
      (snd tc ++ " " ++ concat (intersperse " " (map (showTexType True) ts)))
showTexType nested (ForallType tvs te)
 | null tvs  = showTexType nested te
 | otherwise = brackets nested
                 (unwords ("forall" : map (showTexType False . TVar . fst) tvs)
                  ++ "." ++ showTexType False te)

-- 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]