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 <= 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-benchmarks/bench/after/After/Sized/R010.hs b/large-records-benchmarks/bench/after/After/Sized/R010.hs index 6bd93e8a..5a781970 100644 --- a/large-records-benchmarks/bench/after/After/Sized/R010.hs +++ b/large-records-benchmarks/bench/after/After/Sized/R010.hs @@ -23,7 +23,6 @@ module After.Sized.R010 where import Data.Aeson (ToJSON(..)) import Data.Record.Generic.JSON -import Data.Record.Plugin import Bench.Types diff --git a/large-records-benchmarks/bench/after/After/Sized/R020.hs b/large-records-benchmarks/bench/after/After/Sized/R020.hs index 8a33c88b..99ab2e5d 100644 --- a/large-records-benchmarks/bench/after/After/Sized/R020.hs +++ b/large-records-benchmarks/bench/after/After/Sized/R020.hs @@ -23,7 +23,6 @@ module After.Sized.R020 where import Data.Aeson (ToJSON(..)) import Data.Record.Generic.JSON -import Data.Record.Plugin import Bench.Types diff --git a/large-records-benchmarks/bench/after/After/Sized/R030.hs b/large-records-benchmarks/bench/after/After/Sized/R030.hs index c9f086a1..922a6ebb 100644 --- a/large-records-benchmarks/bench/after/After/Sized/R030.hs +++ b/large-records-benchmarks/bench/after/After/Sized/R030.hs @@ -23,7 +23,6 @@ module After.Sized.R030 where import Data.Aeson (ToJSON(..)) import Data.Record.Generic.JSON -import Data.Record.Plugin import Bench.Types diff --git a/large-records-benchmarks/bench/after/After/Sized/R040.hs b/large-records-benchmarks/bench/after/After/Sized/R040.hs index 844631af..df15dfea 100644 --- a/large-records-benchmarks/bench/after/After/Sized/R040.hs +++ b/large-records-benchmarks/bench/after/After/Sized/R040.hs @@ -23,7 +23,6 @@ module After.Sized.R040 where import Data.Aeson (ToJSON(..)) import Data.Record.Generic.JSON -import Data.Record.Plugin import Bench.Types diff --git a/large-records-benchmarks/bench/after/After/Sized/R050.hs b/large-records-benchmarks/bench/after/After/Sized/R050.hs index 10db3599..30d91b07 100644 --- a/large-records-benchmarks/bench/after/After/Sized/R050.hs +++ b/large-records-benchmarks/bench/after/After/Sized/R050.hs @@ -23,7 +23,6 @@ module After.Sized.R050 where import Data.Aeson (ToJSON(..)) import Data.Record.Generic.JSON -import Data.Record.Plugin import Bench.Types diff --git a/large-records-benchmarks/bench/after/After/Sized/R060.hs b/large-records-benchmarks/bench/after/After/Sized/R060.hs index e85bc2df..055c9778 100644 --- a/large-records-benchmarks/bench/after/After/Sized/R060.hs +++ b/large-records-benchmarks/bench/after/After/Sized/R060.hs @@ -23,7 +23,6 @@ module After.Sized.R060 where import Data.Aeson (ToJSON(..)) import Data.Record.Generic.JSON -import Data.Record.Plugin import Bench.Types diff --git a/large-records-benchmarks/bench/after/After/Sized/R070.hs b/large-records-benchmarks/bench/after/After/Sized/R070.hs index ca6a472e..32a9cd08 100644 --- a/large-records-benchmarks/bench/after/After/Sized/R070.hs +++ b/large-records-benchmarks/bench/after/After/Sized/R070.hs @@ -23,7 +23,6 @@ module After.Sized.R070 where import Data.Aeson (ToJSON(..)) import Data.Record.Generic.JSON -import Data.Record.Plugin import Bench.Types diff --git a/large-records-benchmarks/bench/after/After/Sized/R080.hs b/large-records-benchmarks/bench/after/After/Sized/R080.hs index aeb6793b..f106e9a6 100644 --- a/large-records-benchmarks/bench/after/After/Sized/R080.hs +++ b/large-records-benchmarks/bench/after/After/Sized/R080.hs @@ -23,7 +23,6 @@ module After.Sized.R080 where import Data.Aeson (ToJSON(..)) import Data.Record.Generic.JSON -import Data.Record.Plugin import Bench.Types diff --git a/large-records-benchmarks/bench/after/After/Sized/R090.hs b/large-records-benchmarks/bench/after/After/Sized/R090.hs index 324a62f9..e2281761 100644 --- a/large-records-benchmarks/bench/after/After/Sized/R090.hs +++ b/large-records-benchmarks/bench/after/After/Sized/R090.hs @@ -23,7 +23,6 @@ module After.Sized.R090 where import Data.Aeson (ToJSON(..)) import Data.Record.Generic.JSON -import Data.Record.Plugin import Bench.Types diff --git a/large-records-benchmarks/bench/after/After/Sized/R100.hs b/large-records-benchmarks/bench/after/After/Sized/R100.hs index c38d6852..6ea9cede 100644 --- a/large-records-benchmarks/bench/after/After/Sized/R100.hs +++ b/large-records-benchmarks/bench/after/After/Sized/R100.hs @@ -23,7 +23,6 @@ module After.Sized.R100 where import Data.Aeson (ToJSON(..)) import Data.Record.Generic.JSON -import Data.Record.Plugin import Bench.Types diff --git a/large-records-benchmarks/bench/after/HigherKinded/Sized/R010.hs b/large-records-benchmarks/bench/after/HigherKinded/Sized/R010.hs index 8123590c..50db8555 100644 --- a/large-records-benchmarks/bench/after/HigherKinded/Sized/R010.hs +++ b/large-records-benchmarks/bench/after/HigherKinded/Sized/R010.hs @@ -21,8 +21,6 @@ module HigherKinded.Sized.R010 where -import Data.Record.Plugin - import Bench.Types {-# ANN type R largeRecord #-} diff --git a/large-records-benchmarks/bench/after/HigherKinded/Sized/R020.hs b/large-records-benchmarks/bench/after/HigherKinded/Sized/R020.hs index 359dfc61..0f306ec3 100644 --- a/large-records-benchmarks/bench/after/HigherKinded/Sized/R020.hs +++ b/large-records-benchmarks/bench/after/HigherKinded/Sized/R020.hs @@ -21,8 +21,6 @@ module HigherKinded.Sized.R020 where -import Data.Record.Plugin - import Bench.Types {-# ANN type R largeRecord #-} diff --git a/large-records-benchmarks/bench/after/HigherKinded/Sized/R030.hs b/large-records-benchmarks/bench/after/HigherKinded/Sized/R030.hs index 9a5fb8e3..4e2ed388 100644 --- a/large-records-benchmarks/bench/after/HigherKinded/Sized/R030.hs +++ b/large-records-benchmarks/bench/after/HigherKinded/Sized/R030.hs @@ -21,8 +21,6 @@ module HigherKinded.Sized.R030 where -import Data.Record.Plugin - import Bench.Types {-# ANN type R largeRecord #-} diff --git a/large-records-benchmarks/bench/after/HigherKinded/Sized/R040.hs b/large-records-benchmarks/bench/after/HigherKinded/Sized/R040.hs index 705f072c..0405ff15 100644 --- a/large-records-benchmarks/bench/after/HigherKinded/Sized/R040.hs +++ b/large-records-benchmarks/bench/after/HigherKinded/Sized/R040.hs @@ -21,8 +21,6 @@ module HigherKinded.Sized.R040 where -import Data.Record.Plugin - import Bench.Types {-# ANN type R largeRecord #-} diff --git a/large-records-benchmarks/bench/after/HigherKinded/Sized/R050.hs b/large-records-benchmarks/bench/after/HigherKinded/Sized/R050.hs index a3a3a434..0b2558a9 100644 --- a/large-records-benchmarks/bench/after/HigherKinded/Sized/R050.hs +++ b/large-records-benchmarks/bench/after/HigherKinded/Sized/R050.hs @@ -21,8 +21,6 @@ module HigherKinded.Sized.R050 where -import Data.Record.Plugin - import Bench.Types {-# ANN type R largeRecord #-} diff --git a/large-records-benchmarks/bench/after/HigherKinded/Sized/R060.hs b/large-records-benchmarks/bench/after/HigherKinded/Sized/R060.hs index f3e60d02..d3e4d84b 100644 --- a/large-records-benchmarks/bench/after/HigherKinded/Sized/R060.hs +++ b/large-records-benchmarks/bench/after/HigherKinded/Sized/R060.hs @@ -21,8 +21,6 @@ module HigherKinded.Sized.R060 where -import Data.Record.Plugin - import Bench.Types {-# ANN type R largeRecord #-} diff --git a/large-records-benchmarks/bench/after/HigherKinded/Sized/R070.hs b/large-records-benchmarks/bench/after/HigherKinded/Sized/R070.hs index ce60dd78..93f3c32b 100644 --- a/large-records-benchmarks/bench/after/HigherKinded/Sized/R070.hs +++ b/large-records-benchmarks/bench/after/HigherKinded/Sized/R070.hs @@ -21,8 +21,6 @@ module HigherKinded.Sized.R070 where -import Data.Record.Plugin - import Bench.Types {-# ANN type R largeRecord #-} diff --git a/large-records-benchmarks/bench/after/HigherKinded/Sized/R080.hs b/large-records-benchmarks/bench/after/HigherKinded/Sized/R080.hs index be39dcad..78d949c2 100644 --- a/large-records-benchmarks/bench/after/HigherKinded/Sized/R080.hs +++ b/large-records-benchmarks/bench/after/HigherKinded/Sized/R080.hs @@ -21,8 +21,6 @@ module HigherKinded.Sized.R080 where -import Data.Record.Plugin - import Bench.Types {-# ANN type R largeRecord #-} diff --git a/large-records-benchmarks/bench/after/HigherKinded/Sized/R090.hs b/large-records-benchmarks/bench/after/HigherKinded/Sized/R090.hs index 66a44fa4..09395914 100644 --- a/large-records-benchmarks/bench/after/HigherKinded/Sized/R090.hs +++ b/large-records-benchmarks/bench/after/HigherKinded/Sized/R090.hs @@ -21,8 +21,6 @@ module HigherKinded.Sized.R090 where -import Data.Record.Plugin - import Bench.Types {-# ANN type R largeRecord #-} diff --git a/large-records-benchmarks/bench/after/HigherKinded/Sized/R100.hs b/large-records-benchmarks/bench/after/HigherKinded/Sized/R100.hs index 89539abb..9f140122 100644 --- a/large-records-benchmarks/bench/after/HigherKinded/Sized/R100.hs +++ b/large-records-benchmarks/bench/after/HigherKinded/Sized/R100.hs @@ -21,8 +21,6 @@ module HigherKinded.Sized.R100 where -import Data.Record.Plugin - import Bench.Types {-# ANN type R largeRecord #-} 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 6249078f..dc56c701 100644 --- a/large-records/CHANGELOG.md +++ b/large-records/CHANGELOG.md @@ -1,5 +1,20 @@ # Revision history for large-records +## 0.4.2 -- 2024-10-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). + +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 * Support ghc 9.6 (and drop ghc <= 8.8) diff --git a/large-records/large-records.cabal b/large-records/large-records.cabal index 88b16cdd..bea2d293 100644 --- a/large-records/large-records.cabal +++ b/large-records/large-records.cabal @@ -1,6 +1,6 @@ cabal-version: 2.4 name: large-records -version: 0.4.1 +version: 0.4.2 synopsis: Efficient compilation for large records, linear in the size of the record description: For many reasons, the internal code generated for modules that contain records is quadratic in the number of record @@ -15,8 +15,8 @@ license: BSD-3-Clause author: Edsko de Vries maintainer: edsko@well-typed.com category: Generics -extra-source-files: CHANGELOG.md -tested-with: GHC ==8.10.7 || ==9.2.8 || ==9.4.8 || ==9.6.4 +extra-doc-files: CHANGELOG.md +tested-with: GHC ==8.10.7 || ==9.2.8 || ==9.4.8 || ==9.6.6 source-repository head type: git @@ -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 @@ -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 1976f97f..2b6ed251 100644 --- a/large-records/src/Data/Record/Plugin.hs +++ b/large-records/src/Data/Record/Plugin.hs @@ -8,14 +8,42 @@ -- -- > {-# 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) -- -- 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 +-- +-- * [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 +-- +-- 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 @@ -135,7 +163,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. 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) } {------------------------------------------------------------------------------- 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