aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorMateusz Kowalczyk <fuuzetsu@fuuzetsu.co.uk>2015-03-27 02:43:55 +0000
committerMateusz Kowalczyk <fuuzetsu@fuuzetsu.co.uk>2015-03-27 02:43:55 +0000
commit1a65ec54ce8516dc2d09af3b1d20fedd21e64ad6 (patch)
treec59e7a20a1e4ba382f431f43c28ab06321faf20d
parent4999f090864463aec6cbcf4f3319015b6601ccef (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--CHANGES2
-rw-r--r--haddock-api/src/Haddock/Backends/Hoogle.hs32
2 files changed, 23 insertions, 11 deletions
diff --git a/CHANGES b/CHANGES
index f436cf64..7aba49ae 100644
--- a/CHANGES
+++ b/CHANGES
@@ -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) $