aboutsummaryrefslogtreecommitdiff
path: root/haddock-api/src
diff options
context:
space:
mode:
Diffstat (limited to 'haddock-api/src')
-rw-r--r--haddock-api/src/Haddock/Backends/Xhtml.hs42
-rw-r--r--haddock-api/src/Haddock/Interface/Create.hs19
-rw-r--r--haddock-api/src/Haddock/Utils.hs12
3 files changed, 18 insertions, 55 deletions
diff --git a/haddock-api/src/Haddock/Backends/Xhtml.hs b/haddock-api/src/Haddock/Backends/Xhtml.hs
index f7284062..8252839c 100644
--- a/haddock-api/src/Haddock/Backends/Xhtml.hs
+++ b/haddock-api/src/Haddock/Backends/Xhtml.hs
@@ -36,14 +36,13 @@ import Haddock.GhcUtils
import Control.Monad ( when, unless )
import Data.Char ( toUpper )
-import Data.List ( sortBy, groupBy, intercalate, isPrefixOf )
+import Data.List ( sortBy, intercalate, isPrefixOf )
import Data.Maybe
import System.FilePath hiding ( (</>) )
import System.Directory
import Data.Map ( Map )
import qualified Data.Map as Map hiding ( Map )
import qualified Data.Set as Set hiding ( Set )
-import Data.Function
import Data.Ord ( comparing )
import DynFlags (Language(..))
@@ -105,7 +104,8 @@ copyHtmlBits odir libdir themes = do
copyCssFile f = copyFile f (combine odir (takeFileName f))
copyLibFile f = copyFile (joinPath [libhtmldir, f]) (joinPath [odir, f])
mapM_ copyCssFile (cssFiles themes)
- mapM_ copyLibFile [ jsFile, framesFile ]
+ copyLibFile jsFile
+ return ()
headHtml :: String -> Maybe String -> Themes -> Maybe String -> Html
@@ -268,9 +268,6 @@ ppHtmlContents dflags odir doctitle _maybe_package
createDirectoryIfMissing True odir
writeFile (joinPath [odir, contentsHtmlFile]) (renderToString debug html)
- -- XXX: think of a better place for this?
- ppHtmlContentsFrame odir doctitle themes mathjax_url ifaces debug
-
ppPrologue :: Qualification -> String -> Maybe (MDoc GHC.RdrName) -> Html
ppPrologue _ _ Nothing = noHtml
@@ -321,39 +318,6 @@ mkNode qual ss p (Node s leaf pkg srcPkg short ts) =
subtree = mkNodeList qual (s:ss) p ts ! collapseSection p True ""
--- | Turn a module tree into a flat list of full module names. E.g.,
--- @
--- A
--- +-B
--- +-C
--- @
--- becomes
--- @["A", "A.B", "A.B.C"]@
-flatModuleTree :: [InstalledInterface] -> [Html]
-flatModuleTree ifaces =
- map (uncurry ppModule' . head)
- . groupBy ((==) `on` fst)
- . sortBy (comparing fst)
- $ mods
- where
- mods = [ (moduleString mdl, mdl) | mdl <- map instMod ifaces ]
- ppModule' txt mdl =
- anchor ! [href (moduleHtmlFile mdl), target mainFrameName]
- << toHtml txt
-
-
-ppHtmlContentsFrame :: FilePath -> String -> Themes -> Maybe String
- -> [InstalledInterface] -> Bool -> IO ()
-ppHtmlContentsFrame odir doctitle themes maybe_mathjax_url ifaces debug = do
- let mods = flatModuleTree ifaces
- html =
- headHtml doctitle Nothing themes maybe_mathjax_url +++
- miniBody << divModuleList <<
- (sectionName << "Modules" +++
- ulist << [ li ! [theclass "module"] << m | m <- mods ])
- createDirectoryIfMissing True odir
- writeFile (joinPath [odir, frameIndexHtmlFile]) (renderToString debug html)
-
--------------------------------------------------------------------------------
-- * Generate the index
diff --git a/haddock-api/src/Haddock/Interface/Create.hs b/haddock-api/src/Haddock/Interface/Create.hs
index 007038cb..cb855693 100644
--- a/haddock-api/src/Haddock/Interface/Create.hs
+++ b/haddock-api/src/Haddock/Interface/Create.hs
@@ -36,7 +36,6 @@ import Control.Arrow (second)
import Control.DeepSeq
import Control.Monad
import Data.Function (on)
-import qualified Data.Foldable as F
import qualified Packages
import qualified Module
@@ -50,7 +49,7 @@ import TcRnTypes
import FastString (concatFS)
import BasicTypes ( StringLiteral(..) )
import qualified Outputable as O
-import HsDecls ( gadtDeclDetails,getConDetails )
+import HsDecls ( getConDetails )
-- | Use a 'TypecheckedModule' to produce an 'Interface'.
-- To do this, we need access to already processed modules in the topological
@@ -784,13 +783,21 @@ extractDecl name mdl decl
| otherwise =
case unLoc decl of
TyClD d@ClassDecl {} ->
- let matches = [ sig | sig <- tcdSigs d, name `elem` sigName sig,
- isTypeLSig sig ] -- TODO: document fixity
+ let matches = [ lsig
+ | lsig <- tcdSigs d
+ , ClassOpSig False _ _ <- pure $ unLoc lsig
+ -- Note: exclude `default` declarations (see #505)
+ , name `elem` sigName lsig
+ ]
+ -- TODO: document fixity
in case matches of
[s0] -> let (n, tyvar_names) = (tcdName d, tyClDeclTyVars d)
L pos sig = addClassContext n tyvar_names s0
in L pos (SigD sig)
- _ -> error "internal: extractDecl (ClassDecl)"
+ _ -> O.pprPanic "extractDecl" (O.text "Ambiguous decl for" O.<+> O.ppr name O.<+> O.text "in class:"
+ O.$$ O.nest 4 (O.ppr d)
+ O.$$ O.text "Matches:"
+ O.$$ O.nest 4 (O.ppr matches))
TyClD d@DataDecl {} ->
let (n, tyvar_tys) = (tcdName d, lHsQTyVarsToTypes (tyClDeclTyVars d))
in SigD <$> extractRecSel name mdl n tyvar_tys (dd_cons (tcdDataDefn d))
@@ -825,7 +832,7 @@ extractRecSel nm mdl t tvs (L _ con : rest) =
matching_fields flds = [ (l,f) | f@(L _ (ConDeclField ns _ _)) <- flds
, L l n <- ns, selectorFieldOcc n == nm ]
data_ty
- -- | ResTyGADT _ ty <- con_res con = ty
+ -- ResTyGADT _ ty <- con_res con = ty
| ConDeclGADT{} <- con = hsib_body $ con_type con
| otherwise = foldl' (\x y -> noLoc (HsAppTy x y)) (noLoc (HsTyVar (noLoc t))) tvs
diff --git a/haddock-api/src/Haddock/Utils.hs b/haddock-api/src/Haddock/Utils.hs
index 58a7ef90..389aa5ab 100644
--- a/haddock-api/src/Haddock/Utils.hs
+++ b/haddock-api/src/Haddock/Utils.hs
@@ -21,10 +21,9 @@ module Haddock.Utils (
-- * Filename utilities
moduleHtmlFile, moduleHtmlFile',
contentsHtmlFile, indexHtmlFile,
- frameIndexHtmlFile,
moduleIndexFrameName, mainFrameName, synopsisFrameName,
subIndexHtmlFile,
- jsFile, framesFile,
+ jsFile,
-- * Anchor and URL utilities
moduleNameUrl, moduleNameUrl', moduleUrl,
@@ -262,12 +261,6 @@ contentsHtmlFile = "index.html"
indexHtmlFile = "doc-index.html"
--- | The name of the module index file to be displayed inside a frame.
--- Modules are display in full, but without indentation. Clicking opens in
--- the main window.
-frameIndexHtmlFile :: String
-frameIndexHtmlFile = "index-frames.html"
-
moduleIndexFrameName, mainFrameName, synopsisFrameName :: String
moduleIndexFrameName = "modules"
@@ -333,9 +326,8 @@ makeAnchorId (f:r) = escape isAlpha f ++ concatMap (escape isLegal) r
-------------------------------------------------------------------------------
-jsFile, framesFile :: String
+jsFile :: String
jsFile = "haddock-util.js"
-framesFile = "frames.html"
-------------------------------------------------------------------------------
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-11 12:27:36 +0000