aboutsummaryrefslogtreecommitdiff
path: root/haddock-api
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 /haddock-api
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
Diffstat (limited to 'haddock-api')
-rw-r--r--haddock-api/src/Haddock/Backends/Hoogle.hs32
1 files changed, 21 insertions, 11 deletions
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) $