CurryDoc.curry 15.5 KB
Newer Older
1 2 3 4
----------------------------------------------------------------------
--- Implementation of CurryDoc, a utility for the automatic
--- generation of HTML documentation from Curry programs.
---
5 6
--- @author Michael Hanus, Jan Tikovsky
--- @version June 2015
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
import AbstractCurry.Files
32 33 34
import Directory
import Distribution
import FileGoodies
35
import FilePath ((</>), (<.>), dropFileName, takeFileName)
36 37 38
import FlatCurry.Types
import FlatCurry.Files
import FlatCurry.Read(readFlatCurryWithImports)
39
import Function
40
import List
41
import Maybe(fromJust)
42 43
import System
import Time
44

45
import AnalysisServer(initializeAnalysisSystem,analyzeInterface)
46 47 48 49
import Deterministic
import TotallyDefined
import Indeterministic
import SolutionCompleteness
50

51
import CurryDocAnaInfo
52 53 54 55 56
import CurryDocParams
import CurryDocRead
import CurryDocHtml
import CurryDocTeX
import CurryDocCDoc
Michael Hanus 's avatar
Michael Hanus committed
57
import CurryDocConfig
58 59 60 61

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

62
greeting :: String
63
greeting = "CurryDoc (" ++ currydocVersion ++ ") - the Curry Documentation Tool\n"
64 65 66

-- Directory where include files for generated documention (e.g., icons,
-- css, tex includes) are stored:
67
includeDir :: String
68
includeDir = installDir </> "include"
69 70 71

--------------------------------------------------------------------------
-- Check arguments and call main function:
72
main :: IO ()
73 74 75 76
main = do
  args <- getArgs
  processArgs defaultCurryDocParams args

77
processArgs :: DocParams -> [String] -> IO ()
78 79 80 81 82 83 84 85 86 87
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))
88
                      True docdir (stripCurrySuffix modname)
89 90
  -- HTML index only
  ("--onlyindexhtml":docdir:modnames) ->
91
                      makeIndexPages docdir (map stripCurrySuffix modnames)
92 93
  ("--libsindexhtml":docdir:modnames) ->
                      makeSystemLibsIndex docdir modnames
94 95 96 97
  (('-':_):_) -> putStrLn usageMessage
  -- module
  [modname] ->
      makeCompleteDoc params (docType params == HtmlDoc)
98 99
                      ("DOC_" ++ stripCurrySuffix (takeFileName modname))
                      (stripCurrySuffix modname)
100 101 102
  -- docdir + module
  [docdir,modname] ->
      makeCompleteDoc params (docType params == HtmlDoc) docdir
103
                      (stripCurrySuffix modname)
104 105
  _ -> putStrLn usageMessage

106
usageMessage :: String
107 108 109 110 111
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>"
112
 , "       currydoc --libsindexhtml <doc directory> <module_names>"
113 114 115
 ]


116 117 118 119 120

-- create directory if not existent:
createDir :: String -> IO ()
createDir dir = do
  exdir <- doesDirectoryExist dir
Michael Hanus 's avatar
Michael Hanus committed
121
  unless exdir $ system ("mkdir " ++ dir) >> done
122 123 124 125 126 127 128 129 130

--------------------------------------------------------------------------
--- 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 ()
131
makeCompleteDoc docparams recursive reldocdir modpath = do
132
  putStrLn greeting
133
  docdir <- makeAbsolute reldocdir
134
  prepareDocDir (docType docparams) docdir
135 136 137 138 139 140 141
  lookupModuleSourceInLoadPath modpath >>=
   maybe (error $ "Source code of module '"++modpath++"' not found!")
    (\ (moddir,_) -> do
      let modname = takeFileName modpath
      setCurrentDirectory moddir
      -- parsing source program:
      callFrontend FCY modname
142 143
      -- generate abstract curry representation
      callFrontend ACY modname
144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167
      -- when constructing CDOC the imported modules don't have to be read
      -- from the FlatCurry file
      (alltypes,allfuns) <- getProg modname $ docType docparams
      makeDocIfNecessary docparams recursive docdir modname
      when (withIndex docparams) $ do
        genMainIndexPage     docdir [modname]
        genFunctionIndexPage docdir allfuns
        genConsIndexPage     docdir alltypes
      -- change access rights to readable for everybody:
      system ("chmod -R go+rX "++docdir)
      putStrLn ("Documentation files written into directory "++docdir) )
 where
  getProg modname HtmlDoc = readTypesFuncsWithImports modname
  getProg modname TexDoc  = readTypesFuncsWithImports modname
  getProg modname CDoc    = do (Prog _ _ types funs _) <- readFlatCurry modname
                               return (types,funs)

--- Transform a file path into an absolute file path:
makeAbsolute :: String -> IO String
makeAbsolute f =
  if isAbsolute f
  then return f
  else do curdir <- getCurrentDirectory
          return (curdir </> f)
168 169 170 171

--- Generate only the index pages for a list of (already compiled!) modules:
makeIndexPages :: String -> [String] -> IO ()
makeIndexPages docdir modnames = do
172
  putStrLn greeting
173
  prepareDocDir HtmlDoc docdir
174
  (alltypes,allfuns) <- mapIO readTypesFuncs modnames >>= return . unzip
Michael Hanus 's avatar
Michael Hanus committed
175
  genMainIndexPage     docdir modnames
176 177
  genFunctionIndexPage docdir (concat allfuns)
  genConsIndexPage     docdir (concat alltypes)
178 179 180
  -- change access rights to readable for everybody:
  system ("chmod -R go+rX "++docdir)
  done
181 182
 where
  readTypesFuncs modname = do
183
    fcyfile <- getFlatCurryFileInLoadPath modname
184 185
    (Prog _ _ types funs _) <- readFlatCurryFile fcyfile
    return (types,funs)
186

187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205
--- Generate a system library index page categorizing the given
--- (already compiled!) modules
makeSystemLibsIndex :: String -> [String] -> IO ()
makeSystemLibsIndex docdir modnames = do
  -- generate index pages (main index, function index, constructor index)
  makeIndexPages docdir modnames
  putStrLn ("Categorizing modules ...")
  modInfos <- mapIO getModInfo modnames
  putStrLn ("Grouping modules by categories ...")
  let grpMods = map sortByName $ groupByCategory $ sortByCategory modInfos
      cats    = sortBy (<=) $ nub $ map fst3 modInfos
  genSystemLibsPage docdir cats grpMods
 where
  fst3 (x,_,_)    = x
  snd3 (_,y,_)    = y
  sortByCategory  = sortBy ((<=) `on` fst3)
  groupByCategory = groupBy ((==) `on` fst3)
  sortByName      = sortBy ((<=) `on` snd3)

206
getModInfo :: String -> IO (Category,String,String)
207 208 209 210 211 212 213 214 215 216
getModInfo modname = do
  mmodsrc <- lookupModuleSourceInLoadPath modname
  case mmodsrc of
    Nothing           -> error $ "Source code of module '"++modname++"' not found!"
    Just (_,progname) -> do
      (modcmts,_) <- readComments progname
      let (modcmt,catcmts) = splitComment modcmts
          category         = readCategory $ getCommentType "category" catcmts
      return (category,modname,firstPassage modcmt)

217 218 219 220
-- create documentation directory (if necessary) with gifs and stylesheets:
prepareDocDir :: DocType -> String -> IO ()
prepareDocDir HtmlDoc docdir = do
  createDir docdir
221
  --putStrLn ("Copying icons into documentation directory \""++docdir++"\"...")
222
  -- copying all icons:
223
  --copyIncludeIfPresent docdir "currydocicons/*.gif"
224
  -- copy style sheet:
225
  copyIncludeIfPresent docdir "currydoc.css"
226 227 228 229
prepareDocDir TexDoc docdir = do
  createDir docdir
  putStrLn $ "Copy macros into documentation directory \""++docdir++"\"..."
  copyIncludeIfPresent docdir "currydoc.tex"
230 231
prepareDocDir CDoc docdir = do
  createDir docdir
232
  putStrLn ("Directory was succesfully created")
233

234
copyIncludeIfPresent :: String -> String -> IO ()
235 236
copyIncludeIfPresent docdir inclfile = do
  existIDir <- doesDirectoryExist includeDir
Michael Hanus 's avatar
Michael Hanus committed
237 238
  when existIDir $
    system ("cp "++includeDir++"/"++inclfile++" "++docdir) >> done
239

240
-- read and generate all analysis infos:
241
readAnaInfo :: String -> IO AnaInfo
242
readAnaInfo modname = do
243
  initializeAnalysisSystem
Michael Hanus 's avatar
Michael Hanus committed
244
  nondet   <- analyzeInterface nondetAnalysis  modname >>= stopIfError
245 246 247 248 249 250 251 252 253 254
  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))
255 256

-- generate documentation for a single module:
257 258 259 260 261
makeDoc :: DocParams -> Bool -> String -> String -> IO ()
makeDoc docparams recursive docdir modname = do
  Just (_,progname) <- lookupModuleSourceInLoadPath modname
  putStrLn ("Reading comments from file '"++progname++"'...")
  (modcmts,progcmts) <- readComments progname
262 263
  putStrLn ("Reading analysis information for module \""++modname++"\"...")
  anainfo <- readAnaInfo modname
264
  makeDocWithComments (docType docparams) docparams recursive docdir
265 266
                      anainfo modname modcmts progcmts

267

268 269 270
makeDocWithComments :: DocType -> DocParams -> Bool -> String -> AnaInfo
                    -> String -> String -> [(SourceLine,String)] -> IO ()
makeDocWithComments HtmlDoc docparams recursive docdir anainfo modname
271
                    modcmts progcmts = do
272 273 274 275
  -- ensure that the AbstractCurry file for the module exists
  loadpath <- getLoadPathForModule modname
  modpath <- lookupFileInPath (abstractCurryFileName modname) [""] loadpath
  unless (modpath /= Nothing) $ callFrontend ACY modname
276 277 278 279 280
  writeOutfile docparams recursive docdir modname
               (generateHtmlDocs docparams anainfo modname modcmts progcmts)
  translateSource2ColoredHtml docdir modname
  writeOutfile (DocParams CDoc False False) False docdir modname
               (generateCDoc modname modcmts progcmts anainfo)
281

282

283
makeDocWithComments TexDoc docparams recursive docdir anainfo modname
284
                    modcmts progcmts = do
285 286
  writeOutfile docparams recursive docdir modname
               (generateTexDocs docparams anainfo modname modcmts progcmts)
287 288


289
makeDocWithComments CDoc docparams recursive docdir anainfo modname
290
                    modcmts progcmts = do
291 292
  writeOutfile docparams recursive docdir modname
               (generateCDoc modname modcmts progcmts anainfo)
293 294 295 296 297 298


--- 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.
299 300
makeDocIfNecessary :: DocParams -> Bool -> String -> String -> IO ()
makeDocIfNecessary docparams recursive docdir modname = do
301
  let docfile = docdir </> modname ++
302 303 304
                (if docType docparams == HtmlDoc then ".html" else ".tex")
  docexists <- doesFileExist docfile
  if not docexists
305
   then copyOrMakeDoc docparams recursive docdir modname
306
   else do
307
     ctime  <- getFlatCurryFileInLoadPath modname >>= getModificationTime
308 309
     dftime <- getModificationTime docfile
     if compareClockTime ctime dftime == GT
310
      then copyOrMakeDoc docparams recursive docdir modname
Michael Hanus 's avatar
Michael Hanus committed
311
      else when recursive $ do
312
             imports <- getImports modname
Michael Hanus 's avatar
Michael Hanus committed
313
             mapIO_ (makeDocIfNecessary docparams recursive docdir) imports
314

315 316 317
-- get imports of a module by reading the interface, if possible:
getImports :: String -> IO [String]
getImports modname = do
318 319
  mbfintfile <- getLoadPathForModule modname >>=
                lookupFileInPath (flatCurryIntName modname) [""]
320
  (Prog _ imports _ _ _) <- maybe
321 322
                             (getFlatCurryFileInLoadPath modname >>=
                              readFlatCurryFile)
323 324
                             readFlatCurryFile
                             mbfintfile
325 326
  return imports

327 328 329 330
copyOrMakeDoc :: DocParams -> Bool -> String -> String -> IO ()
copyOrMakeDoc docparams recursive docdir modname = do
  hasCopied <- copyDocIfPossible docparams docdir modname
  unless hasCopied $ makeDoc docparams recursive docdir modname
331 332 333 334 335

--- 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
336
copyDocIfPossible docparams docdir modname =
337 338 339
  if docType docparams == TexDoc
  then return False -- ignore copying for TeX docs
  else do
340 341
    mdir <- lookupModuleSourceInLoadPath modname >>= return . fst . fromJust
    let docprogname = mdir </> "CDOC" </> modname
342 343 344
        docHtmlFile = docprogname <.> "html"
    docexists <- doesFileExist docHtmlFile
    if not docexists
345
      then return False
346
      else do
347
        ctime <- getModificationTime (mdir </> flatCurryFileName modname)
348 349 350 351 352 353 354 355
        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
356 357 358 359

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

360 361 362 363 364 365 366
-- reads all types and function declarations (also imported ones) of
-- a module:
readTypesFuncsWithImports :: String -> IO ([TypeDecl],[FuncDecl])
readTypesFuncsWithImports modname = do
  allprogs <- readFlatCurryWithImports modname
  let (ts,fs) = unzip (map (\ (Prog _ _ types funs _) -> (types,funs)) allprogs)
  return (concat ts, concat fs)
367

368 369 370 371 372 373 374
-- 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
375
writeOutfile :: DocParams -> Bool -> String -> String -> IO String -> IO ()
376
writeOutfile docparams recursive docdir modname generate = do
377
  doc     <- generate
378 379
  imports <- getImports modname
  let outfile = docdir </> modname <.> fileExtension (docType docparams)
380
  putStrLn ("Writing documentation to \"" ++ outfile ++ "\"...")
381
  writeFile outfile doc
Michael Hanus 's avatar
Michael Hanus committed
382 383
  when recursive $
    mapIO_ (makeDocIfNecessary docparams recursive docdir) imports
384

385
-- -----------------------------------------------------------------------