From 088b1993fb6c6ed014a95e93d7c07f68218c7777 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Tue, 26 Dec 2017 17:13:14 +0200 Subject: Grid Tables (#718) * Add table examples * Add table types and adopt simple parser Simple parser is done by Giovanni Cappellotto (@potomak) in https://github.com/haskell/haddock/pull/577 It seems to support single fine full tables, so far from full RST-grid tables, but it's good start. Table type support row- and colspans, but obviously parser is lacking. Still TODO: - Latex backend. Should we use multirow package https://ctan.org/pkg/multirow?lang=en? - Hoogle backend: ? * Implement grid-tables * Refactor table parser * Add two ill-examples * Update CHANGES.md * Basic documentation for tables * Fix documentation example --- haddock-api/src/Haddock/Backends/Hoogle.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) (limited to 'haddock-api/src/Haddock/Backends/Hoogle.hs') diff --git a/haddock-api/src/Haddock/Backends/Hoogle.hs b/haddock-api/src/Haddock/Backends/Hoogle.hs index f1d8ddb2..fc71d4b5 100644 --- a/haddock-api/src/Haddock/Backends/Hoogle.hs +++ b/haddock-api/src/Haddock/Backends/Hoogle.hs @@ -328,7 +328,8 @@ markupTag dflags = Markup { markupAName = const $ str "", markupProperty = box TagPre . str, markupExample = box TagPre . str . unlines . map exampleToString, - markupHeader = \(Header l h) -> box (TagInline $ "h" ++ show l) h + markupHeader = \(Header l h) -> box (TagInline $ "h" ++ show l) h, + markupTable = \(Table _ _) -> str "TODO: table" } -- cgit v1.2.3 From d66092ee99639de628dbc4fce8a9936875f47d8c Mon Sep 17 00:00:00 2001 From: Alexander Biehl Date: Mon, 19 Feb 2018 10:03:50 +0100 Subject: Hoogle/Latex: Remove use of partial function --- haddock-api/src/Haddock/Backends/Hoogle.hs | 2 +- haddock-api/src/Haddock/Backends/LaTeX.hs | 10 ++++------ 2 files changed, 5 insertions(+), 7 deletions(-) (limited to 'haddock-api/src/Haddock/Backends/Hoogle.hs') diff --git a/haddock-api/src/Haddock/Backends/Hoogle.hs b/haddock-api/src/Haddock/Backends/Hoogle.hs index fc71d4b5..e002b602 100644 --- a/haddock-api/src/Haddock/Backends/Hoogle.hs +++ b/haddock-api/src/Haddock/Backends/Hoogle.hs @@ -141,7 +141,7 @@ ppSigWithDoc dflags (TypeSig names sig) subdocs = concatMap mkDocSig names where mkDocSig n = concatMap (ppDocumentation dflags) (getDoc n) - ++ [pp_sig dflags names (hsSigWcType sig)] + ++ [pp_sig dflags [n] (hsSigWcType sig)] getDoc :: Located Name -> [Documentation Name] getDoc n = maybe [] (return . fst) (lookup (unL n) subdocs) diff --git a/haddock-api/src/Haddock/Backends/LaTeX.hs b/haddock-api/src/Haddock/Backends/LaTeX.hs index 3ac3b405..1043453d 100644 --- a/haddock-api/src/Haddock/Backends/LaTeX.hs +++ b/haddock-api/src/Haddock/Backends/LaTeX.hs @@ -508,13 +508,11 @@ ppClassDecl instances loc doc subdocs methodTable = text "\\haddockpremethods{}\\textbf{Methods}" $$ - vcat [ ppFunSig loc doc names (hsSigWcType typ) unicode + vcat [ ppFunSig loc doc [name] (hsSigWcType typ) unicode | L _ (TypeSig lnames typ) <- lsigs - , let doc = lookupAnySubdoc (head names) subdocs - names = map unLoc lnames ] - -- FIXME: is taking just the first name ok? Is it possible that - -- there are different subdocs for different names in a single - -- type signature? + , name <- map unLoc lnames + , let doc = lookupAnySubdoc name subdocs + ] instancesBit = ppDocInstances unicode instances -- cgit v1.2.3 From 979c7338cfcdc59f0b0dda562a53558c416cc362 Mon Sep 17 00:00:00 2001 From: Ryan Scott Date: Tue, 24 Apr 2018 16:51:06 -0400 Subject: Improve the Hoogle backend's treatment of type families (#808) Fixes parts 1 and 2 of #806. --- haddock-api/src/Haddock/Backends/Hoogle.hs | 26 ++++++++++++++++++++------ hoogle-test/ref/Bug806/test.txt | 24 ++++++++++++++++++++++++ hoogle-test/src/Bug806/Bug806.hs | 23 +++++++++++++++++++++++ 3 files changed, 67 insertions(+), 6 deletions(-) create mode 100644 hoogle-test/ref/Bug806/test.txt create mode 100644 hoogle-test/src/Bug806/Bug806.hs (limited to 'haddock-api/src/Haddock/Backends/Hoogle.hs') diff --git a/haddock-api/src/Haddock/Backends/Hoogle.hs b/haddock-api/src/Haddock/Backends/Hoogle.hs index e002b602..e7ce9d30 100644 --- a/haddock-api/src/Haddock/Backends/Hoogle.hs +++ b/haddock-api/src/Haddock/Backends/Hoogle.hs @@ -128,6 +128,7 @@ ppExport dflags ExportDecl { expItemDecl = L _ decl f (TyClD d@DataDecl{}) = ppData dflags d subdocs f (TyClD d@SynDecl{}) = ppSynonym dflags d f (TyClD d@ClassDecl{}) = ppClass dflags d subdocs + f (TyClD (FamDecl d)) = ppFam dflags d f (ForD (ForeignImport name typ _ _)) = [pp_sig dflags [name] (hsSigType typ)] f (ForD (ForeignExport name typ _ _)) = [pp_sig dflags [name] (hsSigType typ)] f (SigD sig) = ppSig dflags sig ++ ppFixities @@ -140,11 +141,7 @@ ppSigWithDoc :: DynFlags -> Sig GhcRn -> [(Name, DocForDecl Name)] -> [String] ppSigWithDoc dflags (TypeSig names sig) subdocs = concatMap mkDocSig names where - mkDocSig n = concatMap (ppDocumentation dflags) (getDoc n) - ++ [pp_sig dflags [n] (hsSigWcType sig)] - - getDoc :: Located Name -> [Documentation Name] - getDoc n = maybe [] (return . fst) (lookup (unL n) subdocs) + mkDocSig n = mkSubdoc dflags n subdocs [pp_sig dflags [n] (hsSigWcType sig)] ppSigWithDoc _ _ _ = [] @@ -172,10 +169,14 @@ ppClass dflags decl subdocs = ppTyFams | null $ tcdATs decl = "" | otherwise = (" " ++) . showSDocUnqual dflags . whereWrapper $ concat - [ map ppr (tcdATs decl) + [ map pprTyFam (tcdATs decl) , map (ppr . tyFamEqnToSyn . unLoc) (tcdATDefs decl) ] + pprTyFam :: LFamilyDecl GhcRn -> SDoc + pprTyFam (L _ at) = vcat' $ map text $ + mkSubdoc dflags (fdLName at) subdocs (ppFam dflags at) + whereWrapper elems = vcat' [ text "where" <+> lbrace , nest 4 . vcat . map (Outputable.<> semi) $ elems @@ -191,6 +192,15 @@ ppClass dflags decl subdocs = , tcdFVs = emptyNameSet } +ppFam :: DynFlags -> FamilyDecl GhcRn -> [String] +ppFam dflags decl@(FamilyDecl { fdInfo = info }) + = [out dflags decl'] + where + decl' = case info of + -- We don't need to print out a closed type family's equations + -- for Hoogle, so pretend it doesn't have any. + ClosedTypeFamily{} -> decl { fdInfo = OpenTypeFamily } + _ -> decl ppInstance :: DynFlags -> ClsInst -> [String] ppInstance dflags x = @@ -285,6 +295,10 @@ docWith dflags header d lines header ++ ["" | header /= "" && isJust d] ++ maybe [] (showTags . markup (markupTag dflags)) d +mkSubdoc :: DynFlags -> Located Name -> [(Name, DocForDecl Name)] -> [String] -> [String] +mkSubdoc dflags n subdocs s = concatMap (ppDocumentation dflags) getDoc ++ s + where + getDoc = maybe [] (return . fst) (lookup (unL n) subdocs) data Tag = TagL Char [Tags] | TagP Tags | TagPre Tags | TagInline String Tags | Str String deriving Show diff --git a/hoogle-test/ref/Bug806/test.txt b/hoogle-test/ref/Bug806/test.txt new file mode 100644 index 00000000..d9a908b3 --- /dev/null +++ b/hoogle-test/ref/Bug806/test.txt @@ -0,0 +1,24 @@ +-- Hoogle documentation, generated by Haddock +-- See Hoogle, http://www.haskell.org/hoogle/ + +@package test +@version 0.0.0 + +module Bug806 + +-- | F1 docs +type family F1 a b :: * -> * + +-- | F2 docs +type family F2 a b :: * -> * + +-- | D docs +data family D a :: * -> * +v :: Int + +-- | C docs +class C a where { + + -- | AT docs + type family AT a; +} diff --git a/hoogle-test/src/Bug806/Bug806.hs b/hoogle-test/src/Bug806/Bug806.hs new file mode 100644 index 00000000..6efcb5cf --- /dev/null +++ b/hoogle-test/src/Bug806/Bug806.hs @@ -0,0 +1,23 @@ +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE UndecidableInstances #-} +module Bug806 where + +import Data.Proxy + +-- | 'F1' docs +type family F1 a b :: * -> * +-- | 'F2' docs +type family F2 a b :: * -> * where + F2 Int b = Maybe + F2 a b = [] +-- | 'D' docs +data family D a :: * -> * + +v :: Int +v = 42 + +-- | 'C' docs +class C a where + -- | 'AT' docs + type AT a -- cgit v1.2.3 From 6be939f24f9db58c19a220daa0ff73d3a633a244 Mon Sep 17 00:00:00 2001 From: Ben Gamari Date: Sat, 2 Jun 2018 15:45:54 -0400 Subject: Remove ParallelArrays and Data Parallel Haskell --- haddock-api/src/Haddock/Backends/Hoogle.hs | 1 - haddock-api/src/Haddock/Backends/LaTeX.hs | 5 ----- haddock-api/src/Haddock/Backends/Xhtml/Decl.hs | 1 - haddock-api/src/Haddock/Interface/Rename.hs | 1 - haddock-api/src/Haddock/Interface/Specialize.hs | 1 - haddock-api/src/Haddock/Types.hs | 1 - 6 files changed, 10 deletions(-) (limited to 'haddock-api/src/Haddock/Backends/Hoogle.hs') diff --git a/haddock-api/src/Haddock/Backends/Hoogle.hs b/haddock-api/src/Haddock/Backends/Hoogle.hs index 9a31428f..8d0318c2 100644 --- a/haddock-api/src/Haddock/Backends/Hoogle.hs +++ b/haddock-api/src/Haddock/Backends/Hoogle.hs @@ -80,7 +80,6 @@ dropHsDocTy = f f (HsAppTy x a b) = HsAppTy x (g a) (g b) f (HsFunTy x a b) = HsFunTy x (g a) (g b) f (HsListTy x a) = HsListTy x (g a) - f (HsPArrTy x a) = HsPArrTy x (g a) f (HsTupleTy x a b) = HsTupleTy x a (map g b) f (HsOpTy x a b c) = HsOpTy x (g a) b (g c) f (HsParTy x a) = HsParTy x (g a) diff --git a/haddock-api/src/Haddock/Backends/LaTeX.hs b/haddock-api/src/Haddock/Backends/LaTeX.hs index f8052895..a2f43ece 100644 --- a/haddock-api/src/Haddock/Backends/LaTeX.hs +++ b/haddock-api/src/Haddock/Backends/LaTeX.hs @@ -967,7 +967,6 @@ ppr_mono_ty _ (HsTupleTy _ con tys) u = tupleParens con (map (ppLType u) ppr_mono_ty _ (HsSumTy _ tys) u = sumParens (map (ppLType u) tys) ppr_mono_ty _ (HsKindSig _ ty kind) u = parens (ppr_mono_lty pREC_TOP ty u <+> dcolon u <+> ppLKind u kind) ppr_mono_ty _ (HsListTy _ ty) u = brackets (ppr_mono_lty pREC_TOP ty u) -ppr_mono_ty _ (HsPArrTy _ ty) u = pabrackets (ppr_mono_lty pREC_TOP ty u) ppr_mono_ty _ (HsIParamTy _ (L _ n) ty) u = brackets (ppIPName n <+> dcolon u <+> ppr_mono_lty pREC_TOP ty u) ppr_mono_ty _ (HsSpliceTy {}) _ = error "ppr_mono_ty HsSpliceTy" ppr_mono_ty _ (HsRecTy {}) _ = text "{..}" @@ -1290,10 +1289,6 @@ ubxparens :: LaTeX -> LaTeX ubxparens h = text "(#" <> h <> text "#)" -pabrackets :: LaTeX -> LaTeX -pabrackets h = text "[:" <> h <> text ":]" - - nl :: LaTeX nl = text "\\\\" diff --git a/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs b/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs index 3fbe6eaf..d4f6db0e 100644 --- a/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs +++ b/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs @@ -1203,7 +1203,6 @@ ppr_mono_ty _ (HsSumTy _ tys) u q _ = sumParens (map (ppLType u q HideEm ppr_mono_ty _ (HsKindSig _ ty kind) u q e = parens (ppr_mono_lty pREC_TOP ty u q e <+> dcolon u <+> ppLKind u q kind) ppr_mono_ty _ (HsListTy _ ty) u q _ = brackets (ppr_mono_lty pREC_TOP ty u q HideEmptyContexts) -ppr_mono_ty _ (HsPArrTy _ ty) u q _ = pabrackets (ppr_mono_lty pREC_TOP ty u q HideEmptyContexts) ppr_mono_ty ctxt_prec (HsIParamTy _ (L _ n) ty) u q _ = maybeParen ctxt_prec pREC_CTX $ ppIPName n <+> dcolon u <+> ppr_mono_lty pREC_TOP ty u q HideEmptyContexts ppr_mono_ty _ (HsSpliceTy {}) _ _ _ = error "ppr_mono_ty HsSpliceTy" diff --git a/haddock-api/src/Haddock/Interface/Rename.hs b/haddock-api/src/Haddock/Interface/Rename.hs index 7fb1f4b7..5684e70a 100644 --- a/haddock-api/src/Haddock/Interface/Rename.hs +++ b/haddock-api/src/Haddock/Interface/Rename.hs @@ -244,7 +244,6 @@ renameType t = case t of return (HsFunTy NoExt a' b') HsListTy _ ty -> return . (HsListTy NoExt) =<< renameLType ty - HsPArrTy _ ty -> return . (HsPArrTy NoExt) =<< renameLType ty HsIParamTy _ n ty -> liftM (HsIParamTy NoExt n) (renameLType ty) HsEqTy _ ty1 ty2 -> liftM2 (HsEqTy NoExt) (renameLType ty1) (renameLType ty2) diff --git a/haddock-api/src/Haddock/Interface/Specialize.hs b/haddock-api/src/Haddock/Interface/Specialize.hs index 80fbc714..2fcb495c 100644 --- a/haddock-api/src/Haddock/Interface/Specialize.hs +++ b/haddock-api/src/Haddock/Interface/Specialize.hs @@ -257,7 +257,6 @@ renameType (HsTyVar x ip name) = HsTyVar x ip <$> located renameName name renameType (HsAppTy x lf la) = HsAppTy x <$> renameLType lf <*> renameLType la renameType (HsFunTy x la lr) = HsFunTy x <$> renameLType la <*> renameLType lr renameType (HsListTy x lt) = HsListTy x <$> renameLType lt -renameType (HsPArrTy x lt) = HsPArrTy x <$> renameLType lt renameType (HsTupleTy x srt lt) = HsTupleTy x srt <$> mapM renameLType lt renameType (HsSumTy x lt) = HsSumTy x <$> mapM renameLType lt renameType (HsOpTy x la lop lb) = diff --git a/haddock-api/src/Haddock/Types.hs b/haddock-api/src/Haddock/Types.hs index 1115e829..e4d79760 100644 --- a/haddock-api/src/Haddock/Types.hs +++ b/haddock-api/src/Haddock/Types.hs @@ -675,7 +675,6 @@ type instance XAppsTy DocNameI = NoExt type instance XAppTy DocNameI = NoExt type instance XFunTy DocNameI = NoExt type instance XListTy DocNameI = NoExt -type instance XPArrTy DocNameI = NoExt type instance XTupleTy DocNameI = NoExt type instance XSumTy DocNameI = NoExt type instance XOpTy DocNameI = NoExt -- cgit v1.2.3 From e5098935e723f668fb2d283ef0393e72df32147a Mon Sep 17 00:00:00 2001 From: Ryan Scott Date: Thu, 10 May 2018 11:19:47 -0400 Subject: Remove Hoogle backend hack that butchers infix datatype names --- haddock-api/src/Haddock/Backends/Hoogle.hs | 3 +-- hoogle-test/ref/Bug825/test.txt | 9 +++++++++ hoogle-test/src/Bug825/Bug825.hs | 6 ++++++ 3 files changed, 16 insertions(+), 2 deletions(-) create mode 100644 hoogle-test/ref/Bug825/test.txt create mode 100644 hoogle-test/src/Bug825/Bug825.hs (limited to 'haddock-api/src/Haddock/Backends/Hoogle.hs') diff --git a/haddock-api/src/Haddock/Backends/Hoogle.hs b/haddock-api/src/Haddock/Backends/Hoogle.hs index 8d0318c2..6d1bdad0 100644 --- a/haddock-api/src/Haddock/Backends/Hoogle.hs +++ b/haddock-api/src/Haddock/Backends/Hoogle.hs @@ -225,11 +225,10 @@ ppData dflags decl@(DataDecl { tcdDataDefn = defn }) subdocs -- GHC gives out "data Bar =", we want to delete the equals -- also writes data : a b, when we want data (:) a b - showData d = unwords $ map f $ if last xs == "=" then init xs else xs + showData d = unwords $ if last xs == "=" then init xs else xs where xs = words $ out dflags d nam = out dflags $ tyClDeclLName d - f w = if w == nam then operator nam else w ppData _ _ _ = panic "ppData" -- | for constructors, and named-fields... diff --git a/hoogle-test/ref/Bug825/test.txt b/hoogle-test/ref/Bug825/test.txt new file mode 100644 index 00000000..a88202dc --- /dev/null +++ b/hoogle-test/ref/Bug825/test.txt @@ -0,0 +1,9 @@ +-- Hoogle documentation, generated by Haddock +-- See Hoogle, http://www.haskell.org/hoogle/ + +@package test +@version 0.0.0 + +module Bug825 +data a :~: b +data (:~~:) a b diff --git a/hoogle-test/src/Bug825/Bug825.hs b/hoogle-test/src/Bug825/Bug825.hs new file mode 100644 index 00000000..bfe07139 --- /dev/null +++ b/hoogle-test/src/Bug825/Bug825.hs @@ -0,0 +1,6 @@ +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE TypeOperators #-} +module Bug825 where + +data a :~: b +data (:~~:) a b -- cgit v1.2.3 From d1b26b4846f10fc3e0f84f6898852a6605a3e286 Mon Sep 17 00:00:00 2001 From: Ryan Scott Date: Thu, 10 May 2018 11:24:38 -0400 Subject: Wibbles --- haddock-api/src/Haddock/Backends/Hoogle.hs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) (limited to 'haddock-api/src/Haddock/Backends/Hoogle.hs') diff --git a/haddock-api/src/Haddock/Backends/Hoogle.hs b/haddock-api/src/Haddock/Backends/Hoogle.hs index 6d1bdad0..6e8148f7 100644 --- a/haddock-api/src/Haddock/Backends/Hoogle.hs +++ b/haddock-api/src/Haddock/Backends/Hoogle.hs @@ -223,12 +223,12 @@ ppData dflags decl@(DataDecl { tcdDataDefn = defn }) subdocs concatMap (ppCtor dflags decl subdocs . unL) (dd_cons defn) where - -- GHC gives out "data Bar =", we want to delete the equals - -- also writes data : a b, when we want data (:) a b + -- GHC gives out "data Bar =", we want to delete the equals. + -- There's no need to worry about parenthesizing infix data type names, + -- since this Outputable instance for TyClDecl gets this right already. showData d = unwords $ if last xs == "=" then init xs else xs where xs = words $ out dflags d - nam = out dflags $ tyClDeclLName d ppData _ _ _ = panic "ppData" -- | for constructors, and named-fields... -- cgit v1.2.3 From 083faee1cec2df01d7ab8a4ef2dc0a28c0c120cf Mon Sep 17 00:00:00 2001 From: Simon Jakobi Date: Wed, 13 Jun 2018 23:28:47 +0200 Subject: Complete FixitySig and FamilyDecl pattern matches --- haddock-api/src/Haddock/Backends/Hoogle.hs | 1 + haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs | 3 +++ 2 files changed, 4 insertions(+) (limited to 'haddock-api/src/Haddock/Backends/Hoogle.hs') diff --git a/haddock-api/src/Haddock/Backends/Hoogle.hs b/haddock-api/src/Haddock/Backends/Hoogle.hs index 6e8148f7..257a8d6d 100644 --- a/haddock-api/src/Haddock/Backends/Hoogle.hs +++ b/haddock-api/src/Haddock/Backends/Hoogle.hs @@ -201,6 +201,7 @@ ppFam dflags decl@(FamilyDecl { fdInfo = info }) -- for Hoogle, so pretend it doesn't have any. ClosedTypeFamily{} -> decl { fdInfo = OpenTypeFamily } _ -> decl +ppFam _ XFamilyDecl {} = panic "ppFam" ppInstance :: DynFlags -> ClsInst -> [String] ppInstance dflags x = diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs b/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs index 220a59fe..0ecf7109 100644 --- a/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs +++ b/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs @@ -183,8 +183,11 @@ decls (group, _, _, _) = concatMap ($ group) fix term = case cast term of Just ((GHC.FixitySig _ names _) :: GHC.FixitySig GHC.GhcRn) -> map (\(GHC.L sspan x) -> (sspan, RtkVar x)) names + Just ((GHC.XFixitySig {}) :: GHC.FixitySig GHC.GhcRn) + -> GHC.panic "haddock:decls" Nothing -> empty tyfam (GHC.L _ (GHC.FamilyDecl{..})) = [decl fdLName] + tyfam (GHC.L _ (GHC.XFamilyDecl {})) = GHC.panic "haddock:dels" sig (GHC.L _ (GHC.TypeSig _ names _)) = map decl names sig (GHC.L _ (GHC.PatSynSig _ names _)) = map decl names sig (GHC.L _ (GHC.ClassOpSig _ _ names _)) = map decl names -- cgit v1.2.3