CurryDoc.curry 13.3 KB
Newer Older
1
2
3
4
5
----------------------------------------------------------------------
--- Implementation of CurryDoc, a utility for the automatic
--- generation of HTML documentation from Curry programs.
---
--- @author Michael Hanus
Michael Hanus 's avatar
Michael Hanus committed
6
--- @version February 2013
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
----------------------------------------------------------------------

-- * All comments to be put into the HTML documentation must be
--   prefixed by "--- " (also in literate programs!).
--
-- * The comment of a module must occur before the first "module" or
--   "import" line of this module.
--
-- * The comment of a function or datatype must occur before the
--   first definition of this function or datatype.
--
-- * The comments can contain at the end several special comments:
--   @cons id comment   --> a comment for a constructor of a datatype
--   @param id comment  --> comment for function parameter id
--                          (list all parameters in left-to-right order)
--   @return comment    --> comments for the return value of a function
--   @author comment    --> the author of a module (only in module comments)
--   @version comment   --> the version of a module (only in module comments)
--
-- * Current restriction: doesn't properly work for infix operator definitions
--   without a type definition (so it should be always included)

module CurryDoc where

31
32
33
34
import Directory
import Distribution
import FileGoodies
import FilePath ((</>), (<.>))
35
import FlatCurry
36
import List
37
38
import System
import Time
39

40
import AnalysisServer(initializeAnalysisSystem,analyzeInterface)
41
42
43
44
import Deterministic
import TotallyDefined
import Indeterministic
import SolutionCompleteness
45
46
47
48
49
50

import CurryDocParams
import CurryDocRead
import CurryDocHtml
import CurryDocTeX
import CurryDocCDoc
Michael Hanus 's avatar
Michael Hanus committed
51
import CurryDocConfig
52
53
54
55

--------------------------------------------------------------------------
-- Global definitions:

56
greeting = "CurryDoc (" ++ currydocVersion ++ ") - the Curry Documentation Tool\n"
57
58
59

-- Directory where include files for generated documention (e.g., icons,
-- css, tex includes) are stored:
60
includeDir = installDir </> "include"
61
62
63
64
65
66
67

--------------------------------------------------------------------------
-- Check arguments and call main function:
main = do
  args <- getArgs
  processArgs defaultCurryDocParams args

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
processArgs params args = case args of
  -- no markdown
  ("--nomarkdown":margs) -> processArgs (setMarkDown False  params) margs
  -- documentation type
  ("--html"      :margs) -> processArgs (setDocType HtmlDoc params) margs
  ("--tex"       :margs) -> processArgs (setDocType TexDoc  params) margs
  ("--cdoc"      :margs) -> processArgs (setDocType CDoc    params) margs
  -- HTML without index
  ["--noindexhtml",docdir,modname] ->
      makeCompleteDoc (setIndex False (setDocType HtmlDoc params))
                      True docdir (stripSuffix modname)
  -- HTML index only
  ("--onlyindexhtml":docdir:modnames) ->
                      makeIndexPages docdir (map stripSuffix modnames)
  (('-':_):_) -> putStrLn usageMessage
  -- module
  [modname] ->
      makeCompleteDoc params (docType params == HtmlDoc)
                      ("DOC_" ++ stripSuffix modname) (stripSuffix modname)
  -- docdir + module
  [docdir,modname] ->
      makeCompleteDoc params (docType params == HtmlDoc) docdir
                      (stripSuffix modname)
  _ -> putStrLn usageMessage

usageMessage = unlines
 [ "ERROR: Illegal arguments for currydoc"
 , "Usage: currydoc [--nomarkdown] [--html|--tex|--cdoc] [<doc directory>] <module_name>"
 , "       currydoc [--nomarkdown] --noindexhtml <doc directory> <module_name>"
 , "       currydoc --onlyindexhtml <doc directory> <module_names>"
 ]


101
102
103
104
105

-- create directory if not existent:
createDir :: String -> IO ()
createDir dir = do
  exdir <- doesDirectoryExist dir
106
  if exdir then done else system ("mkdir " ++ dir) >> done
107
108
109
110
111
112
113
114
115
116

--------------------------------------------------------------------------
--- The main function of the CurryDoc utility.
--- @param withindex - True if the index pages should also be generated
--- @param recursive - True if the documentation for the imported modules
---                    should be also generated (if necessary)
--- @param docdir - the directory name containing all documentation files
--- @param modname - the name of the main module to be documented
makeCompleteDoc :: DocParams -> Bool -> String -> String -> IO ()
makeCompleteDoc docparams recursive docdir modname = do
117
  putStrLn greeting
118
119
120
  prepareDocDir (docType docparams) docdir
  -- parsing source program:
  callFrontend FCY modname
121
  -- when constructing CDOC the imported modules don't have to be read from the flatCurryFile
122
123
  (alltypes, allfuns, _) <- getProg $ docType docparams
  makeDocIfNecessary docparams recursive docdir modname
124
  if withIndex docparams
Michael Hanus 's avatar
Michael Hanus committed
125
126
127
   then do genMainIndexPage     docdir [modname]
           genFunctionIndexPage docdir allfuns
           genConsIndexPage     docdir alltypes
128
129
130
131
   else done
  -- change access rights to readable for everybody:
  system ("chmod -R go+rX "++docdir)
  done
132
133
134
135
136
137
    where getProg HtmlDoc = readFlatCurryWithImports [modname]
          getProg TexDoc  = readFlatCurryWithImports [modname]
          getProg CDoc    = do
              Prog _ _ t f o <- readFlatCurry modname
              return (t, f, o)

138
139
140
141

--- Generate only the index pages for a list of (already compiled!) modules:
makeIndexPages :: String -> [String] -> IO ()
makeIndexPages docdir modnames = do
142
  putStrLn greeting
143
144
  prepareDocDir HtmlDoc docdir
  (alltypes,allfuns,_) <- readFlatCurryWithImports modnames
Michael Hanus 's avatar
Michael Hanus committed
145
146
147
  genMainIndexPage     docdir modnames
  genFunctionIndexPage docdir allfuns
  genConsIndexPage     docdir alltypes
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
  -- change access rights to readable for everybody:
  system ("chmod -R go+rX "++docdir)
  done

-- create documentation directory (if necessary) with gifs and stylesheets:
prepareDocDir :: DocType -> String -> IO ()
prepareDocDir HtmlDoc docdir = do
  createDir docdir
  putStrLn ("Copying icons into documentation directory \""++docdir++"\"...")
  -- copying all icons:
  copyIncludeIfPresent docdir "currydocicons/*.gif"
  -- copy style sheet:
  copyIncludeIfPresent docdir "currydoc.css"
prepareDocDir TexDoc docdir = do
  createDir docdir
  putStrLn $ "Copy macros into documentation directory \""++docdir++"\"..."
  copyIncludeIfPresent docdir "currydoc.tex"
165
166
167
prepareDocDir CDoc docdir = do
  createDir docdir
  putStrLn ("Directory was created succesfully")
168
169
170
171
172
173
174

copyIncludeIfPresent docdir inclfile = do
  existIDir <- doesDirectoryExist includeDir
  if existIDir
   then system ("cp "++includeDir++"/"++inclfile++" "++docdir) >> done
   else done

175
176
-- read and generate all analysis infos:
readAnaInfo modname = do
177
  initializeAnalysisSystem
Michael Hanus 's avatar
Michael Hanus committed
178
  nondet   <- analyzeInterface nondetAnalysis  modname >>= stopIfError
179
180
181
182
183
184
185
186
187
188
  complete <- analyzeInterface patCompAnalysis modname >>= stopIfError
  indet    <- analyzeInterface indetAnalysis   modname >>= stopIfError
  solcomp  <- analyzeInterface solcompAnalysis modname >>= stopIfError
  return (AnaInfo (\qn -> nondet qn == NDet) complete indet solcomp)
 where
   stopIfError (Right err) = error ("Analysis error: "++err)
   stopIfError (Left results) =
     return (\qn -> maybe (error $ "No analysis result for function "++show qn)
                          id
                          (lookup qn results))
189
190

-- generate documentation for a single module:
191
192
makeDoc :: DocParams -> Bool -> String -> String -> String -> IO ()
makeDoc docparams recursive docdir modname progname = do
193
194
  putStrLn ("Reading comments from file \""++progname++".curry\"...")
  (modcmts,progcmts) <- readComments (progname++".curry")
195
196
  putStrLn ("Reading analysis information for module \""++modname++"\"...")
  anainfo <- readAnaInfo modname
197
198
199
200
201
  makeDocWithComments (docType docparams) docparams recursive docdir
                      anainfo progname modcmts progcmts

makeDocWithComments HtmlDoc docparams recursive docdir anainfo progname
                    modcmts progcmts = do
202
  writeOutfile docparams recursive docdir progname
Michael Hanus 's avatar
Michael Hanus committed
203
               (generateHtmlDocs docparams anainfo progname modcmts progcmts)
204
  translateSource2ColoredHtml docdir progname
205
206
  writeOutfile (DocParams CDoc False False) False docdir progname
               (generateCDoc progname modcmts progcmts anainfo)
207

208
209
210

makeDocWithComments TexDoc docparams recursive docdir anainfo progname
                    modcmts progcmts = do
211
212
  writeOutfile docparams recursive docdir progname
               (generateTexDocs docparams anainfo progname modcmts progcmts)
213
214
215
216


makeDocWithComments CDoc docparams recursive docdir anainfo progname
                    modcmts progcmts = do
217
218
  writeOutfile docparams recursive docdir progname
               (generateCDoc progname modcmts progcmts anainfo)
219
220
221
222
223
224


--- Generates the documentation for a module if it is necessary.
--- I.e., the documentation is generated if no previous documentation
--- file exists or if the existing documentation file is older than
--- the FlatCurry file.
225
226
makeDocIfNecessary :: DocParams -> Bool -> String -> String -> IO ()
makeDocIfNecessary docparams recursive docdir modname = do
227
  progname <- findSourceFileInLoadPath modname
228
  let docfile = docdir </> getLastName progname ++
229
230
231
                (if docType docparams == HtmlDoc then ".html" else ".tex")
  docexists <- doesFileExist docfile
  if not docexists
232
233
234
235
236
237
238
239
240
241
242
   then copyOrMakeDoc docparams recursive docdir modname progname 
   else do
     ctime  <- getModificationTime (flatCurryFileName progname)
     dftime <- getModificationTime docfile
     if compareClockTime ctime dftime == GT
      then copyOrMakeDoc docparams recursive docdir modname progname
      else if recursive
           then do imports <- getImports progname
                   mapIO_ (makeDocIfNecessary docparams recursive docdir)
                          imports
           else done
243
244
245
246
247
248
249
250
251
252

-- get imports of a program by reading the interface, if possible:
getImports progname = do
  let fintname = flatCurryIntName progname
  fintexists <- doesFileExist fintname
  (Prog _ imports _ _ _) <- if fintexists
                            then readFlatCurryFile fintname
                            else readFlatCurryFile (flatCurryFileName progname)
  return imports

253
254
copyOrMakeDoc :: DocParams -> Bool -> String -> String -> String -> IO ()
copyOrMakeDoc docparams recursive docdir modname progname = do
255
256
  hasCopied <- copyDocIfPossible docparams docdir progname
  if hasCopied then done
257
               else makeDoc docparams recursive docdir modname progname
258
259
260
261
262
263
264
265
266

--- Copy the documentation file from standard documentation directoy "CDOC"
--- (used for documentation of system libraries) if possible.
--- Returns true if the copy was possible.
copyDocIfPossible :: DocParams -> String -> String -> IO Bool
copyDocIfPossible docparams docdir progname =
  if docType docparams == TexDoc
  then return False -- ignore copying for TeX docs
  else do
267
268
269
270
    let docprogname = getDirName progname </> "CDOC" </> getLastName progname
        docHtmlFile = docprogname <.> "html"
    docexists <- doesFileExist docHtmlFile
    if not docexists
271
      then return False
272
273
274
275
276
277
278
279
280
281
      else do
        ctime <- getModificationTime (flatCurryFileName progname)
        htime <- getModificationTime docHtmlFile
        if compareClockTime ctime htime == GT
          then return False
          else do
            putStrLn ("Copying doc file from " ++ docHtmlFile)
            system ("cp " ++ docHtmlFile ++ ' ':docdir)
            system ("cp " ++ docprogname ++ "_curry.html "++docdir)
            return True
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296

-----------------------------------------------------------------------
-- auxiliaries:

-- extract directory name from a path name:
getDirName n =
  let revdirname = dropWhile (/='/') (reverse n)
   in if revdirname=="" then "."
                        else reverse (tail revdirname)

-- read a list of FlatCurry modules together with all their imported modules
-- and return the lists of type, function, and operator declarations:
readFlatCurryWithImports :: [String] -> IO ([TypeDecl],[FuncDecl],[OpDecl])
readFlatCurryWithImports modules = collectMods modules []
 where
297
298
299
300
301
302
303
304
  collectMods []     _       = return ([],[],[])
  collectMods (m:ms) implist
    | m `elem` implist = collectMods ms implist
    | otherwise        = do
      filename <- findFileInLoadPath (m <.> "fcy")
      (Prog _ imps types funs ops) <- readFlatCurryFile filename
      (ts,fs,os) <- collectMods (ms++imps) (m:implist)
      return (types++ts, funs++fs, ops++os)
305
306
307
308
309
310
311
312
313
314

-- add a directory name for a Curry source file by looking up the
-- current load path (CURRYPATH):
findSourceFileInLoadPath modname = do
  loadpath <- getLoadPathForFile modname
  mbfname <- lookupFileInPath (baseName modname) [".lcurry",".curry"] loadpath
  maybe (error ("Curry file for module \""++modname++"\" not found!"))
        (return . stripSuffix)
        mbfname

315
316
317
318
319
320
321
-- get the associated file extenstion from DocType
fileExtension :: DocType -> String
fileExtension HtmlDoc = "html"
fileExtension TexDoc  = "tex"
fileExtension CDoc    = "cdoc"

-- harmonized writeFile function for all docType
322
323
writeOutfile :: DocParams -> Bool -> String -> String -> IO String -> IO ()
writeOutfile docparams recursive docdir progname generate = do
324
325
  doc     <- generate
  imports <- getImports progname
326
327
  let outfile = docdir </> getLastName progname <.> fileExtension (docType docparams)
  putStrLn ("Writing documentation to \"" ++ outfile ++ "\"...")
328
329
  writeFile outfile doc
  if recursive
330
    then mapIO_ (makeDocIfNecessary docparams recursive docdir) imports
331
332
333
    else done

-- -----------------------------------------------------------------------