From b383b17cd1c4aebe73481dba0df13640e7bfc50a Mon Sep 17 00:00:00 2001 From: Justus Adam Date: Thu, 2 Mar 2017 15:33:34 +0100 Subject: Adding MDoc to exports of Documentation.Haddock --- haddock-api/src/Documentation/Haddock.hs | 1 + 1 file changed, 1 insertion(+) diff --git a/haddock-api/src/Documentation/Haddock.hs b/haddock-api/src/Documentation/Haddock.hs index 1ff5cf75..4203a564 100644 --- a/haddock-api/src/Documentation/Haddock.hs +++ b/haddock-api/src/Documentation/Haddock.hs @@ -34,6 +34,7 @@ module Documentation.Haddock ( -- * Documentation comments Doc, + MDoc, DocH(..), Example(..), Hyperlink(..), -- cgit v1.2.3 From ef99ed85007636a866fbdeed154d89612d68f824 Mon Sep 17 00:00:00 2001 From: Justus Adam Date: Thu, 9 Mar 2017 11:41:44 +0100 Subject: Also exposing toInstalledIface --- haddock-api/src/Documentation/Haddock.hs | 1 + 1 file changed, 1 insertion(+) diff --git a/haddock-api/src/Documentation/Haddock.hs b/haddock-api/src/Documentation/Haddock.hs index 4203a564..14605e92 100644 --- a/haddock-api/src/Documentation/Haddock.hs +++ b/haddock-api/src/Documentation/Haddock.hs @@ -16,6 +16,7 @@ module Documentation.Haddock ( -- * Interface Interface(..), InstalledInterface(..), + toInstalledIface, createInterfaces, processModules, -- cgit v1.2.3 From d2be5e88281d8e3148bc55830c27c75844b86f38 Mon Sep 17 00:00:00 2001 From: Ben Gamari Date: Thu, 9 Mar 2017 22:13:43 -0500 Subject: Bump for GHC 8.2 --- haddock-api/src/Haddock/InterfaceFile.hs | 4 ++-- haddock.cabal | 4 ++-- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/haddock-api/src/Haddock/InterfaceFile.hs b/haddock-api/src/Haddock/InterfaceFile.hs index 63419102..0d000029 100644 --- a/haddock-api/src/Haddock/InterfaceFile.hs +++ b/haddock-api/src/Haddock/InterfaceFile.hs @@ -82,8 +82,8 @@ binaryInterfaceMagic = 0xD0Cface -- (2) set `binaryInterfaceVersionCompatibility` to [binaryInterfaceVersion] -- binaryInterfaceVersion :: Word16 -#if (__GLASGOW_HASKELL__ >= 801) && (__GLASGOW_HASKELL__ < 803) -binaryInterfaceVersion = 28 +#if (__GLASGOW_HASKELL__ >= 802) && (__GLASGOW_HASKELL__ < 804) +binaryInterfaceVersion = 29 binaryInterfaceVersionCompatibility :: [Word16] binaryInterfaceVersionCompatibility = [binaryInterfaceVersion] diff --git a/haddock.cabal b/haddock.cabal index 7103a459..10460526 100644 --- a/haddock.cabal +++ b/haddock.cabal @@ -55,8 +55,8 @@ executable haddock array, xhtml >= 3000.2 && < 3000.3, Cabal >= 1.10, - ghc-boot == 8.1, - ghc == 8.1, + ghc-boot, + ghc == 8.2.*, bytestring, transformers -- cgit v1.2.3 From 4f249c9b64d50d79e7ba703289cd67293a76821a Mon Sep 17 00:00:00 2001 From: Richard Eisenberg Date: Fri, 10 Mar 2017 11:31:33 -0500 Subject: Update Haddock w.r.t. new HsImplicitBndrs --- haddock-api/src/Haddock/Convert.hs | 5 +++-- haddock-api/src/Haddock/Interface/Rename.hs | 3 ++- 2 files changed, 5 insertions(+), 3 deletions(-) diff --git a/haddock-api/src/Haddock/Convert.hs b/haddock-api/src/Haddock/Convert.hs index b5966291..577b1a3c 100644 --- a/haddock-api/src/Haddock/Convert.hs +++ b/haddock-api/src/Haddock/Convert.hs @@ -114,7 +114,8 @@ synifyAxBranch tc (CoAxBranch { cab_tvs = tkvs, cab_lhs = args, cab_rhs = rhs }) hs_rhs = synifyType WithinType rhs in TyFamEqn { tfe_tycon = name , tfe_pats = HsIB { hsib_body = typats - , hsib_vars = map tyVarName tkvs } + , hsib_vars = map tyVarName tkvs + , hsib_closed = True } , tfe_fixity = Prefix , tfe_rhs = hs_rhs } @@ -300,7 +301,7 @@ synifyDataCon use_gadt_syntax dc = (False,True) -> case linear_tys of [a,b] -> return $ InfixCon a b _ -> Left "synifyDataCon: infix with non-2 args?" - gadt_ty = HsIB [] (synifyType WithinType res_ty) + gadt_ty = HsIB [] (synifyType WithinType res_ty) False -- finally we get synifyDataCon's result! in hs_arg_tys >>= \hat -> diff --git a/haddock-api/src/Haddock/Interface/Rename.hs b/haddock-api/src/Haddock/Interface/Rename.hs index f88d9f4e..b43860fb 100644 --- a/haddock-api/src/Haddock/Interface/Rename.hs +++ b/haddock-api/src/Haddock/Interface/Rename.hs @@ -577,7 +577,8 @@ renameImplicit :: (in_thing -> RnM out_thing) renameImplicit rn_thing (HsIB { hsib_body = thing }) = do { thing' <- rn_thing thing ; return (HsIB { hsib_body = thing' - , hsib_vars = PlaceHolder }) } + , hsib_vars = PlaceHolder + , hsib_closed = PlaceHolder }) } renameWc :: (in_thing -> RnM out_thing) -> HsWildCardBndrs Name in_thing -- cgit v1.2.3 From f6f9bca1416f6cee48f2d4731a6c38db92e87300 Mon Sep 17 00:00:00 2001 From: Brian Huffman Date: Fri, 17 Mar 2017 14:57:39 -0700 Subject: Print any user-supplied kind signatures on type parameters. This applies to type parameters on data, newtype, type, and class declarations, and also to forall-bound type vars in type signatures. --- haddock-api/src/Haddock/Backends/Xhtml/Decl.hs | 37 ++++++++++---------------- 1 file changed, 14 insertions(+), 23 deletions(-) diff --git a/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs b/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs index 2aec5272..ffe42c4f 100644 --- a/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs +++ b/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs @@ -171,8 +171,8 @@ ppFixities fs qual = foldr1 (+++) (map ppFix uniq_fs) +++ rightEdge -- | Pretty-print type variables. -ppTyVars :: [LHsTyVarBndr DocName] -> [Html] -ppTyVars tvs = map (ppTyName . getName . hsLTyVarName) tvs +ppTyVars :: Unicode -> Qualification -> [LHsTyVarBndr DocName] -> [Html] +ppTyVars unicode qual tvs = map (ppHsTyVarBndr unicode qual . unLoc) tvs tyvarNames :: LHsQTyVars DocName -> [Name] tyvarNames = map (getName . hsLTyVarName) . hsQTvExplicit @@ -199,7 +199,7 @@ ppTySyn summary links fixities loc doc (SynDecl { tcdLName = L _ name, tcdTyVars splice unicode qual where hdr = hsep ([keyword "type", ppBinder summary occ] - ++ ppTyVars (hsQTvExplicit ltyvars)) + ++ ppTyVars unicode qual (hsQTvExplicit ltyvars)) full = hdr <+> equals <+> ppLType unicode qual ltype occ = nameOccName . getName $ name fixs @@ -353,20 +353,20 @@ ppAssocType summ links doc (L loc decl) fixities splice unicode qual = -- | Print a type family and its variables ppFamDeclBinderWithVars :: Bool -> Unicode -> Qualification -> FamilyDecl DocName -> Html ppFamDeclBinderWithVars summ unicode qual (FamilyDecl { fdLName = lname, fdTyVars = tvs }) = - ppAppDocNameTyVarBndrs summ unicode qual (unLoc lname) (map unLoc $ hsq_explicit tvs) + ppAppDocNameTyVarBndrs summ unicode qual (unLoc lname) (hsq_explicit tvs) -- | Print a newtype / data binder and its variables -ppDataBinderWithVars :: Bool -> TyClDecl DocName -> Html -ppDataBinderWithVars summ decl = - ppAppDocNameNames summ (tcdName decl) (tyvarNames $ tcdTyVars decl) +ppDataBinderWithVars :: Bool -> Unicode -> Qualification -> TyClDecl DocName -> Html +ppDataBinderWithVars summ unicode qual decl = + ppAppDocNameTyVarBndrs summ unicode qual (tcdName decl) (hsQTvExplicit $ tcdTyVars decl) -------------------------------------------------------------------------------- -- * Type applications -------------------------------------------------------------------------------- -ppAppDocNameTyVarBndrs :: Bool -> Unicode -> Qualification -> DocName -> [HsTyVarBndr DocName] -> Html +ppAppDocNameTyVarBndrs :: Bool -> Unicode -> Qualification -> DocName -> [LHsTyVarBndr DocName] -> Html ppAppDocNameTyVarBndrs summ unicode qual n vs = - ppTypeApp n [] vs ppDN (ppHsTyVarBndr unicode qual) + ppTypeApp n [] vs ppDN (ppHsTyVarBndr unicode qual . unLoc) where ppDN notation = ppBinderFixity notation summ . nameOccName . getName ppBinderFixity Infix = ppBinderInfix @@ -379,15 +379,6 @@ ppAppNameTypes n ks ts unicode qual = ppTypeApp n ks ts (\p -> ppDocName qual p True) (ppParendType unicode qual) --- | Print an application of a 'DocName' and a list of 'Names' -ppAppDocNameNames :: Bool -> DocName -> [Name] -> Html -ppAppDocNameNames summ n ns = - ppTypeApp n [] ns ppDN ppTyName - where - ppDN notation = ppBinderFixity notation summ . nameOccName . getName - ppBinderFixity Infix = ppBinderInfix - ppBinderFixity _ = ppBinder - -- | General printing of type applications ppTypeApp :: DocName -> [a] -> [a] -> (Notation -> DocName -> Html) -> (a -> Html) -> Html ppTypeApp n [] (t1:t2:rest) ppDN ppT @@ -445,7 +436,7 @@ ppClassHdr :: Bool -> Located [LHsType DocName] -> DocName ppClassHdr summ lctxt n tvs fds unicode qual = keyword "class" <+> (if not . null . unLoc $ lctxt then ppLContext lctxt unicode qual else noHtml) - <+> ppAppDocNameNames summ n (tyvarNames tvs) + <+> ppAppDocNameTyVarBndrs summ unicode qual n (hsQTvExplicit tvs) <+> ppFds fds unicode qual @@ -890,7 +881,7 @@ ppDataHeader summary decl@(DataDecl { tcdDataDefn = -- context ppLContext ctxt unicode qual <+> -- T a b c ..., or a :+: b - ppDataBinderWithVars summary decl + ppDataBinderWithVars summary unicode qual decl <+> case ks of Nothing -> mempty Just (L _ x) -> dcolon unicode <+> ppKind unicode qual x @@ -967,8 +958,8 @@ ppLKind unicode qual y = ppKind unicode qual (unLoc y) ppKind :: Unicode -> Qualification -> HsKind DocName -> Html ppKind unicode qual ki = ppr_mono_ty pREC_TOP ki unicode qual -ppForAllPart :: [LHsTyVarBndr DocName] -> Unicode -> Html -ppForAllPart tvs unicode = hsep (forallSymbol unicode : ppTyVars tvs) +++ dot +ppForAllPart :: Unicode -> Qualification -> [LHsTyVarBndr DocName] -> Html +ppForAllPart unicode qual tvs = hsep (forallSymbol unicode : ppTyVars unicode qual tvs) +++ dot ppr_mono_lty :: Int -> LHsType DocName -> Unicode -> Qualification -> Html ppr_mono_lty ctxt_prec ty = ppr_mono_ty ctxt_prec (unLoc ty) @@ -977,7 +968,7 @@ ppr_mono_lty ctxt_prec ty = ppr_mono_ty ctxt_prec (unLoc ty) ppr_mono_ty :: Int -> HsType DocName -> Unicode -> Qualification -> Html ppr_mono_ty ctxt_prec (HsForAllTy tvs ty) unicode qual = maybeParen ctxt_prec pREC_FUN $ - ppForAllPart tvs unicode <+> ppr_mono_lty pREC_TOP ty unicode qual + ppForAllPart unicode qual tvs <+> ppr_mono_lty pREC_TOP ty unicode qual ppr_mono_ty ctxt_prec (HsQualTy ctxt ty) unicode qual = maybeParen ctxt_prec pREC_FUN $ -- cgit v1.2.3 From 29c76f761fe131cc00272eed9a0137953dba6180 Mon Sep 17 00:00:00 2001 From: Brian Huffman Date: Fri, 17 Mar 2017 15:10:40 -0700 Subject: Update test suite to expect kind annotations on type parameters. --- html-test/ref/SpuriousSuperclassConstraints.html | 6 +++++- html-test/ref/TypeFamilies.html | 8 ++++---- 2 files changed, 9 insertions(+), 5 deletions(-) diff --git a/html-test/ref/SpuriousSuperclassConstraints.html b/html-test/ref/SpuriousSuperclassConstraints.html index b5aa56b3..e73ef2ac 100644 --- a/html-test/ref/SpuriousSuperclassConstraints.html +++ b/html-test/ref/SpuriousSuperclassConstraints.html @@ -77,7 +77,11 @@ Fix spurious superclass constraints bug.data SomeType f a (f :: * -> *) a #

  • class a (a :: k) >< b
    • (b :: k)

    class a (a :: k) >< b (b :: k) #

    Date: Thu, 23 Mar 2017 17:49:32 +0100 Subject: Include travis build indication badge --- README.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/README.md b/README.md index 160ee995..23d0dd0b 100644 --- a/README.md +++ b/README.md @@ -1,4 +1,4 @@ -# Haddock, a Haskell Documentation Tool +# Haddock, a Haskell Documentation Tool [![Build Status](https://travis-ci.org/haskell/haddock.svg?branch=master)](https://travis-ci.org/haskell/haddock) #### About haddock -- cgit v1.2.3 From ee3e3d03ce17238fb81a2ec83880167335d516e9 Mon Sep 17 00:00:00 2001 From: Ben Gamari Date: Thu, 23 Mar 2017 09:27:28 -0400 Subject: haddock-api: Bump bound on GHC --- haddock-api/haddock-api.cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/haddock-api/haddock-api.cabal b/haddock-api/haddock-api.cabal index 620fd981..922aa07c 100644 --- a/haddock-api/haddock-api.cabal +++ b/haddock-api/haddock-api.cabal @@ -48,7 +48,7 @@ library , xhtml >= 3000.2 && < 3000.3 , Cabal >= 1.10 , ghc-boot - , ghc >= 8.0 && < 8.2 + , ghc == 8.2.* , ghc-paths , haddock-library == 1.4.* -- cgit v1.2.3 From 68e531baa35e698d947686b83525871eb33c3730 Mon Sep 17 00:00:00 2001 From: "Edward Z. Yang" Date: Mon, 13 Mar 2017 02:53:36 -0700 Subject: Correctly handle Backpack identity/semantic modules. Signed-off-by: Edward Z. Yang (cherry picked from commit 26d6c150b31bc4580ab17cfd07b6e7f9afe10737) --- haddock-api/src/Haddock/Interface/Create.hs | 75 +++++++++++++++++++++-------- 1 file changed, 54 insertions(+), 21 deletions(-) diff --git a/haddock-api/src/Haddock/Interface/Create.hs b/haddock-api/src/Haddock/Interface/Create.hs index c8e6b982..ff53fd3c 100644 --- a/haddock-api/src/Haddock/Interface/Create.hs +++ b/haddock-api/src/Haddock/Interface/Create.hs @@ -62,6 +62,7 @@ createInterface tm flags modMap instIfaceMap = do L _ hsm = parsedSource tm !safety = modInfoSafe mi mdl = ms_mod ms + sem_mdl = tcg_semantic_mod (fst (tm_internals_ tm)) dflags = ms_hspp_opts ms !instances = modInfoInstances mi !fam_instances = md_fam_insts md @@ -88,8 +89,9 @@ createInterface tm flags modMap instIfaceMap = do let declsWithDocs = topDecls group_ fixMap = mkFixMap group_ (decls, _) = unzip declsWithDocs - localInsts = filter (nameIsLocalOrFrom mdl) $ map getName instances - ++ map getName fam_instances + localInsts = filter (nameIsLocalOrFrom sem_mdl) + $ map getName instances + ++ map getName fam_instances -- Locations of all TH splices splices = [ l | L l (SpliceD _) <- hsmodDecls hsm ] @@ -104,7 +106,7 @@ createInterface tm flags modMap instIfaceMap = do let allWarnings = M.unions (warningMap : map ifaceWarningMap (M.elems modMap)) - exportItems <- mkExportItems modMap mdl allWarnings gre exportedNames decls + exportItems <- mkExportItems modMap mdl sem_mdl allWarnings gre exportedNames decls maps fixMap splices exports instIfaceMap dflags let !visibleNames = mkVisibleNames maps exportItems opts @@ -156,6 +158,10 @@ createInterface tm flags modMap instIfaceMap = do , ifaceTokenizedSrc = tokenizedSrc } +-- | Given all of the @import M as N@ declarations in a package, +-- create a mapping from the module identity of M, to an alias N +-- (if there are multiple aliases, we pick the last one.) This +-- will go in 'ifaceModuleAliases'. mkAliasMap :: DynFlags -> Maybe RenamedSource -> M.Map Module ModuleName mkAliasMap dflags mRenamedSource = case mRenamedSource of @@ -166,13 +172,28 @@ mkAliasMap dflags mRenamedSource = SrcLoc.L _ alias <- ideclAs impDecl return $ (lookupModuleDyn dflags + -- TODO: This is supremely dodgy, because in general the + -- UnitId isn't going to look anything like the package + -- qualifier (even with old versions of GHC, the + -- IPID would be p-0.1, but a package qualifier never + -- has a version number it. (Is it possible that in + -- Haddock-land, the UnitIds never have version numbers? + -- I, ezyang, have not quite understand Haddock's package + -- identifier model.) + -- + -- Additionally, this is simulating some logic GHC already + -- has for deciding how to qualify names when it outputs + -- them to the user. We should reuse that information; + -- or at least reuse the renamed imports, which know what + -- they import! (fmap Module.fsToUnitId $ fmap sl_fs $ ideclPkgQual impDecl) (case ideclName impDecl of SrcLoc.L _ name -> name), alias)) impDecls --- similar to GHC.lookupModule +-- Similar to GHC.lookupModule +-- ezyang: Not really... lookupModuleDyn :: DynFlags -> Maybe UnitId -> ModuleName -> Module lookupModuleDyn _ (Just pkgId) mdlName = @@ -492,6 +513,7 @@ collectDocs = go Nothing [] mkExportItems :: IfaceMap -> Module -- this module + -> Module -- semantic module -> WarningMap -> GlobalRdrEnv -> [Name] -- exported names (orig) @@ -504,7 +526,7 @@ mkExportItems -> DynFlags -> ErrMsgGhc [ExportItem Name] mkExportItems - modMap thisMod warnings gre exportedNames decls + modMap thisMod semMod warnings gre exportedNames decls maps@(docMap, argMap, subMap, declMap, instMap) fixMap splices optExports instIfaceMap dflags = case optExports of Nothing -> fullModuleContents dflags warnings gre maps fixMap splices decls @@ -515,6 +537,7 @@ mkExportItems lookupExport (IEThingAll (L _ t)) = declWith $ ieWrappedName t lookupExport (IEThingWith (L _ t) _ _ _) = declWith $ ieWrappedName t lookupExport (IEModuleContents (L _ m)) = + -- Pass in identity module, so we can look it up in index correctly moduleExports thisMod m dflags warnings gre exportedNames decls modMap instIfaceMap maps fixMap splices lookupExport (IEGroup lev docStr) = return $ return . ExportGroup lev "" $ processDocString dflags gre docStr @@ -582,6 +605,8 @@ mkExportItems Just decl -> -- We try to get the subs and docs -- from the installed .haddock file for that package. + -- TODO: This needs to be more sophisticated to deal + -- with signature inheritance case M.lookup (nameModule t) instIfaceMap of Nothing -> do liftErrMsg $ tell @@ -597,8 +622,7 @@ mkExportItems mkExportDecl :: Name -> LHsDecl Name -> (DocForDecl Name, [(Name, DocForDecl Name)]) -> ExportItem Name mkExportDecl name decl (doc, subs) = decl' where - decl' = ExportDecl (restrictTo sub_names (extractDecl name mdl decl)) doc subs' [] fixities False - mdl = nameModule name + decl' = ExportDecl (restrictTo sub_names (extractDecl name decl)) doc subs' [] fixities False subs' = filter (isExported . fst) subs sub_names = map fst subs' fixities = [ (n, f) | n <- name:sub_names, Just f <- [M.lookup n fixMap] ] @@ -609,14 +633,20 @@ mkExportItems findDecl :: Name -> ([LHsDecl Name], (DocForDecl Name, [(Name, DocForDecl Name)])) findDecl n - | m == thisMod, Just ds <- M.lookup n declMap = + | m == semMod, Just ds <- M.lookup n declMap = (ds, lookupDocs n warnings docMap argMap subMap) - | Just iface <- M.lookup m modMap, Just ds <- M.lookup n (ifaceDeclMap iface) = + | Just iface <- M.lookup (semToIdMod (moduleUnitId thisMod) m) modMap, Just ds <- M.lookup n (ifaceDeclMap iface) = (ds, lookupDocs n warnings (ifaceDocMap iface) (ifaceArgMap iface) (ifaceSubMap iface)) | otherwise = ([], (noDocForDecl, [])) where m = nameModule n +-- | Given a 'Module' from a 'Name', convert it into a 'Module' that +-- we can actually find in the 'IfaceMap'. +semToIdMod :: UnitId -> Module -> Module +semToIdMod this_uid m + | Module.isHoleModule m = mkModule this_uid (moduleName m) + | otherwise = m hiDecl :: DynFlags -> Name -> ErrMsgGhc (Maybe (LHsDecl Name)) hiDecl dflags t = do @@ -679,7 +709,7 @@ lookupDocs n warnings docMap argMap subMap = -- only return those that are. -- 3) B is visible and all its exports are in scope, in which case we return -- a single 'ExportModule' item. -moduleExports :: Module -- ^ Module A +moduleExports :: Module -- ^ Module A (identity, NOT semantic) -> ModuleName -- ^ The real name of B, the exported module -> DynFlags -- ^ The flags used when typechecking A -> WarningMap @@ -693,8 +723,11 @@ moduleExports :: Module -- ^ Module A -> [SrcSpan] -- ^ Locations of all TH splices -> ErrMsgGhc [ExportItem Name] -- ^ Resulting export items moduleExports thisMod expMod dflags warnings gre _exports decls ifaceMap instIfaceMap maps fixMap splices - | m == thisMod = fullModuleContents dflags warnings gre maps fixMap splices decls + | expMod == moduleName thisMod + = fullModuleContents dflags warnings gre maps fixMap splices decls | otherwise = + -- NB: we constructed the identity module when looking up in + -- the IfaceMap. case M.lookup m ifaceMap of Just iface | OptHide `elem` ifaceOptions iface -> return (ifaceExportItems iface) @@ -710,7 +743,7 @@ moduleExports thisMod expMod dflags warnings gre _exports decls ifaceMap instIfa "documentation for exported module: " ++ pretty dflags expMod] return [] where - m = mkModule unitId expMod + m = mkModule unitId expMod -- Identity module! unitId = moduleUnitId thisMod @@ -789,8 +822,8 @@ fullModuleContents dflags warnings gre (docMap, argMap, subMap, declMap, instMap -- it might be an individual record selector or a class method. In these -- cases we have to extract the required declaration (and somehow cobble -- together a type signature for it...). -extractDecl :: Name -> Module -> LHsDecl Name -> LHsDecl Name -extractDecl name mdl decl +extractDecl :: Name -> LHsDecl Name -> LHsDecl Name +extractDecl name decl | name `elem` getMainDeclBinder (unLoc decl) = decl | otherwise = case unLoc decl of @@ -812,11 +845,11 @@ extractDecl name mdl decl O.$$ O.nest 4 (O.ppr matches)) TyClD d@DataDecl {} -> let (n, tyvar_tys) = (tcdName d, lHsQTyVarsToTypes (tyClDeclTyVars d)) - in SigD <$> extractRecSel name mdl n tyvar_tys (dd_cons (tcdDataDefn d)) + in SigD <$> extractRecSel name n tyvar_tys (dd_cons (tcdDataDefn d)) InstD (DataFamInstD DataFamInstDecl { dfid_tycon = L _ n , dfid_pats = HsIB { hsib_body = tys } , dfid_defn = defn }) -> - SigD <$> extractRecSel name mdl n tys (dd_cons defn) + SigD <$> extractRecSel name n tys (dd_cons defn) InstD (ClsInstD ClsInstDecl { cid_datafam_insts = insts }) -> let matches = [ d | L _ d <- insts -- , L _ ConDecl { con_details = RecCon rec } <- dd_cons (dfid_defn d) @@ -826,19 +859,19 @@ extractDecl name mdl decl , selectorFieldOcc n == name ] in case matches of - [d0] -> extractDecl name mdl (noLoc . InstD $ DataFamInstD d0) + [d0] -> extractDecl name (noLoc . InstD $ DataFamInstD d0) _ -> error "internal: extractDecl (ClsInstD)" _ -> error "internal: extractDecl" -extractRecSel :: Name -> Module -> Name -> [LHsType Name] -> [LConDecl Name] +extractRecSel :: Name -> Name -> [LHsType Name] -> [LConDecl Name] -> LSig Name -extractRecSel _ _ _ _ [] = error "extractRecSel: selector not found" +extractRecSel _ _ _ [] = error "extractRecSel: selector not found" -extractRecSel nm mdl t tvs (L _ con : rest) = +extractRecSel nm t tvs (L _ con : rest) = case getConDetails con of RecCon (L _ fields) | ((l,L _ (ConDeclField _nn ty _)) : _) <- matching_fields fields -> L l (TypeSig [noLoc nm] (mkEmptySigWcType (noLoc (HsFunTy data_ty (getBangType ty))))) - _ -> extractRecSel nm mdl t tvs rest + _ -> extractRecSel nm t tvs rest where matching_fields :: [LConDeclField Name] -> [(SrcSpan, LConDeclField Name)] matching_fields flds = [ (l,f) | f@(L _ (ConDeclField ns _ _)) <- flds -- cgit v1.2.3 From 26879d9b4a2aba264a10812f2738d4db685d61d1 Mon Sep 17 00:00:00 2001 From: "Edward Z. Yang" Date: Mon, 13 Mar 2017 03:03:20 -0700 Subject: Add a field marking if interface is a signature or not. Signed-off-by: Edward Z. Yang (cherry picked from commit 930cfbe58e2e87f5a4d431d89a3c204934e6e858) --- haddock-api/src/Haddock/Interface/Create.hs | 1 + haddock-api/src/Haddock/InterfaceFile.hs | 6 ++++-- haddock-api/src/Haddock/Types.hs | 7 +++++++ 3 files changed, 12 insertions(+), 2 deletions(-) diff --git a/haddock-api/src/Haddock/Interface/Create.hs b/haddock-api/src/Haddock/Interface/Create.hs index ff53fd3c..024cd02d 100644 --- a/haddock-api/src/Haddock/Interface/Create.hs +++ b/haddock-api/src/Haddock/Interface/Create.hs @@ -132,6 +132,7 @@ createInterface tm flags modMap instIfaceMap = do return $! Interface { ifaceMod = mdl + , ifaceIsSig = Module.isHoleModule sem_mdl , ifaceOrigFilename = msHsFilePath ms , ifaceInfo = info , ifaceDoc = Documentation mbDoc modWarn diff --git a/haddock-api/src/Haddock/InterfaceFile.hs b/haddock-api/src/Haddock/InterfaceFile.hs index 0d000029..78853a79 100644 --- a/haddock-api/src/Haddock/InterfaceFile.hs +++ b/haddock-api/src/Haddock/InterfaceFile.hs @@ -372,9 +372,10 @@ instance Binary InterfaceFile where instance Binary InstalledInterface where - put_ bh (InstalledInterface modu info docMap argMap + put_ bh (InstalledInterface modu is_sig info docMap argMap exps visExps opts subMap fixMap) = do put_ bh modu + put_ bh is_sig put_ bh info put_ bh docMap put_ bh argMap @@ -386,6 +387,7 @@ instance Binary InstalledInterface where get bh = do modu <- get bh + is_sig <- get bh info <- get bh docMap <- get bh argMap <- get bh @@ -395,7 +397,7 @@ instance Binary InstalledInterface where subMap <- get bh fixMap <- get bh - return (InstalledInterface modu info docMap argMap + return (InstalledInterface modu is_sig info docMap argMap exps visExps opts subMap fixMap) diff --git a/haddock-api/src/Haddock/Types.hs b/haddock-api/src/Haddock/Types.hs index 8addfa2f..a6dd6354 100644 --- a/haddock-api/src/Haddock/Types.hs +++ b/haddock-api/src/Haddock/Types.hs @@ -80,6 +80,9 @@ data Interface = Interface -- | The module behind this interface. ifaceMod :: !Module + -- | Is this a signature? + , ifaceIsSig :: !Bool + -- | Original file name of the module. , ifaceOrigFilename :: !FilePath @@ -157,6 +160,9 @@ data InstalledInterface = InstalledInterface -- | The module represented by this interface. instMod :: Module + -- | Is this a signature? + , instIsSig :: Bool + -- | Textual information about the module. , instInfo :: HaddockModInfo Name @@ -186,6 +192,7 @@ data InstalledInterface = InstalledInterface toInstalledIface :: Interface -> InstalledInterface toInstalledIface interface = InstalledInterface { instMod = ifaceMod interface + , instIsSig = ifaceIsSig interface , instInfo = ifaceInfo interface , instDocMap = ifaceDocMap interface , instArgMap = ifaceArgMap interface -- cgit v1.2.3 From fbbe544c91020da143160bb8c68ee890d214a69e Mon Sep 17 00:00:00 2001 From: "Edward Z. Yang" Date: Mon, 13 Mar 2017 03:13:10 -0700 Subject: Render signature module tree separately from modules. Signed-off-by: Edward Z. Yang (cherry picked from commit 2067a2d0afa9cef381d26fb7140b67c62f433fc0) --- haddock-api/src/Haddock/Backends/Xhtml.hs | 15 ++++++++++++++- 1 file changed, 14 insertions(+), 1 deletion(-) diff --git a/haddock-api/src/Haddock/Backends/Xhtml.hs b/haddock-api/src/Haddock/Backends/Xhtml.hs index 65b427f9..34911b11 100644 --- a/haddock-api/src/Haddock/Backends/Xhtml.hs +++ b/haddock-api/src/Haddock/Backends/Xhtml.hs @@ -263,13 +263,20 @@ ppHtmlContents dflags odir doctitle _maybe_package themes mathjax_url maybe_index_url maybe_source_url maybe_wiki_url ifaces showPkgs prologue debug qual = do let tree = mkModuleTree dflags showPkgs - [(instMod iface, toInstalledDescription iface) | iface <- ifaces] + [(instMod iface, toInstalledDescription iface) + | iface <- ifaces + , not (instIsSig iface)] + sig_tree = mkModuleTree dflags showPkgs + [(instMod iface, toInstalledDescription iface) + | iface <- ifaces + , instIsSig iface] html = headHtml doctitle Nothing themes mathjax_url +++ bodyHtml doctitle Nothing maybe_source_url maybe_wiki_url Nothing maybe_index_url << [ ppPrologue qual doctitle prologue, + ppSignatureTree qual sig_tree, ppModuleTree qual tree ] createDirectoryIfMissing True odir @@ -282,7 +289,13 @@ ppPrologue qual title (Just doc) = divDescription << (h1 << title +++ docElement thediv (rdrDocToHtml qual doc)) +ppSignatureTree :: Qualification -> [ModuleTree] -> Html +ppSignatureTree qual ts = + divModuleList << (sectionName << "Signatures" +++ mkNodeList qual [] "n" ts) + + ppModuleTree :: Qualification -> [ModuleTree] -> Html +ppModuleTree _ [] = mempty ppModuleTree qual ts = divModuleList << (sectionName << "Modules" +++ mkNodeList qual [] "n" ts) -- cgit v1.2.3 From 4e6f4447caf61b6a91a483f30a15354cbf6cfc31 Mon Sep 17 00:00:00 2001 From: "Edward Z. Yang" Date: Mon, 13 Mar 2017 15:13:27 -0700 Subject: Documentation. Signed-off-by: Edward Z. Yang (cherry picked from commit 0671abfe7e8ceae2269467a30b77ed9d9656e2cc) --- haddock-api/src/Haddock/Interface/Create.hs | 27 ++++++++++++++++++++++----- 1 file changed, 22 insertions(+), 5 deletions(-) diff --git a/haddock-api/src/Haddock/Interface/Create.hs b/haddock-api/src/Haddock/Interface/Create.hs index 024cd02d..502d6599 100644 --- a/haddock-api/src/Haddock/Interface/Create.hs +++ b/haddock-api/src/Haddock/Interface/Create.hs @@ -11,6 +11,10 @@ -- Maintainer : haddock@projects.haskell.org -- Stability : experimental -- Portability : portable +-- +-- This module provides a single function 'createInterface', +-- which creates a Haddock 'Interface' from the typechecking +-- results 'TypecheckedModule' from GHC. ----------------------------------------------------------------------------- module Haddock.Interface.Create (createInterface) where @@ -54,7 +58,11 @@ import HsDecls ( getConDetails ) -- | Use a 'TypecheckedModule' to produce an 'Interface'. -- To do this, we need access to already processed modules in the topological -- sort. That's what's in the 'IfaceMap'. -createInterface :: TypecheckedModule -> [Flag] -> IfaceMap -> InstIfaceMap -> ErrMsgGhc Interface +createInterface :: TypecheckedModule + -> [Flag] -- Boolean flags + -> IfaceMap -- Locally processed modules + -> InstIfaceMap -- External, already installed interfaces + -> ErrMsgGhc Interface createInterface tm flags modMap instIfaceMap = do let ms = pm_mod_summary . tm_parsed_module $ tm @@ -518,7 +526,7 @@ mkExportItems -> WarningMap -> GlobalRdrEnv -> [Name] -- exported names (orig) - -> [LHsDecl Name] + -> [LHsDecl Name] -- renamed source declarations -> Maps -> FixMap -> [SrcSpan] -- splice locations @@ -716,7 +724,7 @@ moduleExports :: Module -- ^ Module A (identity, NOT semantic) -> WarningMap -> GlobalRdrEnv -- ^ The renaming environment used for A -> [Name] -- ^ All the exports of A - -> [LHsDecl Name] -- ^ All the declarations in A + -> [LHsDecl Name] -- ^ All the renamed declarations in A -> IfaceMap -- ^ Already created interfaces -> InstIfaceMap -- ^ Interfaces in other packages -> Maps @@ -765,8 +773,17 @@ moduleExports thisMod expMod dflags warnings gre _exports decls ifaceMap instIfa -- (For more information, see Trac #69) -fullModuleContents :: DynFlags -> WarningMap -> GlobalRdrEnv -> Maps -> FixMap -> [SrcSpan] - -> [LHsDecl Name] -> ErrMsgGhc [ExportItem Name] +-- | Simplified variant of 'mkExportItems', where we can assume that +-- every locally defined declaration is exported; thus, we just +-- zip through the renamed declarations. +fullModuleContents :: DynFlags + -> WarningMap + -> GlobalRdrEnv -- ^ The renaming environment + -> Maps + -> FixMap + -> [SrcSpan] -- ^ Locations of all TH splices + -> [LHsDecl Name] -- ^ All the renamed declarations + -> ErrMsgGhc [ExportItem Name] fullModuleContents dflags warnings gre (docMap, argMap, subMap, declMap, instMap) fixMap splices decls = liftM catMaybes $ mapM mkExportItem (expandSig decls) where -- cgit v1.2.3 From f65966b2febe36c8aae8ebee13d3f12a63479e65 Mon Sep 17 00:00:00 2001 From: "Edward Z. Yang" Date: Mon, 13 Mar 2017 15:25:09 -0700 Subject: More docs. Signed-off-by: Edward Z. Yang (cherry picked from commit 3d77b373dd5807d5d956719dd7c849a11534fa6a) --- haddock-api/src/Haddock/Interface/Create.hs | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/haddock-api/src/Haddock/Interface/Create.hs b/haddock-api/src/Haddock/Interface/Create.hs index 502d6599..f1043c03 100644 --- a/haddock-api/src/Haddock/Interface/Create.hs +++ b/haddock-api/src/Haddock/Interface/Create.hs @@ -92,6 +92,7 @@ createInterface tm flags modMap instIfaceMap = do | Flag_IgnoreAllExports `elem` flags = OptIgnoreExports : opts0 | otherwise = opts0 + -- Process the top-level module header documentation. (!info, mbDoc) <- liftErrMsg $ processModuleHeader dflags gre safety mayDocHeader let declsWithDocs = topDecls group_ @@ -114,6 +115,8 @@ createInterface tm flags modMap instIfaceMap = do let allWarnings = M.unions (warningMap : map ifaceWarningMap (M.elems modMap)) + -- The MAIN functionality: compute the export items which will + -- each be the actual documentation of this module. exportItems <- mkExportItems modMap mdl sem_mdl allWarnings gre exportedNames decls maps fixMap splices exports instIfaceMap dflags @@ -352,6 +355,8 @@ mkMaps dflags gre instances decls = -- | Get all subordinate declarations inside a declaration, and their docs. +-- A subordinate declaration is something like the associate type or data +-- family of a type class. subordinates :: InstMap -> HsDecl Name -> [(Name, [HsDocString], Map Int HsDocString)] subordinates instMap decl = case decl of InstD (ClsInstD d) -> do -- cgit v1.2.3 From 76d0b2b8ac2bfaa7983a9b5ea828f6caf8a6205d Mon Sep 17 00:00:00 2001 From: "Edward Z. Yang" Date: Mon, 13 Mar 2017 15:33:25 -0700 Subject: TODO on moduleExports. Signed-off-by: Edward Z. Yang (cherry picked from commit 94610e9b446324f4231fa6ad4c6ac51e4eba8c0e) --- haddock-api/src/Haddock/Interface/Create.hs | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/haddock-api/src/Haddock/Interface/Create.hs b/haddock-api/src/Haddock/Interface/Create.hs index f1043c03..85401bfa 100644 --- a/haddock-api/src/Haddock/Interface/Create.hs +++ b/haddock-api/src/Haddock/Interface/Create.hs @@ -551,7 +551,11 @@ mkExportItems lookupExport (IEThingAll (L _ t)) = declWith $ ieWrappedName t lookupExport (IEThingWith (L _ t) _ _ _) = declWith $ ieWrappedName t lookupExport (IEModuleContents (L _ m)) = - -- Pass in identity module, so we can look it up in index correctly + -- TODO: We could get more accurate reporting here if IEModuleContents + -- also recorded the actual names that are exported here. We CAN + -- compute this info using @gre@ but 'moduleExports does not seem to + -- do so. + -- NB: Pass in identity module, so we can look it up in index correctly moduleExports thisMod m dflags warnings gre exportedNames decls modMap instIfaceMap maps fixMap splices lookupExport (IEGroup lev docStr) = return $ return . ExportGroup lev "" $ processDocString dflags gre docStr -- cgit v1.2.3 From 24694932de26645331eb53b016c84a6a5c171a97 Mon Sep 17 00:00:00 2001 From: "Edward Z. Yang" Date: Tue, 14 Mar 2017 03:53:49 -0700 Subject: Better Backpack support with signature merging. When we merge signatures, we gain exports that don't necessarily have a source-level declaration corresponding to them. This meant Haddock dropped them. There are two big limitations: * If there's no export list, we won't report inherited signatures. * If the type has a subordinate, the current hiDecl implementation doesn't reconstitute them. These are probably worth fixing eventually, but this gets us to minimum viable functionality. Signed-off-by: Edward Z. Yang (cherry picked from commit 6cc832dfb1de6088a4abcaae62b25a7e944d55c3) --- haddock-api/src/Haddock/Interface/Create.hs | 46 +++++++++++++++++++++-------- 1 file changed, 34 insertions(+), 12 deletions(-) diff --git a/haddock-api/src/Haddock/Interface/Create.hs b/haddock-api/src/Haddock/Interface/Create.hs index 85401bfa..e594feae 100644 --- a/haddock-api/src/Haddock/Interface/Create.hs +++ b/haddock-api/src/Haddock/Interface/Create.hs @@ -71,6 +71,7 @@ createInterface tm flags modMap instIfaceMap = do !safety = modInfoSafe mi mdl = ms_mod ms sem_mdl = tcg_semantic_mod (fst (tm_internals_ tm)) + is_sig = ms_hsc_src ms == HsigFile dflags = ms_hspp_opts ms !instances = modInfoInstances mi !fam_instances = md_fam_insts md @@ -117,7 +118,7 @@ createInterface tm flags modMap instIfaceMap = do -- The MAIN functionality: compute the export items which will -- each be the actual documentation of this module. - exportItems <- mkExportItems modMap mdl sem_mdl allWarnings gre exportedNames decls + exportItems <- mkExportItems is_sig modMap mdl sem_mdl allWarnings gre exportedNames decls maps fixMap splices exports instIfaceMap dflags let !visibleNames = mkVisibleNames maps exportItems opts @@ -143,7 +144,7 @@ createInterface tm flags modMap instIfaceMap = do return $! Interface { ifaceMod = mdl - , ifaceIsSig = Module.isHoleModule sem_mdl + , ifaceIsSig = is_sig , ifaceOrigFilename = msHsFilePath ms , ifaceInfo = info , ifaceDoc = Documentation mbDoc modWarn @@ -525,7 +526,8 @@ collectDocs = go Nothing [] -- We create the export items even if the module is hidden, since they -- might be useful when creating the export items for other modules. mkExportItems - :: IfaceMap + :: Bool -- is it a signature + -> IfaceMap -> Module -- this module -> Module -- semantic module -> WarningMap @@ -540,7 +542,7 @@ mkExportItems -> DynFlags -> ErrMsgGhc [ExportItem Name] mkExportItems - modMap thisMod semMod warnings gre exportedNames decls + is_sig modMap thisMod semMod warnings gre exportedNames decls maps@(docMap, argMap, subMap, declMap, instMap) fixMap splices optExports instIfaceMap dflags = case optExports of Nothing -> fullModuleContents dflags warnings gre maps fixMap splices decls @@ -569,8 +571,9 @@ mkExportItems Just doc -> return . ExportDoc $ processDocStringParas dflags gre doc declWith :: Name -> ErrMsgGhc [ ExportItem Name ] - declWith t = - case findDecl t of + declWith t = do + r <- findDecl t + case r of ([L l (ValD _)], (doc, _)) -> do -- Top-level binding without type signature export <- hiValExportItem dflags t l doc (l `elem` splices) $ M.lookup t fixMap @@ -649,13 +652,32 @@ mkExportItems isExported = (`elem` exportedNames) - findDecl :: Name -> ([LHsDecl Name], (DocForDecl Name, [(Name, DocForDecl Name)])) + findDecl :: Name -> ErrMsgGhc ([LHsDecl Name], (DocForDecl Name, [(Name, DocForDecl Name)])) findDecl n - | m == semMod, Just ds <- M.lookup n declMap = - (ds, lookupDocs n warnings docMap argMap subMap) - | Just iface <- M.lookup (semToIdMod (moduleUnitId thisMod) m) modMap, Just ds <- M.lookup n (ifaceDeclMap iface) = - (ds, lookupDocs n warnings (ifaceDocMap iface) (ifaceArgMap iface) (ifaceSubMap iface)) - | otherwise = ([], (noDocForDecl, [])) + | m == semMod = + case M.lookup n declMap of + Just ds -> return (ds, lookupDocs n warnings docMap argMap subMap) + Nothing + | is_sig -> do + -- OK, so it wasn't in the local declaration map. It could + -- have been inherited from a signature. Reconstitute it + -- from the type. + mb_r <- hiDecl dflags n + case mb_r of + Nothing -> return ([], (noDocForDecl, [])) + -- TODO: If we try harder, we might be able to find + -- a Haddock! Look in the Haddocks for each thing in + -- requirementContext (pkgState) + Just decl -> return ([decl], (noDocForDecl, [])) + | otherwise -> + return ([], (noDocForDecl, [])) + | Just iface <- M.lookup (semToIdMod (moduleUnitId thisMod) m) modMap + , Just ds <- M.lookup n (ifaceDeclMap iface) = + return (ds, lookupDocs n warnings + (ifaceDocMap iface) + (ifaceArgMap iface) + (ifaceSubMap iface)) + | otherwise = return ([], (noDocForDecl, [])) where m = nameModule n -- cgit v1.2.3 From e3568da479b6297e48b8b83ee067174717fdbe22 Mon Sep 17 00:00:00 2001 From: "Edward Z. Yang" Date: Tue, 14 Mar 2017 14:23:35 -0700 Subject: Fix haddock-test to work with latest version of Cabal. Signed-off-by: Edward Z. Yang (cherry picked from commit bf3c4d72a0fda38561376eac7eda216158783267) --- haddock-test/src/Test/Haddock/Config.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/haddock-test/src/Test/Haddock/Config.hs b/haddock-test/src/Test/Haddock/Config.hs index dea101d8..e1e920f2 100644 --- a/haddock-test/src/Test/Haddock/Config.hs +++ b/haddock-test/src/Test/Haddock/Config.hs @@ -237,7 +237,7 @@ baseDependencies ghcPath = do exitFailure (ifArg:_) -> pure ifArg ifaces pkgIndex name = do - pkg <- join $ snd <$> lookupPackageName pkgIndex (PackageName name) + pkg <- join $ snd <$> lookupPackageName pkgIndex (mkPackageName name) iface <$> haddockInterfaces pkg <*> haddockHTMLs pkg iface file html = "--read-interface=" ++ html ++ "," ++ file -- cgit v1.2.3 From ef93eaac9bc0ca40073763d2e18ced3a51679ead Mon Sep 17 00:00:00 2001 From: "Edward Z. Yang" Date: Wed, 22 Mar 2017 13:48:12 -0700 Subject: Annotate signature docs with (signature) Signed-off-by: Edward Z. Yang (cherry picked from commit 07b88c5d4e79b87a319fbb08f8ea01dbb41063c1) --- haddock-api/src/Haddock/Backends/Xhtml.hs | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/haddock-api/src/Haddock/Backends/Xhtml.hs b/haddock-api/src/Haddock/Backends/Xhtml.hs index 34911b11..fc26afbb 100644 --- a/haddock-api/src/Haddock/Backends/Xhtml.hs +++ b/haddock-api/src/Haddock/Backends/Xhtml.hs @@ -482,13 +482,16 @@ ppHtmlModule odir doctitle themes mdl = ifaceMod iface aliases = ifaceModuleAliases iface mdl_str = moduleString mdl + mdl_str_annot = mdl_str ++ if ifaceIsSig iface + then " (signature)" + else "" real_qual = makeModuleQual qual aliases mdl html = - headHtml mdl_str (Just $ "mini_" ++ moduleHtmlFile mdl) themes maybe_mathjax_url +++ + headHtml mdl_str_annot (Just $ "mini_" ++ moduleHtmlFile mdl) themes maybe_mathjax_url +++ bodyHtml doctitle (Just iface) maybe_source_url maybe_wiki_url maybe_contents_url maybe_index_url << [ - divModuleHeader << (moduleInfo iface +++ (sectionName << mdl_str)), + divModuleHeader << (moduleInfo iface +++ (sectionName << mdl_str_annot)), ifaceToHtml maybe_source_url maybe_wiki_url iface unicode real_qual ] -- cgit v1.2.3 From 0567d936e02dcbc41c62b4dd63c7aaafc3383844 Mon Sep 17 00:00:00 2001 From: "Edward Z. Yang" Date: Wed, 22 Mar 2017 14:11:25 -0700 Subject: Render help documentation link next to (signature) in title. Signed-off-by: Edward Z. Yang (cherry picked from commit 4eb765ca4205c79539d60b7afa9b7e261a4a49fe) --- haddock-api/resources/html/Ocean.std-theme/ocean.css | 5 +++++ haddock-api/src/Haddock/Backends/Xhtml.hs | 9 ++++++++- 2 files changed, 13 insertions(+), 1 deletion(-) diff --git a/haddock-api/resources/html/Ocean.std-theme/ocean.css b/haddock-api/resources/html/Ocean.std-theme/ocean.css index e8e4d705..29af691b 100644 --- a/haddock-api/resources/html/Ocean.std-theme/ocean.css +++ b/haddock-api/resources/html/Ocean.std-theme/ocean.css @@ -88,6 +88,11 @@ pre, code, kbd, samp, tt, .src { font-size: 182%; /* 24pt */ } +#module-header .caption sup { + font-size: 70%; + font-weight: normal; +} + .info { font-size: 85%; /* 11pt */ } diff --git a/haddock-api/src/Haddock/Backends/Xhtml.hs b/haddock-api/src/Haddock/Backends/Xhtml.hs index fc26afbb..4cb028b8 100644 --- a/haddock-api/src/Haddock/Backends/Xhtml.hs +++ b/haddock-api/src/Haddock/Backends/Xhtml.hs @@ -485,13 +485,17 @@ ppHtmlModule odir doctitle themes mdl_str_annot = mdl_str ++ if ifaceIsSig iface then " (signature)" else "" + mdl_str_linked = mdl_str +++ + " (signature" +++ + sup << ("[" +++ anchor ! [href signatureDocURL] << "?" +++ "]" ) +++ + ")" real_qual = makeModuleQual qual aliases mdl html = headHtml mdl_str_annot (Just $ "mini_" ++ moduleHtmlFile mdl) themes maybe_mathjax_url +++ bodyHtml doctitle (Just iface) maybe_source_url maybe_wiki_url maybe_contents_url maybe_index_url << [ - divModuleHeader << (moduleInfo iface +++ (sectionName << mdl_str_annot)), + divModuleHeader << (moduleInfo iface +++ (sectionName << mdl_str_linked)), ifaceToHtml maybe_source_url maybe_wiki_url iface unicode real_qual ] @@ -499,6 +503,9 @@ ppHtmlModule odir doctitle themes writeFile (joinPath [odir, moduleHtmlFile mdl]) (renderToString debug html) ppHtmlModuleMiniSynopsis odir doctitle themes maybe_mathjax_url iface unicode real_qual debug +signatureDocURL :: String +signatureDocURL = "https://wiki.haskell.org/Module_signature" + ppHtmlModuleMiniSynopsis :: FilePath -> String -> Themes -> Maybe String -> Interface -> Bool -> Qualification -> Bool -> IO () ppHtmlModuleMiniSynopsis odir _doctitle themes maybe_mathjax_url iface unicode qual debug = do -- cgit v1.2.3 From 18ed871afb82560d5433b2f53e31b4db9353a74e Mon Sep 17 00:00:00 2001 From: Phil Ruffwind Date: Sat, 1 Apr 2017 05:05:06 -0400 Subject: Update MathJax URL MathJax is shutting down their CDN: https://www.mathjax.org/cdn-shutting-down/ They recommend migrating to cdnjs. --- haddock-api/src/Haddock/Backends/Xhtml.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/haddock-api/src/Haddock/Backends/Xhtml.hs b/haddock-api/src/Haddock/Backends/Xhtml.hs index 4cb028b8..c5caa6a2 100644 --- a/haddock-api/src/Haddock/Backends/Xhtml.hs +++ b/haddock-api/src/Haddock/Backends/Xhtml.hs @@ -126,7 +126,7 @@ headHtml docTitle miniPage themes mathjax_url = ] where setSynopsis = maybe "" (\p -> "setSynopsis(\"" ++ p ++ "\");") miniPage - mjUrl = maybe "https://cdn.mathjax.org/mathjax/latest/MathJax.js?config=TeX-AMS-MML_HTMLorMML" id mathjax_url + mjUrl = maybe "https://cdnjs.cloudflare.com/ajax/libs/mathjax/2.7.0/MathJax.js?config=TeX-AMS-MML_HTMLorMML" id mathjax_url srcButton :: SourceURLs -> Maybe Interface -> Maybe Html -- cgit v1.2.3 From 1185aba1fd0727028dc223380c811ec98a42605c Mon Sep 17 00:00:00 2001 From: David Turner Date: Fri, 17 Mar 2017 12:04:04 +0000 Subject: Add highlight for :target to ocean.css --- haddock-api/resources/html/Ocean.std-theme/ocean.css | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/haddock-api/resources/html/Ocean.std-theme/ocean.css b/haddock-api/resources/html/Ocean.std-theme/ocean.css index 29af691b..9d2c644f 100644 --- a/haddock-api/resources/html/Ocean.std-theme/ocean.css +++ b/haddock-api/resources/html/Ocean.std-theme/ocean.css @@ -614,4 +614,8 @@ div#style-menu-holder { float: right; } +:target { + background-color: #ffff00; +} + /* @end */ -- cgit v1.2.3 From 02a633476f68c9a8efe579abfd4745a08d145f89 Mon Sep 17 00:00:00 2001 From: alexbiehl Date: Tue, 11 Apr 2017 19:35:58 +0200 Subject: Allow base-4.10 for haddock-test --- haddock-test/haddock-test.cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/haddock-test/haddock-test.cabal b/haddock-test/haddock-test.cabal index 7cb15d7d..ef928e78 100644 --- a/haddock-test/haddock-test.cabal +++ b/haddock-test/haddock-test.cabal @@ -16,7 +16,7 @@ library default-language: Haskell2010 ghc-options: -Wall hs-source-dirs: src - build-depends: base >= 4.3 && < 4.10, bytestring, directory, process, filepath, Cabal, xml, xhtml, syb + build-depends: base >= 4.3 && < 4.11, bytestring, directory, process, filepath, Cabal, xml, xhtml, syb exposed-modules: Test.Haddock -- cgit v1.2.3 From 8260f433c5e7b9baf47ae94f2208a2eedfad189d Mon Sep 17 00:00:00 2001 From: alexbiehl Date: Tue, 11 Apr 2017 19:38:00 +0200 Subject: cabal.project for haddock-api, haddock-library and haddock-test --- .gitignore | 1 + cabal.project | 3 +++ 2 files changed, 4 insertions(+) create mode 100644 cabal.project diff --git a/.gitignore b/.gitignore index 2bbb0885..5d82bc96 100644 --- a/.gitignore +++ b/.gitignore @@ -1,4 +1,5 @@ /dist/ +/dist-newstyle/ /haddock-api/dist/ /haddock-library/dist/ /haddock-test/dist/ diff --git a/cabal.project b/cabal.project new file mode 100644 index 00000000..b48ea111 --- /dev/null +++ b/cabal.project @@ -0,0 +1,3 @@ +packages: ./haddock-api + ./haddock-library + ./haddock-test \ No newline at end of file -- cgit v1.2.3 From 62ae5e71ceaee2e5ae58c87f870cdc5ccfe67e33 Mon Sep 17 00:00:00 2001 From: alexbiehl Date: Tue, 11 Apr 2017 19:46:29 +0200 Subject: Move dist scripts to scripts/ --- build-windows-dist.sh | 18 ------------------ make-sdist.sh | 36 ------------------------------------ scripts/build-windows-dist.sh | 18 ++++++++++++++++++ scripts/make-sdist.sh | 36 ++++++++++++++++++++++++++++++++++++ 4 files changed, 54 insertions(+), 54 deletions(-) delete mode 100644 build-windows-dist.sh delete mode 100644 make-sdist.sh create mode 100644 scripts/build-windows-dist.sh create mode 100644 scripts/make-sdist.sh diff --git a/build-windows-dist.sh b/build-windows-dist.sh deleted file mode 100644 index 2ae7dd2a..00000000 --- a/build-windows-dist.sh +++ /dev/null @@ -1,18 +0,0 @@ -# mini script for building the relocatable Windows binary distribution. -# -# sh build-windows-dist.sh -# -# NB. the Cabal that shipped with GHC 6.6 isn't enough for this, because it -# is missing this patch: -# -# Fri Oct 13 11:09:41 BST 2006 Simon Marlow -# * Fix getDataDir etc. when bindir=$prefix -# -# So you need to use a more recent Cabal. GHC 6.6 is fine for building the -# package, though. - -ghc --make Setup -./Setup configure --prefix=`pwd`/install --bindir='$prefix' --libdir='$prefix' --datadir='$prefix' -./Setup build -./Setup install -echo Now zip up `pwd`/install as "haddock--Win32.zip" diff --git a/make-sdist.sh b/make-sdist.sh deleted file mode 100644 index 914bf909..00000000 --- a/make-sdist.sh +++ /dev/null @@ -1,36 +0,0 @@ -# Put the Happy-generated .hs files in the right place in the source dist. -set -e -rm -f dist/haddock-*.tar.gz -rm -rf dist/haddock-*/ -./Setup sdist -cd dist -tar xvzf haddock-*.tar.gz -cd haddock-*/ -mkdir dist -mkdir dist/build -mv haddock dist/build -cd .. -tar cvzf haddock-*.tar.gz haddock-*/ - -# Steps for doing a release: -# * Update version number in .cabal, doc/haddock.xml -# * Update CHANGES -# * Source: -# - do the above -# - upload the dist to haskell.org:haddock/dist/${version} -# - scp CHANGES haskell.org:haddock/CHANGES.txt -# * Binaries: -# - build the Windows binary zip (see build-windows-dist.sh) -# - scp haddock--Win32.zip haskell.org:haddock/dist -# * Documentation: -# - cd doc -# - make html -# - mv haddock haddock-html -# - tar cvzf haddock-doc-html-${version}.tar.gz haddock-html -# - scp haddock-doc-html-${version}.tar.gz www.haskell.org:../haskell/haddock/doc -# - ssh haskell.org -# - cd haddock/doc -# - tar xvzf haddock-doc-html-${version}.tar.gz -# - rm -rf html-OLD -# - mv html html-OLD && mv haddock-html html -# * Update the web page (~/darcs/www/haddock/index.html), and push it diff --git a/scripts/build-windows-dist.sh b/scripts/build-windows-dist.sh new file mode 100644 index 00000000..2ae7dd2a --- /dev/null +++ b/scripts/build-windows-dist.sh @@ -0,0 +1,18 @@ +# mini script for building the relocatable Windows binary distribution. +# +# sh build-windows-dist.sh +# +# NB. the Cabal that shipped with GHC 6.6 isn't enough for this, because it +# is missing this patch: +# +# Fri Oct 13 11:09:41 BST 2006 Simon Marlow +# * Fix getDataDir etc. when bindir=$prefix +# +# So you need to use a more recent Cabal. GHC 6.6 is fine for building the +# package, though. + +ghc --make Setup +./Setup configure --prefix=`pwd`/install --bindir='$prefix' --libdir='$prefix' --datadir='$prefix' +./Setup build +./Setup install +echo Now zip up `pwd`/install as "haddock--Win32.zip" diff --git a/scripts/make-sdist.sh b/scripts/make-sdist.sh new file mode 100644 index 00000000..914bf909 --- /dev/null +++ b/scripts/make-sdist.sh @@ -0,0 +1,36 @@ +# Put the Happy-generated .hs files in the right place in the source dist. +set -e +rm -f dist/haddock-*.tar.gz +rm -rf dist/haddock-*/ +./Setup sdist +cd dist +tar xvzf haddock-*.tar.gz +cd haddock-*/ +mkdir dist +mkdir dist/build +mv haddock dist/build +cd .. +tar cvzf haddock-*.tar.gz haddock-*/ + +# Steps for doing a release: +# * Update version number in .cabal, doc/haddock.xml +# * Update CHANGES +# * Source: +# - do the above +# - upload the dist to haskell.org:haddock/dist/${version} +# - scp CHANGES haskell.org:haddock/CHANGES.txt +# * Binaries: +# - build the Windows binary zip (see build-windows-dist.sh) +# - scp haddock--Win32.zip haskell.org:haddock/dist +# * Documentation: +# - cd doc +# - make html +# - mv haddock haddock-html +# - tar cvzf haddock-doc-html-${version}.tar.gz haddock-html +# - scp haddock-doc-html-${version}.tar.gz www.haskell.org:../haskell/haddock/doc +# - ssh haskell.org +# - cd haddock/doc +# - tar xvzf haddock-doc-html-${version}.tar.gz +# - rm -rf html-OLD +# - mv html html-OLD && mv haddock-html html +# * Update the web page (~/darcs/www/haddock/index.html), and push it -- cgit v1.2.3 From 39642e46e98157f5f7e547987c798c9698c871c7 Mon Sep 17 00:00:00 2001 From: alexbiehl Date: Tue, 11 Apr 2017 20:34:46 +0200 Subject: Add haddock to cabal.project --- cabal.project | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/cabal.project b/cabal.project index b48ea111..ba925e3d 100644 --- a/cabal.project +++ b/cabal.project @@ -1,3 +1,4 @@ -packages: ./haddock-api +packages: ./ + ./haddock-api ./haddock-library - ./haddock-test \ No newline at end of file + ./haddock-test -- cgit v1.2.3 From e0ada1743cb722d2f82498a95b201f3ffb303137 Mon Sep 17 00:00:00 2001 From: alexbiehl Date: Tue, 11 Apr 2017 20:35:08 +0200 Subject: Read files for hyperlinker eagerly This also exposes Documentation.Haddock.Utf8 --- haddock-api/src/Haddock/Interface/Create.hs | 12 ++++++++---- haddock-library/haddock-library.cabal | 2 +- 2 files changed, 9 insertions(+), 5 deletions(-) diff --git a/haddock-api/src/Haddock/Interface/Create.hs b/haddock-api/src/Haddock/Interface/Create.hs index e594feae..d2ad9294 100644 --- a/haddock-api/src/Haddock/Interface/Create.hs +++ b/haddock-api/src/Haddock/Interface/Create.hs @@ -19,6 +19,7 @@ module Haddock.Interface.Create (createInterface) where import Documentation.Haddock.Doc (metaDocAppend) +import Documentation.Haddock.Utf8 as Utf8 import Haddock.Types import Haddock.Options import Haddock.GhcUtils @@ -29,6 +30,7 @@ import Haddock.Backends.Hyperlinker.Types import Haddock.Backends.Hyperlinker.Ast as Hyperlinker import Haddock.Backends.Hyperlinker.Parser as Hyperlinker +import qualified Data.ByteString as BS import qualified Data.Map as M import Data.Map (Map) import Data.List @@ -38,6 +40,7 @@ import Data.Ord import Control.Applicative import Control.Arrow (second) import Control.DeepSeq +import Control.Exception (evaluate) import Control.Monad import Data.Function (on) @@ -976,10 +979,11 @@ mkMaybeTokenizedSrc flags tm summary = pm_mod_summary . tm_parsed_module $ tm mkTokenizedSrc :: ModSummary -> RenamedSource -> IO [RichToken] -mkTokenizedSrc ms src = - Hyperlinker.enrich src . Hyperlinker.parse <$> rawSrc - where - rawSrc = readFile $ msHsFilePath ms +mkTokenizedSrc ms src = do + -- make sure to read the whole file at once otherwise + -- we run out of file descriptors (see #495) + rawSrc <- BS.readFile (msHsFilePath ms) >>= evaluate + return $ Hyperlinker.enrich src (Hyperlinker.parse (decodeUtf8 rawSrc)) -- | Find a stand-alone documentation comment by its name. findNamedDoc :: String -> [HsDecl Name] -> ErrMsgM (Maybe HsDocString) diff --git a/haddock-library/haddock-library.cabal b/haddock-library/haddock-library.cabal index cabfbc67..4e355dd1 100644 --- a/haddock-library/haddock-library.cabal +++ b/haddock-library/haddock-library.cabal @@ -34,6 +34,7 @@ library Documentation.Haddock.Parser.Monad Documentation.Haddock.Types Documentation.Haddock.Doc + Documentation.Haddock.Utf8 other-modules: Data.Attoparsec @@ -48,7 +49,6 @@ library Data.Attoparsec.Internal.Types Data.Attoparsec.Number Documentation.Haddock.Parser.Util - Documentation.Haddock.Utf8 test-suite spec type: exitcode-stdio-1.0 -- cgit v1.2.3 From b44676d9acd36b50a93aea6882751284d00013b6 Mon Sep 17 00:00:00 2001 From: alexbiehl Date: Tue, 11 Apr 2017 20:37:06 +0200 Subject: Explicit import list ofr Control.DeepSeq in Haddock.Interface.Create --- haddock-api/src/Haddock/Interface/Create.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/haddock-api/src/Haddock/Interface/Create.hs b/haddock-api/src/Haddock/Interface/Create.hs index d2ad9294..6ff1223c 100644 --- a/haddock-api/src/Haddock/Interface/Create.hs +++ b/haddock-api/src/Haddock/Interface/Create.hs @@ -39,7 +39,7 @@ import Data.Monoid import Data.Ord import Control.Applicative import Control.Arrow (second) -import Control.DeepSeq +import Control.DeepSeq (force) import Control.Exception (evaluate) import Control.Monad import Data.Function (on) -- cgit v1.2.3 From e9cd7b1b52228b9ef8e1bd4e6cb1f2583740fcee Mon Sep 17 00:00:00 2001 From: Kyrill Briantsev Date: Thu, 12 Jan 2017 13:23:50 +0300 Subject: Prevent GHC API from doing optimization passes. --- haddock-api/src/Haddock.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/haddock-api/src/Haddock.hs b/haddock-api/src/Haddock.hs index bbaea359..6af0874a 100644 --- a/haddock-api/src/Haddock.hs +++ b/haddock-api/src/Haddock.hs @@ -397,7 +397,7 @@ withGhc' libDir flags ghcActs = runGhc (Just libDir) $ do ghcMode = CompManager, ghcLink = NoLink } - let dynflags'' = gopt_unset dynflags' Opt_SplitObjs + let dynflags'' = updOptLevel 0 $ gopt_unset dynflags' Opt_SplitObjs defaultCleanupHandler dynflags'' $ do -- ignore the following return-value, which is a list of packages -- that may need to be re-linked: Haddock doesn't do any -- cgit v1.2.3 From 3b64e93ec1811bb5741550a4956ea5f28be24443 Mon Sep 17 00:00:00 2001 From: Alexander Biehl Date: Wed, 12 Apr 2017 16:32:04 +0200 Subject: Add @alexbiehl as maintaner --- haddock-api/haddock-api.cabal | 2 +- haddock-library/haddock-library.cabal | 2 +- haddock.cabal | 2 +- 3 files changed, 3 insertions(+), 3 deletions(-) diff --git a/haddock-api/haddock-api.cabal b/haddock-api/haddock-api.cabal index 922aa07c..f98a8202 100644 --- a/haddock-api/haddock-api.cabal +++ b/haddock-api/haddock-api.cabal @@ -6,7 +6,7 @@ description: Haddock is a documentation-generation tool for Haskell license: BSD3 license-file: LICENSE author: Simon Marlow, David Waern -maintainer: Simon Hengel , Mateusz Kowalczyk +maintainer: Alex Biehl , Simon Hengel , Mateusz Kowalczyk homepage: http://www.haskell.org/haddock/ bug-reports: https://github.com/haskell/haddock/issues copyright: (c) Simon Marlow, David Waern diff --git a/haddock-library/haddock-library.cabal b/haddock-library/haddock-library.cabal index 4e355dd1..463569a3 100644 --- a/haddock-library/haddock-library.cabal +++ b/haddock-library/haddock-library.cabal @@ -9,7 +9,7 @@ description: Haddock is a documentation-generation tool for Haskell itself, see the ‘haddock’ package. license: BSD3 license-file: LICENSE -maintainer: Simon Hengel , Mateusz Kowalczyk +maintainer: Alex Biehl , Simon Hengel , Mateusz Kowalczyk homepage: http://www.haskell.org/haddock/ bug-reports: https://github.com/haskell/haddock/issues category: Documentation diff --git a/haddock.cabal b/haddock.cabal index 6ebdad76..a79f8c78 100644 --- a/haddock.cabal +++ b/haddock.cabal @@ -6,7 +6,7 @@ description: Haddock is a documentation-generation tool for Haskell license: BSD3 license-file: LICENSE author: Simon Marlow, David Waern -maintainer: Simon Hengel , Mateusz Kowalczyk +maintainer: Alex Biehl , Simon Hengel , Mateusz Kowalczyk homepage: http://www.haskell.org/haddock/ bug-reports: https://github.com/haskell/haddock/issues copyright: (c) Simon Marlow, David Waern -- cgit v1.2.3 From 99ec96e57ea6b002394c923201d46a67ecfb8e16 Mon Sep 17 00:00:00 2001 From: Alex Biehl Date: Thu, 13 Apr 2017 07:27:18 +0200 Subject: Disable doctest with ghc-8.3 Currently doctest doesn't support ghc-head --- .travis.yml | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/.travis.yml b/.travis.yml index 7fb97c8e..405f8753 100644 --- a/.travis.yml +++ b/.travis.yml @@ -14,13 +14,13 @@ before_install: - cabal update - cd haddock-library - cabal install --only-dependencies --enable-tests - - cabal install doctest +# - cabal install doctest # --ghc-options=-Werror - cabal configure --enable-tests && cabal build && cabal test - - doctest -isrc -i$(echo vendor/attoparsec-*) -optP-include -optPdist/build/autogen/cabal_macros.h src/Documentation/Haddock/Parser.hs +# - doctest -isrc -i$(echo vendor/attoparsec-*) -optP-include -optPdist/build/autogen/cabal_macros.h src/Documentation/Haddock/Parser.hs - cabal install - cd .. - (cd haddock-api/ && cabal install --only-dependencies --enable-tests && cabal configure --enable-tests && cabal build && cabal test && cabal install) script: - - cabal configure --enable-tests && cabal build && cabal test \ No newline at end of file + - cabal configure --enable-tests && cabal build && cabal test -- cgit v1.2.3 From 70885ce16e1b0b9bf19fe0efb85a48daa0e5c281 Mon Sep 17 00:00:00 2001 From: alexbiehl Date: Tue, 18 Apr 2017 16:45:32 +0200 Subject: Travis: Use ghc-8.2.1 on master --- .travis.yml | 84 +++++++++++++++++++++++++++------ haddock-api/haddock-api.cabal | 5 +- haddock-api/src/Haddock.hs | 25 ++++++---- haddock-library/haddock-library.cabal | 5 +- haddock-test/src/Test/Haddock/Config.hs | 17 +++++-- haddock.cabal | 53 ++++++++++++--------- 6 files changed, 136 insertions(+), 53 deletions(-) diff --git a/.travis.yml b/.travis.yml index 405f8753..c1f8f504 100644 --- a/.travis.yml +++ b/.travis.yml @@ -1,26 +1,80 @@ +# This Travis job script has been generated by a script via +# +# make_travis_yml_2.hs 'haddock.cabal' +# +# For more information, see https://github.com/hvr/multi-ghc-travis +# +language: c sudo: false +git: + submodules: false # whether to recursively clone submodules + +cache: + directories: + - $HOME/.cabal/packages + - $HOME/.cabal/store + +before_cache: + - rm -fv $HOME/.cabal/packages/hackage.haskell.org/build-reports.log + # remove files that are regenerated by 'cabal update' + - rm -fv $HOME/.cabal/packages/hackage.haskell.org/00-index.* + - rm -fv $HOME/.cabal/packages/hackage.haskell.org/*.json + - rm -fv $HOME/.cabal/packages/hackage.haskell.org/01-index.cache + - rm -fv $HOME/.cabal/packages/hackage.haskell.org/01-index.tar + - rm -fv $HOME/.cabal/packages/hackage.haskell.org/01-index.tar.idx + matrix: include: - - env: CABALVER=head GHCVER=head - addons: {apt: {packages: [cabal-install-head,ghc-head], sources: [hvr-ghc]}} + - compiler: "ghc-8.2.1" + # env: TEST=--disable-tests BENCH=--disable-benchmarks + addons: {apt: {packages: [ghc-ppa-tools,cabal-install-head,ghc-8.2.1], sources: [hvr-ghc]}} + - compiler: "ghc-head" + # env: TEST=--disable-tests BENCH=--disable-benchmarks + addons: {apt: {packages: [ghc-ppa-tools,cabal-install-head,ghc-head], sources: [hvr-ghc]}} allow_failures: - - env: CABALVER=head GHCVER=head + - compiler: "ghc-head" before_install: - - export PATH=$HOME/.cabal/bin:/opt/ghc/$GHCVER/bin:/opt/cabal/$CABALVER/bin:$PATH + - HC=${CC} + - unset CC + - PATH=/opt/ghc/bin:/opt/ghc-ppa-tools/bin:$PATH + - PKGNAME='haddock' + +install: - cabal --version - - cabal update - - cd haddock-library - - cabal install --only-dependencies --enable-tests -# - cabal install doctest - # --ghc-options=-Werror - - cabal configure --enable-tests && cabal build && cabal test -# - doctest -isrc -i$(echo vendor/attoparsec-*) -optP-include -optPdist/build/autogen/cabal_macros.h src/Documentation/Haddock/Parser.hs - - cabal install - - cd .. - - (cd haddock-api/ && cabal install --only-dependencies --enable-tests && cabal configure --enable-tests && cabal build && cabal test && cabal install) + - echo "$(${HC} --version) [$(${HC} --print-project-git-commit-id 2> /dev/null || echo '?')]" + - BENCH=${BENCH---enable-benchmarks} + - TEST=${TEST---enable-tests} + - travis_retry cabal update -v + - sed -i 's/^jobs:/-- jobs:/' ${HOME}/.cabal/config + - rm -fv cabal.project.local + - rm -f cabal.project.freeze + - cabal new-build -w ${HC} ${TEST} ${BENCH} --dep -j2 all + - cabal new-build -w ${HC} --disable-tests --disable-benchmarks --dep -j2 all +# Here starts the actual work to be performed for the package under test; +# any command which exits with a non-zero exit code causes the build to fail. script: - - cabal configure --enable-tests && cabal build && cabal test + - if [ -f configure.ac ]; then autoreconf -i; fi + - rm -rf dist/ + - cabal sdist # test that a source-distribution can be generated + - cd dist/ + - SRCTAR=(${PKGNAME}-*.tar.gz) + - SRC_BASENAME="${SRCTAR/%.tar.gz}" + - tar -xvf "./$SRC_BASENAME.tar.gz" + - cd "$SRC_BASENAME/" +## from here on, CWD is inside the extracted source-tarball + - rm -fv cabal.project.local + # this builds all libraries and executables (without tests/benchmarks) + - rm -f cabal.project.freeze + - cabal new-build -w ${HC} --disable-tests --disable-benchmarks all + # this builds all libraries and executables (including tests/benchmarks) + # - rm -rf ./dist-newstyle + + # build & run tests + - cabal new-build -w ${HC} ${TEST} ${BENCH} all + - if [ "x$TEST" = "x--enable-tests" ]; then cabal new-test -w ${HC} ${TEST} all; fi + +# EOF diff --git a/haddock-api/haddock-api.cabal b/haddock-api/haddock-api.cabal index f98a8202..921e16eb 100644 --- a/haddock-api/haddock-api.cabal +++ b/haddock-api/haddock-api.cabal @@ -12,7 +12,7 @@ bug-reports: https://github.com/haskell/haddock/issues copyright: (c) Simon Marlow, David Waern category: Documentation build-type: Simple -cabal-version: >= 1.10 +cabal-version: >= 2.0 stability: experimental data-dir: @@ -120,6 +120,9 @@ test-suite spec , hspec , QuickCheck == 2.* + build-tool-depends: + hspec-discover:hspec-discover + source-repository head type: git location: https://github.com/haskell/haddock.git diff --git a/haddock-api/src/Haddock.hs b/haddock-api/src/Haddock.hs index 6af0874a..dec85b79 100644 --- a/haddock-api/src/Haddock.hs +++ b/haddock-api/src/Haddock.hs @@ -426,15 +426,22 @@ getHaddockLibDir flags = #ifdef IN_GHC_TREE getInTreeDir #else - d <- getDataDir -- provided by Cabal - doesDirectoryExist d >>= \exists -> case exists of - True -> return d - False -> do - -- If directory does not exist then we are probably invoking from - -- ./dist/build/haddock/haddock so we use ./resources as a fallback. - doesDirectoryExist "resources" >>= \exists_ -> case exists_ of - True -> return "resources" - False -> die ("Haddock's resource directory (" ++ d ++ ") does not exist!\n") + -- if data directory does not exist we are probably + -- invoking from either ./haddock-api or ./ + let res_dirs = [ getDataDir -- provided by Cabal + , pure "resources" + , pure "haddock-api/resources" + ] + + check get_path = do + p <- get_path + exists <- doesDirectoryExist p + pure $ if exists then Just p else Nothing + + dirs <- mapM check res_dirs + case [p | Just p <- dirs] of + (p : _) -> return p + _ -> die "Haddock's resource directory does not exist!\n" #endif fs -> return (last fs) diff --git a/haddock-library/haddock-library.cabal b/haddock-library/haddock-library.cabal index 463569a3..b7a20758 100644 --- a/haddock-library/haddock-library.cabal +++ b/haddock-library/haddock-library.cabal @@ -14,7 +14,7 @@ homepage: http://www.haskell.org/haddock/ bug-reports: https://github.com/haskell/haddock/issues category: Documentation build-type: Simple -cabal-version: >= 1.10 +cabal-version: >= 2.0 stability: experimental library @@ -78,6 +78,9 @@ test-suite spec , hspec , QuickCheck == 2.* + build-tool-depends: + hspec-discover:hspec-discover + source-repository head type: git subdir: haddock-library diff --git a/haddock-test/src/Test/Haddock/Config.hs b/haddock-test/src/Test/Haddock/Config.hs index e1e920f2..50616c7f 100644 --- a/haddock-test/src/Test/Haddock/Config.hs +++ b/haddock-test/src/Test/Haddock/Config.hs @@ -165,11 +165,18 @@ loadConfig ccfg dcfg flags files = do cfgEnv <- (:) ("haddock_datadir", dcfgResDir dcfg) <$> getEnvironment systemHaddockPath <- List.lookup "HADDOCK_PATH" <$> getEnvironment - cfgHaddockPath <- case flagsHaddockPath flags <|> systemHaddockPath of + haddockOnPath <- findExecutable "haddock" + + let haddock_path = msum [ flagsHaddockPath flags + , systemHaddockPath + , haddockOnPath + ] + + cfgHaddockPath <- case haddock_path of Just path -> pure path - Nothing -> do - hPutStrLn stderr $ "Haddock executable not specified" - exitFailure + Nothing -> do + hPutStrLn stderr "Haddock executable not found" + exitFailure ghcPath <- init <$> rawSystemStdout normal cfgHaddockPath ["--print-ghc-path"] @@ -195,7 +202,7 @@ loadConfig ccfg dcfg flags files = do let cfgAccept = FlagAccept `elem` flags let cfgCheckConfig = ccfg - let cfgDirConfig = dcfg + let cfgDirConfig = dcfg return $ Config { .. } diff --git a/haddock.cabal b/haddock.cabal index a79f8c78..fa8a3531 100644 --- a/haddock.cabal +++ b/haddock.cabal @@ -12,9 +12,10 @@ bug-reports: https://github.com/haskell/haddock/issues copyright: (c) Simon Marlow, David Waern category: Documentation build-type: Simple -cabal-version: >= 1.10 +cabal-version: >= 2.0 stability: experimental - +tested-with: GHC==8.2.*, GHC==8.3 + extra-source-files: CHANGES README.md @@ -130,32 +131,40 @@ test-suite driver-test test-suite html-test type: exitcode-stdio-1.0 - default-language: Haskell2010 - main-is: Main.hs - hs-source-dirs: html-test - build-depends: base, filepath, haddock-test == 0.0.1 + -- This tells cabal that this test depends on the executable + -- component 'haddock' from this very same package, as well + -- as adding the build-folder where the `haddock` + -- executable can be found in front of $PATH + build-tool-depends: haddock:haddock + default-language: Haskell2010 + main-is: Main.hs + hs-source-dirs: html-test + build-depends: base, filepath, haddock-test == 0.0.1 test-suite hypsrc-test - type: exitcode-stdio-1.0 - default-language: Haskell2010 - main-is: Main.hs - hs-source-dirs: hypsrc-test - build-depends: base, filepath, haddock-test == 0.0.1 - ghc-options: -Wall -fwarn-tabs + type: exitcode-stdio-1.0 + build-tool-depends: haddock:haddock + default-language: Haskell2010 + main-is: Main.hs + hs-source-dirs: hypsrc-test + build-depends: base, filepath, haddock-test == 0.0.1 + ghc-options: -Wall -fwarn-tabs test-suite latex-test - type: exitcode-stdio-1.0 - default-language: Haskell2010 - main-is: Main.hs - hs-source-dirs: latex-test - build-depends: base, filepath, haddock-test == 0.0.1 + type: exitcode-stdio-1.0 + build-tool-depends: haddock:haddock + default-language: Haskell2010 + main-is: Main.hs + hs-source-dirs: latex-test + build-depends: base, filepath, haddock-test == 0.0.1 test-suite hoogle-test - type: exitcode-stdio-1.0 - default-language: Haskell2010 - main-is: Main.hs - hs-source-dirs: hoogle-test - build-depends: base, filepath, haddock-test == 0.0.1 + type: exitcode-stdio-1.0 + build-tool-depends: haddock:haddock + default-language: Haskell2010 + main-is: Main.hs + hs-source-dirs: hoogle-test + build-depends: base, filepath, haddock-test == 0.0.1 source-repository head type: git -- cgit v1.2.3 From 83c460c13957ab0a9a30cfa8d5b9b095b9e8d804 Mon Sep 17 00:00:00 2001 From: Alex Biehl Date: Tue, 25 Apr 2017 10:32:01 +0200 Subject: Travis: Verbose cabal output cf. https://travis-ci.org/haskell/haddock/jobs/225512194#L377 --- .travis.yml | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/.travis.yml b/.travis.yml index c1f8f504..9bbd0d24 100644 --- a/.travis.yml +++ b/.travis.yml @@ -51,8 +51,8 @@ install: - sed -i 's/^jobs:/-- jobs:/' ${HOME}/.cabal/config - rm -fv cabal.project.local - rm -f cabal.project.freeze - - cabal new-build -w ${HC} ${TEST} ${BENCH} --dep -j2 all - - cabal new-build -w ${HC} --disable-tests --disable-benchmarks --dep -j2 all + - cabal new-build -w ${HC} ${TEST} ${BENCH} --dep -j2 all -v3 + - cabal new-build -w ${HC} --disable-tests --disable-benchmarks --dep -j2 all -v3 # Here starts the actual work to be performed for the package under test; # any command which exits with a non-zero exit code causes the build to fail. @@ -74,7 +74,7 @@ script: # - rm -rf ./dist-newstyle # build & run tests - - cabal new-build -w ${HC} ${TEST} ${BENCH} all - - if [ "x$TEST" = "x--enable-tests" ]; then cabal new-test -w ${HC} ${TEST} all; fi + - cabal new-build -w ${HC} ${TEST} ${BENCH} all -v3 + - if [ "x$TEST" = "x--enable-tests" ]; then cabal new-test -w ${HC} ${TEST} all -v3; fi # EOF -- cgit v1.2.3 From 862afa05d4ebada8e7b57f289cf31a53fb0a7dd9 Mon Sep 17 00:00:00 2001 From: Alex Biehl Date: Tue, 25 Apr 2017 10:40:43 +0200 Subject: Use travis_retry for cabal invocations --- .travis.yml | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/.travis.yml b/.travis.yml index 9bbd0d24..f7a9d921 100644 --- a/.travis.yml +++ b/.travis.yml @@ -51,8 +51,8 @@ install: - sed -i 's/^jobs:/-- jobs:/' ${HOME}/.cabal/config - rm -fv cabal.project.local - rm -f cabal.project.freeze - - cabal new-build -w ${HC} ${TEST} ${BENCH} --dep -j2 all -v3 - - cabal new-build -w ${HC} --disable-tests --disable-benchmarks --dep -j2 all -v3 + - travis_retry cabal new-build -w ${HC} ${TEST} ${BENCH} --dep -j2 all + - travis_retry cabal new-build -w ${HC} --disable-tests --disable-benchmarks --dep -j2 all # Here starts the actual work to be performed for the package under test; # any command which exits with a non-zero exit code causes the build to fail. @@ -74,7 +74,7 @@ script: # - rm -rf ./dist-newstyle # build & run tests - - cabal new-build -w ${HC} ${TEST} ${BENCH} all -v3 - - if [ "x$TEST" = "x--enable-tests" ]; then cabal new-test -w ${HC} ${TEST} all -v3; fi + - cabal new-build -w ${HC} ${TEST} ${BENCH} all + - if [ "x$TEST" = "x--enable-tests" ]; then cabal new-test -w ${HC} ${TEST} all; fi # EOF -- cgit v1.2.3 From 65fccc0fec773a745b1b6363aa5c0cd433949830 Mon Sep 17 00:00:00 2001 From: alexbiehl Date: Tue, 25 Apr 2017 07:16:05 +0200 Subject: Use new MathJax URL in html-test 18ed871afb82560d5433b2f53e31b4db9353a74e switched to a new MathJax URL but didn't update the tests. --- html-test/ref/A.html | 4 ++-- html-test/ref/B.html | 4 ++-- html-test/ref/Bold.html | 4 ++-- html-test/ref/Bug1.html | 4 ++-- html-test/ref/Bug195.html | 4 ++-- html-test/ref/Bug2.html | 4 ++-- html-test/ref/Bug201.html | 4 ++-- html-test/ref/Bug253.html | 4 ++-- html-test/ref/Bug26.html | 4 ++-- html-test/ref/Bug280.html | 2 +- html-test/ref/Bug294.html | 4 ++-- html-test/ref/Bug298.html | 4 ++-- html-test/ref/Bug3.html | 4 ++-- html-test/ref/Bug308.html | 4 ++-- html-test/ref/Bug308CrossModule.html | 4 ++-- html-test/ref/Bug310.html | 4 ++-- html-test/ref/Bug313.html | 4 ++-- html-test/ref/Bug335.html | 4 ++-- html-test/ref/Bug387.html | 4 ++-- html-test/ref/Bug4.html | 4 ++-- html-test/ref/Bug6.html | 4 ++-- html-test/ref/Bug7.html | 4 ++-- html-test/ref/Bug8.html | 4 ++-- html-test/ref/Bug85.html | 4 ++-- html-test/ref/BugDeprecated.html | 4 ++-- html-test/ref/BugExportHeadings.html | 4 ++-- html-test/ref/Bugs.html | 4 ++-- html-test/ref/DeprecatedClass.html | 4 ++-- html-test/ref/DeprecatedData.html | 4 ++-- html-test/ref/DeprecatedFunction.html | 4 ++-- html-test/ref/DeprecatedFunction2.html | 4 ++-- html-test/ref/DeprecatedFunction3.html | 4 ++-- html-test/ref/DeprecatedModule.html | 4 ++-- html-test/ref/DeprecatedModule2.html | 4 ++-- html-test/ref/DeprecatedNewtype.html | 4 ++-- html-test/ref/DeprecatedReExport.html | 4 ++-- html-test/ref/DeprecatedRecord.html | 4 ++-- html-test/ref/DeprecatedTypeFamily.html | 4 ++-- html-test/ref/DeprecatedTypeSynonym.html | 4 ++-- html-test/ref/Examples.html | 4 ++-- html-test/ref/Extensions.html | 4 ++-- html-test/ref/FunArgs.html | 4 ++-- html-test/ref/GADTRecords.html | 4 ++-- html-test/ref/Hash.html | 4 ++-- html-test/ref/HiddenInstances.html | 4 ++-- html-test/ref/HiddenInstancesB.html | 4 ++-- html-test/ref/Hyperlinks.html | 4 ++-- html-test/ref/IgnoreExports.html | 4 ++-- html-test/ref/ImplicitParams.html | 4 ++-- html-test/ref/Instances.html | 4 ++-- html-test/ref/Math.html | 4 ++-- html-test/ref/Minimal.html | 4 ++-- html-test/ref/ModuleWithWarning.html | 4 ++-- html-test/ref/NamedDoc.html | 4 ++-- html-test/ref/Nesting.html | 4 ++-- html-test/ref/NoLayout.html | 4 ++-- html-test/ref/NonGreedy.html | 4 ++-- html-test/ref/Operators.html | 4 ++-- html-test/ref/OrphanInstances.html | 4 ++-- html-test/ref/OrphanInstancesClass.html | 4 ++-- html-test/ref/OrphanInstancesType.html | 4 ++-- html-test/ref/PatternSyns.html | 4 ++-- html-test/ref/PromotedTypes.html | 4 ++-- html-test/ref/Properties.html | 4 ++-- html-test/ref/PruneWithWarning.html | 4 ++-- html-test/ref/QuasiExpr.html | 4 ++-- html-test/ref/QuasiQuote.html | 4 ++-- html-test/ref/SpuriousSuperclassConstraints.html | 4 ++-- html-test/ref/TH.html | 4 ++-- html-test/ref/TH2.html | 4 ++-- html-test/ref/Test.html | 4 ++-- html-test/ref/Threaded.html | 4 ++-- html-test/ref/Threaded_TH.html | 4 ++-- html-test/ref/Ticket112.html | 4 ++-- html-test/ref/Ticket61.html | 4 ++-- html-test/ref/Ticket75.html | 4 ++-- html-test/ref/TitledPicture.html | 4 ++-- html-test/ref/TypeFamilies.html | 4 ++-- html-test/ref/TypeFamilies2.html | 4 ++-- html-test/ref/TypeOperators.html | 4 ++-- html-test/ref/Unicode.html | 4 ++-- html-test/ref/Visible.html | 4 ++-- html-test/ref/mini_A.html | 2 +- html-test/ref/mini_AdvanceTypes.html | 2 +- html-test/ref/mini_B.html | 2 +- html-test/ref/mini_Bug1.html | 2 +- html-test/ref/mini_Bug2.html | 2 +- html-test/ref/mini_Bug3.html | 2 +- html-test/ref/mini_Bug4.html | 2 +- html-test/ref/mini_Bug6.html | 2 +- html-test/ref/mini_Bug7.html | 2 +- html-test/ref/mini_Bug8.html | 2 +- html-test/ref/mini_BugDeprecated.html | 2 +- html-test/ref/mini_BugExportHeadings.html | 2 +- html-test/ref/mini_Bugs.html | 2 +- html-test/ref/mini_DeprecatedClass.html | 2 +- html-test/ref/mini_DeprecatedData.html | 2 +- html-test/ref/mini_DeprecatedFunction.html | 2 +- html-test/ref/mini_DeprecatedFunction2.html | 2 +- html-test/ref/mini_DeprecatedFunction3.html | 2 +- html-test/ref/mini_DeprecatedModule.html | 2 +- html-test/ref/mini_DeprecatedModule2.html | 2 +- html-test/ref/mini_DeprecatedNewtype.html | 2 +- html-test/ref/mini_DeprecatedReExport.html | 2 +- html-test/ref/mini_DeprecatedRecord.html | 2 +- html-test/ref/mini_DeprecatedTypeFamily.html | 2 +- html-test/ref/mini_DeprecatedTypeSynonym.html | 2 +- html-test/ref/mini_Examples.html | 2 +- html-test/ref/mini_FunArgs.html | 2 +- html-test/ref/mini_GADTRecords.html | 2 +- html-test/ref/mini_Hash.html | 2 +- html-test/ref/mini_HiddenInstances.html | 2 +- html-test/ref/mini_HiddenInstancesB.html | 2 +- html-test/ref/mini_Hyperlinks.html | 2 +- html-test/ref/mini_IgnoreExports.html | 2 +- html-test/ref/mini_Math.html | 2 +- html-test/ref/mini_ModuleWithWarning.html | 2 +- html-test/ref/mini_NamedDoc.html | 2 +- html-test/ref/mini_NoLayout.html | 2 +- html-test/ref/mini_NonGreedy.html | 2 +- html-test/ref/mini_Properties.html | 2 +- html-test/ref/mini_PruneWithWarning.html | 2 +- html-test/ref/mini_QuasiExpr.html | 2 +- html-test/ref/mini_QuasiQuote.html | 2 +- html-test/ref/mini_SpuriousSuperclassConstraints.html | 2 +- html-test/ref/mini_TH.html | 2 +- html-test/ref/mini_TH2.html | 2 +- html-test/ref/mini_Test.html | 2 +- html-test/ref/mini_Ticket112.html | 2 +- html-test/ref/mini_Ticket61.html | 2 +- html-test/ref/mini_Ticket75.html | 2 +- html-test/ref/mini_TitledPicture.html | 2 +- html-test/ref/mini_TypeFamilies.html | 2 +- html-test/ref/mini_TypeOperators.html | 2 +- html-test/ref/mini_Unicode.html | 2 +- html-test/ref/mini_Visible.html | 2 +- 136 files changed, 217 insertions(+), 217 deletions(-) diff --git a/html-test/ref/A.html b/html-test/ref/A.html index b58845e5..64a2916b 100644 --- a/html-test/ref/A.html +++ b/html-test/ref/A.html @@ -6,7 +6,7 @@ >
    +> \ No newline at end of file diff --git a/html-test/ref/B.html b/html-test/ref/B.html index b1e43a51..f4ce89d4 100644 --- a/html-test/ref/B.html +++ b/html-test/ref/B.html @@ -10,7 +10,7 @@ >
    +> \ No newline at end of file diff --git a/html-test/ref/Bold.html b/html-test/ref/Bold.html index d8f8b3d4..a7cb4e7f 100644 --- a/html-test/ref/Bold.html +++ b/html-test/ref/Bold.html @@ -10,7 +10,7 @@ > +> \ No newline at end of file diff --git a/html-test/ref/Bug1.html b/html-test/ref/Bug1.html index 5ea4ff26..37a37527 100644 --- a/html-test/ref/Bug1.html +++ b/html-test/ref/Bug1.html @@ -10,7 +10,7 @@ > +> \ No newline at end of file diff --git a/html-test/ref/Bug195.html b/html-test/ref/Bug195.html index b7f10741..ca5c2cc0 100644 --- a/html-test/ref/Bug195.html +++ b/html-test/ref/Bug195.html @@ -10,7 +10,7 @@ > +> \ No newline at end of file diff --git a/html-test/ref/Bug2.html b/html-test/ref/Bug2.html index 98d7f06d..5b88feae 100644 --- a/html-test/ref/Bug2.html +++ b/html-test/ref/Bug2.html @@ -10,7 +10,7 @@ > +> \ No newline at end of file diff --git a/html-test/ref/Bug201.html b/html-test/ref/Bug201.html index 19cb1aae..04cb0991 100644 --- a/html-test/ref/Bug201.html +++ b/html-test/ref/Bug201.html @@ -10,7 +10,7 @@ > +> \ No newline at end of file diff --git a/html-test/ref/Bug253.html b/html-test/ref/Bug253.html index 2210b023..28482b24 100644 --- a/html-test/ref/Bug253.html +++ b/html-test/ref/Bug253.html @@ -10,7 +10,7 @@ > +> \ No newline at end of file diff --git a/html-test/ref/Bug26.html b/html-test/ref/Bug26.html index 9382a738..8b0644aa 100644 --- a/html-test/ref/Bug26.html +++ b/html-test/ref/Bug26.html @@ -10,7 +10,7 @@ > +> \ No newline at end of file diff --git a/html-test/ref/Bug280.html b/html-test/ref/Bug280.html index fa8ca0de..6c533a28 100644 --- a/html-test/ref/Bug280.html +++ b/html-test/ref/Bug280.html @@ -1,4 +1,3 @@ -

     

    CopyrightFoo
    Bar
    BazBar
    Baz

    Description

    The module description

    The module description

    +> \ No newline at end of file diff --git a/html-test/ref/Bug294.html b/html-test/ref/Bug294.html index 44aad9d1..3a82af80 100644 --- a/html-test/ref/Bug294.html +++ b/html-test/ref/Bug294.html @@ -10,7 +10,7 @@ > +> \ No newline at end of file diff --git a/html-test/ref/Bug298.html b/html-test/ref/Bug298.html index a748e92a..cba626b6 100644 --- a/html-test/ref/Bug298.html +++ b/html-test/ref/Bug298.html @@ -10,7 +10,7 @@ > +> \ No newline at end of file diff --git a/html-test/ref/Bug3.html b/html-test/ref/Bug3.html index d5f589ed..4a9cf8bc 100644 --- a/html-test/ref/Bug3.html +++ b/html-test/ref/Bug3.html @@ -10,7 +10,7 @@ > +> \ No newline at end of file diff --git a/html-test/ref/Bug308.html b/html-test/ref/Bug308.html index 03f287d5..d816fef5 100644 --- a/html-test/ref/Bug308.html +++ b/html-test/ref/Bug308.html @@ -10,7 +10,7 @@ > +> \ No newline at end of file diff --git a/html-test/ref/Bug308CrossModule.html b/html-test/ref/Bug308CrossModule.html index d9ed0b19..60f371af 100644 --- a/html-test/ref/Bug308CrossModule.html +++ b/html-test/ref/Bug308CrossModule.html @@ -10,7 +10,7 @@ > +> \ No newline at end of file diff --git a/html-test/ref/Bug310.html b/html-test/ref/Bug310.html index 2ba8dfb9..468e64eb 100644 --- a/html-test/ref/Bug310.html +++ b/html-test/ref/Bug310.html @@ -10,7 +10,7 @@ > +> \ No newline at end of file diff --git a/html-test/ref/Bug313.html b/html-test/ref/Bug313.html index a6573eaa..4fc1682c 100644 --- a/html-test/ref/Bug313.html +++ b/html-test/ref/Bug313.html @@ -10,7 +10,7 @@ > +> \ No newline at end of file diff --git a/html-test/ref/Bug335.html b/html-test/ref/Bug335.html index f9eec481..d1602c7b 100644 --- a/html-test/ref/Bug335.html +++ b/html-test/ref/Bug335.html @@ -10,7 +10,7 @@ > +> \ No newline at end of file diff --git a/html-test/ref/Bug387.html b/html-test/ref/Bug387.html index 6305a38d..27d47e75 100644 --- a/html-test/ref/Bug387.html +++ b/html-test/ref/Bug387.html @@ -10,7 +10,7 @@ > +> \ No newline at end of file diff --git a/html-test/ref/Bug4.html b/html-test/ref/Bug4.html index 722d4102..fe6f47d1 100644 --- a/html-test/ref/Bug4.html +++ b/html-test/ref/Bug4.html @@ -10,7 +10,7 @@ > +> \ No newline at end of file diff --git a/html-test/ref/Bug6.html b/html-test/ref/Bug6.html index 34fc4054..678f4070 100644 --- a/html-test/ref/Bug6.html +++ b/html-test/ref/Bug6.html @@ -10,7 +10,7 @@ > +> \ No newline at end of file diff --git a/html-test/ref/Bug7.html b/html-test/ref/Bug7.html index cf6f2f2a..ef26d62f 100644 --- a/html-test/ref/Bug7.html +++ b/html-test/ref/Bug7.html @@ -10,7 +10,7 @@ > +> \ No newline at end of file diff --git a/html-test/ref/Bug8.html b/html-test/ref/Bug8.html index d6cef1b2..1b6c1525 100644 --- a/html-test/ref/Bug8.html +++ b/html-test/ref/Bug8.html @@ -10,7 +10,7 @@ > +> \ No newline at end of file diff --git a/html-test/ref/BugDeprecated.html b/html-test/ref/BugDeprecated.html index 2fb509d8..96fdab34 100644 --- a/html-test/ref/BugDeprecated.html +++ b/html-test/ref/BugDeprecated.html @@ -10,7 +10,7 @@ > +> \ No newline at end of file diff --git a/html-test/ref/BugExportHeadings.html b/html-test/ref/BugExportHeadings.html index 8d444e26..2a05bed9 100644 --- a/html-test/ref/BugExportHeadings.html +++ b/html-test/ref/BugExportHeadings.html @@ -10,7 +10,7 @@ > +> \ No newline at end of file diff --git a/html-test/ref/Bugs.html b/html-test/ref/Bugs.html index b83036c8..c29004f3 100644 --- a/html-test/ref/Bugs.html +++ b/html-test/ref/Bugs.html @@ -10,7 +10,7 @@ > +> \ No newline at end of file diff --git a/html-test/ref/DeprecatedClass.html b/html-test/ref/DeprecatedClass.html index ac14b0d4..f055f36f 100644 --- a/html-test/ref/DeprecatedClass.html +++ b/html-test/ref/DeprecatedClass.html @@ -10,7 +10,7 @@ > +> \ No newline at end of file diff --git a/html-test/ref/DeprecatedData.html b/html-test/ref/DeprecatedData.html index 248de4cb..aeb2a7c8 100644 --- a/html-test/ref/DeprecatedData.html +++ b/html-test/ref/DeprecatedData.html @@ -10,7 +10,7 @@ > +> \ No newline at end of file diff --git a/html-test/ref/DeprecatedFunction.html b/html-test/ref/DeprecatedFunction.html index 59206ac9..f4381d96 100644 --- a/html-test/ref/DeprecatedFunction.html +++ b/html-test/ref/DeprecatedFunction.html @@ -10,7 +10,7 @@ > +> \ No newline at end of file diff --git a/html-test/ref/DeprecatedFunction2.html b/html-test/ref/DeprecatedFunction2.html index 36159359..b8985bcd 100644 --- a/html-test/ref/DeprecatedFunction2.html +++ b/html-test/ref/DeprecatedFunction2.html @@ -10,7 +10,7 @@ > +> \ No newline at end of file diff --git a/html-test/ref/DeprecatedFunction3.html b/html-test/ref/DeprecatedFunction3.html index 1bfc7d90..b62e1ee3 100644 --- a/html-test/ref/DeprecatedFunction3.html +++ b/html-test/ref/DeprecatedFunction3.html @@ -10,7 +10,7 @@ > +> \ No newline at end of file diff --git a/html-test/ref/DeprecatedModule.html b/html-test/ref/DeprecatedModule.html index a6b2e0e8..84c7a885 100644 --- a/html-test/ref/DeprecatedModule.html +++ b/html-test/ref/DeprecatedModule.html @@ -10,7 +10,7 @@ > +> \ No newline at end of file diff --git a/html-test/ref/DeprecatedModule2.html b/html-test/ref/DeprecatedModule2.html index bd7a7f31..862f79ee 100644 --- a/html-test/ref/DeprecatedModule2.html +++ b/html-test/ref/DeprecatedModule2.html @@ -10,7 +10,7 @@ > +> \ No newline at end of file diff --git a/html-test/ref/DeprecatedNewtype.html b/html-test/ref/DeprecatedNewtype.html index 3d826f57..a03d63fb 100644 --- a/html-test/ref/DeprecatedNewtype.html +++ b/html-test/ref/DeprecatedNewtype.html @@ -10,7 +10,7 @@ > +> \ No newline at end of file diff --git a/html-test/ref/DeprecatedReExport.html b/html-test/ref/DeprecatedReExport.html index e5a3c38c..52f2b8e9 100644 --- a/html-test/ref/DeprecatedReExport.html +++ b/html-test/ref/DeprecatedReExport.html @@ -10,7 +10,7 @@ > +> \ No newline at end of file diff --git a/html-test/ref/DeprecatedRecord.html b/html-test/ref/DeprecatedRecord.html index ff217c4d..79b7b7f9 100644 --- a/html-test/ref/DeprecatedRecord.html +++ b/html-test/ref/DeprecatedRecord.html @@ -10,7 +10,7 @@ > +> \ No newline at end of file diff --git a/html-test/ref/DeprecatedTypeFamily.html b/html-test/ref/DeprecatedTypeFamily.html index 4a5028f3..1d94e99b 100644 --- a/html-test/ref/DeprecatedTypeFamily.html +++ b/html-test/ref/DeprecatedTypeFamily.html @@ -10,7 +10,7 @@ > +> \ No newline at end of file diff --git a/html-test/ref/DeprecatedTypeSynonym.html b/html-test/ref/DeprecatedTypeSynonym.html index 8f1896df..cb7a3afe 100644 --- a/html-test/ref/DeprecatedTypeSynonym.html +++ b/html-test/ref/DeprecatedTypeSynonym.html @@ -10,7 +10,7 @@ > +> \ No newline at end of file diff --git a/html-test/ref/Examples.html b/html-test/ref/Examples.html index 7f742f2f..f706eef1 100644 --- a/html-test/ref/Examples.html +++ b/html-test/ref/Examples.html @@ -10,7 +10,7 @@ > +> \ No newline at end of file diff --git a/html-test/ref/Extensions.html b/html-test/ref/Extensions.html index 01dde2d3..e21785c0 100644 --- a/html-test/ref/Extensions.html +++ b/html-test/ref/Extensions.html @@ -10,7 +10,7 @@ > +> \ No newline at end of file diff --git a/html-test/ref/FunArgs.html b/html-test/ref/FunArgs.html index 4c285c41..df597e12 100644 --- a/html-test/ref/FunArgs.html +++ b/html-test/ref/FunArgs.html @@ -10,7 +10,7 @@ > +> \ No newline at end of file diff --git a/html-test/ref/GADTRecords.html b/html-test/ref/GADTRecords.html index 6c091ac3..3b036aae 100644 --- a/html-test/ref/GADTRecords.html +++ b/html-test/ref/GADTRecords.html @@ -10,7 +10,7 @@ > +> \ No newline at end of file diff --git a/html-test/ref/Hash.html b/html-test/ref/Hash.html index ac422955..4ad1c27e 100644 --- a/html-test/ref/Hash.html +++ b/html-test/ref/Hash.html @@ -10,7 +10,7 @@ > +> \ No newline at end of file diff --git a/html-test/ref/HiddenInstances.html b/html-test/ref/HiddenInstances.html index 5071e702..8c7312d7 100644 --- a/html-test/ref/HiddenInstances.html +++ b/html-test/ref/HiddenInstances.html @@ -10,7 +10,7 @@ > +> \ No newline at end of file diff --git a/html-test/ref/HiddenInstancesB.html b/html-test/ref/HiddenInstancesB.html index b3cf9ef9..77af69d0 100644 --- a/html-test/ref/HiddenInstancesB.html +++ b/html-test/ref/HiddenInstancesB.html @@ -10,7 +10,7 @@ > +> \ No newline at end of file diff --git a/html-test/ref/Hyperlinks.html b/html-test/ref/Hyperlinks.html index 66b14d7a..db1953e3 100644 --- a/html-test/ref/Hyperlinks.html +++ b/html-test/ref/Hyperlinks.html @@ -10,7 +10,7 @@ > +> \ No newline at end of file diff --git a/html-test/ref/IgnoreExports.html b/html-test/ref/IgnoreExports.html index 235d601c..262bb769 100644 --- a/html-test/ref/IgnoreExports.html +++ b/html-test/ref/IgnoreExports.html @@ -10,7 +10,7 @@ > +> \ No newline at end of file diff --git a/html-test/ref/ImplicitParams.html b/html-test/ref/ImplicitParams.html index c08a565a..d22e7f4c 100644 --- a/html-test/ref/ImplicitParams.html +++ b/html-test/ref/ImplicitParams.html @@ -10,7 +10,7 @@ > +> \ No newline at end of file diff --git a/html-test/ref/Instances.html b/html-test/ref/Instances.html index ba6ef185..b014e8df 100644 --- a/html-test/ref/Instances.html +++ b/html-test/ref/Instances.html @@ -10,7 +10,7 @@ > +> \ No newline at end of file diff --git a/html-test/ref/Minimal.html b/html-test/ref/Minimal.html index ac28b0d9..b7507bd7 100644 --- a/html-test/ref/Minimal.html +++ b/html-test/ref/Minimal.html @@ -10,7 +10,7 @@ > +> \ No newline at end of file diff --git a/html-test/ref/NamedDoc.html b/html-test/ref/NamedDoc.html index 631f2043..a10aa305 100644 --- a/html-test/ref/NamedDoc.html +++ b/html-test/ref/NamedDoc.html @@ -10,7 +10,7 @@ > +> \ No newline at end of file diff --git a/html-test/ref/Nesting.html b/html-test/ref/Nesting.html index 370c6a88..7ce0c0d8 100644 --- a/html-test/ref/Nesting.html +++ b/html-test/ref/Nesting.html @@ -10,7 +10,7 @@ > +> \ No newline at end of file diff --git a/html-test/ref/NoLayout.html b/html-test/ref/NoLayout.html index d8148b0e..43352864 100644 --- a/html-test/ref/NoLayout.html +++ b/html-test/ref/NoLayout.html @@ -10,7 +10,7 @@ > +> \ No newline at end of file diff --git a/html-test/ref/NonGreedy.html b/html-test/ref/NonGreedy.html index c389fc6a..6ed1563f 100644 --- a/html-test/ref/NonGreedy.html +++ b/html-test/ref/NonGreedy.html @@ -10,7 +10,7 @@ > +> \ No newline at end of file diff --git a/html-test/ref/Operators.html b/html-test/ref/Operators.html index 27b3427d..d498a906 100644 --- a/html-test/ref/Operators.html +++ b/html-test/ref/Operators.html @@ -10,7 +10,7 @@ > +> \ No newline at end of file diff --git a/html-test/ref/OrphanInstancesClass.html b/html-test/ref/OrphanInstancesClass.html index 98641d0b..93594d90 100644 --- a/html-test/ref/OrphanInstancesClass.html +++ b/html-test/ref/OrphanInstancesClass.html @@ -10,7 +10,7 @@ > +> \ No newline at end of file diff --git a/html-test/ref/OrphanInstancesType.html b/html-test/ref/OrphanInstancesType.html index d616edf9..5d7a76c9 100644 --- a/html-test/ref/OrphanInstancesType.html +++ b/html-test/ref/OrphanInstancesType.html @@ -10,7 +10,7 @@ > +> \ No newline at end of file diff --git a/html-test/ref/PatternSyns.html b/html-test/ref/PatternSyns.html index 2052d87c..9f0caaa2 100644 --- a/html-test/ref/PatternSyns.html +++ b/html-test/ref/PatternSyns.html @@ -10,7 +10,7 @@ > +> \ No newline at end of file diff --git a/html-test/ref/Properties.html b/html-test/ref/Properties.html index 27f3a93a..4ce37acd 100644 --- a/html-test/ref/Properties.html +++ b/html-test/ref/Properties.html @@ -10,7 +10,7 @@ > +> \ No newline at end of file diff --git a/html-test/ref/PruneWithWarning.html b/html-test/ref/PruneWithWarning.html index 7523c657..e714ec21 100644 --- a/html-test/ref/PruneWithWarning.html +++ b/html-test/ref/PruneWithWarning.html @@ -10,7 +10,7 @@ > +> \ No newline at end of file diff --git a/html-test/ref/QuasiExpr.html b/html-test/ref/QuasiExpr.html index c51ac526..0b5b8054 100644 --- a/html-test/ref/QuasiExpr.html +++ b/html-test/ref/QuasiExpr.html @@ -10,7 +10,7 @@ > +> \ No newline at end of file diff --git a/html-test/ref/QuasiQuote.html b/html-test/ref/QuasiQuote.html index 251c48dc..4919e48d 100644 --- a/html-test/ref/QuasiQuote.html +++ b/html-test/ref/QuasiQuote.html @@ -10,7 +10,7 @@ > +> \ No newline at end of file diff --git a/html-test/ref/SpuriousSuperclassConstraints.html b/html-test/ref/SpuriousSuperclassConstraints.html index 285ab05c..b7c707c5 100644 --- a/html-test/ref/SpuriousSuperclassConstraints.html +++ b/html-test/ref/SpuriousSuperclassConstraints.html @@ -10,7 +10,7 @@ > +> \ No newline at end of file diff --git a/html-test/ref/TH2.html b/html-test/ref/TH2.html index 71bc1083..5562cb67 100644 --- a/html-test/ref/TH2.html +++ b/html-test/ref/TH2.html @@ -10,7 +10,7 @@ > +> \ No newline at end of file diff --git a/html-test/ref/Threaded.html b/html-test/ref/Threaded.html index bb31f300..ac6a66b9 100644 --- a/html-test/ref/Threaded.html +++ b/html-test/ref/Threaded.html @@ -10,7 +10,7 @@ > +> \ No newline at end of file diff --git a/html-test/ref/Threaded_TH.html b/html-test/ref/Threaded_TH.html index 2890ca6b..89f276c9 100644 --- a/html-test/ref/Threaded_TH.html +++ b/html-test/ref/Threaded_TH.html @@ -10,7 +10,7 @@ > +> \ No newline at end of file diff --git a/html-test/ref/Ticket61.html b/html-test/ref/Ticket61.html index cb9ba8bd..cfc2e7f7 100644 --- a/html-test/ref/Ticket61.html +++ b/html-test/ref/Ticket61.html @@ -10,7 +10,7 @@ > +> \ No newline at end of file diff --git a/html-test/ref/Ticket75.html b/html-test/ref/Ticket75.html index 07e75296..616f5d47 100644 --- a/html-test/ref/Ticket75.html +++ b/html-test/ref/Ticket75.html @@ -10,7 +10,7 @@ > +> \ No newline at end of file diff --git a/html-test/ref/TitledPicture.html b/html-test/ref/TitledPicture.html index 04d1476b..927631f8 100644 --- a/html-test/ref/TitledPicture.html +++ b/html-test/ref/TitledPicture.html @@ -10,7 +10,7 @@ > +> \ No newline at end of file diff --git a/html-test/ref/TypeFamilies.html b/html-test/ref/TypeFamilies.html index db6ee1c3..c6301a56 100644 --- a/html-test/ref/TypeFamilies.html +++ b/html-test/ref/TypeFamilies.html @@ -10,7 +10,7 @@ > +> \ No newline at end of file diff --git a/html-test/ref/TypeFamilies2.html b/html-test/ref/TypeFamilies2.html index 156486d0..65ab0317 100644 --- a/html-test/ref/TypeFamilies2.html +++ b/html-test/ref/TypeFamilies2.html @@ -10,7 +10,7 @@ > +> \ No newline at end of file diff --git a/html-test/ref/TypeOperators.html b/html-test/ref/TypeOperators.html index 53428892..b461ac71 100644 --- a/html-test/ref/TypeOperators.html +++ b/html-test/ref/TypeOperators.html @@ -10,7 +10,7 @@ > +> \ No newline at end of file diff --git a/html-test/ref/Unicode.html b/html-test/ref/Unicode.html index 59f715e8..ae1d4293 100644 --- a/html-test/ref/Unicode.html +++ b/html-test/ref/Unicode.html @@ -10,7 +10,7 @@ > +> \ No newline at end of file diff --git a/html-test/ref/Visible.html b/html-test/ref/Visible.html index 47568b65..d9b8cd11 100644 --- a/html-test/ref/Visible.html +++ b/html-test/ref/Visible.html @@ -10,7 +10,7 @@ > +> \ No newline at end of file diff --git a/html-test/ref/haddock-util.js b/html-test/ref/haddock-util.js index 92d07d2a..05bdaef5 100644 --- a/html-test/ref/haddock-util.js +++ b/html-test/ref/haddock-util.js @@ -1,7 +1,7 @@ // Haddock JavaScript utilities var rspace = /\s\s+/g, - rtrim = /^\s+|\s+$/g; + rtrim = /^\s+|\s+$/g; function spaced(s) { return (" " + s + " ").replace(rspace, " "); } function trim(s) { return s.replace(rtrim, ""); } @@ -109,136 +109,6 @@ function getCookie(name) { return null; } - - -var max_results = 75; // 50 is not enough to search for map in the base libraries -var shown_range = null; -var last_search = null; - -function quick_search() -{ - perform_search(false); -} - -function full_search() -{ - perform_search(true); -} - - -function perform_search(full) -{ - var text = document.getElementById("searchbox").value.toLowerCase(); - if (text == last_search && !full) return; - last_search = text; - - var table = document.getElementById("indexlist"); - var status = document.getElementById("searchmsg"); - var children = table.firstChild.childNodes; - - // first figure out the first node with the prefix - var first = bisect(-1); - var last = (first == -1 ? -1 : bisect(1)); - - if (first == -1) - { - table.className = ""; - status.innerHTML = "No results found, displaying all"; - } - else if (first == 0 && last == children.length - 1) - { - table.className = ""; - status.innerHTML = ""; - } - else if (last - first >= max_results && !full) - { - table.className = ""; - status.innerHTML = "More than " + max_results + ", press Search to display"; - } - else - { - // decide what you need to clear/show - if (shown_range) - setclass(shown_range[0], shown_range[1], "indexrow"); - setclass(first, last, "indexshow"); - shown_range = [first, last]; - table.className = "indexsearch"; - status.innerHTML = ""; - } - - - function setclass(first, last, status) - { - for (var i = first; i <= last; i++) - { - children[i].className = status; - } - } - - - // do a binary search, treating 0 as ... - // return either -1 (no 0's found) or location of most far match - function bisect(dir) - { - var first = 0, finish = children.length - 1; - var mid, success = false; - - while (finish - first > 3) - { - mid = Math.floor((finish + first) / 2); - - var i = checkitem(mid); - if (i == 0) i = dir; - if (i == -1) - finish = mid; - else - first = mid; - } - var a = (dir == 1 ? first : finish); - var b = (dir == 1 ? finish : first); - for (var i = b; i != a - dir; i -= dir) - { - if (checkitem(i) == 0) return i; - } - return -1; - } - - - // from an index, decide what the result is - // 0 = match, -1 is lower, 1 is higher - function checkitem(i) - { - var s = getitem(i).toLowerCase().substr(0, text.length); - if (s == text) return 0; - else return (s > text ? -1 : 1); - } - - - // from an index, get its string - // this abstracts over alternates - function getitem(i) - { - for ( ; i >= 0; i--) - { - var s = children[i].firstChild.firstChild.data; - if (s.indexOf(' ') == -1) - return s; - } - return ""; // should never be reached - } -} - -function setSynopsis(filename) { - if (parent.window.synopsis && parent.window.synopsis.location) { - if (parent.window.synopsis.location.replace) { - // In Firefox this avoids adding the change to the history. - parent.window.synopsis.location.replace(filename); - } else { - parent.window.synopsis.location = filename; - } - } -} - function addMenuItem(html) { var menu = document.getElementById("page-menu"); if (menu) { -- cgit v1.2.3 From 67d6345e7b941008080ea79ea462229f0f377d50 Mon Sep 17 00:00:00 2001 From: Alex Biehl Date: Wed, 26 Apr 2017 07:49:10 +0200 Subject: Cherry-picked remaining commits from haddock-2.17.4-release (#603) * Release haddock/haddock-api 2.17.4 and haddock-library 1.4.3 * Set version bounds for haddock-library NB: This allows GHC 8.2.1's base * Set version bounds for haddock & haddock-api The version bounds support GHC 8.2 * Merge (temporary) v2.17.3 branch into v2.17 This allows us to delete the v2.17.3 branch * Fixup changelog * Pin down haddock-api to a single version as otherwise `haddock`'s package version has no proper meaning * fix source-repo spec for haddock-api --- CHANGES | 14 ++++++++++++ haddock-api/haddock-api.cabal | 42 ++++++++++++++++++----------------- haddock-api/src/Haddock/Types.hs | 4 ++-- haddock-library/haddock-library.cabal | 10 ++++----- haddock.cabal | 7 ++++-- 5 files changed, 48 insertions(+), 29 deletions(-) diff --git a/CHANGES b/CHANGES index 4389c58a..7e3d052a 100644 --- a/CHANGES +++ b/CHANGES @@ -1,3 +1,17 @@ +Changes in version 2.17.4 + + * Fix 'internal error: links: UnhelpfulSpan' (#554, #565) + + * Hyperlink backend knows about `DataKinds` (#510) + + * Fix rendering of class methods for `Eq` and `Ord` (#549) + + * Export `MDoc` and `toInstalledIface` from `Haddock.Types` + +Changes in version 2.17.3.1 + + * Disable `NFData` instances for GHC types when GHC >= 8.0.2 (#537) + Changes in version 2.17.3 * Remove framed view of the HTML documentation diff --git a/haddock-api/haddock-api.cabal b/haddock-api/haddock-api.cabal index 921e16eb..20b656b9 100644 --- a/haddock-api/haddock-api.cabal +++ b/haddock-api/haddock-api.cabal @@ -1,5 +1,5 @@ name: haddock-api -version: 2.17.3 +version: 2.17.4 synopsis: A documentation-generation tool for Haskell libraries description: Haddock is a documentation-generation tool for Haskell libraries @@ -33,28 +33,29 @@ data-files: latex/haddock.sty library - default-language: - Haskell2010 + default-language: Haskell2010 - build-depends: - base >= 4.3 && < 4.11 - , bytestring - , filepath - , directory - , containers - , transformers - , deepseq - , array - , xhtml >= 3000.2 && < 3000.3 - , Cabal >= 1.10 - , ghc-boot - , ghc == 8.2.* + -- this package typically supports only single major versions + build-depends: base == 4.10.* + , Cabal == 2.0.* + , ghc == 8.2.* + , ghc-paths == 0.1.* + , haddock-library >= 1.4.2 && < 1.5 + , xhtml == 3000.2.* - , ghc-paths - , haddock-library == 1.4.* + -- Versions for the dependencies below are transitively pinned by + -- the non-reinstallable `ghc` package and hence need no version + -- bounds + build-depends: array + , bytestring + , containers + , deepseq + , directory + , filepath + , ghc-boot + , transformers - hs-source-dirs: - src + hs-source-dirs: src ghc-options: -funbox-strict-fields -Wall -fwarn-tabs -O2 @@ -125,4 +126,5 @@ test-suite spec source-repository head type: git + subdir: haddock-api location: https://github.com/haskell/haddock.git diff --git a/haddock-api/src/Haddock/Types.hs b/haddock-api/src/Haddock/Types.hs index a6dd6354..803995cc 100644 --- a/haddock-api/src/Haddock/Types.hs +++ b/haddock-api/src/Haddock/Types.hs @@ -460,8 +460,8 @@ instance (NFData a, NFData mod) DocExamples a -> a `deepseq` () DocHeader a -> a `deepseq` () -#if __GLASGOW_HASKELL__ < 801 --- These were added to GHC itself in 8.2.1 +#if !MIN_VERSION_ghc(8,0,2) +-- These were added to GHC itself in 8.0.2 instance NFData Name where rnf x = seq x () instance NFData OccName where rnf x = seq x () instance NFData ModuleName where rnf x = seq x () diff --git a/haddock-library/haddock-library.cabal b/haddock-library/haddock-library.cabal index b7a20758..be433e6a 100644 --- a/haddock-library/haddock-library.cabal +++ b/haddock-library/haddock-library.cabal @@ -1,5 +1,5 @@ name: haddock-library -version: 1.4.2 +version: 1.4.3 synopsis: Library exposing some functionality of Haddock. description: Haddock is a documentation-generation tool for Haskell libraries. These modules expose some functionality of it @@ -21,10 +21,10 @@ library default-language: Haskell2010 build-depends: - base >= 4.5 && < 4.11 - , bytestring - , transformers - , deepseq + base >= 4.5 && < 4.11 + , bytestring >= 0.9.2.1 && < 0.11 + , transformers >= 0.3.0 && < 0.6 + , deepseq >= 1.3 && < 1.5 hs-source-dirs: src, vendor/attoparsec-0.12.1.1 ghc-options: -funbox-strict-fields -Wall -fwarn-tabs -O2 diff --git a/haddock.cabal b/haddock.cabal index fa8a3531..598f2b9a 100644 --- a/haddock.cabal +++ b/haddock.cabal @@ -1,5 +1,5 @@ name: haddock -version: 2.17.3 +version: 2.17.4 synopsis: A documentation-generation tool for Haskell libraries description: Haddock is a documentation-generation tool for Haskell libraries @@ -43,6 +43,7 @@ executable haddock hs-source-dirs: driver ghc-options: -funbox-strict-fields -Wall -fwarn-tabs -O2 -threaded + -- haddock typically only supports a single GHC major version build-depends: base >= 4.3 && < 4.11 if flag(in-ghc-tree) @@ -120,7 +121,9 @@ executable haddock Haddock.Syb Haddock.Convert else - build-depends: haddock-api == 2.17.* + -- in order for haddock's advertised version number to have proper meaning, + -- we pin down to a single haddock-api version. + build-depends: haddock-api == 2.17.4 test-suite driver-test type: exitcode-stdio-1.0 -- cgit v1.2.3 From d0fd3613deba40cc0c11198f6d9a844f36c22d2c Mon Sep 17 00:00:00 2001 From: alexbiehl Date: Wed, 26 Apr 2017 07:55:59 +0200 Subject: Update changelog to reflect news in HEAD --- CHANGES | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/CHANGES b/CHANGES index 7e3d052a..8be4e79a 100644 --- a/CHANGES +++ b/CHANGES @@ -1,3 +1,7 @@ +Changes in version HEAD + + * Synopsis is working again (#599) + Changes in version 2.17.4 * Fix 'internal error: links: UnhelpfulSpan' (#554, #565) -- cgit v1.2.3 From 0ae73bb4987cc4c265fbbfdf0766d793ab69460d Mon Sep 17 00:00:00 2001 From: alexbiehl Date: Wed, 26 Apr 2017 07:57:43 +0200 Subject: Markdownify changelog --- CHANGES | 766 ---------------------------------------------------------- CHANGES.md | 766 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ haddock.cabal | 2 +- 3 files changed, 767 insertions(+), 767 deletions(-) delete mode 100644 CHANGES create mode 100644 CHANGES.md diff --git a/CHANGES b/CHANGES deleted file mode 100644 index 8be4e79a..00000000 --- a/CHANGES +++ /dev/null @@ -1,766 +0,0 @@ -Changes in version HEAD - - * Synopsis is working again (#599) - -Changes in version 2.17.4 - - * Fix 'internal error: links: UnhelpfulSpan' (#554, #565) - - * Hyperlink backend knows about `DataKinds` (#510) - - * Fix rendering of class methods for `Eq` and `Ord` (#549) - - * Export `MDoc` and `toInstalledIface` from `Haddock.Types` - -Changes in version 2.17.3.1 - - * Disable `NFData` instances for GHC types when GHC >= 8.0.2 (#537) - -Changes in version 2.17.3 - - * Remove framed view of the HTML documentation - -Changes in version 2.17.2 - - * Fix portability of documentation building within GHC - -Changes in version 2.17.1 - - * Included with GHC 8.0.1 - - * Fixed Makefile for GHC installation - - * Fixed clean rule of GHC Makefile - -Changes in version 2.17.0 (not released) - - * Support typesetting of mathematical expressions via Mathjax (#397) - - * Describe orphan instances defined in a module in its documentation (#449) - - * Produce specialized type signatures for typeclass methods (#425) - - * Support GCC-like response files (#470) - -Changes in version 2.16.2 - - * Generate hyperlinked source ourselves (#410, part of GSOC 2015) - - * Fix expansion icon for user-collapsible sections (#412) - - * Break up response file arguments on newlines - - * Various HTML fixes (#301, #406, #407, #421) - - * Line anchors in hyperlinked source (#420) - -Changes in version 2.16.1 - - * Don't default to type constructors for out-of-scope names (#253 and - #375) - - * Fix Hoogle display of constructors (#361) - - * Fully qualify names in Hoogle instances output (#263) - - * Output method documentation in Hoogle backend (#259) - - * Don't print instance safety information in Hoogle (#168) - - * Expand response files in arguments (#285) - - * Build the main executable with -threaded (#399) - - * Use SrcSpan of declarations for inferred type sigs (#207) - - * Fix cross-module instance locations (#383) - - * Fix alignment of Source link for instances in Firefox (#384) - -Changes in version 2.16.0 - - * Experimental collapsible header support (#335) - - * Add support for markdown links and images - - * Allow an optional colon after the closing bracket of definition lists. - This is to disambiguate them from markdown links and will be require with a - future release. - - * Fix re-exports of built-in type families (#310) - - * Fix parsing of infix identifiers such as ``elem``. - - * Print missing docs by default and add --no-print-missing-docs - - * parser: now parses out some meta data too, breaking the API - - * parser: markdown syntax for images and URLs is now accepted: - <> style for images and style for links is now - considered deprecated. for links is still OK. - - * parser: add support for @since element: this is paragraph-level - element of the form ‘@since x.y.z’ where x.y.z is the version - number. The way it is rendered is subject to change. - - * properly render package ID (not package key) in index (#329) - - * links to source location of class instance definitions - - * Fix code blocks in presence of Windows line endings - - * Deal better with long synopsis lines (#151) - -Changes in version 2.15.0 - - * Always read in prologue files as UTF8 (#286 and Cabal #1721) - - * parser: don't wrap headers in DocParagraph (#307) - - * parser: don't mangle append order for nested lists (pandoc #1346) - - * parser: preserve list ordering in certain scenarios (#313) - - * parser: update the attoparsec version used internally giving slight - parsing performance boost. - - * Move development to be against latest GHC release and not GHC HEAD. - - * Further split up the package to separate the executable from the - library, necessary by things like GHCJS. We now have - ‘haddock-library’ which are the parts that don't use GHC API, - ‘haddock-api’ which are (some of) the parts that do use GHC API and - ‘haddock’ which merely provides the executable. - - * Export few extra functions in the API. - - * Add compatibility with GHC 7.8.2. - - * Omit unnecessary ‘forall’s (#315 and #86) - - * Remove some files which were really old or did not belong in the - repository in the first place. - -Changes in version 2.14.3 - - * Fix parsing of identifiers with ^ or ⋆ in them (#298) - - * Fix anchors (#308) - -Changes in version 2.14.2 - - * Always drop --split-objs GHC flag for performance reasons (#292) - - * Print kind signatures GADTs (#85) - - * Drop single leading whitespace when reasonable from @-style blocks (#201) - - * Fix crashes associated with exporting data family record selectors (#294) - -Changes in version 2.14.1 - - * Render * and -> with their UnicodeSyntax equivalents if -U is enabled - - * Display minimal complete definitions for type classes - - * Hide right hand side of TF instances with hidden names on the RHS - -Changes in version 2.14.0 - - * Print entities with missing documentation (#258) - - * Print a warning message when given `-optghc` instead of `--optghc` (#5) - - * Add `--compatible-interface-versions` (#231) - - * Allow to generate latex documentation for FFI declarations (#247) - - * Add copyright and license information to generated documentation - - * Improved to Unicode support - - * Bold markup support - - * Nested paragraphs - - * Better escaping - - * Header markup - - * Parser should no longer fail to parse any markup - - * {-# OPTIONS_HADDOCK show-extensions #-} pragma will show the GHC extensions - enabled in the module. - - * Properly render License field (#271) - - * Print type/data family instances (for exported types only) - - * Fix display of poly-kinded type operators (#189) - - * PatternSynonyms support - - * Fix display of implicit parameters (#260) - - * Fix rendering of Contents when links are present (#276) - - * Fix documentation duplication on record fields (#195) - - * Add `--source-entity-line` for exact line links (eg. things defined - inside TH splices) (#79) - - * Display fixity information for names with nonstandard fixities - - * Bird tracks specified like "> code" no longer suffer from an extra leading - space in the code output - -Changes in version 2.13.2 - - * Handle HsExplicitListTy in renamer (#213) - - * Allow haddock markup in deprecation messages - - * Export more types from Documentation.Haddock - - * Include everything that is required to run the test suite with the cabal - package (#230) - -Changes in version 2.13.1 - - * Hide instances that are "internal" to a module - - * Add support for properties in documentation - - * Fix a bug with spurious superclass constraints - - * Fix and extend the Haddock API - -Changes in version 2.12.0 - - * Labeled URLs (e.g ) - - * Improved memory usage (new dependency: deepseq) - -Changes in version 2.11.0 - - * Show deprecation messages for identifiers - - * List identifiers declared on the same line (with a common type) separately - - * Don't crash on unicode strings in doc comments - - * Fix reporting of modules safe haskell mode - - * Fix a case where we were generating invalid xhtml - - * Improved --qual option (no crashes, proper error messages) - - * A new --qual option "aliased" which qualifies identifiers by the module alias - used in the source code - - * The Haddock API restores GHC's static flags after invocation - - * Access to unexported identifiers through the Haddock API again - -Changes in version 2.10.0 - - * Require GHC >= 7.4 - - * Safe Haskell indications on module pages - - * Type declarations on identifiers no longer necessary - - * Add flag --interface-version - - * Warn when comment refers to in-scope identifier without documentation - - * Bug fix: links to out-of-scope things (#78) - - * Bug fix: module references to other packages work again - -Changes in version 2.9.4 - - * Require GHC >= 7.2 - - * Support Alex 3.x - -Changes in version 2.9.3 - - [This is the version that comes with GHC 7.2.1 although it claims it's 2.9.2!] - - * Build with GHC 7.2.1 - - * Support blank lines in results of examples - - * A type signature for multiple names generates one signature in the output - - * Minor bug fixes - -Changes in version 2.9.2 - - * Build with GHC 7.0.2 - - * Write Hoogle output in utf8; fixes GHC build on Windows - -Changes in version 2.9.1 - - * Fix build in GHC tree - - * Improve .cabal file - -Changes in version 2.9.0 - - * Drop support for ghc < 7 - - * New flag --qual for qualification of names - - * Print doc coverage information to stdout when generating docs - - * Include an 'All' option in the A-Z subdivided index - - * Make TOC group header identifiers validate - - * Minor changes to the API - -Changes in the version that comes with GHC 7.0.1 - - [This version claims it is 2.8.0 but is actually based on 2.8.1] - - * Fix URL creation on Windows: Use / not \ in URLs. - - * Support GHC 7.0 - -Changes in version 2.8.1 - - * Fix build on Windows with MinGW - -Changes in version 2.8.0 - - * HTML backend completely rewritten to generate semantically rich XHTML - using the xhtml package. - - * New default CSS based on the color scheme chosen for the new Haskell - wiki, with a pull-out tab for the synopsis. - - * Theme engine based on CSS files. Themes can be switched from the - header menu. (New flags --built-in-themes and --theme. The latter - is an alias for --css which now has extended semantics). - - * Markup support for executable examples/unit-tests. To be used with an - upcoming version of the DocTest program. - - * Addition of a LaTeX backend. - - * Frames-mode can be enabled from the header menu. - - * Path to source entities can be specified per package, so that source - links work for cross-package documentation. - - * Support for a second form of enumerated lists (1. 2. etc). - - * Additions and changes to the Haddock API. - - * New flag --no-tmp-comp-dir to tell Haddock to write and pick up - compilation files (.o, .hi, etc) to/from GHC's output directory instead - of a temporary directory. - - * Various bug fixes. - ------------------------------------------------------------------------------ - -Changes in version 2.6.1 (bug fix release from the stable branch) - - * Fix #128 - ------------------------------------------------------------------------------ - -Changes in version 2.7.2 - - * Add Paths_haddock to library - ------------------------------------------------------------------------------ - -Changes in version 2.7.1: - - * Fix problems with library part of .cabal file - ------------------------------------------------------------------------------ - -Changes in version 2.7.0: - - * Instances can be commented - - * The Haddock API now exposes more of the internals of Haddock - - * Bug fixes (most importantly #128) - ------------------------------------------------------------------------------ - -Changes in version 2.6.0: - - * Drop support for GHC 6.10.* - - * Add support for GHC 6.12.1 - - * Cross-package documentation: full documentation show up when re-exporting - things coming from external packages - - * Lexing and parsing the Haddock comment markup is now done in Haddock - again, instead of in GHC - - * Slightly prettier printing of instance heads - - * Support platforms for which GHC has no native code generator - - * Add a flag --print-ghc-libdir - - * Minor bug fixes - ------------------------------------------------------------------------------ - -Changed in version 2.5.0: - - * Drop support for GHC 6.8.* - - * Add support for GHC 6.10.3 and 6.10.4 - - * Revert to the old multi-page index for large packages (#106) - - * Show GADT records in the generated documentation - - * Create output directory if it doesn't exist (#104) - - * Use the native codegen instead of compiling via C for TH modules - - * Add --use-unicode flag for displaying prettier versions of common symbols - - * Multiple verbosity levels: remove --verbose and add --verbosity=n - ------------------------------------------------------------------------------ - -Changed in version 2.4.2: - - * Support GHC 6.10.2 - - * Haddock no longer crashes on Template Haskell modules (#68) - (only with GHC 6.10.2 or above) - - * Fix problem with Template Haskell-generated declarations disappearing (#59) - - * Generate two anchors for each link for compatibility between IE and Opera - (#45) - - * Improved error messages - - * Show re-exports from external packages again (GHC ticket #2746) - - * Store hidden modules in .haddock files again (needed by the haddock - library) - - * Avoid processing boot modules - - * Pragmas may exist between document comments and declarations - - * Do not indicate that a constructor argument is unboxed - - * Fix problem with non-working links to ghc-prim - - * Allow referring to a specific section within a module in a module link - (#65) - - * Fixes to the Hoogle backend - - * Improvements to the haddock library - - * Many other fixes (including #67, #69, #58, #57) - ------------------------------------------------------------------------------ - -Changed in version 2.4.1: - - * Depend on base 4.* when GHC >= 6.9, otherwise 3.* - ------------------------------------------------------------------------------ - -Changed in version 2.4.0: - - * Add framed view of the HTML documentation - - * Build with GHC 6.8.2 and 6.8.3 again - - * Support images in documentation comments again - - * Small improvements to the Hoogle output - - * A few bugs has been fixed - ------------------------------------------------------------------------------ - -Changed in version 2.3.0: - - * Support for GHC 6.10.1 - - * Slightly improved space usage - - * Fix a bug that made hidden modules show up in the contents & index pages - - * Fix a bug that made Haddock load modules twice - - * Improvements to the Hoogle output - ------------------------------------------------------------------------------ - -Changed in version 2.2.2: - - * Relax version dependency on ghc-paths - ------------------------------------------------------------------------------ - -Changes in version 2.2.1: - - * Support for GHC 6.8.3 - - * The Hoogle backend is back, thanks to Neil Mitchell. The plan is to be - compatible with the upcoming Hoogle 4 pre-release - - * Show associated types in the documentation for class declarations - - * Show type family declarations - - * Show type equality predicates - - * Major bug fixes (#1 and #44) - - * It is no longer required to specify the path to GHC's lib dir - - * Remove unnecessary parenthesis in type signatures - ------------------------------------------------------------------------------ - -Changes in version 2.1.0: - - * Fix a bug that made links point to the defining module instead - of the "best" one (e.g Int pointing to GHC.Base instead of Data.Int) - - * Fix a couple of smaller bugs - - * The representation of DocName was changed in the library - - * Add a flag --no-warnings for turning off warnings - ------------------------------------------------------------------------------ - -Changes in version 2.0.0.0: - - * The GHC API is used as the front-end - - * Haddock now understands all syntax understood by GHC 6.8.2 - - * Haddock can generate documentation for some of the language extensions - in GHC 6.8.2 - - * Format of module attributes has changed. The only way of specifying - module attributes is via a new OPTIONS_HADDOCK pragma. Example: - {-# OPTIONS_HADDOCK hide, prune #-} - - * Haddock understands literate source files - - * Add a small library to read Haddock's interface files - - * Add a flag -B for passing the path to the GHC lib dir - - * Add a flag --optghc for passing options to GHC - - * Add a flag --ghc-version for printing the GHC version - - * Remove --use-package, --allow-missing-html, --ghc-pkg, in favour of only - supporting --read-interface - - * Remove --package flag, the GHC flag -package-name can be used instead - - * Remove --no-implicit-prelude flag, the GHC flag -XNoImplicitPrelude can - be used instead - ------------------------------------------------------------------------------ - -Changes in version 0.9: - - * Infix type operators, e.g., first :: a~>a' -> (a,b)~>(a',b) - - * Add a search box to the index page which automatically narrows - the index to the search as you type (thanks to Neil Mitchell). - - * Add a --ghc-pkg flag - - * Add a flag --allow-missing-html - - * URL expansion for %%, %L, %{LINE} - - * added substitution %{FILE///c} - - * Lexing of /.../ is now more like '...', in that a / character must - be matched by another / character on the same line, otherwise it - is treated as a literal '/'. This removes a common source of - accidental parse errors in documentation. - - * Various bugs were fixed. - - * Cabal 1.2 is now required, and Haddock builds with GHC 6.8.x. - ------------------------------------------------------------------------------ - -Changes in version 0.8: - - * Haddock has a Cabal build system, and will build on Windows without - Cygwin or MSYS. GHC 6.4 or later is required. - - * New options: --comments-base, --comments-module, --comments-entity - for generating links to pages (eg. wiki) for collecting user comments. - - * New options: --source-base, --source-module, --source-entity - for generating links to source code. Haddock now understands - {-# LINE #-} pragmas, which means it can figure out the correct - name for the source file even if the file is preprocessed. - - * Haddock generates output for populating the Hoogle search engine. - - * New markup <> for including images. - ------------------------------------------------------------------------------ - -Changes in version 0.7: - - * Changes in the way Haddock decides where to direct hyperlinks. Each entity - is now assigned a single "home" module, and all hyperlinks are directed - to that module. See the docs ("Hyperlinking and re-exported entities") - for details. - - * New options --ignore-all-exports, --hide - - * New option --use-package for creating documentation that hyperlinks to - the HTML documentation for existing packages on your system. It works - by querying ghc-pkg for the location of the Haddock interface and - HTML for the given package. - - * Parts of the HTML documentation, notably lists of instances, are - now "collapsible" with a +/- button. Also, the contents page is now - in the form of tree in which subtrees can be collapsed. - - * Support for Microsoft DevHelp and HtmlHelp 2.0 formats. - - * Support for a short description for each module for the contents page. - - * Compiles with GHC 6.4+ - - * Various bugfixes - ------------------------------------------------------------------------------ - -Changes in version 0.6: - - * Implicit parameters, zip comprehensions and 'mdo' are now - supported by the parser. - - * Some lexical bugs were fixed, mainly concerning literal paragraphs - next to non-literal paragraphs. - - * New options: --gen-index, --use-index, --gen-contents and --use-contents, - for generting a combined index and contents for several libraries - from the appropriate .haddock files. - - * There is now one index rather than separate Function/Constructor and - Type/Class indices. Where a name refers to several entities, these - are listed separately in the index. - - * New option: -v, elicits more verbose warnings. Some warnings are - now turned off by default; Haddock should be a little less noisy - in general. - - * Markup for definition lists has been added. See the documentation - for details. - - * New option: --package for setting the package name. The package - is listed alongside each module name in the combined contents. - - * Entities which are re-exported from another package now at least - leave a hyperlink in the generated HTML, rather than nothing at all. - - * Some fixes for bugs which caused incorrect hyperlinks in the - generated HTML. In particular, instances should now be linked - correctly. - - * Some aesthetic improvements to the generated HTML. - ------------------------------------------------------------------------------ - -Changes in version 0.5: - - * Compiles with recent versions of GHC. - - * A few bugs have been fixed. - - * New labelling/linking feature (see "Anchors" in the manual). - ------------------------------------------------------------------------------ - -Changes in version 0.4: - - * Import declarations which list entities in parentheses, or with - hiding clauses, are now properly supported. Modulo one or two - small infelicities, the full Haskell modules system is now supported. - - * Haddock is now more flexible about the placing of separators - (commas, semicolons) in relation to doc comments. - - * There is support for generating and reading "interface files" - which describe the exports of a set of modules. This is useful - for generating documentation which hyperlinks to - previously-generated documentation. - - * Support for generating the extra files required by the Microsoft - Help compiler. - - * New option: --prologue specifies a file of documentation which is - placed on the contents page. - - * Many bugs fixed - ------------------------------------------------------------------------------ -Changes in version 0.3: - - * Documentation on individual function arguments is now implemented - - * Links can be made to identifiers that aren't in scope, by using - the fully qualified name. - - * Instances are collected and listed with the appropriate classes - and datatypes (not for derived instances yet). - - * Single quotes are only interpreted specially when they surround a - legal Haskell identifier, otherwise they are treated literally. - - * Bird-tracked text is now literal. If you want marked-up text in - a code block, use the @...@ notation instead. - - * Various changes to the layout, it generally looks nicer now. - - * Various bugs fixed. - ------------------------------------------------------------------------------ -Changes in version 0.2: - - * The [...] markup for typewriter font has been changed to @...@. - - * Module attributes introduced (see the documentation for details). - - * {- ... -} style comments may now be used for documentation annotations - - * Recursive modules are detected and reported as an error. - - * Existential constructors and rank-N types are now groked by the parser - - * Some type rendering cleaned up - - * `abc' is accepted as well as 'abc' to markup an identifier - - * Several bugs fixed, and error messages improved. diff --git a/CHANGES.md b/CHANGES.md new file mode 100644 index 00000000..351d1293 --- /dev/null +++ b/CHANGES.md @@ -0,0 +1,766 @@ +## Changes in version HEAD + + * Synopsis is working again (#599) + +## Changes in version 2.17.4 + + * Fix 'internal error: links: UnhelpfulSpan' (#554, #565) + + * Hyperlink backend knows about `DataKinds` (#510) + + * Fix rendering of class methods for `Eq` and `Ord` (#549) + + * Export `MDoc` and `toInstalledIface` from `Haddock.Types` + +## Changes in version 2.17.3.1 + + * Disable `NFData` instances for GHC types when GHC >= 8.0.2 (#537) + +## Changes in version 2.17.3 + + * Remove framed view of the HTML documentation + +## Changes in version 2.17.2 + + * Fix portability of documentation building within GHC + +## Changes in version 2.17.1 + + * Included with GHC 8.0.1 + + * Fixed Makefile for GHC installation + + * Fixed clean rule of GHC Makefile + +## Changes in version 2.17.0 (not released) + + * Support typesetting of mathematical expressions via Mathjax (#397) + + * Describe orphan instances defined in a module in its documentation (#449) + + * Produce specialized type signatures for typeclass methods (#425) + + * Support GCC-like response files (#470) + +## Changes in version 2.16.2 + + * Generate hyperlinked source ourselves (#410, part of GSOC 2015) + + * Fix expansion icon for user-collapsible sections (#412) + + * Break up response file arguments on newlines + + * Various HTML fixes (#301, #406, #407, #421) + + * Line anchors in hyperlinked source (#420) + +## Changes in version 2.16.1 + + * Don't default to type constructors for out-of-scope names (#253 and + #375) + + * Fix Hoogle display of constructors (#361) + + * Fully qualify names in Hoogle instances output (#263) + + * Output method documentation in Hoogle backend (#259) + + * Don't print instance safety information in Hoogle (#168) + + * Expand response files in arguments (#285) + + * Build the main executable with -threaded (#399) + + * Use SrcSpan of declarations for inferred type sigs (#207) + + * Fix cross-module instance locations (#383) + + * Fix alignment of Source link for instances in Firefox (#384) + +## Changes in version 2.16.0 + + * Experimental collapsible header support (#335) + + * Add support for markdown links and images + + * Allow an optional colon after the closing bracket of definition lists. + This is to disambiguate them from markdown links and will be require with a + future release. + + * Fix re-exports of built-in type families (#310) + + * Fix parsing of infix identifiers such as ``elem``. + + * Print missing docs by default and add --no-print-missing-docs + + * parser: now parses out some meta data too, breaking the API + + * parser: markdown syntax for images and URLs is now accepted: + <> style for images and style for links is now + considered deprecated. for links is still OK. + + * parser: add support for @since element: this is paragraph-level + element of the form ‘@since x.y.z’ where x.y.z is the version + number. The way it is rendered is subject to change. + + * properly render package ID (not package key) in index (#329) + + * links to source location of class instance definitions + + * Fix code blocks in presence of Windows line endings + + * Deal better with long synopsis lines (#151) + +## Changes in version 2.15.0 + + * Always read in prologue files as UTF8 (#286 and Cabal #1721) + + * parser: don't wrap headers in DocParagraph (#307) + + * parser: don't mangle append order for nested lists (pandoc #1346) + + * parser: preserve list ordering in certain scenarios (#313) + + * parser: update the attoparsec version used internally giving slight + parsing performance boost. + + * Move development to be against latest GHC release and not GHC HEAD. + + * Further split up the package to separate the executable from the + library, necessary by things like GHCJS. We now have + ‘haddock-library’ which are the parts that don't use GHC API, + ‘haddock-api’ which are (some of) the parts that do use GHC API and + ‘haddock’ which merely provides the executable. + + * Export few extra functions in the API. + + * Add compatibility with GHC 7.8.2. + + * Omit unnecessary ‘forall’s (#315 and #86) + + * Remove some files which were really old or did not belong in the + repository in the first place. + +## Changes in version 2.14.3 + + * Fix parsing of identifiers with ^ or ⋆ in them (#298) + + * Fix anchors (#308) + +## Changes in version 2.14.2 + + * Always drop --split-objs GHC flag for performance reasons (#292) + + * Print kind signatures GADTs (#85) + + * Drop single leading whitespace when reasonable from @-style blocks (#201) + + * Fix crashes associated with exporting data family record selectors (#294) + +## Changes in version 2.14.1 + + * Render * and -> with their UnicodeSyntax equivalents if -U is enabled + + * Display minimal complete definitions for type classes + + * Hide right hand side of TF instances with hidden names on the RHS + +## Changes in version 2.14.0 + + * Print entities with missing documentation (#258) + + * Print a warning message when given `-optghc` instead of `--optghc` (#5) + + * Add `--compatible-interface-versions` (#231) + + * Allow to generate latex documentation for FFI declarations (#247) + + * Add copyright and license information to generated documentation + + * Improved to Unicode support + + * Bold markup support + + * Nested paragraphs + + * Better escaping + + * Header markup + + * Parser should no longer fail to parse any markup + + * {-# OPTIONS_HADDOCK show-extensions #-} pragma will show the GHC extensions + enabled in the module. + + * Properly render License field (#271) + + * Print type/data family instances (for exported types only) + + * Fix display of poly-kinded type operators (#189) + + * PatternSynonyms support + + * Fix display of implicit parameters (#260) + + * Fix rendering of Contents when links are present (#276) + + * Fix documentation duplication on record fields (#195) + + * Add `--source-entity-line` for exact line links (eg. things defined + inside TH splices) (#79) + + * Display fixity information for names with nonstandard fixities + + * Bird tracks specified like "> code" no longer suffer from an extra leading + space in the code output + +## Changes in version 2.13.2 + + * Handle HsExplicitListTy in renamer (#213) + + * Allow haddock markup in deprecation messages + + * Export more types from Documentation.Haddock + + * Include everything that is required to run the test suite with the cabal + package (#230) + +## Changes in version 2.13.1 + + * Hide instances that are "internal" to a module + + * Add support for properties in documentation + + * Fix a bug with spurious superclass constraints + + * Fix and extend the Haddock API + +## Changes in version 2.12.0 + + * Labeled URLs (e.g ) + + * Improved memory usage (new dependency: deepseq) + +## Changes in version 2.11.0 + + * Show deprecation messages for identifiers + + * List identifiers declared on the same line (with a common type) separately + + * Don't crash on unicode strings in doc comments + + * Fix reporting of modules safe haskell mode + + * Fix a case where we were generating invalid xhtml + + * Improved --qual option (no crashes, proper error messages) + + * A new --qual option "aliased" which qualifies identifiers by the module alias + used in the source code + + * The Haddock API restores GHC's static flags after invocation + + * Access to unexported identifiers through the Haddock API again + +## Changes in version 2.10.0 + + * Require GHC >= 7.4 + + * Safe Haskell indications on module pages + + * Type declarations on identifiers no longer necessary + + * Add flag --interface-version + + * Warn when comment refers to in-scope identifier without documentation + + * Bug fix: links to out-of-scope things (#78) + + * Bug fix: module references to other packages work again + +## Changes in version 2.9.4 + + * Require GHC >= 7.2 + + * Support Alex 3.x + +## Changes in version 2.9.3 + + [This is the version that comes with GHC 7.2.1 although it claims it's 2.9.2!] + + * Build with GHC 7.2.1 + + * Support blank lines in results of examples + + * A type signature for multiple names generates one signature in the output + + * Minor bug fixes + +## Changes in version 2.9.2 + + * Build with GHC 7.0.2 + + * Write Hoogle output in utf8; fixes GHC build on Windows + +## Changes in version 2.9.1 + + * Fix build in GHC tree + + * Improve .cabal file + +## Changes in version 2.9.0 + + * Drop support for ghc < 7 + + * New flag --qual for qualification of names + + * Print doc coverage information to stdout when generating docs + + * Include an 'All' option in the A-Z subdivided index + + * Make TOC group header identifiers validate + + * Minor changes to the API + +## Changes in the version that comes with GHC 7.0.1 + + [This version claims it is 2.8.0 but is actually based on 2.8.1] + + * Fix URL creation on Windows: Use / not \ in URLs. + + * Support GHC 7.0 + +## Changes in version 2.8.1 + + * Fix build on Windows with MinGW + +## Changes in version 2.8.0 + + * HTML backend completely rewritten to generate semantically rich XHTML + using the xhtml package. + + * New default CSS based on the color scheme chosen for the new Haskell + wiki, with a pull-out tab for the synopsis. + + * Theme engine based on CSS files. Themes can be switched from the + header menu. (New flags --built-in-themes and --theme. The latter + is an alias for --css which now has extended semantics). + + * Markup support for executable examples/unit-tests. To be used with an + upcoming version of the DocTest program. + + * Addition of a LaTeX backend. + + * Frames-mode can be enabled from the header menu. + + * Path to source entities can be specified per package, so that source + links work for cross-package documentation. + + * Support for a second form of enumerated lists (1. 2. etc). + + * Additions and changes to the Haddock API. + + * New flag --no-tmp-comp-dir to tell Haddock to write and pick up + compilation files (.o, .hi, etc) to/from GHC's output directory instead + of a temporary directory. + + * Various bug fixes. + +----------------------------------------------------------------------------- + +## Changes in version 2.6.1 (bug fix release from the stable branch) + + * Fix #128 + +----------------------------------------------------------------------------- + +## Changes in version 2.7.2 + + * Add Paths_haddock to library + +----------------------------------------------------------------------------- + +## Changes in version 2.7.1: + + * Fix problems with library part of .cabal file + +----------------------------------------------------------------------------- + +## Changes in version 2.7.0: + + * Instances can be commented + + * The Haddock API now exposes more of the internals of Haddock + + * Bug fixes (most importantly #128) + +----------------------------------------------------------------------------- + +## Changes in version 2.6.0: + + * Drop support for GHC 6.10.* + + * Add support for GHC 6.12.1 + + * Cross-package documentation: full documentation show up when re-exporting + things coming from external packages + + * Lexing and parsing the Haddock comment markup is now done in Haddock + again, instead of in GHC + + * Slightly prettier printing of instance heads + + * Support platforms for which GHC has no native code generator + + * Add a flag --print-ghc-libdir + + * Minor bug fixes + +----------------------------------------------------------------------------- + +Changed in version 2.5.0: + + * Drop support for GHC 6.8.* + + * Add support for GHC 6.10.3 and 6.10.4 + + * Revert to the old multi-page index for large packages (#106) + + * Show GADT records in the generated documentation + + * Create output directory if it doesn't exist (#104) + + * Use the native codegen instead of compiling via C for TH modules + + * Add --use-unicode flag for displaying prettier versions of common symbols + + * Multiple verbosity levels: remove --verbose and add --verbosity=n + +----------------------------------------------------------------------------- + +Changed in version 2.4.2: + + * Support GHC 6.10.2 + + * Haddock no longer crashes on Template Haskell modules (#68) + (only with GHC 6.10.2 or above) + + * Fix problem with Template Haskell-generated declarations disappearing (#59) + + * Generate two anchors for each link for compatibility between IE and Opera + (#45) + + * Improved error messages + + * Show re-exports from external packages again (GHC ticket #2746) + + * Store hidden modules in .haddock files again (needed by the haddock + library) + + * Avoid processing boot modules + + * Pragmas may exist between document comments and declarations + + * Do not indicate that a constructor argument is unboxed + + * Fix problem with non-working links to ghc-prim + + * Allow referring to a specific section within a module in a module link + (#65) + + * Fixes to the Hoogle backend + + * Improvements to the haddock library + + * Many other fixes (including #67, #69, #58, #57) + +----------------------------------------------------------------------------- + +Changed in version 2.4.1: + + * Depend on base 4.* when GHC >= 6.9, otherwise 3.* + +----------------------------------------------------------------------------- + +Changed in version 2.4.0: + + * Add framed view of the HTML documentation + + * Build with GHC 6.8.2 and 6.8.3 again + + * Support images in documentation comments again + + * Small improvements to the Hoogle output + + * A few bugs has been fixed + +----------------------------------------------------------------------------- + +Changed in version 2.3.0: + + * Support for GHC 6.10.1 + + * Slightly improved space usage + + * Fix a bug that made hidden modules show up in the contents & index pages + + * Fix a bug that made Haddock load modules twice + + * Improvements to the Hoogle output + +----------------------------------------------------------------------------- + +Changed in version 2.2.2: + + * Relax version dependency on ghc-paths + +----------------------------------------------------------------------------- + +## Changes in version 2.2.1: + + * Support for GHC 6.8.3 + + * The Hoogle backend is back, thanks to Neil Mitchell. The plan is to be + compatible with the upcoming Hoogle 4 pre-release + + * Show associated types in the documentation for class declarations + + * Show type family declarations + + * Show type equality predicates + + * Major bug fixes (#1 and #44) + + * It is no longer required to specify the path to GHC's lib dir + + * Remove unnecessary parenthesis in type signatures + +----------------------------------------------------------------------------- + +## Changes in version 2.1.0: + + * Fix a bug that made links point to the defining module instead + of the "best" one (e.g Int pointing to GHC.Base instead of Data.Int) + + * Fix a couple of smaller bugs + + * The representation of DocName was changed in the library + + * Add a flag --no-warnings for turning off warnings + +----------------------------------------------------------------------------- + +## Changes in version 2.0.0.0: + + * The GHC API is used as the front-end + + * Haddock now understands all syntax understood by GHC 6.8.2 + + * Haddock can generate documentation for some of the language extensions + in GHC 6.8.2 + + * Format of module attributes has changed. The only way of specifying + module attributes is via a new OPTIONS_HADDOCK pragma. Example: + {-# OPTIONS_HADDOCK hide, prune #-} + + * Haddock understands literate source files + + * Add a small library to read Haddock's interface files + + * Add a flag -B for passing the path to the GHC lib dir + + * Add a flag --optghc for passing options to GHC + + * Add a flag --ghc-version for printing the GHC version + + * Remove --use-package, --allow-missing-html, --ghc-pkg, in favour of only + supporting --read-interface + + * Remove --package flag, the GHC flag -package-name can be used instead + + * Remove --no-implicit-prelude flag, the GHC flag -XNoImplicitPrelude can + be used instead + +----------------------------------------------------------------------------- + +## Changes in version 0.9: + + * Infix type operators, e.g., first :: a~>a' -> (a,b)~>(a',b) + + * Add a search box to the index page which automatically narrows + the index to the search as you type (thanks to Neil Mitchell). + + * Add a --ghc-pkg flag + + * Add a flag --allow-missing-html + + * URL expansion for %%, %L, %{LINE} + + * added substitution %{FILE///c} + + * Lexing of /.../ is now more like '...', in that a / character must + be matched by another / character on the same line, otherwise it + is treated as a literal '/'. This removes a common source of + accidental parse errors in documentation. + + * Various bugs were fixed. + + * Cabal 1.2 is now required, and Haddock builds with GHC 6.8.x. + +----------------------------------------------------------------------------- + +## Changes in version 0.8: + + * Haddock has a Cabal build system, and will build on Windows without + Cygwin or MSYS. GHC 6.4 or later is required. + + * New options: --comments-base, --comments-module, --comments-entity + for generating links to pages (eg. wiki) for collecting user comments. + + * New options: --source-base, --source-module, --source-entity + for generating links to source code. Haddock now understands + {-# LINE #-} pragmas, which means it can figure out the correct + name for the source file even if the file is preprocessed. + + * Haddock generates output for populating the Hoogle search engine. + + * New markup <> for including images. + +----------------------------------------------------------------------------- + +## Changes in version 0.7: + + * ## Changes in the way Haddock decides where to direct hyperlinks. Each entity + is now assigned a single "home" module, and all hyperlinks are directed + to that module. See the docs ("Hyperlinking and re-exported entities") + for details. + + * New options --ignore-all-exports, --hide + + * New option --use-package for creating documentation that hyperlinks to + the HTML documentation for existing packages on your system. It works + by querying ghc-pkg for the location of the Haddock interface and + HTML for the given package. + + * Parts of the HTML documentation, notably lists of instances, are + now "collapsible" with a +/- button. Also, the contents page is now + in the form of tree in which subtrees can be collapsed. + + * Support for Microsoft DevHelp and HtmlHelp 2.0 formats. + + * Support for a short description for each module for the contents page. + + * Compiles with GHC 6.4+ + + * Various bugfixes + +----------------------------------------------------------------------------- + +## Changes in version 0.6: + + * Implicit parameters, zip comprehensions and 'mdo' are now + supported by the parser. + + * Some lexical bugs were fixed, mainly concerning literal paragraphs + next to non-literal paragraphs. + + * New options: --gen-index, --use-index, --gen-contents and --use-contents, + for generting a combined index and contents for several libraries + from the appropriate .haddock files. + + * There is now one index rather than separate Function/Constructor and + Type/Class indices. Where a name refers to several entities, these + are listed separately in the index. + + * New option: -v, elicits more verbose warnings. Some warnings are + now turned off by default; Haddock should be a little less noisy + in general. + + * Markup for definition lists has been added. See the documentation + for details. + + * New option: --package for setting the package name. The package + is listed alongside each module name in the combined contents. + + * Entities which are re-exported from another package now at least + leave a hyperlink in the generated HTML, rather than nothing at all. + + * Some fixes for bugs which caused incorrect hyperlinks in the + generated HTML. In particular, instances should now be linked + correctly. + + * Some aesthetic improvements to the generated HTML. + +----------------------------------------------------------------------------- + +## Changes in version 0.5: + + * Compiles with recent versions of GHC. + + * A few bugs have been fixed. + + * New labelling/linking feature (see "Anchors" in the manual). + +----------------------------------------------------------------------------- + +## Changes in version 0.4: + + * Import declarations which list entities in parentheses, or with + hiding clauses, are now properly supported. Modulo one or two + small infelicities, the full Haskell modules system is now supported. + + * Haddock is now more flexible about the placing of separators + (commas, semicolons) in relation to doc comments. + + * There is support for generating and reading "interface files" + which describe the exports of a set of modules. This is useful + for generating documentation which hyperlinks to + previously-generated documentation. + + * Support for generating the extra files required by the Microsoft + Help compiler. + + * New option: --prologue specifies a file of documentation which is + placed on the contents page. + + * Many bugs fixed + +----------------------------------------------------------------------------- +## Changes in version 0.3: + + * Documentation on individual function arguments is now implemented + + * Links can be made to identifiers that aren't in scope, by using + the fully qualified name. + + * Instances are collected and listed with the appropriate classes + and datatypes (not for derived instances yet). + + * Single quotes are only interpreted specially when they surround a + legal Haskell identifier, otherwise they are treated literally. + + * Bird-tracked text is now literal. If you want marked-up text in + a code block, use the @...@ notation instead. + + * Various changes to the layout, it generally looks nicer now. + + * Various bugs fixed. + +----------------------------------------------------------------------------- +## Changes in version 0.2: + + * The [...] markup for typewriter font has been changed to @...@. + + * Module attributes introduced (see the documentation for details). + + * {- ... -} style comments may now be used for documentation annotations + + * Recursive modules are detected and reported as an error. + + * Existential constructors and rank-N types are now groked by the parser + + * Some type rendering cleaned up + + * `abc' is accepted as well as 'abc' to markup an identifier + + * Several bugs fixed, and error messages improved. diff --git a/haddock.cabal b/haddock.cabal index 598f2b9a..935d517f 100644 --- a/haddock.cabal +++ b/haddock.cabal @@ -17,7 +17,7 @@ stability: experimental tested-with: GHC==8.2.*, GHC==8.3 extra-source-files: - CHANGES + CHANGES.md README.md doc/Makefile doc/README.md -- cgit v1.2.3 From 7ec72d3ad81657f5a5298ac1465229fa7cafb35c Mon Sep 17 00:00:00 2001 From: Alex Biehl Date: Wed, 26 Apr 2017 11:32:33 +0200 Subject: Bump to 2.18.0 (#605) --- CHANGES.md | 2 +- haddock-api/haddock-api.cabal | 2 +- haddock.cabal | 6 +++--- 3 files changed, 5 insertions(+), 5 deletions(-) diff --git a/CHANGES.md b/CHANGES.md index 351d1293..6c2b5d32 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -1,4 +1,4 @@ -## Changes in version HEAD +## Changes in version 2.18.0 * Synopsis is working again (#599) diff --git a/haddock-api/haddock-api.cabal b/haddock-api/haddock-api.cabal index 20b656b9..15215cdb 100644 --- a/haddock-api/haddock-api.cabal +++ b/haddock-api/haddock-api.cabal @@ -1,5 +1,5 @@ name: haddock-api -version: 2.17.4 +version: 2.18.0 synopsis: A documentation-generation tool for Haskell libraries description: Haddock is a documentation-generation tool for Haskell libraries diff --git a/haddock.cabal b/haddock.cabal index 935d517f..160316e9 100644 --- a/haddock.cabal +++ b/haddock.cabal @@ -1,5 +1,5 @@ name: haddock -version: 2.17.4 +version: 2.18.0 synopsis: A documentation-generation tool for Haskell libraries description: Haddock is a documentation-generation tool for Haskell libraries @@ -15,7 +15,7 @@ build-type: Simple cabal-version: >= 2.0 stability: experimental tested-with: GHC==8.2.*, GHC==8.3 - + extra-source-files: CHANGES.md README.md @@ -123,7 +123,7 @@ executable haddock else -- in order for haddock's advertised version number to have proper meaning, -- we pin down to a single haddock-api version. - build-depends: haddock-api == 2.17.4 + build-depends: haddock-api == 2.18.0 test-suite driver-test type: exitcode-stdio-1.0 -- cgit v1.2.3 From 799a41fffde7ec6e1c2097b895925a4adac5419f Mon Sep 17 00:00:00 2001 From: alexbiehl Date: Fri, 28 Apr 2017 11:28:08 +0200 Subject: Update attoparsec-0.12.1.1 to attoparsec-0.13.1.0 --- haddock-library/haddock-library.cabal | 4 +- .../vendor/attoparsec-0.12.1.1/Data/Attoparsec.hs | 23 - .../Data/Attoparsec/ByteString.hs | 223 --------- .../Data/Attoparsec/ByteString/Buffer.hs | 151 ------ .../Data/Attoparsec/ByteString/Char8.hs | 469 ------------------ .../Data/Attoparsec/ByteString/FastSet.hs | 115 ----- .../Data/Attoparsec/ByteString/Internal.hs | 485 ------------------- .../Data/Attoparsec/Combinator.hs | 220 --------- .../Data/Attoparsec/Internal.hs | 142 ------ .../Data/Attoparsec/Internal/Fhthagn.hs | 18 - .../Data/Attoparsec/Internal/Types.hs | 230 --------- .../attoparsec-0.12.1.1/Data/Attoparsec/Number.hs | 137 ------ haddock-library/vendor/attoparsec-0.12.1.1/LICENSE | 30 -- .../vendor/attoparsec-0.13.1.0/Data/Attoparsec.hs | 23 + .../Data/Attoparsec/ByteString.hs | 230 +++++++++ .../Data/Attoparsec/ByteString/Buffer.hs | 156 ++++++ .../Data/Attoparsec/ByteString/Char8.hs | 464 ++++++++++++++++++ .../Data/Attoparsec/ByteString/FastSet.hs | 115 +++++ .../Data/Attoparsec/ByteString/Internal.hs | 536 +++++++++++++++++++++ .../Data/Attoparsec/Combinator.hs | 233 +++++++++ .../Data/Attoparsec/Internal.hs | 157 ++++++ .../Data/Attoparsec/Internal/Fhthagn.hs | 18 + .../Data/Attoparsec/Internal/Types.hs | 243 ++++++++++ .../attoparsec-0.13.1.0/Data/Attoparsec/Number.hs | 137 ++++++ haddock-library/vendor/attoparsec-0.13.1.0/LICENSE | 30 ++ haddock.cabal | 2 +- 26 files changed, 2345 insertions(+), 2246 deletions(-) delete mode 100644 haddock-library/vendor/attoparsec-0.12.1.1/Data/Attoparsec.hs delete mode 100644 haddock-library/vendor/attoparsec-0.12.1.1/Data/Attoparsec/ByteString.hs delete mode 100644 haddock-library/vendor/attoparsec-0.12.1.1/Data/Attoparsec/ByteString/Buffer.hs delete mode 100644 haddock-library/vendor/attoparsec-0.12.1.1/Data/Attoparsec/ByteString/Char8.hs delete mode 100644 haddock-library/vendor/attoparsec-0.12.1.1/Data/Attoparsec/ByteString/FastSet.hs delete mode 100644 haddock-library/vendor/attoparsec-0.12.1.1/Data/Attoparsec/ByteString/Internal.hs delete mode 100644 haddock-library/vendor/attoparsec-0.12.1.1/Data/Attoparsec/Combinator.hs delete mode 100644 haddock-library/vendor/attoparsec-0.12.1.1/Data/Attoparsec/Internal.hs delete mode 100644 haddock-library/vendor/attoparsec-0.12.1.1/Data/Attoparsec/Internal/Fhthagn.hs delete mode 100644 haddock-library/vendor/attoparsec-0.12.1.1/Data/Attoparsec/Internal/Types.hs delete mode 100644 haddock-library/vendor/attoparsec-0.12.1.1/Data/Attoparsec/Number.hs delete mode 100644 haddock-library/vendor/attoparsec-0.12.1.1/LICENSE create mode 100644 haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec.hs create mode 100644 haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec/ByteString.hs create mode 100644 haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec/ByteString/Buffer.hs create mode 100644 haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec/ByteString/Char8.hs create mode 100644 haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec/ByteString/FastSet.hs create mode 100644 haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec/ByteString/Internal.hs create mode 100644 haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec/Combinator.hs create mode 100644 haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec/Internal.hs create mode 100644 haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec/Internal/Fhthagn.hs create mode 100644 haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec/Internal/Types.hs create mode 100644 haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec/Number.hs create mode 100644 haddock-library/vendor/attoparsec-0.13.1.0/LICENSE diff --git a/haddock-library/haddock-library.cabal b/haddock-library/haddock-library.cabal index be433e6a..a293039a 100644 --- a/haddock-library/haddock-library.cabal +++ b/haddock-library/haddock-library.cabal @@ -26,7 +26,7 @@ library , transformers >= 0.3.0 && < 0.6 , deepseq >= 1.3 && < 1.5 - hs-source-dirs: src, vendor/attoparsec-0.12.1.1 + hs-source-dirs: src, vendor/attoparsec-0.13.1.0 ghc-options: -funbox-strict-fields -Wall -fwarn-tabs -O2 exposed-modules: @@ -57,7 +57,7 @@ test-suite spec hs-source-dirs: test , src - , vendor/attoparsec-0.12.1.1 + , vendor/attoparsec-0.13.1.0 ghc-options: -Wall cpp-options: diff --git a/haddock-library/vendor/attoparsec-0.12.1.1/Data/Attoparsec.hs b/haddock-library/vendor/attoparsec-0.12.1.1/Data/Attoparsec.hs deleted file mode 100644 index 53d91190..00000000 --- a/haddock-library/vendor/attoparsec-0.12.1.1/Data/Attoparsec.hs +++ /dev/null @@ -1,23 +0,0 @@ --- | --- Module : Data.Attoparsec --- Copyright : Bryan O'Sullivan 2007-2014 --- License : BSD3 --- --- Maintainer : bos@serpentine.com --- Stability : experimental --- Portability : unknown --- --- Simple, efficient combinator parsing for --- 'Data.ByteString.ByteString' strings, loosely based on the Parsec --- library. --- --- This module is deprecated. Use "Data.Attoparsec.ByteString" --- instead. - -module Data.Attoparsec - {-# DEPRECATED "This module will be removed in the next major release." #-} - ( - module Data.Attoparsec.ByteString - ) where - -import Data.Attoparsec.ByteString diff --git a/haddock-library/vendor/attoparsec-0.12.1.1/Data/Attoparsec/ByteString.hs b/haddock-library/vendor/attoparsec-0.12.1.1/Data/Attoparsec/ByteString.hs deleted file mode 100644 index da28b723..00000000 --- a/haddock-library/vendor/attoparsec-0.12.1.1/Data/Attoparsec/ByteString.hs +++ /dev/null @@ -1,223 +0,0 @@ --- | --- Module : Data.Attoparsec.ByteString --- Copyright : Bryan O'Sullivan 2007-2014 --- License : BSD3 --- --- Maintainer : bos@serpentine.com --- Stability : experimental --- Portability : unknown --- --- Simple, efficient combinator parsing for 'B.ByteString' strings, --- loosely based on the Parsec library. - -module Data.Attoparsec.ByteString - ( - -- * Differences from Parsec - -- $parsec - - -- * Incremental input - -- $incremental - - -- * Performance considerations - -- $performance - - -- * Parser types - I.Parser - , Result - , T.IResult(..) - , I.compareResults - - -- * Running parsers - , parse - , feed - , I.parseOnly - , parseWith - , parseTest - - -- ** Result conversion - , maybeResult - , eitherResult - - -- * Parsing individual bytes - , I.word8 - , I.anyWord8 - , I.notWord8 - , I.satisfy - , I.satisfyWith - , I.skip - - -- ** Lookahead - , I.peekWord8 - , I.peekWord8' - - -- ** Byte classes - , I.inClass - , I.notInClass - - -- * Efficient string handling - , I.string - , I.skipWhile - , I.take - , I.scan - , I.takeWhile - , I.takeWhile1 - , I.takeTill - - -- ** Consume all remaining input - , I.takeByteString - , I.takeLazyByteString - - -- * Combinators - , try - , () - , choice - , count - , option - , many' - , many1 - , many1' - , manyTill - , manyTill' - , sepBy - , sepBy' - , sepBy1 - , sepBy1' - , skipMany - , skipMany1 - , eitherP - , I.match - -- * State observation and manipulation functions - , I.endOfInput - , I.atEnd - ) where - -import Data.Attoparsec.Combinator -import qualified Data.Attoparsec.ByteString.Internal as I -import qualified Data.Attoparsec.Internal as I -import qualified Data.ByteString as B -import Data.Attoparsec.ByteString.Internal (Result, parse) -import qualified Data.Attoparsec.Internal.Types as T - --- $parsec --- --- Compared to Parsec 3, attoparsec makes several tradeoffs. It is --- not intended for, or ideal for, all possible uses. --- --- * While attoparsec can consume input incrementally, Parsec cannot. --- Incremental input is a huge deal for efficient and secure network --- and system programming, since it gives much more control to users --- of the library over matters such as resource usage and the I/O --- model to use. --- --- * Much of the performance advantage of attoparsec is gained via --- high-performance parsers such as 'I.takeWhile' and 'I.string'. --- If you use complicated combinators that return lists of bytes or --- characters, there is less performance difference between the two --- libraries. --- --- * Unlike Parsec 3, attoparsec does not support being used as a --- monad transformer. --- --- * attoparsec is specialised to deal only with strict 'B.ByteString' --- input. Efficiency concerns rule out both lists and lazy --- bytestrings. The usual use for lazy bytestrings would be to --- allow consumption of very large input without a large footprint. --- For this need, attoparsec's incremental input provides an --- excellent substitute, with much more control over when input --- takes place. If you must use lazy bytestrings, see the --- "Data.Attoparsec.ByteString.Lazy" module, which feeds lazy chunks --- to a regular parser. --- --- * Parsec parsers can produce more helpful error messages than --- attoparsec parsers. This is a matter of focus: attoparsec avoids --- the extra book-keeping in favour of higher performance. - --- $incremental --- --- attoparsec supports incremental input, meaning that you can feed it --- a bytestring that represents only part of the expected total amount --- of data to parse. If your parser reaches the end of a fragment of --- input and could consume more input, it will suspend parsing and --- return a 'T.Partial' continuation. --- --- Supplying the 'T.Partial' continuation with a bytestring will --- resume parsing at the point where it was suspended, with the --- bytestring you supplied used as new input at the end of the --- existing input. You must be prepared for the result of the resumed --- parse to be another 'T.Partial' continuation. --- --- To indicate that you have no more input, supply the 'T.Partial' --- continuation with an empty bytestring. --- --- Remember that some parsing combinators will not return a result --- until they reach the end of input. They may thus cause 'T.Partial' --- results to be returned. --- --- If you do not need support for incremental input, consider using --- the 'I.parseOnly' function to run your parser. It will never --- prompt for more input. --- --- /Note/: incremental input does /not/ imply that attoparsec will --- release portions of its internal state for garbage collection as it --- proceeds. Its internal representation is equivalent to a single --- 'ByteString': if you feed incremental input to a parser, it will --- require memory proportional to the amount of input you supply. --- (This is necessary to support arbitrary backtracking.) - --- $performance --- --- If you write an attoparsec-based parser carefully, it can be --- realistic to expect it to perform similarly to a hand-rolled C --- parser (measuring megabytes parsed per second). --- --- To actually achieve high performance, there are a few guidelines --- that it is useful to follow. --- --- Use the 'B.ByteString'-oriented parsers whenever possible, --- e.g. 'I.takeWhile1' instead of 'many1' 'I.anyWord8'. There is --- about a factor of 100 difference in performance between the two --- kinds of parser. --- --- For very simple byte-testing predicates, write them by hand instead --- of using 'I.inClass' or 'I.notInClass'. For instance, both of --- these predicates test for an end-of-line byte, but the first is --- much faster than the second: --- --- >endOfLine_fast w = w == 13 || w == 10 --- >endOfLine_slow = inClass "\r\n" --- --- Make active use of benchmarking and profiling tools to measure, --- find the problems with, and improve the performance of your parser. - --- | Run a parser and print its result to standard output. -parseTest :: (Show a) => I.Parser a -> B.ByteString -> IO () -parseTest p s = print (parse p s) - --- | Run a parser with an initial input string, and a monadic action --- that can supply more input if needed. -parseWith :: Monad m => - (m B.ByteString) - -- ^ An action that will be executed to provide the parser - -- with more input, if necessary. The action must return an - -- 'B.empty' string when there is no more input available. - -> I.Parser a - -> B.ByteString - -- ^ Initial input for the parser. - -> m (Result a) -parseWith refill p s = step $ parse p s - where step (T.Partial k) = (step . k) =<< refill - step r = return r -{-# INLINE parseWith #-} - --- | Convert a 'Result' value to a 'Maybe' value. A 'T.Partial' result --- is treated as failure. -maybeResult :: Result r -> Maybe r -maybeResult (T.Done _ r) = Just r -maybeResult _ = Nothing - --- | Convert a 'Result' value to an 'Either' value. A 'T.Partial' --- result is treated as failure. -eitherResult :: Result r -> Either String r -eitherResult (T.Done _ r) = Right r -eitherResult (T.Fail _ _ msg) = Left msg -eitherResult _ = Left "Result: incomplete input" diff --git a/haddock-library/vendor/attoparsec-0.12.1.1/Data/Attoparsec/ByteString/Buffer.hs b/haddock-library/vendor/attoparsec-0.12.1.1/Data/Attoparsec/ByteString/Buffer.hs deleted file mode 100644 index 5e32d022..00000000 --- a/haddock-library/vendor/attoparsec-0.12.1.1/Data/Attoparsec/ByteString/Buffer.hs +++ /dev/null @@ -1,151 +0,0 @@ -{-# LANGUAGE BangPatterns #-} --- | --- Module : Data.Attoparsec.ByteString.Buffer --- Copyright : Bryan O'Sullivan 2007-2014 --- License : BSD3 --- --- Maintainer : bos@serpentine.com --- Stability : experimental --- Portability : GHC --- --- An "immutable" buffer that supports cheap appends. --- --- A Buffer is divided into an immutable read-only zone, followed by a --- mutable area that we've preallocated, but not yet written to. --- --- We overallocate at the end of a Buffer so that we can cheaply --- append. Since a user of an existing Buffer cannot see past the end --- of its immutable zone into the data that will change during an --- append, this is safe. --- --- Once we run out of space at the end of a Buffer, we do the usual --- doubling of the buffer size. --- --- The fact of having a mutable buffer really helps with performance, --- but it does have a consequence: if someone misuses the Partial API --- that attoparsec uses by calling the same continuation repeatedly --- (which never makes sense in practice), they could overwrite data. --- --- Since the API *looks* pure, it should *act* pure, too, so we use --- two generation counters (one mutable, one immutable) to track the --- number of appends to a mutable buffer. If the counters ever get out --- of sync, someone is appending twice to a mutable buffer, so we --- duplicate the entire buffer in order to preserve the immutability --- of its older self. --- --- While we could go a step further and gain protection against API --- abuse on a multicore system, by use of an atomic increment --- instruction to bump the mutable generation counter, that would be --- very expensive, and feels like it would also be in the realm of the --- ridiculous. Clients should never call a continuation more than --- once; we lack a linear type system that could enforce this; and --- there's only so far we should go to accommodate broken uses. - -module Data.Attoparsec.ByteString.Buffer - ( - Buffer - , buffer - , unbuffer - , pappend - , length - , unsafeIndex - , substring - , unsafeDrop - ) where - -import Control.Exception (assert) -import Data.ByteString.Internal (ByteString(..), memcpy, nullForeignPtr) -import Data.Attoparsec.Internal.Fhthagn (inlinePerformIO) -import Data.List (foldl1') -import Data.Monoid (Monoid(..)) -import Data.Word (Word8) -import Foreign.ForeignPtr (ForeignPtr, withForeignPtr) -import Foreign.Ptr (castPtr, plusPtr) -import Foreign.Storable (peek, peekByteOff, poke, sizeOf) -import GHC.ForeignPtr (mallocPlainForeignPtrBytes) -import Prelude hiding (length) - -data Buffer = Buf { - _fp :: {-# UNPACK #-} !(ForeignPtr Word8) - , _off :: {-# UNPACK #-} !Int - , _len :: {-# UNPACK #-} !Int - , _cap :: {-# UNPACK #-} !Int - , _gen :: {-# UNPACK #-} !Int - } - -instance Show Buffer where - showsPrec p = showsPrec p . unbuffer - --- | The initial 'Buffer' has no mutable zone, so we can avoid all --- copies in the (hopefully) common case of no further input being fed --- to us. -buffer :: ByteString -> Buffer -buffer (PS fp off len) = Buf fp off len len 0 - -unbuffer :: Buffer -> ByteString -unbuffer (Buf fp off len _ _) = PS fp off len - -instance Monoid Buffer where - mempty = Buf nullForeignPtr 0 0 0 0 - - mappend (Buf _ _ _ 0 _) b = b - mappend a (Buf _ _ _ 0 _) = a - mappend buf (Buf fp off len _ _) = append buf fp off len - - mconcat [] = mempty - mconcat xs = foldl1' mappend xs - -pappend :: Buffer -> ByteString -> Buffer -pappend (Buf _ _ _ 0 _) (PS fp off len) = Buf fp off len 0 0 -pappend buf (PS fp off len) = append buf fp off len - -append :: Buffer -> ForeignPtr a -> Int -> Int -> Buffer -append (Buf fp0 off0 len0 cap0 gen0) !fp1 !off1 !len1 = - inlinePerformIO . withForeignPtr fp0 $ \ptr0 -> - withForeignPtr fp1 $ \ptr1 -> do - let genSize = sizeOf (0::Int) - newlen = len0 + len1 - gen <- if gen0 == 0 - then return 0 - else peek (castPtr ptr0) - if gen == gen0 && newlen <= cap0 - then do - let newgen = gen + 1 - poke (castPtr ptr0) newgen - memcpy (ptr0 `plusPtr` (off0+len0)) - (ptr1 `plusPtr` off1) - (fromIntegral len1) - return (Buf fp0 off0 newlen cap0 newgen) - else do - let newcap = newlen * 2 - fp <- mallocPlainForeignPtrBytes (newcap + genSize) - withForeignPtr fp $ \ptr_ -> do - let ptr = ptr_ `plusPtr` genSize - newgen = 1 - poke (castPtr ptr_) newgen - memcpy ptr (ptr0 `plusPtr` off0) (fromIntegral len0) - memcpy (ptr `plusPtr` len0) (ptr1 `plusPtr` off1) - (fromIntegral len1) - return (Buf fp genSize newlen newcap newgen) - -length :: Buffer -> Int -length (Buf _ _ len _ _) = len -{-# INLINE length #-} - -unsafeIndex :: Buffer -> Int -> Word8 -unsafeIndex (Buf fp off len _ _) i = assert (i >= 0 && i < len) . - inlinePerformIO . withForeignPtr fp $ flip peekByteOff (off+i) -{-# INLINE unsafeIndex #-} - -substring :: Int -> Int -> Buffer -> ByteString -substring s l (Buf fp off len _ _) = - assert (s >= 0 && s <= len) . - assert (l >= 0 && l <= len-s) $ - PS fp (off+s) l -{-# INLINE substring #-} - -unsafeDrop :: Int -> Buffer -> ByteString -unsafeDrop s (Buf fp off len _ _) = - assert (s >= 0 && s <= len) $ - PS fp (off+s) (len-s) -{-# INLINE unsafeDrop #-} diff --git a/haddock-library/vendor/attoparsec-0.12.1.1/Data/Attoparsec/ByteString/Char8.hs b/haddock-library/vendor/attoparsec-0.12.1.1/Data/Attoparsec/ByteString/Char8.hs deleted file mode 100644 index 576dded9..00000000 --- a/haddock-library/vendor/attoparsec-0.12.1.1/Data/Attoparsec/ByteString/Char8.hs +++ /dev/null @@ -1,469 +0,0 @@ -{-# LANGUAGE BangPatterns, FlexibleInstances, TypeFamilies, - TypeSynonymInstances, GADTs #-} -{-# OPTIONS_GHC -fno-warn-orphans -fno-warn-warnings-deprecations #-} - --- | --- Module : Data.Attoparsec.ByteString.Char8 --- Copyright : Bryan O'Sullivan 2007-2014 --- License : BSD3 --- --- Maintainer : bos@serpentine.com --- Stability : experimental --- Portability : unknown --- --- Simple, efficient, character-oriented combinator parsing for --- 'B.ByteString' strings, loosely based on the Parsec library. - -module Data.Attoparsec.ByteString.Char8 - ( - -- * Character encodings - -- $encodings - - -- * Parser types - Parser - , A.Result - , A.IResult(..) - , I.compareResults - - -- * Running parsers - , A.parse - , A.feed - , A.parseOnly - , A.parseWith - , A.parseTest - - -- ** Result conversion - , A.maybeResult - , A.eitherResult - - -- * Parsing individual characters - , char - , char8 - , anyChar - , notChar - , satisfy - - -- ** Lookahead - , peekChar - , peekChar' - - -- ** Special character parsers - , digit - , letter_iso8859_15 - , letter_ascii - , space - - -- ** Fast predicates - , isDigit - , isDigit_w8 - , isAlpha_iso8859_15 - , isAlpha_ascii - , isSpace - , isSpace_w8 - - -- *** Character classes - , inClass - , notInClass - - -- * Efficient string handling - , I.string - , stringCI - , skipSpace - , skipWhile - , I.take - , scan - , takeWhile - , takeWhile1 - , takeTill - - -- ** String combinators - -- $specalt - , (.*>) - , (<*.) - - -- ** Consume all remaining input - , I.takeByteString - , I.takeLazyByteString - - -- * Text parsing - , I.endOfLine - , isEndOfLine - , isHorizontalSpace - - -- * Numeric parsers - , decimal - , hexadecimal - , signed - , Number(..) - - -- * Combinators - , try - , () - , choice - , count - , option - , many' - , many1 - , many1' - , manyTill - , manyTill' - , sepBy - , sepBy' - , sepBy1 - , sepBy1' - , skipMany - , skipMany1 - , eitherP - , I.match - -- * State observation and manipulation functions - , I.endOfInput - , I.atEnd - ) where - -import Control.Applicative ((*>), (<*), (<$>), (<|>)) -import Data.Attoparsec.ByteString.FastSet (charClass, memberChar) -import Data.Attoparsec.ByteString.Internal (Parser) -import Data.Attoparsec.Combinator -import Data.Attoparsec.Number (Number(..)) -import Data.Bits (Bits, (.|.), shiftL) -import Data.ByteString.Internal (c2w, w2c) -import Data.Int (Int8, Int16, Int32, Int64) -import Data.String (IsString(..)) -import Data.Word -import Prelude hiding (takeWhile) -import qualified Data.Attoparsec.ByteString as A -import qualified Data.Attoparsec.ByteString.Internal as I -import qualified Data.Attoparsec.Internal as I -import qualified Data.ByteString as B8 -import qualified Data.ByteString.Char8 as B - -instance (a ~ B.ByteString) => IsString (Parser a) where - fromString = I.string . B.pack - --- $encodings --- --- This module is intended for parsing text that is --- represented using an 8-bit character set, e.g. ASCII or --- ISO-8859-15. It /does not/ make any attempt to deal with character --- encodings, multibyte characters, or wide characters. In --- particular, all attempts to use characters above code point U+00FF --- will give wrong answers. --- --- Code points below U+0100 are simply translated to and from their --- numeric values, so e.g. the code point U+00A4 becomes the byte --- @0xA4@ (which is the Euro symbol in ISO-8859-15, but the generic --- currency sign in ISO-8859-1). Haskell 'Char' values above U+00FF --- are truncated, so e.g. U+1D6B7 is truncated to the byte @0xB7@. - --- ASCII-specific but fast, oh yes. -toLower :: Word8 -> Word8 -toLower w | w >= 65 && w <= 90 = w + 32 - | otherwise = w - --- | Satisfy a literal string, ignoring case. -stringCI :: B.ByteString -> Parser B.ByteString -stringCI = I.stringTransform (B8.map toLower) -{-# INLINE stringCI #-} - --- | Consume input as long as the predicate returns 'True', and return --- the consumed input. --- --- This parser requires the predicate to succeed on at least one byte --- of input: it will fail if the predicate never returns 'True' or if --- there is no input left. -takeWhile1 :: (Char -> Bool) -> Parser B.ByteString -takeWhile1 p = I.takeWhile1 (p . w2c) -{-# INLINE takeWhile1 #-} - --- | The parser @satisfy p@ succeeds for any byte for which the --- predicate @p@ returns 'True'. Returns the byte that is actually --- parsed. --- --- >digit = satisfy isDigit --- > where isDigit c = c >= '0' && c <= '9' -satisfy :: (Char -> Bool) -> Parser Char -satisfy = I.satisfyWith w2c -{-# INLINE satisfy #-} - --- | Match a letter, in the ISO-8859-15 encoding. -letter_iso8859_15 :: Parser Char -letter_iso8859_15 = satisfy isAlpha_iso8859_15 "letter_iso8859_15" -{-# INLINE letter_iso8859_15 #-} - --- | Match a letter, in the ASCII encoding. -letter_ascii :: Parser Char -letter_ascii = satisfy isAlpha_ascii "letter_ascii" -{-# INLINE letter_ascii #-} - --- | A fast alphabetic predicate for the ISO-8859-15 encoding --- --- /Note/: For all character encodings other than ISO-8859-15, and --- almost all Unicode code points above U+00A3, this predicate gives --- /wrong answers/. -isAlpha_iso8859_15 :: Char -> Bool -isAlpha_iso8859_15 c = (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z') || - (c >= '\166' && moby c) - where moby = notInClass "\167\169\171-\179\182\183\185\187\191\215\247" - {-# NOINLINE moby #-} -{-# INLINE isAlpha_iso8859_15 #-} - --- | A fast alphabetic predicate for the ASCII encoding --- --- /Note/: For all character encodings other than ASCII, and --- almost all Unicode code points above U+007F, this predicate gives --- /wrong answers/. -isAlpha_ascii :: Char -> Bool -isAlpha_ascii c = (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z') -{-# INLINE isAlpha_ascii #-} - --- | Parse a single digit. -digit :: Parser Char -digit = satisfy isDigit "digit" -{-# INLINE digit #-} - --- | A fast digit predicate. -isDigit :: Char -> Bool -isDigit c = c >= '0' && c <= '9' -{-# INLINE isDigit #-} - --- | A fast digit predicate. -isDigit_w8 :: Word8 -> Bool -isDigit_w8 w = w >= 48 && w <= 57 -{-# INLINE isDigit_w8 #-} - --- | Match any character. -anyChar :: Parser Char -anyChar = satisfy $ const True -{-# INLINE anyChar #-} - --- | Match any character, to perform lookahead. Returns 'Nothing' if --- end of input has been reached. Does not consume any input. --- --- /Note/: Because this parser does not fail, do not use it with --- combinators such as 'many', because such parsers loop until a --- failure occurs. Careless use will thus result in an infinite loop. -peekChar :: Parser (Maybe Char) -peekChar = (fmap w2c) `fmap` I.peekWord8 -{-# INLINE peekChar #-} - --- | Match any character, to perform lookahead. Does not consume any --- input, but will fail if end of input has been reached. -peekChar' :: Parser Char -peekChar' = w2c `fmap` I.peekWord8' -{-# INLINE peekChar' #-} - --- | Fast predicate for matching ASCII space characters. --- --- /Note/: This predicate only gives correct answers for the ASCII --- encoding. For instance, it does not recognise U+00A0 (non-breaking --- space) as a space character, even though it is a valid ISO-8859-15 --- byte. For a Unicode-aware and only slightly slower predicate, --- use 'Data.Char.isSpace' -isSpace :: Char -> Bool -isSpace c = (c == ' ') || ('\t' <= c && c <= '\r') -{-# INLINE isSpace #-} - --- | Fast 'Word8' predicate for matching ASCII space characters. -isSpace_w8 :: Word8 -> Bool -isSpace_w8 w = (w == 32) || (9 <= w && w <= 13) -{-# INLINE isSpace_w8 #-} - - --- | Parse a space character. --- --- /Note/: This parser only gives correct answers for the ASCII --- encoding. For instance, it does not recognise U+00A0 (non-breaking --- space) as a space character, even though it is a valid ISO-8859-15 --- byte. -space :: Parser Char -space = satisfy isSpace "space" -{-# INLINE space #-} - --- | Match a specific character. -char :: Char -> Parser Char -char c = satisfy (== c) [c] -{-# INLINE char #-} - --- | Match a specific character, but return its 'Word8' value. -char8 :: Char -> Parser Word8 -char8 c = I.satisfy (== c2w c) [c] -{-# INLINE char8 #-} - --- | Match any character except the given one. -notChar :: Char -> Parser Char -notChar c = satisfy (/= c) "not " ++ [c] -{-# INLINE notChar #-} - --- | Match any character in a set. --- --- >vowel = inClass "aeiou" --- --- Range notation is supported. --- --- >halfAlphabet = inClass "a-nA-N" --- --- To add a literal \'-\' to a set, place it at the beginning or end --- of the string. -inClass :: String -> Char -> Bool -inClass s = (`memberChar` mySet) - where mySet = charClass s -{-# INLINE inClass #-} - --- | Match any character not in a set. -notInClass :: String -> Char -> Bool -notInClass s = not . inClass s -{-# INLINE notInClass #-} - --- | Consume input as long as the predicate returns 'True', and return --- the consumed input. --- --- This parser does not fail. It will return an empty string if the --- predicate returns 'False' on the first byte of input. --- --- /Note/: Because this parser does not fail, do not use it with --- combinators such as 'many', because such parsers loop until a --- failure occurs. Careless use will thus result in an infinite loop. -takeWhile :: (Char -> Bool) -> Parser B.ByteString -takeWhile p = I.takeWhile (p . w2c) -{-# INLINE takeWhile #-} - --- | A stateful scanner. The predicate consumes and transforms a --- state argument, and each transformed state is passed to successive --- invocations of the predicate on each byte of the input until one --- returns 'Nothing' or the input ends. --- --- This parser does not fail. It will return an empty string if the --- predicate returns 'Nothing' on the first byte of input. --- --- /Note/: Because this parser does not fail, do not use it with --- combinators such as 'many', because such parsers loop until a --- failure occurs. Careless use will thus result in an infinite loop. -scan :: s -> (s -> Char -> Maybe s) -> Parser B.ByteString -scan s0 p = I.scan s0 (\s -> p s . w2c) -{-# INLINE scan #-} - --- | Consume input as long as the predicate returns 'False' --- (i.e. until it returns 'True'), and return the consumed input. --- --- This parser does not fail. It will return an empty string if the --- predicate returns 'True' on the first byte of input. --- --- /Note/: Because this parser does not fail, do not use it with --- combinators such as 'many', because such parsers loop until a --- failure occurs. Careless use will thus result in an infinite loop. -takeTill :: (Char -> Bool) -> Parser B.ByteString -takeTill p = I.takeTill (p . w2c) -{-# INLINE takeTill #-} - --- | Skip past input for as long as the predicate returns 'True'. -skipWhile :: (Char -> Bool) -> Parser () -skipWhile p = I.skipWhile (p . w2c) -{-# INLINE skipWhile #-} - --- | Skip over white space. -skipSpace :: Parser () -skipSpace = I.skipWhile isSpace_w8 -{-# INLINE skipSpace #-} - --- $specalt --- --- If you enable the @OverloadedStrings@ language extension, you can --- use the '*>' and '<*' combinators to simplify the common task of --- matching a statically known string, then immediately parsing --- something else. --- --- Instead of writing something like this: --- --- @ ---'I.string' \"foo\" '*>' wibble --- @ --- --- Using @OverloadedStrings@, you can omit the explicit use of --- 'I.string', and write a more compact version: --- --- @ --- \"foo\" '*>' wibble --- @ --- --- (Note: the '.*>' and '<*.' combinators that were originally --- provided for this purpose are obsolete and unnecessary, and will be --- removed in the next major version.) - --- | /Obsolete/. A type-specialized version of '*>' for --- 'B.ByteString'. Use '*>' instead. -(.*>) :: B.ByteString -> Parser a -> Parser a -s .*> f = I.string s *> f -{-# DEPRECATED (.*>) "This is no longer necessary, and will be removed. Use '*>' instead." #-} - --- | /Obsolete/. A type-specialized version of '<*' for --- 'B.ByteString'. Use '<*' instead. -(<*.) :: Parser a -> B.ByteString -> Parser a -f <*. s = f <* I.string s -{-# DEPRECATED (<*.) "This is no longer necessary, and will be removed. Use '<*' instead." #-} - --- | A predicate that matches either a carriage return @\'\\r\'@ or --- newline @\'\\n\'@ character. -isEndOfLine :: Word8 -> Bool -isEndOfLine w = w == 13 || w == 10 -{-# INLINE isEndOfLine #-} - --- | A predicate that matches either a space @\' \'@ or horizontal tab --- @\'\\t\'@ character. -isHorizontalSpace :: Word8 -> Bool -isHorizontalSpace w = w == 32 || w == 9 -{-# INLINE isHorizontalSpace #-} - --- | Parse and decode an unsigned hexadecimal number. The hex digits --- @\'a\'@ through @\'f\'@ may be upper or lower case. --- --- This parser does not accept a leading @\"0x\"@ string. -hexadecimal :: (Integral a, Bits a) => Parser a -hexadecimal = B8.foldl' step 0 `fmap` I.takeWhile1 isHexDigit - where - isHexDigit w = (w >= 48 && w <= 57) || - (w >= 97 && w <= 102) || - (w >= 65 && w <= 70) - step a w | w >= 48 && w <= 57 = (a `shiftL` 4) .|. fromIntegral (w - 48) - | w >= 97 = (a `shiftL` 4) .|. fromIntegral (w - 87) - | otherwise = (a `shiftL` 4) .|. fromIntegral (w - 55) -{-# SPECIALISE hexadecimal :: Parser Int #-} -{-# SPECIALISE hexadecimal :: Parser Int8 #-} -{-# SPECIALISE hexadecimal :: Parser Int16 #-} -{-# SPECIALISE hexadecimal :: Parser Int32 #-} -{-# SPECIALISE hexadecimal :: Parser Int64 #-} -{-# SPECIALISE hexadecimal :: Parser Integer #-} -{-# SPECIALISE hexadecimal :: Parser Word #-} -{-# SPECIALISE hexadecimal :: Parser Word8 #-} -{-# SPECIALISE hexadecimal :: Parser Word16 #-} -{-# SPECIALISE hexadecimal :: Parser Word32 #-} -{-# SPECIALISE hexadecimal :: Parser Word64 #-} - --- | Parse and decode an unsigned decimal number. -decimal :: Integral a => Parser a -decimal = B8.foldl' step 0 `fmap` I.takeWhile1 isDig - where isDig w = w >= 48 && w <= 57 - step a w = a * 10 + fromIntegral (w - 48) -{-# SPECIALISE decimal :: Parser Int #-} -{-# SPECIALISE decimal :: Parser Int8 #-} -{-# SPECIALISE decimal :: Parser Int16 #-} -{-# SPECIALISE decimal :: Parser Int32 #-} -{-# SPECIALISE decimal :: Parser Int64 #-} -{-# SPECIALISE decimal :: Parser Integer #-} -{-# SPECIALISE decimal :: Parser Word #-} -{-# SPECIALISE decimal :: Parser Word8 #-} -{-# SPECIALISE decimal :: Parser Word16 #-} -{-# SPECIALISE decimal :: Parser Word32 #-} -{-# SPECIALISE decimal :: Parser Word64 #-} - --- | Parse a number with an optional leading @\'+\'@ or @\'-\'@ sign --- character. -signed :: Num a => Parser a -> Parser a -{-# SPECIALISE signed :: Parser Int -> Parser Int #-} -{-# SPECIALISE signed :: Parser Int8 -> Parser Int8 #-} -{-# SPECIALISE signed :: Parser Int16 -> Parser Int16 #-} -{-# SPECIALISE signed :: Parser Int32 -> Parser Int32 #-} -{-# SPECIALISE signed :: Parser Int64 -> Parser Int64 #-} -{-# SPECIALISE signed :: Parser Integer -> Parser Integer #-} -signed p = (negate <$> (char8 '-' *> p)) - <|> (char8 '+' *> p) - <|> p diff --git a/haddock-library/vendor/attoparsec-0.12.1.1/Data/Attoparsec/ByteString/FastSet.hs b/haddock-library/vendor/attoparsec-0.12.1.1/Data/Attoparsec/ByteString/FastSet.hs deleted file mode 100644 index cb615167..00000000 --- a/haddock-library/vendor/attoparsec-0.12.1.1/Data/Attoparsec/ByteString/FastSet.hs +++ /dev/null @@ -1,115 +0,0 @@ -{-# LANGUAGE BangPatterns, MagicHash #-} - ------------------------------------------------------------------------------ --- | --- Module : Data.Attoparsec.ByteString.FastSet --- Copyright : Bryan O'Sullivan 2007-2014 --- License : BSD3 --- --- Maintainer : bos@serpentine.com --- Stability : experimental --- Portability : unknown --- --- Fast set membership tests for 'Word8' and 8-bit 'Char' values. The --- set representation is unboxed for efficiency. For small sets, we --- test for membership using a binary search. For larger sets, we use --- a lookup table. --- ------------------------------------------------------------------------------ -module Data.Attoparsec.ByteString.FastSet - ( - -- * Data type - FastSet - -- * Construction - , fromList - , set - -- * Lookup - , memberChar - , memberWord8 - -- * Debugging - , fromSet - -- * Handy interface - , charClass - ) where - -import Data.Bits ((.&.), (.|.)) -import Foreign.Storable (peekByteOff, pokeByteOff) -import GHC.Base (Int(I#), iShiftRA#, narrow8Word#, shiftL#) -import GHC.Word (Word8(W8#)) -import qualified Data.ByteString as B -import qualified Data.ByteString.Char8 as B8 -import qualified Data.ByteString.Internal as I -import qualified Data.ByteString.Unsafe as U - -data FastSet = Sorted { fromSet :: !B.ByteString } - | Table { fromSet :: !B.ByteString } - deriving (Eq, Ord) - -instance Show FastSet where - show (Sorted s) = "FastSet Sorted " ++ show (B8.unpack s) - show (Table _) = "FastSet Table" - --- | The lower bound on the size of a lookup table. We choose this to --- balance table density against performance. -tableCutoff :: Int -tableCutoff = 8 - --- | Create a set. -set :: B.ByteString -> FastSet -set s | B.length s < tableCutoff = Sorted . B.sort $ s - | otherwise = Table . mkTable $ s - -fromList :: [Word8] -> FastSet -fromList = set . B.pack - -data I = I {-# UNPACK #-} !Int {-# UNPACK #-} !Word8 - -shiftR :: Int -> Int -> Int -shiftR (I# x#) (I# i#) = I# (x# `iShiftRA#` i#) - -shiftL :: Word8 -> Int -> Word8 -shiftL (W8# x#) (I# i#) = W8# (narrow8Word# (x# `shiftL#` i#)) - -index :: Int -> I -index i = I (i `shiftR` 3) (1 `shiftL` (i .&. 7)) -{-# INLINE index #-} - --- | Check the set for membership. -memberWord8 :: Word8 -> FastSet -> Bool -memberWord8 w (Table t) = - let I byte bit = index (fromIntegral w) - in U.unsafeIndex t byte .&. bit /= 0 -memberWord8 w (Sorted s) = search 0 (B.length s - 1) - where search lo hi - | hi < lo = False - | otherwise = - let mid = (lo + hi) `quot` 2 - in case compare w (U.unsafeIndex s mid) of - GT -> search (mid + 1) hi - LT -> search lo (mid - 1) - _ -> True - --- | Check the set for membership. Only works with 8-bit characters: --- characters above code point 255 will give wrong answers. -memberChar :: Char -> FastSet -> Bool -memberChar c = memberWord8 (I.c2w c) -{-# INLINE memberChar #-} - -mkTable :: B.ByteString -> B.ByteString -mkTable s = I.unsafeCreate 32 $ \t -> do - _ <- I.memset t 0 32 - U.unsafeUseAsCStringLen s $ \(p, l) -> - let loop n | n == l = return () - | otherwise = do - c <- peekByteOff p n :: IO Word8 - let I byte bit = index (fromIntegral c) - prev <- peekByteOff t byte :: IO Word8 - pokeByteOff t byte (prev .|. bit) - loop (n + 1) - in loop 0 - -charClass :: String -> FastSet -charClass = set . B8.pack . go - where go (a:'-':b:xs) = [a..b] ++ go xs - go (x:xs) = x : go xs - go _ = "" diff --git a/haddock-library/vendor/attoparsec-0.12.1.1/Data/Attoparsec/ByteString/Internal.hs b/haddock-library/vendor/attoparsec-0.12.1.1/Data/Attoparsec/ByteString/Internal.hs deleted file mode 100644 index f6ec3b32..00000000 --- a/haddock-library/vendor/attoparsec-0.12.1.1/Data/Attoparsec/ByteString/Internal.hs +++ /dev/null @@ -1,485 +0,0 @@ -{-# LANGUAGE BangPatterns, GADTs, OverloadedStrings, RecordWildCards #-} --- | --- Module : Data.Attoparsec.ByteString.Internal --- Copyright : Bryan O'Sullivan 2007-2014 --- License : BSD3 --- --- Maintainer : bos@serpentine.com --- Stability : experimental --- Portability : unknown --- --- Simple, efficient parser combinators for 'ByteString' strings, --- loosely based on the Parsec library. - -module Data.Attoparsec.ByteString.Internal - ( - -- * Parser types - Parser - , Result - - -- * Running parsers - , parse - , parseOnly - - -- * Combinators - , module Data.Attoparsec.Combinator - - -- * Parsing individual bytes - , satisfy - , satisfyWith - , anyWord8 - , skip - , word8 - , notWord8 - - -- ** Lookahead - , peekWord8 - , peekWord8' - - -- ** Byte classes - , inClass - , notInClass - - -- * Parsing more complicated structures - , storable - - -- * Efficient string handling - , skipWhile - , string - , stringTransform - , take - , scan - , runScanner - , takeWhile - , takeWhile1 - , takeTill - - -- ** Consume all remaining input - , takeByteString - , takeLazyByteString - - -- * Utilities - , endOfLine - , endOfInput - , match - , atEnd - ) where - -import Control.Applicative ((<|>), (<$>)) -import Control.Monad (when) -import Data.Attoparsec.ByteString.Buffer (Buffer, buffer) -import Data.Attoparsec.ByteString.FastSet (charClass, memberWord8) -import Data.Attoparsec.Combinator (()) -import Data.Attoparsec.Internal -import Data.Attoparsec.Internal.Fhthagn (inlinePerformIO) -import Data.Attoparsec.Internal.Types hiding (Parser, Failure, Success) -import Data.ByteString (ByteString) -import Data.Word (Word8) -import Foreign.ForeignPtr (withForeignPtr) -import Foreign.Ptr (castPtr, minusPtr, plusPtr) -import Foreign.Storable (Storable(peek, sizeOf)) -import Prelude hiding (getChar, succ, take, takeWhile) -import qualified Data.Attoparsec.ByteString.Buffer as Buf -import qualified Data.Attoparsec.Internal.Types as T -import qualified Data.ByteString as B8 -import qualified Data.ByteString.Char8 as B -import qualified Data.ByteString.Internal as B -import qualified Data.ByteString.Lazy as L -import qualified Data.ByteString.Unsafe as B - -type Parser = T.Parser ByteString -type Result = IResult ByteString -type Failure r = T.Failure ByteString Buffer r -type Success a r = T.Success ByteString Buffer a r - --- | The parser @satisfy p@ succeeds for any byte for which the --- predicate @p@ returns 'True'. Returns the byte that is actually --- parsed. --- --- >digit = satisfy isDigit --- > where isDigit w = w >= 48 && w <= 57 -satisfy :: (Word8 -> Bool) -> Parser Word8 -satisfy p = do - h <- peekWord8' - if p h - then advance 1 >> return h - else fail "satisfy" -{-# INLINE satisfy #-} - --- | The parser @skip p@ succeeds for any byte for which the predicate --- @p@ returns 'True'. --- --- >skipDigit = skip isDigit --- > where isDigit w = w >= 48 && w <= 57 -skip :: (Word8 -> Bool) -> Parser () -skip p = do - h <- peekWord8' - if p h - then advance 1 - else fail "skip" - --- | The parser @satisfyWith f p@ transforms a byte, and succeeds if --- the predicate @p@ returns 'True' on the transformed value. The --- parser returns the transformed byte that was parsed. -satisfyWith :: (Word8 -> a) -> (a -> Bool) -> Parser a -satisfyWith f p = do - h <- peekWord8' - let c = f h - if p c - then advance 1 >> return c - else fail "satisfyWith" -{-# INLINE satisfyWith #-} - -storable :: Storable a => Parser a -storable = hack undefined - where - hack :: Storable b => b -> Parser b - hack dummy = do - (fp,o,_) <- B.toForeignPtr `fmap` take (sizeOf dummy) - return . B.inlinePerformIO . withForeignPtr fp $ \p -> - peek (castPtr $ p `plusPtr` o) - --- | Consume @n@ bytes of input, but succeed only if the predicate --- returns 'True'. -takeWith :: Int -> (ByteString -> Bool) -> Parser ByteString -takeWith n0 p = do - let n = max n0 0 - s <- ensure n - if p s - then advance n >> return s - else fail "takeWith" - --- | Consume exactly @n@ bytes of input. -take :: Int -> Parser ByteString -take n = takeWith n (const True) -{-# INLINE take #-} - --- | @string s@ parses a sequence of bytes that identically match --- @s@. Returns the parsed string (i.e. @s@). This parser consumes no --- input if it fails (even if a partial match). --- --- /Note/: The behaviour of this parser is different to that of the --- similarly-named parser in Parsec, as this one is all-or-nothing. --- To illustrate the difference, the following parser will fail under --- Parsec given an input of @\"for\"@: --- --- >string "foo" <|> string "for" --- --- The reason for its failure is that the first branch is a --- partial match, and will consume the letters @\'f\'@ and @\'o\'@ --- before failing. In attoparsec, the above parser will /succeed/ on --- that input, because the failed first branch will consume nothing. -string :: ByteString -> Parser ByteString -string s = takeWith (B.length s) (==s) -{-# INLINE string #-} - -stringTransform :: (ByteString -> ByteString) -> ByteString - -> Parser ByteString -stringTransform f s = takeWith (B.length s) ((==f s) . f) -{-# INLINE stringTransform #-} - --- | Skip past input for as long as the predicate returns 'True'. -skipWhile :: (Word8 -> Bool) -> Parser () -skipWhile p = go - where - go = do - t <- B8.takeWhile p <$> get - continue <- inputSpansChunks (B.length t) - when continue go -{-# INLINE skipWhile #-} - --- | Consume input as long as the predicate returns 'False' --- (i.e. until it returns 'True'), and return the consumed input. --- --- This parser does not fail. It will return an empty string if the --- predicate returns 'True' on the first byte of input. --- --- /Note/: Because this parser does not fail, do not use it with --- combinators such as 'Control.Applicative.many', because such --- parsers loop until a failure occurs. Careless use will thus result --- in an infinite loop. -takeTill :: (Word8 -> Bool) -> Parser ByteString -takeTill p = takeWhile (not . p) -{-# INLINE takeTill #-} - --- | Consume input as long as the predicate returns 'True', and return --- the consumed input. --- --- This parser does not fail. It will return an empty string if the --- predicate returns 'False' on the first byte of input. --- --- /Note/: Because this parser does not fail, do not use it with --- combinators such as 'Control.Applicative.many', because such --- parsers loop until a failure occurs. Careless use will thus result --- in an infinite loop. -takeWhile :: (Word8 -> Bool) -> Parser ByteString -takeWhile p = (B.concat . reverse) `fmap` go [] - where - go acc = do - s <- B8.takeWhile p <$> get - continue <- inputSpansChunks (B.length s) - if continue - then go (s:acc) - else return (s:acc) -{-# INLINE takeWhile #-} - -takeRest :: Parser [ByteString] -takeRest = go [] - where - go acc = do - input <- wantInput - if input - then do - s <- get - advance (B.length s) - go (s:acc) - else return (reverse acc) - --- | Consume all remaining input and return it as a single string. -takeByteString :: Parser ByteString -takeByteString = B.concat `fmap` takeRest - --- | Consume all remaining input and return it as a single string. -takeLazyByteString :: Parser L.ByteString -takeLazyByteString = L.fromChunks `fmap` takeRest - -data T s = T {-# UNPACK #-} !Int s - -scan_ :: (s -> [ByteString] -> Parser r) -> s -> (s -> Word8 -> Maybe s) - -> Parser r -scan_ f s0 p = go [] s0 - where - go acc s1 = do - let scanner (B.PS fp off len) = - withForeignPtr fp $ \ptr0 -> do - let start = ptr0 `plusPtr` off - end = start `plusPtr` len - inner ptr !s - | ptr < end = do - w <- peek ptr - case p s w of - Just s' -> inner (ptr `plusPtr` 1) s' - _ -> done (ptr `minusPtr` start) s - | otherwise = done (ptr `minusPtr` start) s - done !i !s = return (T i s) - inner start s1 - bs <- get - let T i s' = inlinePerformIO $ scanner bs - !h = B.unsafeTake i bs - continue <- inputSpansChunks i - if continue - then go (h:acc) s' - else f s' (h:acc) -{-# INLINE scan_ #-} - --- | A stateful scanner. The predicate consumes and transforms a --- state argument, and each transformed state is passed to successive --- invocations of the predicate on each byte of the input until one --- returns 'Nothing' or the input ends. --- --- This parser does not fail. It will return an empty string if the --- predicate returns 'Nothing' on the first byte of input. --- --- /Note/: Because this parser does not fail, do not use it with --- combinators such as 'Control.Applicative.many', because such --- parsers loop until a failure occurs. Careless use will thus result --- in an infinite loop. -scan :: s -> (s -> Word8 -> Maybe s) -> Parser ByteString -scan = scan_ $ \_ chunks -> - case chunks of - [x] -> return x - xs -> return $! B.concat $ reverse xs -{-# INLINE scan #-} - --- | Like 'scan', but generalized to return the final state of the --- scanner. -runScanner :: s -> (s -> Word8 -> Maybe s) -> Parser (ByteString, s) -runScanner = scan_ $ \s xs -> return (B.concat (reverse xs), s) -{-# INLINE runScanner #-} - --- | Consume input as long as the predicate returns 'True', and return --- the consumed input. --- --- This parser requires the predicate to succeed on at least one byte --- of input: it will fail if the predicate never returns 'True' or if --- there is no input left. -takeWhile1 :: (Word8 -> Bool) -> Parser ByteString -takeWhile1 p = do - (`when` demandInput) =<< endOfChunk - s <- B8.takeWhile p <$> get - let len = B.length s - if len == 0 - then fail "takeWhile1" - else do - advance len - eoc <- endOfChunk - if eoc - then (s<>) `fmap` takeWhile p - else return s - --- | Match any byte in a set. --- --- >vowel = inClass "aeiou" --- --- Range notation is supported. --- --- >halfAlphabet = inClass "a-nA-N" --- --- To add a literal @\'-\'@ to a set, place it at the beginning or end --- of the string. -inClass :: String -> Word8 -> Bool -inClass s = (`memberWord8` mySet) - where mySet = charClass s - {-# NOINLINE mySet #-} -{-# INLINE inClass #-} - --- | Match any byte not in a set. -notInClass :: String -> Word8 -> Bool -notInClass s = not . inClass s -{-# INLINE notInClass #-} - --- | Match any byte. -anyWord8 :: Parser Word8 -anyWord8 = satisfy $ const True -{-# INLINE anyWord8 #-} - --- | Match a specific byte. -word8 :: Word8 -> Parser Word8 -word8 c = satisfy (== c) show c -{-# INLINE word8 #-} - --- | Match any byte except the given one. -notWord8 :: Word8 -> Parser Word8 -notWord8 c = satisfy (/= c) "not " ++ show c -{-# INLINE notWord8 #-} - --- | Match any byte, to perform lookahead. Returns 'Nothing' if end of --- input has been reached. Does not consume any input. --- --- /Note/: Because this parser does not fail, do not use it with --- combinators such as 'Control.Applicative.many', because such --- parsers loop until a failure occurs. Careless use will thus result --- in an infinite loop. -peekWord8 :: Parser (Maybe Word8) -peekWord8 = T.Parser $ \t pos@(Pos pos_) more _lose succ -> - case () of - _| pos_ < Buf.length t -> - let !w = Buf.unsafeIndex t pos_ - in succ t pos more (Just w) - | more == Complete -> - succ t pos more Nothing - | otherwise -> - let succ' t' pos' more' = let !w = Buf.unsafeIndex t' pos_ - in succ t' pos' more' (Just w) - lose' t' pos' more' = succ t' pos' more' Nothing - in prompt t pos more lose' succ' -{-# INLINE peekWord8 #-} - --- | Match any byte, to perform lookahead. Does not consume any --- input, but will fail if end of input has been reached. -peekWord8' :: Parser Word8 -peekWord8' = T.Parser $ \t pos more lose succ -> - if lengthAtLeast pos 1 t - then succ t pos more (Buf.unsafeIndex t (fromPos pos)) - else let succ' t' pos' more' bs' = succ t' pos' more' $! B.unsafeHead bs' - in ensureSuspended 1 t pos more lose succ' -{-# INLINE peekWord8' #-} - --- | Match either a single newline character @\'\\n\'@, or a carriage --- return followed by a newline character @\"\\r\\n\"@. -endOfLine :: Parser () -endOfLine = (word8 10 >> return ()) <|> (string "\r\n" >> return ()) - --- | Terminal failure continuation. -failK :: Failure a -failK t (Pos pos) _more stack msg = Fail (Buf.unsafeDrop pos t) stack msg -{-# INLINE failK #-} - --- | Terminal success continuation. -successK :: Success a a -successK t (Pos pos) _more a = Done (Buf.unsafeDrop pos t) a -{-# INLINE successK #-} - --- | Run a parser. -parse :: Parser a -> ByteString -> Result a -parse m s = T.runParser m (buffer s) (Pos 0) Incomplete failK successK -{-# INLINE parse #-} - --- | Run a parser that cannot be resupplied via a 'Partial' result. --- --- This function does not force a parser to consume all of its input. --- Instead, any residual input will be discarded. To force a parser --- to consume all of its input, use something like this: --- --- @ ---'parseOnly' (myParser 'Control.Applicative.<*' 'endOfInput') --- @ -parseOnly :: Parser a -> ByteString -> Either String a -parseOnly m s = case T.runParser m (buffer s) (Pos 0) Complete failK successK of - Fail _ _ err -> Left err - Done _ a -> Right a - _ -> error "parseOnly: impossible error!" -{-# INLINE parseOnly #-} - -get :: Parser ByteString -get = T.Parser $ \t pos more _lose succ -> - succ t pos more (Buf.unsafeDrop (fromPos pos) t) -{-# INLINE get #-} - -endOfChunk :: Parser Bool -endOfChunk = T.Parser $ \t pos more _lose succ -> - succ t pos more (fromPos pos == Buf.length t) -{-# INLINE endOfChunk #-} - -inputSpansChunks :: Int -> Parser Bool -inputSpansChunks i = T.Parser $ \t pos_ more _lose succ -> - let pos = pos_ + Pos i - in if fromPos pos < Buf.length t || more == Complete - then succ t pos more False - else let lose' t' pos' more' = succ t' pos' more' False - succ' t' pos' more' = succ t' pos' more' True - in prompt t pos more lose' succ' -{-# INLINE inputSpansChunks #-} - -advance :: Int -> Parser () -advance n = T.Parser $ \t pos more _lose succ -> - succ t (pos + Pos n) more () -{-# INLINE advance #-} - -ensureSuspended :: Int -> Buffer -> Pos -> More - -> Failure r - -> Success ByteString r - -> Result r -ensureSuspended n t pos more lose succ = - runParser (demandInput >> go) t pos more lose succ - where go = T.Parser $ \t' pos' more' lose' succ' -> - if lengthAtLeast pos' n t' - then succ' t' pos' more' (substring pos (Pos n) t') - else runParser (demandInput >> go) t' pos' more' lose' succ' - --- | If at least @n@ elements of input are available, return the --- current input, otherwise fail. -ensure :: Int -> Parser ByteString -ensure n = T.Parser $ \t pos more lose succ -> - if lengthAtLeast pos n t - then succ t pos more (substring pos (Pos n) t) - -- The uncommon case is kept out-of-line to reduce code size: - else ensureSuspended n t pos more lose succ --- Non-recursive so the bounds check can be inlined: -{-# INLINE ensure #-} - --- | Return both the result of a parse and the portion of the input --- that was consumed while it was being parsed. -match :: Parser a -> Parser (ByteString, a) -match p = T.Parser $ \t pos more lose succ -> - let succ' t' pos' more' a = - succ t' pos' more' (substring pos (pos'-pos) t', a) - in runParser p t pos more lose succ' - -lengthAtLeast :: Pos -> Int -> Buffer -> Bool -lengthAtLeast (Pos pos) n bs = Buf.length bs >= pos + n -{-# INLINE lengthAtLeast #-} - -substring :: Pos -> Pos -> Buffer -> ByteString -substring (Pos pos) (Pos n) = Buf.substring pos n -{-# INLINE substring #-} diff --git a/haddock-library/vendor/attoparsec-0.12.1.1/Data/Attoparsec/Combinator.hs b/haddock-library/vendor/attoparsec-0.12.1.1/Data/Attoparsec/Combinator.hs deleted file mode 100644 index 65788ce9..00000000 --- a/haddock-library/vendor/attoparsec-0.12.1.1/Data/Attoparsec/Combinator.hs +++ /dev/null @@ -1,220 +0,0 @@ -{-# LANGUAGE BangPatterns #-} --- | --- Module : Data.Attoparsec.Combinator --- Copyright : Daan Leijen 1999-2001, Bryan O'Sullivan 2007-2014 --- License : BSD3 --- --- Maintainer : bos@serpentine.com --- Stability : experimental --- Portability : portable --- --- Useful parser combinators, similar to those provided by Parsec. -module Data.Attoparsec.Combinator - ( - -- * Combinators - try - , () - , choice - , count - , option - , many' - , many1 - , many1' - , manyTill - , manyTill' - , sepBy - , sepBy' - , sepBy1 - , sepBy1' - , skipMany - , skipMany1 - , eitherP - , feed - , satisfyElem - , endOfInput - , atEnd - ) where - -import Control.Applicative (Alternative(..), Applicative(..), empty, liftA2, - many, (<|>), (*>), (<$>)) -import Control.Monad (MonadPlus(..)) -import Data.Attoparsec.Internal.Types (Parser(..), IResult(..)) -import Data.Attoparsec.Internal (endOfInput, atEnd, satisfyElem) -import Data.ByteString (ByteString) -import Data.Monoid (Monoid(mappend)) -import Prelude hiding (succ) - --- | Attempt a parse, and if it fails, rewind the input so that no --- input appears to have been consumed. --- --- This combinator is provided for compatibility with Parsec. --- attoparsec parsers always backtrack on failure. -try :: Parser i a -> Parser i a -try p = p -{-# INLINE try #-} - --- | Name the parser, in case failure occurs. -() :: Parser i a - -> String -- ^ the name to use if parsing fails - -> Parser i a -p msg0 = Parser $ \t pos more lose succ -> - let lose' t' pos' more' strs msg = lose t' pos' more' (msg0:strs) msg - in runParser p t pos more lose' succ -{-# INLINE () #-} -infix 0 - --- | @choice ps@ tries to apply the actions in the list @ps@ in order, --- until one of them succeeds. Returns the value of the succeeding --- action. -choice :: Alternative f => [f a] -> f a -choice = foldr (<|>) empty -{-# SPECIALIZE choice :: [Parser ByteString a] - -> Parser ByteString a #-} - --- | @option x p@ tries to apply action @p@. If @p@ fails without --- consuming input, it returns the value @x@, otherwise the value --- returned by @p@. --- --- > priority = option 0 (digitToInt <$> digit) -option :: Alternative f => a -> f a -> f a -option x p = p <|> pure x -{-# SPECIALIZE option :: a -> Parser ByteString a -> Parser ByteString a #-} - --- | A version of 'liftM2' that is strict in the result of its first --- action. -liftM2' :: (Monad m) => (a -> b -> c) -> m a -> m b -> m c -liftM2' f a b = do - !x <- a - y <- b - return (f x y) -{-# INLINE liftM2' #-} - --- | @many' p@ applies the action @p@ /zero/ or more times. Returns a --- list of the returned values of @p@. The value returned by @p@ is --- forced to WHNF. --- --- > word = many' letter -many' :: (MonadPlus m) => m a -> m [a] -many' p = many_p - where many_p = some_p `mplus` return [] - some_p = liftM2' (:) p many_p -{-# INLINE many' #-} - --- | @many1 p@ applies the action @p@ /one/ or more times. Returns a --- list of the returned values of @p@. --- --- > word = many1 letter -many1 :: Alternative f => f a -> f [a] -many1 p = liftA2 (:) p (many p) -{-# INLINE many1 #-} - --- | @many1' p@ applies the action @p@ /one/ or more times. Returns a --- list of the returned values of @p@. The value returned by @p@ is --- forced to WHNF. --- --- > word = many1' letter -many1' :: (MonadPlus m) => m a -> m [a] -many1' p = liftM2' (:) p (many' p) -{-# INLINE many1' #-} - --- | @sepBy p sep@ applies /zero/ or more occurrences of @p@, separated --- by @sep@. Returns a list of the values returned by @p@. --- --- > commaSep p = p `sepBy` (symbol ",") -sepBy :: Alternative f => f a -> f s -> f [a] -sepBy p s = liftA2 (:) p ((s *> sepBy1 p s) <|> pure []) <|> pure [] -{-# SPECIALIZE sepBy :: Parser ByteString a -> Parser ByteString s - -> Parser ByteString [a] #-} - --- | @sepBy' p sep@ applies /zero/ or more occurrences of @p@, separated --- by @sep@. Returns a list of the values returned by @p@. The value --- returned by @p@ is forced to WHNF. --- --- > commaSep p = p `sepBy'` (symbol ",") -sepBy' :: (MonadPlus m) => m a -> m s -> m [a] -sepBy' p s = scan `mplus` return [] - where scan = liftM2' (:) p ((s >> sepBy1' p s) `mplus` return []) -{-# SPECIALIZE sepBy' :: Parser ByteString a -> Parser ByteString s - -> Parser ByteString [a] #-} - --- | @sepBy1 p sep@ applies /one/ or more occurrences of @p@, separated --- by @sep@. Returns a list of the values returned by @p@. --- --- > commaSep p = p `sepBy1` (symbol ",") -sepBy1 :: Alternative f => f a -> f s -> f [a] -sepBy1 p s = scan - where scan = liftA2 (:) p ((s *> scan) <|> pure []) -{-# SPECIALIZE sepBy1 :: Parser ByteString a -> Parser ByteString s - -> Parser ByteString [a] #-} - --- | @sepBy1' p sep@ applies /one/ or more occurrences of @p@, separated --- by @sep@. Returns a list of the values returned by @p@. The value --- returned by @p@ is forced to WHNF. --- --- > commaSep p = p `sepBy1'` (symbol ",") -sepBy1' :: (MonadPlus m) => m a -> m s -> m [a] -sepBy1' p s = scan - where scan = liftM2' (:) p ((s >> scan) `mplus` return []) -{-# SPECIALIZE sepBy1' :: Parser ByteString a -> Parser ByteString s - -> Parser ByteString [a] #-} - --- | @manyTill p end@ applies action @p@ /zero/ or more times until --- action @end@ succeeds, and returns the list of values returned by --- @p@. This can be used to scan comments: --- --- > simpleComment = string "") --- --- (Note the overlapping parsers @anyChar@ and @string \"-->\"@. --- While this will work, it is not very efficient, as it will cause a --- lot of backtracking.) -manyTill :: Alternative f => f a -> f b -> f [a] -manyTill p end = scan - where scan = (end *> pure []) <|> liftA2 (:) p scan -{-# SPECIALIZE manyTill :: Parser ByteString a -> Parser ByteString b - -> Parser ByteString [a] #-} - --- | @manyTill' p end@ applies action @p@ /zero/ or more times until --- action @end@ succeeds, and returns the list of values returned by --- @p@. This can be used to scan comments: --- --- > simpleComment = string "") --- --- (Note the overlapping parsers @anyChar@ and @string \"-->\"@. --- While this will work, it is not very efficient, as it will cause a --- lot of backtracking.) --- --- The value returned by @p@ is forced to WHNF. -manyTill' :: (MonadPlus m) => m a -> m b -> m [a] -manyTill' p end = scan - where scan = (end >> return []) `mplus` liftM2' (:) p scan -{-# SPECIALIZE manyTill' :: Parser ByteString a -> Parser ByteString b - -> Parser ByteString [a] #-} - --- | Skip zero or more instances of an action. -skipMany :: Alternative f => f a -> f () -skipMany p = scan - where scan = (p *> scan) <|> pure () -{-# SPECIALIZE skipMany :: Parser ByteString a -> Parser ByteString () #-} - --- | Skip one or more instances of an action. -skipMany1 :: Alternative f => f a -> f () -skipMany1 p = p *> skipMany p -{-# SPECIALIZE skipMany1 :: Parser ByteString a -> Parser ByteString () #-} - --- | Apply the given action repeatedly, returning every result. -count :: Monad m => Int -> m a -> m [a] -count n p = sequence (replicate n p) -{-# INLINE count #-} - --- | Combine two alternatives. -eitherP :: (Alternative f) => f a -> f b -> f (Either a b) -eitherP a b = (Left <$> a) <|> (Right <$> b) -{-# INLINE eitherP #-} - --- | If a parser has returned a 'T.Partial' result, supply it with more --- input. -feed :: Monoid i => IResult i r -> i -> IResult i r -feed f@(Fail _ _ _) _ = f -feed (Partial k) d = k d -feed (Done t r) d = Done (mappend t d) r -{-# INLINE feed #-} diff --git a/haddock-library/vendor/attoparsec-0.12.1.1/Data/Attoparsec/Internal.hs b/haddock-library/vendor/attoparsec-0.12.1.1/Data/Attoparsec/Internal.hs deleted file mode 100644 index 371770a9..00000000 --- a/haddock-library/vendor/attoparsec-0.12.1.1/Data/Attoparsec/Internal.hs +++ /dev/null @@ -1,142 +0,0 @@ -{-# LANGUAGE CPP, BangPatterns, ScopedTypeVariables #-} --- | --- Module : Data.Attoparsec.Internal --- Copyright : Bryan O'Sullivan 2007-2014 --- License : BSD3 --- --- Maintainer : bos@serpentine.com --- Stability : experimental --- Portability : unknown --- --- Simple, efficient parser combinators, loosely based on the Parsec --- library. - -module Data.Attoparsec.Internal - ( compareResults - , prompt - , demandInput - , wantInput - , endOfInput - , atEnd - , satisfyElem - ) where - -import Control.Applicative ((<$>)) -#if __GLASGOW_HASKELL__ >= 700 -import Data.ByteString (ByteString) -#endif -import Data.Attoparsec.Internal.Types -import Prelude hiding (succ) - --- | Compare two 'IResult' values for equality. --- --- If both 'IResult's are 'Partial', the result will be 'Nothing', as --- they are incomplete and hence their equality cannot be known. --- (This is why there is no 'Eq' instance for 'IResult'.) -compareResults :: (Eq i, Eq r) => IResult i r -> IResult i r -> Maybe Bool -compareResults (Fail t0 ctxs0 msg0) (Fail t1 ctxs1 msg1) = - Just (t0 == t1 && ctxs0 == ctxs1 && msg0 == msg1) -compareResults (Done t0 r0) (Done t1 r1) = - Just (t0 == t1 && r0 == r1) -compareResults (Partial _) (Partial _) = Nothing -compareResults _ _ = Just False - --- | Ask for input. If we receive any, pass it to a success --- continuation, otherwise to a failure continuation. -prompt :: Chunk t - => State t -> Pos -> More - -> (State t -> Pos -> More -> IResult t r) - -> (State t -> Pos -> More -> IResult t r) - -> IResult t r -prompt t pos _more lose succ = Partial $ \s -> - if nullChunk s - then lose t pos Complete - else succ (pappendChunk t s) pos Incomplete -#if __GLASGOW_HASKELL__ >= 700 -{-# SPECIALIZE prompt :: State ByteString -> Pos -> More - -> (State ByteString -> Pos -> More - -> IResult ByteString r) - -> (State ByteString -> Pos -> More - -> IResult ByteString r) - -> IResult ByteString r #-} -#endif - --- | Immediately demand more input via a 'Partial' continuation --- result. -demandInput :: Chunk t => Parser t () -demandInput = Parser $ \t pos more lose succ -> - case more of - Complete -> lose t pos more [] "not enough input" - _ -> let lose' t' pos' more' = lose t' pos' more' [] "not enough input" - succ' t' pos' more' = succ t' pos' more' () - in prompt t pos more lose' succ' -#if __GLASGOW_HASKELL__ >= 700 -{-# SPECIALIZE demandInput :: Parser ByteString () #-} -#endif - --- | This parser always succeeds. It returns 'True' if any input is --- available either immediately or on demand, and 'False' if the end --- of all input has been reached. -wantInput :: forall t . Chunk t => Parser t Bool -wantInput = Parser $ \t pos more _lose succ -> - case () of - _ | pos < atBufferEnd (undefined :: t) t -> succ t pos more True - | more == Complete -> succ t pos more False - | otherwise -> let lose' t' pos' more' = succ t' pos' more' False - succ' t' pos' more' = succ t' pos' more' True - in prompt t pos more lose' succ' -{-# INLINE wantInput #-} - --- | Match only if all input has been consumed. -endOfInput :: forall t . Chunk t => Parser t () -endOfInput = Parser $ \t pos more lose succ -> - case () of - _| pos < atBufferEnd (undefined :: t) t -> lose t pos more [] "endOfInput" - | more == Complete -> succ t pos more () - | otherwise -> - let lose' t' pos' more' _ctx _msg = succ t' pos' more' () - succ' t' pos' more' _a = lose t' pos' more' [] "endOfInput" - in runParser demandInput t pos more lose' succ' -#if __GLASGOW_HASKELL__ >= 700 -{-# SPECIALIZE endOfInput :: Parser ByteString () #-} -#endif - --- | Return an indication of whether the end of input has been --- reached. -atEnd :: Chunk t => Parser t Bool -atEnd = not <$> wantInput -{-# INLINE atEnd #-} - -satisfySuspended :: forall t r . Chunk t - => (ChunkElem t -> Bool) - -> State t -> Pos -> More - -> Failure t (State t) r - -> Success t (State t) (ChunkElem t) r - -> IResult t r -satisfySuspended p t pos more lose succ = - runParser (demandInput >> go) t pos more lose succ - where go = Parser $ \t' pos' more' lose' succ' -> - case bufferElemAt (undefined :: t) pos' t' of - Just (e, l) | p e -> succ' t' (pos' + Pos l) more' e - | otherwise -> lose' t' pos' more' [] "satisfyElem" - Nothing -> runParser (demandInput >> go) t' pos' more' lose' succ' -#if __GLASGOW_HASKELL__ >= 700 -{-# SPECIALIZE satisfySuspended :: (ChunkElem ByteString -> Bool) - -> State ByteString -> Pos -> More - -> Failure ByteString (State ByteString) r - -> Success ByteString (State ByteString) - (ChunkElem ByteString) r - -> IResult ByteString r #-} -#endif - --- | The parser @satisfyElem p@ succeeds for any chunk element for which the --- predicate @p@ returns 'True'. Returns the element that is --- actually parsed. -satisfyElem :: forall t . Chunk t - => (ChunkElem t -> Bool) -> Parser t (ChunkElem t) -satisfyElem p = Parser $ \t pos more lose succ -> - case bufferElemAt (undefined :: t) pos t of - Just (e, l) | p e -> succ t (pos + Pos l) more e - | otherwise -> lose t pos more [] "satisfyElem" - Nothing -> satisfySuspended p t pos more lose succ -{-# INLINE satisfyElem #-} diff --git a/haddock-library/vendor/attoparsec-0.12.1.1/Data/Attoparsec/Internal/Fhthagn.hs b/haddock-library/vendor/attoparsec-0.12.1.1/Data/Attoparsec/Internal/Fhthagn.hs deleted file mode 100644 index 0e00ed2c..00000000 --- a/haddock-library/vendor/attoparsec-0.12.1.1/Data/Attoparsec/Internal/Fhthagn.hs +++ /dev/null @@ -1,18 +0,0 @@ -{-# LANGUAGE BangPatterns, Rank2Types, OverloadedStrings, - RecordWildCards, MagicHash, UnboxedTuples #-} - -module Data.Attoparsec.Internal.Fhthagn - ( - inlinePerformIO - ) where - -import GHC.Base (realWorld#) -import GHC.IO (IO(IO)) - --- | Just like unsafePerformIO, but we inline it. Big performance gains as --- it exposes lots of things to further inlining. /Very unsafe/. In --- particular, you should do no memory allocation inside an --- 'inlinePerformIO' block. On Hugs this is just @unsafePerformIO@. -inlinePerformIO :: IO a -> a -inlinePerformIO (IO m) = case m realWorld# of (# _, r #) -> r -{-# INLINE inlinePerformIO #-} diff --git a/haddock-library/vendor/attoparsec-0.12.1.1/Data/Attoparsec/Internal/Types.hs b/haddock-library/vendor/attoparsec-0.12.1.1/Data/Attoparsec/Internal/Types.hs deleted file mode 100644 index 9c7994e9..00000000 --- a/haddock-library/vendor/attoparsec-0.12.1.1/Data/Attoparsec/Internal/Types.hs +++ /dev/null @@ -1,230 +0,0 @@ -{-# LANGUAGE BangPatterns, GeneralizedNewtypeDeriving, OverloadedStrings, - Rank2Types, RecordWildCards, TypeFamilies #-} --- | --- Module : Data.Attoparsec.Internal.Types --- Copyright : Bryan O'Sullivan 2007-2014 --- License : BSD3 --- --- Maintainer : bos@serpentine.com --- Stability : experimental --- Portability : unknown --- --- Simple, efficient parser combinators, loosely based on the Parsec --- library. - -module Data.Attoparsec.Internal.Types - ( - Parser(..) - , State - , Failure - , Success - , Pos(..) - , IResult(..) - , More(..) - , (<>) - , Chunk(..) - ) where - -import Control.Applicative (Alternative(..), Applicative(..), (<$>)) -import Control.DeepSeq (NFData(rnf)) -import Control.Monad (MonadPlus(..)) -import Data.Word (Word8) -import Data.ByteString (ByteString) -import qualified Data.ByteString as BS -import Data.ByteString.Internal (w2c) -import Data.Monoid (Monoid(..)) -import Prelude hiding (getChar, succ) -import qualified Data.Attoparsec.ByteString.Buffer as B - -newtype Pos = Pos { fromPos :: Int } - deriving (Eq, Ord, Show, Num) - --- | The result of a parse. This is parameterised over the type @i@ --- of string that was processed. --- --- This type is an instance of 'Functor', where 'fmap' transforms the --- value in a 'Done' result. -data IResult i r = - Fail i [String] String - -- ^ The parse failed. The @i@ parameter is the input that had - -- not yet been consumed when the failure occurred. The - -- @[@'String'@]@ is a list of contexts in which the error - -- occurred. The 'String' is the message describing the error, if - -- any. - | Partial (i -> IResult i r) - -- ^ Supply this continuation with more input so that the parser - -- can resume. To indicate that no more input is available, pass - -- an empty string to the continuation. - -- - -- __Note__: if you get a 'Partial' result, do not call its - -- continuation more than once. - | Done i r - -- ^ The parse succeeded. The @i@ parameter is the input that had - -- not yet been consumed (if any) when the parse succeeded. - -instance (Show i, Show r) => Show (IResult i r) where - show (Fail t stk msg) = - unwords [ "Fail", show t, show stk, show msg] - show (Partial _) = "Partial _" - show (Done t r) = unwords ["Done", show t, show r] - -instance (NFData i, NFData r) => NFData (IResult i r) where - rnf (Fail t stk msg) = rnf t `seq` rnf stk `seq` rnf msg - rnf (Partial _) = () - rnf (Done t r) = rnf t `seq` rnf r - {-# INLINE rnf #-} - -instance Functor (IResult i) where - fmap _ (Fail t stk msg) = Fail t stk msg - fmap f (Partial k) = Partial (fmap f . k) - fmap f (Done t r) = Done t (f r) - --- | The core parser type. This is parameterised over the types @i@ --- of string being processed and @t@ of internal state representation. --- --- This type is an instance of the following classes: --- --- * 'Monad', where 'fail' throws an exception (i.e. fails) with an --- error message. --- --- * 'Functor' and 'Applicative', which follow the usual definitions. --- --- * 'MonadPlus', where 'mzero' fails (with no error message) and --- 'mplus' executes the right-hand parser if the left-hand one --- fails. When the parser on the right executes, the input is reset --- to the same state as the parser on the left started with. (In --- other words, attoparsec is a backtracking parser that supports --- arbitrary lookahead.) --- --- * 'Alternative', which follows 'MonadPlus'. -newtype Parser i a = Parser { - runParser :: forall r. - State i -> Pos -> More - -> Failure i (State i) r - -> Success i (State i) a r - -> IResult i r - } - -type family State i -type instance State ByteString = B.Buffer - -type Failure i t r = t -> Pos -> More -> [String] -> String - -> IResult i r -type Success i t a r = t -> Pos -> More -> a -> IResult i r - --- | Have we read all available input? -data More = Complete | Incomplete - deriving (Eq, Show) - -instance Monoid More where - mappend c@Complete _ = c - mappend _ m = m - mempty = Incomplete - -instance Monad (Parser i) where - fail err = Parser $ \t pos more lose _succ -> lose t pos more [] msg - where msg = "Failed reading: " ++ err - {-# INLINE fail #-} - - return = pure - {-# INLINE return #-} - - m >>= k = Parser $ \t !pos more lose succ -> - let succ' t' !pos' more' a = runParser (k a) t' pos' more' lose succ - in runParser m t pos more lose succ' - {-# INLINE (>>=) #-} - -plus :: Parser i a -> Parser i a -> Parser i a -plus f g = Parser $ \t pos more lose succ -> - let lose' t' _pos' more' _ctx _msg = runParser g t' pos more' lose succ - in runParser f t pos more lose' succ - -instance MonadPlus (Parser i) where - mzero = fail "mzero" - {-# INLINE mzero #-} - mplus = plus - -instance Functor (Parser i) where - fmap f p = Parser $ \t pos more lose succ -> - let succ' t' pos' more' a = succ t' pos' more' (f a) - in runParser p t pos more lose succ' - {-# INLINE fmap #-} - -apP :: Parser i (a -> b) -> Parser i a -> Parser i b -apP d e = do - b <- d - a <- e - return (b a) -{-# INLINE apP #-} - -instance Applicative (Parser i) where - pure v = Parser $ \t pos more _lose succ -> succ t pos more v - {-# INLINE pure #-} - (<*>) = apP - {-# INLINE (<*>) #-} - - -- These definitions are equal to the defaults, but this - -- way the optimizer doesn't have to work so hard to figure - -- that out. - m *> k = m >>= \_ -> k - {-# INLINE (*>) #-} - x <* y = x >>= \a -> y >> return a - {-# INLINE (<*) #-} - -instance Monoid (Parser i a) where - mempty = fail "mempty" - {-# INLINE mempty #-} - mappend = plus - {-# INLINE mappend #-} - -instance Alternative (Parser i) where - empty = fail "empty" - {-# INLINE empty #-} - - (<|>) = plus - {-# INLINE (<|>) #-} - - many v = many_v - where many_v = some_v <|> pure [] - some_v = (:) <$> v <*> many_v - {-# INLINE many #-} - - some v = some_v - where - many_v = some_v <|> pure [] - some_v = (:) <$> v <*> many_v - {-# INLINE some #-} - -(<>) :: (Monoid m) => m -> m -> m -(<>) = mappend -{-# INLINE (<>) #-} - --- | A common interface for input chunks. -class Monoid c => Chunk c where - type ChunkElem c - -- | Test if the chunk is empty. - nullChunk :: c -> Bool - -- | Append chunk to a buffer. - pappendChunk :: State c -> c -> State c - -- | Position at the end of a buffer. The first argument is ignored. - atBufferEnd :: c -> State c -> Pos - -- | Return the buffer element at the given position along with its length. - bufferElemAt :: c -> Pos -> State c -> Maybe (ChunkElem c, Int) - -- | Map an element to the corresponding character. - -- The first argument is ignored. - chunkElemToChar :: c -> ChunkElem c -> Char - -instance Chunk ByteString where - type ChunkElem ByteString = Word8 - nullChunk = BS.null - {-# INLINE nullChunk #-} - pappendChunk = B.pappend - {-# INLINE pappendChunk #-} - atBufferEnd _ = Pos . B.length - {-# INLINE atBufferEnd #-} - bufferElemAt _ (Pos i) buf - | i < B.length buf = Just (B.unsafeIndex buf i, 1) - | otherwise = Nothing - {-# INLINE bufferElemAt #-} - chunkElemToChar _ = w2c - {-# INLINE chunkElemToChar #-} diff --git a/haddock-library/vendor/attoparsec-0.12.1.1/Data/Attoparsec/Number.hs b/haddock-library/vendor/attoparsec-0.12.1.1/Data/Attoparsec/Number.hs deleted file mode 100644 index 7438a912..00000000 --- a/haddock-library/vendor/attoparsec-0.12.1.1/Data/Attoparsec/Number.hs +++ /dev/null @@ -1,137 +0,0 @@ -{-# LANGUAGE DeriveDataTypeable #-} --- | --- Module : Data.Attoparsec.Number --- Copyright : Bryan O'Sullivan 2007-2014 --- License : BSD3 --- --- Maintainer : bos@serpentine.com --- Stability : experimental --- Portability : unknown --- --- This module is deprecated, and both the module and 'Number' type --- will be removed in the next major release. Use the --- package --- and the 'Data.Scientific.Scientific' type instead. --- --- A simple number type, useful for parsing both exact and inexact --- quantities without losing much precision. -module Data.Attoparsec.Number - {-# DEPRECATED "This module will be removed in the next major release." #-} - ( - Number(..) - ) where - -import Control.DeepSeq (NFData(rnf)) -import Data.Data (Data) -import Data.Function (on) -import Data.Typeable (Typeable) - --- | A numeric type that can represent integers accurately, and --- floating point numbers to the precision of a 'Double'. --- --- /Note/: this type is deprecated, and will be removed in the next --- major release. Use the 'Data.Scientific.Scientific' type instead. -data Number = I !Integer - | D {-# UNPACK #-} !Double - deriving (Typeable, Data) -{-# DEPRECATED Number "Use Scientific instead." #-} - -instance Show Number where - show (I a) = show a - show (D a) = show a - -instance NFData Number where - rnf (I _) = () - rnf (D _) = () - {-# INLINE rnf #-} - -binop :: (Integer -> Integer -> a) -> (Double -> Double -> a) - -> Number -> Number -> a -binop _ d (D a) (D b) = d a b -binop i _ (I a) (I b) = i a b -binop _ d (D a) (I b) = d a (fromIntegral b) -binop _ d (I a) (D b) = d (fromIntegral a) b -{-# INLINE binop #-} - -instance Eq Number where - (==) = binop (==) (==) - {-# INLINE (==) #-} - - (/=) = binop (/=) (/=) - {-# INLINE (/=) #-} - -instance Ord Number where - (<) = binop (<) (<) - {-# INLINE (<) #-} - - (<=) = binop (<=) (<=) - {-# INLINE (<=) #-} - - (>) = binop (>) (>) - {-# INLINE (>) #-} - - (>=) = binop (>=) (>=) - {-# INLINE (>=) #-} - - compare = binop compare compare - {-# INLINE compare #-} - -instance Num Number where - (+) = binop (((I$!).) . (+)) (((D$!).) . (+)) - {-# INLINE (+) #-} - - (-) = binop (((I$!).) . (-)) (((D$!).) . (-)) - {-# INLINE (-) #-} - - (*) = binop (((I$!).) . (*)) (((D$!).) . (*)) - {-# INLINE (*) #-} - - abs (I a) = I $! abs a - abs (D a) = D $! abs a - {-# INLINE abs #-} - - negate (I a) = I $! negate a - negate (D a) = D $! negate a - {-# INLINE negate #-} - - signum (I a) = I $! signum a - signum (D a) = D $! signum a - {-# INLINE signum #-} - - fromInteger = (I$!) . fromInteger - {-# INLINE fromInteger #-} - -instance Real Number where - toRational (I a) = fromIntegral a - toRational (D a) = toRational a - {-# INLINE toRational #-} - -instance Fractional Number where - fromRational = (D$!) . fromRational - {-# INLINE fromRational #-} - - (/) = binop (((D$!).) . (/) `on` fromIntegral) - (((D$!).) . (/)) - {-# INLINE (/) #-} - - recip (I a) = D $! recip (fromIntegral a) - recip (D a) = D $! recip a - {-# INLINE recip #-} - -instance RealFrac Number where - properFraction (I a) = (fromIntegral a,0) - properFraction (D a) = case properFraction a of - (i,d) -> (i,D d) - {-# INLINE properFraction #-} - truncate (I a) = fromIntegral a - truncate (D a) = truncate a - {-# INLINE truncate #-} - round (I a) = fromIntegral a - round (D a) = round a - {-# INLINE round #-} - ceiling (I a) = fromIntegral a - ceiling (D a) = ceiling a - {-# INLINE ceiling #-} - floor (I a) = fromIntegral a - floor (D a) = floor a - {-# INLINE floor #-} diff --git a/haddock-library/vendor/attoparsec-0.12.1.1/LICENSE b/haddock-library/vendor/attoparsec-0.12.1.1/LICENSE deleted file mode 100644 index 97392a62..00000000 --- a/haddock-library/vendor/attoparsec-0.12.1.1/LICENSE +++ /dev/null @@ -1,30 +0,0 @@ -Copyright (c) Lennart Kolmodin - -All rights reserved. - -Redistribution and use in source and binary forms, with or without -modification, are permitted provided that the following conditions -are met: - -1. Redistributions of source code must retain the above copyright - notice, this list of conditions and the following disclaimer. - -2. Redistributions in binary form must reproduce the above copyright - notice, this list of conditions and the following disclaimer in the - documentation and/or other materials provided with the distribution. - -3. Neither the name of the author nor the names of his contributors - may be used to endorse or promote products derived from this software - without specific prior written permission. - -THIS SOFTWARE IS PROVIDED BY THE CONTRIBUTORS ``AS IS'' AND ANY EXPRESS -OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED -WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE -DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR -ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL -DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS -OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) -HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, -STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN -ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE -POSSIBILITY OF SUCH DAMAGE. diff --git a/haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec.hs b/haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec.hs new file mode 100644 index 00000000..bd3c5592 --- /dev/null +++ b/haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec.hs @@ -0,0 +1,23 @@ +-- | +-- Module : Data.Attoparsec +-- Copyright : Bryan O'Sullivan 2007-2015 +-- License : BSD3 +-- +-- Maintainer : bos@serpentine.com +-- Stability : experimental +-- Portability : unknown +-- +-- Simple, efficient combinator parsing for +-- 'Data.ByteString.ByteString' strings, loosely based on the Parsec +-- library. +-- +-- This module is deprecated. Use "Data.Attoparsec.ByteString" +-- instead. + +module Data.Attoparsec + {-# DEPRECATED "This module will be removed in the next major release." #-} + ( + module Data.Attoparsec.ByteString + ) where + +import Data.Attoparsec.ByteString diff --git a/haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec/ByteString.hs b/haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec/ByteString.hs new file mode 100644 index 00000000..84e567d9 --- /dev/null +++ b/haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec/ByteString.hs @@ -0,0 +1,230 @@ +{-# LANGUAGE CPP #-} +#if __GLASGOW_HASKELL__ >= 702 +{-# LANGUAGE Trustworthy #-} +#endif +-- | +-- Module : Data.Attoparsec.ByteString +-- Copyright : Bryan O'Sullivan 2007-2015 +-- License : BSD3 +-- +-- Maintainer : bos@serpentine.com +-- Stability : experimental +-- Portability : unknown +-- +-- Simple, efficient combinator parsing for 'B.ByteString' strings, +-- loosely based on the Parsec library. + +module Data.Attoparsec.ByteString + ( + -- * Differences from Parsec + -- $parsec + + -- * Incremental input + -- $incremental + + -- * Performance considerations + -- $performance + + -- * Parser types + I.Parser + , Result + , T.IResult(..) + , I.compareResults + + -- * Running parsers + , parse + , feed + , I.parseOnly + , parseWith + , parseTest + + -- ** Result conversion + , maybeResult + , eitherResult + + -- * Parsing individual bytes + , I.word8 + , I.anyWord8 + , I.notWord8 + , I.satisfy + , I.satisfyWith + , I.skip + + -- ** Lookahead + , I.peekWord8 + , I.peekWord8' + + -- ** Byte classes + , I.inClass + , I.notInClass + + -- * Efficient string handling + , I.string + , I.skipWhile + , I.take + , I.scan + , I.runScanner + , I.takeWhile + , I.takeWhile1 + , I.takeTill + + -- ** Consume all remaining input + , I.takeByteString + , I.takeLazyByteString + + -- * Combinators + , try + , () + , choice + , count + , option + , many' + , many1 + , many1' + , manyTill + , manyTill' + , sepBy + , sepBy' + , sepBy1 + , sepBy1' + , skipMany + , skipMany1 + , eitherP + , I.match + -- * State observation and manipulation functions + , I.endOfInput + , I.atEnd + ) where + +import Data.Attoparsec.Combinator +import Data.List (intercalate) +import qualified Data.Attoparsec.ByteString.Internal as I +import qualified Data.Attoparsec.Internal as I +import qualified Data.ByteString as B +import Data.Attoparsec.ByteString.Internal (Result, parse) +import qualified Data.Attoparsec.Internal.Types as T + +-- $parsec +-- +-- Compared to Parsec 3, attoparsec makes several tradeoffs. It is +-- not intended for, or ideal for, all possible uses. +-- +-- * While attoparsec can consume input incrementally, Parsec cannot. +-- Incremental input is a huge deal for efficient and secure network +-- and system programming, since it gives much more control to users +-- of the library over matters such as resource usage and the I/O +-- model to use. +-- +-- * Much of the performance advantage of attoparsec is gained via +-- high-performance parsers such as 'I.takeWhile' and 'I.string'. +-- If you use complicated combinators that return lists of bytes or +-- characters, there is less performance difference between the two +-- libraries. +-- +-- * Unlike Parsec 3, attoparsec does not support being used as a +-- monad transformer. +-- +-- * attoparsec is specialised to deal only with strict 'B.ByteString' +-- input. Efficiency concerns rule out both lists and lazy +-- bytestrings. The usual use for lazy bytestrings would be to +-- allow consumption of very large input without a large footprint. +-- For this need, attoparsec's incremental input provides an +-- excellent substitute, with much more control over when input +-- takes place. If you must use lazy bytestrings, see the +-- "Data.Attoparsec.ByteString.Lazy" module, which feeds lazy chunks +-- to a regular parser. +-- +-- * Parsec parsers can produce more helpful error messages than +-- attoparsec parsers. This is a matter of focus: attoparsec avoids +-- the extra book-keeping in favour of higher performance. + +-- $incremental +-- +-- attoparsec supports incremental input, meaning that you can feed it +-- a bytestring that represents only part of the expected total amount +-- of data to parse. If your parser reaches the end of a fragment of +-- input and could consume more input, it will suspend parsing and +-- return a 'T.Partial' continuation. +-- +-- Supplying the 'T.Partial' continuation with a bytestring will +-- resume parsing at the point where it was suspended, with the +-- bytestring you supplied used as new input at the end of the +-- existing input. You must be prepared for the result of the resumed +-- parse to be another 'T.Partial' continuation. +-- +-- To indicate that you have no more input, supply the 'T.Partial' +-- continuation with an empty bytestring. +-- +-- Remember that some parsing combinators will not return a result +-- until they reach the end of input. They may thus cause 'T.Partial' +-- results to be returned. +-- +-- If you do not need support for incremental input, consider using +-- the 'I.parseOnly' function to run your parser. It will never +-- prompt for more input. +-- +-- /Note/: incremental input does /not/ imply that attoparsec will +-- release portions of its internal state for garbage collection as it +-- proceeds. Its internal representation is equivalent to a single +-- 'ByteString': if you feed incremental input to a parser, it will +-- require memory proportional to the amount of input you supply. +-- (This is necessary to support arbitrary backtracking.) + +-- $performance +-- +-- If you write an attoparsec-based parser carefully, it can be +-- realistic to expect it to perform similarly to a hand-rolled C +-- parser (measuring megabytes parsed per second). +-- +-- To actually achieve high performance, there are a few guidelines +-- that it is useful to follow. +-- +-- Use the 'B.ByteString'-oriented parsers whenever possible, +-- e.g. 'I.takeWhile1' instead of 'many1' 'I.anyWord8'. There is +-- about a factor of 100 difference in performance between the two +-- kinds of parser. +-- +-- For very simple byte-testing predicates, write them by hand instead +-- of using 'I.inClass' or 'I.notInClass'. For instance, both of +-- these predicates test for an end-of-line byte, but the first is +-- much faster than the second: +-- +-- >endOfLine_fast w = w == 13 || w == 10 +-- >endOfLine_slow = inClass "\r\n" +-- +-- Make active use of benchmarking and profiling tools to measure, +-- find the problems with, and improve the performance of your parser. + +-- | Run a parser and print its result to standard output. +parseTest :: (Show a) => I.Parser a -> B.ByteString -> IO () +parseTest p s = print (parse p s) + +-- | Run a parser with an initial input string, and a monadic action +-- that can supply more input if needed. +parseWith :: Monad m => + (m B.ByteString) + -- ^ An action that will be executed to provide the parser + -- with more input, if necessary. The action must return an + -- 'B.empty' string when there is no more input available. + -> I.Parser a + -> B.ByteString + -- ^ Initial input for the parser. + -> m (Result a) +parseWith refill p s = step $ parse p s + where step (T.Partial k) = (step . k) =<< refill + step r = return r +{-# INLINE parseWith #-} + +-- | Convert a 'Result' value to a 'Maybe' value. A 'T.Partial' result +-- is treated as failure. +maybeResult :: Result r -> Maybe r +maybeResult (T.Done _ r) = Just r +maybeResult _ = Nothing + +-- | Convert a 'Result' value to an 'Either' value. A 'T.Partial' +-- result is treated as failure. +eitherResult :: Result r -> Either String r +eitherResult (T.Done _ r) = Right r +eitherResult (T.Fail _ [] msg) = Left msg +eitherResult (T.Fail _ ctxs msg) = Left (intercalate " > " ctxs ++ ": " ++ msg) +eitherResult _ = Left "Result: incomplete input" diff --git a/haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec/ByteString/Buffer.hs b/haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec/ByteString/Buffer.hs new file mode 100644 index 00000000..ac94dfcc --- /dev/null +++ b/haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec/ByteString/Buffer.hs @@ -0,0 +1,156 @@ +{-# LANGUAGE BangPatterns #-} +-- | +-- Module : Data.Attoparsec.ByteString.Buffer +-- Copyright : Bryan O'Sullivan 2007-2015 +-- License : BSD3 +-- +-- Maintainer : bos@serpentine.com +-- Stability : experimental +-- Portability : GHC +-- +-- An "immutable" buffer that supports cheap appends. +-- +-- A Buffer is divided into an immutable read-only zone, followed by a +-- mutable area that we've preallocated, but not yet written to. +-- +-- We overallocate at the end of a Buffer so that we can cheaply +-- append. Since a user of an existing Buffer cannot see past the end +-- of its immutable zone into the data that will change during an +-- append, this is safe. +-- +-- Once we run out of space at the end of a Buffer, we do the usual +-- doubling of the buffer size. +-- +-- The fact of having a mutable buffer really helps with performance, +-- but it does have a consequence: if someone misuses the Partial API +-- that attoparsec uses by calling the same continuation repeatedly +-- (which never makes sense in practice), they could overwrite data. +-- +-- Since the API *looks* pure, it should *act* pure, too, so we use +-- two generation counters (one mutable, one immutable) to track the +-- number of appends to a mutable buffer. If the counters ever get out +-- of sync, someone is appending twice to a mutable buffer, so we +-- duplicate the entire buffer in order to preserve the immutability +-- of its older self. +-- +-- While we could go a step further and gain protection against API +-- abuse on a multicore system, by use of an atomic increment +-- instruction to bump the mutable generation counter, that would be +-- very expensive, and feels like it would also be in the realm of the +-- ridiculous. Clients should never call a continuation more than +-- once; we lack a linear type system that could enforce this; and +-- there's only so far we should go to accommodate broken uses. + +module Data.Attoparsec.ByteString.Buffer + ( + Buffer + , buffer + , unbuffer + , pappend + , length + , unsafeIndex + , substring + , unsafeDrop + ) where + +import Control.Exception (assert) +import Data.ByteString.Internal (ByteString(..), memcpy, nullForeignPtr) +import Data.Attoparsec.Internal.Fhthagn (inlinePerformIO) +import Data.List (foldl1') +import Data.Monoid as Mon (Monoid(..)) +import Data.Semigroup (Semigroup(..)) +import Data.Word (Word8) +import Foreign.ForeignPtr (ForeignPtr, withForeignPtr) +import Foreign.Ptr (castPtr, plusPtr) +import Foreign.Storable (peek, peekByteOff, poke, sizeOf) +import GHC.ForeignPtr (mallocPlainForeignPtrBytes) +import Prelude hiding (length) + +-- If _cap is zero, this buffer is empty. +data Buffer = Buf { + _fp :: {-# UNPACK #-} !(ForeignPtr Word8) + , _off :: {-# UNPACK #-} !Int + , _len :: {-# UNPACK #-} !Int + , _cap :: {-# UNPACK #-} !Int + , _gen :: {-# UNPACK #-} !Int + } + +instance Show Buffer where + showsPrec p = showsPrec p . unbuffer + +-- | The initial 'Buffer' has no mutable zone, so we can avoid all +-- copies in the (hopefully) common case of no further input being fed +-- to us. +buffer :: ByteString -> Buffer +buffer (PS fp off len) = Buf fp off len len 0 + +unbuffer :: Buffer -> ByteString +unbuffer (Buf fp off len _ _) = PS fp off len + +instance Semigroup Buffer where + (Buf _ _ _ 0 _) <> b = b + a <> (Buf _ _ _ 0 _) = a + buf <> (Buf fp off len _ _) = append buf fp off len + +instance Monoid Buffer where + mempty = Buf nullForeignPtr 0 0 0 0 + + mappend = (<>) + + mconcat [] = Mon.mempty + mconcat xs = foldl1' mappend xs + +pappend :: Buffer -> ByteString -> Buffer +pappend (Buf _ _ _ 0 _) bs = buffer bs +pappend buf (PS fp off len) = append buf fp off len + +append :: Buffer -> ForeignPtr a -> Int -> Int -> Buffer +append (Buf fp0 off0 len0 cap0 gen0) !fp1 !off1 !len1 = + inlinePerformIO . withForeignPtr fp0 $ \ptr0 -> + withForeignPtr fp1 $ \ptr1 -> do + let genSize = sizeOf (0::Int) + newlen = len0 + len1 + gen <- if gen0 == 0 + then return 0 + else peek (castPtr ptr0) + if gen == gen0 && newlen <= cap0 + then do + let newgen = gen + 1 + poke (castPtr ptr0) newgen + memcpy (ptr0 `plusPtr` (off0+len0)) + (ptr1 `plusPtr` off1) + (fromIntegral len1) + return (Buf fp0 off0 newlen cap0 newgen) + else do + let newcap = newlen * 2 + fp <- mallocPlainForeignPtrBytes (newcap + genSize) + withForeignPtr fp $ \ptr_ -> do + let ptr = ptr_ `plusPtr` genSize + newgen = 1 + poke (castPtr ptr_) newgen + memcpy ptr (ptr0 `plusPtr` off0) (fromIntegral len0) + memcpy (ptr `plusPtr` len0) (ptr1 `plusPtr` off1) + (fromIntegral len1) + return (Buf fp genSize newlen newcap newgen) + +length :: Buffer -> Int +length (Buf _ _ len _ _) = len +{-# INLINE length #-} + +unsafeIndex :: Buffer -> Int -> Word8 +unsafeIndex (Buf fp off len _ _) i = assert (i >= 0 && i < len) . + inlinePerformIO . withForeignPtr fp $ flip peekByteOff (off+i) +{-# INLINE unsafeIndex #-} + +substring :: Int -> Int -> Buffer -> ByteString +substring s l (Buf fp off len _ _) = + assert (s >= 0 && s <= len) . + assert (l >= 0 && l <= len-s) $ + PS fp (off+s) l +{-# INLINE substring #-} + +unsafeDrop :: Int -> Buffer -> ByteString +unsafeDrop s (Buf fp off len _ _) = + assert (s >= 0 && s <= len) $ + PS fp (off+s) (len-s) +{-# INLINE unsafeDrop #-} diff --git a/haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec/ByteString/Char8.hs b/haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec/ByteString/Char8.hs new file mode 100644 index 00000000..7fafba40 --- /dev/null +++ b/haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec/ByteString/Char8.hs @@ -0,0 +1,464 @@ +{-# LANGUAGE BangPatterns, CPP, FlexibleInstances, TypeFamilies, + TypeSynonymInstances, GADTs #-} +#if __GLASGOW_HASKELL__ >= 702 +{-# LANGUAGE Trustworthy #-} -- Imports internal modules +#endif +{-# OPTIONS_GHC -fno-warn-orphans -fno-warn-warnings-deprecations #-} + +-- | +-- Module : Data.Attoparsec.ByteString.Char8 +-- Copyright : Bryan O'Sullivan 2007-2015 +-- License : BSD3 +-- +-- Maintainer : bos@serpentine.com +-- Stability : experimental +-- Portability : unknown +-- +-- Simple, efficient, character-oriented combinator parsing for +-- 'B.ByteString' strings, loosely based on the Parsec library. + +module Data.Attoparsec.ByteString.Char8 + ( + -- * Character encodings + -- $encodings + + -- * Parser types + Parser + , A.Result + , A.IResult(..) + , I.compareResults + + -- * Running parsers + , A.parse + , A.feed + , A.parseOnly + , A.parseWith + , A.parseTest + + -- ** Result conversion + , A.maybeResult + , A.eitherResult + + -- * Parsing individual characters + , char + , char8 + , anyChar + , notChar + , satisfy + + -- ** Lookahead + , peekChar + , peekChar' + + -- ** Special character parsers + , digit + , letter_iso8859_15 + , letter_ascii + , space + + -- ** Fast predicates + , isDigit + , isDigit_w8 + , isAlpha_iso8859_15 + , isAlpha_ascii + , isSpace + , isSpace_w8 + + -- *** Character classes + , inClass + , notInClass + + -- * Efficient string handling + , I.string + , I.stringCI + , skipSpace + , skipWhile + , I.take + , scan + , takeWhile + , takeWhile1 + , takeTill + + -- ** String combinators + -- $specalt + , (.*>) + , (<*.) + + -- ** Consume all remaining input + , I.takeByteString + , I.takeLazyByteString + + -- * Text parsing + , I.endOfLine + , isEndOfLine + , isHorizontalSpace + + -- * Numeric parsers + , decimal + , hexadecimal + , signed + + -- * Combinators + , try + , () + , choice + , count + , option + , many' + , many1 + , many1' + , manyTill + , manyTill' + , sepBy + , sepBy' + , sepBy1 + , sepBy1' + , skipMany + , skipMany1 + , eitherP + , I.match + -- * State observation and manipulation functions + , I.endOfInput + , I.atEnd + ) where + +#if !MIN_VERSION_base(4,8,0) +import Control.Applicative (pure, (*>), (<*), (<$>)) +import Data.Word (Word) +#endif +import Control.Applicative ((<|>)) +import Data.Attoparsec.ByteString.FastSet (charClass, memberChar) +import Data.Attoparsec.ByteString.Internal (Parser) +import Data.Attoparsec.Combinator +import Data.Bits (Bits, (.|.), shiftL) +import Data.ByteString.Internal (c2w, w2c) +import Data.Int (Int8, Int16, Int32, Int64) +import Data.String (IsString(..)) +import Data.Word (Word8, Word16, Word32, Word64) +import Prelude hiding (takeWhile) +import qualified Data.Attoparsec.ByteString as A +import qualified Data.Attoparsec.ByteString.Internal as I +import qualified Data.Attoparsec.Internal as I +import qualified Data.ByteString as B8 +import qualified Data.ByteString.Char8 as B + +instance (a ~ B.ByteString) => IsString (Parser a) where + fromString = I.string . B.pack + +-- $encodings +-- +-- This module is intended for parsing text that is +-- represented using an 8-bit character set, e.g. ASCII or +-- ISO-8859-15. It /does not/ make any attempt to deal with character +-- encodings, multibyte characters, or wide characters. In +-- particular, all attempts to use characters above code point U+00FF +-- will give wrong answers. +-- +-- Code points below U+0100 are simply translated to and from their +-- numeric values, so e.g. the code point U+00A4 becomes the byte +-- @0xA4@ (which is the Euro symbol in ISO-8859-15, but the generic +-- currency sign in ISO-8859-1). Haskell 'Char' values above U+00FF +-- are truncated, so e.g. U+1D6B7 is truncated to the byte @0xB7@. + +-- | Consume input as long as the predicate returns 'True', and return +-- the consumed input. +-- +-- This parser requires the predicate to succeed on at least one byte +-- of input: it will fail if the predicate never returns 'True' or if +-- there is no input left. +takeWhile1 :: (Char -> Bool) -> Parser B.ByteString +takeWhile1 p = I.takeWhile1 (p . w2c) +{-# INLINE takeWhile1 #-} + +-- | The parser @satisfy p@ succeeds for any byte for which the +-- predicate @p@ returns 'True'. Returns the byte that is actually +-- parsed. +-- +-- >digit = satisfy isDigit +-- > where isDigit c = c >= '0' && c <= '9' +satisfy :: (Char -> Bool) -> Parser Char +satisfy = I.satisfyWith w2c +{-# INLINE satisfy #-} + +-- | Match a letter, in the ISO-8859-15 encoding. +letter_iso8859_15 :: Parser Char +letter_iso8859_15 = satisfy isAlpha_iso8859_15 "letter_iso8859_15" +{-# INLINE letter_iso8859_15 #-} + +-- | Match a letter, in the ASCII encoding. +letter_ascii :: Parser Char +letter_ascii = satisfy isAlpha_ascii "letter_ascii" +{-# INLINE letter_ascii #-} + +-- | A fast alphabetic predicate for the ISO-8859-15 encoding +-- +-- /Note/: For all character encodings other than ISO-8859-15, and +-- almost all Unicode code points above U+00A3, this predicate gives +-- /wrong answers/. +isAlpha_iso8859_15 :: Char -> Bool +isAlpha_iso8859_15 c = (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z') || + (c >= '\166' && moby c) + where moby = notInClass "\167\169\171-\179\182\183\185\187\191\215\247" + {-# NOINLINE moby #-} +{-# INLINE isAlpha_iso8859_15 #-} + +-- | A fast alphabetic predicate for the ASCII encoding +-- +-- /Note/: For all character encodings other than ASCII, and +-- almost all Unicode code points above U+007F, this predicate gives +-- /wrong answers/. +isAlpha_ascii :: Char -> Bool +isAlpha_ascii c = (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z') +{-# INLINE isAlpha_ascii #-} + +-- | Parse a single digit. +digit :: Parser Char +digit = satisfy isDigit "digit" +{-# INLINE digit #-} + +-- | A fast digit predicate. +isDigit :: Char -> Bool +isDigit c = c >= '0' && c <= '9' +{-# INLINE isDigit #-} + +-- | A fast digit predicate. +isDigit_w8 :: Word8 -> Bool +isDigit_w8 w = w - 48 <= 9 +{-# INLINE isDigit_w8 #-} + +-- | Match any character. +anyChar :: Parser Char +anyChar = satisfy $ const True +{-# INLINE anyChar #-} + +-- | Match any character, to perform lookahead. Returns 'Nothing' if +-- end of input has been reached. Does not consume any input. +-- +-- /Note/: Because this parser does not fail, do not use it with +-- combinators such as 'many', because such parsers loop until a +-- failure occurs. Careless use will thus result in an infinite loop. +peekChar :: Parser (Maybe Char) +peekChar = (fmap w2c) `fmap` I.peekWord8 +{-# INLINE peekChar #-} + +-- | Match any character, to perform lookahead. Does not consume any +-- input, but will fail if end of input has been reached. +peekChar' :: Parser Char +peekChar' = w2c `fmap` I.peekWord8' +{-# INLINE peekChar' #-} + +-- | Fast predicate for matching ASCII space characters. +-- +-- /Note/: This predicate only gives correct answers for the ASCII +-- encoding. For instance, it does not recognise U+00A0 (non-breaking +-- space) as a space character, even though it is a valid ISO-8859-15 +-- byte. For a Unicode-aware and only slightly slower predicate, +-- use 'Data.Char.isSpace' +isSpace :: Char -> Bool +isSpace c = (c == ' ') || ('\t' <= c && c <= '\r') +{-# INLINE isSpace #-} + +-- | Fast 'Word8' predicate for matching ASCII space characters. +isSpace_w8 :: Word8 -> Bool +isSpace_w8 w = w == 32 || w - 9 <= 4 +{-# INLINE isSpace_w8 #-} + + +-- | Parse a space character. +-- +-- /Note/: This parser only gives correct answers for the ASCII +-- encoding. For instance, it does not recognise U+00A0 (non-breaking +-- space) as a space character, even though it is a valid ISO-8859-15 +-- byte. +space :: Parser Char +space = satisfy isSpace "space" +{-# INLINE space #-} + +-- | Match a specific character. +char :: Char -> Parser Char +char c = satisfy (== c) [c] +{-# INLINE char #-} + +-- | Match a specific character, but return its 'Word8' value. +char8 :: Char -> Parser Word8 +char8 c = I.satisfy (== c2w c) [c] +{-# INLINE char8 #-} + +-- | Match any character except the given one. +notChar :: Char -> Parser Char +notChar c = satisfy (/= c) "not " ++ [c] +{-# INLINE notChar #-} + +-- | Match any character in a set. +-- +-- >vowel = inClass "aeiou" +-- +-- Range notation is supported. +-- +-- >halfAlphabet = inClass "a-nA-N" +-- +-- To add a literal \'-\' to a set, place it at the beginning or end +-- of the string. +inClass :: String -> Char -> Bool +inClass s = (`memberChar` mySet) + where mySet = charClass s +{-# INLINE inClass #-} + +-- | Match any character not in a set. +notInClass :: String -> Char -> Bool +notInClass s = not . inClass s +{-# INLINE notInClass #-} + +-- | Consume input as long as the predicate returns 'True', and return +-- the consumed input. +-- +-- This parser does not fail. It will return an empty string if the +-- predicate returns 'False' on the first byte of input. +-- +-- /Note/: Because this parser does not fail, do not use it with +-- combinators such as 'many', because such parsers loop until a +-- failure occurs. Careless use will thus result in an infinite loop. +takeWhile :: (Char -> Bool) -> Parser B.ByteString +takeWhile p = I.takeWhile (p . w2c) +{-# INLINE takeWhile #-} + +-- | A stateful scanner. The predicate consumes and transforms a +-- state argument, and each transformed state is passed to successive +-- invocations of the predicate on each byte of the input until one +-- returns 'Nothing' or the input ends. +-- +-- This parser does not fail. It will return an empty string if the +-- predicate returns 'Nothing' on the first byte of input. +-- +-- /Note/: Because this parser does not fail, do not use it with +-- combinators such as 'many', because such parsers loop until a +-- failure occurs. Careless use will thus result in an infinite loop. +scan :: s -> (s -> Char -> Maybe s) -> Parser B.ByteString +scan s0 p = I.scan s0 (\s -> p s . w2c) +{-# INLINE scan #-} + +-- | Consume input as long as the predicate returns 'False' +-- (i.e. until it returns 'True'), and return the consumed input. +-- +-- This parser does not fail. It will return an empty string if the +-- predicate returns 'True' on the first byte of input. +-- +-- /Note/: Because this parser does not fail, do not use it with +-- combinators such as 'many', because such parsers loop until a +-- failure occurs. Careless use will thus result in an infinite loop. +takeTill :: (Char -> Bool) -> Parser B.ByteString +takeTill p = I.takeTill (p . w2c) +{-# INLINE takeTill #-} + +-- | Skip past input for as long as the predicate returns 'True'. +skipWhile :: (Char -> Bool) -> Parser () +skipWhile p = I.skipWhile (p . w2c) +{-# INLINE skipWhile #-} + +-- | Skip over white space. +skipSpace :: Parser () +skipSpace = I.skipWhile isSpace_w8 +{-# INLINE skipSpace #-} + +-- $specalt +-- +-- If you enable the @OverloadedStrings@ language extension, you can +-- use the '*>' and '<*' combinators to simplify the common task of +-- matching a statically known string, then immediately parsing +-- something else. +-- +-- Instead of writing something like this: +-- +-- @ +--'I.string' \"foo\" '*>' wibble +-- @ +-- +-- Using @OverloadedStrings@, you can omit the explicit use of +-- 'I.string', and write a more compact version: +-- +-- @ +-- \"foo\" '*>' wibble +-- @ +-- +-- (Note: the '.*>' and '<*.' combinators that were originally +-- provided for this purpose are obsolete and unnecessary, and will be +-- removed in the next major version.) + +-- | /Obsolete/. A type-specialized version of '*>' for +-- 'B.ByteString'. Use '*>' instead. +(.*>) :: B.ByteString -> Parser a -> Parser a +s .*> f = I.string s *> f +{-# DEPRECATED (.*>) "This is no longer necessary, and will be removed. Use '*>' instead." #-} + +-- | /Obsolete/. A type-specialized version of '<*' for +-- 'B.ByteString'. Use '<*' instead. +(<*.) :: Parser a -> B.ByteString -> Parser a +f <*. s = f <* I.string s +{-# DEPRECATED (<*.) "This is no longer necessary, and will be removed. Use '<*' instead." #-} + +-- | A predicate that matches either a carriage return @\'\\r\'@ or +-- newline @\'\\n\'@ character. +isEndOfLine :: Word8 -> Bool +isEndOfLine w = w == 13 || w == 10 +{-# INLINE isEndOfLine #-} + +-- | A predicate that matches either a space @\' \'@ or horizontal tab +-- @\'\\t\'@ character. +isHorizontalSpace :: Word8 -> Bool +isHorizontalSpace w = w == 32 || w == 9 +{-# INLINE isHorizontalSpace #-} + +-- | Parse and decode an unsigned hexadecimal number. The hex digits +-- @\'a\'@ through @\'f\'@ may be upper or lower case. +-- +-- This parser does not accept a leading @\"0x\"@ string. +hexadecimal :: (Integral a, Bits a) => Parser a +hexadecimal = B8.foldl' step 0 `fmap` I.takeWhile1 isHexDigit + where + isHexDigit w = (w >= 48 && w <= 57) || + (w >= 97 && w <= 102) || + (w >= 65 && w <= 70) + step a w | w >= 48 && w <= 57 = (a `shiftL` 4) .|. fromIntegral (w - 48) + | w >= 97 = (a `shiftL` 4) .|. fromIntegral (w - 87) + | otherwise = (a `shiftL` 4) .|. fromIntegral (w - 55) +{-# SPECIALISE hexadecimal :: Parser Int #-} +{-# SPECIALISE hexadecimal :: Parser Int8 #-} +{-# SPECIALISE hexadecimal :: Parser Int16 #-} +{-# SPECIALISE hexadecimal :: Parser Int32 #-} +{-# SPECIALISE hexadecimal :: Parser Int64 #-} +{-# SPECIALISE hexadecimal :: Parser Integer #-} +{-# SPECIALISE hexadecimal :: Parser Word #-} +{-# SPECIALISE hexadecimal :: Parser Word8 #-} +{-# SPECIALISE hexadecimal :: Parser Word16 #-} +{-# SPECIALISE hexadecimal :: Parser Word32 #-} +{-# SPECIALISE hexadecimal :: Parser Word64 #-} + +-- | Parse and decode an unsigned decimal number. +decimal :: Integral a => Parser a +decimal = B8.foldl' step 0 `fmap` I.takeWhile1 isDigit_w8 + where step a w = a * 10 + fromIntegral (w - 48) +{-# SPECIALISE decimal :: Parser Int #-} +{-# SPECIALISE decimal :: Parser Int8 #-} +{-# SPECIALISE decimal :: Parser Int16 #-} +{-# SPECIALISE decimal :: Parser Int32 #-} +{-# SPECIALISE decimal :: Parser Int64 #-} +{-# SPECIALISE decimal :: Parser Integer #-} +{-# SPECIALISE decimal :: Parser Word #-} +{-# SPECIALISE decimal :: Parser Word8 #-} +{-# SPECIALISE decimal :: Parser Word16 #-} +{-# SPECIALISE decimal :: Parser Word32 #-} +{-# SPECIALISE decimal :: Parser Word64 #-} + +-- | Parse a number with an optional leading @\'+\'@ or @\'-\'@ sign +-- character. +signed :: Num a => Parser a -> Parser a +{-# SPECIALISE signed :: Parser Int -> Parser Int #-} +{-# SPECIALISE signed :: Parser Int8 -> Parser Int8 #-} +{-# SPECIALISE signed :: Parser Int16 -> Parser Int16 #-} +{-# SPECIALISE signed :: Parser Int32 -> Parser Int32 #-} +{-# SPECIALISE signed :: Parser Int64 -> Parser Int64 #-} +{-# SPECIALISE signed :: Parser Integer -> Parser Integer #-} +signed p = (negate <$> (char8 '-' *> p)) + <|> (char8 '+' *> p) + <|> p + diff --git a/haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec/ByteString/FastSet.hs b/haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec/ByteString/FastSet.hs new file mode 100644 index 00000000..d15854c4 --- /dev/null +++ b/haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec/ByteString/FastSet.hs @@ -0,0 +1,115 @@ +{-# LANGUAGE BangPatterns, MagicHash #-} + +----------------------------------------------------------------------------- +-- | +-- Module : Data.Attoparsec.ByteString.FastSet +-- Copyright : Bryan O'Sullivan 2007-2015 +-- License : BSD3 +-- +-- Maintainer : bos@serpentine.com +-- Stability : experimental +-- Portability : unknown +-- +-- Fast set membership tests for 'Word8' and 8-bit 'Char' values. The +-- set representation is unboxed for efficiency. For small sets, we +-- test for membership using a binary search. For larger sets, we use +-- a lookup table. +-- +----------------------------------------------------------------------------- +module Data.Attoparsec.ByteString.FastSet + ( + -- * Data type + FastSet + -- * Construction + , fromList + , set + -- * Lookup + , memberChar + , memberWord8 + -- * Debugging + , fromSet + -- * Handy interface + , charClass + ) where + +import Data.Bits ((.&.), (.|.)) +import Foreign.Storable (peekByteOff, pokeByteOff) +import GHC.Base (Int(I#), iShiftRA#, narrow8Word#, shiftL#) +import GHC.Word (Word8(W8#)) +import qualified Data.ByteString as B +import qualified Data.ByteString.Char8 as B8 +import qualified Data.ByteString.Internal as I +import qualified Data.ByteString.Unsafe as U + +data FastSet = Sorted { fromSet :: !B.ByteString } + | Table { fromSet :: !B.ByteString } + deriving (Eq, Ord) + +instance Show FastSet where + show (Sorted s) = "FastSet Sorted " ++ show (B8.unpack s) + show (Table _) = "FastSet Table" + +-- | The lower bound on the size of a lookup table. We choose this to +-- balance table density against performance. +tableCutoff :: Int +tableCutoff = 8 + +-- | Create a set. +set :: B.ByteString -> FastSet +set s | B.length s < tableCutoff = Sorted . B.sort $ s + | otherwise = Table . mkTable $ s + +fromList :: [Word8] -> FastSet +fromList = set . B.pack + +data I = I {-# UNPACK #-} !Int {-# UNPACK #-} !Word8 + +shiftR :: Int -> Int -> Int +shiftR (I# x#) (I# i#) = I# (x# `iShiftRA#` i#) + +shiftL :: Word8 -> Int -> Word8 +shiftL (W8# x#) (I# i#) = W8# (narrow8Word# (x# `shiftL#` i#)) + +index :: Int -> I +index i = I (i `shiftR` 3) (1 `shiftL` (i .&. 7)) +{-# INLINE index #-} + +-- | Check the set for membership. +memberWord8 :: Word8 -> FastSet -> Bool +memberWord8 w (Table t) = + let I byte bit = index (fromIntegral w) + in U.unsafeIndex t byte .&. bit /= 0 +memberWord8 w (Sorted s) = search 0 (B.length s - 1) + where search lo hi + | hi < lo = False + | otherwise = + let mid = (lo + hi) `quot` 2 + in case compare w (U.unsafeIndex s mid) of + GT -> search (mid + 1) hi + LT -> search lo (mid - 1) + _ -> True + +-- | Check the set for membership. Only works with 8-bit characters: +-- characters above code point 255 will give wrong answers. +memberChar :: Char -> FastSet -> Bool +memberChar c = memberWord8 (I.c2w c) +{-# INLINE memberChar #-} + +mkTable :: B.ByteString -> B.ByteString +mkTable s = I.unsafeCreate 32 $ \t -> do + _ <- I.memset t 0 32 + U.unsafeUseAsCStringLen s $ \(p, l) -> + let loop n | n == l = return () + | otherwise = do + c <- peekByteOff p n :: IO Word8 + let I byte bit = index (fromIntegral c) + prev <- peekByteOff t byte :: IO Word8 + pokeByteOff t byte (prev .|. bit) + loop (n + 1) + in loop 0 + +charClass :: String -> FastSet +charClass = set . B8.pack . go + where go (a:'-':b:xs) = [a..b] ++ go xs + go (x:xs) = x : go xs + go _ = "" diff --git a/haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec/ByteString/Internal.hs b/haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec/ByteString/Internal.hs new file mode 100644 index 00000000..4938ea87 --- /dev/null +++ b/haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec/ByteString/Internal.hs @@ -0,0 +1,536 @@ +{-# LANGUAGE BangPatterns, CPP, GADTs, OverloadedStrings, RankNTypes, + RecordWildCards #-} +-- | +-- Module : Data.Attoparsec.ByteString.Internal +-- Copyright : Bryan O'Sullivan 2007-2015 +-- License : BSD3 +-- +-- Maintainer : bos@serpentine.com +-- Stability : experimental +-- Portability : unknown +-- +-- Simple, efficient parser combinators for 'ByteString' strings, +-- loosely based on the Parsec library. + +module Data.Attoparsec.ByteString.Internal + ( + -- * Parser types + Parser + , Result + + -- * Running parsers + , parse + , parseOnly + + -- * Combinators + , module Data.Attoparsec.Combinator + + -- * Parsing individual bytes + , satisfy + , satisfyWith + , anyWord8 + , skip + , word8 + , notWord8 + + -- ** Lookahead + , peekWord8 + , peekWord8' + + -- ** Byte classes + , inClass + , notInClass + + -- * Parsing more complicated structures + , storable + + -- * Efficient string handling + , skipWhile + , string + , stringCI + , take + , scan + , runScanner + , takeWhile + , takeWhile1 + , takeTill + + -- ** Consume all remaining input + , takeByteString + , takeLazyByteString + + -- * Utilities + , endOfLine + , endOfInput + , match + , atEnd + ) where + +#if !MIN_VERSION_base(4,8,0) +import Control.Applicative ((<$>)) +#endif +import Control.Applicative ((<|>)) +import Control.Monad (when) +import Data.Attoparsec.ByteString.Buffer (Buffer, buffer) +import Data.Attoparsec.ByteString.FastSet (charClass, memberWord8) +import Data.Attoparsec.Combinator (()) +import Data.Attoparsec.Internal +import Data.Attoparsec.Internal.Fhthagn (inlinePerformIO) +import Data.Attoparsec.Internal.Types hiding (Parser, Failure, Success) +import Data.ByteString (ByteString) +import Data.List (intercalate) +import Data.Word (Word8) +import Foreign.ForeignPtr (withForeignPtr) +import Foreign.Ptr (castPtr, minusPtr, plusPtr) +import Foreign.Storable (Storable(peek, sizeOf)) +import Prelude hiding (getChar, succ, take, takeWhile) +import qualified Data.Attoparsec.ByteString.Buffer as Buf +import qualified Data.Attoparsec.Internal.Types as T +import qualified Data.ByteString as B8 +import qualified Data.ByteString.Char8 as B +import qualified Data.ByteString.Internal as B +import qualified Data.ByteString.Lazy as L +import qualified Data.ByteString.Unsafe as B + +type Parser = T.Parser ByteString +type Result = IResult ByteString +type Failure r = T.Failure ByteString Buffer r +type Success a r = T.Success ByteString Buffer a r + +-- | The parser @satisfy p@ succeeds for any byte for which the +-- predicate @p@ returns 'True'. Returns the byte that is actually +-- parsed. +-- +-- >digit = satisfy isDigit +-- > where isDigit w = w >= 48 && w <= 57 +satisfy :: (Word8 -> Bool) -> Parser Word8 +satisfy p = do + h <- peekWord8' + if p h + then advance 1 >> return h + else fail "satisfy" +{-# INLINE satisfy #-} + +-- | The parser @skip p@ succeeds for any byte for which the predicate +-- @p@ returns 'True'. +-- +-- >skipDigit = skip isDigit +-- > where isDigit w = w >= 48 && w <= 57 +skip :: (Word8 -> Bool) -> Parser () +skip p = do + h <- peekWord8' + if p h + then advance 1 + else fail "skip" + +-- | The parser @satisfyWith f p@ transforms a byte, and succeeds if +-- the predicate @p@ returns 'True' on the transformed value. The +-- parser returns the transformed byte that was parsed. +satisfyWith :: (Word8 -> a) -> (a -> Bool) -> Parser a +satisfyWith f p = do + h <- peekWord8' + let c = f h + if p c + then advance 1 >> return c + else fail "satisfyWith" +{-# INLINE satisfyWith #-} + +storable :: Storable a => Parser a +storable = hack undefined + where + hack :: Storable b => b -> Parser b + hack dummy = do + (fp,o,_) <- B.toForeignPtr `fmap` take (sizeOf dummy) + return . inlinePerformIO . withForeignPtr fp $ \p -> + peek (castPtr $ p `plusPtr` o) + +-- | Consume exactly @n@ bytes of input. +take :: Int -> Parser ByteString +take n0 = do + let n = max n0 0 + s <- ensure n + advance n >> return s +{-# INLINE take #-} + +-- | @string s@ parses a sequence of bytes that identically match +-- @s@. Returns the parsed string (i.e. @s@). This parser consumes no +-- input if it fails (even if a partial match). +-- +-- /Note/: The behaviour of this parser is different to that of the +-- similarly-named parser in Parsec, as this one is all-or-nothing. +-- To illustrate the difference, the following parser will fail under +-- Parsec given an input of @\"for\"@: +-- +-- >string "foo" <|> string "for" +-- +-- The reason for its failure is that the first branch is a +-- partial match, and will consume the letters @\'f\'@ and @\'o\'@ +-- before failing. In attoparsec, the above parser will /succeed/ on +-- that input, because the failed first branch will consume nothing. +string :: ByteString -> Parser ByteString +string s = string_ (stringSuspended id) id s +{-# INLINE string #-} + +-- ASCII-specific but fast, oh yes. +toLower :: Word8 -> Word8 +toLower w | w >= 65 && w <= 90 = w + 32 + | otherwise = w + +-- | Satisfy a literal string, ignoring case. +stringCI :: ByteString -> Parser ByteString +stringCI s = string_ (stringSuspended lower) lower s + where lower = B8.map toLower +{-# INLINE stringCI #-} + +string_ :: (forall r. ByteString -> ByteString -> Buffer -> Pos -> More + -> Failure r -> Success ByteString r -> Result r) + -> (ByteString -> ByteString) + -> ByteString -> Parser ByteString +string_ suspended f s0 = T.Parser $ \t pos more lose succ -> + let n = B.length s + s = f s0 + in if lengthAtLeast pos n t + then let t' = substring pos (Pos n) t + in if s == f t' + then succ t (pos + Pos n) more t' + else lose t pos more [] "string" + else let t' = Buf.unsafeDrop (fromPos pos) t + in if f t' `B.isPrefixOf` s + then suspended s (B.drop (B.length t') s) t pos more lose succ + else lose t pos more [] "string" +{-# INLINE string_ #-} + +stringSuspended :: (ByteString -> ByteString) + -> ByteString -> ByteString -> Buffer -> Pos -> More + -> Failure r + -> Success ByteString r + -> Result r +stringSuspended f s0 s t pos more lose succ = + runParser (demandInput_ >>= go) t pos more lose succ + where go s'0 = T.Parser $ \t' pos' more' lose' succ' -> + let m = B.length s + s' = f s'0 + n = B.length s' + in if n >= m + then if B.unsafeTake m s' == s + then let o = Pos (B.length s0) + in succ' t' (pos' + o) more' + (substring pos' o t') + else lose' t' pos' more' [] "string" + else if s' == B.unsafeTake n s + then stringSuspended f s0 (B.unsafeDrop n s) + t' pos' more' lose' succ' + else lose' t' pos' more' [] "string" + +-- | Skip past input for as long as the predicate returns 'True'. +skipWhile :: (Word8 -> Bool) -> Parser () +skipWhile p = go + where + go = do + t <- B8.takeWhile p <$> get + continue <- inputSpansChunks (B.length t) + when continue go +{-# INLINE skipWhile #-} + +-- | Consume input as long as the predicate returns 'False' +-- (i.e. until it returns 'True'), and return the consumed input. +-- +-- This parser does not fail. It will return an empty string if the +-- predicate returns 'True' on the first byte of input. +-- +-- /Note/: Because this parser does not fail, do not use it with +-- combinators such as 'Control.Applicative.many', because such +-- parsers loop until a failure occurs. Careless use will thus result +-- in an infinite loop. +takeTill :: (Word8 -> Bool) -> Parser ByteString +takeTill p = takeWhile (not . p) +{-# INLINE takeTill #-} + +-- | Consume input as long as the predicate returns 'True', and return +-- the consumed input. +-- +-- This parser does not fail. It will return an empty string if the +-- predicate returns 'False' on the first byte of input. +-- +-- /Note/: Because this parser does not fail, do not use it with +-- combinators such as 'Control.Applicative.many', because such +-- parsers loop until a failure occurs. Careless use will thus result +-- in an infinite loop. +takeWhile :: (Word8 -> Bool) -> Parser ByteString +takeWhile p = do + s <- B8.takeWhile p <$> get + continue <- inputSpansChunks (B.length s) + if continue + then takeWhileAcc p [s] + else return s +{-# INLINE takeWhile #-} + +takeWhileAcc :: (Word8 -> Bool) -> [ByteString] -> Parser ByteString +takeWhileAcc p = go + where + go acc = do + s <- B8.takeWhile p <$> get + continue <- inputSpansChunks (B.length s) + if continue + then go (s:acc) + else return $ concatReverse (s:acc) +{-# INLINE takeWhileAcc #-} + +takeRest :: Parser [ByteString] +takeRest = go [] + where + go acc = do + input <- wantInput + if input + then do + s <- get + advance (B.length s) + go (s:acc) + else return (reverse acc) + +-- | Consume all remaining input and return it as a single string. +takeByteString :: Parser ByteString +takeByteString = B.concat `fmap` takeRest + +-- | Consume all remaining input and return it as a single string. +takeLazyByteString :: Parser L.ByteString +takeLazyByteString = L.fromChunks `fmap` takeRest + +data T s = T {-# UNPACK #-} !Int s + +scan_ :: (s -> [ByteString] -> Parser r) -> s -> (s -> Word8 -> Maybe s) + -> Parser r +scan_ f s0 p = go [] s0 + where + go acc s1 = do + let scanner (B.PS fp off len) = + withForeignPtr fp $ \ptr0 -> do + let start = ptr0 `plusPtr` off + end = start `plusPtr` len + inner ptr !s + | ptr < end = do + w <- peek ptr + case p s w of + Just s' -> inner (ptr `plusPtr` 1) s' + _ -> done (ptr `minusPtr` start) s + | otherwise = done (ptr `minusPtr` start) s + done !i !s = return (T i s) + inner start s1 + bs <- get + let T i s' = inlinePerformIO $ scanner bs + !h = B.unsafeTake i bs + continue <- inputSpansChunks i + if continue + then go (h:acc) s' + else f s' (h:acc) +{-# INLINE scan_ #-} + +-- | A stateful scanner. The predicate consumes and transforms a +-- state argument, and each transformed state is passed to successive +-- invocations of the predicate on each byte of the input until one +-- returns 'Nothing' or the input ends. +-- +-- This parser does not fail. It will return an empty string if the +-- predicate returns 'Nothing' on the first byte of input. +-- +-- /Note/: Because this parser does not fail, do not use it with +-- combinators such as 'Control.Applicative.many', because such +-- parsers loop until a failure occurs. Careless use will thus result +-- in an infinite loop. +scan :: s -> (s -> Word8 -> Maybe s) -> Parser ByteString +scan = scan_ $ \_ chunks -> return $! concatReverse chunks +{-# INLINE scan #-} + +-- | Like 'scan', but generalized to return the final state of the +-- scanner. +runScanner :: s -> (s -> Word8 -> Maybe s) -> Parser (ByteString, s) +runScanner = scan_ $ \s xs -> let !sx = concatReverse xs in return (sx, s) +{-# INLINE runScanner #-} + +-- | Consume input as long as the predicate returns 'True', and return +-- the consumed input. +-- +-- This parser requires the predicate to succeed on at least one byte +-- of input: it will fail if the predicate never returns 'True' or if +-- there is no input left. +takeWhile1 :: (Word8 -> Bool) -> Parser ByteString +takeWhile1 p = do + (`when` demandInput) =<< endOfChunk + s <- B8.takeWhile p <$> get + let len = B.length s + if len == 0 + then fail "takeWhile1" + else do + advance len + eoc <- endOfChunk + if eoc + then takeWhileAcc p [s] + else return s +{-# INLINE takeWhile1 #-} + +-- | Match any byte in a set. +-- +-- >vowel = inClass "aeiou" +-- +-- Range notation is supported. +-- +-- >halfAlphabet = inClass "a-nA-N" +-- +-- To add a literal @\'-\'@ to a set, place it at the beginning or end +-- of the string. +inClass :: String -> Word8 -> Bool +inClass s = (`memberWord8` mySet) + where mySet = charClass s + {-# NOINLINE mySet #-} +{-# INLINE inClass #-} + +-- | Match any byte not in a set. +notInClass :: String -> Word8 -> Bool +notInClass s = not . inClass s +{-# INLINE notInClass #-} + +-- | Match any byte. +anyWord8 :: Parser Word8 +anyWord8 = satisfy $ const True +{-# INLINE anyWord8 #-} + +-- | Match a specific byte. +word8 :: Word8 -> Parser Word8 +word8 c = satisfy (== c) show c +{-# INLINE word8 #-} + +-- | Match any byte except the given one. +notWord8 :: Word8 -> Parser Word8 +notWord8 c = satisfy (/= c) "not " ++ show c +{-# INLINE notWord8 #-} + +-- | Match any byte, to perform lookahead. Returns 'Nothing' if end of +-- input has been reached. Does not consume any input. +-- +-- /Note/: Because this parser does not fail, do not use it with +-- combinators such as 'Control.Applicative.many', because such +-- parsers loop until a failure occurs. Careless use will thus result +-- in an infinite loop. +peekWord8 :: Parser (Maybe Word8) +peekWord8 = T.Parser $ \t pos@(Pos pos_) more _lose succ -> + case () of + _| pos_ < Buf.length t -> + let !w = Buf.unsafeIndex t pos_ + in succ t pos more (Just w) + | more == Complete -> + succ t pos more Nothing + | otherwise -> + let succ' t' pos' more' = let !w = Buf.unsafeIndex t' pos_ + in succ t' pos' more' (Just w) + lose' t' pos' more' = succ t' pos' more' Nothing + in prompt t pos more lose' succ' +{-# INLINE peekWord8 #-} + +-- | Match any byte, to perform lookahead. Does not consume any +-- input, but will fail if end of input has been reached. +peekWord8' :: Parser Word8 +peekWord8' = T.Parser $ \t pos more lose succ -> + if lengthAtLeast pos 1 t + then succ t pos more (Buf.unsafeIndex t (fromPos pos)) + else let succ' t' pos' more' bs' = succ t' pos' more' $! B.unsafeHead bs' + in ensureSuspended 1 t pos more lose succ' +{-# INLINE peekWord8' #-} + +-- | Match either a single newline character @\'\\n\'@, or a carriage +-- return followed by a newline character @\"\\r\\n\"@. +endOfLine :: Parser () +endOfLine = (word8 10 >> return ()) <|> (string "\r\n" >> return ()) + +-- | Terminal failure continuation. +failK :: Failure a +failK t (Pos pos) _more stack msg = Fail (Buf.unsafeDrop pos t) stack msg +{-# INLINE failK #-} + +-- | Terminal success continuation. +successK :: Success a a +successK t (Pos pos) _more a = Done (Buf.unsafeDrop pos t) a +{-# INLINE successK #-} + +-- | Run a parser. +parse :: Parser a -> ByteString -> Result a +parse m s = T.runParser m (buffer s) (Pos 0) Incomplete failK successK +{-# INLINE parse #-} + +-- | Run a parser that cannot be resupplied via a 'Partial' result. +-- +-- This function does not force a parser to consume all of its input. +-- Instead, any residual input will be discarded. To force a parser +-- to consume all of its input, use something like this: +-- +-- @ +--'parseOnly' (myParser 'Control.Applicative.<*' 'endOfInput') +-- @ +parseOnly :: Parser a -> ByteString -> Either String a +parseOnly m s = case T.runParser m (buffer s) (Pos 0) Complete failK successK of + Fail _ [] err -> Left err + Fail _ ctxs err -> Left (intercalate " > " ctxs ++ ": " ++ err) + Done _ a -> Right a + _ -> error "parseOnly: impossible error!" +{-# INLINE parseOnly #-} + +get :: Parser ByteString +get = T.Parser $ \t pos more _lose succ -> + succ t pos more (Buf.unsafeDrop (fromPos pos) t) +{-# INLINE get #-} + +endOfChunk :: Parser Bool +endOfChunk = T.Parser $ \t pos more _lose succ -> + succ t pos more (fromPos pos == Buf.length t) +{-# INLINE endOfChunk #-} + +inputSpansChunks :: Int -> Parser Bool +inputSpansChunks i = T.Parser $ \t pos_ more _lose succ -> + let pos = pos_ + Pos i + in if fromPos pos < Buf.length t || more == Complete + then succ t pos more False + else let lose' t' pos' more' = succ t' pos' more' False + succ' t' pos' more' = succ t' pos' more' True + in prompt t pos more lose' succ' +{-# INLINE inputSpansChunks #-} + +advance :: Int -> Parser () +advance n = T.Parser $ \t pos more _lose succ -> + succ t (pos + Pos n) more () +{-# INLINE advance #-} + +ensureSuspended :: Int -> Buffer -> Pos -> More + -> Failure r + -> Success ByteString r + -> Result r +ensureSuspended n t pos more lose succ = + runParser (demandInput >> go) t pos more lose succ + where go = T.Parser $ \t' pos' more' lose' succ' -> + if lengthAtLeast pos' n t' + then succ' t' pos' more' (substring pos (Pos n) t') + else runParser (demandInput >> go) t' pos' more' lose' succ' + +-- | If at least @n@ elements of input are available, return the +-- current input, otherwise fail. +ensure :: Int -> Parser ByteString +ensure n = T.Parser $ \t pos more lose succ -> + if lengthAtLeast pos n t + then succ t pos more (substring pos (Pos n) t) + -- The uncommon case is kept out-of-line to reduce code size: + else ensureSuspended n t pos more lose succ +{-# INLINE ensure #-} + +-- | Return both the result of a parse and the portion of the input +-- that was consumed while it was being parsed. +match :: Parser a -> Parser (ByteString, a) +match p = T.Parser $ \t pos more lose succ -> + let succ' t' pos' more' a = + succ t' pos' more' (substring pos (pos'-pos) t', a) + in runParser p t pos more lose succ' + +lengthAtLeast :: Pos -> Int -> Buffer -> Bool +lengthAtLeast (Pos pos) n bs = Buf.length bs >= pos + n +{-# INLINE lengthAtLeast #-} + +substring :: Pos -> Pos -> Buffer -> ByteString +substring (Pos pos) (Pos n) = Buf.substring pos n +{-# INLINE substring #-} diff --git a/haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec/Combinator.hs b/haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec/Combinator.hs new file mode 100644 index 00000000..dde0c27a --- /dev/null +++ b/haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec/Combinator.hs @@ -0,0 +1,233 @@ +{-# LANGUAGE BangPatterns, CPP #-} +#if __GLASGOW_HASKELL__ >= 702 +{-# LANGUAGE Trustworthy #-} -- Imports internal modules +#endif +-- | +-- Module : Data.Attoparsec.Combinator +-- Copyright : Daan Leijen 1999-2001, Bryan O'Sullivan 2007-2015 +-- License : BSD3 +-- +-- Maintainer : bos@serpentine.com +-- Stability : experimental +-- Portability : portable +-- +-- Useful parser combinators, similar to those provided by Parsec. +module Data.Attoparsec.Combinator + ( + -- * Combinators + try + , () + , choice + , count + , option + , many' + , many1 + , many1' + , manyTill + , manyTill' + , sepBy + , sepBy' + , sepBy1 + , sepBy1' + , skipMany + , skipMany1 + , eitherP + , feed + , satisfyElem + , endOfInput + , atEnd + , lookAhead + ) where + +#if !MIN_VERSION_base(4,8,0) +import Control.Applicative (Applicative(..), (<$>)) +import Data.Monoid (Monoid(mappend)) +#endif +import Control.Applicative (Alternative(..), empty, liftA2, many, (<|>)) +import Control.Monad (MonadPlus(..)) +import Data.Attoparsec.Internal.Types (Parser(..), IResult(..)) +import Data.Attoparsec.Internal (endOfInput, atEnd, satisfyElem) +import Data.ByteString (ByteString) +import Prelude hiding (succ) + +-- | Attempt a parse, and if it fails, rewind the input so that no +-- input appears to have been consumed. +-- +-- This combinator is provided for compatibility with Parsec. +-- attoparsec parsers always backtrack on failure. +try :: Parser i a -> Parser i a +try p = p +{-# INLINE try #-} + +-- | Name the parser, in case failure occurs. +() :: Parser i a + -> String -- ^ the name to use if parsing fails + -> Parser i a +p msg0 = Parser $ \t pos more lose succ -> + let lose' t' pos' more' strs msg = lose t' pos' more' (msg0:strs) msg + in runParser p t pos more lose' succ +{-# INLINE () #-} +infix 0 + +-- | @choice ps@ tries to apply the actions in the list @ps@ in order, +-- until one of them succeeds. Returns the value of the succeeding +-- action. +choice :: Alternative f => [f a] -> f a +choice = foldr (<|>) empty +{-# SPECIALIZE choice :: [Parser ByteString a] + -> Parser ByteString a #-} + +-- | @option x p@ tries to apply action @p@. If @p@ fails without +-- consuming input, it returns the value @x@, otherwise the value +-- returned by @p@. +-- +-- > priority = option 0 (digitToInt <$> digit) +option :: Alternative f => a -> f a -> f a +option x p = p <|> pure x +{-# SPECIALIZE option :: a -> Parser ByteString a -> Parser ByteString a #-} + +-- | A version of 'liftM2' that is strict in the result of its first +-- action. +liftM2' :: (Monad m) => (a -> b -> c) -> m a -> m b -> m c +liftM2' f a b = do + !x <- a + y <- b + return (f x y) +{-# INLINE liftM2' #-} + +-- | @many' p@ applies the action @p@ /zero/ or more times. Returns a +-- list of the returned values of @p@. The value returned by @p@ is +-- forced to WHNF. +-- +-- > word = many' letter +many' :: (MonadPlus m) => m a -> m [a] +many' p = many_p + where many_p = some_p `mplus` return [] + some_p = liftM2' (:) p many_p +{-# INLINE many' #-} + +-- | @many1 p@ applies the action @p@ /one/ or more times. Returns a +-- list of the returned values of @p@. +-- +-- > word = many1 letter +many1 :: Alternative f => f a -> f [a] +many1 p = liftA2 (:) p (many p) +{-# INLINE many1 #-} + +-- | @many1' p@ applies the action @p@ /one/ or more times. Returns a +-- list of the returned values of @p@. The value returned by @p@ is +-- forced to WHNF. +-- +-- > word = many1' letter +many1' :: (MonadPlus m) => m a -> m [a] +many1' p = liftM2' (:) p (many' p) +{-# INLINE many1' #-} + +-- | @sepBy p sep@ applies /zero/ or more occurrences of @p@, separated +-- by @sep@. Returns a list of the values returned by @p@. +-- +-- > commaSep p = p `sepBy` (char ',') +sepBy :: Alternative f => f a -> f s -> f [a] +sepBy p s = liftA2 (:) p ((s *> sepBy1 p s) <|> pure []) <|> pure [] +{-# SPECIALIZE sepBy :: Parser ByteString a -> Parser ByteString s + -> Parser ByteString [a] #-} + +-- | @sepBy' p sep@ applies /zero/ or more occurrences of @p@, separated +-- by @sep@. Returns a list of the values returned by @p@. The value +-- returned by @p@ is forced to WHNF. +-- +-- > commaSep p = p `sepBy'` (char ',') +sepBy' :: (MonadPlus m) => m a -> m s -> m [a] +sepBy' p s = scan `mplus` return [] + where scan = liftM2' (:) p ((s >> sepBy1' p s) `mplus` return []) +{-# SPECIALIZE sepBy' :: Parser ByteString a -> Parser ByteString s + -> Parser ByteString [a] #-} + +-- | @sepBy1 p sep@ applies /one/ or more occurrences of @p@, separated +-- by @sep@. Returns a list of the values returned by @p@. +-- +-- > commaSep p = p `sepBy1` (char ',') +sepBy1 :: Alternative f => f a -> f s -> f [a] +sepBy1 p s = scan + where scan = liftA2 (:) p ((s *> scan) <|> pure []) +{-# SPECIALIZE sepBy1 :: Parser ByteString a -> Parser ByteString s + -> Parser ByteString [a] #-} + +-- | @sepBy1' p sep@ applies /one/ or more occurrences of @p@, separated +-- by @sep@. Returns a list of the values returned by @p@. The value +-- returned by @p@ is forced to WHNF. +-- +-- > commaSep p = p `sepBy1'` (char ',') +sepBy1' :: (MonadPlus m) => m a -> m s -> m [a] +sepBy1' p s = scan + where scan = liftM2' (:) p ((s >> scan) `mplus` return []) +{-# SPECIALIZE sepBy1' :: Parser ByteString a -> Parser ByteString s + -> Parser ByteString [a] #-} + +-- | @manyTill p end@ applies action @p@ /zero/ or more times until +-- action @end@ succeeds, and returns the list of values returned by +-- @p@. This can be used to scan comments: +-- +-- > simpleComment = string "") +-- +-- (Note the overlapping parsers @anyChar@ and @string \"-->\"@. +-- While this will work, it is not very efficient, as it will cause a +-- lot of backtracking.) +manyTill :: Alternative f => f a -> f b -> f [a] +manyTill p end = scan + where scan = (end *> pure []) <|> liftA2 (:) p scan +{-# SPECIALIZE manyTill :: Parser ByteString a -> Parser ByteString b + -> Parser ByteString [a] #-} + +-- | @manyTill' p end@ applies action @p@ /zero/ or more times until +-- action @end@ succeeds, and returns the list of values returned by +-- @p@. This can be used to scan comments: +-- +-- > simpleComment = string "") +-- +-- (Note the overlapping parsers @anyChar@ and @string \"-->\"@. +-- While this will work, it is not very efficient, as it will cause a +-- lot of backtracking.) +-- +-- The value returned by @p@ is forced to WHNF. +manyTill' :: (MonadPlus m) => m a -> m b -> m [a] +manyTill' p end = scan + where scan = (end >> return []) `mplus` liftM2' (:) p scan +{-# SPECIALIZE manyTill' :: Parser ByteString a -> Parser ByteString b + -> Parser ByteString [a] #-} + +-- | Skip zero or more instances of an action. +skipMany :: Alternative f => f a -> f () +skipMany p = scan + where scan = (p *> scan) <|> pure () +{-# SPECIALIZE skipMany :: Parser ByteString a -> Parser ByteString () #-} + +-- | Skip one or more instances of an action. +skipMany1 :: Alternative f => f a -> f () +skipMany1 p = p *> skipMany p +{-# SPECIALIZE skipMany1 :: Parser ByteString a -> Parser ByteString () #-} + +-- | Apply the given action repeatedly, returning every result. +count :: Monad m => Int -> m a -> m [a] +count n p = sequence (replicate n p) +{-# INLINE count #-} + +-- | Combine two alternatives. +eitherP :: (Alternative f) => f a -> f b -> f (Either a b) +eitherP a b = (Left <$> a) <|> (Right <$> b) +{-# INLINE eitherP #-} + +-- | If a parser has returned a 'T.Partial' result, supply it with more +-- input. +feed :: Monoid i => IResult i r -> i -> IResult i r +feed (Fail t ctxs msg) d = Fail (mappend t d) ctxs msg +feed (Partial k) d = k d +feed (Done t r) d = Done (mappend t d) r +{-# INLINE feed #-} + +-- | Apply a parser without consuming any input. +lookAhead :: Parser i a -> Parser i a +lookAhead p = Parser $ \t pos more lose succ -> + let succ' t' _pos' more' = succ t' pos more' + in runParser p t pos more lose succ' +{-# INLINE lookAhead #-} diff --git a/haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec/Internal.hs b/haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec/Internal.hs new file mode 100644 index 00000000..ee758b26 --- /dev/null +++ b/haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec/Internal.hs @@ -0,0 +1,157 @@ +{-# LANGUAGE BangPatterns, CPP, ScopedTypeVariables #-} +-- | +-- Module : Data.Attoparsec.Internal +-- Copyright : Bryan O'Sullivan 2007-2015 +-- License : BSD3 +-- +-- Maintainer : bos@serpentine.com +-- Stability : experimental +-- Portability : unknown +-- +-- Simple, efficient parser combinators, loosely based on the Parsec +-- library. + +module Data.Attoparsec.Internal + ( compareResults + , prompt + , demandInput + , demandInput_ + , wantInput + , endOfInput + , atEnd + , satisfyElem + , concatReverse + ) where + +#if !MIN_VERSION_base(4,8,0) +import Control.Applicative ((<$>)) +import Data.Monoid (Monoid, mconcat) +#endif +import Data.Attoparsec.Internal.Types +import Data.ByteString (ByteString) +import Prelude hiding (succ) + +-- | Compare two 'IResult' values for equality. +-- +-- If both 'IResult's are 'Partial', the result will be 'Nothing', as +-- they are incomplete and hence their equality cannot be known. +-- (This is why there is no 'Eq' instance for 'IResult'.) +compareResults :: (Eq i, Eq r) => IResult i r -> IResult i r -> Maybe Bool +compareResults (Fail t0 ctxs0 msg0) (Fail t1 ctxs1 msg1) = + Just (t0 == t1 && ctxs0 == ctxs1 && msg0 == msg1) +compareResults (Done t0 r0) (Done t1 r1) = + Just (t0 == t1 && r0 == r1) +compareResults (Partial _) (Partial _) = Nothing +compareResults _ _ = Just False + +-- | Ask for input. If we receive any, pass the augmented input to a +-- success continuation, otherwise to a failure continuation. +prompt :: Chunk t + => State t -> Pos -> More + -> (State t -> Pos -> More -> IResult t r) + -> (State t -> Pos -> More -> IResult t r) + -> IResult t r +prompt t pos _more lose succ = Partial $ \s -> + if nullChunk s + then lose t pos Complete + else succ (pappendChunk t s) pos Incomplete +{-# SPECIALIZE prompt :: State ByteString -> Pos -> More + -> (State ByteString -> Pos -> More + -> IResult ByteString r) + -> (State ByteString -> Pos -> More + -> IResult ByteString r) + -> IResult ByteString r #-} + +-- | Immediately demand more input via a 'Partial' continuation +-- result. +demandInput :: Chunk t => Parser t () +demandInput = Parser $ \t pos more lose succ -> + case more of + Complete -> lose t pos more [] "not enough input" + _ -> let lose' _ pos' more' = lose t pos' more' [] "not enough input" + succ' t' pos' more' = succ t' pos' more' () + in prompt t pos more lose' succ' +{-# SPECIALIZE demandInput :: Parser ByteString () #-} + +-- | Immediately demand more input via a 'Partial' continuation +-- result. Return the new input. +demandInput_ :: Chunk t => Parser t t +demandInput_ = Parser $ \t pos more lose succ -> + case more of + Complete -> lose t pos more [] "not enough input" + _ -> Partial $ \s -> + if nullChunk s + then lose t pos Complete [] "not enough input" + else succ (pappendChunk t s) pos more s +{-# SPECIALIZE demandInput_ :: Parser ByteString ByteString #-} + +-- | This parser always succeeds. It returns 'True' if any input is +-- available either immediately or on demand, and 'False' if the end +-- of all input has been reached. +wantInput :: forall t . Chunk t => Parser t Bool +wantInput = Parser $ \t pos more _lose succ -> + case () of + _ | pos < atBufferEnd (undefined :: t) t -> succ t pos more True + | more == Complete -> succ t pos more False + | otherwise -> let lose' t' pos' more' = succ t' pos' more' False + succ' t' pos' more' = succ t' pos' more' True + in prompt t pos more lose' succ' +{-# INLINE wantInput #-} + +-- | Match only if all input has been consumed. +endOfInput :: forall t . Chunk t => Parser t () +endOfInput = Parser $ \t pos more lose succ -> + case () of + _| pos < atBufferEnd (undefined :: t) t -> lose t pos more [] "endOfInput" + | more == Complete -> succ t pos more () + | otherwise -> + let lose' t' pos' more' _ctx _msg = succ t' pos' more' () + succ' t' pos' more' _a = lose t' pos' more' [] "endOfInput" + in runParser demandInput t pos more lose' succ' +{-# SPECIALIZE endOfInput :: Parser ByteString () #-} + +-- | Return an indication of whether the end of input has been +-- reached. +atEnd :: Chunk t => Parser t Bool +atEnd = not <$> wantInput +{-# INLINE atEnd #-} + +satisfySuspended :: forall t r . Chunk t + => (ChunkElem t -> Bool) + -> State t -> Pos -> More + -> Failure t (State t) r + -> Success t (State t) (ChunkElem t) r + -> IResult t r +satisfySuspended p t pos more lose succ = + runParser (demandInput >> go) t pos more lose succ + where go = Parser $ \t' pos' more' lose' succ' -> + case bufferElemAt (undefined :: t) pos' t' of + Just (e, l) | p e -> succ' t' (pos' + Pos l) more' e + | otherwise -> lose' t' pos' more' [] "satisfyElem" + Nothing -> runParser (demandInput >> go) t' pos' more' lose' succ' +{-# SPECIALIZE satisfySuspended :: (ChunkElem ByteString -> Bool) + -> State ByteString -> Pos -> More + -> Failure ByteString (State ByteString) r + -> Success ByteString (State ByteString) + (ChunkElem ByteString) r + -> IResult ByteString r #-} + +-- | The parser @satisfyElem p@ succeeds for any chunk element for which the +-- predicate @p@ returns 'True'. Returns the element that is +-- actually parsed. +satisfyElem :: forall t . Chunk t + => (ChunkElem t -> Bool) -> Parser t (ChunkElem t) +satisfyElem p = Parser $ \t pos more lose succ -> + case bufferElemAt (undefined :: t) pos t of + Just (e, l) | p e -> succ t (pos + Pos l) more e + | otherwise -> lose t pos more [] "satisfyElem" + Nothing -> satisfySuspended p t pos more lose succ +{-# INLINE satisfyElem #-} + +-- | Concatenate a monoid after reversing its elements. Used to +-- glue together a series of textual chunks that have been accumulated +-- \"backwards\". +concatReverse :: Monoid m => [m] -> m +concatReverse [x] = x +concatReverse xs = mconcat (reverse xs) +{-# INLINE concatReverse #-} diff --git a/haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec/Internal/Fhthagn.hs b/haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec/Internal/Fhthagn.hs new file mode 100644 index 00000000..0e00ed2c --- /dev/null +++ b/haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec/Internal/Fhthagn.hs @@ -0,0 +1,18 @@ +{-# LANGUAGE BangPatterns, Rank2Types, OverloadedStrings, + RecordWildCards, MagicHash, UnboxedTuples #-} + +module Data.Attoparsec.Internal.Fhthagn + ( + inlinePerformIO + ) where + +import GHC.Base (realWorld#) +import GHC.IO (IO(IO)) + +-- | Just like unsafePerformIO, but we inline it. Big performance gains as +-- it exposes lots of things to further inlining. /Very unsafe/. In +-- particular, you should do no memory allocation inside an +-- 'inlinePerformIO' block. On Hugs this is just @unsafePerformIO@. +inlinePerformIO :: IO a -> a +inlinePerformIO (IO m) = case m realWorld# of (# _, r #) -> r +{-# INLINE inlinePerformIO #-} diff --git a/haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec/Internal/Types.hs b/haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec/Internal/Types.hs new file mode 100644 index 00000000..96bc319e --- /dev/null +++ b/haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec/Internal/Types.hs @@ -0,0 +1,243 @@ +{-# LANGUAGE BangPatterns, GeneralizedNewtypeDeriving, OverloadedStrings, + Rank2Types, RecordWildCards, TypeFamilies #-} +-- | +-- Module : Data.Attoparsec.Internal.Types +-- Copyright : Bryan O'Sullivan 2007-2015 +-- License : BSD3 +-- +-- Maintainer : bos@serpentine.com +-- Stability : experimental +-- Portability : unknown +-- +-- Simple, efficient parser combinators, loosely based on the Parsec +-- library. + +module Data.Attoparsec.Internal.Types + ( + Parser(..) + , State + , Failure + , Success + , Pos(..) + , IResult(..) + , More(..) + , (<>) + , Chunk(..) + ) where + +import Control.Applicative as App (Applicative(..), (<$>)) +import Control.Applicative (Alternative(..)) +import Control.DeepSeq (NFData(rnf)) +import Control.Monad (MonadPlus(..)) +import qualified Control.Monad.Fail as Fail (MonadFail(..)) +import Data.Monoid as Mon (Monoid(..)) +import Data.Semigroup (Semigroup(..)) +import Data.Word (Word8) +import Data.ByteString (ByteString) +import qualified Data.ByteString as BS +import Data.ByteString.Internal (w2c) +import Prelude hiding (getChar, succ) +import qualified Data.Attoparsec.ByteString.Buffer as B + +newtype Pos = Pos { fromPos :: Int } + deriving (Eq, Ord, Show, Num) + +-- | The result of a parse. This is parameterised over the type @i@ +-- of string that was processed. +-- +-- This type is an instance of 'Functor', where 'fmap' transforms the +-- value in a 'Done' result. +data IResult i r = + Fail i [String] String + -- ^ The parse failed. The @i@ parameter is the input that had + -- not yet been consumed when the failure occurred. The + -- @[@'String'@]@ is a list of contexts in which the error + -- occurred. The 'String' is the message describing the error, if + -- any. + | Partial (i -> IResult i r) + -- ^ Supply this continuation with more input so that the parser + -- can resume. To indicate that no more input is available, pass + -- an empty string to the continuation. + -- + -- __Note__: if you get a 'Partial' result, do not call its + -- continuation more than once. + | Done i r + -- ^ The parse succeeded. The @i@ parameter is the input that had + -- not yet been consumed (if any) when the parse succeeded. + +instance (Show i, Show r) => Show (IResult i r) where + showsPrec d ir = showParen (d > 10) $ + case ir of + (Fail t stk msg) -> showString "Fail" . f t . f stk . f msg + (Partial _) -> showString "Partial _" + (Done t r) -> showString "Done" . f t . f r + where f :: Show a => a -> ShowS + f x = showChar ' ' . showsPrec 11 x + +instance (NFData i, NFData r) => NFData (IResult i r) where + rnf (Fail t stk msg) = rnf t `seq` rnf stk `seq` rnf msg + rnf (Partial _) = () + rnf (Done t r) = rnf t `seq` rnf r + {-# INLINE rnf #-} + +instance Functor (IResult i) where + fmap _ (Fail t stk msg) = Fail t stk msg + fmap f (Partial k) = Partial (fmap f . k) + fmap f (Done t r) = Done t (f r) + +-- | The core parser type. This is parameterised over the type @i@ +-- of string being processed. +-- +-- This type is an instance of the following classes: +-- +-- * 'Monad', where 'fail' throws an exception (i.e. fails) with an +-- error message. +-- +-- * 'Functor' and 'Applicative', which follow the usual definitions. +-- +-- * 'MonadPlus', where 'mzero' fails (with no error message) and +-- 'mplus' executes the right-hand parser if the left-hand one +-- fails. When the parser on the right executes, the input is reset +-- to the same state as the parser on the left started with. (In +-- other words, attoparsec is a backtracking parser that supports +-- arbitrary lookahead.) +-- +-- * 'Alternative', which follows 'MonadPlus'. +newtype Parser i a = Parser { + runParser :: forall r. + State i -> Pos -> More + -> Failure i (State i) r + -> Success i (State i) a r + -> IResult i r + } + +type family State i +type instance State ByteString = B.Buffer + +type Failure i t r = t -> Pos -> More -> [String] -> String + -> IResult i r +type Success i t a r = t -> Pos -> More -> a -> IResult i r + +-- | Have we read all available input? +data More = Complete | Incomplete + deriving (Eq, Show) + +instance Semigroup More where + c@Complete <> _ = c + _ <> m = m + +instance Mon.Monoid More where + mappend = (<>) + mempty = Incomplete + +instance Monad (Parser i) where + fail = Fail.fail + {-# INLINE fail #-} + + return = App.pure + {-# INLINE return #-} + + m >>= k = Parser $ \t !pos more lose succ -> + let succ' t' !pos' more' a = runParser (k a) t' pos' more' lose succ + in runParser m t pos more lose succ' + {-# INLINE (>>=) #-} + + (>>) = (*>) + {-# INLINE (>>) #-} + + +instance Fail.MonadFail (Parser i) where + fail err = Parser $ \t pos more lose _succ -> lose t pos more [] msg + where msg = "Failed reading: " ++ err + {-# INLINE fail #-} + +plus :: Parser i a -> Parser i a -> Parser i a +plus f g = Parser $ \t pos more lose succ -> + let lose' t' _pos' more' _ctx _msg = runParser g t' pos more' lose succ + in runParser f t pos more lose' succ + +instance MonadPlus (Parser i) where + mzero = fail "mzero" + {-# INLINE mzero #-} + mplus = plus + +instance Functor (Parser i) where + fmap f p = Parser $ \t pos more lose succ -> + let succ' t' pos' more' a = succ t' pos' more' (f a) + in runParser p t pos more lose succ' + {-# INLINE fmap #-} + +apP :: Parser i (a -> b) -> Parser i a -> Parser i b +apP d e = do + b <- d + a <- e + return (b a) +{-# INLINE apP #-} + +instance Applicative (Parser i) where + pure v = Parser $ \t pos more _lose succ -> succ t pos more v + {-# INLINE pure #-} + (<*>) = apP + {-# INLINE (<*>) #-} + m *> k = m >>= \_ -> k + {-# INLINE (*>) #-} + x <* y = x >>= \a -> y >> pure a + {-# INLINE (<*) #-} + +instance Semigroup (Parser i a) where + (<>) = plus + {-# INLINE (<>) #-} + +instance Monoid (Parser i a) where + mempty = fail "mempty" + {-# INLINE mempty #-} + mappend = (<>) + {-# INLINE mappend #-} + +instance Alternative (Parser i) where + empty = fail "empty" + {-# INLINE empty #-} + + (<|>) = plus + {-# INLINE (<|>) #-} + + many v = many_v + where many_v = some_v <|> pure [] + some_v = (:) App.<$> v <*> many_v + {-# INLINE many #-} + + some v = some_v + where + many_v = some_v <|> pure [] + some_v = (:) <$> v <*> many_v + {-# INLINE some #-} + +-- | A common interface for input chunks. +class Monoid c => Chunk c where + type ChunkElem c + -- | Test if the chunk is empty. + nullChunk :: c -> Bool + -- | Append chunk to a buffer. + pappendChunk :: State c -> c -> State c + -- | Position at the end of a buffer. The first argument is ignored. + atBufferEnd :: c -> State c -> Pos + -- | Return the buffer element at the given position along with its length. + bufferElemAt :: c -> Pos -> State c -> Maybe (ChunkElem c, Int) + -- | Map an element to the corresponding character. + -- The first argument is ignored. + chunkElemToChar :: c -> ChunkElem c -> Char + +instance Chunk ByteString where + type ChunkElem ByteString = Word8 + nullChunk = BS.null + {-# INLINE nullChunk #-} + pappendChunk = B.pappend + {-# INLINE pappendChunk #-} + atBufferEnd _ = Pos . B.length + {-# INLINE atBufferEnd #-} + bufferElemAt _ (Pos i) buf + | i < B.length buf = Just (B.unsafeIndex buf i, 1) + | otherwise = Nothing + {-# INLINE bufferElemAt #-} + chunkElemToChar _ = w2c + {-# INLINE chunkElemToChar #-} diff --git a/haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec/Number.hs b/haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec/Number.hs new file mode 100644 index 00000000..d0970d90 --- /dev/null +++ b/haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec/Number.hs @@ -0,0 +1,137 @@ +{-# LANGUAGE DeriveDataTypeable #-} +-- | +-- Module : Data.Attoparsec.Number +-- Copyright : Bryan O'Sullivan 2007-2015 +-- License : BSD3 +-- +-- Maintainer : bos@serpentine.com +-- Stability : experimental +-- Portability : unknown +-- +-- This module is deprecated, and both the module and 'Number' type +-- will be removed in the next major release. Use the +-- package +-- and the 'Data.Scientific.Scientific' type instead. +-- +-- A simple number type, useful for parsing both exact and inexact +-- quantities without losing much precision. +module Data.Attoparsec.Number + {-# DEPRECATED "This module will be removed in the next major release." #-} + ( + Number(..) + ) where + +import Control.DeepSeq (NFData(rnf)) +import Data.Data (Data) +import Data.Function (on) +import Data.Typeable (Typeable) + +-- | A numeric type that can represent integers accurately, and +-- floating point numbers to the precision of a 'Double'. +-- +-- /Note/: this type is deprecated, and will be removed in the next +-- major release. Use the 'Data.Scientific.Scientific' type instead. +data Number = I !Integer + | D {-# UNPACK #-} !Double + deriving (Typeable, Data) +{-# DEPRECATED Number "Use Scientific instead." #-} + +instance Show Number where + show (I a) = show a + show (D a) = show a + +instance NFData Number where + rnf (I _) = () + rnf (D _) = () + {-# INLINE rnf #-} + +binop :: (Integer -> Integer -> a) -> (Double -> Double -> a) + -> Number -> Number -> a +binop _ d (D a) (D b) = d a b +binop i _ (I a) (I b) = i a b +binop _ d (D a) (I b) = d a (fromIntegral b) +binop _ d (I a) (D b) = d (fromIntegral a) b +{-# INLINE binop #-} + +instance Eq Number where + (==) = binop (==) (==) + {-# INLINE (==) #-} + + (/=) = binop (/=) (/=) + {-# INLINE (/=) #-} + +instance Ord Number where + (<) = binop (<) (<) + {-# INLINE (<) #-} + + (<=) = binop (<=) (<=) + {-# INLINE (<=) #-} + + (>) = binop (>) (>) + {-# INLINE (>) #-} + + (>=) = binop (>=) (>=) + {-# INLINE (>=) #-} + + compare = binop compare compare + {-# INLINE compare #-} + +instance Num Number where + (+) = binop (((I$!).) . (+)) (((D$!).) . (+)) + {-# INLINE (+) #-} + + (-) = binop (((I$!).) . (-)) (((D$!).) . (-)) + {-# INLINE (-) #-} + + (*) = binop (((I$!).) . (*)) (((D$!).) . (*)) + {-# INLINE (*) #-} + + abs (I a) = I $! abs a + abs (D a) = D $! abs a + {-# INLINE abs #-} + + negate (I a) = I $! negate a + negate (D a) = D $! negate a + {-# INLINE negate #-} + + signum (I a) = I $! signum a + signum (D a) = D $! signum a + {-# INLINE signum #-} + + fromInteger = (I$!) . fromInteger + {-# INLINE fromInteger #-} + +instance Real Number where + toRational (I a) = fromIntegral a + toRational (D a) = toRational a + {-# INLINE toRational #-} + +instance Fractional Number where + fromRational = (D$!) . fromRational + {-# INLINE fromRational #-} + + (/) = binop (((D$!).) . (/) `on` fromIntegral) + (((D$!).) . (/)) + {-# INLINE (/) #-} + + recip (I a) = D $! recip (fromIntegral a) + recip (D a) = D $! recip a + {-# INLINE recip #-} + +instance RealFrac Number where + properFraction (I a) = (fromIntegral a,0) + properFraction (D a) = case properFraction a of + (i,d) -> (i,D d) + {-# INLINE properFraction #-} + truncate (I a) = fromIntegral a + truncate (D a) = truncate a + {-# INLINE truncate #-} + round (I a) = fromIntegral a + round (D a) = round a + {-# INLINE round #-} + ceiling (I a) = fromIntegral a + ceiling (D a) = ceiling a + {-# INLINE ceiling #-} + floor (I a) = fromIntegral a + floor (D a) = floor a + {-# INLINE floor #-} diff --git a/haddock-library/vendor/attoparsec-0.13.1.0/LICENSE b/haddock-library/vendor/attoparsec-0.13.1.0/LICENSE new file mode 100644 index 00000000..97392a62 --- /dev/null +++ b/haddock-library/vendor/attoparsec-0.13.1.0/LICENSE @@ -0,0 +1,30 @@ +Copyright (c) Lennart Kolmodin + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions +are met: + +1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + +2. Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + +3. Neither the name of the author nor the names of his contributors + may be used to endorse or promote products derived from this software + without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE CONTRIBUTORS ``AS IS'' AND ANY EXPRESS +OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED +WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE +DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR +ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS +OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) +HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, +STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN +ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +POSSIBILITY OF SUCH DAMAGE. diff --git a/haddock.cabal b/haddock.cabal index 160316e9..fb16a2a9 100644 --- a/haddock.cabal +++ b/haddock.cabal @@ -47,7 +47,7 @@ executable haddock build-depends: base >= 4.3 && < 4.11 if flag(in-ghc-tree) - hs-source-dirs: haddock-api/src, haddock-library/vendor/attoparsec-0.12.1.1, haddock-library/src + hs-source-dirs: haddock-api/src, haddock-library/vendor/attoparsec-0.13.1.0, haddock-library/src cpp-options: -DIN_GHC_TREE build-depends: filepath, -- cgit v1.2.3 From 393920f125d1870c4fec5a09a5ac2dddc8da746b Mon Sep 17 00:00:00 2001 From: Sergey Vinokurov Date: Sun, 30 Oct 2016 17:39:50 +0200 Subject: Improve error message --- haddock-api/src/Haddock.hs | 2 +- html-test/ref/SpuriousSuperclassConstraints.html | 4 ++-- html-test/src/SpuriousSuperclassConstraints.hs | 2 +- 3 files changed, 4 insertions(+), 4 deletions(-) diff --git a/haddock-api/src/Haddock.hs b/haddock-api/src/Haddock.hs index dec85b79..3971a5b7 100644 --- a/haddock-api/src/Haddock.hs +++ b/haddock-api/src/Haddock.hs @@ -489,7 +489,7 @@ shortcutFlags flags = do when ((Flag_GenIndex `elem` flags || Flag_GenContents `elem` flags) && Flag_Html `elem` flags) $ - throwE "-h cannot be used with --gen-index or --gen-contents" + throwE "-h/--html cannot be used with --gen-index or --gen-contents" when ((Flag_GenIndex `elem` flags || Flag_GenContents `elem` flags) && Flag_Hoogle `elem` flags) $ diff --git a/html-test/ref/SpuriousSuperclassConstraints.html b/html-test/ref/SpuriousSuperclassConstraints.html index b7c707c5..0f38d15c 100644 --- a/html-test/ref/SpuriousSuperclassConstraints.html +++ b/html-test/ref/SpuriousSuperclassConstraints.html @@ -56,7 +56,7 @@ window.onload = function () {pageLoad();}; >http://www.haskell.org/pipermail/haskell-cafe/2012-September/103600.html

    And here is the corresponding theard on glasgow-haskell-users:

    And here is the corresponding thread on glasgow-haskell-users:

    http://www.haskell.org/pipermail/glasgow-haskell-users/2012-September/022914.html \ No newline at end of file +> diff --git a/html-test/src/SpuriousSuperclassConstraints.hs b/html-test/src/SpuriousSuperclassConstraints.hs index d9e43e1c..3e230945 100644 --- a/html-test/src/SpuriousSuperclassConstraints.hs +++ b/html-test/src/SpuriousSuperclassConstraints.hs @@ -7,7 +7,7 @@ -- -- -- --- And here is the corresponding theard on glasgow-haskell-users: +-- And here is the corresponding thread on glasgow-haskell-users: -- -- -- -- cgit v1.2.3 From 02787004ffeb16c9d848b77b6e23598b58596348 Mon Sep 17 00:00:00 2001 From: Alex Biehl Date: Sun, 30 Apr 2017 10:07:46 +0200 Subject: Correctly remember collapsed sections (#608) Now the "collapsed" cookie stores which sections have changed state instead of which are collapsed. --- haddock-api/resources/html/haddock-util.js | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/haddock-api/resources/html/haddock-util.js b/haddock-api/resources/html/haddock-util.js index 05bdaef5..967e2026 100644 --- a/haddock-api/resources/html/haddock-util.js +++ b/haddock-api/resources/html/haddock-util.js @@ -52,17 +52,17 @@ function toggleSection(id) { var b = toggleShow(document.getElementById("section." + id)); toggleCollapser(document.getElementById("control." + id), b); - rememberCollapsed(id, b); + rememberCollapsed(id); return b; } var collapsed = {}; -function rememberCollapsed(id, b) +function rememberCollapsed(id) { - if(b) + if(collapsed[id]) delete collapsed[id] else - collapsed[id] = null; + collapsed[id] = true; var sections = []; for(var i in collapsed) -- cgit v1.2.3 From 2163981e773b76212b2265a1eb03208ee2e7edf2 Mon Sep 17 00:00:00 2001 From: Alex Biehl Date: Mon, 1 May 2017 17:40:36 +0200 Subject: Lazily decode docMap and argMap (#610) These are only used in case of a doc reexport so most of the time decoding these is wasted work. --- haddock-api/src/Haddock/InterfaceFile.hs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/haddock-api/src/Haddock/InterfaceFile.hs b/haddock-api/src/Haddock/InterfaceFile.hs index 78853a79..3365581f 100644 --- a/haddock-api/src/Haddock/InterfaceFile.hs +++ b/haddock-api/src/Haddock/InterfaceFile.hs @@ -83,7 +83,7 @@ binaryInterfaceMagic = 0xD0Cface -- binaryInterfaceVersion :: Word16 #if (__GLASGOW_HASKELL__ >= 802) && (__GLASGOW_HASKELL__ < 804) -binaryInterfaceVersion = 29 +binaryInterfaceVersion = 30 binaryInterfaceVersionCompatibility :: [Word16] binaryInterfaceVersionCompatibility = [binaryInterfaceVersion] @@ -377,6 +377,7 @@ instance Binary InstalledInterface where put_ bh modu put_ bh is_sig put_ bh info + lazyPut bh (docMap, argMap) put_ bh docMap put_ bh argMap put_ bh exps @@ -389,8 +390,7 @@ instance Binary InstalledInterface where modu <- get bh is_sig <- get bh info <- get bh - docMap <- get bh - argMap <- get bh + ~(docMap, argMap) <- lazyGet bh exps <- get bh visExps <- get bh opts <- get bh -- cgit v1.2.3 From e0e6615dd421f1b332ce2b11a98de768fa7c29a8 Mon Sep 17 00:00:00 2001 From: Alex Biehl Date: Mon, 1 May 2017 21:59:23 +0200 Subject: Fix Binary instance for InstalledInterface (#611) (#610) introduced lazy decoding for docs from InstalledInterface but forgot to remove the original calls to get and put_ --- haddock-api/src/Haddock/InterfaceFile.hs | 2 -- 1 file changed, 2 deletions(-) diff --git a/haddock-api/src/Haddock/InterfaceFile.hs b/haddock-api/src/Haddock/InterfaceFile.hs index 3365581f..e5c2face 100644 --- a/haddock-api/src/Haddock/InterfaceFile.hs +++ b/haddock-api/src/Haddock/InterfaceFile.hs @@ -378,8 +378,6 @@ instance Binary InstalledInterface where put_ bh is_sig put_ bh info lazyPut bh (docMap, argMap) - put_ bh docMap - put_ bh argMap put_ bh exps put_ bh visExps put_ bh opts -- cgit v1.2.3 From d300632cbc2346f6d95188426e5db5fbeb7c9f34 Mon Sep 17 00:00:00 2001 From: Nathan Collins Date: Thu, 11 May 2017 02:47:55 -0700 Subject: Improve documenation of Haddock markup (#614) * Improve documentation of Haddock markup. - document that Haddock supports inferring types top-level functions with without type signatures, but also explain why using this feature is discouraged. Looks like this feature has been around since version 2.0.0.0 in 2008! - rework the "Module description" section: - move the general discussion of field formatting to the section intro and add examples illustrating the prose for multiline fields. - mention that newlines are preserved in some multiline fields, but not in others (I also noticed that commas in the `Copyright` field are not preserved; I'll look into this bug later). - add a subsection for the module description fields documentation, and put the field keywords in code formatting (double back ticks) instead of double quotes, to be consistent with the typesetting of keywords in other parts of the documentation. - mention that "Named chunks" are not supported in the long-form "Module description" documentation. - fix formatting of keywords in the "Module attributes" section. Perhaps these errors were left over from an automatic translation to ReST from some other format as part of the transition to using Sphinx for Haddock documentation? Also, add a missing reference here; it just said "See ?"! - update footnote about special treatment for re-exporting partially imported modules not being implemented. In my tests it's not implemented at all -- I tried re-exporting both `import B hiding (f)` and `import B (a, b)` style partial imports, and in both cases got the same result as with full imports `import B`: I only get a module reference. * Rework the `Controlling the documentation structure` section. My main goal was to better explain how to use Haddock without an export list, since that's my most common use case, but I hope I improved the section overall: - remove the incomplete `Omitting the export list` section and fold it into the other sections. In particular, summarize the differences between using and not using an export list -- i.e. control over what and in what order is documented -- in the section lead. - add "realistic" examples that use the structure markup, both with and without an export list. I wanted a realistic example here to capture how it can be useful to explain the relationship between a group of functions in a section, in addition to documenting their individual APIs. - make it clear that you can associate documentation chunks with documentation sections when you aren't using an export list, and that doing it in the most obvious way -- i.e. with `-- |`, as you can in the export list -- doesn't work without an export list. It took me a while to figure this out the first time, since the docs didn't explain it at all before. - add a "no export list" example to the section header section. - add more cross references. * Add examples of gotchas for markup in `@...@`. I'm not sure this will help anyone, since I think most people first learn about `@...@` by reading other people's Haddocks, but I've documented the mistakes which I've made and then gotten confused by. * Use consistent Capitalization of Titles. Some titles were in usual title caps, and others only had the first word capitalized. I chose making them all use title caps because that seems to make the cross references look better. --- doc/markup.rst | 450 +++++++++++++++++++++++++++++++++++++++++++++------------ 1 file changed, 357 insertions(+), 93 deletions(-) diff --git a/doc/markup.rst b/doc/markup.rst index b0ebc738..d0b9392d 100644 --- a/doc/markup.rst +++ b/doc/markup.rst @@ -8,7 +8,7 @@ will just generate documentation that contains the type signatures, data type declarations, and class declarations exported by each of the modules being processed. -Documenting a top-level declaration +Documenting a Top-Level Declaration ----------------------------------- The simplest example of a documentation annotation is for documenting @@ -35,6 +35,8 @@ the following: - A type signature for a top-level function, +- A definition for a top-level function with no type signature, + - A ``data`` declaration, - A ``newtype`` declaration, @@ -57,9 +59,12 @@ this is possible in Haddock too: :: -- ^The 'square' function squares an integer. square x = x * x -Note that Haddock doesn't contain a Haskell type system — if you don't -write the type signature for a function, then Haddock can't tell what -its type is and it won't be included in the documentation. +Since Haddock uses the GHC API internally, it can infer types for +top-level functions without type signatures. However, you're +encouraged to add explicit type signatures for all top-level +functions, to make your source code more readable for your users, and +at times to avoid GHC inferring overly general type signatures that +are less helpful to your users. Documentation annotations may span several lines; the annotation continues until the first non-comment line in the source file. For @@ -81,13 +86,13 @@ comments: :: square :: Int -> Int square x = x * x -Documenting parts of a declaration +Documenting Parts of a Declaration ---------------------------------- In addition to documenting the whole declaration, in some cases we can also document individual parts of the declaration. -Class methods +Class Methods ~~~~~~~~~~~~~ Class methods are documented in the same way as top level type @@ -99,7 +104,7 @@ signatures, by using either the ``-- |`` or ``-- ^`` annotations: :: -- | This is the documentation for the 'g' method g :: Int -> a -Constructors and record fields +Constructors and Record Fields ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Constructors are documented like so: :: @@ -150,7 +155,7 @@ would join up documentation of each field and render the result. The reason for this seemingly weird behaviour is the fact that ``someField`` is actually the same (partial) function. -Function arguments +Function Arguments ~~~~~~~~~~~~~~~~~~ Individual arguments to a function may be documented like this: :: @@ -159,7 +164,9 @@ Individual arguments to a function may be documented like this: :: -> Float -- ^ The 'Float' argument -> IO () -- ^ The return value -The module description +.. _module-description: + +The Module Description ---------------------- A module itself may be documented with multiple fields that can then be @@ -183,50 +190,100 @@ module documentation example and then talk about the fields. :: module W where ... -The “Module” field should be clear. It currently doesn't affect the -output of any of the backends but you might want to include it for human -information or for any other tools that might be parsing these comments +All fields are optional but they must be in order if they do appear. +Multi-line fields are accepted but the consecutive lines have to start +indented more than their label. If your label is indented one space as +is often the case with the ``--`` syntax, the consecutive lines have +to start at two spaces at the very least. For example, above we saw a +multiline ``Copyright`` field: :: + + {-| + ... + Copyright : (c) Some Guy, 2013 + Someone Else, 2014 + ... + -} + +That could equivalently be written as :: + + -- | ... + -- Copyright: + -- (c) Some Guy, 2013 + -- Someone Else, 2014 + -- ... + +or as :: + + -- | ... + -- Copyright: (c) Some Guy, 2013 + -- Someone Else, 2014 + -- ... + +but not as :: + + -- | ... + -- Copyright: (c) Some Guy, 2013 + -- Someone Else, 2014 + -- ... + +since the ``Someone`` needs to be indented more than the +``Copyright``. + +Whether new lines and other formatting in multiline fields is +preserved depends on the field type. For example, new lines in the +``Copyright`` field are preserved, but new lines in the +``Description`` field are not; leading whitespace is not preserved in +either [#backend]_. Please note that we do not enforce the format for +any of the fields and the established formats are just a convention. + +.. [#backend] Technically, whitespace and newlines in the + ``Description`` field are preserved verbatim by the HTML backend, + but because most browsers collapse whitespace in HTML, they don't + render as such. But other backends may render this whitespace. + +Fields of the Module Description +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +The ``Module`` field specifies the current module name. Since the module +name can be inferred automatically from the source file, it doesn't +affect the output of any of the backends. But you might want to +include it for any other tools that might be parsing these comments without the help of GHC. -The “Description” field accepts some short text which outlines the +The ``Description`` field accepts some short text which outlines the general purpose of the module. If you're generating HTML, it will show up next to the module link in the module index. -The “Copyright”, “License”, “Maintainer” and “Stability” fields should -be obvious. An alternative spelling for the “License” field is accepted -as “Licence” but the output will always prefer “License”. +The ``Copyright``, ``License``, ``Maintainer`` and ``Stability`` fields should +be obvious. An alternative spelling for the ``License`` field is accepted +as ``Licence`` but the output will always prefer ``License``. -The “Portability” field has seen varied use by different library +The ``Portability`` field has seen varied use by different library authors. Some people put down things like operating system constraints there while others put down which GHC extensions are used in the module. -Note that you might want to consider using the “show-extensions” module -flag for the latter. +Note that you might want to consider using the ``show-extensions`` module +flag for the latter (see :ref:`module-attrs`). -Finally, a module may contain a documentation comment before the module -header, in which case this comment is interpreted by Haddock as an -overall description of the module itself, and placed in a section -entitled “Description” in the documentation for the module. All usual -Haddock markup is valid in this comment. +Finally, a module may contain a documentation comment before the +module header, in which case this comment is interpreted by Haddock as +an overall description of the module itself, and placed in a section +entitled ``Description`` in the documentation for the module. All the +usual Haddock :ref:`markup` is valid in this comment. -All fields are optional but they must be in order if they do appear. -Multi-line fields are accepted but the consecutive lines have to start -indented more than their label. If your label is indented one space as -is often the case with “--” syntax, the consecutive lines have to start -at two spaces at the very least. Please note that we do not enforce the -format for any of the fields and the established formats are just a -convention. - -Controlling the documentation structure +Controlling the Documentation Structure --------------------------------------- Haddock produces interface documentation that lists only the entities -actually exported by the module. The documentation for a module will +actually exported by the module. If there is no export list then all +entities defined by the module are exported. + +The documentation for a module will include *all* entities exported by that module, even if they were -re-exported by another module. The only exception is when Haddock can't +re-exported from another module. The only exception is when Haddock can't see the declaration for the re-exported entity, perhaps because it isn't part of the batch of modules currently being processed. -However, to Haddock the export list has even more significance than just +To Haddock the export list has even more significance than just specifying the entities to be included in the documentation. It also specifies the *order* that entities will be listed in the generated documentation. This leaves the programmer free to implement functions in @@ -237,9 +294,154 @@ is often used as a kind of ad-hoc interface documentation, with headings, groups of functions, type signatures and declarations in comments. +In the next section we give examples illustrating most of the +structural markup features. After the examples we go into more detail +explaining the related markup, namely :ref:`section-headings`, +:ref:`named-chunks`, and :ref:`re-exporting-entire-module`. + +.. _structure-examples: + +Documentation Structure Examples +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +We now give several examples that produce similar results and +illustrate most of the structural markup features. The first two +example use an export list, but the third example does not. + +The first example, using an export list with :ref:`section-headings` +and inline section descriptions: :: + + module Image + ( -- * Image importers + -- + -- | There is a "smart" importer, 'readImage', that determines + -- the image format from the file extension, and several + -- "dumb" format-specific importers that decode the file at + -- the specified type. + readImage + , readPngImage + , readGifImage + , ... + -- * Image exporters + -- ... + ) where + + import Image.Types ( Image ) + + -- | Read an image, guessing the format from the file name. + readImage :: FilePath -> IO Image + readImage = ... + + -- | Read a GIF. + readGifImage :: FilePath -> IO Image + readGifImage = ... + + -- | Read a PNG. + readPngImage :: FilePath -> IO Image + readPngImage = ... + + ... + +Note that the order of the entities ``readPngImage`` and +``readGifImage`` in the export list is different from the order of the +actual declarations farther down; the order in the export list is the +order used in the generated docs. Also, the imported ``Image`` type +itself is not re-exported, so it will not be included in the rendered +docs (see :ref:`hyperlinking-re-exported`). + +The second example, using an export list with a section description +defined elsewhere (the ``$imageImporters``; see :ref:`named-chunks`): +:: + + module Image + ( -- * Image importers + -- + -- $imageImporters + readImage + , readPngImage + , readGifImage + , ... + -- * Image exporters + -- ... + ) where + + import Image.Types ( Image ) + + -- $imageImporters + -- + -- There is a "smart" importer, 'readImage', that determines the + -- image format from the file extension, and several "dumb" + -- format-specific importers that decode the file at the specified + -- type. + + -- | Read an image, guessing the format from the file name. + readImage :: FilePath -> IO Image + readImage = ... + + -- | Read a GIF. + readGifImage :: FilePath -> IO Image + readGifImage = ... + + -- | Read a PNG. + readPngImage :: FilePath -> IO Image + readPngImage = ... + + ... + +This produces the same rendered docs as the first example, but the +source code itself is arguably more readable, since the documentation +for the group of importer functions is closer to their definitions. + +The third example, without an export list: :: + + module Image where + + import Image.Types ( Image ) + + -- * Image importers + -- + -- $imageImporters + -- + -- There is a "smart" importer, 'readImage', that determines the + -- image format from the file extension, and several "dumb" + -- format-specific importers that decode the file at the specified + -- type. + + -- | Read an image, guessing the format from the file name. + readImage :: FilePath -> IO Image + readImage = ... + + -- | Read a GIF. + readGifImage :: FilePath -> IO Image + readGifImage = ... + + -- | Read a PNG. + readPngImage :: FilePath -> IO Image + readPngImage = ... + + ... + + -- * Image exporters + -- ... + +Note that the section headers (e.g. ``-- * Image importers``) now +appear in the module body itself, and that the section documentation +is still given using :ref:`named-chunks`. Unlike in the first example +when using an export list, the named chunk syntax ``$imageImporters`` +*must* be used for the section documentation; attempting to use the +``-- | ...`` syntax to document the image importers here will wrongly +associate the documentation chunk with the next definition! + +.. _section-headings: + +Section Headings +~~~~~~~~~~~~~~~~ + You can insert headings and sub-headings in the documentation by -including annotations at the appropriate point in the export list. For -example: :: +including annotations at the appropriate point in the export list, or +in the module body directly when not using an export list. + +For example: :: module Foo ( -- * Classes @@ -276,7 +478,31 @@ line is also supported. e.g.: :: , g ) where -Re-exporting an entire module +When not using an export list, you may insert section headers in the +module body. Such section headers associate with all entities +declaried up until the next section header. For example: :: + + module Foo where + + -- * Classes + class C a where ... + + -- * Types + -- ** A data type + data T = ... + + -- ** A record + data R = ... + + -- * Some functions + f :: ... + f = ... + g :: ... + g = ... + +.. _re-exporting-entire-module: + +Re-Exporting an Entire Module ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Haskell allows you to re-export the entire contents of a module (or at @@ -292,8 +518,10 @@ What will the Haddock-generated documentation for this module look like? Well, it depends on how the modules ``B`` and ``C`` are imported. If they are imported wholly and without any ``hiding`` qualifiers, then the documentation will just contain a cross-reference to the documentation -for ``B`` and ``C``. However, if the modules are not *completely* -re-exported, for example: :: +for ``B`` and ``C``. + +However, if the modules are not *completely* re-exported, for example: +:: module A ( module B, @@ -304,48 +532,39 @@ re-exported, for example: :: import C (a, b) then Haddock behaves as if the set of entities re-exported from ``B`` -and ``C`` had been listed explicitly in the export list [2]_. +and ``C`` had been listed explicitly in the export list [#notImplemented]_. + +.. Comment: was this ever implemented? Perhaps this part of the docs + should just be removed until it is implemented? -.. [2] - NOTE: this is not fully implemented at the time of writing (version - 0.2). At the moment, Haddock always inserts a cross-reference. +.. [#notImplemented] This is not implemented at the time of writing + (Haddock version 2.17.3 with GHC 8.0.2). At the moment, Haddock + always inserts a module cross-reference. The exception to this rule is when the re-exported module is declared -with the ``hide`` attribute (:ref:`module-attrs`), in which case the module is +with the ``hide`` attribute (see :ref:`module-attrs`), in which +case the module is never cross-referenced; the contents are always expanded in place in the re-exporting module. -Omitting the export list -~~~~~~~~~~~~~~~~~~~~~~~~ - -If there is no export list in the module, how does Haddock generate -documentation? Well, when the export list is omitted, e.g.: :: - - module Foo where - -this is equivalent to an export list which mentions every entity defined -at the top level in this module, and Haddock treats it in the same way. -Furthermore, the generated documentation will retain the order in which -entities are defined in the module. In this special case the module body -may also include section headings (normally they would be ignored by -Haddock). :: +.. _named-chunks: - module Foo where - - -- * This heading will now appear before foo. - - -- | Documentation for 'foo'. - foo :: Integer - foo = 5 +(Named) Chunks of Documentation +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Named chunks of documentation ------------------------------ +It is often desirable to include a chunk of documentation which is not +attached to any particular Haskell declaration, for example, when +giving summary documentation for a group of related definitions (see +:ref:`structure-examples`). In addition to including such documenation +chunks at the top of the file, as part of the +:ref:`module-description`, you can also associate them with +:ref:`section-headings`. -Occasionally it is desirable to include a chunk of documentation which -is not attached to any particular Haskell declaration. There are two -ways to do this: +There are several ways to associate documentation chunks with section +headings, depending on whether you are using an export list or not: -- The documentation can be included in the export list directly, e.g.: :: +- The documentation can be included in the export list directly, by + preceding it with a ``-- |``. For example: :: module Foo ( -- * A section heading @@ -354,11 +573,13 @@ ways to do this: ... ) where + In this case the chunk is not "named". + - If the documentation is large and placing it inline in the export list might bloat the export list and obscure the structure, then it can be given a name and placed out of line in the body of the module. This is achieved with a special form of documentation annotation - “``-- $``”: :: + ``-- $``, which we call a *named chunk*: :: module Foo ( -- * A section heading @@ -371,11 +592,48 @@ ways to do this: -- Here is a large chunk of documentation which may be referred to by -- the name $doc. - The documentation chunk is given a name, which is the sequence of - alphanumeric characters directly after the “``-- $``”, and it may be - referred to by the same name in the export list. + The documentation chunk is given a name of your choice (here + ``doc``), which is the sequence of alphanumeric characters directly + after the ``-- $``, and it may be referred to by the same name in + the export list. Note that named chunks must come *after* any + imports in the module body. + +- If you aren't using an export list, then your only choice is to use + a named chunk with the ``-- $`` syntax. For example: :: + + module Foo where + + -- * A section heading + -- + -- $doc + -- Here is a large chunk of documentation which may be referred to by + -- the name $doc. + + Just like with entity declariations when not using an export list, + named chunks of documentation are associated with the preceding + section header here, or with the implicit top-level documentation + section if there is no preceding section header. + + **Warning**: the form used in the first bullet above, where the + chunk is not named, *does not work* when you aren't using an + export list. For example :: -Hyperlinking and re-exported entities + module Foo where + + -- * A section heading + -- + -- | Some documentation not attached to a particular Haskell entity + + -- | The fooifier. + foo :: ... + + will result in ``Some documentation not ...`` being attached to + *next* entity declaration, here ``foo``, in addition to any other + documentation that next entity already has! + +.. _hyperlinking-re-exported: + +Hyperlinking and Re-Exported Entities ------------------------------------- When Haddock renders a type in the generated documentation, it @@ -455,26 +713,27 @@ The options and module description can be in either order. The following attributes are currently understood by Haddock: -``hide`` ``hide`` +``hide`` Omit this module from the generated documentation, but nevertheless propagate definitions and documentation from within this module to modules that re-export those definitions. -``hide`` ``prune`` +``prune`` Omit definitions that have no documentation annotations from the generated documentation. -``ignore-exports`` ``ignore-exports`` +``ignore-exports`` Ignore the export list. Generate documentation as if the module had no export list - i.e. all the top-level declarations are exported, and section headings may be given in the body of the module. -``not-home`` ``not-home`` +``not-home`` Indicates that the current module should not be considered to be the home module for each entity it exports, unless that entity is not - exported from any other module. See ? for more details. + exported from any other module. See :ref:`hyperlinking-re-exported` + for more details. -``show-extensions`` ``show-extensions`` +``show-extensions`` Indicates that we should render the extensions used in this module in the resulting documentation. This will only render if the output format supports it. If Language is set, it will be shown as well and @@ -482,6 +741,8 @@ The following attributes are currently understood by Haddock: be rendered, including those implied by their more powerful versions. +.. _markup: + Markup ------ @@ -497,7 +758,7 @@ Paragraphs One or more blank lines separates two paragraphs in a documentation comment. -Special characters +Special Characters ~~~~~~~~~~~~~~~~~~ The following characters have special meanings in documentation @@ -514,7 +775,7 @@ Furthermore, the character sequence ``>>>`` has a special meaning at the beginning of a line. To escape it, just prefix the characters in the sequence with a backslash. -Character references +Character References ~~~~~~~~~~~~~~~~~~~~ Although Haskell source files may contain any character from the Unicode @@ -546,7 +807,9 @@ call these “bird tracks”). For example: :: There is an important difference between the two forms of code block: in the bird-track form, the text to the right of the ‘\ ``>``\ ’ is interpreted literally, whereas the ``@...@`` form interprets markup as -normal inside the code block. +normal inside the code block. In particular, ``/`` is markup for italics, +and so e.g. ``@x / y / z@`` renders as ``x`` followed by italic +``y`` with no slashes, followed by ``z``. Examples ~~~~~~~~ @@ -621,7 +884,7 @@ markup is accepted [3]_: ```T'``. because strictly speaking the ````` character should not be used as a left quote, it is a grave accent. -Emphasis, Bold and Monospaced text +Emphasis, Bold and Monospaced Text ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Emphasis may be added by surrounding text with ``/.../``. Other markup @@ -637,9 +900,10 @@ underscore if you need it bold: Monospaced (or typewriter) text is indicated by surrounding it with ``@...@``. Other markup is valid inside a monospaced span: for example ``@'f' a b@`` will hyperlink the identifier ``f`` inside the code -fragment. +fragment, but ``@__FILE__@`` will render ``FILE`` in bold with no +underscores, which may not be what you had in mind. -Linking to modules +Linking to Modules ~~~~~~~~~~~~~~~~~~ Linking to a module is done by surrounding the module name with double @@ -652,7 +916,7 @@ is valid before turning it into a link but unlike with identifiers, whether the module is in scope isn't checked and will always be turned into a link. -Itemized and Enumerated lists +Itemized and Enumerated Lists ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ A bulleted item is represented by preceding a paragraph with either @@ -732,7 +996,7 @@ which was unexpected. :: * bar -} -Definition lists +Definition Lists ~~~~~~~~~~~~~~~~ Definition lists are written as follows: :: @@ -833,7 +1097,7 @@ and will be removed in the future. Headings ~~~~~~~~ -Headings inside of comment documentation are possible be preceding them +Headings inside of comment documentation are possible by preceding them with a number of ``=``\ s. From 1 to 6 are accepted. Extra ``=``\ s will be treated as belonging to the text of the heading. Note that it's up to the output format to decide how to render the different levels. :: -- cgit v1.2.3 From b35eed2a9f1c82131f51f55c771ac2372127520d Mon Sep 17 00:00:00 2001 From: Alex Biehl Date: Fri, 12 May 2017 21:02:33 +0200 Subject: Haddock: Fix broken lazy IO in prologue reading (#615) We previously used withFile in conjunction with hGetContents. The list returned by the latter wasn't completely forced by the time we left the withFile block, meaning that we would try to read from a closed handle. --- haddock-api/src/Haddock.hs | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/haddock-api/src/Haddock.hs b/haddock-api/src/Haddock.hs index 3971a5b7..f0e7e6c7 100644 --- a/haddock-api/src/Haddock.hs +++ b/haddock-api/src/Haddock.hs @@ -547,9 +547,10 @@ getPrologue :: DynFlags -> [Flag] -> IO (Maybe (MDoc RdrName)) getPrologue dflags flags = case [filename | Flag_Prologue filename <- flags ] of [] -> return Nothing - [filename] -> withFile filename ReadMode $ \h -> do + [filename] -> do + h <- openFile filename ReadMode hSetEncoding h utf8 - str <- hGetContents h + str <- hGetContents h -- semi-closes the handle return . Just $! parseParas dflags str _ -> throwE "multiple -p/--prologue options" -- cgit v1.2.3 From c836dd4cb47d457b066b51b61a08f583a8c4466e Mon Sep 17 00:00:00 2001 From: Alex Biehl Date: Sat, 13 May 2017 12:48:10 +0200 Subject: Consequently use inClass and notInClass in haddock-library (#617) These allow attoparsec to do some clever lookup optimization --- haddock-library/src/Documentation/Haddock/Parser.hs | 21 +++++++++++++-------- .../src/Documentation/Haddock/Parser/Util.hs | 9 ++++++--- 2 files changed, 19 insertions(+), 11 deletions(-) diff --git a/haddock-library/src/Documentation/Haddock/Parser.hs b/haddock-library/src/Documentation/Haddock/Parser.hs index 123f5612..ddea2b9b 100644 --- a/haddock-library/src/Documentation/Haddock/Parser.hs +++ b/haddock-library/src/Documentation/Haddock/Parser.hs @@ -143,7 +143,7 @@ specialChar = "_/<@\"&'`# " -- to ensure that we have already given a chance to more meaningful parsers -- before capturing their characers. string' :: Parser (DocH mod a) -string' = DocString . unescape . decodeUtf8 <$> takeWhile1_ (`notElem` specialChar) +string' = DocString . unescape . decodeUtf8 <$> takeWhile1_ (notInClass specialChar) where unescape "" = "" unescape ('\\':x:xs) = x : unescape xs @@ -153,7 +153,7 @@ string' = DocString . unescape . decodeUtf8 <$> takeWhile1_ (`notElem` specialCh -- This is done to skip over any special characters belonging to other -- elements but which were not deemed meaningful at their positions. skipSpecialChar :: Parser (DocH mod a) -skipSpecialChar = DocString . return <$> satisfy (`elem` specialChar) +skipSpecialChar = DocString . return <$> satisfy (inClass specialChar) -- | Emphasis parser. -- @@ -215,7 +215,7 @@ moduleName = DocModule <$> (char '"' *> modid <* char '"') -- accept {small | large | digit | ' } here. But as we can't -- match on unicode characters, this is currently not possible. -- Note that we allow ‘#’ to suport anchors. - <*> (decodeUtf8 <$> takeWhile (`notElem` (" .&[{}(=*)+]!|@/;,^?\"\n"::String))) + <*> (decodeUtf8 <$> takeWhile (notInClass " .&[{}(=*)+]!|@/;,^?\"\n")) -- | Picture parser, surrounded by \<\< and \>\>. It's possible to specify -- a title for the picture. @@ -338,7 +338,7 @@ definitionList :: BS.ByteString -> Parser (DocH mod Identifier) definitionList indent = DocDefList <$> p where p = do - label <- "[" *> (parseStringBS <$> takeWhile1 (`notElem` ("]\n" :: String))) <* ("]" <* optional ":") + label <- "[" *> (parseStringBS <$> takeWhile1 (notInClass "]\n")) <* ("]" <* optional ":") c <- takeLine (cs, items) <- more indent p let contents = parseString . dropNLs . unlines $ c : cs @@ -561,7 +561,7 @@ autoUrl = mkLink <$> url url = mappend <$> ("http://" <|> "https://" <|> "ftp://") <*> takeWhile1 (not . isSpace) mkLink :: BS.ByteString -> DocH mod a mkLink s = case unsnoc s of - Just (xs, x) | x `elem` (",.!?" :: String) -> DocHyperlink (Hyperlink (decodeUtf8 xs) Nothing) `docAppend` DocString [x] + Just (xs, x) | inClass ",.!?" x -> DocHyperlink (Hyperlink (decodeUtf8 xs) Nothing) `docAppend` DocString [x] _ -> DocHyperlink (Hyperlink (decodeUtf8 s) Nothing) -- | Parses strings between identifier delimiters. Consumes all input that it @@ -570,8 +570,13 @@ autoUrl = mkLink <$> url parseValid :: Parser String parseValid = p some where - idChar = satisfy (`elem` ("_.!#$%&*+/<=>?@\\|-~:^"::String)) - <|> digit <|> letter_ascii + idChar = + satisfy (\c -> isAlpha_ascii c + || isDigit c + -- N.B. '-' is placed first otherwise attoparsec thinks + -- it belongs to a character class + || inClass "-_.!#$%&*+/<=>?@\\|~:^" c) + p p' = do vs' <- p' $ utf8String "⋆" <|> return <$> idChar let vs = concat vs' @@ -594,4 +599,4 @@ identifier = do e <- idDelim return $ DocIdentifier (o, vid, e) where - idDelim = char '\'' <|> char '`' + idDelim = satisfy (\c -> c == '\'' || c == '`') diff --git a/haddock-library/src/Documentation/Haddock/Parser/Util.hs b/haddock-library/src/Documentation/Haddock/Parser/Util.hs index d908ce18..ab5e5e9e 100644 --- a/haddock-library/src/Documentation/Haddock/Parser/Util.hs +++ b/haddock-library/src/Documentation/Haddock/Parser/Util.hs @@ -22,7 +22,7 @@ module Documentation.Haddock.Parser.Util ( import Control.Applicative import Control.Monad (mfilter) -import Documentation.Haddock.Parser.Monad +import Documentation.Haddock.Parser.Monad hiding (isHorizontalSpace) import Data.ByteString.Char8 (ByteString) import qualified Data.ByteString.Char8 as BS import Prelude hiding (takeWhile) @@ -40,11 +40,14 @@ unsnoc bs strip :: String -> String strip = (\f -> f . f) $ dropWhile isSpace . reverse +isHorizontalSpace :: Char -> Bool +isHorizontalSpace = inClass " \t\f\v\r" + skipHorizontalSpace :: Parser () -skipHorizontalSpace = skipWhile (`elem` " \t\f\v\r") +skipHorizontalSpace = skipWhile isHorizontalSpace takeHorizontalSpace :: Parser BS.ByteString -takeHorizontalSpace = takeWhile (`elem` " \t\f\v\r") +takeHorizontalSpace = takeWhile isHorizontalSpace makeLabeled :: (String -> Maybe String -> a) -> String -> a makeLabeled f input = case break isSpace $ removeEscapes $ strip input of -- cgit v1.2.3 From 506f614402192bd7b6a9a608e925a01b373b2bdc Mon Sep 17 00:00:00 2001 From: Doug Wilson Date: Sun, 28 May 2017 05:54:53 +1200 Subject: Improve Syb code (#621) Specialize.hs and Ast.hs are modified to have their Syb code not recurse into Name or Id in HsSyn types. Specialize.hs is refactored to have fewer calls to Syb functions. Syb.hs has some foldl calls replaced with foldl' calls. There is still a lot of performance on the floor of Ast.hs. The RenamedSource is traversed many times, and lookupBySpan is very inefficient. everywhereBut and lookupBySpan dominate the runtime whenever --hyperlinked-source is passed. --- .../src/Haddock/Backends/Hyperlinker/Ast.hs | 28 ++++++----- haddock-api/src/Haddock/Interface/Specialize.hs | 58 +++++++++------------- haddock-api/src/Haddock/Syb.hs | 55 +++++++++++++++++--- 3 files changed, 88 insertions(+), 53 deletions(-) diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs b/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs index b97f0ead..78beacf2 100644 --- a/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs +++ b/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs @@ -2,12 +2,12 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE TypeFamilies #-} - +{-# LANGUAGE TypeApplications #-} module Haddock.Backends.Hyperlinker.Ast (enrich) where -import Haddock.Syb +import qualified Haddock.Syb as Syb import Haddock.Backends.Hyperlinker.Types import qualified GHC @@ -16,6 +16,9 @@ import Control.Applicative import Data.Data import Data.Maybe +everythingInRenamedSource :: (Alternative f, Data x) + => (forall a. Data a => a -> f r) -> x -> f r +everythingInRenamedSource f = Syb.everythingButType @GHC.Name (<|>) f -- | Add more detailed information to token stream using GHC API. enrich :: GHC.RenamedSource -> [Token] -> [RichToken] @@ -53,7 +56,7 @@ enrichToken _ _ = Nothing -- | Obtain details map for variables ("normally" used identifiers). variables :: GHC.RenamedSource -> DetailsMap variables = - everything (<|>) (var `combine` rec) + everythingInRenamedSource (var `Syb.combine` rec) where var term = case cast term of (Just (GHC.L sspan (GHC.HsVar name))) -> @@ -68,8 +71,7 @@ variables = -- | Obtain details map for types. types :: GHC.RenamedSource -> DetailsMap -types = - everything (<|>) ty +types = everythingInRenamedSource ty where ty term = case cast term of (Just (GHC.L sspan (GHC.HsTyVar _ name))) -> @@ -81,9 +83,10 @@ types = -- That includes both identifiers bound by pattern matching or declared using -- ordinary assignment (in top-level declarations, let-expressions and where -- clauses). + binds :: GHC.RenamedSource -> DetailsMap -binds = - everything (<|>) (fun `combine` pat `combine` tvar) +binds = everythingInRenamedSource + (fun `Syb.combine` pat `Syb.combine` tvar) where fun term = case cast term of (Just (GHC.FunBind (GHC.L sspan name) _ _ _ _ :: GHC.HsBind GHC.Name)) -> @@ -93,7 +96,7 @@ binds = (Just (GHC.L sspan (GHC.VarPat name))) -> pure (sspan, RtkBind (GHC.unLoc name)) (Just (GHC.L _ (GHC.ConPatIn (GHC.L sspan name) recs))) -> - [(sspan, RtkVar name)] ++ everything (<|>) rec recs + [(sspan, RtkVar name)] ++ everythingInRenamedSource rec recs (Just (GHC.L _ (GHC.AsPat (GHC.L sspan name) _))) -> pure (sspan, RtkBind name) _ -> empty @@ -112,8 +115,8 @@ binds = decls :: GHC.RenamedSource -> DetailsMap decls (group, _, _, _) = concatMap ($ group) [ concat . map typ . concat . map GHC.group_tyclds . GHC.hs_tyclds - , everything (<|>) fun . GHC.hs_valds - , everything (<|>) (con `combine` ins) + , everythingInRenamedSource fun . GHC.hs_valds + , everythingInRenamedSource (con `Syb.combine` ins) ] where typ (GHC.L _ t) = case t of @@ -127,7 +130,8 @@ decls (group, _, _, _) = concatMap ($ group) _ -> empty con term = case cast term of (Just cdcl) -> - map decl (GHC.getConNames cdcl) ++ everything (<|>) fld cdcl + map decl (GHC.getConNames cdcl) + ++ everythingInRenamedSource fld cdcl Nothing -> empty ins term = case cast term of (Just (GHC.DataFamInstD inst)) -> pure . tyref $ GHC.dfid_tycon inst @@ -149,7 +153,7 @@ decls (group, _, _, _) = concatMap ($ group) -- import lists. imports :: GHC.RenamedSource -> DetailsMap imports src@(_, imps, _, _) = - everything (<|>) ie src ++ mapMaybe (imp . GHC.unLoc) imps + everythingInRenamedSource ie src ++ mapMaybe (imp . GHC.unLoc) imps where ie term = case cast term of (Just (GHC.IEVar v)) -> pure $ var $ GHC.ieLWrappedName v diff --git a/haddock-api/src/Haddock/Interface/Specialize.hs b/haddock-api/src/Haddock/Interface/Specialize.hs index 28bbf305..8c28cd5a 100644 --- a/haddock-api/src/Haddock/Interface/Specialize.hs +++ b/haddock-api/src/Haddock/Interface/Specialize.hs @@ -1,9 +1,9 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE Rank2Types #-} {-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} {-# LANGUAGE RecordWildCards #-} - module Haddock.Interface.Specialize ( specializeInstHead ) where @@ -27,73 +27,66 @@ import Data.Map (Map) import qualified Data.Map as Map import Data.Set (Set) import qualified Data.Set as Set - - --- | Instantiate all occurrences of given name with particular type. -specialize :: (Eq name, Typeable name) - => Data a - => name -> HsType name -> a -> a -specialize name details = - everywhere $ mkT step - where - step (HsTyVar _ (L _ name')) | name == name' = details - step typ = typ - +import Data.Foldable -- | Instantiate all occurrences of given names with corresponding types. --- --- It is just a convenience function wrapping 'specialize' that supports more --- that one specialization. -specialize' :: (Eq name, Typeable name) +specialize :: forall name a. (Ord name, DataId name, NamedThing name) => Data a => [(name, HsType name)] -> a -> a -specialize' = flip $ foldr (uncurry specialize) +specialize specs = go + where + go :: forall x. Data x => x -> x + go = everywhereButType @name $ mkT $ sugar . specialize_ty_var + specialize_ty_var (HsTyVar _ (L _ name')) + | Just t <- Map.lookup name' spec_map = t + specialize_ty_var typ = typ + -- This is a tricky recursive definition that is guaranteed to terminate + -- because a type binder cannot be instantiated with a type that depends + -- on that binder. i.e. @a -> Maybe a@ is invalid + spec_map = Map.fromList [ (n, go t) | (n, t) <- specs] -- | Instantiate given binders with corresponding types. -- -- Again, it is just a convenience function around 'specialize'. Note that -- length of type list should be the same as the number of binders. -specializeTyVarBndrs :: (Eq name, DataId name) +specializeTyVarBndrs :: (Ord name, DataId name, NamedThing name) => Data a => LHsQTyVars name -> [HsType name] -> a -> a specializeTyVarBndrs bndrs typs = - specialize' $ zip bndrs' typs + specialize $ zip bndrs' typs where bndrs' = map (bname . unLoc) . hsq_explicit $ bndrs bname (UserTyVar (L _ name)) = name bname (KindedTyVar (L _ name) _) = name -specializePseudoFamilyDecl :: (Eq name, DataId name) +specializePseudoFamilyDecl :: (Ord name, DataId name, NamedThing name) => LHsQTyVars name -> [HsType name] -> PseudoFamilyDecl name -> PseudoFamilyDecl name specializePseudoFamilyDecl bndrs typs decl = - decl { pfdTyVars = map specializeTyVars (pfdTyVars decl) } - where - specializeTyVars = specializeTyVarBndrs bndrs typs - + decl {pfdTyVars = map (specializeTyVarBndrs bndrs typs) (pfdTyVars decl)} -specializeSig :: forall name . (Eq name, DataId name, SetName name) +specializeSig :: forall name . (Ord name, DataId name, SetName name, NamedThing name) => LHsQTyVars name -> [HsType name] -> Sig name -> Sig name specializeSig bndrs typs (TypeSig lnames typ) = - TypeSig lnames (typ { hswc_body = (hswc_body typ) { hsib_body = noLoc typ'}}) + TypeSig lnames (typ {hswc_body = (hswc_body typ) {hsib_body = noLoc typ'}}) where true_type :: HsType name true_type = unLoc (hsSigWcType typ) typ' :: HsType name - typ' = rename fv . sugar $ specializeTyVarBndrs bndrs typs true_type + typ' = rename fv $ specializeTyVarBndrs bndrs typs true_type fv = foldr Set.union Set.empty . map freeVariables $ typs specializeSig _ _ sig = sig -- | Make all details of instance head (signatures, associated types) -- specialized to that particular instance type. -specializeInstHead :: (Eq name, DataId name, SetName name) +specializeInstHead :: (Ord name, DataId name, SetName name, NamedThing name) => InstHead name -> InstHead name specializeInstHead ihd@InstHead { ihdInstType = clsi@ClassInst { .. }, .. } = ihd { ihdInstType = instType' } @@ -115,12 +108,7 @@ specializeInstHead ihd = ihd -- and @(a, b, c)@. sugar :: forall name. (NamedThing name, DataId name) => HsType name -> HsType name -sugar = - everywhere $ mkT step - where - step :: HsType name -> HsType name - step = sugarOperators . sugarTuples . sugarLists - +sugar = sugarOperators . sugarTuples . sugarLists sugarLists :: NamedThing name => HsType name -> HsType name sugarLists (HsAppTy (L _ (HsTyVar _ (L _ name))) ltyp) diff --git a/haddock-api/src/Haddock/Syb.hs b/haddock-api/src/Haddock/Syb.hs index 4847e486..7e34ae8c 100644 --- a/haddock-api/src/Haddock/Syb.hs +++ b/haddock-api/src/Haddock/Syb.hs @@ -1,8 +1,11 @@ {-# LANGUAGE Rank2Types #-} - +{-# LANGUAGE AllowAmbiguousTypes #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE ScopedTypeVariables #-} module Haddock.Syb - ( everything, everythingWithState, everywhere + ( everything, everythingButType, everythingWithState + , everywhere, everywhereButType , mkT , combine ) where @@ -10,16 +13,41 @@ module Haddock.Syb import Data.Data import Control.Applicative +import Data.Maybe +import Data.Foldable +-- | Returns true if a == t. +-- requires AllowAmbiguousTypes +isType :: forall a b. (Typeable a, Typeable b) => b -> Bool +isType _ = isJust $ eqT @a @b -- | Perform a query on each level of a tree. -- -- This is stolen directly from SYB package and copied here to not introduce -- additional dependencies. -everything :: (r -> r -> r) -> (forall a. Data a => a -> r) +everything :: (r -> r -> r) + -> (forall a. Data a => a -> r) -> (forall a. Data a => a -> r) -everything k f x = foldl k (f x) (gmapQ (everything k f) x) +everything k f x = foldl' k (f x) (gmapQ (everything k f) x) + +-- | Variation of "everything" with an added stop condition +-- Just like 'everything', this is stolen from SYB package. +everythingBut :: (r -> r -> r) + -> (forall a. Data a => a -> (r, Bool)) + -> (forall a. Data a => a -> r) +everythingBut k f x = let (v, stop) = f x + in if stop + then v + else foldl' k v (gmapQ (everythingBut k f) x) +-- | Variation of "everything" that does not recurse into children of type t +-- requires AllowAmbiguousTypes +everythingButType :: + forall t r. (Typeable t) + => (r -> r -> r) + -> (forall a. Data a => a -> r) + -> (forall a. Data a => a -> r) +everythingButType k f = everythingBut k $ (,) <$> f <*> isType @t -- | Perform a query with state on each level of a tree. -- @@ -31,8 +59,7 @@ everythingWithState :: s -> (r -> r -> r) -> (forall a. Data a => a -> r) everythingWithState s k f x = let (r, s') = f x s - in foldl k r (gmapQ (everythingWithState s' k f) x) - + in foldl' k r (gmapQ (everythingWithState s' k f) x) -- | Apply transformation on each level of a tree. -- @@ -40,6 +67,22 @@ everythingWithState s k f x = everywhere :: (forall a. Data a => a -> a) -> (forall a. Data a => a -> a) everywhere f = f . gmapT (everywhere f) +-- | Variation on everywhere with an extra stop condition +-- Just like 'everything', this is stolen from SYB package. +everywhereBut :: (forall a. Data a => a -> Bool) + -> (forall a. Data a => a -> a) + -> (forall a. Data a => a -> a) +everywhereBut q f x + | q x = x + | otherwise = f (gmapT (everywhereBut q f) x) + +-- | Variation of "everywhere" that does not recurse into children of type t +-- requires AllowAmbiguousTypes +everywhereButType :: forall t . (Typeable t) + => (forall a. Data a => a -> a) + -> (forall a. Data a => a -> a) +everywhereButType = everywhereBut (isType @t) + -- | Create generic transformation. -- -- Another function stolen from SYB package. -- cgit v1.2.3 From eca0677beaa78f31485055c432bf481dc06007a9 Mon Sep 17 00:00:00 2001 From: Alex Biehl Date: Tue, 30 May 2017 19:01:37 +0200 Subject: Clear fixme comment (#625) --- haddock-api/src/Haddock/Backends/Xhtml/Decl.hs | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs b/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs index ffe42c4f..035c8e9e 100644 --- a/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs +++ b/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs @@ -520,9 +520,8 @@ ppClassDecl summary links instances fixities loc d subdocs , f@(n',_) <- fixities , n == n' ] 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? + -- N.B. taking just the first name is ok. Signatures with multiple names + -- are expanded so that each name gets its own signature. minimalBit = case [ s | MinimalSig _ (L _ s) <- sigs ] of -- Miminal complete definition = every shown method -- cgit v1.2.3 From fdf1b017b07e12769a7ca605b41dc76842838855 Mon Sep 17 00:00:00 2001 From: Alex Biehl Date: Tue, 30 May 2017 19:02:12 +0200 Subject: Make haddock-library and haddock-api warning free (#626) --- haddock-api/src/Haddock.hs | 12 ++++++------ haddock-api/src/Haddock/GhcUtils.hs | 4 ---- haddock-api/src/Haddock/Interface/Specialize.hs | 1 - haddock-library/src/Documentation/Haddock/Types.hs | 4 +++- 4 files changed, 9 insertions(+), 12 deletions(-) diff --git a/haddock-api/src/Haddock.hs b/haddock-api/src/Haddock.hs index f0e7e6c7..57ea5fea 100644 --- a/haddock-api/src/Haddock.hs +++ b/haddock-api/src/Haddock.hs @@ -398,12 +398,12 @@ withGhc' libDir flags ghcActs = runGhc (Just libDir) $ do ghcLink = NoLink } let dynflags'' = updOptLevel 0 $ gopt_unset dynflags' Opt_SplitObjs - defaultCleanupHandler dynflags'' $ do - -- ignore the following return-value, which is a list of packages - -- that may need to be re-linked: Haddock doesn't do any - -- dynamic or static linking at all! - _ <- setSessionDynFlags dynflags'' - ghcActs dynflags'' + + -- ignore the following return-value, which is a list of packages + -- that may need to be re-linked: Haddock doesn't do any + -- dynamic or static linking at all! + _ <- setSessionDynFlags dynflags'' + ghcActs dynflags'' where parseGhcFlags :: MonadIO m => DynFlags -> m DynFlags parseGhcFlags dynflags = do diff --git a/haddock-api/src/Haddock/GhcUtils.hs b/haddock-api/src/Haddock/GhcUtils.hs index c8e5ea8b..dcc1d834 100644 --- a/haddock-api/src/Haddock/GhcUtils.hs +++ b/haddock-api/src/Haddock/GhcUtils.hs @@ -17,17 +17,13 @@ module Haddock.GhcUtils where import Control.Arrow -import Data.Function import Exception import Outputable import Name import Lexeme import Module -import RdrName (GlobalRdrEnv) -import GhcMonad (withSession) import HscTypes -import UniqFM import GHC import Class diff --git a/haddock-api/src/Haddock/Interface/Specialize.hs b/haddock-api/src/Haddock/Interface/Specialize.hs index 8c28cd5a..da8c3e7b 100644 --- a/haddock-api/src/Haddock/Interface/Specialize.hs +++ b/haddock-api/src/Haddock/Interface/Specialize.hs @@ -27,7 +27,6 @@ import Data.Map (Map) import qualified Data.Map as Map import Data.Set (Set) import qualified Data.Set as Set -import Data.Foldable -- | Instantiate all occurrences of given names with corresponding types. specialize :: forall name a. (Ord name, DataId name, NamedThing name) diff --git a/haddock-library/src/Documentation/Haddock/Types.hs b/haddock-library/src/Documentation/Haddock/Types.hs index 4d5bb68a..660878ff 100644 --- a/haddock-library/src/Documentation/Haddock/Types.hs +++ b/haddock-library/src/Documentation/Haddock/Types.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE DeriveFunctor, DeriveFoldable, DeriveTraversable #-} +{-# LANGUAGE CPP, DeriveFunctor, DeriveFoldable, DeriveTraversable #-} -- | -- Module : Documentation.Haddock.Types @@ -14,8 +14,10 @@ -- Exposes documentation data types used for (some) of Haddock. module Documentation.Haddock.Types where +#if !MIN_VERSION_base(4,8,0) import Data.Foldable import Data.Traversable +#endif -- | With the advent of 'Version', we may want to start attaching more -- meta-data to comments. We make a structure for this ahead of time -- cgit v1.2.3 From 75e1e19d0d6c139c3c7d9b77b2928e6eb286dd48 Mon Sep 17 00:00:00 2001 From: Alex Biehl Date: Thu, 1 Jun 2017 10:40:33 +0200 Subject: Include `driver-test/*.hs` sdist (#630) This lead to #629. --- haddock.cabal | 1 + 1 file changed, 1 insertion(+) diff --git a/haddock.cabal b/haddock.cabal index fb16a2a9..e3c17a02 100644 --- a/haddock.cabal +++ b/haddock.cabal @@ -23,6 +23,7 @@ extra-source-files: doc/README.md doc/*.rst doc/conf.py + driver-test/*.hs haddock-api/src/haddock.sh html-test/src/*.hs html-test/ref/*.html -- cgit v1.2.3 From bfb3563f730fd1c973a6611a0fba3435fb1df489 Mon Sep 17 00:00:00 2001 From: Alex Biehl Date: Sat, 3 Jun 2017 20:37:28 +0200 Subject: Allow user defined signatures for pattern synonyms (#631) --- CHANGES.md | 2 ++ haddock-api/src/Haddock/GhcUtils.hs | 5 +++++ haddock-api/src/Haddock/Interface/Create.hs | 1 + html-test/ref/PatternSyns.html | 29 +++++++++++++++++++++++++++++ html-test/src/PatternSyns.hs | 5 +++++ 5 files changed, 42 insertions(+) diff --git a/CHANGES.md b/CHANGES.md index 6c2b5d32..95e1763a 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -1,5 +1,7 @@ ## Changes in version 2.18.0 + * Support user defined signatures on pattern synonyms + * Synopsis is working again (#599) ## Changes in version 2.17.4 diff --git a/haddock-api/src/Haddock/GhcUtils.hs b/haddock-api/src/Haddock/GhcUtils.hs index dcc1d834..4280cd80 100644 --- a/haddock-api/src/Haddock/GhcUtils.hs +++ b/haddock-api/src/Haddock/GhcUtils.hs @@ -88,6 +88,10 @@ filterSigNames p (ClassOpSig is_default ns ty) = case filter (p . unLoc) ns of [] -> Nothing filtered -> Just (ClassOpSig is_default filtered ty) +filterSigNames p (PatSynSig ns ty) = + case filter (p . unLoc) ns of + [] -> Nothing + filtered -> Just (PatSynSig filtered ty) filterSigNames _ _ = Nothing ifTrueJust :: Bool -> name -> Maybe name @@ -110,6 +114,7 @@ sigNameNoLoc _ = [] isUserLSig :: LSig name -> Bool isUserLSig (L _(TypeSig {})) = True isUserLSig (L _(ClassOpSig {})) = True +isUserLSig (L _(PatSynSig {})) = True isUserLSig _ = False diff --git a/haddock-api/src/Haddock/Interface/Create.hs b/haddock-api/src/Haddock/Interface/Create.hs index 26ac0281..98d4dbe8 100644 --- a/haddock-api/src/Haddock/Interface/Create.hs +++ b/haddock-api/src/Haddock/Interface/Create.hs @@ -842,6 +842,7 @@ fullModuleContents dflags warnings gre (docMap, argMap, subMap, declMap, instMap expandSig :: Sig name -> [Sig name] expandSig (TypeSig names t) = [ TypeSig [n] t | n <- names ] expandSig (ClassOpSig b names t) = [ ClassOpSig b [n] t | n <- names ] + expandSig (PatSynSig names t) = [ PatSynSig [n] t | n <- names ] expandSig x = [x] mkExportItem :: LHsDecl Name -> ErrMsgGhc (Maybe (ExportItem Name)) diff --git a/html-test/ref/PatternSyns.html b/html-test/ref/PatternSyns.html index 9f0caaa2..2cf936b3 100644 --- a/html-test/ref/PatternSyns.html +++ b/html-test/ref/PatternSyns.html @@ -118,6 +118,16 @@ window.onload = function () {pageLoad();}; > k a (b :: k). (><) k a b

  • pattern PatWithExplicitSig :: Eq somex => somex -> FooType somex

    • pattern PatWithExplicitSig :: Eq somex => somex -> FooType somex #

    Earlier ghc versions didn't allow explicit signatures + on pattern synonyms.

    Quux a c (Quux a c b)) a c b0)) #

    Quux a b c)) -> (Quux a c b, a c b0, Quux a c c) a c c0) #

    Quux a b c)) -> (Quux a c b, a c b0, Quux a c c) a c c0) #

    forall a. a -> a) -> (b, forall a. a -> [c]) -> (b, c) c0. c0 -> [c]) -> (b, c1) #

    forall b. (forall a. a -> [c]) -> c) -> b. b -> [c]) -> c0) -> forall a. a -> b c1. c1 -> b #

    baz :: (a -> b) -> (forall c. c -> c) -> (b, a0. a0 -> a0) -> (b0, forall c. c -> a -> b) -> (b, c) c. c -> a -> b) -> (b0, c) #

    baz' :: b -> ( :: b0 -> (forall c. c -> a -> b) -> ( b1. b1 -> a -> b) -> (forall c. c -> a -> b) -> [(b, a -> b)] b2. b2 -> a -> b) -> [(b0, a -> b)] #

    baz'' :: b -> ( :: b0 -> (forall c. ( b1. (forall d. d -> a -> b) -> c) -> b2. b2 -> a -> b) -> c) -> forall c. c -> b c. c -> b0 #

    baz :: (a, b, c) -> (forall d. d -> d) -> (b, a0. a0 -> a0) -> (b0, forall d. d -> (a, b, c)) -> (b, c) c0. c0 -> (a, b, c)) -> (b0, c1) #

    baz' :: b -> ( :: b0 -> (forall d. d -> (a, b, c)) -> ( b1. b1 -> (a, b, c)) -> (forall d. d -> (a, b, c)) -> [(b, (a, b, c))] b2. b2 -> (a, b, c)) -> [(b0, (a, b, c))] #

    baz'' :: b -> ( :: b0 -> (forall d. ( b1. (forall e. e -> (a, b, c)) -> c) -> b2. b2 -> (a, b, c)) -> c0) -> forall d. d -> b c1. c1 -> b0 #

    Quux a b c -> (forall d. d -> d) -> (b, a0. a0 -> a0) -> (b0, forall d. d -> c0. c0 -> Quux a b c) -> (b, c) a b c) -> (b0, c1) #

    baz' :: b -> ( :: b0 -> (forall d. d -> b1. b1 -> Quux a b c) -> (forall d. d -> b2. b2 -> Quux a b c) -> [(b, a b c) -> [(b0, Quux a b c)] #

    baz'' :: b -> ( :: b0 -> (forall d. ( b1. (forall e. e -> b2. b2 -> Quux a b c) -> c) -> a b c) -> c0) -> forall d. d -> b c1. c1 -> b0 #

    baz :: (a, [b], b, a) -> (forall c. c -> c) -> (b, a0. a0 -> a0) -> (b0, forall c. c -> (a, [b], b, a)) -> (b, c) c. c -> (a, [b], b, a)) -> (b0, c) #

    baz' :: b -> ( :: b0 -> (forall c. c -> (a, [b], b, a)) -> ( b1. b1 -> (a, [b], b, a)) -> (forall c. c -> (a, [b], b, a)) -> [(b, (a, [b], b, a))] b2. b2 -> (a, [b], b, a)) -> [(b0, (a, [b], b, a))] #

    baz'' :: b -> ( :: b0 -> (forall c. ( b1. (forall d. d -> (a, [b], b, a)) -> c) -> b2. b2 -> (a, [b], b, a)) -> c) -> forall c. c -> b c. c -> b0 #

    Quux a b Int -> a -> -> a0 -> Quux a b a a b a0 #

    Quux a b (Quux a b a) -> a b a0) -> Int -> QuuxQuux a c (Quux a c b)) a c b0)) #

    Quux a b c)) -> (Quux a c b, a c b0, Quux a c c) a c c0) #

    Quux a b c)) -> (Quux a c b, a c b0, Quux a c c) a c c0) #

    Quux a b c -> (forall d. d -> d) -> (b, a0. a0 -> a0) -> (b0, forall d. d -> c0. c0 -> Quux a b c) -> (b, c) a b c) -> (b0, c1) #

    baz' :: b -> ( :: b0 -> (forall d. d -> b1. b1 -> Quux a b c) -> (forall d. d -> b2. b2 -> Quux a b c) -> [(b, a b c) -> [(b0, Quux a b c)] #

    baz'' :: b -> ( :: b0 -> (forall d. ( b1. (forall e. e -> b2. b2 -> Quux a b c) -> c) -> a b c) -> c0) -> forall d. d -> b c1. c1 -> b0 #

    b) -> f a -> f b + +instance Functor (Either a) where + fmap _ (Left x) = Left x + fmap f (Right y) = Right (f y) + +-- | Phantom type a0 is added to block the first renaming from a to a0. This ensures that the renamer doesn't create a new conflict +data ThreeVars a0 a b = ThreeVars a b + +instance Functor (ThreeVars a0 a) where + fmap f (ThreeVars a b) = ThreeVars a (f b) -- cgit v1.2.3 From 3fddb62913c72f29843335aa796c2e444ded1608 Mon Sep 17 00:00:00 2001 From: Tim Baumann Date: Sun, 6 Aug 2017 11:33:38 +0200 Subject: Fix: Generate pattern signatures for constructors exported as patterns (#663) * Fix pretty-printing of pattern signatures Pattern synonyms can have up to two contexts, both having a different semantic meaning: The first holds the constraints required to perform the matching, the second contains the constraints provided by a successful pattern match. When the first context is empty but the second is not it is necessary to render the first, empty context. * Generate pattern synonym signatures for ctors exported as patterns This fixes #653. * Simplify extractPatternSyn It is not necessary to generate the simplest type signature since it will be simplified when pretty-printed. * Add changelog entries for PR #663 * Fix extractPatternSyn error message --- CHANGES.md | 5 + haddock-api/src/Haddock/Backends/Xhtml/Decl.hs | 242 ++++++++++++++----------- haddock-api/src/Haddock/Interface/Create.hs | 34 +++- haddock-api/src/Haddock/Types.hs | 6 + html-test/ref/ConstructorPatternExport.html | 124 +++++++++++++ html-test/ref/PatternSyns.html | 76 ++++++++ html-test/src/ConstructorPatternExport.hs | 26 +++ html-test/src/PatternSyns.hs | 8 +- 8 files changed, 412 insertions(+), 109 deletions(-) create mode 100644 html-test/ref/ConstructorPatternExport.html create mode 100644 html-test/src/ConstructorPatternExport.hs diff --git a/CHANGES.md b/CHANGES.md index 5050339d..f96ac325 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -6,6 +6,11 @@ * Move markup related data types to haddock-library + * Fix: Show empty constraint contexts in pattern type signatures (#663) + + * Fix: Generate constraint signatures for constructors exported as pattern + synonyms (#663) + ## Changes in version 2.18.1 * Synopsis is working again (#599) diff --git a/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs b/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs index cda0611a..c78bee2d 100644 --- a/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs +++ b/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs @@ -71,9 +71,9 @@ ppFunSig :: Bool -> LinksInfo -> SrcSpan -> DocForDecl DocName -> Splice -> Unicode -> Qualification -> Html ppFunSig summary links loc doc docnames typ fixities splice unicode qual = ppSigLike summary links loc mempty doc docnames fixities (unLoc typ, pp_typ) - splice unicode qual + splice unicode qual HideEmptyContexts where - pp_typ = ppLType unicode qual typ + pp_typ = ppLType unicode qual HideEmptyContexts typ ppLPatSig :: Bool -> LinksInfo -> SrcSpan -> DocForDecl DocName -> [Located DocName] -> LHsSigType DocName -> @@ -87,20 +87,20 @@ ppLPatSig summary links loc (doc, _argDocs) docnames typ fixities splice unicode pref1 = hsep [ keyword "pattern" , hsep $ punctuate comma $ map (ppBinder summary . getOccName) docnames , dcolon unicode - , ppLType unicode qual (hsSigType typ) + , ppPatSigType unicode qual (hsSigType typ) ] ppSigLike :: Bool -> LinksInfo -> SrcSpan -> Html -> DocForDecl DocName -> [DocName] -> [(DocName, Fixity)] -> (HsType DocName, Html) -> - Splice -> Unicode -> Qualification -> Html + Splice -> Unicode -> Qualification -> HideEmptyContexts -> Html ppSigLike summary links loc leader doc docnames fixities (typ, pp_typ) - splice unicode qual = + splice unicode qual emptyCtxts = ppTypeOrFunSig summary links loc docnames typ doc ( addFixities $ leader <+> ppTypeSig summary occnames pp_typ unicode , addFixities . concatHtml . punctuate comma $ map (ppBinder False) occnames , dcolon unicode ) - splice unicode qual + splice unicode qual emptyCtxts where occnames = map (nameOccName . getName) docnames addFixities html @@ -110,8 +110,8 @@ ppSigLike summary links loc leader doc docnames fixities (typ, pp_typ) ppTypeOrFunSig :: Bool -> LinksInfo -> SrcSpan -> [DocName] -> HsType DocName -> DocForDecl DocName -> (Html, Html, Html) - -> Splice -> Unicode -> Qualification -> Html -ppTypeOrFunSig summary links loc docnames typ (doc, argDocs) (pref1, pref2, sep) splice unicode qual + -> Splice -> Unicode -> Qualification -> HideEmptyContexts -> Html +ppTypeOrFunSig summary links loc docnames typ (doc, argDocs) (pref1, pref2, sep) splice unicode qual emptyCtxts | summary = pref1 | Map.null argDocs = topDeclElem links loc splice docnames pref1 +++ docSection curName qual doc | otherwise = topDeclElem links loc splice docnames pref2 +++ @@ -132,14 +132,14 @@ ppTypeOrFunSig summary links loc docnames typ (doc, argDocs) (pref1, pref2, sep) | null (unLoc lctxt) = do_largs n leader ltype | otherwise - = (leader <+> ppLContextNoArrow lctxt unicode qual, Nothing, []) + = (leader <+> ppLContextNoArrow lctxt unicode qual emptyCtxts, Nothing, []) : do_largs n (darrow unicode) ltype do_args n leader (HsFunTy lt r) - = (leader <+> ppLFunLhType unicode qual lt, argDoc n, []) + = (leader <+> ppLFunLhType unicode qual emptyCtxts lt, argDoc n, []) : do_largs (n+1) (arrow unicode) r do_args n leader t - = [(leader <+> ppType unicode qual t, argDoc n, [])] + = [(leader <+> ppType unicode qual emptyCtxts t, argDoc n, [])] ppForAll :: [LHsTyVarBndr DocName] -> Unicode -> Qualification -> Html ppForAll tvs unicode qual = @@ -197,11 +197,11 @@ ppTySyn summary links fixities loc doc (SynDecl { tcdLName = L _ name, tcdTyVars splice unicode qual = ppTypeOrFunSig summary links loc [name] (unLoc ltype) doc (full <+> fixs, hdr <+> fixs, spaceHtml +++ equals) - splice unicode qual + splice unicode qual ShowEmptyToplevelContexts where hdr = hsep ([keyword "type", ppBinder summary occ] ++ ppTyVars unicode qual (hsQTvExplicit ltyvars)) - full = hdr <+> equals <+> ppLType unicode qual ltype + full = hdr <+> equals <+> ppPatSigType unicode qual ltype occ = nameOccName . getName $ name fixs | summary = noHtml @@ -220,14 +220,14 @@ ppTyName :: Name -> Html ppTyName = ppName Prefix -ppSimpleSig :: LinksInfo -> Splice -> Unicode -> Qualification -> SrcSpan +ppSimpleSig :: LinksInfo -> Splice -> Unicode -> Qualification -> HideEmptyContexts -> SrcSpan -> [DocName] -> HsType DocName -> Html -ppSimpleSig links splice unicode qual loc names typ = +ppSimpleSig links splice unicode qual emptyCtxts loc names typ = topDeclElem' names $ ppTypeSig True occNames ppTyp unicode where topDeclElem' = topDeclElem links loc splice - ppTyp = ppType unicode qual typ + ppTyp = ppType unicode qual emptyCtxts typ occNames = map getOccName names @@ -321,7 +321,7 @@ ppTyFam summary associated links instances fixities loc doc decl splice unicode ppTyFamEqn TyFamEqn { tfe_tycon = n, tfe_rhs = rhs , tfe_pats = HsIB { hsib_body = ts }} = ( ppAppNameTypes (unLoc n) [] (map unLoc ts) unicode qual - <+> equals <+> ppType unicode qual (unLoc rhs) + <+> equals <+> ppType unicode qual HideEmptyContexts (unLoc rhs) , Nothing, [] ) @@ -377,7 +377,7 @@ ppAppDocNameTyVarBndrs summ unicode qual n vs = ppAppNameTypes :: DocName -> [HsType DocName] -> [HsType DocName] -> Unicode -> Qualification -> Html ppAppNameTypes n ks ts unicode qual = - ppTypeApp n ks ts (\p -> ppDocName qual p True) (ppParendType unicode qual) + ppTypeApp n ks ts (\p -> ppDocName qual p True) (ppParendType unicode qual HideEmptyContexts) -- | General printing of type applications @@ -398,32 +398,35 @@ ppTypeApp n ks ts ppDN ppT = ppDN Prefix n <+> hsep (map ppT $ ks ++ ts) ppLContext, ppLContextNoArrow :: Located (HsContext DocName) -> Unicode - -> Qualification -> Html + -> Qualification -> HideEmptyContexts -> Html ppLContext = ppContext . unLoc ppLContextNoArrow = ppContextNoArrow . unLoc -ppContextNoArrow :: HsContext DocName -> Unicode -> Qualification -> Html -ppContextNoArrow cxt unicode qual = fromMaybe noHtml $ - ppContextNoLocsMaybe (map unLoc cxt) unicode qual +ppContextNoArrow :: HsContext DocName -> Unicode -> Qualification -> HideEmptyContexts -> Html +ppContextNoArrow cxt unicode qual emptyCtxts = fromMaybe noHtml $ + ppContextNoLocsMaybe (map unLoc cxt) unicode qual emptyCtxts -ppContextNoLocs :: [HsType DocName] -> Unicode -> Qualification -> Html -ppContextNoLocs cxt unicode qual = maybe noHtml (<+> darrow unicode) $ - ppContextNoLocsMaybe cxt unicode qual +ppContextNoLocs :: [HsType DocName] -> Unicode -> Qualification -> HideEmptyContexts -> Html +ppContextNoLocs cxt unicode qual emptyCtxts = maybe noHtml (<+> darrow unicode) $ + ppContextNoLocsMaybe cxt unicode qual emptyCtxts -ppContextNoLocsMaybe :: [HsType DocName] -> Unicode -> Qualification -> Maybe Html -ppContextNoLocsMaybe [] _ _ = Nothing -ppContextNoLocsMaybe cxt unicode qual = Just $ ppHsContext cxt unicode qual +ppContextNoLocsMaybe :: [HsType DocName] -> Unicode -> Qualification -> HideEmptyContexts -> Maybe Html +ppContextNoLocsMaybe [] _ _ emptyCtxts = + case emptyCtxts of + HideEmptyContexts -> Nothing + ShowEmptyToplevelContexts -> Just (toHtml "()") +ppContextNoLocsMaybe cxt unicode qual _ = Just $ ppHsContext cxt unicode qual -ppContext :: HsContext DocName -> Unicode -> Qualification -> Html -ppContext cxt unicode qual = ppContextNoLocs (map unLoc cxt) unicode qual +ppContext :: HsContext DocName -> Unicode -> Qualification -> HideEmptyContexts -> Html +ppContext cxt unicode qual emptyCtxts = ppContextNoLocs (map unLoc cxt) unicode qual emptyCtxts -ppHsContext :: [HsType DocName] -> Unicode -> Qualification-> Html -ppHsContext [] _ _ = noHtml +ppHsContext :: [HsType DocName] -> Unicode -> Qualification -> Html +ppHsContext [] _ _ = noHtml ppHsContext [p] unicode qual = ppCtxType unicode qual p -ppHsContext cxt unicode qual = parenList (map (ppType unicode qual) cxt) +ppHsContext cxt unicode qual = parenList (map (ppType unicode qual HideEmptyContexts) cxt) ------------------------------------------------------------------------------- @@ -436,7 +439,7 @@ ppClassHdr :: Bool -> Located [LHsType DocName] -> DocName -> Unicode -> Qualification -> Html ppClassHdr summ lctxt n tvs fds unicode qual = keyword "class" - <+> (if not . null . unLoc $ lctxt then ppLContext lctxt unicode qual else noHtml) + <+> (if not . null . unLoc $ lctxt then ppLContext lctxt unicode qual HideEmptyContexts else noHtml) <+> ppAppDocNameTyVarBndrs summ unicode qual n (hsQTvExplicit tvs) <+> ppFds fds unicode qual @@ -592,7 +595,7 @@ ppInstHead :: LinksInfo -> Splice -> Unicode -> Qualification ppInstHead links splice unicode qual mdoc origin orphan no ihd@(InstHead {..}) = case ihdInstType of ClassInst { .. } -> - ( subInstHead iid $ ppContextNoLocs clsiCtx unicode qual <+> typ + ( subInstHead iid $ ppContextNoLocs clsiCtx unicode qual HideEmptyContexts <+> typ , mdoc , [subInstDetails iid ats sigs] ) @@ -607,7 +610,7 @@ ppInstHead links splice unicode qual mdoc origin orphan no ihd@(InstHead {..}) = where ptype = keyword "type" <+> typ prhs = ptype <+> maybe noHtml - (\t -> equals <+> ppType unicode qual t) rhs + (\t -> equals <+> ppType unicode qual HideEmptyContexts t) rhs DataInst dd -> ( subInstHead iid pdata , mdoc @@ -636,9 +639,9 @@ ppInstanceSigs links splice unicode qual sigs = do TypeSig lnames typ <- sigs let names = map unLoc lnames L _ rtyp = hsSigWcType typ - -- Instance methods signatures are synified and thus don't have a useful + -- Instance methods signatures are synified and thus don't have a useful -- SrcSpan value. Use the methods name location instead. - return $ ppSimpleSig links splice unicode qual (getLoc $ head $ lnames) names rtyp + return $ ppSimpleSig links splice unicode qual HideEmptyContexts (getLoc $ head $ lnames) names rtyp lookupAnySubdoc :: Eq id1 => id1 -> [(id1, DocForDecl id2)] -> DocForDecl id2 @@ -698,7 +701,7 @@ ppShortDataDecl summary dataInst dataDecl pats unicode qual pats1 = [ hsep [ keyword "pattern" , hsep $ punctuate comma $ map (ppBinder summary . getOccName) lnames , dcolon unicode - , ppLType unicode qual (hsSigType typ) + , ppPatSigType unicode qual (hsSigType typ) ] | (SigD (PatSynSig lnames typ),_) <- pats ] @@ -744,7 +747,7 @@ ppDataDecl summary links instances fixities subdocs loc doc dataDecl pats [ (hsep [ keyword "pattern" , hsep $ punctuate comma $ map (ppBinder summary . getOccName) lnames , dcolon unicode - , ppLType unicode qual (hsSigType typ) + , ppPatSigType unicode qual (hsSigType typ) ] <+> ppFixities subfixs qual ,combineDocumentation (fst d), []) | (SigD (PatSynSig lnames typ),d) <- pats @@ -769,17 +772,17 @@ ppShortConstrParts summary dataInst con unicode qual = case con of ConDeclH98{} -> case con_details con of PrefixCon args -> (header_ unicode qual +++ hsep (ppOcc - : map (ppLParendType unicode qual) args), noHtml, noHtml) + : map (ppLParendType unicode qual HideEmptyContexts) args), noHtml, noHtml) RecCon (L _ fields) -> (header_ unicode qual +++ ppOcc <+> char '{', doRecordFields fields, char '}') InfixCon arg1 arg2 -> - (header_ unicode qual +++ hsep [ppLParendType unicode qual arg1, - ppOccInfix, ppLParendType unicode qual arg2], + (header_ unicode qual +++ hsep [ppLParendType unicode qual HideEmptyContexts arg1, + ppOccInfix, ppLParendType unicode qual HideEmptyContexts arg2], noHtml, noHtml) - ConDeclGADT {} -> (ppOcc <+> dcolon unicode <+> ppLType unicode qual resTy,noHtml,noHtml) + ConDeclGADT {} -> (ppOcc <+> dcolon unicode <+> ppLType unicode qual HideEmptyContexts resTy,noHtml,noHtml) where resTy = hsib_body (con_type con) @@ -811,7 +814,7 @@ ppConstrHdr forall_ tvs ctxt unicode qual = (if null tvs then noHtml else ppForall) +++ (if null ctxt then noHtml - else ppContextNoArrow ctxt unicode qual + else ppContextNoArrow ctxt unicode qual HideEmptyContexts <+> darrow unicode +++ toHtml " ") where ppForall | forall_ = forallSymbol unicode <+> hsep (map (ppName Prefix) tvs) @@ -827,15 +830,15 @@ ppSideBySideConstr subdocs fixities unicode qual (L _ con) ConDeclH98{} -> case con_details con of PrefixCon args -> hsep ((header_ +++ ppOcc) - : map (ppLParendType unicode qual) args) + : map (ppLParendType unicode qual HideEmptyContexts) args) <+> fixity RecCon _ -> header_ +++ ppOcc <+> fixity InfixCon arg1 arg2 -> - hsep [header_ +++ ppLParendType unicode qual arg1, + hsep [header_ +++ ppLParendType unicode qual HideEmptyContexts arg1, ppOccInfix, - ppLParendType unicode qual arg2] + ppLParendType unicode qual HideEmptyContexts arg2] <+> fixity ConDeclGADT{} -> doGADTCon resTy @@ -852,7 +855,7 @@ ppSideBySideConstr subdocs fixities unicode qual (L _ con) doGADTCon :: Located (HsType DocName) -> Html doGADTCon ty = ppOcc <+> dcolon unicode -- ++AZ++ make this prepend "{..}" when it is a record style GADT - <+> ppLType unicode qual ty + <+> ppLType unicode qual HideEmptyContexts ty <+> fixity fixity = ppFixities fixities qual @@ -879,9 +882,12 @@ ppSideBySideConstr subdocs fixities unicode qual (L _ con) ppSideBySideField :: [(DocName, DocForDecl DocName)] -> Unicode -> Qualification -> ConDeclField DocName -> SubDecl ppSideBySideField subdocs unicode qual (ConDeclField names ltype _) = - (hsep (punctuate comma (map ((ppBinder False) . rdrNameOcc . unLoc . rdrNameFieldOcc . unLoc) names)) <+> dcolon unicode <+> ppLType unicode qual ltype, - mbDoc, - []) + ( hsep (punctuate comma (map ((ppBinder False) . rdrNameOcc . unLoc . rdrNameFieldOcc . unLoc) names)) + <+> dcolon unicode + <+> ppLType unicode qual HideEmptyContexts ltype + , mbDoc + , [] + ) where -- don't use cd_fld_doc for same reason we don't use con_doc above -- Where there is more than one name, they all have the same documentation @@ -891,7 +897,7 @@ ppSideBySideField subdocs unicode qual (ConDeclField names ltype _) = ppShortField :: Bool -> Unicode -> Qualification -> ConDeclField DocName -> Html ppShortField summary unicode qual (ConDeclField names ltype _) = hsep (punctuate comma (map ((ppBinder summary) . rdrNameOcc . unLoc . rdrNameFieldOcc . unLoc) names)) - <+> dcolon unicode <+> ppLType unicode qual ltype + <+> dcolon unicode <+> ppLType unicode qual HideEmptyContexts ltype -- | Print the LHS of a data\/newtype declaration. @@ -906,7 +912,7 @@ ppDataHeader summary decl@(DataDecl { tcdDataDefn = (case nd of { NewType -> keyword "newtype"; DataType -> keyword "data" }) <+> -- context - ppLContext ctxt unicode qual <+> + ppLContext ctxt unicode qual HideEmptyContexts <+> -- T a b c ..., or a :+: b ppDataBinderWithVars summary unicode qual decl <+> case ks of @@ -958,19 +964,18 @@ maybeParen ctxt_prec op_prec p | ctxt_prec >= op_prec = parens p | otherwise = p -ppLType, ppLParendType, ppLFunLhType :: Unicode -> Qualification - -> Located (HsType DocName) -> Html -ppLType unicode qual y = ppType unicode qual (unLoc y) -ppLParendType unicode qual y = ppParendType unicode qual (unLoc y) -ppLFunLhType unicode qual y = ppFunLhType unicode qual (unLoc y) +ppLType, ppLParendType, ppLFunLhType :: Unicode -> Qualification -> HideEmptyContexts -> Located (HsType DocName) -> Html +ppLType unicode qual emptyCtxts y = ppType unicode qual emptyCtxts (unLoc y) +ppLParendType unicode qual emptyCtxts y = ppParendType unicode qual emptyCtxts (unLoc y) +ppLFunLhType unicode qual emptyCtxts y = ppFunLhType unicode qual emptyCtxts (unLoc y) +ppCtxType :: Unicode -> Qualification -> HsType DocName -> Html +ppCtxType unicode qual ty = ppr_mono_ty pREC_CTX ty unicode qual HideEmptyContexts -ppType, ppCtxType, ppParendType, ppFunLhType :: Unicode -> Qualification - -> HsType DocName -> Html -ppType unicode qual ty = ppr_mono_ty pREC_TOP ty unicode qual -ppCtxType unicode qual ty = ppr_mono_ty pREC_CTX ty unicode qual -ppParendType unicode qual ty = ppr_mono_ty pREC_CON ty unicode qual -ppFunLhType unicode qual ty = ppr_mono_ty pREC_FUN ty unicode qual +ppType, ppParendType, ppFunLhType :: Unicode -> Qualification -> HideEmptyContexts -> HsType DocName -> Html +ppType unicode qual emptyCtxts ty = ppr_mono_ty pREC_TOP ty unicode qual emptyCtxts +ppParendType unicode qual emptyCtxts ty = ppr_mono_ty pREC_CON ty unicode qual emptyCtxts +ppFunLhType unicode qual emptyCtxts ty = ppr_mono_ty pREC_FUN ty unicode qual emptyCtxts ppHsTyVarBndr :: Unicode -> Qualification -> HsTyVarBndr DocName -> Html ppHsTyVarBndr _ qual (UserTyVar (L _ name)) = @@ -983,62 +988,85 @@ ppLKind :: Unicode -> Qualification -> LHsKind DocName -> Html ppLKind unicode qual y = ppKind unicode qual (unLoc y) ppKind :: Unicode -> Qualification -> HsKind DocName -> Html -ppKind unicode qual ki = ppr_mono_ty pREC_TOP ki unicode qual +ppKind unicode qual ki = ppr_mono_ty pREC_TOP ki unicode qual HideEmptyContexts + +ppPatSigType :: Unicode -> Qualification -> LHsType DocName -> Html +ppPatSigType unicode qual typ = + let emptyCtxts = + if hasNonEmptyContext typ && isFirstContextEmpty typ + then ShowEmptyToplevelContexts + else HideEmptyContexts + in ppLType unicode qual emptyCtxts typ + where + hasNonEmptyContext :: LHsType name -> Bool + hasNonEmptyContext t = + case unLoc t of + HsForAllTy _ s -> hasNonEmptyContext s + HsQualTy cxt s -> if null (unLoc cxt) then hasNonEmptyContext s else True + HsFunTy _ s -> hasNonEmptyContext s + _ -> False + isFirstContextEmpty :: LHsType name -> Bool + isFirstContextEmpty t = + case unLoc t of + HsForAllTy _ s -> isFirstContextEmpty s + HsQualTy cxt _ -> null (unLoc cxt) + HsFunTy _ s -> isFirstContextEmpty s + _ -> False ppForAllPart :: Unicode -> Qualification -> [LHsTyVarBndr DocName] -> Html ppForAllPart unicode qual tvs = hsep (forallSymbol unicode : ppTyVars unicode qual tvs) +++ dot -ppr_mono_lty :: Int -> LHsType DocName -> Unicode -> Qualification -> Html +ppr_mono_lty :: Int -> LHsType DocName -> Unicode -> Qualification -> HideEmptyContexts -> Html ppr_mono_lty ctxt_prec ty = ppr_mono_ty ctxt_prec (unLoc ty) -ppr_mono_ty :: Int -> HsType DocName -> Unicode -> Qualification -> Html -ppr_mono_ty ctxt_prec (HsForAllTy tvs ty) unicode qual +ppr_mono_ty :: Int -> HsType DocName -> Unicode -> Qualification -> HideEmptyContexts -> Html +ppr_mono_ty ctxt_prec (HsForAllTy tvs ty) unicode qual emptyCtxts = maybeParen ctxt_prec pREC_FUN $ - ppForAllPart unicode qual tvs <+> ppr_mono_lty pREC_TOP ty unicode qual + ppForAllPart unicode qual tvs <+> ppr_mono_lty pREC_TOP ty unicode qual emptyCtxts -ppr_mono_ty ctxt_prec (HsQualTy ctxt ty) unicode qual +ppr_mono_ty ctxt_prec (HsQualTy ctxt ty) unicode qual emptyCtxts = maybeParen ctxt_prec pREC_FUN $ - ppLContext ctxt unicode qual <+> ppr_mono_lty pREC_TOP ty unicode qual + ppLContext ctxt unicode qual emptyCtxts <+> ppr_mono_lty pREC_TOP ty unicode qual emptyCtxts -- UnicodeSyntax alternatives -ppr_mono_ty _ (HsTyVar _ (L _ name)) True _ +ppr_mono_ty _ (HsTyVar _ (L _ name)) True _ _ | getOccString (getName name) == "*" = toHtml "★" | getOccString (getName name) == "(->)" = toHtml "(→)" -ppr_mono_ty _ (HsBangTy b ty) u q = ppBang b +++ ppLParendType u q ty -ppr_mono_ty _ (HsTyVar _ (L _ name)) _ q = ppDocName q Prefix True name -ppr_mono_ty ctxt_prec (HsFunTy ty1 ty2) u q = ppr_fun_ty ctxt_prec ty1 ty2 u q -ppr_mono_ty _ (HsTupleTy con tys) u q = tupleParens con (map (ppLType u q) tys) -ppr_mono_ty _ (HsSumTy tys) u q = sumParens (map (ppLType u q) tys) -ppr_mono_ty _ (HsKindSig ty kind) u q = - parens (ppr_mono_lty pREC_TOP ty u q <+> dcolon u <+> ppLKind u q kind) -ppr_mono_ty _ (HsListTy ty) u q = brackets (ppr_mono_lty pREC_TOP ty u q) -ppr_mono_ty _ (HsPArrTy ty) u q = pabrackets (ppr_mono_lty pREC_TOP ty u q) -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 -ppr_mono_ty _ (HsSpliceTy {}) _ _ = error "ppr_mono_ty HsSpliceTy" -ppr_mono_ty _ (HsRecTy {}) _ _ = toHtml "{..}" +ppr_mono_ty _ (HsBangTy b ty) u q _ = ppBang b +++ ppLParendType u q HideEmptyContexts ty +ppr_mono_ty _ (HsTyVar _ (L _ name)) _ q _ = ppDocName q Prefix True name +ppr_mono_ty ctxt_prec (HsFunTy ty1 ty2) u q e = ppr_fun_ty ctxt_prec ty1 ty2 u q e +ppr_mono_ty _ (HsTupleTy con tys) u q _ = tupleParens con (map (ppLType u q HideEmptyContexts) tys) +ppr_mono_ty _ (HsSumTy tys) u q _ = sumParens (map (ppLType u q HideEmptyContexts) tys) +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" +ppr_mono_ty _ (HsRecTy {}) _ _ _ = toHtml "{..}" -- Can now legally occur in ConDeclGADT, the output here is to provide a -- placeholder in the signature, which is followed by the field -- declarations. -ppr_mono_ty _ (HsCoreTy {}) _ _ = error "ppr_mono_ty HsCoreTy" -ppr_mono_ty _ (HsExplicitListTy Promoted _ tys) u q = promoQuote $ brackets $ hsep $ punctuate comma $ map (ppLType u q) tys -ppr_mono_ty _ (HsExplicitListTy NotPromoted _ tys) u q = brackets $ hsep $ punctuate comma $ map (ppLType u q) tys -ppr_mono_ty _ (HsExplicitTupleTy _ tys) u q = promoQuote $ parenList $ map (ppLType u q) tys -ppr_mono_ty _ (HsAppsTy {}) _ _ = error "ppr_mono_ty HsAppsTy" +ppr_mono_ty _ (HsCoreTy {}) _ _ _ = error "ppr_mono_ty HsCoreTy" +ppr_mono_ty _ (HsExplicitListTy Promoted _ tys) u q _ = promoQuote $ brackets $ hsep $ punctuate comma $ map (ppLType u q HideEmptyContexts) tys +ppr_mono_ty _ (HsExplicitListTy NotPromoted _ tys) u q _ = brackets $ hsep $ punctuate comma $ map (ppLType u q HideEmptyContexts) tys +ppr_mono_ty _ (HsExplicitTupleTy _ tys) u q _ = promoQuote $ parenList $ map (ppLType u q HideEmptyContexts) tys +ppr_mono_ty _ (HsAppsTy {}) _ _ _ = error "ppr_mono_ty HsAppsTy" -ppr_mono_ty ctxt_prec (HsEqTy ty1 ty2) unicode qual +ppr_mono_ty ctxt_prec (HsEqTy ty1 ty2) unicode qual _ = maybeParen ctxt_prec pREC_CTX $ - ppr_mono_lty pREC_OP ty1 unicode qual <+> char '~' <+> ppr_mono_lty pREC_OP ty2 unicode qual + ppr_mono_lty pREC_OP ty1 unicode qual HideEmptyContexts <+> char '~' <+> ppr_mono_lty pREC_OP ty2 unicode qual HideEmptyContexts -ppr_mono_ty ctxt_prec (HsAppTy fun_ty arg_ty) unicode qual +ppr_mono_ty ctxt_prec (HsAppTy fun_ty arg_ty) unicode qual _ = maybeParen ctxt_prec pREC_CON $ - hsep [ppr_mono_lty pREC_FUN fun_ty unicode qual, ppr_mono_lty pREC_CON arg_ty unicode qual] + hsep [ppr_mono_lty pREC_FUN fun_ty unicode qual HideEmptyContexts, ppr_mono_lty pREC_CON arg_ty unicode qual HideEmptyContexts] -ppr_mono_ty ctxt_prec (HsOpTy ty1 op ty2) unicode qual +ppr_mono_ty ctxt_prec (HsOpTy ty1 op ty2) unicode qual _ = maybeParen ctxt_prec pREC_FUN $ - ppr_mono_lty pREC_OP ty1 unicode qual <+> ppr_op <+> ppr_mono_lty pREC_OP ty2 unicode qual + ppr_mono_lty pREC_OP ty1 unicode qual HideEmptyContexts <+> ppr_op <+> ppr_mono_lty pREC_OP ty2 unicode qual HideEmptyContexts where -- `(:)` is valid in type signature only as constructor to promoted list -- and needs to be quoted in code so we explicitly quote it here too. @@ -1047,25 +1075,25 @@ ppr_mono_ty ctxt_prec (HsOpTy ty1 op ty2) unicode qual | otherwise = ppr_op' ppr_op' = ppLDocName qual Infix op -ppr_mono_ty ctxt_prec (HsParTy ty) unicode qual +ppr_mono_ty ctxt_prec (HsParTy ty) unicode qual emptyCtxts -- = parens (ppr_mono_lty pREC_TOP ty) - = ppr_mono_lty ctxt_prec ty unicode qual + = ppr_mono_lty ctxt_prec ty unicode qual emptyCtxts -ppr_mono_ty ctxt_prec (HsDocTy ty _) unicode qual - = ppr_mono_lty ctxt_prec ty unicode qual +ppr_mono_ty ctxt_prec (HsDocTy ty _) unicode qual emptyCtxts + = ppr_mono_lty ctxt_prec ty unicode qual emptyCtxts -ppr_mono_ty _ (HsWildCardTy (AnonWildCard _)) _ _ = char '_' -ppr_mono_ty _ (HsTyLit n) _ _ = ppr_tylit n +ppr_mono_ty _ (HsWildCardTy (AnonWildCard _)) _ _ _ = char '_' +ppr_mono_ty _ (HsTyLit n) _ _ _ = ppr_tylit n ppr_tylit :: HsTyLit -> Html ppr_tylit (HsNumTy _ n) = toHtml (show n) ppr_tylit (HsStrTy _ s) = toHtml (show s) -ppr_fun_ty :: Int -> LHsType DocName -> LHsType DocName -> Unicode -> Qualification -> Html -ppr_fun_ty ctxt_prec ty1 ty2 unicode qual - = let p1 = ppr_mono_lty pREC_FUN ty1 unicode qual - p2 = ppr_mono_lty pREC_TOP ty2 unicode qual +ppr_fun_ty :: Int -> LHsType DocName -> LHsType DocName -> Unicode -> Qualification -> HideEmptyContexts -> Html +ppr_fun_ty ctxt_prec ty1 ty2 unicode qual emptyCtxts + = let p1 = ppr_mono_lty pREC_FUN ty1 unicode qual HideEmptyContexts + p2 = ppr_mono_lty pREC_TOP ty2 unicode qual emptyCtxts in maybeParen ctxt_prec pREC_FUN $ hsep [p1, arrow unicode <+> p2] diff --git a/haddock-api/src/Haddock/Interface/Create.hs b/haddock-api/src/Haddock/Interface/Create.hs index b9179d11..89f7f71b 100644 --- a/haddock-api/src/Haddock/Interface/Create.hs +++ b/haddock-api/src/Haddock/Interface/Create.hs @@ -985,7 +985,9 @@ extractDecl name decl O.$$ O.nest 4 (O.ppr matches)) TyClD d@DataDecl {} -> let (n, tyvar_tys) = (tcdName d, lHsQTyVarsToTypes (tyClDeclTyVars d)) - in SigD <$> extractRecSel name n tyvar_tys (dd_cons (tcdDataDefn d)) + in if isDataConName name + then SigD <$> extractPatternSyn name n tyvar_tys (dd_cons (tcdDataDefn d)) + else SigD <$> extractRecSel name n tyvar_tys (dd_cons (tcdDataDefn d)) InstD (DataFamInstD DataFamInstDecl { dfid_tycon = L _ n , dfid_pats = HsIB { hsib_body = tys } , dfid_defn = defn }) -> @@ -1003,6 +1005,36 @@ extractDecl name decl _ -> error "internal: extractDecl (ClsInstD)" _ -> error "internal: extractDecl" +extractPatternSyn :: Name -> Name -> [LHsType Name] -> [LConDecl Name] -> LSig Name +extractPatternSyn nm t tvs cons = + case filter matches cons of + [] -> error "extractPatternSyn: constructor pattern not found" + con:_ -> extract <$> con + where + matches :: LConDecl Name -> Bool + matches (L _ con) = nm `elem` (unLoc <$> getConNames con) + extract :: ConDecl Name -> Sig Name + extract con = + let args = + case getConDetails con of + PrefixCon args' -> args' + RecCon (L _ fields) -> cd_fld_type . unLoc <$> fields + InfixCon arg1 arg2 -> [arg1, arg2] + typ = longArrow args (data_ty con) + typ' = + case con of + ConDeclH98 { con_cxt = Just cxt } -> noLoc (HsQualTy cxt typ) + _ -> typ + typ'' = noLoc (HsQualTy (noLoc []) typ') + in PatSynSig [noLoc nm] (mkEmptyImplicitBndrs typ'') + + longArrow :: [LHsType name] -> LHsType name -> LHsType name + longArrow inputs output = foldr (\x y -> noLoc (HsFunTy x y)) output inputs + + data_ty con + | ConDeclGADT{} <- con = hsib_body $ con_type con + | otherwise = foldl' (\x y -> noLoc (HsAppTy x y)) (noLoc (HsTyVar NotPromoted (noLoc t))) tvs + extractRecSel :: Name -> Name -> [LHsType Name] -> [LConDecl Name] -> LSig Name extractRecSel _ _ _ [] = error "extractRecSel: selector not found" diff --git a/haddock-api/src/Haddock/Types.hs b/haddock-api/src/Haddock/Types.hs index de599bd8..724f59bc 100644 --- a/haddock-api/src/Haddock/Types.hs +++ b/haddock-api/src/Haddock/Types.hs @@ -579,6 +579,12 @@ makeModuleQual qual aliases mdl = OptFullQual -> FullQual OptNoQual -> NoQual +-- | Whether to hide empty contexts +-- Since pattern synonyms have two contexts with different semantics, it is +-- important to all of them, even if one of them is empty. +data HideEmptyContexts + = HideEmptyContexts + | ShowEmptyToplevelContexts ----------------------------------------------------------------------------- -- * Error handling diff --git a/html-test/ref/ConstructorPatternExport.html b/html-test/ref/ConstructorPatternExport.html new file mode 100644 index 00000000..20f00d0f --- /dev/null +++ b/html-test/ref/ConstructorPatternExport.html @@ -0,0 +1,124 @@ +ConstructorPatternExport
    Safe HaskellSafe

    ConstructorPatternExport

    Documentation

    pattern FooCons :: String -> a -> Foo a #

    pattern MyRecCons :: Bool -> Int -> MyRec #

    pattern (:+) :: String -> a -> MyInfix a #

    pattern BlubCons :: () => Show b => b -> Blub #

    pattern MyGADTCons :: () => forall a. Eq a => a -> Int -> MyGADT (Maybe String) #

    \ No newline at end of file diff --git a/html-test/ref/PatternSyns.html b/html-test/ref/PatternSyns.html index 2cf936b3..37596645 100644 --- a/html-test/ref/PatternSyns.html +++ b/html-test/ref/PatternSyns.html @@ -99,6 +99,28 @@ window.onload = function () {pageLoad();}; >FooType x1))
  • data BlubType = Show x => BlubCtor x
  • pattern Blub :: () => forall x. Show x => x -> BlubType
  • data (a ::

    data BlubType #

    BlubType is existentially quantified

    Constructors

    Show x => BlubCtor x

    pattern Blub :: () => forall x. Show x => x -> BlubType #

    Pattern synonym for Blub x

    data BlubCons b + +data MyGADT :: * -> * where + MyGADTCons :: forall a. Eq a => a -> Int -> MyGADT (Maybe String) + +pattern MyGADTCons' :: () => forall a. Eq a => a -> Int -> MyGADT (Maybe String) +pattern MyGADTCons' x y = MyGADTCons x y \ No newline at end of file diff --git a/html-test/src/PatternSyns.hs b/html-test/src/PatternSyns.hs index a8de113c..bf0f7848 100644 --- a/html-test/src/PatternSyns.hs +++ b/html-test/src/PatternSyns.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE PatternSynonyms, PolyKinds, TypeOperators #-} +{-# LANGUAGE ExistentialQuantification, PatternSynonyms, PolyKinds, TypeOperators #-} -- | Testing some pattern synonyms module PatternSyns where @@ -15,6 +15,12 @@ pattern Bar x = FooCtor (Foo x) -- | Pattern synonym for (':<->') pattern x :<-> y = (Foo x, Bar y) +-- | BlubType is existentially quantified +data BlubType = forall x. Show x => BlubCtor x + +-- | Pattern synonym for 'Blub' x +pattern Blub x = BlubCtor x + -- | Doc for ('><') data (a :: *) >< b = Empty -- cgit v1.2.3 From 1732b91dcdb3eee32f2301fb400f96506bd9ccb4 Mon Sep 17 00:00:00 2001 From: Alexander Biehl Date: Sun, 6 Aug 2017 12:43:25 +0200 Subject: Bump haddock-library --- haddock-library/haddock-library.cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/haddock-library/haddock-library.cabal b/haddock-library/haddock-library.cabal index 0a07094b..120af729 100644 --- a/haddock-library/haddock-library.cabal +++ b/haddock-library/haddock-library.cabal @@ -1,5 +1,5 @@ name: haddock-library -version: 1.4.5 +version: 1.4.6 synopsis: Library exposing some functionality of Haddock. description: Haddock is a documentation-generation tool for Haskell libraries. These modules expose some functionality of it -- cgit v1.2.3 From a677f1592d292a422b9a8d681b0b63a9af611722 Mon Sep 17 00:00:00 2001 From: Alexander Biehl Date: Sun, 6 Aug 2017 12:44:07 +0200 Subject: Bump haddock-library in haddock-api --- haddock-api/haddock-api.cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/haddock-api/haddock-api.cabal b/haddock-api/haddock-api.cabal index 6cde7266..ef4bb98c 100644 --- a/haddock-api/haddock-api.cabal +++ b/haddock-api/haddock-api.cabal @@ -42,7 +42,7 @@ library , Cabal ^>= 2.0.0 , ghc ^>= 8.2 , ghc-paths ^>= 0.1.0.9 - , haddock-library ^>= 1.4.5 + , haddock-library ^>= 1.4.6 , xhtml ^>= 3000.2.2 -- Versions for the dependencies below are transitively pinned by -- cgit v1.2.3 From f1d326b53fbed5d37f2a83c66e73dbbc94a4354f Mon Sep 17 00:00:00 2001 From: Alexander Biehl Date: Sun, 6 Aug 2017 13:18:02 +0200 Subject: Provide --show-interface option to dump interfaces (#645) * WIP: Provide --show-interface option to dump interfaces Like ghcs own --show-iface this flag dumps a binary interface file to stdout in a human (and machine) readable fashion. Currently it uses json as output format. * Fill all the jsonNull stubs * Rework Bifunctor instance of DocH, update changelog and documentation * replace changelog, bring DocMarkupH doc back * Update CHANGES.md * Update CHANGES.md * Move Control.Arrow up It would result in unused import if the Bifunctor instance is not generated. --- doc/invoking.rst | 5 + haddock-api/haddock-api.cabal | 1 + haddock-api/src/Haddock.hs | 7 ++ haddock-api/src/Haddock/Interface/Json.hs | 109 +++++++++++++++++++++ haddock-api/src/Haddock/Options.hs | 6 ++ haddock-library/CHANGES.md | 6 ++ haddock-library/src/Documentation/Haddock/Types.hs | 33 ++++++- haddock.cabal | 1 + 8 files changed, 167 insertions(+), 1 deletion(-) create mode 100644 haddock-api/src/Haddock/Interface/Json.hs diff --git a/doc/invoking.rst b/doc/invoking.rst index 83087bac..fc1e4410 100644 --- a/doc/invoking.rst +++ b/doc/invoking.rst @@ -88,6 +88,11 @@ The following options are available: :option:`--read-interface` option for more details. The interface file is in a binary format; don't try to read it. +.. option:: --show-interface= + + Dumps a binary interface file to stdout in a human readable fashion. + Uses json as output format. + .. [1] Haddock interface files are not the same as Haskell interface files, I just couldn't think of a better name. diff --git a/haddock-api/haddock-api.cabal b/haddock-api/haddock-api.cabal index ef4bb98c..d38e9149 100644 --- a/haddock-api/haddock-api.cabal +++ b/haddock-api/haddock-api.cabal @@ -73,6 +73,7 @@ library Haddock.Interface.Rename Haddock.Interface.Create Haddock.Interface.AttachInstances + Haddock.Interface.Json Haddock.Interface.LexParseRn Haddock.Interface.ParseModuleHeader Haddock.Interface.Specialize diff --git a/haddock-api/src/Haddock.hs b/haddock-api/src/Haddock.hs index 57ea5fea..554cb416 100644 --- a/haddock-api/src/Haddock.hs +++ b/haddock-api/src/Haddock.hs @@ -32,6 +32,7 @@ import Haddock.Backends.LaTeX import Haddock.Backends.Hoogle import Haddock.Backends.Hyperlinker import Haddock.Interface +import Haddock.Interface.Json import Haddock.Parser import Haddock.Types import Haddock.Version @@ -68,6 +69,7 @@ import System.Directory (doesDirectoryExist) import GHC hiding (verbosity) import Config import DynFlags hiding (projectVersion, verbosity) +import ErrUtils import Packages import Panic (handleGhcException) import Module @@ -164,6 +166,11 @@ haddockWithGhc ghc args = handleTopExceptions $ do dflags <- getDynFlags + forM_ (optShowInterfaceFile flags) $ \path -> liftIO $ do + mIfaceFile <- readInterfaceFiles freshNameCache [(("", Nothing), path)] + forM_ mIfaceFile $ \(_, ifaceFile) -> do + putMsg dflags (renderJson (jsonInterfaceFile ifaceFile)) + if not (null files) then do (packages, ifaces, homeLinks) <- readPackagesAndProcessModules flags files diff --git a/haddock-api/src/Haddock/Interface/Json.hs b/haddock-api/src/Haddock/Interface/Json.hs new file mode 100644 index 00000000..9a569204 --- /dev/null +++ b/haddock-api/src/Haddock/Interface/Json.hs @@ -0,0 +1,109 @@ +{-# LANGUAGE RecordWildCards #-} +module Haddock.Interface.Json ( + jsonInstalledInterface + , jsonInterfaceFile + , renderJson + ) where + +import BasicTypes +import Json +import Module +import Name +import Outputable + +import Control.Arrow +import Data.Map (Map) +import Data.Bifunctor +import qualified Data.Map as Map + +import Haddock.Types +import Haddock.InterfaceFile + +jsonInterfaceFile :: InterfaceFile -> JsonDoc +jsonInterfaceFile InterfaceFile{..} = + jsonObject [ ("link_env" , jsonMap nameStableString (jsonString . moduleNameString . moduleName) ifLinkEnv) + , ("inst_ifaces", jsonArray (map jsonInstalledInterface ifInstalledIfaces)) + ] + +jsonInstalledInterface :: InstalledInterface -> JsonDoc +jsonInstalledInterface InstalledInterface{..} = jsonObject properties + where + properties = + [ ("module" , jsonModule instMod) + , ("is_sig" , jsonBool instIsSig) + , ("info" , jsonHaddockModInfo instInfo) + , ("doc_map" , jsonMap nameStableString jsonMDoc instDocMap) + , ("arg_map" , jsonMap nameStableString (jsonMap show jsonMDoc) instArgMap) + , ("exports" , jsonArray (map jsonName instExports)) + , ("visible_exports" , jsonArray (map jsonName instVisibleExports)) + , ("options" , jsonArray (map (jsonString . show) instOptions)) + , ("sub_map" , jsonMap nameStableString (jsonArray . map jsonName) instSubMap) + , ("bundled_patsyns" , jsonMap nameStableString (jsonArray . map jsonName) instBundledPatSynMap) + , ("fix_map" , jsonMap nameStableString jsonFixity instFixMap) + ] + +jsonHaddockModInfo :: HaddockModInfo Name -> JsonDoc +jsonHaddockModInfo HaddockModInfo{..} = + jsonObject [ ("description" , jsonMaybe jsonDoc hmi_description) + , ("copyright" , jsonMaybe jsonString hmi_copyright) + , ("maintainer" , jsonMaybe jsonString hmi_maintainer) + , ("stability" , jsonMaybe jsonString hmi_stability) + , ("protability" , jsonMaybe jsonString hmi_portability) + , ("safety" , jsonMaybe jsonString hmi_safety) + , ("language" , jsonMaybe (jsonString . show) hmi_language) + , ("extensions" , jsonArray (map (jsonString . show) hmi_extensions)) + ] + +jsonMap :: (a -> String) -> (b -> JsonDoc) -> Map a b -> JsonDoc +jsonMap f g = jsonObject . map (f *** g) . Map.toList + +jsonMDoc :: MDoc Name -> JsonDoc +jsonMDoc MetaDoc{..} = + jsonObject [ ("meta", jsonObject [("version", jsonMaybe (jsonString . show) (_version _meta))]) + , ("doc", jsonDoc _doc) + ] + +jsonDoc :: Doc Name -> JsonDoc +jsonDoc doc = jsonString (show (bimap (moduleNameString . fst) nameStableString doc)) + +jsonModule :: Module -> JsonDoc +jsonModule = JSString . moduleStableString + +jsonName :: Name -> JsonDoc +jsonName = JSString . nameStableString + +jsonFixity :: Fixity -> JsonDoc +jsonFixity (Fixity _ prec dir) = + jsonObject [ ("prec" , jsonInt prec) + , ("direction" , jsonFixityDirection dir) + ] + +jsonFixityDirection :: FixityDirection -> JsonDoc +jsonFixityDirection InfixL = jsonString "infixl" +jsonFixityDirection InfixR = jsonString "infixr" +jsonFixityDirection InfixN = jsonString "infix" + +renderJson :: JsonDoc -> SDoc +renderJson = renderJSON + +jsonMaybe :: (a -> JsonDoc) -> Maybe a -> JsonDoc +jsonMaybe = maybe jsonNull + +jsonString :: String -> JsonDoc +jsonString = JSString + +jsonObject :: [(String, JsonDoc)] -> JsonDoc +jsonObject = JSObject + +jsonArray :: [JsonDoc] -> JsonDoc +jsonArray = JSArray + +jsonNull :: JsonDoc +jsonNull = JSNull + +jsonInt :: Int -> JsonDoc +jsonInt = JSInt + +jsonBool :: Bool -> JsonDoc +jsonBool = JSBool + diff --git a/haddock-api/src/Haddock/Options.hs b/haddock-api/src/Haddock/Options.hs index 0449c829..d73d1a79 100644 --- a/haddock-api/src/Haddock/Options.hs +++ b/haddock-api/src/Haddock/Options.hs @@ -25,6 +25,7 @@ module Haddock.Options ( sourceUrls, wikiUrls, optDumpInterfaceFile, + optShowInterfaceFile, optLaTeXStyle, optMathjax, qualification, @@ -53,6 +54,7 @@ data Flag -- | Flag_DocBook | Flag_ReadInterface String | Flag_DumpInterface String + | Flag_ShowInterface String | Flag_Heading String | Flag_Html | Flag_Hoogle @@ -112,6 +114,8 @@ options backwardsCompat = "read an interface from FILE", Option ['D'] ["dump-interface"] (ReqArg Flag_DumpInterface "FILE") "write the resulting interface to FILE", + Option [] ["show-interface"] (ReqArg Flag_ShowInterface "FILE") + "print the interface in a human readable form", -- Option ['S'] ["docbook"] (NoArg Flag_DocBook) -- "output in DocBook XML", Option ['h'] ["html"] (NoArg Flag_Html) @@ -270,6 +274,8 @@ wikiUrls flags = optDumpInterfaceFile :: [Flag] -> Maybe FilePath optDumpInterfaceFile flags = optLast [ str | Flag_DumpInterface str <- flags ] +optShowInterfaceFile :: [Flag] -> Maybe FilePath +optShowInterfaceFile flags = optLast [ str | Flag_ShowInterface str <- flags ] optLaTeXStyle :: [Flag] -> Maybe String optLaTeXStyle flags = optLast [ str | Flag_LaTeXStyle str <- flags ] diff --git a/haddock-library/CHANGES.md b/haddock-library/CHANGES.md index bebb9982..c52908e1 100644 --- a/haddock-library/CHANGES.md +++ b/haddock-library/CHANGES.md @@ -1,3 +1,9 @@ +## Changes in version 1.4.6 + + * to be released + + * Bifunctor instance for DocH + ## Changes in version 1.4.5 * Move markup related data types to haddock-library diff --git a/haddock-library/src/Documentation/Haddock/Types.hs b/haddock-library/src/Documentation/Haddock/Types.hs index 0ab6bb4c..22cab425 100644 --- a/haddock-library/src/Documentation/Haddock/Types.hs +++ b/haddock-library/src/Documentation/Haddock/Types.hs @@ -19,6 +19,11 @@ import Data.Foldable import Data.Traversable #endif +#if MIN_VERSION_base(4,8,0) +import Control.Arrow ((***)) +import Data.Bifunctor +#endif + -- | With the advent of 'Version', we may want to start attaching more -- meta-data to comments. We make a structure for this ahead of time -- so we don't have to gut half the core each time we want to add such @@ -81,6 +86,33 @@ data DocH mod id | DocHeader (Header (DocH mod id)) deriving (Eq, Show, Functor, Foldable, Traversable) +#if MIN_VERSION_base(4,8,0) +instance Bifunctor DocH where + bimap _ _ DocEmpty = DocEmpty + bimap f g (DocAppend docA docB) = DocAppend (bimap f g docA) (bimap f g docB) + bimap _ _ (DocString s) = DocString s + bimap f g (DocParagraph doc) = DocParagraph (bimap f g doc) + bimap _ g (DocIdentifier i) = DocIdentifier (g i) + bimap f _ (DocIdentifierUnchecked m) = DocIdentifierUnchecked (f m) + bimap _ _ (DocModule s) = DocModule s + bimap f g (DocWarning doc) = DocWarning (bimap f g doc) + bimap f g (DocEmphasis doc) = DocEmphasis (bimap f g doc) + bimap f g (DocMonospaced doc) = DocMonospaced (bimap f g doc) + bimap f g (DocBold doc) = DocBold (bimap f g doc) + bimap f g (DocUnorderedList docs) = DocUnorderedList (map (bimap f g) docs) + bimap f g (DocOrderedList docs) = DocOrderedList (map (bimap f g) docs) + bimap f g (DocDefList docs) = DocDefList (map (bimap f g *** bimap f g) docs) + bimap f g (DocCodeBlock doc) = DocCodeBlock (bimap f g doc) + bimap _ _ (DocHyperlink hyperlink) = DocHyperlink hyperlink + bimap _ _ (DocPic picture) = DocPic picture + bimap _ _ (DocMathInline s) = DocMathInline s + bimap _ _ (DocMathDisplay s) = DocMathDisplay s + bimap _ _ (DocAName s) = DocAName s + bimap _ _ (DocProperty s) = DocProperty s + bimap _ _ (DocExamples examples) = DocExamples examples + bimap f g (DocHeader (Header level title)) = DocHeader (Header level (bimap f g title)) +#endif + -- | 'DocMarkupH' is a set of instructions for marking up documentation. -- In fact, it's really just a mapping from 'Doc' to some other -- type [a], where [a] is usually the type of the output (HTML, say). @@ -114,4 +146,3 @@ data DocMarkupH mod id a = Markup , markupExample :: [Example] -> a , markupHeader :: Header a -> a } - diff --git a/haddock.cabal b/haddock.cabal index 36c80f33..5ae3443c 100644 --- a/haddock.cabal +++ b/haddock.cabal @@ -106,6 +106,7 @@ executable haddock Documentation.Haddock Haddock Haddock.Interface + Haddock.Interface.Json Haddock.Interface.Rename Haddock.Interface.Create Haddock.Interface.AttachInstances -- cgit v1.2.3 From 2ad45f618b9ad2a7a5507e83c3990d93b752a3c0 Mon Sep 17 00:00:00 2001 From: alexbiehl Date: Wed, 16 Aug 2017 08:20:01 +0200 Subject: Bifoldable and Bitraversable for DocH and MetaDoc --- haddock-library/CHANGES.md | 2 +- haddock-library/src/Documentation/Haddock/Types.hs | 61 ++++++++++++++++++++++ 2 files changed, 62 insertions(+), 1 deletion(-) diff --git a/haddock-library/CHANGES.md b/haddock-library/CHANGES.md index c52908e1..53d17f5e 100644 --- a/haddock-library/CHANGES.md +++ b/haddock-library/CHANGES.md @@ -2,7 +2,7 @@ * to be released - * Bifunctor instance for DocH + * Bifunctor, Bifoldable and Bitraversable instances for DocH and MetaDoc ## Changes in version 1.4.5 diff --git a/haddock-library/src/Documentation/Haddock/Types.hs b/haddock-library/src/Documentation/Haddock/Types.hs index 22cab425..48b29075 100644 --- a/haddock-library/src/Documentation/Haddock/Types.hs +++ b/haddock-library/src/Documentation/Haddock/Types.hs @@ -24,6 +24,11 @@ import Control.Arrow ((***)) import Data.Bifunctor #endif +#if MIN_VERSION_base(4,10,0) +import Data.Bifoldable +import Data.Bitraversable +#endif + -- | With the advent of 'Version', we may want to start attaching more -- meta-data to comments. We make a structure for this ahead of time -- so we don't have to gut half the core each time we want to add such @@ -35,6 +40,19 @@ data MetaDoc mod id = , _doc :: DocH mod id } deriving (Eq, Show, Functor, Foldable, Traversable) +#if MIN_VERSION_base(4,8,0) +instance Bifunctor MetaDoc where + bimap f g (MetaDoc m d) = MetaDoc m (bimap f g d) +#endif + +#if MIN_VERSION_base(4,10,0) +instance Bifoldable MetaDoc where + bifoldr f g z d = bifoldr f g z (_doc d) + +instance Bitraversable MetaDoc where + bitraverse f g (MetaDoc m d) = MetaDoc m <$> bitraverse f g d +#endif + overDoc :: (DocH a b -> DocH c d) -> MetaDoc a b -> MetaDoc c d overDoc f d = d { _doc = f $ _doc d } @@ -113,6 +131,49 @@ instance Bifunctor DocH where bimap f g (DocHeader (Header level title)) = DocHeader (Header level (bimap f g title)) #endif +#if MIN_VERSION_base(4,10,0) +instance Bifoldable DocH where + bifoldr f g z (DocAppend docA docB) = bifoldr f g (bifoldr f g z docA) docB + bifoldr f g z (DocParagraph doc) = bifoldr f g z doc + bifoldr _ g z (DocIdentifier i) = g i z + bifoldr f _ z (DocIdentifierUnchecked m) = f m z + bifoldr f g z (DocWarning doc) = bifoldr f g z doc + bifoldr f g z (DocEmphasis doc) = bifoldr f g z doc + bifoldr f g z (DocMonospaced doc) = bifoldr f g z doc + bifoldr f g z (DocBold doc) = bifoldr f g z doc + bifoldr f g z (DocUnorderedList docs) = foldr (flip (bifoldr f g)) z docs + bifoldr f g z (DocOrderedList docs) = foldr (flip (bifoldr f g)) z docs + bifoldr f g z (DocDefList docs) = foldr (\(l, r) acc -> bifoldr f g (bifoldr f g acc l) r) z docs + bifoldr f g z (DocCodeBlock doc) = bifoldr f g z doc + bifoldr f g z (DocHeader (Header _ title)) = bifoldr f g z title + bifoldr _ _ z _ = z + +instance Bitraversable DocH where + bitraverse _ _ DocEmpty = pure DocEmpty + bitraverse f g (DocAppend docA docB) = DocAppend <$> bitraverse f g docA <*> bitraverse f g docB + bitraverse _ _ (DocString s) = pure (DocString s) + bitraverse f g (DocParagraph doc) = DocParagraph <$> bitraverse f g doc + bitraverse _ g (DocIdentifier i) = DocIdentifier <$> g i + bitraverse f _ (DocIdentifierUnchecked m) = DocIdentifierUnchecked <$> f m + bitraverse _ _ (DocModule s) = pure (DocModule s) + bitraverse f g (DocWarning doc) = DocWarning <$> bitraverse f g doc + bitraverse f g (DocEmphasis doc) = DocEmphasis <$> bitraverse f g doc + bitraverse f g (DocMonospaced doc) = DocMonospaced <$> bitraverse f g doc + bitraverse f g (DocBold doc) = DocBold <$> bitraverse f g doc + bitraverse f g (DocUnorderedList docs) = DocUnorderedList <$> traverse (bitraverse f g) docs + bitraverse f g (DocOrderedList docs) = DocOrderedList <$> traverse (bitraverse f g) docs + bitraverse f g (DocDefList docs) = DocDefList <$> traverse (bitraverse (bitraverse f g) (bitraverse f g)) docs + bitraverse f g (DocCodeBlock doc) = DocCodeBlock <$> bitraverse f g doc + bitraverse _ _ (DocHyperlink hyperlink) = pure (DocHyperlink hyperlink) + bitraverse _ _ (DocPic picture) = pure (DocPic picture) + bitraverse _ _ (DocMathInline s) = pure (DocMathInline s) + bitraverse _ _ (DocMathDisplay s) = pure (DocMathDisplay s) + bitraverse _ _ (DocAName s) = pure (DocAName s) + bitraverse _ _ (DocProperty s) = pure (DocProperty s) + bitraverse _ _ (DocExamples examples) = pure (DocExamples examples) + bitraverse f g (DocHeader (Header level title)) = (DocHeader . Header level) <$> bitraverse f g title +#endif + -- | 'DocMarkupH' is a set of instructions for marking up documentation. -- In fact, it's really just a mapping from 'Doc' to some other -- type [a], where [a] is usually the type of the output (HTML, say). -- cgit v1.2.3 From f7032e5e48c7a6635e1dca607a37a16c8893e94b Mon Sep 17 00:00:00 2001 From: alexbiehl Date: Wed, 16 Aug 2017 09:06:40 +0200 Subject: Refactoring: Make doc renaming monadic This allows us to later throw warnings if can't find an identifier --- haddock-api/src/Haddock/Interface/Create.hs | 127 ++++++++++++--------- haddock-api/src/Haddock/Interface/LexParseRn.hs | 81 ++++++------- haddock-library/src/Documentation/Haddock/Types.hs | 3 + 3 files changed, 116 insertions(+), 95 deletions(-) diff --git a/haddock-api/src/Haddock/Interface/Create.hs b/haddock-api/src/Haddock/Interface/Create.hs index 89f7f71b..87cdb01f 100644 --- a/haddock-api/src/Haddock/Interface/Create.hs +++ b/haddock-api/src/Haddock/Interface/Create.hs @@ -30,6 +30,7 @@ import Haddock.Backends.Hyperlinker.Types import Haddock.Backends.Hyperlinker.Ast as Hyperlinker import Haddock.Backends.Hyperlinker.Parser as Hyperlinker +import Data.Bitraversable import qualified Data.ByteString as BS import qualified Data.Map as M import Data.Map (Map) @@ -38,8 +39,6 @@ import Data.Maybe import Data.Monoid import Data.Ord import Control.Applicative -import Control.Arrow (second) -import Control.DeepSeq (force) import Control.Exception (evaluate) import Control.Monad import Data.Traversable @@ -109,7 +108,6 @@ createInterface tm flags modMap instIfaceMap = do exports | OptIgnoreExports `elem` opts = Nothing | otherwise = exports0 - warningMap = mkWarningMap dflags warnings gre exportedNames localBundledPatSyns :: Map Name [Name] localBundledPatSyns = @@ -134,8 +132,10 @@ createInterface tm flags modMap instIfaceMap = do -- Locations of all TH splices splices = [ l | L l (SpliceD _) <- hsmodDecls hsm ] - maps@(!docMap, !argMap, !subMap, !declMap, _) = - mkMaps dflags gre localInsts declsWithDocs + warningMap <- liftErrMsg (mkWarningMap dflags warnings gre exportedNames) + + maps@(!docMap, !argMap, !subMap, !declMap, _) <- + liftErrMsg (mkMaps dflags gre localInsts declsWithDocs) let allWarnings = M.unions (warningMap : map ifaceWarningMap (M.elems modMap)) @@ -161,7 +161,8 @@ createInterface tm flags modMap instIfaceMap = do let !aliases = mkAliasMap dflags $ tm_renamed_source tm - modWarn = moduleWarning dflags gre warnings + + modWarn <- liftErrMsg (moduleWarning dflags gre warnings) tokenizedSrc <- mkMaybeTokenizedSrc flags tm @@ -245,27 +246,29 @@ lookupModuleDyn dflags Nothing mdlName = -- Warnings ------------------------------------------------------------------------------- -mkWarningMap :: DynFlags -> Warnings -> GlobalRdrEnv -> [Name] -> WarningMap +mkWarningMap :: DynFlags -> Warnings -> GlobalRdrEnv -> [Name] -> ErrMsgM WarningMap mkWarningMap dflags warnings gre exps = case warnings of - NoWarnings -> M.empty - WarnAll _ -> M.empty + NoWarnings -> pure M.empty + WarnAll _ -> pure M.empty WarnSome ws -> - let ws' = [ (n, w) | (occ, w) <- ws, elt <- lookupGlobalRdrEnv gre occ + let ws' = [ (n, w) + | (occ, w) <- ws + , elt <- lookupGlobalRdrEnv gre occ , let n = gre_name elt, n `elem` exps ] - in M.fromList $ map (second $ parseWarning dflags gre) ws' + in M.fromList <$> traverse (bitraverse pure (parseWarning dflags gre)) ws' -moduleWarning :: DynFlags -> GlobalRdrEnv -> Warnings -> Maybe (Doc Name) -moduleWarning _ _ NoWarnings = Nothing -moduleWarning _ _ (WarnSome _) = Nothing -moduleWarning dflags gre (WarnAll w) = Just $ parseWarning dflags gre w +moduleWarning :: DynFlags -> GlobalRdrEnv -> Warnings -> ErrMsgM (Maybe (Doc Name)) +moduleWarning _ _ NoWarnings = pure Nothing +moduleWarning _ _ (WarnSome _) = pure Nothing +moduleWarning dflags gre (WarnAll w) = Just <$> parseWarning dflags gre w -parseWarning :: DynFlags -> GlobalRdrEnv -> WarningTxt -> Doc Name -parseWarning dflags gre w = force $ case w of +parseWarning :: DynFlags -> GlobalRdrEnv -> WarningTxt -> ErrMsgM (Doc Name) +parseWarning dflags gre w = case w of DeprecatedTxt _ msg -> format "Deprecated: " (concatFS $ map (sl_fs . unLoc) msg) WarningTxt _ msg -> format "Warning: " (concatFS $ map (sl_fs . unLoc) msg) where format x xs = DocWarning . DocParagraph . DocAppend (DocString x) - . processDocString dflags gre $ HsDocString xs + <$> processDocString dflags gre (HsDocString xs) ------------------------------------------------------------------------------- @@ -313,16 +316,15 @@ mkMaps :: DynFlags -> GlobalRdrEnv -> [Name] -> [(LHsDecl Name, [HsDocString])] - -> Maps -mkMaps dflags gre instances decls = - let - (a, b, c, d) = unzip4 $ map mappings decls - in ( f' (map (nubByName fst) a) - , f (filterMapping (not . M.null) b) - , f (filterMapping (not . null) c) - , f (filterMapping (not . null) d) - , instanceMap - ) + -> ErrMsgM Maps +mkMaps dflags gre instances decls = do + (a, b, c, d) <- unzip4 <$> traverse mappings decls + pure ( f' (map (nubByName fst) a) + , f (filterMapping (not . M.null) b) + , f (filterMapping (not . null) c) + , f (filterMapping (not . null) d) + , instanceMap + ) where f :: (Ord a, Monoid b) => [[(a, b)]] -> Map a b f = M.fromListWith (<>) . concat @@ -334,35 +336,42 @@ mkMaps dflags gre instances decls = filterMapping p = map (filter (p . snd)) mappings :: (LHsDecl Name, [HsDocString]) - -> ( [(Name, MDoc Name)] - , [(Name, Map Int (MDoc Name))] - , [(Name, [Name])] - , [(Name, [LHsDecl Name])] - ) - mappings (ldecl, docStrs) = + -> ErrMsgM ( [(Name, MDoc Name)] + , [(Name, Map Int (MDoc Name))] + , [(Name, [Name])] + , [(Name, [LHsDecl Name])] + ) + mappings (ldecl, docStrs) = do let L l decl = ldecl declDoc :: [HsDocString] -> Map Int HsDocString - -> (Maybe (MDoc Name), Map Int (MDoc Name)) - declDoc strs m = - let doc' = processDocStrings dflags gre strs - m' = M.map (processDocStringParas dflags gre) m - in (doc', m') - (doc, args) = declDoc docStrs (typeDocs decl) + -> ErrMsgM (Maybe (MDoc Name), Map Int (MDoc Name)) + declDoc strs m = do + doc' <- processDocStrings dflags gre strs + m' <- traverse (processDocStringParas dflags gre) m + pure (doc', m') + + (doc, args) <- declDoc docStrs (typeDocs decl) + + let subs :: [(Name, [HsDocString], Map Int HsDocString)] subs = subordinates instanceMap decl - (subDocs, subArgs) = unzip $ map (\(_, strs, m) -> declDoc strs m) subs + + (subDocs, subArgs) <- unzip <$> traverse (\(_, strs, m) -> declDoc strs m) subs + + let ns = names l decl subNs = [ n | (n, _, _) <- subs ] dm = [ (n, d) | (n, Just d) <- zip ns (repeat doc) ++ zip subNs subDocs ] am = [ (n, args) | n <- ns ] ++ zip subNs subArgs sm = [ (n, subNs) | n <- ns ] cm = [ (n, [ldecl]) | n <- ns ++ subNs ] - in seqList ns `seq` - seqList subNs `seq` - doc `seq` - seqList subDocs `seq` - seqList subArgs `seq` - (dm, am, sm, cm) + + seqList ns `seq` + seqList subNs `seq` + doc `seq` + seqList subDocs `seq` + seqList subArgs `seq` + pure (dm, am, sm, cm) instanceMap :: Map SrcSpan Name instanceMap = M.fromList [ (getSrcSpan n, n) | n <- instances ] @@ -602,16 +611,20 @@ mkExportItems -- do so. -- NB: Pass in identity module, so we can look it up in index correctly moduleExports thisMod m dflags warnings gre exportedNames decls modMap instIfaceMap maps fixMap splices - lookupExport (IEGroup lev docStr) = return $ - return . ExportGroup lev "" $ processDocString dflags gre docStr + lookupExport (IEGroup lev docStr) = liftErrMsg $ do + doc <- processDocString dflags gre docStr + return [ExportGroup lev "" doc] - lookupExport (IEDoc docStr) = return $ - return . ExportDoc $ processDocStringParas dflags gre docStr + lookupExport (IEDoc docStr) = liftErrMsg $ do + doc <- processDocStringParas dflags gre docStr + return [ExportDoc doc] lookupExport (IEDocNamed str) = liftErrMsg $ - findNamedDoc str [ unL d | d <- decls ] >>= return . \case - Nothing -> [] - Just doc -> return . ExportDoc $ processDocStringParas dflags gre doc + findNamedDoc str [ unL d | d <- decls ] >>= \case + Nothing -> return [] + Just docStr -> do + doc <- processDocStringParas dflags gre docStr + return [ExportDoc doc] declWith :: [(HsDecl Name, DocForDecl Name)] -> Name -> ErrMsgGhc [ ExportItem Name ] declWith pats t = do @@ -924,9 +937,11 @@ fullModuleContents dflags warnings gre (docMap, argMap, subMap, declMap, instMap mkExportItem :: LHsDecl Name -> ErrMsgGhc (Maybe (ExportItem Name)) mkExportItem (L _ (DocD (DocGroup lev docStr))) = do - return . Just . ExportGroup lev "" $ processDocString dflags gre docStr + doc <- liftErrMsg (processDocString dflags gre docStr) + return . Just . ExportGroup lev "" $ doc mkExportItem (L _ (DocD (DocCommentNamed _ docStr))) = do - return . Just . ExportDoc $ processDocStringParas dflags gre docStr + doc <- liftErrMsg (processDocStringParas dflags gre docStr) + return . Just . ExportDoc $ doc mkExportItem (L l (ValD d)) | name:_ <- collectHsBindBinders d, Just [L _ (ValD _)] <- M.lookup name declMap = -- Top-level binding without type signature. diff --git a/haddock-api/src/Haddock/Interface/LexParseRn.hs b/haddock-api/src/Haddock/Interface/LexParseRn.hs index 4f6b2c09..a38e7667 100644 --- a/haddock-api/src/Haddock/Interface/LexParseRn.hs +++ b/haddock-api/src/Haddock/Interface/LexParseRn.hs @@ -34,20 +34,21 @@ import RdrName import RnEnv (dataTcOccs) processDocStrings :: DynFlags -> GlobalRdrEnv -> [HsDocString] - -> Maybe (MDoc Name) -processDocStrings dflags gre strs = - case metaDocConcat $ map (processDocStringParas dflags gre) strs of + -> ErrMsgM (Maybe (MDoc Name)) +processDocStrings dflags gre strs = do + mdoc <- metaDocConcat <$> traverse (processDocStringParas dflags gre) strs + case mdoc of -- We check that we don't have any version info to render instead -- of just checking if there is no comment: there may not be a -- comment but we still want to pass through any meta data. - MetaDoc { _meta = Meta { _version = Nothing }, _doc = DocEmpty } -> Nothing - x -> Just x + MetaDoc { _meta = Meta { _version = Nothing }, _doc = DocEmpty } -> pure Nothing + x -> pure (Just x) -processDocStringParas :: DynFlags -> GlobalRdrEnv -> HsDocString -> MDoc Name +processDocStringParas :: DynFlags -> GlobalRdrEnv -> HsDocString -> ErrMsgM (MDoc Name) processDocStringParas dflags gre (HsDocString fs) = - overDoc (rename dflags gre) $ parseParas dflags (unpackFS fs) + overDocF (rename dflags gre) $ parseParas dflags (unpackFS fs) -processDocString :: DynFlags -> GlobalRdrEnv -> HsDocString -> Doc Name +processDocString :: DynFlags -> GlobalRdrEnv -> HsDocString -> ErrMsgM (Doc Name) processDocString dflags gre (HsDocString fs) = rename dflags gre $ parseString dflags (unpackFS fs) @@ -60,9 +61,11 @@ processModuleHeader dflags gre safety mayStr = do Just (L _ (HsDocString fs)) -> do let str = unpackFS fs (hmi, doc) = parseModuleHeader dflags str - !descr = rename dflags gre <$> hmi_description hmi - hmi' = hmi { hmi_description = descr } - doc' = overDoc (rename dflags gre) doc + !descr <- case hmi_description hmi of + Just hmi_descr -> Just <$> rename dflags gre hmi_descr + Nothing -> pure Nothing + let hmi' = hmi { hmi_description = descr } + doc' <- overDocF (rename dflags gre) doc return (hmi', Just doc') let flags :: [LangExt.Extension] @@ -82,12 +85,12 @@ processModuleHeader dflags gre safety mayStr = do -- fallbacks in case we can't locate the identifiers. -- -- See the comments in the source for implementation commentary. -rename :: DynFlags -> GlobalRdrEnv -> Doc RdrName -> Doc Name +rename :: DynFlags -> GlobalRdrEnv -> Doc RdrName -> ErrMsgM (Doc Name) rename dflags gre = rn where rn d = case d of - DocAppend a b -> DocAppend (rn a) (rn b) - DocParagraph doc -> DocParagraph (rn doc) + DocAppend a b -> DocAppend <$> rn a <*> rn b + DocParagraph doc -> DocParagraph <$> rn doc DocIdentifier x -> do -- Generate the choices for the possible kind of thing this -- is. @@ -100,7 +103,7 @@ rename dflags gre = rn -- We found no names in the env so we start guessing. [] -> case choices of - [] -> DocMonospaced (DocString (showPpr dflags x)) + [] -> pure (DocMonospaced (DocString (showPpr dflags x))) -- There was nothing in the environment so we need to -- pick some default from what's available to us. We -- diverge here from the old way where we would default @@ -109,37 +112,37 @@ rename dflags gre = rn -- type constructor names (such as in #253). So now we -- only get type constructor links if they are actually -- in scope. - a:_ -> outOfScope dflags a + a:_ -> pure (outOfScope dflags a) -- There is only one name in the environment that matches so -- use it. - [a] -> DocIdentifier a + [a] -> pure (DocIdentifier a) -- But when there are multiple names available, default to -- type constructors: somewhat awfully GHC returns the -- values in the list positionally. - a:b:_ | isTyConName a -> DocIdentifier a - | otherwise -> DocIdentifier b + a:b:_ | isTyConName a -> pure (DocIdentifier a) + | otherwise -> pure (DocIdentifier b) - DocWarning doc -> DocWarning (rn doc) - DocEmphasis doc -> DocEmphasis (rn doc) - DocBold doc -> DocBold (rn doc) - DocMonospaced doc -> DocMonospaced (rn doc) - DocUnorderedList docs -> DocUnorderedList (map rn docs) - DocOrderedList docs -> DocOrderedList (map rn docs) - DocDefList list -> DocDefList [ (rn a, rn b) | (a, b) <- list ] - DocCodeBlock doc -> DocCodeBlock (rn doc) - DocIdentifierUnchecked x -> DocIdentifierUnchecked x - DocModule str -> DocModule str - DocHyperlink l -> DocHyperlink l - DocPic str -> DocPic str - DocMathInline str -> DocMathInline str - DocMathDisplay str -> DocMathDisplay str - DocAName str -> DocAName str - DocProperty p -> DocProperty p - DocExamples e -> DocExamples e - DocEmpty -> DocEmpty - DocString str -> DocString str - DocHeader (Header l t) -> DocHeader $ Header l (rn t) + DocWarning doc -> DocWarning <$> rn doc + DocEmphasis doc -> DocEmphasis <$> rn doc + DocBold doc -> DocBold <$> rn doc + DocMonospaced doc -> DocMonospaced <$> rn doc + DocUnorderedList docs -> DocUnorderedList <$> traverse rn docs + DocOrderedList docs -> DocOrderedList <$> traverse rn docs + DocDefList list -> DocDefList <$> traverse (\(a, b) -> (,) <$> rn a <*> rn b) list + DocCodeBlock doc -> DocCodeBlock <$> rn doc + DocIdentifierUnchecked x -> pure (DocIdentifierUnchecked x) + DocModule str -> pure (DocModule str) + DocHyperlink l -> pure (DocHyperlink l) + DocPic str -> pure (DocPic str) + DocMathInline str -> pure (DocMathInline str) + DocMathDisplay str -> pure (DocMathDisplay str) + DocAName str -> pure (DocAName str) + DocProperty p -> pure (DocProperty p) + DocExamples e -> pure (DocExamples e) + DocEmpty -> pure (DocEmpty) + DocString str -> pure (DocString str) + DocHeader (Header l t) -> DocHeader . Header l <$> rn t -- | Wrap an identifier that's out of scope (i.e. wasn't found in -- 'GlobalReaderEnv' during 'rename') in an appropriate doc. Currently diff --git a/haddock-library/src/Documentation/Haddock/Types.hs b/haddock-library/src/Documentation/Haddock/Types.hs index 48b29075..1e76c631 100644 --- a/haddock-library/src/Documentation/Haddock/Types.hs +++ b/haddock-library/src/Documentation/Haddock/Types.hs @@ -56,6 +56,9 @@ instance Bitraversable MetaDoc where overDoc :: (DocH a b -> DocH c d) -> MetaDoc a b -> MetaDoc c d overDoc f d = d { _doc = f $ _doc d } +overDocF :: Functor f => (DocH a b -> f (DocH c d)) -> MetaDoc a b -> f (MetaDoc c d) +overDocF f d = (\x -> d { _doc = x }) <$> f (_doc d) + type Version = [Int] data Hyperlink = Hyperlink -- cgit v1.2.3 From 740458ac4d2acf197f2ef8dc94a66f9b160b9c3c Mon Sep 17 00:00:00 2001 From: Alexander Biehl Date: Sat, 19 Aug 2017 20:35:27 +0200 Subject: Hyperlinker: Avoid linear lookup in enrichToken (#669) * Make Span strict in Position * Hyperlinker: Use a proper map to enrich tokens --- .../src/Haddock/Backends/Hyperlinker/Ast.hs | 80 ++++++++++++---------- .../src/Haddock/Backends/Hyperlinker/Types.hs | 14 ++-- 2 files changed, 53 insertions(+), 41 deletions(-) diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs b/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs index 78beacf2..9d273417 100644 --- a/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs +++ b/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE BangPatterns #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE RecordWildCards #-} @@ -13,9 +14,13 @@ import Haddock.Backends.Hyperlinker.Types import qualified GHC import Control.Applicative +import Control.Monad (guard) import Data.Data +import qualified Data.Map.Strict as Map import Data.Maybe +import Prelude hiding (span) + everythingInRenamedSource :: (Alternative f, Data x) => (forall a. Data a => a -> f r) -> x -> f r everythingInRenamedSource f = Syb.everythingButType @GHC.Name (<|>) f @@ -28,25 +33,45 @@ enrich src = , rtkDetails = enrichToken token detailsMap } where - detailsMap = concatMap ($ src) - [ variables - , types - , decls - , binds - , imports - ] + detailsMap = + mkDetailsMap (concatMap ($ src) + [ variables + , types + , decls + , binds + , imports + ]) + +type LTokenDetails = [(GHC.SrcSpan, TokenDetails)] -- | A map containing association between source locations and "details" of -- this location. -- --- For the time being, it is just a list of pairs. However, looking up things --- in such structure has linear complexity. We cannot use any hashmap-like --- stuff because source locations are not ordered. In the future, this should --- be replaced with interval tree data structure. -type DetailsMap = [(GHC.SrcSpan, TokenDetails)] +type DetailsMap = Map.Map Position (Span, TokenDetails) + +mkDetailsMap :: [(GHC.SrcSpan, TokenDetails)] -> DetailsMap +mkDetailsMap xs = + Map.fromListWith select_details [ (start, (token_span, token_details)) + | (ghc_span, token_details) <- xs + , Just !token_span <- [ghcSrcSpanToSpan ghc_span] + , let start = spStart token_span + ] + where + -- favour token details which appear earlier in the list + select_details _new old = old lookupBySpan :: Span -> DetailsMap -> Maybe TokenDetails -lookupBySpan tspan = listToMaybe . map snd . filter (matches tspan . fst) +lookupBySpan span details = do + (_, (tok_span, tok_details)) <- Map.lookupLE (spStart span) details + guard (tok_span `containsSpan` span ) + return tok_details + +ghcSrcSpanToSpan :: GHC.SrcSpan -> Maybe Span +ghcSrcSpanToSpan (GHC.RealSrcSpan span) = + Just (Span { spStart = Position (GHC.srcSpanStartLine span) (GHC.srcSpanStartCol span) + , spEnd = Position (GHC.srcSpanEndLine span) (GHC.srcSpanEndCol span) + }) +ghcSrcSpanToSpan _ = Nothing enrichToken :: Token -> DetailsMap -> Maybe TokenDetails enrichToken (Token typ _ spn) dm @@ -54,7 +79,7 @@ enrichToken (Token typ _ spn) dm enrichToken _ _ = Nothing -- | Obtain details map for variables ("normally" used identifiers). -variables :: GHC.RenamedSource -> DetailsMap +variables :: GHC.RenamedSource -> LTokenDetails variables = everythingInRenamedSource (var `Syb.combine` rec) where @@ -70,7 +95,7 @@ variables = _ -> empty -- | Obtain details map for types. -types :: GHC.RenamedSource -> DetailsMap +types :: GHC.RenamedSource -> LTokenDetails types = everythingInRenamedSource ty where ty term = case cast term of @@ -84,7 +109,7 @@ types = everythingInRenamedSource ty -- ordinary assignment (in top-level declarations, let-expressions and where -- clauses). -binds :: GHC.RenamedSource -> DetailsMap +binds :: GHC.RenamedSource -> LTokenDetails binds = everythingInRenamedSource (fun `Syb.combine` pat `Syb.combine` tvar) where @@ -112,7 +137,7 @@ binds = everythingInRenamedSource _ -> empty -- | Obtain details map for top-level declarations. -decls :: GHC.RenamedSource -> DetailsMap +decls :: GHC.RenamedSource -> LTokenDetails decls (group, _, _, _) = concatMap ($ group) [ concat . map typ . concat . map GHC.group_tyclds . GHC.hs_tyclds , everythingInRenamedSource fun . GHC.hs_valds @@ -151,7 +176,7 @@ decls (group, _, _, _) = concatMap ($ group) -- -- This map also includes type and variable details for items in export and -- import lists. -imports :: GHC.RenamedSource -> DetailsMap +imports :: GHC.RenamedSource -> LTokenDetails imports src@(_, imps, _, _) = everythingInRenamedSource ie src ++ mapMaybe (imp . GHC.unLoc) imps where @@ -168,22 +193,3 @@ imports src@(_, imps, _, _) = let (GHC.L sspan name) = GHC.ideclName idecl in Just (sspan, RtkModule name) imp _ = Nothing - --- | Check whether token stream span matches GHC source span. --- --- Currently, it is implemented as checking whether "our" span is contained --- in GHC span. The reason for that is because GHC span are generally wider --- and may spread across couple tokens. For example, @(>>=)@ consists of three --- tokens: @(@, @>>=@, @)@, but GHC source span associated with @>>=@ variable --- contains @(@ and @)@. Similarly, qualified identifiers like @Foo.Bar.quux@ --- are tokenized as @Foo@, @.@, @Bar@, @.@, @quux@ but GHC source span --- associated with @quux@ contains all five elements. -matches :: Span -> GHC.SrcSpan -> Bool -matches tspan (GHC.RealSrcSpan aspan) - | saspan <= stspan && etspan <= easpan = True - where - stspan = (posRow . spStart $ tspan, posCol . spStart $ tspan) - etspan = (posRow . spEnd $ tspan, posCol . spEnd $ tspan) - saspan = (GHC.srcSpanStartLine aspan, GHC.srcSpanStartCol aspan) - easpan = (GHC.srcSpanEndLine aspan, GHC.srcSpanEndCol aspan) -matches _ _ = False diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker/Types.hs b/haddock-api/src/Haddock/Backends/Hyperlinker/Types.hs index b27ec4d8..d8ae89e4 100644 --- a/haddock-api/src/Haddock/Backends/Hyperlinker/Types.hs +++ b/haddock-api/src/Haddock/Backends/Hyperlinker/Types.hs @@ -10,7 +10,7 @@ import qualified Data.Map as Map data Token = Token { tkType :: TokenType , tkValue :: String - , tkSpan :: Span + , tkSpan :: {-# UNPACK #-} !Span } deriving (Show) @@ -18,14 +18,20 @@ data Position = Position { posRow :: !Int , posCol :: !Int } - deriving (Show) + deriving (Eq, Ord, Show) data Span = Span - { spStart :: Position - , spEnd :: Position + { spStart :: !Position + , spEnd :: !Position } deriving (Show) +-- | Tests whether the first span "contains" the other span, meaning +-- that it covers at least as much source code. True where spans are equal. +containsSpan :: Span -> Span -> Bool +containsSpan s1 s2 = + spStart s1 <= spStart s2 && spEnd s1 >= spEnd s2 + data TokenType = TkIdentifier | TkKeyword -- cgit v1.2.3