From eb7ff6d5ea8625cb45b0f03b35fe41f5ea21a606 Mon Sep 17 00:00:00 2001 From: Isaac Elliott Date: Thu, 8 Aug 2024 10:48:31 +1000 Subject: [PATCH 1/5] Remove annotation after processing large record It's possible for the compiler plugin to fire multiple times, with each successive run using the AST from the previous run. When this happens, the first run succeeds but later runs fail. The datatype definition generated by `transformDecl` still has the `largeRecord` annotation, but is no longer in a form that's accepted by the compiler plugin. Removing the annotations for which `transformDecl` succeeds makes the compiler plugin idempotent. --- large-records/src/Data/Record/Plugin.hs | 13 ++++++++++++- 1 file changed, 12 insertions(+), 1 deletion(-) diff --git a/large-records/src/Data/Record/Plugin.hs b/large-records/src/Data/Record/Plugin.hs index 1976f97f..2174ad93 100644 --- a/large-records/src/Data/Record/Plugin.hs +++ b/large-records/src/Data/Record/Plugin.hs @@ -135,7 +135,18 @@ transformDecl :: -> WriterT (Set String) Hsc [LHsDecl GhcPs] transformDecl largeRecords decl@(reLoc -> L l _) = case decl of - DataD (nameBase -> name) _ _ _ -> + (unLoc -> AnnD _ (PragAnnD (TypeAnnotation (nameBase -> name)) _)) -> + case Map.findWithDefault [] name largeRecords of + [_] -> + {- A valid `large-records` annotation. + + Remove it so that subsequent passes of the plugin will ignore the generated + `large-records` code. + -} + pure [] + _ -> + pure [decl] + DataD (nameBase -> name) _ _ _ -> do case Map.findWithDefault [] name largeRecords of [] -> -- Not a large record. Leave alone. From 3c5d497edec1f6f0f439f610bd07fbd14c0b2826 Mon Sep 17 00:00:00 2001 From: Isaac Elliott Date: Thu, 8 Aug 2024 14:52:29 +1000 Subject: [PATCH 2/5] Widen version bounds for primitive --- large-generics/large-generics.cabal | 2 +- large-records/large-records.cabal | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/large-generics/large-generics.cabal b/large-generics/large-generics.cabal index 52a0d9a9..88d3876a 100644 --- a/large-generics/large-generics.cabal +++ b/large-generics/large-generics.cabal @@ -47,7 +47,7 @@ library , deepseq >= 1.4.4 && < 1.6 , generics-sop >= 0.5 && < 0.6 , sop-core >= 0.5 && < 0.6 - , primitive >= 0.8 && < 0.10 + , primitive >= 0.7.3 && < 0.10 if impl(ghc >= 8.10) ghc-options: -Wunused-packages diff --git a/large-records/large-records.cabal b/large-records/large-records.cabal index 88b16cdd..ee7c95e3 100644 --- a/large-records/large-records.cabal +++ b/large-records/large-records.cabal @@ -48,7 +48,7 @@ library , containers >= 0.6.2 && < 0.8 , ghc >= 8.10 && < 9.7 , mtl >= 2.2.1 && < 2.4 - , primitive >= 0.8 && < 0.10 + , primitive >= 0.7.3 && < 0.10 , record-hasfield >= 1.0 && < 1.1 , syb >= 0.7 && < 0.8 , template-haskell >= 2.16 && < 2.21 From fb24492a51d8a52f933e7014f06e41d0b2592094 Mon Sep 17 00:00:00 2001 From: Edsko de Vries Date: Tue, 15 Oct 2024 13:24:09 +0200 Subject: [PATCH 3/5] Prepare for release --- .github/workflows/haskell-ci.yml | 30 +++++++++---------- beam-large-records/beam-large-records.cabal | 2 +- .../test/Test/Record/Beam/Andres.hs | 1 - .../test/Test/Record/Beam/SimpleSQL.hs | 1 - .../test/Test/Record/Beam/Tutorial1.hs | 1 - .../test/Test/Record/Beam/Tutorial2.hs | 1 - .../test/Test/Record/Beam/Tutorial3.hs | 1 - .../test/Test/Record/Beam/Zipping.hs | 1 - large-anon/large-anon.cabal | 2 +- large-generics/large-generics.cabal | 2 +- .../bench/after/After/Sized/R010.hs | 1 - .../bench/after/After/Sized/R020.hs | 1 - .../bench/after/After/Sized/R030.hs | 1 - .../bench/after/After/Sized/R040.hs | 1 - .../bench/after/After/Sized/R050.hs | 1 - .../bench/after/After/Sized/R060.hs | 1 - .../bench/after/After/Sized/R070.hs | 1 - .../bench/after/After/Sized/R080.hs | 1 - .../bench/after/After/Sized/R090.hs | 1 - .../bench/after/After/Sized/R100.hs | 1 - .../bench/after/HigherKinded/Sized/R010.hs | 2 -- .../bench/after/HigherKinded/Sized/R020.hs | 2 -- .../bench/after/HigherKinded/Sized/R030.hs | 2 -- .../bench/after/HigherKinded/Sized/R040.hs | 2 -- .../bench/after/HigherKinded/Sized/R050.hs | 2 -- .../bench/after/HigherKinded/Sized/R060.hs | 2 -- .../bench/after/HigherKinded/Sized/R070.hs | 2 -- .../bench/after/HigherKinded/Sized/R080.hs | 2 -- .../bench/after/HigherKinded/Sized/R090.hs | 2 -- .../bench/after/HigherKinded/Sized/R100.hs | 2 -- large-records/CHANGELOG.md | 9 ++++++ large-records/large-records.cabal | 4 +-- large-records/src/Data/Record/Plugin.hs | 2 -- .../test/Test/Record/Sanity/CodeGen.hs | 1 - .../test/Test/Record/Sanity/Derive.hs | 2 -- .../Test/Record/Sanity/EqualFieldTypes.hs | 2 -- .../test/Test/Record/Sanity/GhcGenerics.hs | 2 -- large-records/test/Test/Record/Sanity/HKD.hs | 2 -- .../test/Test/Record/Sanity/HigherKinded.hs | 2 -- .../test/Test/Record/Sanity/NamedWildCards.hs | 2 -- .../test/Test/Record/Sanity/Operators.hs | 2 -- .../Record/Sanity/OverloadedRecordUpdate.hs | 1 - .../Test/Record/Sanity/OverloadingNoDRF.hs | 2 -- .../test/Test/Record/Sanity/PatternMatch.hs | 2 -- .../Test/Record/Sanity/QualifiedImports/A.hs | 2 -- .../Test/Record/Sanity/QualifiedImports/B.hs | 2 -- .../Test/Record/Sanity/RDP/SingleModule.hs | 2 -- .../Sanity/RDP/SplitModule/RecordDef.hs | 2 -- .../Test/Record/Sanity/RecordConstruction.hs | 2 -- .../test/Test/Record/Sanity/Strictness.hs | 2 -- .../Record/Sanity/StrictnessStrictData.hs | 2 -- typelet/typelet.cabal | 2 +- 52 files changed, 30 insertions(+), 93 deletions(-) diff --git a/.github/workflows/haskell-ci.yml b/.github/workflows/haskell-ci.yml index cad0e03a..dcfd9b3c 100644 --- a/.github/workflows/haskell-ci.yml +++ b/.github/workflows/haskell-ci.yml @@ -8,9 +8,9 @@ # # For more information, see https://github.com/haskell-CI/haskell-ci # -# version: 0.19.20240514 +# version: 0.19.20240708 # -# REGENDATA ("0.19.20240514",["github","cabal.project"]) +# REGENDATA ("0.19.20240708",["github","cabal.project"]) # name: Haskell-CI on: @@ -32,9 +32,9 @@ jobs: strategy: matrix: include: - - compiler: ghc-9.6.4 + - compiler: ghc-9.6.6 compilerKind: ghc - compilerVersion: 9.6.4 + compilerVersion: 9.6.6 setup-method: ghcup allow-failure: false - compiler: ghc-9.4.8 @@ -59,10 +59,10 @@ jobs: apt-get update apt-get install -y --no-install-recommends gnupg ca-certificates dirmngr curl git software-properties-common libtinfo5 mkdir -p "$HOME/.ghcup/bin" - curl -sL https://downloads.haskell.org/ghcup/0.1.20.0/x86_64-linux-ghcup-0.1.20.0 > "$HOME/.ghcup/bin/ghcup" + curl -sL https://downloads.haskell.org/ghcup/0.1.30.0/x86_64-linux-ghcup-0.1.30.0 > "$HOME/.ghcup/bin/ghcup" chmod a+x "$HOME/.ghcup/bin/ghcup" "$HOME/.ghcup/bin/ghcup" install ghc "$HCVER" || (cat "$HOME"/.ghcup/logs/*.* && false) - "$HOME/.ghcup/bin/ghcup" install cabal 3.10.2.0 || (cat "$HOME"/.ghcup/logs/*.* && false) + "$HOME/.ghcup/bin/ghcup" install cabal 3.12.1.0 || (cat "$HOME"/.ghcup/logs/*.* && false) env: HCKIND: ${{ matrix.compilerKind }} HCNAME: ${{ matrix.compiler }} @@ -80,7 +80,7 @@ jobs: echo "HC=$HC" >> "$GITHUB_ENV" echo "HCPKG=$HCPKG" >> "$GITHUB_ENV" echo "HADDOCK=$HADDOCK" >> "$GITHUB_ENV" - echo "CABAL=$HOME/.ghcup/bin/cabal-3.10.2.0 -vnormal+nowrap" >> "$GITHUB_ENV" + echo "CABAL=$HOME/.ghcup/bin/cabal-3.12.1.0 -vnormal+nowrap" >> "$GITHUB_ENV" HCNUMVER=$(${HC} --numeric-version|perl -ne '/^(\d+)\.(\d+)\.(\d+)(\.(\d+))?$/; print(10000 * $1 + 100 * $2 + ($3 == 0 ? $5 != 1 : $3))') echo "HCNUMVER=$HCNUMVER" >> "$GITHUB_ENV" echo "ARG_TESTS=--enable-tests" >> "$GITHUB_ENV" @@ -139,8 +139,8 @@ jobs: - name: install cabal-docspec run: | mkdir -p $HOME/.cabal/bin - curl -sL https://github.com/phadej/cabal-extras/releases/download/cabal-docspec-0.0.0.20240414/cabal-docspec-0.0.0.20240414-x86_64-linux.xz > cabal-docspec.xz - echo '2d18a3f79619e8ec5f11870f926f6dc2616e02a6c889315b7f82044b95a1adb9 cabal-docspec.xz' | sha256sum -c - + curl -sL https://github.com/phadej/cabal-extras/releases/download/cabal-docspec-0.0.0.20240703/cabal-docspec-0.0.0.20240703-x86_64-linux.xz > cabal-docspec.xz + echo '48bf3b7fd2f7f0caa6162afee57a755be8523e7f467b694900eb420f5f9a7b76 cabal-docspec.xz' | sha256sum -c - xz -d < cabal-docspec.xz > $HOME/.cabal/bin/cabal-docspec rm -f cabal-docspec.xz chmod a+x $HOME/.cabal/bin/cabal-docspec @@ -205,20 +205,20 @@ jobs: cat >> cabal.project < {-# OPTIONS_GHC -fplugin=Data.Record.Plugin #-} -- > --- > import Data.Record.Plugin --- > -- > {-# ANN type B largeRecord #-} -- > data B a = B {a :: a, b :: String} -- > deriving stock (Show, Eq, Ord) diff --git a/large-records/test/Test/Record/Sanity/CodeGen.hs b/large-records/test/Test/Record/Sanity/CodeGen.hs index ba1b14bc..535366db 100644 --- a/large-records/test/Test/Record/Sanity/CodeGen.hs +++ b/large-records/test/Test/Record/Sanity/CodeGen.hs @@ -16,7 +16,6 @@ module Test.Record.Sanity.CodeGen (tests) where import Data.Record.Generic -import Data.Record.Plugin import Test.Tasty import Test.Tasty.HUnit diff --git a/large-records/test/Test/Record/Sanity/Derive.hs b/large-records/test/Test/Record/Sanity/Derive.hs index 222afc07..6b4fe2fa 100644 --- a/large-records/test/Test/Record/Sanity/Derive.hs +++ b/large-records/test/Test/Record/Sanity/Derive.hs @@ -24,8 +24,6 @@ import GHC.Records.Compat import Test.Tasty import Test.Tasty.HUnit -import Data.Record.Plugin - {------------------------------------------------------------------------------- Class of kind @Type -> Constraint@. -------------------------------------------------------------------------------} diff --git a/large-records/test/Test/Record/Sanity/EqualFieldTypes.hs b/large-records/test/Test/Record/Sanity/EqualFieldTypes.hs index 456e4a1d..f7f01f78 100644 --- a/large-records/test/Test/Record/Sanity/EqualFieldTypes.hs +++ b/large-records/test/Test/Record/Sanity/EqualFieldTypes.hs @@ -21,8 +21,6 @@ module Test.Record.Sanity.EqualFieldTypes (tests) where import Test.Tasty import Test.Tasty.HUnit -import Data.Record.Plugin - {-# ANN type R largeRecord #-} data R a = MkR { field1 :: a diff --git a/large-records/test/Test/Record/Sanity/GhcGenerics.hs b/large-records/test/Test/Record/Sanity/GhcGenerics.hs index 1e863e08..5101ae96 100644 --- a/large-records/test/Test/Record/Sanity/GhcGenerics.hs +++ b/large-records/test/Test/Record/Sanity/GhcGenerics.hs @@ -21,8 +21,6 @@ import Test.Tasty.HUnit import qualified GHC.Generics as GHC -import Data.Record.Plugin - {-# ANN type R largeRecord #-} data R = MkR { a :: Int } deriving (Show) diff --git a/large-records/test/Test/Record/Sanity/HKD.hs b/large-records/test/Test/Record/Sanity/HKD.hs index 43d4354a..3d8da699 100644 --- a/large-records/test/Test/Record/Sanity/HKD.hs +++ b/large-records/test/Test/Record/Sanity/HKD.hs @@ -25,8 +25,6 @@ import GHC.Records.Compat import Test.Tasty import Test.Tasty.HUnit -import Data.Record.Plugin - type family HKD f a where HKD Identity a = a HKD (Const b) a = b diff --git a/large-records/test/Test/Record/Sanity/HigherKinded.hs b/large-records/test/Test/Record/Sanity/HigherKinded.hs index fbee905f..da2f8f60 100644 --- a/large-records/test/Test/Record/Sanity/HigherKinded.hs +++ b/large-records/test/Test/Record/Sanity/HigherKinded.hs @@ -26,8 +26,6 @@ import GHC.TypeLits import Test.Tasty import Test.Tasty.HUnit -import Data.Record.Plugin - newtype T (n :: Nat) (f :: Type -> Type) = MkT (f Word) instance LowerBound (T n I) where diff --git a/large-records/test/Test/Record/Sanity/NamedWildCards.hs b/large-records/test/Test/Record/Sanity/NamedWildCards.hs index 03b77d17..7f7d8354 100644 --- a/large-records/test/Test/Record/Sanity/NamedWildCards.hs +++ b/large-records/test/Test/Record/Sanity/NamedWildCards.hs @@ -16,8 +16,6 @@ module Test.Record.Sanity.NamedWildCards where -import Data.Record.Plugin - {-# ANN type X largeRecord #-} data X = MkX { _x :: Int } diff --git a/large-records/test/Test/Record/Sanity/Operators.hs b/large-records/test/Test/Record/Sanity/Operators.hs index 26873e2a..3c8b7f71 100644 --- a/large-records/test/Test/Record/Sanity/Operators.hs +++ b/large-records/test/Test/Record/Sanity/Operators.hs @@ -16,8 +16,6 @@ module Test.Record.Sanity.Operators () where import Data.Kind (Type) -import Data.Record.Plugin - -- Some type family (e.g. servant record-style API def). type family tag :- route :: Type diff --git a/large-records/test/Test/Record/Sanity/OverloadedRecordUpdate.hs b/large-records/test/Test/Record/Sanity/OverloadedRecordUpdate.hs index 905f44c1..e478becc 100644 --- a/large-records/test/Test/Record/Sanity/OverloadedRecordUpdate.hs +++ b/large-records/test/Test/Record/Sanity/OverloadedRecordUpdate.hs @@ -39,7 +39,6 @@ import Test.Tasty.HUnit import Data.Record.Generic (Rep) import Data.Record.Generic.Lens.VL import Data.Record.Overloading -import Data.Record.Plugin tests :: TestTree tests = testGroup "Test.Record.Sanity.OverloadedRecordUpdate" [ diff --git a/large-records/test/Test/Record/Sanity/OverloadingNoDRF.hs b/large-records/test/Test/Record/Sanity/OverloadingNoDRF.hs index f16c4e35..95c988dd 100644 --- a/large-records/test/Test/Record/Sanity/OverloadingNoDRF.hs +++ b/large-records/test/Test/Record/Sanity/OverloadingNoDRF.hs @@ -21,8 +21,6 @@ import GHC.Records.Compat import Test.Tasty import Test.Tasty.HUnit -import Data.Record.Plugin - {------------------------------------------------------------------------------- Simple test case diff --git a/large-records/test/Test/Record/Sanity/PatternMatch.hs b/large-records/test/Test/Record/Sanity/PatternMatch.hs index a39fed1d..a2c9b6b2 100644 --- a/large-records/test/Test/Record/Sanity/PatternMatch.hs +++ b/large-records/test/Test/Record/Sanity/PatternMatch.hs @@ -23,8 +23,6 @@ import Data.List (isInfixOf) import Test.Tasty import Test.Tasty.HUnit -import Data.Record.Plugin - import Test.Record.Util {------------------------------------------------------------------------------- diff --git a/large-records/test/Test/Record/Sanity/QualifiedImports/A.hs b/large-records/test/Test/Record/Sanity/QualifiedImports/A.hs index 90d2bffc..0a63def6 100644 --- a/large-records/test/Test/Record/Sanity/QualifiedImports/A.hs +++ b/large-records/test/Test/Record/Sanity/QualifiedImports/A.hs @@ -12,7 +12,5 @@ module Test.Record.Sanity.QualifiedImports.A (T(..)) where -import Data.Record.Plugin - {-# ANN type T largeRecord #-} data T a = MkT { x :: Int, y :: [a] } diff --git a/large-records/test/Test/Record/Sanity/QualifiedImports/B.hs b/large-records/test/Test/Record/Sanity/QualifiedImports/B.hs index b445b02b..44f426ff 100644 --- a/large-records/test/Test/Record/Sanity/QualifiedImports/B.hs +++ b/large-records/test/Test/Record/Sanity/QualifiedImports/B.hs @@ -13,8 +13,6 @@ module Test.Record.Sanity.QualifiedImports.B (T(..)) where -import Data.Record.Plugin - import qualified Test.Record.Sanity.QualifiedImports.A as A {-# ANN type T largeRecord #-} diff --git a/large-records/test/Test/Record/Sanity/RDP/SingleModule.hs b/large-records/test/Test/Record/Sanity/RDP/SingleModule.hs index e4f24eb9..bcb9611c 100644 --- a/large-records/test/Test/Record/Sanity/RDP/SingleModule.hs +++ b/large-records/test/Test/Record/Sanity/RDP/SingleModule.hs @@ -20,8 +20,6 @@ module Test.Record.Sanity.RDP.SingleModule (tests) where import Test.Tasty import Test.Tasty.HUnit -import Data.Record.Plugin - {------------------------------------------------------------------------------- Simple field selection and override -------------------------------------------------------------------------------} diff --git a/large-records/test/Test/Record/Sanity/RDP/SplitModule/RecordDef.hs b/large-records/test/Test/Record/Sanity/RDP/SplitModule/RecordDef.hs index 59f0e5b8..6ceb24a8 100644 --- a/large-records/test/Test/Record/Sanity/RDP/SplitModule/RecordDef.hs +++ b/large-records/test/Test/Record/Sanity/RDP/SplitModule/RecordDef.hs @@ -23,8 +23,6 @@ module Test.Record.Sanity.RDP.SplitModule.RecordDef ( , R5_WithLR(..) ) where -import Data.Record.Plugin - {-# ANN type R1 largeRecord #-} data R1 = MkR1 { r1_x :: Int, r1_y :: Bool } deriving (Show, Eq) diff --git a/large-records/test/Test/Record/Sanity/RecordConstruction.hs b/large-records/test/Test/Record/Sanity/RecordConstruction.hs index 370ea4f0..c99a6e13 100644 --- a/large-records/test/Test/Record/Sanity/RecordConstruction.hs +++ b/large-records/test/Test/Record/Sanity/RecordConstruction.hs @@ -20,8 +20,6 @@ import GHC.Records.Compat import Test.Tasty import Test.Tasty.HUnit -import Data.Record.Plugin - -- Test that this works if we don't generate field accessors -- See -- diff --git a/large-records/test/Test/Record/Sanity/Strictness.hs b/large-records/test/Test/Record/Sanity/Strictness.hs index d274add0..085ef067 100644 --- a/large-records/test/Test/Record/Sanity/Strictness.hs +++ b/large-records/test/Test/Record/Sanity/Strictness.hs @@ -26,8 +26,6 @@ import Test.Tasty.HUnit import qualified Data.Record.Generic.Rep as Rep -import Data.Record.Plugin - {-# ANN type Lazy largeRecord #-} data Lazy = MkLazy { lazyField :: Word } diff --git a/large-records/test/Test/Record/Sanity/StrictnessStrictData.hs b/large-records/test/Test/Record/Sanity/StrictnessStrictData.hs index 390c3ba5..ef7ae5ed 100644 --- a/large-records/test/Test/Record/Sanity/StrictnessStrictData.hs +++ b/large-records/test/Test/Record/Sanity/StrictnessStrictData.hs @@ -27,8 +27,6 @@ import Test.Tasty.HUnit import qualified Data.Record.Generic.Rep as Rep -import Data.Record.Plugin - {-# ANN type Lazy largeRecord #-} data Lazy = MkLazy { lazyField :: ~Word } diff --git a/typelet/typelet.cabal b/typelet/typelet.cabal index 49429334..8f1b45d8 100644 --- a/typelet/typelet.cabal +++ b/typelet/typelet.cabal @@ -17,7 +17,7 @@ maintainer: edsko@well-typed.com copyright: Well-Typed LLP, Juspay Technologies Pvt Ltd category: Plugin extra-source-files: CHANGELOG.md -tested-with: GHC ==8.10.7 || ==9.2.8 || ==9.4.8 || ==9.6.4 +tested-with: GHC ==8.10.7 || ==9.2.8 || ==9.4.8 || ==9.6.6 source-repository head type: git From 2a257b5317b34bfa940e8daa8e7afd4f0643fd86 Mon Sep 17 00:00:00 2001 From: Edsko de Vries Date: Tue, 15 Oct 2024 13:54:37 +0200 Subject: [PATCH 4/5] Document required dependencies and extensions --- large-records/CHANGELOG.md | 3 ++- large-records/src/Data/Record/Plugin.hs | 28 +++++++++++++++++++++++++ 2 files changed, 30 insertions(+), 1 deletion(-) diff --git a/large-records/CHANGELOG.md b/large-records/CHANGELOG.md index 55e25686..fdb617d4 100644 --- a/large-records/CHANGELOG.md +++ b/large-records/CHANGELOG.md @@ -2,8 +2,9 @@ ## 0.4.2 -- 2024-10-15 -* Support `primitive-0.7.3` (#159, Isaac Elliott) +* Support `primitive-0.7.3` (#159, Isaac Elliott). * Plugin idempotence (#159, Isaac Elliott). +* Document required additional dependencies and language extensions (#161). Note: if your code imports `Data.Plugin.Record` only for the `largeRecord` identifier used in the `ANN` annotations, this import is no longer required diff --git a/large-records/src/Data/Record/Plugin.hs b/large-records/src/Data/Record/Plugin.hs index f06d351d..e731be19 100644 --- a/large-records/src/Data/Record/Plugin.hs +++ b/large-records/src/Data/Record/Plugin.hs @@ -14,6 +14,34 @@ -- -- See 'LargeRecordOptions' for the list of all possible annotations. -- +-- = Dependencies +-- +-- In addition to the dependency on @large-records@, you will also need to add +-- dependencies +-- on [large-generics](http://hackage.haskell.org/package/large-generics) +-- and [record-hasfield](http://hackage.haskell.org/package/record-hasfield). +-- +-- = Language extensions +-- +-- The plugin depends on a number of language extensions. If you are using +-- GHC2021, you will need enable: +-- +-- > {-# LANGUAGE DataKinds #-} +-- > {-# LANGUAGE TypeFamilies #-} +-- > {-# LANGUAGE UndecidableInstances #-} +-- +-- If you are using Haskell2010, you need to enable: +-- +-- > {-# LANGUAGE ConstraintKinds #-} +-- > {-# LANGUAGE DataKinds #-} +-- > {-# LANGUAGE FlexibleInstances #-} +-- > {-# LANGUAGE GADTs #-} +-- > {-# LANGUAGE MultiParamTypeClasses #-} +-- > {-# LANGUAGE ScopedTypeVariables #-} +-- > {-# LANGUAGE TypeFamilies #-} +-- > {-# LANGUAGE TypeOperators #-} +-- > {-# LANGUAGE UndecidableInstances #-} +-- -- = Usage with @record-dot-preprocessor@ -- -- The easiest way to use both plugins together is to do From 6ed71292d5d34c6876907c268aa6dccb66fd6988 Mon Sep 17 00:00:00 2001 From: Edsko de Vries Date: Tue, 15 Oct 2024 14:55:46 +0200 Subject: [PATCH 5/5] Use `Exact` names for `Prelude` imports Closes #162 --- beam-large-records/beam-large-records.cabal | 1 + .../large-records-benchmarks.cabal | 7 +- large-records/CHANGELOG.md | 11 ++- large-records/large-records.cabal | 3 +- .../Data/Record/Internal/Plugin/CodeGen.hs | 22 ++--- .../src/Data/Record/Internal/Plugin/Names.hs | 80 +++++++++---------- large-records/src/Data/Record/Plugin.hs | 8 +- .../src/Data/Record/Plugin/Runtime.hs | 30 +++++-- 8 files changed, 92 insertions(+), 70 deletions(-) diff --git a/beam-large-records/beam-large-records.cabal b/beam-large-records/beam-large-records.cabal index 246bea53..5ffdf381 100644 --- a/beam-large-records/beam-large-records.cabal +++ b/beam-large-records/beam-large-records.cabal @@ -74,6 +74,7 @@ test-suite test-beam-large-records , beam-core , beam-large-records , beam-sqlite + , ghc-prim , large-generics , large-records , microlens diff --git a/large-records-benchmarks/large-records-benchmarks.cabal b/large-records-benchmarks/large-records-benchmarks.cabal index 3d39008b..5ef4ad1f 100644 --- a/large-records-benchmarks/large-records-benchmarks.cabal +++ b/large-records-benchmarks/large-records-benchmarks.cabal @@ -131,6 +131,7 @@ executable bench-before build-depends: , aeson , generics-sop + , ghc-prim , json-sop , record-dot-preprocessor , record-hasfield @@ -159,7 +160,8 @@ executable bench-after -- Needed for the HasNormalForm benchmark -freduction-depth=2000 build-depends: - aeson + , aeson + , ghc-prim , large-generics , large-records , record-hasfield @@ -656,8 +658,9 @@ test-suite test-large-records-benchmarks bench/before bench/experiments build-depends: - aeson + , aeson , generics-sop + , ghc-prim , json-sop , large-generics , large-records diff --git a/large-records/CHANGELOG.md b/large-records/CHANGELOG.md index fdb617d4..dc56c701 100644 --- a/large-records/CHANGELOG.md +++ b/large-records/CHANGELOG.md @@ -5,10 +5,15 @@ * Support `primitive-0.7.3` (#159, Isaac Elliott). * Plugin idempotence (#159, Isaac Elliott). * Document required additional dependencies and language extensions (#161). +* Use `Exact` names for `Prelude` imports, to avoid unexpected clashes (#162). -Note: if your code imports `Data.Plugin.Record` only for the `largeRecord` -identifier used in the `ANN` annotations, this import is no longer required -as of this version and can be omitted. +Notes: + +* If your code imports `Data.Plugin.Record` only for the `largeRecord` + identifier used in the `ANN` annotations, this import is no longer required as + of this version and can be omitted. +* In addition to `large-generics` and `record-hasfield` you will now also need + to declare a dependency on `ghc-prim`. ## 0.4.1 -- 2024-05-30 diff --git a/large-records/large-records.cabal b/large-records/large-records.cabal index 0783fa10..bea2d293 100644 --- a/large-records/large-records.cabal +++ b/large-records/large-records.cabal @@ -15,7 +15,7 @@ license: BSD-3-Clause author: Edsko de Vries maintainer: edsko@well-typed.com category: Generics -extra-source-files: CHANGELOG.md +extra-doc-files: CHANGELOG.md tested-with: GHC ==8.10.7 || ==9.2.8 || ==9.4.8 || ==9.6.6 source-repository head @@ -113,6 +113,7 @@ test-suite test-large-records , large-records , generic-deriving + , ghc-prim , large-generics , mtl , newtype diff --git a/large-records/src/Data/Record/Internal/Plugin/CodeGen.hs b/large-records/src/Data/Record/Internal/Plugin/CodeGen.hs index 41920449..dd4ccfab 100644 --- a/large-records/src/Data/Record/Internal/Plugin/CodeGen.hs +++ b/large-records/src/Data/Record/Internal/Plugin/CodeGen.hs @@ -5,6 +5,8 @@ -- | The core of the plugin implementation. module Data.Record.Internal.Plugin.CodeGen (genLargeRecord) where +import Prelude hiding (error) + import Data.List (nubBy) import Data.List.NonEmpty (NonEmpty(..)) @@ -159,8 +161,6 @@ genVectorConversions QualifiedNames{..} r@Record{..} = concatM [ , toVector ] where - UnqualifiedNames{..} = getUnqualifiedNames - fromVector :: m [LHsDecl GhcPs] fromVector = do args <- mapM (freshName . fieldName) recordFields @@ -203,7 +203,7 @@ genVectorConversions QualifiedNames{..} r@Record{..} = concatM [ ] ) , ( wildP - , VarE unq_error `appE` stringE matchErr + , VarE error `appE` stringE matchErr ) ] ] @@ -245,7 +245,7 @@ genIndexedAccessor QualifiedNames{..} r@Record{..} = do return [ sigD name $ funT - (ConT unq_type_Int) + (ConT type_Int) (recordTypeT r `funT` VarT x) , valD name $ lamE (varP n :| [varP t]) $ @@ -259,8 +259,6 @@ genIndexedAccessor QualifiedNames{..} r@Record{..} = do ) ] where - UnqualifiedNames{..} = getUnqualifiedNames - name :: LRdrName name = nameUnsafeGetIndex r @@ -287,7 +285,7 @@ genUnsafeSetIndex QualifiedNames{..} r@Record{..} = do val <- freshName $ mkExpVar recordAnnLoc "val" return [ sigD name $ - ConT unq_type_Int + ConT type_Int `funT` (recordTypeT r `funT` (VarT x `funT` recordTypeT r)) , valD name $ lamE (varP n :| [varP t, (varP val)]) $ @@ -305,8 +303,6 @@ genUnsafeSetIndex QualifiedNames{..} r@Record{..} = do ) ] where - UnqualifiedNames{..} = getUnqualifiedNames - name :: LRdrName name = nameUnsafeSetIndex r @@ -624,13 +620,11 @@ genStockInstance :: MonadFresh m => QualifiedNames -> Record -> StockDeriving -> m [LHsDecl GhcPs] genStockInstance QualifiedNames{..} r = pure . \case - Show -> [mkInstance unq_type_Show unq_showsPrec gshowsPrec] - Eq -> [mkInstance unq_type_Eq unq_eq geq ] - Ord -> [mkInstance unq_type_Ord unq_compare gcompare ] + Show -> [mkInstance prelude_type_Show prelude_showsPrec gshowsPrec] + Eq -> [mkInstance prelude_type_Eq prelude_eq geq ] + Ord -> [mkInstance prelude_type_Ord prelude_compare gcompare ] Generic -> [] where - UnqualifiedNames{..} = getUnqualifiedNames - mkInstance :: LRdrName -> LRdrName -> LRdrName -> LHsDecl GhcPs mkInstance cls mthd gen = instanceD diff --git a/large-records/src/Data/Record/Internal/Plugin/Names.hs b/large-records/src/Data/Record/Internal/Plugin/Names.hs index ecfd86ec..15946712 100644 --- a/large-records/src/Data/Record/Internal/Plugin/Names.hs +++ b/large-records/src/Data/Record/Internal/Plugin/Names.hs @@ -2,14 +2,11 @@ {-# LANGUAGE RecordWildCards #-} module Data.Record.Internal.Plugin.Names ( - -- * Qualified names QualifiedNames(..) , getQualifiedNames - -- * Unqualified names - , UnqualifiedNames(..) - , getUnqualifiedNames ) where +import Prelude hiding (error) import Data.Record.Internal.GHC.Shim {------------------------------------------------------------------------------- @@ -19,17 +16,30 @@ import Data.Record.Internal.GHC.Shim data QualifiedNames = QualifiedNames { -- - -- Base + -- Prelude type classes -- - type_Constraint :: LRdrName + prelude_type_Eq :: LRdrName + , prelude_type_Ord :: LRdrName + , prelude_type_Show :: LRdrName + , prelude_compare :: LRdrName + , prelude_eq :: LRdrName + , prelude_showsPrec :: LRdrName + + -- + -- Other base + -- + + , type_Constraint :: LRdrName , type_GHC_Generic :: LRdrName , type_GHC_Rep :: LRdrName + , type_Int :: LRdrName , type_Proxy :: LRdrName , type_Type :: LRdrName - , proxy :: LRdrName + , error :: LRdrName , ghc_from :: LRdrName , ghc_to :: LRdrName + , proxy :: LRdrName -- -- AnyArray @@ -100,8 +110,23 @@ data QualifiedNames = QualifiedNames { -- define a dependency on that other package. getQualifiedNames :: Hsc QualifiedNames getQualifiedNames = do + + -- + -- Prelude classes + -- + -- Annoyingly, we cannot re-rexport these through our runtime module, since + -- we cannot declare instances of type aliased classes. + -- + + prelude_type_Eq <- exact <$> lookupTcName ghcClasses (Just "ghc-prim") "Eq" + prelude_type_Ord <- exact <$> lookupTcName ghcClasses (Just "ghc-prim") "Ord" + prelude_type_Show <- exact <$> lookupTcName ghcShow Nothing "Show" + prelude_compare <- exact <$> lookupVarName ghcClasses (Just "ghc-prim") "compare" + prelude_eq <- exact <$> lookupVarName ghcClasses (Just "ghc-prim") "==" + prelude_showsPrec <- exact <$> lookupVarName ghcShow Nothing "showsPrec" + -- - -- base + -- Other base -- type_Constraint <- exact <$> lookupTcName runtime Nothing "Constraint" @@ -109,9 +134,11 @@ getQualifiedNames = do type_GHC_Rep <- exact <$> lookupTcName ghcGenerics Nothing "Rep" type_Proxy <- exact <$> lookupTcName runtime Nothing "Proxy" type_Type <- exact <$> lookupTcName runtime Nothing "Type" - proxy <- exact <$> lookupVarName runtime Nothing "proxy" + type_Int <- exact <$> lookupTcName runtime Nothing "Int" + error <- exact <$> lookupVarName runtime Nothing "error" ghc_from <- exact <$> lookupVarName ghcGenerics Nothing "from" ghc_to <- exact <$> lookupVarName ghcGenerics Nothing "to" + proxy <- exact <$> lookupVarName runtime Nothing "proxy" -- -- AnyArray @@ -173,39 +200,12 @@ getQualifiedNames = do exact :: Name -> LRdrName exact = noLoc . Exact + ghcClasses, ghcShow :: ModuleName + ghcClasses = mkModuleName "GHC.Classes" + ghcShow = mkModuleName "GHC.Show" + runtime, recordHasField, ghcGenerics, largeGenerics :: ModuleName runtime = mkModuleName "Data.Record.Plugin.Runtime" recordHasField = mkModuleName "GHC.Records.Compat" ghcGenerics = mkModuleName "GHC.Generics" largeGenerics = mkModuleName "Data.Record.Generic" - -{------------------------------------------------------------------------------- - We use Prelude names unqualified. --------------------------------------------------------------------------------} - -data UnqualifiedNames = UnqualifiedNames { - unq_type_Eq :: LRdrName - , unq_type_Int :: LRdrName - , unq_type_Ord :: LRdrName - , unq_type_Show :: LRdrName - , unq_compare :: LRdrName - , unq_eq :: LRdrName - , unq_error :: LRdrName - , unq_showsPrec :: LRdrName - } - -getUnqualifiedNames :: UnqualifiedNames -getUnqualifiedNames = UnqualifiedNames { - unq_type_Eq = tc "Eq" - , unq_type_Int = tc "Int" - , unq_type_Ord = tc "Ord" - , unq_type_Show = tc "Show" - , unq_compare = var "compare" - , unq_eq = var "==" - , unq_error = var "error" - , unq_showsPrec = var "showsPrec" - } - where - var, tc :: String -> LRdrName - var x = noLoc $ mkRdrUnqual $ mkVarOcc x - tc x = noLoc $ mkRdrUnqual $ mkTcOcc x diff --git a/large-records/src/Data/Record/Plugin.hs b/large-records/src/Data/Record/Plugin.hs index e731be19..2b6ed251 100644 --- a/large-records/src/Data/Record/Plugin.hs +++ b/large-records/src/Data/Record/Plugin.hs @@ -17,9 +17,11 @@ -- = Dependencies -- -- In addition to the dependency on @large-records@, you will also need to add --- dependencies --- on [large-generics](http://hackage.haskell.org/package/large-generics) --- and [record-hasfield](http://hackage.haskell.org/package/record-hasfield). +-- dependencies on +-- +-- * [ghc-prim](http://hackage.haskell.org/package/ghc-prim). +-- * [large-generics](http://hackage.haskell.org/package/large-generics) +-- * [record-hasfield](http://hackage.haskell.org/package/record-hasfield). -- -- = Language extensions -- diff --git a/large-records/src/Data/Record/Plugin/Runtime.hs b/large-records/src/Data/Record/Plugin/Runtime.hs index 099c833c..2318e177 100644 --- a/large-records/src/Data/Record/Plugin/Runtime.hs +++ b/large-records/src/Data/Record/Plugin/Runtime.hs @@ -11,8 +11,11 @@ -- This exports all functionality required by the generated code, with the -- exception of GHC generics (name clash with @large-records@ generics). module Data.Record.Plugin.Runtime ( - -- * Base - Constraint + -- * Prelude + Int + , error + -- * Other base + , Constraint , Proxy , Type , proxy @@ -43,10 +46,14 @@ module Data.Record.Plugin.Runtime ( , unwrapThroughLRGenerics ) where +import Prelude hiding (Int, error) +import qualified Prelude as Prelude + import Control.Monad (forM_) import Data.Coerce (coerce) import Data.Primitive.SmallArray import GHC.Exts (Any) +import GHC.Stack (HasCallStack) import GHC.TypeLits import qualified Data.Foldable as Foldable @@ -58,6 +65,15 @@ import qualified Data.Record.Generic.GHC as LR import qualified Data.Record.Generic.Rep.Internal as LR import qualified Data.Record.Generic.Show as LR +{------------------------------------------------------------------------------- + Prelude +-------------------------------------------------------------------------------} + +type Int = Prelude.Int + +error :: HasCallStack => String -> a +error = Prelude.error + {------------------------------------------------------------------------------- base -------------------------------------------------------------------------------} @@ -85,11 +101,11 @@ anyArrayIndex :: AnyArray -> Int -> Any anyArrayIndex = indexSmallArray anyArrayUpdate :: AnyArray -> [(Int, Any)] -> AnyArray -anyArrayUpdate v updates = runSmallArray $ do +anyArrayUpdate v updates = runSmallArray (do v' <- thawSmallArray v 0 (sizeofSmallArray v) - forM_ updates $ \(i, a) -> do - writeSmallArray v' i a + forM_ updates (\(i, a) -> writeSmallArray v' i a) return v' + ) {------------------------------------------------------------------------------- large-generics: utilities @@ -102,7 +118,7 @@ anyArrayFromRep :: Rep LR.I a -> AnyArray anyArrayFromRep = coerce mkDicts :: [Dict c Any] -> Rep (Dict c) a -mkDicts = LR.Rep . smallArrayFromList +mkDicts ds = LR.Rep (smallArrayFromList ds) mkDict :: c x => Proxy c -> Proxy x -> Dict c x mkDict _ _ = LR.Dict @@ -126,7 +142,7 @@ mkMetadata name constr fields = LR.Metadata { recordName = name , recordConstructor = constr , recordSize = length fields - , recordFieldMetadata = LR.Rep $ smallArrayFromList fields + , recordFieldMetadata = LR.Rep (smallArrayFromList fields) } {-------------------------------------------------------------------------------