diff options
author | Mateusz Kowalczyk <fuuzetsu@fuuzetsu.co.uk> | 2015-03-27 02:43:55 +0000 |
---|---|---|
committer | Mateusz Kowalczyk <fuuzetsu@fuuzetsu.co.uk> | 2015-03-27 02:43:55 +0000 |
commit | 1a65ec54ce8516dc2d09af3b1d20fedd21e64ad6 (patch) | |
tree | c59e7a20a1e4ba382f431f43c28ab06321faf20d | |
parent | 4999f090864463aec6cbcf4f3319015b6601ccef (diff) |
Output method documentation in Hoogle backend
One thing of note is that we no longer preserve grouping of methods and
print each method on its own line. We could preserve it if no
documentation is present for any methods in the group if someone asks
for it though.
Fixes #259
-rw-r--r-- | CHANGES | 2 | ||||
-rw-r--r-- | haddock-api/src/Haddock/Backends/Hoogle.hs | 32 |
2 files changed, 23 insertions, 11 deletions
@@ -39,6 +39,8 @@ Changes in version 2.16.0 * Fully qualify names in Hoogle instances output (#263) + * Output method documentation in Hoogle backend (#259) + Changes in version 2.15.0 * Always read in prologue files as UTF8 (#286 and Cabal #1721) diff --git a/haddock-api/src/Haddock/Backends/Hoogle.hs b/haddock-api/src/Haddock/Backends/Hoogle.hs index 3ffa582f..12dfc1f5 100644 --- a/haddock-api/src/Haddock/Backends/Hoogle.hs +++ b/haddock-api/src/Haddock/Backends/Hoogle.hs @@ -109,6 +109,8 @@ operator :: String -> String operator (x:xs) | not (isAlphaNum x) && x `notElem` "_' ([{" = '(' : x:xs ++ ")" operator x = x +commaSeparate :: Outputable a => DynFlags -> [a] -> String +commaSeparate dflags = showSDocUnqual dflags . interpp'SP --------------------------------------------------------------------- -- How to print each export @@ -121,30 +123,38 @@ ppExport dflags ExportDecl { expItemDecl = L _ decl where f (TyClD d@DataDecl{}) = ppData dflags d subdocs f (TyClD d@SynDecl{}) = ppSynonym dflags d - f (TyClD d@ClassDecl{}) = ppClass dflags d + f (TyClD d@ClassDecl{}) = ppClass dflags d subdocs f (ForD (ForeignImport name typ _ _)) = ppSig dflags $ TypeSig [name] typ [] f (ForD (ForeignExport name typ _ _)) = ppSig dflags $ TypeSig [name] typ [] f (SigD sig) = ppSig dflags sig f _ = [] ppExport _ _ = [] - -ppSig :: DynFlags -> Sig Name -> [String] -ppSig dflags (TypeSig names sig _) - = [operator prettyNames ++ " :: " ++ outHsType dflags typ] +ppSigWithDoc :: DynFlags -> Sig Name -> [(Name, DocForDecl Name)] -> [String] +ppSigWithDoc dflags (TypeSig names sig _) subdocs + = concatMap mkDocSig names where - prettyNames = intercalate ", " $ map (out dflags) names + mkDocSig n = concatMap (ppDocumentation dflags) (getDoc n) + ++ [mkSig n] + mkSig n = operator (out dflags n) ++ " :: " ++ outHsType dflags typ + + getDoc :: Located Name -> [Documentation Name] + getDoc n = maybe [] (return . fst) (lookup (unL n) subdocs) + typ = case unL sig of HsForAllTy Explicit a b c d -> HsForAllTy Implicit a b c d HsForAllTy Qualified a b c d -> HsForAllTy Implicit a b c d x -> x -ppSig _ _ = [] +ppSigWithDoc _ _ _ = [] + +ppSig :: DynFlags -> Sig Name -> [String] +ppSig dflags x = ppSigWithDoc dflags x [] -- note: does not yet output documentation for class methods -ppClass :: DynFlags -> TyClDecl Name -> [String] -ppClass dflags x = out dflags x{tcdSigs=[]} : - concatMap (ppSig dflags . addContext . unL) (tcdSigs x) +ppClass :: DynFlags -> TyClDecl Name -> [(Name, DocForDecl Name)] -> [String] +ppClass dflags x subdocs = out dflags x{tcdSigs=[]} : + concatMap (flip (ppSigWithDoc dflags) subdocs . addContext . unL) (tcdSigs x) where addContext (TypeSig name (L l sig) nwcs) = TypeSig name (L l $ f sig) nwcs addContext (MinimalSig src sig) = MinimalSig src sig @@ -203,7 +213,7 @@ ppCtor dflags dat subdocs con -- We print the constructors as comma-separated list. See GHC -- docs for con_names on why it is a list to begin with. - name = showSDocUnqual dflags . interpp'SP . map unL $ con_names con + name = commaSeparate dflags . map unL $ con_names con resType = case con_res con of ResTyH98 -> apps $ map (reL . HsTyVar) $ |