Skip to content

GitLab

Commit af57b8a4 authored by Michael Hanus's avatar Michael Hanus
Browse files

currydoc updated to respect hierarchical module names

parent c64b7b46
Hide whitespace changes
Inline Side-by-side
currydoc/CurryDoc.curry
View file @ af57b8a4
......@@ -3,7 +3,7 @@
--- generation of HTML documentation from Curry programs.
---
--- @author Michael Hanus
--- @version January 2014
--- @version January 2015
----------------------------------------------------------------------
-- * All comments to be put into the HTML documentation must be
......@@ -31,9 +31,11 @@ module CurryDoc where
import Directory
import Distribution
import FileGoodies
import FilePath ((</>), (<.>))
import FilePath ((</>), (<.>), dropFileName, takeFileName)
import FlatCurry
import FlatCurryRead(readFlatCurryWithImports)
import List
import Maybe(fromJust)
import System
import Time
......@@ -53,18 +55,22 @@ import CurryDocConfig
--------------------------------------------------------------------------
-- Global definitions:
greeting :: String
greeting = "CurryDoc (" ++ currydocVersion ++ ") - the Curry Documentation Tool\n"
-- Directory where include files for generated documention (e.g., icons,
-- css, tex includes) are stored:
includeDir :: String
includeDir = installDir </> "include"
--------------------------------------------------------------------------
-- Check arguments and call main function:
main :: IO ()
main = do
args <- getArgs
processArgs defaultCurryDocParams args
processArgs :: DocParams -> [String] -> IO ()
processArgs params args = case args of
-- no markdown
("--nomarkdown":margs) -> processArgs (setMarkDown False params) margs
......@@ -75,21 +81,23 @@ processArgs params args = case args of
-- HTML without index
["--noindexhtml",docdir,modname] ->
makeCompleteDoc (setIndex False (setDocType HtmlDoc params))
True docdir (stripSuffix modname)
True docdir (stripCurrySuffix modname)
-- HTML index only
("--onlyindexhtml":docdir:modnames) ->
makeIndexPages docdir (map stripSuffix modnames)
makeIndexPages docdir (map stripCurrySuffix modnames)
(('-':_):_) -> putStrLn usageMessage
-- module
[modname] ->
makeCompleteDoc params (docType params == HtmlDoc)
("DOC_" ++ stripSuffix modname) (stripSuffix modname)
("DOC_" ++ stripCurrySuffix (takeFileName modname))
(stripCurrySuffix modname)
-- docdir + module
[docdir,modname] ->
makeCompleteDoc params (docType params == HtmlDoc) docdir
(stripSuffix modname)
(stripCurrySuffix modname)
_ -> putStrLn usageMessage
usageMessage :: String
usageMessage = unlines
[ "ERROR: Illegal arguments for currydoc"
, "Usage: currydoc [--nomarkdown] [--html|--tex|--cdoc] [<doc directory>] <module_name>"
......@@ -113,40 +121,59 @@ createDir dir = do
--- @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
makeCompleteDoc docparams recursive reldocdir modpath = do
putStrLn greeting
docdir <- makeAbsolute reldocdir
prepareDocDir (docType docparams) docdir
-- parsing source program:
callFrontend FCY modname
-- when constructing CDOC the imported modules don't have to be read from the flatCurryFile
(alltypes, allfuns, _) <- getProg $ 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)
done
where getProg HtmlDoc = readFlatCurryWithImports [modname]
getProg TexDoc = readFlatCurryWithImports [modname]
getProg CDoc = do
Prog _ _ t f o <- readFlatCurry modname
return (t, f, o)
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
-- 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)
--- Generate only the index pages for a list of (already compiled!) modules:
makeIndexPages :: String -> [String] -> IO ()
makeIndexPages docdir modnames = do
putStrLn greeting
prepareDocDir HtmlDoc docdir
(alltypes,allfuns,_) <- readFlatCurryWithImports modnames
(alltypes,allfuns) <- mapIO readTypesFuncs modnames >>= return . unzip
genMainIndexPage docdir modnames
genFunctionIndexPage docdir allfuns
genConsIndexPage docdir alltypes
genFunctionIndexPage docdir (concat allfuns)
genConsIndexPage docdir (concat alltypes)
-- change access rights to readable for everybody:
system ("chmod -R go+rX "++docdir)
done
where
readTypesFuncs modname = do
fcyfile <- findFileInLoadPath (flatCurryFileName modname)
(Prog _ _ types funs _) <- readFlatCurryFile fcyfile
return (types,funs)
-- create documentation directory (if necessary) with gifs and stylesheets:
prepareDocDir :: DocType -> String -> IO ()
......@@ -165,12 +192,14 @@ prepareDocDir CDoc docdir = do
createDir docdir
putStrLn ("Directory was succesfully created")
copyIncludeIfPresent :: String -> String -> IO ()
copyIncludeIfPresent docdir inclfile = do
existIDir <- doesDirectoryExist includeDir
when existIDir $
system ("cp "++includeDir++"/"++inclfile++" "++docdir) >> done
-- read and generate all analysis infos:
readAnaInfo :: String -> IO AnaInfo
readAnaInfo modname = do
initializeAnalysisSystem
nondet <- analyzeInterface nondetAnalysis modname >>= stopIfError
......@@ -186,34 +215,38 @@ readAnaInfo modname = do
(lookup qn results))
-- generate documentation for a single module:
makeDoc :: DocParams -> Bool -> String -> String -> String -> IO ()
makeDoc docparams recursive docdir modname progname = do
putStrLn ("Reading comments from file \""++progname++".curry\"...")
(modcmts,progcmts) <- readComments (progname++".curry")
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
putStrLn ("Reading analysis information for module \""++modname++"\"...")
anainfo <- readAnaInfo modname
makeDocWithComments (docType docparams) docparams recursive docdir
anainfo progname modcmts progcmts
anainfo modname modcmts progcmts
makeDocWithComments HtmlDoc docparams recursive docdir anainfo progname
makeDocWithComments :: DocType -> DocParams -> Bool -> String -> AnaInfo
-> String -> String -> [(SourceLine,String)] -> IO ()
makeDocWithComments HtmlDoc docparams recursive docdir anainfo modname
modcmts progcmts = do
writeOutfile docparams recursive docdir progname
(generateHtmlDocs docparams anainfo progname modcmts progcmts)
translateSource2ColoredHtml docdir progname
writeOutfile (DocParams CDoc False False) False docdir progname
(generateCDoc progname modcmts progcmts anainfo)
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)
makeDocWithComments TexDoc docparams recursive docdir anainfo progname
makeDocWithComments TexDoc docparams recursive docdir anainfo modname
modcmts progcmts = do
writeOutfile docparams recursive docdir progname
(generateTexDocs docparams anainfo progname modcmts progcmts)
writeOutfile docparams recursive docdir modname
(generateTexDocs docparams anainfo modname modcmts progcmts)
makeDocWithComments CDoc docparams recursive docdir anainfo progname
makeDocWithComments CDoc docparams recursive docdir anainfo modname
modcmts progcmts = do
writeOutfile docparams recursive docdir progname
(generateCDoc progname modcmts progcmts anainfo)
writeOutfile docparams recursive docdir modname
(generateCDoc modname modcmts progcmts anainfo)
--- Generates the documentation for a module if it is necessary.
......@@ -222,50 +255,54 @@ makeDocWithComments CDoc docparams recursive docdir anainfo progname
--- the FlatCurry file.
makeDocIfNecessary :: DocParams -> Bool -> String -> String -> IO ()
makeDocIfNecessary docparams recursive docdir modname = do
progname <- findSourceFileInLoadPath modname
let docfile = docdir </> getLastName progname ++
let docfile = docdir </> modname ++
(if docType docparams == HtmlDoc then ".html" else ".tex")
docexists <- doesFileExist docfile
if not docexists
then copyOrMakeDoc docparams recursive docdir modname progname
then copyOrMakeDoc docparams recursive docdir modname
else do
ctime <- getModificationTime (flatCurryFileName progname)
ctime <- findFileInLoadPath (flatCurryFileName modname)
>>= getModificationTime
dftime <- getModificationTime docfile
if compareClockTime ctime dftime == GT
then copyOrMakeDoc docparams recursive docdir modname progname
then copyOrMakeDoc docparams recursive docdir modname
else when recursive $ do
imports <- getImports progname
imports <- getImports modname
mapIO_ (makeDocIfNecessary docparams recursive docdir) imports
-- 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)
-- get imports of a module by reading the interface, if possible:
getImports :: String -> IO [String]
getImports modname = do
let fintname = flatCurryIntName modname
fcyname = flatCurryFileName modname
mbfintfile <- lookupFileInLoadPath fintname
(Prog _ imports _ _ _) <- maybe
(findFileInLoadPath fcyname >>= readFlatCurryFile)
readFlatCurryFile
mbfintfile
return imports
copyOrMakeDoc :: DocParams -> Bool -> String -> String -> String -> IO ()
copyOrMakeDoc docparams recursive docdir modname progname = do
hasCopied <- copyDocIfPossible docparams docdir progname
unless hasCopied $ makeDoc docparams recursive docdir modname progname
copyOrMakeDoc :: DocParams -> Bool -> String -> String -> IO ()
copyOrMakeDoc docparams recursive docdir modname = do
hasCopied <- copyDocIfPossible docparams docdir modname
unless hasCopied $ makeDoc docparams recursive docdir modname
--- 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 =
copyDocIfPossible docparams docdir modname =
if docType docparams == TexDoc
then return False -- ignore copying for TeX docs
else do
let docprogname = getDirName progname </> "CDOC" </> getLastName progname
mdir <- lookupModuleSourceInLoadPath modname >>= return . fst . fromJust
let docprogname = mdir </> "CDOC" </> modname
docHtmlFile = docprogname <.> "html"
docexists <- doesFileExist docHtmlFile
if not docexists
then return False
else do
ctime <- getModificationTime (flatCurryFileName progname)
ctime <- getModificationTime (mdir </> flatCurryFileName modname)
htime <- getModificationTime docHtmlFile
if compareClockTime ctime htime == GT
then return False
......@@ -278,34 +315,13 @@ copyDocIfPossible docparams docdir progname =
-----------------------------------------------------------------------
-- 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
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)
-- 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
-- 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)
-- get the associated file extenstion from DocType
fileExtension :: DocType -> String
......@@ -315,13 +331,13 @@ fileExtension CDoc = "cdoc"
-- harmonized writeFile function for all docType
writeOutfile :: DocParams -> Bool -> String -> String -> IO String -> IO ()
writeOutfile docparams recursive docdir progname generate = do
writeOutfile docparams recursive docdir modname generate = do
doc <- generate
imports <- getImports progname
let outfile = docdir </> getLastName progname <.> fileExtension (docType docparams)
imports <- getImports modname
let outfile = docdir </> modname <.> fileExtension (docType docparams)
putStrLn ("Writing documentation to \"" ++ outfile ++ "\"...")
writeFile outfile doc
when recursive $
mapIO_ (makeDocIfNecessary docparams recursive docdir) imports
-- -----------------------------------------------------------------------
\ No newline at end of file
-- -----------------------------------------------------------------------
currydoc/CurryDocCDoc.curry
View file @ af57b8a4
......@@ -8,14 +8,17 @@ module CurryDocCDoc where
import CurryDocParams
import CurryDocRead
import Distribution(findFileInLoadPath)
import FlatCurry
import FlexRigid
import ReadShowTerm
import List
generateCDoc :: String -> String -> [(SourceLine,String)] -> AnaInfo -> IO String
generateCDoc progName modCmts progCmts anaInfo = do
Prog modName _ types functions _ <- readFlatCurryFile fcyName
generateCDoc :: String -> String -> [(SourceLine,String)] -> AnaInfo
-> IO String
generateCDoc modName modCmts progCmts anaInfo = do
fcyName <- findFileInLoadPath (flatCurryFileName modName)
Prog _ _ types functions _ <- readFlatCurryFile fcyName
let modInfo = ModuleInfo modName (author avCmts) mCmts
funcInfo (Func qName@(mName, fName) _ _ tExpr rule) =
FunctionInfo fName
......@@ -43,9 +46,9 @@ generateCDoc progName modCmts progCmts anaInfo = do
typeInfos = map typeInfo (concatMap filterT types)
putStrLn $ "Writing " ++ modName ++ ".cdoc file"
return $ showTerm (CurryInfo modInfo funcInfos typeInfos)
where fcyName = flatCurryFileName progName
filterT f@(Type _ vis _ _) = if vis == Public then [f] else []
filterT f@(TypeSyn _ vis _ _) = if vis == Public then [f] else []
where
filterT f@(Type _ vis _ _) = if vis == Public then [f] else []
filterT f@(TypeSyn _ vis _ _) = if vis == Public then [f] else []
funcComment :: String -> [(SourceLine,String)] -> String
funcComment str = fst . splitComment . getFuncComment str
......
currydoc/CurryDocHtml.curry
View file @ af57b8a4
......@@ -2,7 +2,7 @@
--- Operations to generate documentation in HTML format.
---
--- @author Michael Hanus
--- @version January 2014
--- @version January 2015
----------------------------------------------------------------------
module CurryDocHtml where
......@@ -11,6 +11,7 @@ import CurryDocParams
import CurryDocRead
import CurryDocConfig
import TotallyDefined(Completeness(..))
import FilePath
import FlatCurry
import FlexRigid
import HTML
......@@ -30,8 +31,8 @@ infixl 0 `withTitle`
-- are already analyzed.
generateHtmlDocs :: DocParams -> AnaInfo -> String -> String
-> [(SourceLine,String)] -> IO String
generateHtmlDocs docparams anainfo progname modcmts progcmts = do
let fcyname = flatCurryFileName progname
generateHtmlDocs docparams anainfo modname modcmts progcmts = do
fcyname <- findFileInLoadPath (flatCurryFileName modname)
putStrLn $ "Reading FlatCurry program \""++fcyname++"\"..."
(Prog _ imports types functions ops) <- readFlatCurryFile fcyname
let exptypes = filter isExportedType types
......@@ -55,13 +56,13 @@ generateHtmlDocs docparams anainfo progname modcmts progcmts = do
concatMap (genHtmlType docparams progcmts) exptypes) ++
[anchored "exported_operations"
[h2 [htxt "Exported operations:"]]] ++
(map (genHtmlFunc docparams progname progcmts anainfo ops) expfuns)))
(map (genHtmlFunc docparams modname progcmts anainfo ops) expfuns)))
where
title = "Module "++getLastName progname
title = "Module "++modname
htmltitle = [h1 [htxt "Module ",
href (getLastName progname++"_curry.html")
[htxt (getLastName progname++".curry")]]]
href (modname++"_curry.html")
[htxt (modname++".curry")]]]
lefttopmenu types =
[[href "?" [htxt title]],
......@@ -215,14 +216,14 @@ genHtmlFuncShort docparams progcmts anainfo
-- generate HTML documentation for a function:
genHtmlFunc :: DocParams -> String -> [(SourceLine,String)] -> AnaInfo
-> [OpDecl] -> FuncDecl -> HtmlExp
genHtmlFunc docparams progname progcmts anainfo ops
genHtmlFunc docparams modname progcmts anainfo ops
(Func (fmod,fname) _ _ ftype rule) =
let (funcmt,paramcmts) = splitComment (getFuncComment fname progcmts)
in anchored fname
[borderedTable [[
[par $
[code [opnameDoc
[href (getLastName progname++"_curry.html#"++fname)
[href (modname++"_curry.html#"++fname)
[htxt (showId fname)]],
HtmlText (" :: "++ showType fmod False ftype)],
nbsp, nbsp] ++
......@@ -378,19 +379,19 @@ showTypeCons mod (mtc,tc) =
--------------------------------------------------------------------------
-- translate source file into HTML file with syntax coloring
translateSource2ColoredHtml :: String -> String -> IO ()
translateSource2ColoredHtml docdir progname = do
let output = docdir++"/"++getLastName progname++"_curry.html"
translateSource2ColoredHtml docdir modname = do
let output = docdir </> modname++"_curry.html"
putStrLn ("Writing source file as HTML to \""++output++"\"...")
callFrontendWithParams HTML
(setQuiet True (setHtmlDir docdir defaultParams)) progname
(setQuiet True (setHtmlDir docdir defaultParams)) modname
-- translate source file into HTML file with anchors for each function:
translateSource2AnchoredHtml :: String -> String -> IO ()
translateSource2AnchoredHtml docdir progname =
do putStrLn ("Writing source file as HTML to \""++docdir++"/"++getLastName progname++"_curry.html\"...")
prog <- readFile (progname++".curry")
writeFile (docdir++"/"++getLastName progname++"_curry.html")
(showPageWithDocStyle (progname++".curry")
translateSource2AnchoredHtml docdir modname =
do putStrLn ("Writing source file as HTML to \""++docdir++"/"++modname++"_curry.html\"...")
prog <- readFile (modname++".curry")
writeFile (docdir </> modname++"_curry.html")
(showPageWithDocStyle (modname++".curry")
[HtmlStruct "pre" []
[HtmlText (addFuncAnchors [] (lines prog))]])
......
currydoc/CurryDocRead.curry
View file @ af57b8a4
......@@ -2,6 +2,7 @@
--- Some auxiliary operations of CurryDoc to read programs.
---
--- @author Michael Hanus
--- @version January 2015
----------------------------------------------------------------------
module CurryDocRead where
......
currydoc/CurryDocTeX.curry
View file @ af57b8a4
......@@ -2,12 +2,14 @@
--- Functions to generate documentation in TeX format.
---
--- @author Michael Hanus
--- @version January 2015
----------------------------------------------------------------------
module CurryDocTeX where
import CurryDocParams
import CurryDocRead
import Distribution
import FlatCurry
import HTML
import HtmlParser
......@@ -20,15 +22,15 @@ import Markdown
-- are already analyzed.
generateTexDocs :: DocParams -> AnaInfo -> String -> String
-> [(SourceLine,String)] -> IO String
generateTexDocs docparams anainfo progname modcmts progcmts = do
let fcyname = flatCurryFileName progname
generateTexDocs docparams anainfo modname modcmts progcmts = do
fcyname <- findFileInLoadPath (flatCurryFileName modname)
putStrLn $ "Reading FlatCurry program \""++fcyname++"\"..."
(Prog _ _ types functions _) <- readFlatCurryFile fcyname
let textypes = concatMap (genTexType docparams progcmts) types
texfuncs = concatMap (genTexFunc docparams progcmts anainfo) functions
modcmt = fst (splitComment modcmts)
return $
"\\currymodule{"++getLastName progname++"}\n" ++
"\\currymodule{"++modname++"}\n" ++
htmlString2Tex docparams modcmt ++ "\n" ++
(if null textypes then ""
else "\\currytypesstart\n" ++ textypes ++ "\\currytypesstop\n") ++
......
currydoc/Makefile
View file @ af57b8a4
......@@ -12,7 +12,8 @@ TOOL = $(BINDIR)/currydoc
# Source modules of currydoc
DEPS = CurryDoc.curry CurryDocRead.curry CurryDocHtml.curry \
CurryDocTeX.curry CurryDocParams.curry CurryDocConfig.curry \
CurryDocTeX.curry CurryDocCDoc.curry \
CurryDocParams.curry CurryDocConfig.curry \
BootstrapStyle.curry \
$(LIBDIR)/Markdown.curry \
$(METADIR)/FlexRigid.curry \
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment