From a063800e79b5b56032c8525c76108aaab22bdd35 Mon Sep 17 00:00:00 2001 From: Bodigrim Date: Fri, 2 Jan 2026 20:16:17 +0000 Subject: [PATCH 1/3] Support ghc-lib-parser-9.14 --- hoogle.cabal | 4 +-- src/Input/Haddock.hs | 4 ++- src/Input/ParseDecl.hs | 58 ++++++++++++++++++++++++++++++------------ 3 files changed, 47 insertions(+), 19 deletions(-) diff --git a/hoogle.cabal b/hoogle.cabal index 1f97e25a..c2a5b0e7 100644 --- a/hoogle.cabal +++ b/hoogle.cabal @@ -46,7 +46,7 @@ library build-depends: QuickCheck, - aeson, + aeson >= 2, ansi-terminal, base >= 4 && < 5, blaze-html, @@ -64,7 +64,7 @@ library directory, extra >= 1.6.6, filepath, - ghc-lib-parser >= 9.6.5, + ghc-lib-parser >= 9.6.5 && < 9.16, hackage-revdeps >= 0.3 && < 0.4, old-locale, hashable, diff --git a/src/Input/Haddock.hs b/src/Input/Haddock.hs index e0b566cf..a6d1b466 100644 --- a/src/Input/Haddock.hs +++ b/src/Input/Haddock.hs @@ -166,6 +166,7 @@ readItem x@(x0 : _) -- constructors | isUpper x0 || x0 == '(' , ParseOk (GDataDecl _ _ _ _ _ [GadtDecl s name _ _ _ ty] _) <- myParseDecl $ "data Data where " ++ x , let f (TyBang _ _ _ (TyParen _ x@TyApp{})) = x + f (TyParen _ x@TyApp{}) = x f (TyBang _ _ _ x) = x f x = x = Just $ TypeSig s [name] $ applyFun1 $ map f $ unapplyFun ty @@ -253,7 +254,8 @@ input_haddock_test = testing "Input.Haddock.parseLine" $ do test "pattern The :: The d a => a -> d" test "Html :: Element \"html\" '[] (Elements [\"head\", \"body\"]) (ManifestA & '[])" test "instance forall k1 v1 (pk :: k1 -> GHC.Types.Constraint) (k2 :: k1) (pv :: v1 -> GHC.Types.Constraint) (v2 :: v1) . (pk k2, pv v2) => Type.Membership.KeyTargetAre pk pv (k2 'Type.Membership.Internal.:> v2)" - test "crDoubleBuffer :: CompactorReturn s -> {-# UNPACK #-} !DoubleBuffer s" + -- The following no longer parses since GHC 9.14 (which is the correct behaviour) + -- test "crDoubleBuffer :: CompactorReturn s -> {-# UNPACK #-} !DoubleBuffer s" test "expectationFailure :: (?callStack :: CallStack) => String -> Expectation" test "type family MapTyCon t xs = r | r -> xs" test "pattern Id :: CRCategory k => (β ~ α, Object k α) => k α β" diff --git a/src/Input/ParseDecl.hs b/src/Input/ParseDecl.hs index ed7fce68..97ed634d 100644 --- a/src/Input/ParseDecl.hs +++ b/src/Input/ParseDecl.hs @@ -51,6 +51,10 @@ pattern MyPrefixConGADT x <- PrefixConGADT x pattern MyRecConGADT x <- RecConGADT x _ #endif +#if !MIN_VERSION_ghc_lib_parser(9,14,0) +#define con_outer_bndrs con_bndrs +#endif + myParseDecl :: String -> HSE.ParseResult (HSE.Decl ()) myParseDecl str = case runGhcLibParser str of POk _state x -> case hsDeclToDecl (unLoc x) of @@ -96,7 +100,7 @@ hsDeclToDecl (TyClD _ (GHC.Hs.DataDecl{tcdLName, tcdTyVars = HsQTvs{hsq_explicit (Just $ hsTypeToType $ unLoc kind) [] [] -hsDeclToDecl (TyClD _ (GHC.Hs.DataDecl{tcdLName, tcdTyVars = HsQTvs{hsq_explicit}, tcdDataDefn = HsDataDefn{dd_cons = DataTypeCons _ [L _ (ConDeclGADT{con_names, con_bndrs, con_g_args = MyPrefixConGADT args, con_res_ty, con_mb_cxt})]}})) = +hsDeclToDecl (TyClD _ (GHC.Hs.DataDecl{tcdLName, tcdTyVars = HsQTvs{hsq_explicit}, tcdDataDefn = HsDataDefn{dd_cons = DataTypeCons _ [L _ (ConDeclGADT{con_names, con_outer_bndrs, con_g_args = MyPrefixConGADT args, con_res_ty, con_mb_cxt})]}})) = Just $ HSE.GDataDecl () @@ -116,10 +120,14 @@ hsDeclToDecl (TyClD _ (GHC.Hs.DataDecl{tcdLName, tcdTyVars = HsQTvs{hsq_explicit Nothing Nothing Nothing - ( maybe id (\bs -> applyTyForall (Just bs) Nothing) (hsOuterTyVarBndrsToFoo $ unLoc con_bndrs) $ + ( maybe id (\bs -> applyTyForall (Just bs) Nothing) (hsOuterTyVarBndrsToFoo $ unLoc con_outer_bndrs) $ maybe id (applyTyForall Nothing . Just . hsTypesToContext . unLoc) con_mb_cxt $ foldr +#if MIN_VERSION_ghc_lib_parser(9,14,0) + (\CDF{cdf_type} -> HSE.TyFun () (hsTypeToType $ unLoc cdf_type)) +#else (\(HsScaled _ a) -> HSE.TyFun () (hsTypeToType $ unLoc a)) +#endif (hsTypeToType $ unLoc con_res_ty) args ) @@ -127,7 +135,7 @@ hsDeclToDecl (TyClD _ (GHC.Hs.DataDecl{tcdLName, tcdTyVars = HsQTvs{hsq_explicit (NE.toList con_names) ) [] -hsDeclToDecl (TyClD _ (GHC.Hs.DataDecl{tcdLName, tcdTyVars = HsQTvs{hsq_explicit}, tcdDataDefn = HsDataDefn{dd_cons = DataTypeCons _ [L _ (ConDeclGADT{con_names, con_bndrs, con_g_args = MyRecConGADT (L _ args), con_res_ty, con_mb_cxt})]}})) = +hsDeclToDecl (TyClD _ (GHC.Hs.DataDecl{tcdLName, tcdTyVars = HsQTvs{hsq_explicit}, tcdDataDefn = HsDataDefn{dd_cons = DataTypeCons _ [L _ (ConDeclGADT{con_names, con_outer_bndrs, con_g_args = MyRecConGADT (L _ args), con_res_ty, con_mb_cxt})]}})) = Just $ HSE.GDataDecl () @@ -148,7 +156,7 @@ hsDeclToDecl (TyClD _ (GHC.Hs.DataDecl{tcdLName, tcdTyVars = HsQTvs{hsq_explicit Nothing (Just $ map (conDeclFieldToFieldDecl . unLoc) args) ( maybe id (HSE.TyForall () Nothing . Just . hsTypesToContext . unLoc) con_mb_cxt $ - maybe id (\bs -> HSE.TyForall () (Just bs) Nothing) (hsOuterTyVarBndrsToFoo $ unLoc con_bndrs) $ + maybe id (\bs -> HSE.TyForall () (Just bs) Nothing) (hsOuterTyVarBndrsToFoo $ unLoc con_outer_bndrs) $ hsTypeToType $ unLoc con_res_ty ) @@ -253,6 +261,15 @@ injectivityAnnToInjectivityInfo = \case InjectivityAnn _ lhs rhs -> HSE.InjectivityInfo () (rdrNameToName $ unLoc lhs) (map (rdrNameToName . unLoc) rhs) +#if MIN_VERSION_ghc_lib_parser(9,14,0) +conDeclFieldToFieldDecl :: HsConDeclRecField GhcPs -> HSE.FieldDecl () +conDeclFieldToFieldDecl = \case + HsConDeclRecField{cdrf_names, cdrf_spec = CDF{cdf_type}} -> + HSE.FieldDecl + () + (map (fieldOccToName . unLoc) cdrf_names) + (hsTypeToType $ unLoc cdf_type) +#else conDeclFieldToFieldDecl :: ConDeclField GhcPs -> HSE.FieldDecl () conDeclFieldToFieldDecl = \case ConDeclField{cd_fld_names, cd_fld_type} -> @@ -260,6 +277,7 @@ conDeclFieldToFieldDecl = \case () (map (fieldOccToName . unLoc) cd_fld_names) (hsTypeToType $ unLoc cd_fld_type) +#endif fieldOccToName :: FieldOcc GhcPs -> HSE.Name () fieldOccToName = \case @@ -374,11 +392,13 @@ hsTypeToType = \case HSE.TyTuple () (hsTupleSortToBoxed boxed) (map (hsTypeToType . unLoc) xs) HsStarTy _ _ -> HSE.TyStar () +#if !MIN_VERSION_ghc_lib_parser(9,14,0) HsBangTy _ (HsBang unpackedness strictness) x -> applyTyBang (srcStrictnessToBangType strictness) (srcUnpackednessToUnpackedness unpackedness) (hsTypeToType $ unLoc x) +#endif HsParTy _ x -> case hsTypeToType (unLoc x) of x'@HSE.TyKind{} -> x' x' -> HSE.TyParen () x' @@ -461,6 +481,7 @@ applyTyForall mArg1 mArg2 = \case | isNothing mArg2 -> HSE.TyForall () mArg1 mArg2' ty ty -> HSE.TyForall () mArg1 mArg2 ty +#if !MIN_VERSION_ghc_lib_parser(9,14,0) applyTyBang :: HSE.BangType () -> HSE.Unpackedness () -> HSE.Type () -> HSE.Type () applyTyBang bang unpack = \case @@ -471,6 +492,19 @@ applyTyBang bang unpack = \case HSE.TyApp () x y -> HSE.TyApp () (applyTyBang bang unpack x) y ty -> HSE.TyBang () bang unpack ty +srcStrictnessToBangType :: SrcStrictness -> HSE.BangType () +srcStrictnessToBangType = \case + SrcLazy -> HSE.LazyTy () + SrcStrict -> HSE.BangedTy () + NoSrcStrict -> HSE.NoStrictAnnot () + +srcUnpackednessToUnpackedness :: SrcUnpackedness -> HSE.Unpackedness () +srcUnpackednessToUnpackedness = \case + SrcUnpack -> HSE.Unpack () + SrcNoUnpack -> HSE.NoUnpack () + NoSrcUnpack -> HSE.NoUnpackPragma () +#endif + typeToInstHead :: HSE.Type () -> HSE.InstHead () typeToInstHead = \case HSE.TyApp () x y -> HSE.IHApp () (typeToInstHead x) y @@ -506,18 +540,6 @@ hsTupleSortToBoxed = \case HsUnboxedTuple -> HSE.Unboxed HsBoxedOrConstraintTuple -> HSE.Boxed -srcStrictnessToBangType :: SrcStrictness -> HSE.BangType () -srcStrictnessToBangType = \case - SrcLazy -> HSE.LazyTy () - SrcStrict -> HSE.BangedTy () - NoSrcStrict -> HSE.NoStrictAnnot () - -srcUnpackednessToUnpackedness :: SrcUnpackedness -> HSE.Unpackedness () -srcUnpackednessToUnpackedness = \case - SrcUnpack -> HSE.Unpack () - SrcNoUnpack -> HSE.NoUnpack () - NoSrcUnpack -> HSE.NoUnpackPragma () - runGhcLibParser :: String -> GHC.Parser.Lexer.ParseResult (GenLocated SrcSpanAnnA (HsDecl GhcPs)) @@ -566,7 +588,11 @@ runGhcLibParserWithExtensions :: GHC.Parser.Lexer.ParseResult (GenLocated SrcSpanAnnA (HsDecl GhcPs)) runGhcLibParserWithExtensions extensions str = unP parseDeclaration parseState where +#if MIN_VERSION_ghc_lib_parser(9,14,0) + opts = mkParserOpts extensions emptyDiagOpts False False False False +#else opts = mkParserOpts extensions emptyDiagOpts [] False False False False +#endif dummyLocation = mkRealSrcLoc mempty 1 1 buffer = stringToStringBuffer str parseState = initParserState opts buffer dummyLocation From 800b0a98406283e24c7468dc4a63677364f3e9e3 Mon Sep 17 00:00:00 2001 From: Bodigrim Date: Fri, 2 Jan 2026 20:26:04 +0000 Subject: [PATCH 2/3] Bump year to 2026 --- LICENSE | 2 +- hoogle.cabal | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/LICENSE b/LICENSE index e229a702..9399c885 100644 --- a/LICENSE +++ b/LICENSE @@ -1,4 +1,4 @@ -Copyright Neil Mitchell 2004-2025. +Copyright Neil Mitchell 2004-2026. All rights reserved. Redistribution and use in source and binary forms, with or without diff --git a/hoogle.cabal b/hoogle.cabal index c2a5b0e7..9890961c 100644 --- a/hoogle.cabal +++ b/hoogle.cabal @@ -7,7 +7,7 @@ license-file: LICENSE category: Development author: Neil Mitchell maintainer: Neil Mitchell -copyright: Neil Mitchell 2004-2025 +copyright: Neil Mitchell 2004-2026 synopsis: Haskell API Search description: Hoogle is a Haskell API search engine, which allows you to From 2a194ae140dd22472aefe90e673bb6d0b4de2c94 Mon Sep 17 00:00:00 2001 From: Bodigrim Date: Fri, 2 Jan 2026 20:37:07 +0000 Subject: [PATCH 3/3] Pin Windows and macOS CI to GHC 9.12 --- .github/workflows/ci.yml | 2 ++ 1 file changed, 2 insertions(+) diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml index 815233c1..6b78edaf 100644 --- a/.github/workflows/ci.yml +++ b/.github/workflows/ci.yml @@ -15,7 +15,9 @@ jobs: ghc: ['9.8', '9.6', '9.4'] include: - os: windows-latest + ghc: 9.12 - os: macOS-latest + ghc: 9.12 steps: - run: git config --global core.autocrlf false