Commit faa9abc7 authored by Björn Peemöller 's avatar Björn Peemöller
Browse files

Adapted HTML generation to hierarchial module names

parent 15bc07e8
...@@ -4,6 +4,12 @@ Change log for curry-frontend ...@@ -4,6 +4,12 @@ Change log for curry-frontend
Under development Under development
================= =================
* HTML generation now places HTML files for hierarchical modules into
files named `<Module>_curry.html`, i.e., no sub-folders reflecting
the the module name hierarchy are generated. In addition, if the option
`--html-dir` is not given, the current directory is used as the output
directory.
* Removed record type extensions * Removed record type extensions
* Enabled declaration of (mutually) recursive record types * Enabled declaration of (mutually) recursive record types
......
...@@ -3,7 +3,7 @@ ...@@ -3,7 +3,7 @@
Description : Build tool for compiling multiple Curry modules Description : Build tool for compiling multiple Curry modules
Copyright : (c) 2005 Martin Engelke Copyright : (c) 2005 Martin Engelke
2007 Sebastian Fischer 2007 Sebastian Fischer
2011 - 2014 Björn Peemöller 2011 - 2015 Björn Peemöller
License : OtherLicense License : OtherLicense
Maintainer : bjp@informatik.uni-kiel.de Maintainer : bjp@informatik.uni-kiel.de
...@@ -13,7 +13,7 @@ ...@@ -13,7 +13,7 @@
This module contains functions to generate Curry representations for a This module contains functions to generate Curry representations for a
Curry source file including all imported modules. Curry source file including all imported modules.
-} -}
module CurryBuilder (buildCurry) where module CurryBuilder (buildCurry, findCurry) where
import Control.Monad (foldM, liftM) import Control.Monad (foldM, liftM)
import Data.Char (isSpace) import Data.Char (isSpace)
......
{- | {- |
Module : $Header$ Module : $Header$
Description : Generating HTML documentation Description : Generating HTML documentation
Copyright : (c) 2011 - 2014, Björn Peemöller Copyright : (c) 2011 - 2015, Björn Peemöller
License : OtherLicense License : OtherLicense
Maintainer : bjp@informatik.uni-kiel.de Maintainer : bjp@informatik.uni-kiel.de
...@@ -11,75 +11,68 @@ ...@@ -11,75 +11,68 @@
This module defines a function for generating HTML documentation pages This module defines a function for generating HTML documentation pages
for Curry source modules. for Curry source modules.
-} -}
{-# LANGUAGE CPP #-}
module Html.CurryHtml (source2html) where module Html.CurryHtml (source2html) where
#if __GLASGOW_HASKELL__ >= 710
import Control.Applicative ((<$>))
#else
import Control.Applicative ((<$>), (<*>))
#endif
import Control.Monad.Writer import Control.Monad.Writer
import Data.List (mapAccumL) import Data.List (mapAccumL)
import Data.Maybe (fromMaybe, isJust) import Data.Maybe (fromMaybe, isJust)
import Network.URI (escapeURIString, isUnreserved) import Network.URI (escapeURIString, isUnreserved)
import System.Directory (copyFile, doesFileExist) import System.Directory (copyFile, doesFileExist)
import System.FilePath ((</>), dropFileName, joinPath, takeBaseName) import System.FilePath ((</>))
import Curry.Base.Ident (ModuleIdent (..), QualIdent (..), unqualify) import Curry.Base.Ident (ModuleIdent (..), QualIdent (..), unqualify)
import Curry.Base.Monad import Curry.Base.Monad (CYIO, liftCYM, failMessages)
import Curry.Base.Pretty (text) import Curry.Base.Pretty ((<+>), text, vcat)
import Curry.Files.Filenames (moduleNameToFile) import Curry.Files.PathUtils (readModule)
import Curry.Files.PathUtils (readModule, lookupCurryFile)
import Curry.Syntax (Module (..), lexSource) import Curry.Syntax (Module (..), lexSource)
import Html.SyntaxColoring import Html.SyntaxColoring
import Base.Messages import Base.Messages (warn, message)
import CompilerOpts (Options (..), WarnOpts (..)) import CompilerOpts (Options (..), WarnOpts (..))
import CurryBuilder (buildCurry) import CurryBuilder (buildCurry, findCurry)
import Modules (loadAndCheckModule) import Modules (loadAndCheckModule)
import Transformations (qual) import Transformations (qual)
import Paths_curry_frontend (getDataFileName) import Paths_curry_frontend (getDataFileName)
-- |'FilePath' of the CSS style file to be added to the documentation.
cssFile :: FilePath cssFile :: FilePath
cssFile = "currysource.css" cssFile = "currysource.css"
-- translate source file into HTML file with syntaxcoloring -- |Translate source file into HTML file with syntaxcoloring
-- @param sourcefilename source2html :: Options -> String -> CYIO ()
source2html :: Options -> FilePath -> CYIO () source2html opts s = do
source2html opts f = do srcFile <- findCurry opts s
let baseName = takeBaseName f (mid, doc) <- docModule opts srcFile
outDir = fromMaybe (dropFileName f) $ optHtmlDir opts let outDir = fromMaybe "." $ optHtmlDir opts
outFile = outDir </> baseName ++ "_curry.html" outFile = outDir </> htmlFile mid
srcFile <- liftIO $ lookupCurryFile ("." : optImportPaths opts) f liftIO $ writeFile outFile doc
(m, program) <- filename2program opts (fromMaybe f srcFile) updateCSSFile opts outDir
liftIO $ writeFile outFile (program2html m program)
liftIO $ updateCSSFile outDir -- |Update the CSS file
updateCSSFile :: Options -> FilePath -> CYIO ()
updateCSSFile :: FilePath -> IO () updateCSSFile opts dir = do
updateCSSFile dir = do src <- liftIO $ getDataFileName cssFile
src <- getDataFileName cssFile
let target = dir </> cssFile let target = dir </> cssFile
exists <- doesFileExist target srcExists <- liftIO $ doesFileExist src
if not exists if srcExists then liftIO $ copyFile src target
then copyFile src target else warn (optWarnOpts opts) [message $ missingStyleFile src ]
else do where
same <- (==) <$> readFile src <*> readFile target missingStyleFile f = vcat
unless same $ copyFile src target [ text "Could not copy CSS style file:"
, text "File" <+> text ("`" ++ f ++ "'") <+> text "does not exist"
-- @param importpaths ]
-- @param filename
-- @return program -- |Create the documentation for the module
filename2program :: Options -> String -> CYIO (ModuleIdent, [Code]) docModule :: Options -> String -> CYIO (ModuleIdent, String)
filename2program opts f = do docModule opts f = do
mbModule <- liftIO $ readModule f mbModule <- liftIO $ readModule f
case mbModule of case mbModule of
Nothing -> failMessages [message $ text $ "Missing file: " ++ f] Nothing -> failMessages [message $ text $ "Missing file: " ++ f]
Just src -> do Just src -> do
toks <- liftCYM $ lexSource f src toks <- liftCYM $ lexSource f src
typed@(Module _ m _ _ _) <- fullParse opts f src typed@(Module _ m _ _ _) <- fullParse opts f src
return (m, genProgram typed toks) return (m, program2html m $ genProgram typed toks)
-- |Return the syntax tree of the source program 'src' (type 'Module'; see -- |Return the syntax tree of the source program 'src' (type 'Module'; see
-- Module "CurrySyntax").after inferring the types of identifiers. -- Module "CurrySyntax").after inferring the types of identifiers.
...@@ -107,7 +100,7 @@ program2html m codes = unlines ...@@ -107,7 +100,7 @@ program2html m codes = unlines
, "<html>", "<head>" , "<html>", "<head>"
, "<meta http-equiv=\"Content-Type\" content=\"text/html;charset=utf-8\" />" , "<meta http-equiv=\"Content-Type\" content=\"text/html;charset=utf-8\" />"
, "<title>" ++ titleHtml ++ "</title>" , "<title>" ++ titleHtml ++ "</title>"
, "<link rel=\"stylesheet\" type=\"text/css\" href=\"" ++ styleLink ++ "\"/>" , "<link rel=\"stylesheet\" type=\"text/css\" href=\"" ++ cssFile ++ "\"/>"
, "</head>" , "</head>"
, "<body>" , "<body>"
, "<table><tbody><tr>" , "<table><tbody><tr>"
...@@ -119,7 +112,6 @@ program2html m codes = unlines ...@@ -119,7 +112,6 @@ program2html m codes = unlines
] ]
where where
titleHtml = "Module " ++ show m titleHtml = "Module " ++ show m
styleLink = makeTopPath m </> cssFile
lineHtml = unlines $ map show [1 .. length (lines codeHtml)] lineHtml = unlines $ map show [1 .. length (lines codeHtml)]
codeHtml = concat $ snd $ mapAccumL (code2html m) [] codes codeHtml = concat $ snd $ mapAccumL (code2html m) [] codes
...@@ -177,12 +169,11 @@ addHtmlLink m str qid = ...@@ -177,12 +169,11 @@ addHtmlLink m str qid =
(mmid, ident) = (qidModule qid, qidIdent qid) (mmid, ident) = (qidModule qid, qidIdent qid)
makeRelativePath :: ModuleIdent -> ModuleIdent -> String makeRelativePath :: ModuleIdent -> ModuleIdent -> String
makeRelativePath cur new makeRelativePath cur new | cur == new = ""
| cur == new = "" | otherwise = htmlFile new
| otherwise = makeTopPath cur </> moduleNameToFile new ++ "_curry.html"
makeTopPath :: ModuleIdent -> String htmlFile :: ModuleIdent -> String
makeTopPath m = joinPath $ replicate (length (midQualifiers m) - 1) ".." htmlFile m = show m ++ "_curry.html"
isCall :: Code -> Bool isCall :: Code -> Bool
isCall (TypeCons TypeExport _) = True isCall (TypeCons TypeExport _) = True
......
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