record-dot-preprocessor 0.2.16 → 0.2.17
raw patch · 6 files changed
+76/−16 lines, 6 filesdep ~ghc
Dependency ranges changed: ghc
Files
- CHANGES.txt +3/−0
- LICENSE +1/−1
- README.md +1/−1
- plugin/Compat.hs +36/−3
- plugin/RecordDotPreprocessor.hs +31/−7
- record-dot-preprocessor.cabal +4/−4
CHANGES.txt view
@@ -1,5 +1,8 @@ Changelog for record-dot-preprocessor +0.2.17, released 2024-01-13+ Support GHC 9.8+ #59, support GHC 9.6 0.2.16, released 2023-03-03 #57, support GHC 9.4 #54, skip polymorphic fields with forall
LICENSE view
@@ -1,4 +1,4 @@-Copyright Neil Mitchell 2018-2023.+Copyright Neil Mitchell 2018-2024. Licensed under either of:
README.md view
@@ -1,4 +1,4 @@-# record-dot-preprocessor [](https://hackage.haskell.org/package/record-dot-preprocessor) [](https://www.stackage.org/package/record-dot-preprocessor) [](https://github.com/ndmitchell/record-dot-preprocessor/actions)+# record-dot-preprocessor [](https://hackage.haskell.org/package/record-dot-preprocessor) [](https://www.stackage.org/package/record-dot-preprocessor) [](https://github.com/ndmitchell/record-dot-preprocessor/actions) In almost every programming language `a.b` will get the `b` field from the `a` data type, and many different data types can have a `b` field. The reason this feature is ubiquitous is because it's _useful_. The `record-dot-preprocessor` brings this feature to modern GHC versions. This feature has been [proposed for Haskell](https://github.com/ghc-proposals/ghc-proposals/pull/282) as `RecordDotSyntax`. Since GHC 9.2 the [`OverloadedRecordDot`](https://downloads.haskell.org/~ghc/9.2.3/docs/html/users_guide/exts/overloaded_record_dot.html#extension-OverloadedRecordDot) and [`OverloadedRecordUpdate`](https://downloads.haskell.org/~ghc/9.2.3/docs/html/users_guide/exts/overloaded_record_update.html) extensions implement much the same functionality. Some examples:
plugin/Compat.hs view
@@ -28,7 +28,9 @@ import UniqSupply #else import GHC.Types.Basic+#if __GLASGOW_HASKELL__ < 906 import GHC.Unit.Types+#endif #if __GLASGOW_HASKELL__ < 902 import GHC.Parser.Annotation #endif@@ -107,6 +109,17 @@ noE = NoExt #endif +#if __GLASGOW_HASKELL__ >= 906+instance WithoutExt XImportDeclPass where+ noE = XImportDeclPass noE NoSourceText True {- implicit -}++instance WithoutExt GHC.Types.Basic.Origin where+ noE = Generated+#if __GLASGOW_HASKELL__ >= 908+ SkipPmc+#endif+#endif+ --------------------------------------------------------------------- -- UTILITIES @@ -143,6 +156,8 @@ #if __GLASGOW_HASKELL__ < 811 type Module = HsModule GhcPs+#elif __GLASGOW_HASKELL__ >= 906+type Module = HsModule GhcPs #else type Module = HsModule #endif@@ -164,9 +179,15 @@ mkAppType expr typ = noL $ HsAppType noE expr (HsWC noE typ) mkTypeAnn expr typ = noL $ ExprWithTySig noE expr (HsWC noE (HsIB noE typ)) +#elif __GLASGOW_HASKELL__ >= 906++-- GHC 9.6++mkAppType expr typ = noL $ HsAppType noE expr noHsTok (HsWC noE typ)+mkTypeAnn expr typ = noL $ ExprWithTySig noE expr (hsTypeToHsSigWcType typ)+ #else --- GHC 9.2++-- GHC 9.2-9.4 mkAppType expr typ = noL $ HsAppType noSrcSpan expr (HsWC noE typ) mkTypeAnn expr typ = noL $ ExprWithTySig noE expr (hsTypeToHsSigWcType typ) @@ -184,9 +205,15 @@ mkFunTy a b = noL $ HsFunTy noE (HsUnrestrictedArrow NormalSyntax) a b newFunBind a b = FunBind noE (reLocA a) b [] +#elif __GLASGOW_HASKELL__ >= 906++-- GHC 9.6++mkFunTy a b = noL $ HsFunTy noE (HsUnrestrictedArrow $ L NoTokenLoc HsNormalTok) a b+newFunBind a = FunBind noE (reLocA a)+ #else --- GHC >= 9.4+-- GHC 9.4 mkFunTy a b = noL $ HsFunTy noE (HsUnrestrictedArrow $ L NoTokenLoc HsNormalTok) a b newFunBind a b = FunBind noE (reLocA a) b [] @@ -234,9 +261,15 @@ qualifiedImplicitImport x = noL $ ImportDecl noE NoSourceText (noL x) Nothing NotBoot False QualifiedPost {- qualified -} True {- implicit -} Nothing Nothing +#elif __GLASGOW_HASKELL__ >= 906++-- GHC 9.6++qualifiedImplicitImport x = noL $ ImportDecl noE (noL x) NoRawPkgQual NotBoot False+ QualifiedPost {- qualified -} Nothing Nothing+ #else --- GHC >= 9.4+-- GHC 9.4 qualifiedImplicitImport x = noL $ ImportDecl noE NoSourceText (noL x) NoRawPkgQual NotBoot False QualifiedPost {- qualified -} True {- implicit -} Nothing Nothing
plugin/RecordDotPreprocessor.hs view
@@ -31,6 +31,9 @@ import qualified GHC.Plugins as GHC import GHC.Types.SrcLoc #endif+#if __GLASGOW_HASKELL__ >= 906+import qualified Data.List.NonEmpty as NE+#endif --------------------------------------------------------------------- -- PLUGIN WRAPPER@@ -45,7 +48,7 @@ #if __GLASGOW_HASKELL__ >= 904 ignoreMessages :: (HsParsedModule -> GHC.Hsc HsParsedModule) -> GHC.ParsedResult -> GHC.Hsc GHC.ParsedResult ignoreMessages f (GHC.ParsedResult modl msgs) =- (\modl' -> GHC.ParsedResult modl' msgs) <$> f modl+ (`GHC.ParsedResult` msgs) <$> f modl #else ignoreMessages = id #endif@@ -143,7 +146,9 @@ } update :: HsExpr GhcPs update = RecordUpd noE (noL $ GHC.HsVar noE $ noL vR)-#if __GLASGOW_HASKELL__ >= 902+#if __GLASGOW_HASKELL__ >= 908+ $ RegularRecUpdFields noE+#elif __GLASGOW_HASKELL__ >= 902 $ Left #endif #if __GLASGOW_HASKELL__ >= 904@@ -158,11 +163,11 @@ #if __GLASGOW_HASKELL__ >= 904 get :: LHsExpr GhcPs get =- (noL $ GHC.HsVar noE $ noL $ var_base_getField)+ noL (GHC.HsVar noE $ noL var_base_getField) `mkAppType` fieldNameAsType `mkApp`- (noL $ GHC.HsVar noE $ noL $ vR)+ noL (GHC.HsVar noE $ noL vR) #else get = mkApp (mkParen $ mkTypeAnn (noL $ GHC.HsVar noE $ rdrNameFieldOcc selector) (mkFunTy (noL record) (noL field)))@@ -170,7 +175,11 @@ #endif mg1 :: Match GhcPs (LHsExpr GhcPs) -> MatchGroup GhcPs (LHsExpr GhcPs)+#if __GLASGOW_HASKELL__ >= 906+ mg1 x = MG noE (noL [noL x])+#else mg1 x = MG noE (noL [noL x]) GHC.Generated+#endif vR = GHC.mkRdrUnqual $ GHC.mkVarOcc "r" vX = GHC.mkRdrUnqual $ GHC.mkVarOcc "x"@@ -225,7 +234,11 @@ null (freeTyVars ty \\ freeTyVars con_res_ty), not $ isLHsForAllTy ty, name <- cd_fld_names,+#if __GLASGOW_HASKELL__ >= 906+ con_name <- NE.toList con_names+#else con_name <- con_names+#endif ] _ -> [] where@@ -259,7 +272,9 @@ $ map ( \ sel -> reLoc $ mkVar var_getField `mkAppType` sel) $ reverse sels -- Turn a{b=c, ...} into setField calls-#if __GLASGOW_HASKELL__ >= 902+#if __GLASGOW_HASKELL__ >= 908+onExp (L o upd@RecordUpd{rupd_expr,rupd_flds= RegularRecUpdFields _ (fld:flds)})+#elif __GLASGOW_HASKELL__ >= 902 onExp (L o upd@RecordUpd{rupd_expr,rupd_flds= Left (fld:flds)}) #else onExp (L o upd@RecordUpd{rupd_expr,rupd_flds= fld:flds})@@ -267,10 +282,19 @@ | adjacentBy 1 rupd_expr fld = onExp $ f rupd_expr $ map unLoc $ fld:flds where+#if __GLASGOW_HASKELL__ >= 908+ f :: LHsExpr GhcPs -> [HsRecUpdField GhcPs GhcPs] -> LHsExpr GhcPs+#else f :: LHsExpr GhcPs -> [HsRecUpdField GhcPs] -> LHsExpr GhcPs+#endif f expr [] = expr-#if __GLASGOW_HASKELL__ >= 904- f expr (HsFieldBind { hfbLHS = (fmap rdrNameAmbiguousFieldOcc . reLoc) -> lbl+#if __GLASGOW_HASKELL__ >= 908+ f expr (HsFieldBind { hfbLHS = fmap ambiguousFieldOccRdrName . reLoc -> lbl+ , hfbRHS = arg+ , hfbPun = pun+ } : flds)+#elif __GLASGOW_HASKELL__ >= 904+ f expr (HsFieldBind { hfbLHS = fmap rdrNameAmbiguousFieldOcc . reLoc -> lbl , hfbRHS = arg , hfbPun = pun } : flds)
record-dot-preprocessor.cabal view
@@ -1,14 +1,14 @@ cabal-version: 1.18 build-type: Simple name: record-dot-preprocessor-version: 0.2.16+version: 0.2.17 license: BSD3 x-license: BSD-3-Clause OR Apache-2.0 license-file: LICENSE category: Development author: Neil Mitchell <ndmitchell@gmail.com> maintainer: Neil Mitchell <ndmitchell@gmail.com>-copyright: Neil Mitchell 2018-2023+copyright: Neil Mitchell 2018-2024 synopsis: Preprocessor to allow record.field syntax description: In almost every programming language @a.b@ will get the @b@ field from the @a@ data type, and many different data types can have a @b@ field.@@ -19,7 +19,7 @@ extra-doc-files: README.md CHANGES.txt-tested-with: GHC==9.2, GHC==9.0, GHC==8.10, GHC==8.8, GHC==8.6+tested-with: GHC==9.8, GHC==9.6, GHC==9.4, GHC==9.2, GHC==9.0, GHC==8.10, GHC==8.8 extra-source-files: examples/Both.hs examples/Both2.hs@@ -39,7 +39,7 @@ build-depends: base >= 4.8 && < 5, uniplate,- ghc >=8.6 && <9.5,+ ghc >=8.6 && <9.9, extra exposed-modules: RecordDotPreprocessor