aboutsummaryrefslogtreecommitdiff
path: root/src/Haddock/Backends/Hoogle.hs
diff options
context:
space:
mode:
authorIan Lynagh <igloo@earth.li>2012-07-19 20:38:26 +0100
committerIan Lynagh <igloo@earth.li>2012-07-19 20:38:26 +0100
commit7f164839d8b0b6e53fa0f15d2a6810ca310e337d (patch)
tree34a2bdeb25673b73d3a6935ab5d4170f94bc11a0 /src/Haddock/Backends/Hoogle.hs
parent4dc9ecd3905f75adb6bcfb818fbc163c724d4545 (diff)
parent6e8bc1dca77bbbc5743f63a2e8ea5b1eab0ed80c (diff)
Merge branch 'master' of darcs.haskell.org:/srv/darcs//haddock
Diffstat (limited to 'src/Haddock/Backends/Hoogle.hs')
-rw-r--r--src/Haddock/Backends/Hoogle.hs33
1 files changed, 19 insertions, 14 deletions
diff --git a/src/Haddock/Backends/Hoogle.hs b/src/Haddock/Backends/Hoogle.hs
index 9c5d57c3..55f6ac1d 100644
--- a/src/Haddock/Backends/Hoogle.hs
+++ b/src/Haddock/Backends/Hoogle.hs
@@ -48,11 +48,11 @@ ppHoogle dflags package version synopsis prologue ifaces odir = do
hClose h
ppModule :: DynFlags -> Interface -> [String]
-ppModule dflags iface
- = "" : doc dflags (ifaceDoc iface) ++
- ["module " ++ moduleString (ifaceMod iface)] ++
- concatMap (ppExport dflags) (ifaceExportItems iface) ++
- concatMap (ppInstance dflags) (ifaceInstances iface)
+ppModule dflags iface =
+ "" : ppDocumentation dflags (ifaceDoc iface) ++
+ ["module " ++ moduleString (ifaceMod iface)] ++
+ concatMap (ppExport dflags) (ifaceExportItems iface) ++
+ concatMap (ppInstance dflags) (ifaceInstances iface)
---------------------------------------------------------------------
@@ -102,7 +102,7 @@ out dflags = f . unwords . map (dropWhile isSpace) . lines . showSDocUnqual dfla
operator :: String -> String
-operator (x:xs) | not (isAlphaNum x) && x `notElem` "_' ([{" = "(" ++ x:xs ++ ")"
+operator (x:xs) | not (isAlphaNum x) && x `notElem` "_' ([{" = '(' : x:xs ++ ")"
operator x = x
@@ -110,7 +110,7 @@ operator x = x
-- How to print each export
ppExport :: DynFlags -> ExportItem Name -> [String]
-ppExport dflags (ExportDecl decl dc subdocs _) = doc dflags (fst dc) ++ f (unL decl)
+ppExport dflags (ExportDecl decl dc subdocs _) = ppDocumentation dflags (fst dc) ++ f (unL decl)
where
f (TyClD d@TyDecl{})
| isDataDecl d = ppData dflags d subdocs
@@ -127,7 +127,7 @@ ppSig :: DynFlags -> Sig Name -> [String]
ppSig dflags (TypeSig names sig)
= [operator prettyNames ++ " :: " ++ outHsType dflags typ]
where
- prettyNames = concat . intersperse ", " $ map (out dflags) names
+ prettyNames = intercalate ", " $ map (out dflags) names
typ = case unL sig of
HsForAllTy Explicit a b c -> HsForAllTy Implicit a b c
x -> x
@@ -172,19 +172,19 @@ ppData dflags decl@(TyDecl { tcdTyDefn = defn }) subdocs
ppData _ _ _ = panic "ppData"
-- | for constructors, and named-fields...
-lookupCon :: [(Name, DocForDecl Name)] -> Located Name -> Maybe (Doc Name)
-lookupCon subdocs (L _ name) = case lookup name subdocs of
- Just (d, _) -> d
- _ -> Nothing
+lookupCon :: DynFlags -> [(Name, DocForDecl Name)] -> Located Name -> [String]
+lookupCon dflags subdocs (L _ name) = case lookup name subdocs of
+ Just (d, _) -> ppDocumentation dflags d
+ _ -> []
ppCtor :: DynFlags -> TyClDecl Name -> [(Name, DocForDecl Name)] -> ConDecl Name -> [String]
-ppCtor dflags dat subdocs con = doc dflags (lookupCon subdocs (con_name con))
+ppCtor dflags dat subdocs con = lookupCon dflags subdocs (con_name con)
++ f (con_details con)
where
f (PrefixCon args) = [typeSig name $ args ++ [resType]]
f (InfixCon a1 a2) = f $ PrefixCon [a1,a2]
f (RecCon recs) = f (PrefixCon $ map cd_fld_type recs) ++ concat
- [doc dflags (lookupCon subdocs (cd_fld_name r)) ++
+ [lookupCon dflags subdocs (cd_fld_name r) ++
[out dflags (unL $ cd_fld_name r) `typeSig` [resType, cd_fld_type r]]
| r <- recs]
@@ -203,6 +203,10 @@ ppCtor dflags dat subdocs con = doc dflags (lookupCon subdocs (con_name con))
---------------------------------------------------------------------
-- DOCUMENTATION
+ppDocumentation :: Outputable o => DynFlags -> Documentation o -> [String]
+ppDocumentation dflags (Documentation d w) = doc dflags d ++ doc dflags w
+
+
doc :: Outputable o => DynFlags -> Maybe (Doc o) -> [String]
doc dflags = docWith dflags ""
@@ -242,6 +246,7 @@ markupTag dflags = Markup {
markupIdentifier = box (TagInline "a") . str . out dflags,
markupIdentifierUnchecked = box (TagInline "a") . str . out dflags . snd,
markupModule = box (TagInline "a") . str,
+ markupWarning = box (TagInline "i"),
markupEmphasis = box (TagInline "i"),
markupMonospaced = box (TagInline "tt"),
markupPic = const $ str " ",