From 8e06728afb0784128ab2df0be7a5d7a191d30ff4 Mon Sep 17 00:00:00 2001 From: Mateusz Kowalczyk Date: Thu, 22 Jan 2015 23:34:05 +0000 Subject: --package-name and --package-version flags Used for --hoogle amongst other things. Now we need to teach cabal to use it. The situation is still a bit sub-par because if the flags aren't passed in, the crash will occur. Closes #353. --- haddock-api/src/Haddock/Options.hs | 37 +++++++++++++++++++++++++++++-------- 1 file changed, 29 insertions(+), 8 deletions(-) (limited to 'haddock-api/src/Haddock/Options.hs') diff --git a/haddock-api/src/Haddock/Options.hs b/haddock-api/src/Haddock/Options.hs index 3fa6397f..e847333e 100644 --- a/haddock-api/src/Haddock/Options.hs +++ b/haddock-api/src/Haddock/Options.hs @@ -28,15 +28,21 @@ module Haddock.Options ( qualification, verbosity, ghcFlags, - readIfaceArgs + readIfaceArgs, + optPackageName, + optPackageVersion ) where -import Distribution.Verbosity -import Haddock.Utils -import Haddock.Types -import System.Console.GetOpt import qualified Data.Char as Char +import Data.Version +import Distribution.Verbosity +import FastString +import Haddock.Types +import Haddock.Utils +import Packages +import System.Console.GetOpt +import qualified Text.ParserCombinators.ReadP as RP data Flag @@ -83,7 +89,9 @@ data Flag | Flag_Qualification String | Flag_PrettyHtml | Flag_NoPrintMissingDocs - deriving (Eq) + | Flag_PackageName String + | Flag_PackageVersion String + deriving (Eq, Show) options :: Bool -> [OptDescr Flag] @@ -107,7 +115,7 @@ options backwardsCompat = Option [] ["latex-style"] (ReqArg Flag_LaTeXStyle "FILE") "provide your own LaTeX style in FILE", Option ['U'] ["use-unicode"] (NoArg Flag_UseUnicode) "use Unicode in HTML output", Option [] ["hoogle"] (NoArg Flag_Hoogle) - "output for Hoogle", + "output for Hoogle; you may want --package-name and --package-version too", Option [] ["source-base"] (ReqArg Flag_SourceBaseURL "URL") "URL for a source code link on the contents\nand index pages", Option ['s'] (if backwardsCompat then ["source", "source-module"] else ["source-module"]) @@ -171,7 +179,11 @@ options backwardsCompat = Option [] ["pretty-html"] (NoArg Flag_PrettyHtml) "generate html with newlines and indenting (for use with --html)", Option [] ["no-print-missing-docs"] (NoArg Flag_NoPrintMissingDocs) - "don't print information about any undocumented entities" + "don't print information about any undocumented entities", + Option [] ["package-name"] (ReqArg Flag_PackageName "NAME") + "name of the package being documented", + Option [] ["package-version"] (ReqArg Flag_PackageVersion "VERSION") + "version of the package being documented in usual x.y.z.w format" ] @@ -192,6 +204,15 @@ parseHaddockOpts params = usage <- getUsage throwE (concat errors ++ usage) +optPackageVersion :: [Flag] -> Maybe Data.Version.Version +optPackageVersion flags = + let ver = optLast [ v | Flag_PackageVersion v <- flags ] + in ver >>= fmap fst . optLast . RP.readP_to_S parseVersion + +optPackageName :: [Flag] -> Maybe PackageName +optPackageName flags = + optLast [ PackageName $ mkFastString n | Flag_PackageName n <- flags ] + optTitle :: [Flag] -> Maybe String optTitle flags = -- cgit v1.2.3 From ce4b5607f84506e5aafd1994e02300c2e3ee475d Mon Sep 17 00:00:00 2001 From: Łukasz Hanuszczak Date: Mon, 22 Jun 2015 12:27:55 +0200 Subject: Add command line option for generating hyperlinked source. --- haddock-api/src/Haddock/Options.hs | 3 +++ 1 file changed, 3 insertions(+) (limited to 'haddock-api/src/Haddock/Options.hs') diff --git a/haddock-api/src/Haddock/Options.hs b/haddock-api/src/Haddock/Options.hs index e847333e..c9d5688c 100644 --- a/haddock-api/src/Haddock/Options.hs +++ b/haddock-api/src/Haddock/Options.hs @@ -66,6 +66,7 @@ data Flag | Flag_WikiEntityURL String | Flag_LaTeX | Flag_LaTeXStyle String + | Flag_HyperlinkedSource | Flag_Help | Flag_Verbosity String | Flag_Version @@ -116,6 +117,8 @@ options backwardsCompat = Option ['U'] ["use-unicode"] (NoArg Flag_UseUnicode) "use Unicode in HTML output", Option [] ["hoogle"] (NoArg Flag_Hoogle) "output for Hoogle; you may want --package-name and --package-version too", + Option [] ["hyperlinked-source"] (NoArg Flag_HyperlinkedSource) + "generate highlighted and hyperlinked source code (for use with --html)", Option [] ["source-base"] (ReqArg Flag_SourceBaseURL "URL") "URL for a source code link on the contents\nand index pages", Option ['s'] (if backwardsCompat then ["source", "source-module"] else ["source-module"]) -- cgit v1.2.3 From 6f16398a26a12d58b3ba7f1924e2b6b00e68f5f7 Mon Sep 17 00:00:00 2001 From: Łukasz Hanuszczak Date: Mon, 22 Jun 2015 17:20:37 +0200 Subject: Add support for providing custom CSS files for hyperlinked source. --- haddock-api/haddock-api.cabal | 1 + haddock-api/resources/html/solarized.css | 55 +++++++++++++++++++++++++ haddock-api/src/Haddock.hs | 3 +- haddock-api/src/Haddock/Backends/Hyperlinker.hs | 26 +++++++++--- haddock-api/src/Haddock/Options.hs | 6 +++ 5 files changed, 84 insertions(+), 7 deletions(-) create mode 100644 haddock-api/resources/html/solarized.css (limited to 'haddock-api/src/Haddock/Options.hs') diff --git a/haddock-api/haddock-api.cabal b/haddock-api/haddock-api.cabal index 6ffde976..14656994 100644 --- a/haddock-api/haddock-api.cabal +++ b/haddock-api/haddock-api.cabal @@ -18,6 +18,7 @@ stability: experimental data-dir: resources data-files: + html/solarized.css html/frames.html html/haddock-util.js html/Classic.theme/haskell_icon.gif diff --git a/haddock-api/resources/html/solarized.css b/haddock-api/resources/html/solarized.css new file mode 100644 index 00000000..e4bff385 --- /dev/null +++ b/haddock-api/resources/html/solarized.css @@ -0,0 +1,55 @@ +body { + background-color: #fdf6e3; +} + +.hs-identifier { + color: #073642; +} + +.hs-identifier.hs-var { +} + +.hs-identifier.hs-type { + color: #5f5faf; +} + +.hs-keyword { + color: #af005f; +} + +.hs-string, .hs-char { + color: #cb4b16; +} + +.hs-number { + color: #268bd2; +} + +.hs-operator { + color: #d33682; +} + +.hs-glyph, .hs-special { + color: #dc322f; +} + +.hs-comment { + color: #8a8a8a; +} + +.hs-pragma { + color: #2aa198; +} + +.hs-cpp { + color: #859900; +} + +a:link, a:visited { + text-decoration: none; + border-bottom: 1px solid #eee8d5; +} + +a:hover { + background-color: #eee8d5; +} diff --git a/haddock-api/src/Haddock.hs b/haddock-api/src/Haddock.hs index e45456ab..698122e3 100644 --- a/haddock-api/src/Haddock.hs +++ b/haddock-api/src/Haddock.hs @@ -244,6 +244,7 @@ render dflags flags qual ifaces installedIfaces srcMap = do opt_index_url = optIndexUrl flags odir = outputDir flags opt_latex_style = optLaTeXStyle flags + opt_source_css = optSourceCssFile flags visibleIfaces = [ i | i <- ifaces, OptHide `notElem` ifaceOptions i ] @@ -310,7 +311,7 @@ render dflags flags qual ifaces installedIfaces srcMap = do libDir when (Flag_HyperlinkedSource `elem` flags) $ do - ppHyperlinkedSource odir libDir Nothing visibleIfaces + ppHyperlinkedSource odir libDir opt_source_css visibleIfaces -- | From GHC 7.10, this function has a potential to crash with a -- nasty message such as @expectJust getPackageDetails@ because diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker.hs b/haddock-api/src/Haddock/Backends/Hyperlinker.hs index 88619474..66392a67 100644 --- a/haddock-api/src/Haddock/Backends/Hyperlinker.hs +++ b/haddock-api/src/Haddock/Backends/Hyperlinker.hs @@ -5,21 +5,35 @@ import Haddock.Backends.Hyperlinker.Renderer import GHC import Text.XHtml hiding (()) + +import Data.Maybe import System.Directory import System.FilePath ppHyperlinkedSource :: FilePath -> FilePath -> Maybe FilePath -> [Interface] -> IO () ppHyperlinkedSource outdir libdir mstyle ifaces = do - createDirectoryIfMissing True (outdir "src") - mapM_ (ppHyperlinkedModuleSource outdir mstyle) ifaces + createDirectoryIfMissing True $ srcPath outdir + let cssFile = fromMaybe (defaultCssFile libdir) mstyle + copyFile cssFile $ srcPath outdir srcCssFile + mapM_ (ppHyperlinkedModuleSource outdir) ifaces -ppHyperlinkedModuleSource :: FilePath -> Maybe FilePath -> Interface -> IO () -ppHyperlinkedModuleSource outdir mstyle iface = case ifaceTokenizedSrc iface of - Just tokens -> writeFile path $ showHtml . render mstyle $ tokens +ppHyperlinkedModuleSource :: FilePath -> Interface -> IO () +ppHyperlinkedModuleSource outdir iface = case ifaceTokenizedSrc iface of + Just tokens -> writeFile path $ showHtml . render mSrcCssFile $ tokens Nothing -> return () where - path = outdir "src" moduleSourceFile (ifaceMod iface) + mSrcCssFile = Just $ srcCssFile + path = srcPath outdir moduleSourceFile (ifaceMod iface) moduleSourceFile :: Module -> FilePath moduleSourceFile = (++ ".html") . moduleNameString . moduleName + +srcPath :: FilePath -> FilePath +srcPath outdir = outdir "src" + +srcCssFile :: FilePath +srcCssFile = "style.css" + +defaultCssFile :: FilePath -> FilePath +defaultCssFile libdir = libdir "html" "solarized.css" diff --git a/haddock-api/src/Haddock/Options.hs b/haddock-api/src/Haddock/Options.hs index c9d5688c..f84989ef 100644 --- a/haddock-api/src/Haddock/Options.hs +++ b/haddock-api/src/Haddock/Options.hs @@ -21,6 +21,7 @@ module Haddock.Options ( optContentsUrl, optIndexUrl, optCssFile, + optSourceCssFile, sourceUrls, wikiUrls, optDumpInterfaceFile, @@ -67,6 +68,7 @@ data Flag | Flag_LaTeX | Flag_LaTeXStyle String | Flag_HyperlinkedSource + | Flag_SourceCss String | Flag_Help | Flag_Verbosity String | Flag_Version @@ -119,6 +121,8 @@ options backwardsCompat = "output for Hoogle; you may want --package-name and --package-version too", Option [] ["hyperlinked-source"] (NoArg Flag_HyperlinkedSource) "generate highlighted and hyperlinked source code (for use with --html)", + Option [] ["source-css"] (ReqArg Flag_SourceCss "FILE") + "use custom CSS file instead of default one in hyperlinked source", Option [] ["source-base"] (ReqArg Flag_SourceBaseURL "URL") "URL for a source code link on the contents\nand index pages", Option ['s'] (if backwardsCompat then ["source", "source-module"] else ["source-module"]) @@ -242,6 +246,8 @@ optIndexUrl flags = optLast [ url | Flag_UseIndex url <- flags ] optCssFile :: [Flag] -> Maybe FilePath optCssFile flags = optLast [ str | Flag_CSS str <- flags ] +optSourceCssFile :: [Flag] -> Maybe FilePath +optSourceCssFile flags = optLast [ str | Flag_SourceCss str <- flags ] sourceUrls :: [Flag] -> (Maybe String, Maybe String, Maybe String, Maybe String) sourceUrls flags = -- cgit v1.2.3