diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,5 +1,12 @@ # Revision history for large-anon +## 0.4.0 -- 2026-11-13 + +* Drop support for `typelet` (which is no longer maintained). +* Drop support for ghc < 9.2 +* Relax bounds +* Use ghc-tcplugin-api 0.20.2 + ## 0.3.4 -- 2026-05-20 * Support ghc 9.14 diff --git a/large-anon.cabal b/large-anon.cabal --- a/large-anon.cabal +++ b/large-anon.cabal @@ -1,6 +1,6 @@ cabal-version: 2.4 name: large-anon -version: 0.3.4 +version: 0.4.0 synopsis: Scalable anonymous records description: The @large-anon@ package provides support for anonymous records in Haskell, with a focus on compile-time (and @@ -12,17 +12,45 @@ category: Records extra-doc-files: CHANGELOG.md test/Test/Sanity/RebindableSyntax/Tests.hs -tested-with: GHC ==8.10.7 - GHC ==9.0.2 - GHC ==9.2.8 +tested-with: GHC ==9.2.8 GHC ==9.4.8 GHC ==9.6.7 GHC ==9.8.4 - GHC ==9.10.2 - GHC ==9.12.2 + GHC ==9.10.3 + GHC ==9.12.4 GHC ==9.14.1 +common lang + build-depends: base >= 4.16 && < 4.23 + default-language: GHC2021 + + default-extensions: + DataKinds + DerivingStrategies + ExplicitNamespaces + FunctionalDependencies + ImportQualifiedPost + LambdaCase + PatternSynonyms + RecordWildCards + RoleAnnotations + TypeFamilies + UndecidableInstances + UndecidableSuperClasses + ViewPatterns + + ghc-options: + -Wall + -Wno-unticked-promoted-constructors + -Wprepositive-qualified-module + -Wredundant-constraints + -Wunused-packages + -fno-show-valid-hole-fits + library + import: lang + hs-source-dirs: src + exposed-modules: Data.Record.Anon Data.Record.Anon.Advanced @@ -77,33 +105,22 @@ Data.Record.Anon.Internal.Plugin.Source.Options build-depends: - , aeson >= 1.4.4 && < 2.3 - , base >= 4.14 && < 4.23 - , containers >= 0.6.2 && < 0.9 - , deepseq >= 1.4.4 && < 1.6 - , ghc >= 8.10 && < 9.15 - , ghc-tcplugin-api >= 0.19 && < 0.20 + , aeson >= 1.4.4 && < 2.4 + , containers >= 0.6.5 && < 0.9 + , deepseq >= 1.4.6 && < 1.6 + , ghc >= 9.2 && < 9.15 + , ghc-tcplugin-api >= 0.20.2 && < 0.21 , hashable >= 1.3 && < 1.6 - , mtl >= 2.2.1 && < 2.4 + , mtl >= 2.2.2 && < 2.4 , optics-core >= 0.3 && < 0.5 , primitive >= 0.8 && < 0.10 , record-hasfield >= 1.0 && < 1.1 , sop-core >= 0.5 && < 0.6 , syb >= 0.7 && < 0.8 - , tagged >= 0.8.6 && < 0.9 - , typelet >= 0.1 && < 0.2 + , tagged >= 0.8.6 && < 0.10 -- large-generics 0.2 starts using 'SmallArray' instead of 'Vector' , large-generics >= 0.2 && < 0.3 - hs-source-dirs: - src - default-language: - Haskell2010 - ghc-options: - -Wall - -Wno-unticked-promoted-constructors - -Wredundant-constraints - -Wunused-packages if flag(debug) build-depends: @@ -115,15 +132,16 @@ ghc-options: -dcore-lint + other-extensions: + CPP + AllowAmbiguousTypes + test-suite test-large-anon - default-language: - Haskell2010 - type: - exitcode-stdio-1.0 - hs-source-dirs: - test - main-is: - TestLargeAnon.hs + import: lang + type: exitcode-stdio-1.0 + hs-source-dirs: test + main-is: TestLargeAnon.hs + other-modules: Test.Infra.Discovery Test.Infra.DynRecord @@ -157,43 +175,38 @@ Test.Sanity.RecordLens Test.Sanity.Regression Test.Sanity.Simple - Test.Sanity.SrcPlugin.WithoutTypelet - Test.Sanity.SrcPlugin.WithTypelet + Test.Sanity.SrcPlugin Test.Sanity.TypeLevelMetadata + build-depends: , aeson - , aeson-pretty , arrows , base - , bytestring , containers , large-anon , large-generics , mtl - , optics-core - , parsec , QuickCheck - , record-hasfield , sop-core , Stream , tasty , tasty-hunit , tasty-quickcheck , text - , typelet , validation-selective - ghc-options: - -Wall - -Wredundant-constraints - -Wno-unticked-promoted-constructors - -fno-show-valid-hole-fits - -- Not sure why, but ghc warns about record-hasfield being unused, - -- despite it actually being required. So for now we just disable this check. - -- ghc-options: -Wunused-packages - if impl(ghc < 9.10) - build-depends: record-dot-preprocessor + -- Not sure why, but ghc warns about record-hasfield being unused, + -- despite it actually being required. So for now we just disable this check. + ghc-options: -Wno-unused-packages + build-depends: + , record-dot-preprocessor + -- dependencies of the blog post example (which uses RDP) + , aeson-pretty + , bytestring + , optics-core + , parsec + , record-hasfield else cpp-options: -DNO_RECORD_DOT_PREPROCESSOR @@ -201,6 +214,17 @@ if flag(enable-core-lint) ghc-options: -dcore-lint + + other-extensions: + Arrows + CPP + NPlusKPatterns + OverloadedLabels + OverloadedLists + OverloadedRecordDot + OverloadedRecordUpdate + OverloadedStrings + RebindableSyntax Flag debug Description: Enable internal debugging features diff --git a/src/Data/Record/Anon.hs b/src/Data/Record/Anon.hs --- a/src/Data/Record/Anon.hs +++ b/src/Data/Record/Anon.hs @@ -1,6 +1,3 @@ -{-# LANGUAGE ExplicitNamespaces #-} -{-# LANGUAGE PatternSynonyms #-} - -- | Supporting definitions used by both the simple and the advanced interface -- -- To use the anonymous records library, you will want to use either the simple @@ -12,7 +9,7 @@ -- -- > import Data.Record.Anon -- > import Data.Record.Anon.Simple (Record) --- > import qualified Data.Record.Anon.Simple as Anon +-- > import Data.Record.Anon.Simple qualified as Anon -- -- In addition, since the classes and type families defined here as handled by -- the plugin, you will also want to enable that: diff --git a/src/Data/Record/Anon/Advanced.hs b/src/Data/Record/Anon/Advanced.hs --- a/src/Data/Record/Anon/Advanced.hs +++ b/src/Data/Record/Anon/Advanced.hs @@ -1,12 +1,3 @@ -{-# LANGUAGE ConstraintKinds #-} -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE OverloadedLabels #-} -{-# LANGUAGE PolyKinds #-} -{-# LANGUAGE RankNTypes #-} -{-# LANGUAGE TypeApplications #-} -{-# LANGUAGE TypeOperators #-} - -- | Advanced interface (with a functor argument) -- -- See "Data.Record.Anon.Simple" for the simple interface. @@ -16,7 +7,7 @@ -- -- > import Data.Record.Anon -- > import Data.Record.Anon.Advanced (Record) --- > import qualified Data.Record.Anon.Advanced as Anon +-- > import Data.Record.Anon.Advanced qualified as Anon module Data.Record.Anon.Advanced ( Record -- * Construction @@ -67,36 +58,23 @@ -- * Existential records , A.SomeRecord(..) , someRecord - -- * Experimental integration with @typelet@ - -- - -- | - -- The @typelet@ plugin provides support for type sharing. These functions - -- can be used to construct records that result in ghc core that is truly - -- linear in size. - , letRecordT - , letInsertAs - -- ** Supporting definitions - , castEqual ) where import Prelude hiding (sequenceA, map, mapM, pure, zip, zipWith) -import TypeLet (Let, Equal) -import qualified TypeLet - import Data.Record.Anon import Data.Record.Anon.Internal.Advanced (Record) -import qualified Data.Record.Anon.Internal.Advanced as A +import Data.Record.Anon.Internal.Advanced qualified as A -- $setup -- >>> :set -XDataKinds -- >>> :set -XOverloadedLabels -- >>> :set -XTypeOperators --- >>> :set -fplugin=TypeLet -fplugin=Data.Record.Anon.Plugin +-- >>> :set -fplugin=Data.Record.Anon.Plugin -- >>> :set -dppr-cols=200 -- >>> import Prelude hiding (pure) --- >>> import qualified Prelude +-- >>> import Prelude qualified -- >>> import Data.Record.Anon {------------------------------------------------------------------------------- @@ -543,43 +521,3 @@ -- projection check. someRecord :: [(String, Some f)] -> A.SomeRecord f someRecord = A.someRecord - -{------------------------------------------------------------------------------- - Experimental integration with @typelet@ --------------------------------------------------------------------------------} - --- | Introduce type variable for a row --- --- This can be used in conjunction with 'letInsertAs': --- --- >>> :{ --- example :: Record I '[ "a" := Int, "b" := Char, "c" := Bool ] --- example = letRecordT $ \p -> castEqual $ --- letInsertAs p #c (I True) empty $ \xs02 -> --- letInsertAs p #b (I 'X' ) xs02 $ \xs01 -> --- letInsertAs p #a (I 1 ) xs01 $ \xs00 -> --- castEqual xs00 --- :} -letRecordT :: forall r f. - (forall r'. Let r' r => Proxy r' -> Record f r) - -> Record f r -letRecordT f = A.letRecordT f - --- | Insert field into a record and introduce type variable for the result -letInsertAs :: forall r r' f n a. - Proxy r -- ^ Type of the record we are constructing - -> Field n -- ^ New field to be inserted - -> f a -- ^ Value of the new field - -> Record f r' -- ^ Record constructed so far - -> (forall r''. Let r'' (n := a : r') => Record f r'' -> Record f r) - -- ^ Assign type variable to new partial record, and continue - -> Record f r -letInsertAs p n x r f = A.letInsertAs p n x r f - -{------------------------------------------------------------------------------- - Supporting definitions --------------------------------------------------------------------------------} - -castEqual :: Equal a b => a -> b -castEqual = TypeLet.castEqual - diff --git a/src/Data/Record/Anon/Internal/Advanced.hs b/src/Data/Record/Anon/Internal/Advanced.hs --- a/src/Data/Record/Anon/Internal/Advanced.hs +++ b/src/Data/Record/Anon/Internal/Advanced.hs @@ -1,28 +1,9 @@ -{-# LANGUAGE ConstraintKinds #-} -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE GADTs #-} -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE NamedFieldPuns #-} -{-# LANGUAGE PolyKinds #-} -{-# LANGUAGE RankNTypes #-} -{-# LANGUAGE RecordWildCards #-} -{-# LANGUAGE RoleAnnotations #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TypeApplications #-} -{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE TypeOperators #-} -{-# LANGUAGE UndecidableInstances #-} -{-# LANGUAGE ViewPatterns #-} - -- | Full record representation -- -- Intended for qualified import. -- -- > import Data.Record.Anon.Internal.Advanced (Record) --- > import qualified Data.Record.Anon.Internal.Advanced as A +-- > import Data.Record.Anon.Internal.Advanced qualified as A module Data.Record.Anon.Internal.Advanced ( -- * Definition Record -- opaque @@ -74,13 +55,10 @@ , Some(..) , SomeRecord(..) , someRecord - -- * Support for @typelet@ - , letRecordT - , letInsertAs ) where import Prelude hiding (map, mapM, zip, zipWith, sequenceA, pure) -import qualified Prelude +import Prelude qualified import Control.DeepSeq (NFData (..)) import Data.Aeson (ToJSON(..), FromJSON(..)) @@ -96,29 +74,26 @@ import Data.Tagged import GHC.Exts (Any) import GHC.OverloadedLabels +import GHC.Records qualified as Base +import GHC.Records.Compat qualified as RecordHasfield import GHC.TypeLits -import TypeLet.UserAPI - -import qualified Optics.Core as Optics -import qualified GHC.Records as Base -import qualified GHC.Records.Compat as RecordHasfield +import Optics.Core qualified as Optics -import qualified Data.Record.Generic.Eq as Generic -import qualified Data.Record.Generic.JSON as Generic -import qualified Data.Record.Generic.NFData as Generic -import qualified Data.Record.Generic.Show as Generic +import Data.Record.Generic.Eq qualified as Generic +import Data.Record.Generic.JSON qualified as Generic +import Data.Record.Generic.NFData qualified as Generic +import Data.Record.Generic.Show qualified as Generic import Data.Record.Anon.Internal.Core.Canonical (Canonical) +import Data.Record.Anon.Internal.Core.Canonical qualified as Canon import Data.Record.Anon.Internal.Core.Diff (Diff) +import Data.Record.Anon.Internal.Core.Diff qualified as Diff import Data.Record.Anon.Internal.Core.FieldName import Data.Record.Anon.Internal.Reflection (Reflected(..)) +import Data.Record.Anon.Internal.Reflection qualified as Unsafe import Data.Record.Anon.Plugin.Internal.Runtime -import qualified Data.Record.Anon.Internal.Core.Canonical as Canon -import qualified Data.Record.Anon.Internal.Core.Diff as Diff -import qualified Data.Record.Anon.Internal.Reflection as Unsafe - {------------------------------------------------------------------------------- Definition -------------------------------------------------------------------------------} @@ -655,25 +630,3 @@ -> (forall x. c x => f x -> g x -> h x) -> Record f r -> Record g r -> Record h r czipWith p f a b = unI $ czipWithM p (\x y -> I (f x y)) a b - -{------------------------------------------------------------------------------- - Support for @typelet@ --------------------------------------------------------------------------------} - --- | Introduce type variable for a row -letRecordT :: forall r f. - (forall r'. Let r' r => Proxy r' -> Record f r) - -> Record f r -letRecordT f = letT' (Proxy @r) f - --- | Insert field into a record and introduce type variable for the result -letInsertAs :: forall r r' f n a. - Proxy r -- ^ Type of the record we are constructing - -> Field n -- ^ New field to be inserted - -> f a -- ^ Value of the new field - -> Record f r' -- ^ Record constructed so far - -> (forall r''. Let r'' (n := a : r') => Record f r'' -> Record f r) - -- ^ Assign type variable to new partial record, and continue - -> Record f r -letInsertAs _ n x r = letAs' (insert n x r) - diff --git a/src/Data/Record/Anon/Internal/Core/Canonical.hs b/src/Data/Record/Anon/Internal/Core/Canonical.hs --- a/src/Data/Record/Anon/Internal/Core/Canonical.hs +++ b/src/Data/Record/Anon/Internal/Core/Canonical.hs @@ -1,24 +1,11 @@ -{-# LANGUAGE BangPatterns #-} -{-# LANGUAGE CPP #-} -{-# LANGUAGE DerivingStrategies #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE GeneralizedNewtypeDeriving #-} -{-# LANGUAGE KindSignatures #-} -{-# LANGUAGE NamedFieldPuns #-} -{-# LANGUAGE PolyKinds #-} -{-# LANGUAGE RankNTypes #-} -{-# LANGUAGE RecordWildCards #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE StandaloneDeriving #-} -{-# LANGUAGE TypeOperators #-} -{-# LANGUAGE RoleAnnotations #-} +{-# LANGUAGE CPP #-} -- | Canonical gecord (i.e., no diff) -- -- Intended for qualified import. -- -- > import Data.Record.Anonymous.Internal.Canonical (Canonical) --- > import qualified Data.Record.Anonymous.Internal.Canonical as Canon +-- > import Data.Record.Anonymous.Internal.Canonical qualified as Canon module Data.Record.Anon.Internal.Core.Canonical ( Canonical -- opaque -- * Indexed access @@ -48,10 +35,12 @@ ) where import Prelude hiding (map, mapM, zipWith, sequenceA, pure) -import qualified Prelude +import Prelude qualified import Data.Coerce (coerce) +import Data.Foldable qualified as Foldable import Data.Kind +import Data.Primitive (SmallArray) import Data.SOP.BasicFunctors import Data.SOP.Classes (type (-.->)(apFn)) import GHC.Exts (Any) @@ -60,12 +49,8 @@ import Debug.RecoverRTTI (AnythingToString(..)) #endif -import qualified Data.Foldable as Foldable - import Data.Record.Anon.Internal.Util.StrictArray (StrictArray) - -import qualified Data.Record.Anon.Internal.Util.StrictArray as Strict -import Data.Primitive (SmallArray) +import Data.Record.Anon.Internal.Util.StrictArray qualified as Strict {------------------------------------------------------------------------------- Definition diff --git a/src/Data/Record/Anon/Internal/Core/Diff.hs b/src/Data/Record/Anon/Internal/Core/Diff.hs --- a/src/Data/Record/Anon/Internal/Core/Diff.hs +++ b/src/Data/Record/Anon/Internal/Core/Diff.hs @@ -1,18 +1,11 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE PolyKinds #-} -{-# LANGUAGE RankNTypes #-} -{-# LANGUAGE RecordWildCards #-} -{-# LANGUAGE RoleAnnotations #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE CPP #-} -- | Record diff -- -- Intended for qualified import. -- -- > import Data.Record.Anonymous.Internal.Diff (Diff) --- > import qualified Data.Record.Anonymous.Internal.Diff as Diff +-- > import Data.Record.Anonymous.Internal.Diff qualified as Diff module Data.Record.Anon.Internal.Core.Diff ( Diff(..) -- * Incremental construction @@ -29,25 +22,23 @@ ) where import Data.IntMap (IntMap) +import Data.IntMap.Strict qualified as IntMap import Data.Kind import Data.List.NonEmpty (NonEmpty(..), (<|)) +import Data.List.NonEmpty qualified as NE import Data.SOP.BasicFunctors import GHC.Exts (Any) -import qualified Data.IntMap.Strict as IntMap #if DEBUG import Debug.RecoverRTTI (AnythingToString(..)) import Data.Record.Generic.Rep.Internal (noInlineUnsafeCo) #endif -import qualified Data.List.NonEmpty as NE - import Data.Record.Anon.Internal.Core.Canonical (Canonical) +import Data.Record.Anon.Internal.Core.Canonical qualified as Canon import Data.Record.Anon.Internal.Core.FieldName (FieldName) import Data.Record.Anon.Internal.Util.SmallHashMap (SmallHashMap) - -import qualified Data.Record.Anon.Internal.Core.Canonical as Canon -import qualified Data.Record.Anon.Internal.Util.SmallHashMap as HashMap +import Data.Record.Anon.Internal.Util.SmallHashMap qualified as HashMap {------------------------------------------------------------------------------- Definition diff --git a/src/Data/Record/Anon/Internal/Core/FieldName.hs b/src/Data/Record/Anon/Internal/Core/FieldName.hs --- a/src/Data/Record/Anon/Internal/Core/FieldName.hs +++ b/src/Data/Record/Anon/Internal/Core/FieldName.hs @@ -3,7 +3,7 @@ -- Intended for qualified import. -- -- > import Data.Record.Anon.Internal.Core.FieldName (FieldName(..)) --- > import qualified Data.Record.Anon.Internal.Core.FieldName as FieldName +-- > import Data.Record.Anon.Internal.Core.FieldName qualified as FieldName module Data.Record.Anon.Internal.Core.FieldName ( -- * Definition FieldName(..) diff --git a/src/Data/Record/Anon/Internal/Plugin.hs b/src/Data/Record/Anon/Internal/Plugin.hs --- a/src/Data/Record/Anon/Internal/Plugin.hs +++ b/src/Data/Record/Anon/Internal/Plugin.hs @@ -3,8 +3,7 @@ module Data.Record.Anon.Internal.Plugin (plugin) where import GHC.TcPlugin.API - -import qualified GHC.Plugins +import GHC.Plugins qualified import Data.Record.Anon.Internal.Plugin.TC.NameResolution import Data.Record.Anon.Internal.Plugin.TC.Rewriter diff --git a/src/Data/Record/Anon/Internal/Plugin/Source.hs b/src/Data/Record/Anon/Internal/Plugin/Source.hs --- a/src/Data/Record/Anon/Internal/Plugin/Source.hs +++ b/src/Data/Record/Anon/Internal/Plugin/Source.hs @@ -1,9 +1,4 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE NamedFieldPuns #-} -{-# LANGUAGE RecordWildCards #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TupleSections #-} -{-# LANGUAGE ViewPatterns #-} +{-# LANGUAGE CPP #-} module Data.Record.Anon.Internal.Plugin.Source (sourcePlugin) where @@ -90,25 +85,24 @@ -> SrcSpan -> [(FastString, LHsExpr GhcPs)] -> FreshT Hsc (LHsExpr GhcPs) -anonRec Options{typelet, noapply} names@LargeAnonNames{..} l = \fields -> +anonRec Options{noapply} names@LargeAnonNames{..} l = \fields -> applyDiff =<< go fields where go :: [(FastString, LHsExpr GhcPs)] -> FreshT Hsc (LHsExpr GhcPs) go fields | null fields = do return $ mkVar l largeAnon_empty - | not typelet = do - lift $ recordWithoutTypelet names l fields | otherwise = do - p <- freshVar l "p" - fields' <- mapM (\(n, e) -> (n,e,) <$> freshVar l "xs") fields - lift $ recordWithTypelet names l p fields' + lift $ recordWithoutTypelet names l fields applyDiff :: LHsExpr GhcPs -> FreshT Hsc (LHsExpr GhcPs) applyDiff e | noapply = return e | otherwise = return $ mkVar l largeAnon_applyPending `mkHsApp` e +-- | No type-level sharing +-- +-- Support for @typelet@ was dropped in 0.4.0. recordWithoutTypelet :: LargeAnonNames -> SrcSpan @@ -121,50 +115,9 @@ go [] = mkVar l largeAnon_empty go ((n,e):fs) = mkVar l largeAnon_insert `mkHsApps` [mkLabel l n, e, go fs] --- | Experimental support for typelet --- --- See documentation of 'letRecordT' and 'letInsertAs'. -recordWithTypelet :: - LargeAnonNames - -> SrcSpan - -> RdrName -- ^ Fresh var for the proxy - -> [(FastString, LHsExpr GhcPs, RdrName)] -- ^ Fresh var for each insert - -> Hsc (LHsExpr GhcPs) -recordWithTypelet LargeAnonNames{..} l p = \fields -> do - return $ - mkHsApp (mkVar l largeAnon_letRecordT) $ - simpleLam p $ mkHsApp (mkVar l typelet_castEqual) $ - go (mkVar l largeAnon_empty) $ reverse fields - where - go :: - LHsExpr GhcPs - -> [(FastString, LHsExpr GhcPs, RdrName)] - -> LHsExpr GhcPs - go prev [] = mkHsApp (mkVar l typelet_castEqual) prev - go prev ((n,e,x):fs) = mkHsApps (mkVar l largeAnon_letInsertAs) [ - mkVar l p - , mkLabel l n - , e - , prev - , simpleLam x $ go (mkVar l x) fs - ] - where - {------------------------------------------------------------------------------- Auxiliary -------------------------------------------------------------------------------} mkVar :: SrcSpan -> RdrName -> LHsExpr GhcPs mkVar l name = reLocA $ L l $ HsVar defExt (reLocA $ L l name) - --- | Construct simple lambda --- --- Constructs lambda of the form --- --- > \x -> e -simpleLam :: RdrName -> LHsExpr GhcPs -> LHsExpr GhcPs -#if __GLASGOW_HASKELL__ >= 912 -simpleLam x body = mkHsLam (noLocA [nlVarPat x]) body -#else -simpleLam x body = mkHsLam [nlVarPat x] body -#endif diff --git a/src/Data/Record/Anon/Internal/Plugin/Source/FreshT.hs b/src/Data/Record/Anon/Internal/Plugin/Source/FreshT.hs --- a/src/Data/Record/Anon/Internal/Plugin/Source/FreshT.hs +++ b/src/Data/Record/Anon/Internal/Plugin/Source/FreshT.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE GeneralizedNewtypeDeriving #-} - -- | Fresh name generation module Data.Record.Anon.Internal.Plugin.Source.FreshT ( -- * Monad definition diff --git a/src/Data/Record/Anon/Internal/Plugin/Source/GhcShim.hs b/src/Data/Record/Anon/Internal/Plugin/Source/GhcShim.hs --- a/src/Data/Record/Anon/Internal/Plugin/Source/GhcShim.hs +++ b/src/Data/Record/Anon/Internal/Plugin/Source/GhcShim.hs @@ -1,7 +1,4 @@ {-# LANGUAGE CPP #-} -{-# LANGUAGE DisambiguateRecordFields #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE MonoLocalBinds #-} -- | Thin shim around the GHC API -- @@ -142,7 +139,7 @@ import GHC.Types.Name.Cache (NameCache, takeUniqFromNameCache) import GHC.Types.PkgQual (RawPkgQual(NoRawPkgQual)) import GHC.Utils.Error (mkPlainError) -import qualified GHC.Types.Error as Err +import GHC.Types.Error qualified as Err #endif #endif diff --git a/src/Data/Record/Anon/Internal/Plugin/Source/Names.hs b/src/Data/Record/Anon/Internal/Plugin/Source/Names.hs --- a/src/Data/Record/Anon/Internal/Plugin/Source/Names.hs +++ b/src/Data/Record/Anon/Internal/Plugin/Source/Names.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE RecordWildCards #-} - -- | Names used in code generation -- -- Intended for unqualified. @@ -23,9 +21,6 @@ largeAnon_empty :: RdrName , largeAnon_insert :: RdrName , largeAnon_applyPending :: RdrName - , largeAnon_letRecordT :: RdrName - , largeAnon_letInsertAs :: RdrName - , typelet_castEqual :: RdrName } getLargeAnonNames :: Mode -> Hsc LargeAnonNames @@ -35,9 +30,6 @@ largeAnon_empty <- Exact <$> lookupName modl Nothing "empty" largeAnon_insert <- Exact <$> lookupName modl Nothing "insert" largeAnon_applyPending <- Exact <$> lookupName modl Nothing "applyPending" - largeAnon_letRecordT <- Exact <$> lookupName modl Nothing "letRecordT" - largeAnon_letInsertAs <- Exact <$> lookupName modl Nothing "letInsertAs" - typelet_castEqual <- Exact <$> lookupName modl Nothing "castEqual" return LargeAnonNames{..} where modl :: ModuleName diff --git a/src/Data/Record/Anon/Internal/Plugin/Source/Options.hs b/src/Data/Record/Anon/Internal/Plugin/Source/Options.hs --- a/src/Data/Record/Anon/Internal/Plugin/Source/Options.hs +++ b/src/Data/Record/Anon/Internal/Plugin/Source/Options.hs @@ -13,14 +13,12 @@ data Options = Options { debug :: Bool -- ^ Dump generated code - , typelet :: Bool -- ^ Integrate with @typelet@ for truly O(1) coresize , noapply :: Bool -- ^ Omit the call to 'applyDiff' } defaultOptions :: Options defaultOptions = Options { debug = False - , typelet = False , noapply = False } @@ -29,7 +27,6 @@ where aux :: String -> Options -> Options aux "debug" opts = opts { debug = True } - aux "typelet" opts = opts { typelet = True } aux "noapply" opts = opts { noapply = True } aux opt _ = error $ "invalid option: " ++ show opt diff --git a/src/Data/Record/Anon/Internal/Plugin/TC/Constraints/AllFields.hs b/src/Data/Record/Anon/Internal/Plugin/TC/Constraints/AllFields.hs --- a/src/Data/Record/Anon/Internal/Plugin/TC/Constraints/AllFields.hs +++ b/src/Data/Record/Anon/Internal/Plugin/TC/Constraints/AllFields.hs @@ -1,9 +1,3 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE RecordWildCards #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TupleSections #-} - module Data.Record.Anon.Internal.Plugin.TC.Constraints.AllFields ( CAllFields(..) , parseAllFields @@ -13,15 +7,14 @@ import Data.Bifunctor import Data.Void -import Data.Record.Anon.Internal.Plugin.TC.Row.KnownField (KnownField(..)) -import Data.Record.Anon.Internal.Plugin.TC.Row.KnownRow (KnownRow) -import Data.Record.Anon.Internal.Plugin.TC.Row.ParsedRow (Fields) import Data.Record.Anon.Internal.Plugin.TC.GhcTcPluginAPI import Data.Record.Anon.Internal.Plugin.TC.NameResolution import Data.Record.Anon.Internal.Plugin.TC.Parsing - -import qualified Data.Record.Anon.Internal.Plugin.TC.Row.KnownRow as KnownRow -import qualified Data.Record.Anon.Internal.Plugin.TC.Row.ParsedRow as ParsedRow +import Data.Record.Anon.Internal.Plugin.TC.Row.KnownField (KnownField(..)) +import Data.Record.Anon.Internal.Plugin.TC.Row.KnownRow (KnownRow) +import Data.Record.Anon.Internal.Plugin.TC.Row.KnownRow qualified as KnownRow +import Data.Record.Anon.Internal.Plugin.TC.Row.ParsedRow (Fields) +import Data.Record.Anon.Internal.Plugin.TC.Row.ParsedRow qualified as ParsedRow {------------------------------------------------------------------------------- Definition diff --git a/src/Data/Record/Anon/Internal/Plugin/TC/Constraints/KnownFields.hs b/src/Data/Record/Anon/Internal/Plugin/TC/Constraints/KnownFields.hs --- a/src/Data/Record/Anon/Internal/Plugin/TC/Constraints/KnownFields.hs +++ b/src/Data/Record/Anon/Internal/Plugin/TC/Constraints/KnownFields.hs @@ -1,8 +1,3 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE NamedFieldPuns #-} -{-# LANGUAGE RecordWildCards #-} - module Data.Record.Anon.Internal.Plugin.TC.Constraints.KnownFields ( CKnownFields(..) , parseKnownFields @@ -14,12 +9,11 @@ import Data.Record.Anon.Internal.Plugin.TC.GhcTcPluginAPI import Data.Record.Anon.Internal.Plugin.TC.NameResolution import Data.Record.Anon.Internal.Plugin.TC.Parsing +import Data.Record.Anon.Internal.Plugin.TC.Row.KnownField qualified as KnownField import Data.Record.Anon.Internal.Plugin.TC.Row.KnownRow (KnownRow) +import Data.Record.Anon.Internal.Plugin.TC.Row.KnownRow qualified as KnownRow import Data.Record.Anon.Internal.Plugin.TC.Row.ParsedRow (Fields) - -import qualified Data.Record.Anon.Internal.Plugin.TC.Row.KnownField as KnownField -import qualified Data.Record.Anon.Internal.Plugin.TC.Row.KnownRow as KnownRow -import qualified Data.Record.Anon.Internal.Plugin.TC.Row.ParsedRow as ParsedRow +import Data.Record.Anon.Internal.Plugin.TC.Row.ParsedRow qualified as ParsedRow {------------------------------------------------------------------------------- Definition diff --git a/src/Data/Record/Anon/Internal/Plugin/TC/Constraints/KnownHash.hs b/src/Data/Record/Anon/Internal/Plugin/TC/Constraints/KnownHash.hs --- a/src/Data/Record/Anon/Internal/Plugin/TC/Constraints/KnownHash.hs +++ b/src/Data/Record/Anon/Internal/Plugin/TC/Constraints/KnownHash.hs @@ -1,6 +1,3 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE RecordWildCards #-} - module Data.Record.Anon.Internal.Plugin.TC.Constraints.KnownHash ( CKnownHash(..) , parseKnownHash diff --git a/src/Data/Record/Anon/Internal/Plugin/TC/Constraints/RowHasField.hs b/src/Data/Record/Anon/Internal/Plugin/TC/Constraints/RowHasField.hs --- a/src/Data/Record/Anon/Internal/Plugin/TC/Constraints/RowHasField.hs +++ b/src/Data/Record/Anon/Internal/Plugin/TC/Constraints/RowHasField.hs @@ -1,7 +1,3 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE RecordWildCards #-} - module Data.Record.Anon.Internal.Plugin.TC.Constraints.RowHasField ( CRowHasField(..) , parseRowHasField @@ -15,10 +11,9 @@ import Data.Record.Anon.Internal.Plugin.TC.NameResolution import Data.Record.Anon.Internal.Plugin.TC.Parsing import Data.Record.Anon.Internal.Plugin.TC.Row.KnownRow (KnownRowField(..)) +import Data.Record.Anon.Internal.Plugin.TC.Row.KnownRow qualified as KnownRow import Data.Record.Anon.Internal.Plugin.TC.Row.ParsedRow (Fields, FieldLabel(..)) - -import qualified Data.Record.Anon.Internal.Plugin.TC.Row.KnownRow as KnownRow -import qualified Data.Record.Anon.Internal.Plugin.TC.Row.ParsedRow as ParsedRow +import Data.Record.Anon.Internal.Plugin.TC.Row.ParsedRow qualified as ParsedRow {------------------------------------------------------------------------------- Definition diff --git a/src/Data/Record/Anon/Internal/Plugin/TC/Constraints/SubRow.hs b/src/Data/Record/Anon/Internal/Plugin/TC/Constraints/SubRow.hs --- a/src/Data/Record/Anon/Internal/Plugin/TC/Constraints/SubRow.hs +++ b/src/Data/Record/Anon/Internal/Plugin/TC/Constraints/SubRow.hs @@ -1,6 +1,3 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE RecordWildCards #-} - module Data.Record.Anon.Internal.Plugin.TC.Constraints.SubRow ( CSubRow(..) , parseSubRow @@ -15,10 +12,9 @@ import Data.Record.Anon.Internal.Plugin.TC.Parsing import Data.Record.Anon.Internal.Plugin.TC.Row.KnownField (KnownField(..)) import Data.Record.Anon.Internal.Plugin.TC.Row.KnownRow (Source(..), Target (..), KnownRowField(..)) +import Data.Record.Anon.Internal.Plugin.TC.Row.KnownRow qualified as KnownRow import Data.Record.Anon.Internal.Plugin.TC.Row.ParsedRow (Fields) - -import qualified Data.Record.Anon.Internal.Plugin.TC.Row.KnownRow as KnownRow -import qualified Data.Record.Anon.Internal.Plugin.TC.Row.ParsedRow as ParsedRow +import Data.Record.Anon.Internal.Plugin.TC.Row.ParsedRow qualified as ParsedRow {------------------------------------------------------------------------------- Definition diff --git a/src/Data/Record/Anon/Internal/Plugin/TC/EquivClasses.hs b/src/Data/Record/Anon/Internal/Plugin/TC/EquivClasses.hs --- a/src/Data/Record/Anon/Internal/Plugin/TC/EquivClasses.hs +++ b/src/Data/Record/Anon/Internal/Plugin/TC/EquivClasses.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE ScopedTypeVariables #-} - module Data.Record.Anon.Internal.Plugin.TC.EquivClasses ( constructEquivClasses , canonicalize @@ -8,12 +6,11 @@ import Data.Bifunctor import Data.Foldable (toList) import Data.Graph (Graph, Vertex) +import Data.Graph qualified as Graph import Data.Map (Map) +import Data.Map qualified as Map import Data.Set (Set) - -import qualified Data.Graph as Graph -import qualified Data.Map as Map -import qualified Data.Set as Set +import Data.Set qualified as Set -- | Given a set of equivalent pairs, map every value to canonical value -- diff --git a/src/Data/Record/Anon/Internal/Plugin/TC/GhcTcPluginAPI.hs b/src/Data/Record/Anon/Internal/Plugin/TC/GhcTcPluginAPI.hs --- a/src/Data/Record/Anon/Internal/Plugin/TC/GhcTcPluginAPI.hs +++ b/src/Data/Record/Anon/Internal/Plugin/TC/GhcTcPluginAPI.hs @@ -1,10 +1,4 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE RecordWildCards #-} -{-# LANGUAGE UndecidableInstances #-} -{-# LANGUAGE ViewPatterns #-} +{-# LANGUAGE CPP #-} {-# OPTIONS_GHC -Wno-orphans #-} @@ -33,8 +27,13 @@ import GHC.Builtin.Names import GHC.Builtin.Types import GHC.Builtin.Types.Prim -import GHC.Core.Make import GHC.Utils.Outputable + +import GHC.Core.Make ( + mkCoreApps + , mkListExpr + , mkUncheckedIntExpr + ) #if __GLASGOW_HASKELL__ >= 810 && __GLASGOW_HASKELL__ < 900 import Constraint (Ct(..)) diff --git a/src/Data/Record/Anon/Internal/Plugin/TC/NameResolution.hs b/src/Data/Record/Anon/Internal/Plugin/TC/NameResolution.hs --- a/src/Data/Record/Anon/Internal/Plugin/TC/NameResolution.hs +++ b/src/Data/Record/Anon/Internal/Plugin/TC/NameResolution.hs @@ -1,6 +1,3 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE RecordWildCards #-} - module Data.Record.Anon.Internal.Plugin.TC.NameResolution ( ResolvedNames(..) , nameResolution diff --git a/src/Data/Record/Anon/Internal/Plugin/TC/Parsing.hs b/src/Data/Record/Anon/Internal/Plugin/TC/Parsing.hs --- a/src/Data/Record/Anon/Internal/Plugin/TC/Parsing.hs +++ b/src/Data/Record/Anon/Internal/Plugin/TC/Parsing.hs @@ -1,11 +1,6 @@ -{-# LANGUAGE DeriveFunctor #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TupleSections #-} - -- | Generic parsing infrastructure -- -- TODO: Perhaps we could move this (or some form of this) to ghc-tcplugin-api? --- (The @typelet@ package could then use it, too.) module Data.Record.Anon.Internal.Plugin.TC.Parsing ( -- * Basic infrastructure ParseResult(..) diff --git a/src/Data/Record/Anon/Internal/Plugin/TC/Rewriter.hs b/src/Data/Record/Anon/Internal/Plugin/TC/Rewriter.hs --- a/src/Data/Record/Anon/Internal/Plugin/TC/Rewriter.hs +++ b/src/Data/Record/Anon/Internal/Plugin/TC/Rewriter.hs @@ -1,24 +1,26 @@ -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE RecordWildCards #-} -{-# LANGUAGE ViewPatterns #-} -{-# LANGUAGE NamedFieldPuns #-} - module Data.Record.Anon.Internal.Plugin.TC.Rewriter (rewrite) where -import Data.Record.Anon.Internal.Plugin.TC.Row.KnownRow (KnownRow) -import Data.Record.Anon.Internal.Plugin.TC.Row.ParsedRow (Fields) import Data.Record.Anon.Internal.Plugin.TC.GhcTcPluginAPI import Data.Record.Anon.Internal.Plugin.TC.NameResolution +import Data.Record.Anon.Internal.Plugin.TC.Row.KnownField qualified as KnownField +import Data.Record.Anon.Internal.Plugin.TC.Row.KnownRow (KnownRow) +import Data.Record.Anon.Internal.Plugin.TC.Row.KnownRow qualified as KnownRow +import Data.Record.Anon.Internal.Plugin.TC.Row.ParsedRow (Fields) +import Data.Record.Anon.Internal.Plugin.TC.Row.ParsedRow qualified as ParsedRow -import qualified Data.Record.Anon.Internal.Plugin.TC.Row.KnownField as KnownField -import qualified Data.Record.Anon.Internal.Plugin.TC.Row.KnownRow as KnownRow -import qualified Data.Record.Anon.Internal.Plugin.TC.Row.ParsedRow as ParsedRow +{------------------------------------------------------------------------------- + Main API +-------------------------------------------------------------------------------} rewrite :: ResolvedNames -> UniqFM TyCon TcPluginRewriter rewrite rn@ResolvedNames{..} = listToUFM [ (tyConFieldTypes , rewriteRecordMetadataOf tyConFieldTypes rn) , (tyConSimpleFieldTypes , rewriteRecordMetadataOf tyConSimpleFieldTypes rn) ] + +{------------------------------------------------------------------------------- + Internal +-------------------------------------------------------------------------------} data Args = Args { -- | Functor argument, if any diff --git a/src/Data/Record/Anon/Internal/Plugin/TC/Row/KnownField.hs b/src/Data/Record/Anon/Internal/Plugin/TC/Row/KnownField.hs --- a/src/Data/Record/Anon/Internal/Plugin/TC/Row/KnownField.hs +++ b/src/Data/Record/Anon/Internal/Plugin/TC/Row/KnownField.hs @@ -1,15 +1,9 @@ -{-# LANGUAGE DeriveFoldable #-} -{-# LANGUAGE DeriveFunctor #-} -{-# LANGUAGE NamedFieldPuns #-} -{-# LANGUAGE RecordWildCards #-} -{-# LANGUAGE DataKinds #-} - -- | Information about a field in a record -- -- Intended for qualified import -- -- > import Data.Record.Anon.Internal.Plugin.TC.Row.KnownField (KnownField(..)) --- > import qualified Data.Record.Anonymous.Row.Record.KnownField as KnownField +-- > import Data.Record.Anonymous.Row.Record.KnownField qualified as KnownField module Data.Record.Anon.Internal.Plugin.TC.Row.KnownField ( -- * Definition KnownField(..) @@ -21,7 +15,7 @@ ) where import Data.Record.Anon.Internal.Core.FieldName (FieldName(..)) -import qualified Data.Record.Anon.Internal.Core.FieldName as FieldName +import Data.Record.Anon.Internal.Core.FieldName qualified as FieldName import Data.Record.Anon.Internal.Plugin.TC.GhcTcPluginAPI diff --git a/src/Data/Record/Anon/Internal/Plugin/TC/Row/KnownRow.hs b/src/Data/Record/Anon/Internal/Plugin/TC/Row/KnownRow.hs --- a/src/Data/Record/Anon/Internal/Plugin/TC/Row/KnownRow.hs +++ b/src/Data/Record/Anon/Internal/Plugin/TC/Row/KnownRow.hs @@ -1,16 +1,9 @@ -{-# LANGUAGE BangPatterns #-} -{-# LANGUAGE DeriveFoldable #-} -{-# LANGUAGE DeriveFunctor #-} -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE RecordWildCards #-} -{-# LANGUAGE ScopedTypeVariables #-} - -- | Information about a record -- -- Intended for qualified import. -- -- > import Data.Record.Anon.Internal.Plugin.TC.Row.KnownRow (KnownRow(..)) --- > import qualified Data.Record.Anon.Internal.Plugin.TC.Row.KnownRow as KnownRow +-- > import Data.Record.Anon.Internal.Plugin.TC.Row.KnownRow qualified as KnownRow module Data.Record.Anon.Internal.Plugin.TC.Row.KnownRow ( -- * Definition KnownRow(..) @@ -36,7 +29,7 @@ ) where import Prelude hiding (traverse, lookup) -import qualified Prelude +import Prelude qualified import Data.Either (partitionEithers) import Data.List (sortBy) @@ -44,11 +37,10 @@ import Data.Record.Anon.Internal.Core.FieldName (FieldName) import Data.Record.Anon.Internal.Util.SmallHashMap (SmallHashMap) +import Data.Record.Anon.Internal.Util.SmallHashMap qualified as HashMap import Data.Record.Anon.Internal.Plugin.TC.Row.KnownField (KnownField(..)) import Data.Record.Anon.Internal.Plugin.TC.GhcTcPluginAPI - -import qualified Data.Record.Anon.Internal.Util.SmallHashMap as HashMap {------------------------------------------------------------------------------- Definition diff --git a/src/Data/Record/Anon/Internal/Plugin/TC/Row/ParsedRow.hs b/src/Data/Record/Anon/Internal/Plugin/TC/Row/ParsedRow.hs --- a/src/Data/Record/Anon/Internal/Plugin/TC/Row/ParsedRow.hs +++ b/src/Data/Record/Anon/Internal/Plugin/TC/Row/ParsedRow.hs @@ -1,11 +1,9 @@ -{-# LANGUAGE RecordWildCards #-} - -- | Parsed form of a row type in the source -- -- Intended for qualified import. -- -- import Data.Record.Anon.Internal.Plugin.TC.Row.ParsedRow (Fields) --- import qualified Data.Record.Anon.Internal.Plugin.TC.Row.ParsedRow as ParsedRow +-- import Data.Record.Anon.Internal.Plugin.TC.Row.ParsedRow qualified as ParsedRow module Data.Record.Anon.Internal.Plugin.TC.Row.ParsedRow ( -- * Definition Fields -- opaque @@ -24,16 +22,14 @@ import Data.Foldable (asum) import Data.Record.Anon.Internal.Core.FieldName (FieldName) - -import qualified Data.Record.Anon.Internal.Core.FieldName as FieldName +import Data.Record.Anon.Internal.Core.FieldName qualified as FieldName -import Data.Record.Anon.Internal.Plugin.TC.Row.KnownField (KnownField(..)) -import Data.Record.Anon.Internal.Plugin.TC.Row.KnownRow (KnownRow(..), KnownRowField(..)) import Data.Record.Anon.Internal.Plugin.TC.GhcTcPluginAPI import Data.Record.Anon.Internal.Plugin.TC.NameResolution (ResolvedNames(..)) import Data.Record.Anon.Internal.Plugin.TC.Parsing - -import qualified Data.Record.Anon.Internal.Plugin.TC.Row.KnownRow as KnownRow +import Data.Record.Anon.Internal.Plugin.TC.Row.KnownField (KnownField(..)) +import Data.Record.Anon.Internal.Plugin.TC.Row.KnownRow (KnownRow(..), KnownRowField(..)) +import Data.Record.Anon.Internal.Plugin.TC.Row.KnownRow qualified as KnownRow {------------------------------------------------------------------------------- Definition diff --git a/src/Data/Record/Anon/Internal/Plugin/TC/Solver.hs b/src/Data/Record/Anon/Internal/Plugin/TC/Solver.hs --- a/src/Data/Record/Anon/Internal/Plugin/TC/Solver.hs +++ b/src/Data/Record/Anon/Internal/Plugin/TC/Solver.hs @@ -1,6 +1,3 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE RecordWildCards #-} - module Data.Record.Anon.Internal.Plugin.TC.Solver ( solve ) where diff --git a/src/Data/Record/Anon/Internal/Reflection.hs b/src/Data/Record/Anon/Internal/Reflection.hs --- a/src/Data/Record/Anon/Internal/Reflection.hs +++ b/src/Data/Record/Anon/Internal/Reflection.hs @@ -1,13 +1,9 @@ -{-# LANGUAGE ConstraintKinds #-} -{-# LANGUAGE GADTs #-} -{-# LANGUAGE RankNTypes #-} - -- | Low-level reflection utility for internal use. -- -- Intended for qualified import: -- -- > import Data.Record.Anon.Internal.Reflection (Reflected(..)) --- > import qualified Data.Record.Anon.Internal.Reflection as Unsafe +-- > import Data.Record.Anon.Internal.Reflection qualified as Unsafe module Data.Record.Anon.Internal.Reflection ( Reflected(..) , reflectKnownFields diff --git a/src/Data/Record/Anon/Internal/Simple.hs b/src/Data/Record/Anon/Internal/Simple.hs --- a/src/Data/Record/Anon/Internal/Simple.hs +++ b/src/Data/Record/Anon/Internal/Simple.hs @@ -1,18 +1,3 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE KindSignatures #-} -{-# LANGUAGE MonoLocalBinds #-} -{-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE NamedFieldPuns #-} -{-# LANGUAGE RankNTypes #-} -{-# LANGUAGE RecordWildCards #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TypeApplications #-} -{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE TypeOperators #-} -{-# LANGUAGE UndecidableInstances #-} - -- | Simple interface to the anonymous records library -- -- This module defines a type @Record r@ such that, for example, @@ -36,7 +21,7 @@ -- This module is intended for qualified import. -- -- > import Data.Record.Anonymous.Simple (Record) --- > import qualified Data.Record.Anonymous.Simple as Anon +-- > import Data.Record.Anonymous.Simple qualified as Anon module Data.Record.Anon.Internal.Simple ( Record -- opaque -- * Basic API @@ -57,9 +42,6 @@ , toAdvanced , fromAdvanced , sequenceA - -- * Support for @typelet@ - , letRecordT - , letInsertAs ) where import Prelude hiding (sequenceA) @@ -67,6 +49,7 @@ import Control.DeepSeq (NFData(..)) import Data.Aeson (ToJSON(..), FromJSON(..)) import Data.Bifunctor +import Data.Primitive.SmallArray import Data.Record.Generic import Data.Record.Generic.Eq import Data.Record.Generic.JSON @@ -75,19 +58,15 @@ import Data.Tagged import GHC.Exts (Any) import GHC.OverloadedLabels +import GHC.Records qualified as Base +import GHC.Records.Compat qualified as RecordHasfield import GHC.TypeLits -import TypeLet -import Data.Primitive.SmallArray - -import qualified GHC.Records as Base -import qualified GHC.Records.Compat as RecordHasfield -import qualified Optics.Core as Optics +import Optics.Core qualified as Optics import Data.Record.Anon.Plugin.Internal.Runtime import Data.Record.Anon.Internal.Advanced (Field(..)) - -import qualified Data.Record.Anon.Internal.Advanced as A +import Data.Record.Anon.Internal.Advanced qualified as A {------------------------------------------------------------------------------- Definition @@ -277,25 +256,3 @@ instance RecordConstraints r FromJSON => FromJSON (Record r) where parseJSON = gparseJSON - -{------------------------------------------------------------------------------- - Support for @typelet@ --------------------------------------------------------------------------------} - --- | Introduce type variable for a row -letRecordT :: forall r. - (forall r'. Let r' r => Proxy r' -> Record r) - -> Record r -letRecordT f = letT' (Proxy @r) f - --- | Insert field into a record and introduce type variable for the result -letInsertAs :: forall r r' n a. - Proxy r -- ^ Type of the record we are constructing - -> Field n -- ^ New field to be inserted - -> a -- ^ Value of the new field - -> Record r' -- ^ Record constructed so far - -> (forall r''. Let r'' (n := a : r') => Record r'' -> Record r) - -- ^ Assign type variable to new partial record, and continue - -> Record r -letInsertAs _ n x r = letAs' (insert n x r) - diff --git a/src/Data/Record/Anon/Internal/Util/SmallHashMap.hs b/src/Data/Record/Anon/Internal/Util/SmallHashMap.hs --- a/src/Data/Record/Anon/Internal/Util/SmallHashMap.hs +++ b/src/Data/Record/Anon/Internal/Util/SmallHashMap.hs @@ -1,7 +1,4 @@ {-# LANGUAGE CPP #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TupleSections #-} -{-# LANGUAGE TypeApplications #-} -- | Strict hash table designed for small hash tables -- @@ -15,7 +12,7 @@ -- Intended for qualified import. -- -- > import Data.Record.Anon.Internal.Util.SmallHashMap (SmallHashMap) --- > import qualified Data.Record.Anon.Internal.Util.SmallHashMap as HashMap +-- > import Data.Record.Anon.Internal.Util.SmallHashMap qualified as HashMap module Data.Record.Anon.Internal.Util.SmallHashMap ( SmallHashMap -- * Standard operations @@ -37,9 +34,8 @@ import Data.Coerce (coerce) import Data.Hashable (Hashable(hash)) import Data.Map.Strict (Map) +import Data.Map.Strict qualified as Map import Data.Tuple (swap) - -import qualified Data.Map.Strict as Map {------------------------------------------------------------------------------- Wrapper to compare keys based on their hash first diff --git a/src/Data/Record/Anon/Internal/Util/StrictArray.hs b/src/Data/Record/Anon/Internal/Util/StrictArray.hs --- a/src/Data/Record/Anon/Internal/Util/StrictArray.hs +++ b/src/Data/Record/Anon/Internal/Util/StrictArray.hs @@ -1,8 +1,4 @@ -{-# LANGUAGE BangPatterns #-} -{-# LANGUAGE CPP #-} -{-# LANGUAGE DerivingStrategies #-} -{-# LANGUAGE GeneralizedNewtypeDeriving #-} -{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE CPP #-} module Data.Record.Anon.Internal.Util.StrictArray ( StrictArray -- opaque @@ -30,12 +26,11 @@ import Prelude hiding (mapM, zipWith) import Control.Monad (forM_) +import Control.Monad qualified as Monad import Control.Monad.ST +import Data.Foldable qualified as Foldable import Data.Primitive.SmallArray hiding (writeSmallArray, indexSmallArray) - -import qualified Control.Monad as Monad -import qualified Data.Foldable as Foldable -import qualified Data.Primitive.SmallArray as SmallArray +import Data.Primitive.SmallArray qualified as SmallArray #ifdef DEBUG import GHC.Stack diff --git a/src/Data/Record/Anon/Overloading.hs b/src/Data/Record/Anon/Overloading.hs --- a/src/Data/Record/Anon/Overloading.hs +++ b/src/Data/Record/Anon/Overloading.hs @@ -1,7 +1,4 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE PolyKinds #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE CPP #-} -- Not a fan of @AllowAmbiguousTypes@, but no choice here, /must/ be enabled -- to export a 'getField' of the correct type. @@ -29,11 +26,11 @@ , setField ) where -import qualified Control.Arrow -import qualified Data.String -import qualified GHC.OverloadedLabels -import qualified GHC.Records -import qualified GHC.Records.Compat +import Control.Arrow qualified +import Data.String qualified +import GHC.OverloadedLabels qualified +import GHC.Records qualified +import GHC.Records.Compat qualified {------------------------------------------------------------------------------- Other exports diff --git a/src/Data/Record/Anon/Plugin/Internal/Runtime.hs b/src/Data/Record/Anon/Plugin/Internal/Runtime.hs --- a/src/Data/Record/Anon/Plugin/Internal/Runtime.hs +++ b/src/Data/Record/Anon/Plugin/Internal/Runtime.hs @@ -1,15 +1,3 @@ -{-# LANGUAGE ConstraintKinds #-} -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE FunctionalDependencies #-} -{-# LANGUAGE GADTs #-} -{-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE PolyKinds #-} -{-# LANGUAGE RankNTypes #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TypeApplications #-} -{-# LANGUAGE TypeFamilies #-} - -- Since this module is intended for codegen, where we generate explicit type -- arguments anyway, ambiguous types are a non-issue. {-# LANGUAGE AllowAmbiguousTypes #-} diff --git a/src/Data/Record/Anon/Simple.hs b/src/Data/Record/Anon/Simple.hs --- a/src/Data/Record/Anon/Simple.hs +++ b/src/Data/Record/Anon/Simple.hs @@ -1,8 +1,3 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE TypeOperators #-} -{-# LANGUAGE RankNTypes #-} - -- | Simple interface (without a functor argument) -- -- See "Data.Record.Anon.Advanced" for the advanced interface. @@ -12,7 +7,7 @@ -- -- > import Data.Record.Anon -- > import Data.Record.Anon.Simple (Record) --- > import qualified Data.Record.Anon.Simple as Anon +-- > import Data.Record.Anon.Simple qualified as Anon module Data.Record.Anon.Simple ( Record -- * Construction @@ -32,34 +27,21 @@ , toAdvanced , fromAdvanced , sequenceA - -- * Experimental integration with @typelet@ - -- - -- | - -- The @typelet@ plugin provides support for type sharing. These functions - -- can be used to construct records that result in ghc core that is truly - -- linear in size. - , letRecordT - , letInsertAs - -- ** Supporting definitions - , castEqual ) where import Prelude hiding (sequenceA) -import TypeLet (Let, Equal) -import qualified TypeLet - import Data.Record.Anon import Data.Record.Anon.Internal.Simple (Record) -import qualified Data.Record.Anon.Internal.Simple as S -import qualified Data.Record.Anon.Internal.Advanced as A +import Data.Record.Anon.Internal.Simple qualified as S +import Data.Record.Anon.Internal.Advanced qualified as A -- $setup -- >>> :set -XDataKinds -- >>> :set -XOverloadedLabels -- >>> :set -XTypeOperators --- >>> :set -fplugin=TypeLet -fplugin=Data.Record.Anon.Plugin +-- >>> :set -fplugin=Data.Record.Anon.Plugin -- >>> :set -dppr-cols=200 -- >>> import Data.Record.Anon @@ -245,43 +227,3 @@ -- | Sequence all actions sequenceA :: Applicative m => A.Record m r -> m (Record r) sequenceA = S.sequenceA - -{------------------------------------------------------------------------------- - Experimental integration with @typelet@ --------------------------------------------------------------------------------} - --- | Introduce type variable for a row --- --- This can be used in conjunction with 'letInsertAs': --- --- >>> :{ --- example :: Record '[ "a" := Int, "b" := Char, "c" := Bool ] --- example = letRecordT $ \p -> castEqual $ --- letInsertAs p #c True empty $ \xs02 -> --- letInsertAs p #b 'X' xs02 $ \xs01 -> --- letInsertAs p #a 1 xs01 $ \xs00 -> --- castEqual xs00 --- :} -letRecordT :: forall r. - (forall r'. Let r' r => Proxy r' -> Record r) - -> Record r -letRecordT f = S.letRecordT f - --- | Insert field into a record and introduce type variable for the result -letInsertAs :: forall r r' n a. - Proxy r -- ^ Type of the record we are constructing - -> Field n -- ^ New field to be inserted - -> a -- ^ Value of the new field - -> Record r' -- ^ Record constructed so far - -> (forall r''. Let r'' (n := a : r') => Record r'' -> Record r) - -- ^ Assign type variable to new partial record, and continue - -> Record r -letInsertAs p n x r f = S.letInsertAs p n x r f - -{------------------------------------------------------------------------------- - Supporting definitions --------------------------------------------------------------------------------} - -castEqual :: Equal a b => a -> b -castEqual = TypeLet.castEqual - diff --git a/test/Test/Infra/Discovery.hs b/test/Test/Infra/Discovery.hs --- a/test/Test/Infra/Discovery.hs +++ b/test/Test/Infra/Discovery.hs @@ -1,12 +1,3 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE GADTs #-} -{-# LANGUAGE KindSignatures #-} -{-# LANGUAGE PolyKinds #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TypeApplications #-} -{-# LANGUAGE TypeOperators #-} - module Test.Infra.Discovery ( -- * Intersect rows InBothRows(..) @@ -26,6 +17,7 @@ , pairSnd ) where +import Control.Monad.State (State, runState, state) import Data.Kind import Data.Maybe (catMaybes) import Data.Typeable @@ -33,8 +25,7 @@ import Data.Record.Anon import Data.Record.Anon.Advanced (Record, InRow(InRow)) -import qualified Data.Record.Anon.Advanced as Anon -import Control.Monad.State +import Data.Record.Anon.Advanced qualified as Anon {------------------------------------------------------------------------------- Intersect rows diff --git a/test/Test/Infra/DynRecord.hs b/test/Test/Infra/DynRecord.hs --- a/test/Test/Infra/DynRecord.hs +++ b/test/Test/Infra/DynRecord.hs @@ -1,12 +1,3 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE KindSignatures #-} -{-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE PolyKinds #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TypeApplications #-} -{-# LANGUAGE GADTs #-} - -- | Simple dynamic record type, for testing purposes only module Test.Infra.DynRecord ( -- * Definition @@ -21,7 +12,7 @@ import Data.Record.Anon import Data.Record.Anon.Advanced (Record) -import qualified Data.Record.Anon.Advanced as Anon +import Data.Record.Anon.Advanced qualified as Anon {------------------------------------------------------------------------------- Definition diff --git a/test/Test/Infra/DynRecord/Advanced.hs b/test/Test/Infra/DynRecord/Advanced.hs --- a/test/Test/Infra/DynRecord/Advanced.hs +++ b/test/Test/Infra/DynRecord/Advanced.hs @@ -1,18 +1,8 @@ -{-# LANGUAGE ConstraintKinds #-} -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE GADTs #-} -{-# LANGUAGE KindSignatures #-} -{-# LANGUAGE PolyKinds #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE StandaloneDeriving #-} -{-# LANGUAGE TypeApplications #-} - -- | 'DynRecord' interop with the advanced record API. -- -- Intended for qualified import -- --- > import qualified Test.Infra.DynRecord.Advanced as Dyn +-- > import Test.Infra.DynRecord.Advanced qualified as Dyn module Test.Infra.DynRecord.Advanced ( -- * Type inference ValidField(..) @@ -32,7 +22,7 @@ import Data.Record.Anon import Data.Record.Anon.Advanced (Record) -import qualified Data.Record.Anon.Advanced as Anon +import Data.Record.Anon.Advanced qualified as Anon import Test.Infra.Discovery import Test.Infra.DynRecord diff --git a/test/Test/Infra/DynRecord/Simple.hs b/test/Test/Infra/DynRecord/Simple.hs --- a/test/Test/Infra/DynRecord/Simple.hs +++ b/test/Test/Infra/DynRecord/Simple.hs @@ -1,15 +1,8 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE GADTs #-} -{-# LANGUAGE KindSignatures #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE StandaloneDeriving #-} - -- | 'DynRecord' interop with the simple record API. -- -- Intended for qualified import. -- --- > import qualified Test.Infra.DynRecord.Simple as Dyn +-- > import Test.Infra.DynRecord.Simple qualified as Dyn module Test.Infra.DynRecord.Simple ( -- * Type inference ValidField(..) @@ -25,10 +18,9 @@ import Data.Typeable import Data.Record.Anon +import Data.Record.Anon.Advanced qualified as A import Data.Record.Anon.Simple (Record) - -import qualified Data.Record.Anon.Advanced as A -import qualified Data.Record.Anon.Simple as S +import Data.Record.Anon.Simple qualified as S import Test.Infra.Discovery import Test.Infra.DynRecord diff --git a/test/Test/Infra/Generics.hs b/test/Test/Infra/Generics.hs --- a/test/Test/Infra/Generics.hs +++ b/test/Test/Infra/Generics.hs @@ -1,10 +1,3 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE GADTs #-} -{-# LANGUAGE KindSignatures #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TypeApplications #-} - -- | Additional generic functions used in tests module Test.Infra.Generics ( describeRecord @@ -18,7 +11,7 @@ import Data.Typeable import GHC.TypeLits -import qualified Data.Record.Generic.Rep as Rep +import Data.Record.Generic.Rep qualified as Rep import Data.Record.Anon import Data.Record.Anon.Advanced (Record) diff --git a/test/Test/Infra/MarkStrictness.hs b/test/Test/Infra/MarkStrictness.hs --- a/test/Test/Infra/MarkStrictness.hs +++ b/test/Test/Infra/MarkStrictness.hs @@ -1,10 +1,3 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE GADTs #-} -{-# LANGUAGE KindSignatures #-} -{-# LANGUAGE MultiParamTypeClasses #-} - -- | Proof of concept: mark strictness at the type-level -- -- This is an illustration of how to take advantage of the polykinded nature of diff --git a/test/Test/Prop/Record/Combinators/Constrained.hs b/test/Test/Prop/Record/Combinators/Constrained.hs --- a/test/Test/Prop/Record/Combinators/Constrained.hs +++ b/test/Test/Prop/Record/Combinators/Constrained.hs @@ -1,7 +1,3 @@ -{-# LANGUAGE RankNTypes #-} -{-# LANGUAGE TupleSections #-} -{-# LANGUAGE TypeApplications #-} - module Test.Prop.Record.Combinators.Constrained (tests) where import Control.Monad.ST @@ -10,15 +6,14 @@ import Data.SOP.BasicFunctors import Data.STRef -import qualified Data.Record.Anon.Advanced as Anon +import Data.Record.Anon.Advanced qualified as Anon import Test.Tasty import Test.Tasty.QuickCheck import Test.Prop.Record.Model.Orphans () import Test.Prop.Record.Model.Generator - -import qualified Test.Prop.Record.Model as Modl +import Test.Prop.Record.Model qualified as Modl tests :: TestTree tests = testGroup "Test.Prop.Record.Combinators.Constrained" [ diff --git a/test/Test/Prop/Record/Combinators/Simple.hs b/test/Test/Prop/Record/Combinators/Simple.hs --- a/test/Test/Prop/Record/Combinators/Simple.hs +++ b/test/Test/Prop/Record/Combinators/Simple.hs @@ -1,26 +1,18 @@ -{-# LANGUAGE DeriveFunctor #-} -{-# LANGUAGE GADTs #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TypeApplications #-} -{-# LANGUAGE TypeOperators #-} -{-# LANGUAGE ViewPatterns #-} - module Test.Prop.Record.Combinators.Simple (tests) where import Control.Monad.State import Data.Bifunctor import Data.SOP -import qualified Data.Record.Anon as Anon -import qualified Data.Record.Anon.Advanced as Anon +import Data.Record.Anon qualified as Anon +import Data.Record.Anon.Advanced qualified as Anon import Test.Tasty import Test.Tasty.QuickCheck import Test.Prop.Record.Model.Orphans () import Test.Prop.Record.Model.Generator - -import qualified Test.Prop.Record.Model as Modl +import Test.Prop.Record.Model qualified as Modl tests :: TestTree tests = testGroup "Test.Prop.Record.Combinators.Simple" [ diff --git a/test/Test/Prop/Record/Diff.hs b/test/Test/Prop/Record/Diff.hs --- a/test/Test/Prop/Record/Diff.hs +++ b/test/Test/Prop/Record/Diff.hs @@ -1,15 +1,4 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE EmptyCase #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE GADTs #-} -{-# LANGUAGE KindSignatures #-} -{-# LANGUAGE OverloadedLabels #-} -{-# LANGUAGE RankNTypes #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE StandaloneDeriving #-} -{-# LANGUAGE TypeApplications #-} -{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE OverloadedLabels #-} {-# OPTIONS_GHC -fplugin=Data.Record.Anon.Plugin #-} @@ -17,6 +6,7 @@ import Data.Kind import Data.Map (Map) +import Data.Map qualified as Map import Data.SOP import Data.Type.Equality import GHC.TypeLits @@ -24,11 +14,9 @@ import Test.Tasty hiding (after) import Test.Tasty.QuickCheck -import qualified Data.Map as Map - import Data.Record.Anon import Data.Record.Anon.Advanced (Record) -import qualified Data.Record.Anon.Advanced as Anon +import Data.Record.Anon.Advanced qualified as Anon {------------------------------------------------------------------------------- Abstraction over the 'Diff' operations diff --git a/test/Test/Prop/Record/Model.hs b/test/Test/Prop/Record/Model.hs --- a/test/Test/Prop/Record/Model.hs +++ b/test/Test/Prop/Record/Model.hs @@ -1,19 +1,4 @@ -{-# LANGUAGE ConstraintKinds #-} -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE ExplicitNamespaces #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE GADTs #-} -{-# LANGUAGE KindSignatures #-} -{-# LANGUAGE OverloadedLabels #-} -{-# LANGUAGE PolyKinds #-} -{-# LANGUAGE RankNTypes #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE StandaloneDeriving #-} -{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE TypeOperators #-} -{-# LANGUAGE UndecidableInstances #-} -{-# LANGUAGE UndecidableSuperClasses #-} +{-# LANGUAGE OverloadedLabels #-} {-# OPTIONS_GHC -fplugin=Data.Record.Anon.Plugin #-} @@ -25,7 +10,7 @@ -- Intended for qualified import. -- -- > import Test.Prop.Model (ModelRecord(..), ModelFields(..)) --- > import qualified Test.Prop.Model as Model +-- > import Test.Prop.Model qualified as Model module Test.Prop.Record.Model ( -- * Model proper ModelFields(..) @@ -66,13 +51,11 @@ import Data.Functor.Product import Data.Kind import Data.SOP (NP(..), SListI, All) - -import qualified Data.SOP as SOP +import Data.SOP qualified as SOP import Data.Record.Anon import Data.Record.Anon.Advanced (Record) - -import qualified Data.Record.Anon.Advanced as Anon +import Data.Record.Anon.Advanced qualified as Anon {------------------------------------------------------------------------------- Model proper diff --git a/test/Test/Prop/Record/Model/Generator.hs b/test/Test/Prop/Record/Model/Generator.hs --- a/test/Test/Prop/Record/Model/Generator.hs +++ b/test/Test/Prop/Record/Model/Generator.hs @@ -1,19 +1,5 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE GADTs #-} -{-# LANGUAGE KindSignatures #-} -{-# LANGUAGE PolyKinds #-} -{-# LANGUAGE RankNTypes #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE StandaloneDeriving #-} -{-# LANGUAGE TypeApplications #-} -{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE TypeOperators #-} -{-# LANGUAGE UndecidableInstances #-} - {-# OPTIONS_GHC -fplugin=Data.Record.Anon.Plugin #-} -{-# OPTIONS -Wno-orphans #-} +{-# OPTIONS_GHC -Wno-orphans #-} module Test.Prop.Record.Model.Generator ( -- * Existential wrapper around 'ModelRecord' that hides the record shape @@ -50,7 +36,7 @@ , Types ) -import qualified Test.Prop.Record.Model as Model +import Test.Prop.Record.Model qualified as Model {------------------------------------------------------------------------------- Existential wrapper around 'ModelRecord' that hides the record shape diff --git a/test/Test/Sanity/AllFields.hs b/test/Test/Sanity/AllFields.hs --- a/test/Test/Sanity/AllFields.hs +++ b/test/Test/Sanity/AllFields.hs @@ -1,7 +1,4 @@ -{-# LANGUAGE DataKinds #-} {-# LANGUAGE OverloadedLabels #-} -{-# LANGUAGE TypeApplications #-} -{-# LANGUAGE TypeOperators #-} {-# OPTIONS_GHC -fplugin=Data.Record.Anon.Plugin #-} @@ -13,7 +10,7 @@ import Data.Record.Anon import Data.Record.Anon.Advanced (Record) -import qualified Data.Record.Anon.Advanced as Anon +import Data.Record.Anon.Advanced qualified as Anon import Test.Tasty import Test.Tasty.HUnit diff --git a/test/Test/Sanity/Applicative.hs b/test/Test/Sanity/Applicative.hs --- a/test/Test/Sanity/Applicative.hs +++ b/test/Test/Sanity/Applicative.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE TypeOperators #-} {-# LANGUAGE OverloadedLabels #-} {-# OPTIONS_GHC -fplugin=Data.Record.Anon.Plugin #-} @@ -10,7 +8,7 @@ import Data.Record.Anon import Data.Record.Anon.Simple (Record) -import qualified Data.Record.Anon.Simple as Anon +import Data.Record.Anon.Simple qualified as Anon import Test.Tasty import Test.Tasty.HUnit diff --git a/test/Test/Sanity/BlogPost.hs b/test/Test/Sanity/BlogPost.hs --- a/test/Test/Sanity/BlogPost.hs +++ b/test/Test/Sanity/BlogPost.hs @@ -1,17 +1,6 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE GADTs #-} -{-# LANGUAGE KindSignatures #-} -{-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE OverloadedLabels #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE PolyKinds #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TypeApplications #-} -{-# LANGUAGE TypeOperators #-} -{-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE OverloadedLabels #-} +{-# LANGUAGE OverloadedStrings #-} #if defined(NO_RECORD_DOT_PREPROCESSOR) @@ -49,31 +38,29 @@ ) where import Data.Aeson (ToJSON(..), Value) +import Data.Aeson qualified as Aeson +import Data.Aeson.Encode.Pretty qualified as Aeson.Pretty import Data.Bifunctor +import Data.ByteString.Lazy qualified as Lazy (ByteString) +import Data.ByteString.Lazy.Char8 qualified as Lazy.BS.C8 import Data.Function (on) import Data.Kind import Data.Maybe import Data.SOP (fn_3) import Data.String +import Data.Text qualified as Text import Data.Type.Equality import GHC.TypeLits import Optics.Core (over) import Text.Parsec (Parsec, ParseError) +import Text.Parsec qualified as Parsec import Text.Read (readMaybe) -import qualified Data.Aeson as Aeson -import qualified Data.Aeson.Encode.Pretty as Aeson.Pretty -import qualified Data.ByteString.Lazy as Lazy (ByteString) -import qualified Data.ByteString.Lazy.Char8 as Lazy.BS.C8 -import qualified Data.Text as Text -import qualified Text.Parsec as Parsec - import Data.Record.Anon -import Data.Record.Anon.Simple (Record) import Data.Record.Anon.Advanced (InRow(..)) - -import qualified Data.Record.Anon.Advanced as A -import qualified Data.Record.Anon.Simple as S +import Data.Record.Anon.Advanced qualified as A +import Data.Record.Anon.Simple (Record) +import Data.Record.Anon.Simple qualified as S import Test.Tasty import Test.Tasty.HUnit diff --git a/test/Test/Sanity/CheckIsSubRow.hs b/test/Test/Sanity/CheckIsSubRow.hs --- a/test/Test/Sanity/CheckIsSubRow.hs +++ b/test/Test/Sanity/CheckIsSubRow.hs @@ -1,7 +1,3 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE TypeApplications #-} -{-# LANGUAGE TypeOperators #-} - {-# OPTIONS_GHC -fplugin=Data.Record.Anon.Plugin #-} module Test.Sanity.CheckIsSubRow (tests) where diff --git a/test/Test/Sanity/Discovery.hs b/test/Test/Sanity/Discovery.hs --- a/test/Test/Sanity/Discovery.hs +++ b/test/Test/Sanity/Discovery.hs @@ -1,8 +1,4 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE OverloadedLabels #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE TypeApplications #-} -{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE OverloadedLabels #-} {-# OPTIONS_GHC -fplugin=Data.Record.Anon.Plugin #-} @@ -12,9 +8,8 @@ import Data.Record.Generic import Data.Record.Anon - -import qualified Data.Record.Anon.Simple as S -import qualified Data.Record.Anon.Advanced as A +import Data.Record.Anon.Advanced qualified as A +import Data.Record.Anon.Simple qualified as S import Test.Tasty import Test.Tasty.HUnit @@ -23,8 +18,8 @@ import Test.Infra.DynRecord import Test.Infra.MarkStrictness -import qualified Test.Infra.DynRecord.Simple as Dyn.S -import qualified Test.Infra.DynRecord.Advanced as Dyn.A +import Test.Infra.DynRecord.Simple qualified as Dyn.S +import Test.Infra.DynRecord.Advanced qualified as Dyn.A {------------------------------------------------------------------------------- Tests proper diff --git a/test/Test/Sanity/DuplicateFields.hs b/test/Test/Sanity/DuplicateFields.hs --- a/test/Test/Sanity/DuplicateFields.hs +++ b/test/Test/Sanity/DuplicateFields.hs @@ -1,9 +1,4 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE MonoLocalBinds #-} {-# LANGUAGE OverloadedLabels #-} -{-# LANGUAGE TypeApplications #-} -{-# LANGUAGE TypeOperators #-} {-# OPTIONS_GHC -fplugin=Data.Record.Anon.Plugin #-} @@ -18,7 +13,7 @@ import Data.Record.Anon import Data.Record.Anon.Advanced (Record) -import qualified Data.Record.Anon.Advanced as Anon +import Data.Record.Anon.Advanced qualified as Anon import Test.Infra.Generics diff --git a/test/Test/Sanity/Generics.hs b/test/Test/Sanity/Generics.hs --- a/test/Test/Sanity/Generics.hs +++ b/test/Test/Sanity/Generics.hs @@ -1,7 +1,4 @@ -{-# LANGUAGE DataKinds #-} {-# LANGUAGE OverloadedLabels #-} -{-# LANGUAGE TypeApplications #-} -{-# LANGUAGE TypeOperators #-} {-# OPTIONS_GHC -fplugin=Data.Record.Anon.Plugin #-} {-# OPTIONS_GHC -Wno-orphans #-} -- for the ToJSON/FromJSON instances @@ -13,15 +10,15 @@ import Data.Record.Anon import Data.Record.Anon.Advanced (Record) -import qualified Data.Record.Anon.Advanced as Anon +import Data.Record.Anon.Advanced qualified as Anon import Test.Tasty import Test.Tasty.HUnit import Test.Infra.Generics -import qualified Test.Sanity.Named.Record1 as R1 -import qualified Test.Sanity.Named.Record2 as R2 +import Test.Sanity.Named.Record1 qualified as R1 +import Test.Sanity.Named.Record2 qualified as R2 -- add test with non-I functor diff --git a/test/Test/Sanity/HasField.hs b/test/Test/Sanity/HasField.hs --- a/test/Test/Sanity/HasField.hs +++ b/test/Test/Sanity/HasField.hs @@ -1,7 +1,4 @@ -{-# LANGUAGE DataKinds #-} {-# LANGUAGE OverloadedLabels #-} -{-# LANGUAGE TypeApplications #-} -{-# LANGUAGE TypeOperators #-} {-# OPTIONS_GHC -fplugin=Data.Record.Anon.Plugin #-} @@ -9,7 +6,7 @@ import Data.Record.Anon import Data.Record.Anon.Advanced (Record) -import qualified Data.Record.Anon.Advanced as Anon +import Data.Record.Anon.Advanced qualified as Anon import Test.Tasty import Test.Tasty.HUnit diff --git a/test/Test/Sanity/Intersection.hs b/test/Test/Sanity/Intersection.hs --- a/test/Test/Sanity/Intersection.hs +++ b/test/Test/Sanity/Intersection.hs @@ -1,8 +1,3 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TypeOperators #-} - {-# OPTIONS_GHC -fplugin=Data.Record.Anon.Plugin #-} module Test.Sanity.Intersection (tests) where @@ -11,7 +6,7 @@ import Data.Record.Anon import Data.Record.Anon.Advanced (Record) -import qualified Data.Record.Anon.Advanced as Anon +import Data.Record.Anon.Advanced qualified as Anon import Test.Tasty import Test.Tasty.HUnit diff --git a/test/Test/Sanity/Merging.hs b/test/Test/Sanity/Merging.hs --- a/test/Test/Sanity/Merging.hs +++ b/test/Test/Sanity/Merging.hs @@ -1,9 +1,6 @@ -{-# LANGUAGE DataKinds #-} {-# LANGUAGE OverloadedLabels #-} -{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE TypeOperators #-} -{-# OPTIONS_GHC -Wno-redundant-constraints #-} +{-# OPTIONS_GHC -Wno-redundant-constraints #-} {-# OPTIONS_GHC -fplugin=Data.Record.Anon.Plugin #-} module Test.Sanity.Merging (tests) where @@ -15,7 +12,7 @@ import Data.Record.Anon import Data.Record.Anon.Advanced (Record) -import qualified Data.Record.Anon.Advanced as Anon +import Data.Record.Anon.Advanced qualified as Anon tests :: TestTree tests = testGroup "Test.Sanity.Merging" [ diff --git a/test/Test/Sanity/Named/Record1.hs b/test/Test/Sanity/Named/Record1.hs --- a/test/Test/Sanity/Named/Record1.hs +++ b/test/Test/Sanity/Named/Record1.hs @@ -1,6 +1,3 @@ -{-# LANGUAGE StandaloneDeriving #-} -{-# LANGUAGE UndecidableInstances #-} - module Test.Sanity.Named.Record1 ( Record(..) ) where diff --git a/test/Test/Sanity/Named/Record2.hs b/test/Test/Sanity/Named/Record2.hs --- a/test/Test/Sanity/Named/Record2.hs +++ b/test/Test/Sanity/Named/Record2.hs @@ -1,6 +1,3 @@ -{-# LANGUAGE StandaloneDeriving #-} -{-# LANGUAGE UndecidableInstances #-} - module Test.Sanity.Named.Record2 ( Record(..) ) where diff --git a/test/Test/Sanity/OverloadedRecordDot.hs b/test/Test/Sanity/OverloadedRecordDot.hs --- a/test/Test/Sanity/OverloadedRecordDot.hs +++ b/test/Test/Sanity/OverloadedRecordDot.hs @@ -1,4 +1,5 @@ -{-# LANGUAGE CPP #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE OverloadedRecordDot #-} #if __GLASGOW_HASKELL__ < 902 @@ -14,10 +15,6 @@ #else -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE OverloadedRecordDot #-} -{-# LANGUAGE TypeOperators #-} - {-# OPTIONS_GHC -fplugin=Data.Record.Anon.Plugin #-} module Test.Sanity.OverloadedRecordDot (tests) where @@ -26,9 +23,8 @@ import Test.Tasty.HUnit import Data.Record.Anon - -import qualified Data.Record.Anon.Simple as S -import qualified Data.Record.Anon.Advanced as A +import Data.Record.Anon.Advanced qualified as A +import Data.Record.Anon.Simple qualified as S tests :: TestTree tests = testGroup "Test.Sanity.OverloadedRecordDot" [ diff --git a/test/Test/Sanity/OverloadedRecordUpdate.hs b/test/Test/Sanity/OverloadedRecordUpdate.hs --- a/test/Test/Sanity/OverloadedRecordUpdate.hs +++ b/test/Test/Sanity/OverloadedRecordUpdate.hs @@ -1,4 +1,7 @@ -{-# LANGUAGE CPP #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE OverloadedRecordDot #-} +{-# LANGUAGE OverloadedRecordUpdate #-} +{-# LANGUAGE RebindableSyntax #-} #if __GLASGOW_HASKELL__ < 902 @@ -14,13 +17,6 @@ #else -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE NamedFieldPuns #-} -{-# LANGUAGE OverloadedRecordDot #-} -{-# LANGUAGE OverloadedRecordUpdate #-} -{-# LANGUAGE RebindableSyntax #-} -{-# LANGUAGE TypeOperators #-} - {-# OPTIONS_GHC -fplugin=Data.Record.Anon.Plugin #-} module Test.Sanity.OverloadedRecordUpdate (tests) where @@ -29,10 +25,9 @@ import Test.Tasty.HUnit import Data.Record.Anon +import Data.Record.Anon.Advanced qualified as A import Data.Record.Anon.Overloading - -import qualified Data.Record.Anon.Simple as S -import qualified Data.Record.Anon.Advanced as A +import Data.Record.Anon.Simple qualified as S tests :: TestTree tests = testGroup "Test.Sanity.OverloadedRecordUpdate" [ diff --git a/test/Test/Sanity/PolyKinds.hs b/test/Test/Sanity/PolyKinds.hs --- a/test/Test/Sanity/PolyKinds.hs +++ b/test/Test/Sanity/PolyKinds.hs @@ -1,6 +1,4 @@ -{-# LANGUAGE DataKinds #-} {-# LANGUAGE OverloadedLabels #-} -{-# LANGUAGE TypeOperators #-} {-# OPTIONS_GHC -fplugin=Data.Record.Anon.Plugin #-} @@ -8,7 +6,7 @@ import Data.Record.Anon import Data.Record.Anon.Advanced (Record) -import qualified Data.Record.Anon.Advanced as Anon +import Data.Record.Anon.Advanced qualified as Anon import Test.Tasty import Test.Tasty.HUnit diff --git a/test/Test/Sanity/RebindableSyntax/Tests.hs b/test/Test/Sanity/RebindableSyntax/Tests.hs --- a/test/Test/Sanity/RebindableSyntax/Tests.hs +++ b/test/Test/Sanity/RebindableSyntax/Tests.hs @@ -1,14 +1,9 @@ -{-# LANGUAGE Arrows #-} -{-# LANGUAGE CPP #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE NPlusKPatterns #-} -{-# LANGUAGE OverloadedLabels #-} -{-# LANGUAGE OverloadedLists #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TypeApplications #-} -{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE Arrows #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE NPlusKPatterns #-} +{-# LANGUAGE OverloadedLabels #-} +{-# LANGUAGE OverloadedLists #-} +{-# LANGUAGE OverloadedStrings #-} #ifdef REBINDABLE_SYNTAX {-# LANGUAGE RebindableSyntax #-} @@ -22,14 +17,13 @@ import Control.Arrow.Transformer.Stream (StreamArrow (..)) import Control.Monad (guard) import Data.Proxy +import Data.Stream qualified as Stream import Data.Text (Text) import GHC.Exts (IsList(..)) import GHC.OverloadedLabels (IsLabel(..)) import GHC.TypeLits (KnownSymbol, symbolVal) import Test.Tasty import Test.Tasty.HUnit - -import qualified Data.Stream as Stream #ifdef REBINDABLE_SYNTAX import Data.Record.Anon.Overloading diff --git a/test/Test/Sanity/RecordLens.hs b/test/Test/Sanity/RecordLens.hs --- a/test/Test/Sanity/RecordLens.hs +++ b/test/Test/Sanity/RecordLens.hs @@ -1,6 +1,4 @@ -{-# LANGUAGE DataKinds #-} {-# LANGUAGE OverloadedLabels #-} -{-# LANGUAGE TypeOperators #-} {-# OPTIONS_GHC -fplugin=Data.Record.Anon.Plugin #-} @@ -11,7 +9,7 @@ import Data.Record.Anon import Data.Record.Anon.Advanced (Record) -import qualified Data.Record.Anon.Advanced as Anon +import Data.Record.Anon.Advanced qualified as Anon tests :: TestTree tests = testGroup "Test.Sanity.RecordLens" [ diff --git a/test/Test/Sanity/Simple.hs b/test/Test/Sanity/Simple.hs --- a/test/Test/Sanity/Simple.hs +++ b/test/Test/Sanity/Simple.hs @@ -1,6 +1,4 @@ -{-# LANGUAGE DataKinds #-} {-# LANGUAGE OverloadedLabels #-} -{-# LANGUAGE TypeOperators #-} {-# OPTIONS_GHC -fplugin=Data.Record.Anon.Plugin #-} @@ -15,8 +13,7 @@ import Data.Record.Anon import Data.Record.Anon.Simple (Record) - -import qualified Data.Record.Anon.Simple as Anon +import Data.Record.Anon.Simple qualified as Anon tests :: TestTree tests = testGroup "Test.Sanity.Simple" [ diff --git a/test/Test/Sanity/SrcPlugin.hs b/test/Test/Sanity/SrcPlugin.hs new file mode 100644 --- /dev/null +++ b/test/Test/Sanity/SrcPlugin.hs @@ -0,0 +1,92 @@ +{-# LANGUAGE OverloadedLabels #-} + +{-# OPTIONS_GHC -fplugin=Data.Record.Anon.Plugin #-} +-- {-# OPTIONS_GHC -fplugin-opt=Data.Record.Anon.Plugin:debug #-} +-- {-# OPTIONS_GHC -fplugin-opt=Data.Record.Anon.Plugin:noapply #-} + +module Test.Sanity.SrcPlugin (tests) where + +import Data.SOP.BasicFunctors + +import Data.Record.Anon +import Data.Record.Anon.Advanced qualified as A +import Data.Record.Anon.Simple qualified as S + +import Test.Tasty +import Test.Tasty.HUnit + +{------------------------------------------------------------------------------- + Tests proper +-------------------------------------------------------------------------------} + +tests :: TestTree +tests = testGroup "Test.Sanity.SrcPlugin" [ + testCase "simple" test_simple + , testCase "advanced" test_advanced + ] + +test_simple :: Assertion +test_simple = do + assertEqual "inorder" expected $ example_simple + assertEqual "reordered" expected $ example_simple_reordered + where + expected :: S.Record '[ "a" := Int, "b" := Char, "c" := Bool ] + expected = + S.insert #a 1 + $ S.insert #b 'a' + $ S.insert #c True + $ S.empty + +test_advanced :: Assertion +test_advanced = do + assertEqual "I" expectedI $ example_advanced_I + assertEqual "Maybe" expectedMaybe $ example_advanced_Maybe + where + expectedI :: A.Record I [ "a" := Int, "b" := Char, "c" := Bool] + expectedI = + A.insert #a (I 1) + $ A.insert #b (I 'a') + $ A.insert #c (I True) + $ A.empty + + expectedMaybe :: Maybe (A.Record I '[ "b" := Char, "a" := Bool ]) + expectedMaybe = Just $ + A.insert #b (I 'a') + $ A.insert #a (I True) + $ A.empty + +{------------------------------------------------------------------------------- + Examples +-------------------------------------------------------------------------------} + +example_simple :: S.Record '[ "a" := Int, "b" := Char, "c" := Bool ] +example_simple = ANON { + a = 1 + , b = 'a' + , c = True + } + +-- | Example showing that we can easily reorder fields +-- +-- Importantly, the @a = 1@ assignment does /not/ lead to warnings about +-- defaulting @1@: the projection causes a unificaiton to happen between its +-- type and @Int@ (provided we have a type annotation, of course). +example_simple_reordered :: S.Record '[ "a" := Int, "b" := Char, "c" := Bool ] +example_simple_reordered = S.project $ ANON { + a = 1 + , c = True + , b = 'a' + } + +example_advanced_I :: A.Record I '[ "a" := Int, "b" := Char, "c" := Bool ] +example_advanced_I = ANON_F { + a = I 1 + , b = I 'a' + , c = I True + } + +example_advanced_Maybe :: Maybe (A.Record I '[ "b" := Char, "a" := Bool ]) +example_advanced_Maybe = A.sequenceA' $ ANON_F { + b = Just 'a' + , a = Just True + } diff --git a/test/Test/Sanity/SrcPlugin/WithTypelet.hs b/test/Test/Sanity/SrcPlugin/WithTypelet.hs deleted file mode 100644 --- a/test/Test/Sanity/SrcPlugin/WithTypelet.hs +++ /dev/null @@ -1,95 +0,0 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE OverloadedLabels #-} -{-# LANGUAGE TypeOperators #-} - -{-# OPTIONS_GHC -fplugin=TypeLet -fplugin=Data.Record.Anon.Plugin #-} -{-# OPTIONS_GHC -fplugin-opt=Data.Record.Anon.Plugin:typelet #-} --- {-# OPTIONS_GHC -fplugin-opt=Data.Record.Anon.Plugin:debug #-} - --- | Tests for @typelet@ --- --- These tests are identical to the ones in @WithoutTypelet@, except that we --- enable the @typelet@ plugin option here. -module Test.Sanity.SrcPlugin.WithTypelet (tests) where - -import Data.SOP.BasicFunctors - -import Data.Record.Anon - -import qualified Data.Record.Anon.Advanced as A -import qualified Data.Record.Anon.Simple as S - -import Test.Tasty -import Test.Tasty.HUnit - -{------------------------------------------------------------------------------- - Tests proper --------------------------------------------------------------------------------} - -tests :: TestTree -tests = testGroup "Test.Sanity.SrcPlugin.WithTypelet" [ - testCase "simple" test_simple - , testCase "advanced" test_advanced - ] - -test_simple :: Assertion -test_simple = do - assertEqual "inorder" expected $ example_simple - assertEqual "reordered" expected $ example_simple_reordered - where - expected :: S.Record '[ "a" := Int, "b" := Char, "c" := Bool ] - expected = - S.insert #a 1 - $ S.insert #b 'a' - $ S.insert #c True - $ S.empty - -test_advanced :: Assertion -test_advanced = do - assertEqual "I" expectedI $ example_advanced_I - assertEqual "Maybe" expectedMaybe $ example_advanced_Maybe - where - expectedI :: A.Record I [ "a" := Int, "b" := Char, "c" := Bool] - expectedI = - A.insert #a (I 1) - $ A.insert #b (I 'a') - $ A.insert #c (I True) - $ A.empty - - expectedMaybe :: Maybe (A.Record I '[ "b" := Char, "a" := Bool ]) - expectedMaybe = Just $ - A.insert #b (I 'a') - $ A.insert #a (I True) - $ A.empty - -{------------------------------------------------------------------------------- - Examples --------------------------------------------------------------------------------} - -example_simple :: S.Record '[ "a" := Int, "b" := Char, "c" := Bool ] -example_simple = ANON { - a = 1 - , b = 'a' - , c = True - } - --- | Check that the use of typelet does not hinder type inference -example_simple_reordered :: S.Record '[ "a" := Int, "b" := Char, "c" := Bool ] -example_simple_reordered = S.project $ ANON { - a = 1 - , c = True - , b = 'a' - } - -example_advanced_I :: A.Record I '[ "a" := Int, "b" := Char, "c" := Bool ] -example_advanced_I = ANON_F { - a = I 1 - , b = I 'a' - , c = I True - } - -example_advanced_Maybe :: Maybe (A.Record I '[ "b" := Char, "a" := Bool ]) -example_advanced_Maybe = A.sequenceA' $ ANON_F { - b = Just 'a' - , a = Just True - } diff --git a/test/Test/Sanity/SrcPlugin/WithoutTypelet.hs b/test/Test/Sanity/SrcPlugin/WithoutTypelet.hs deleted file mode 100644 --- a/test/Test/Sanity/SrcPlugin/WithoutTypelet.hs +++ /dev/null @@ -1,95 +0,0 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE OverloadedLabels #-} -{-# LANGUAGE TypeOperators #-} - -{-# OPTIONS_GHC -fplugin=Data.Record.Anon.Plugin #-} --- {-# OPTIONS_GHC -fplugin-opt=Data.Record.Anon.Plugin:debug #-} --- {-# OPTIONS_GHC -fplugin-opt=Data.Record.Anon.Plugin:noapply #-} - -module Test.Sanity.SrcPlugin.WithoutTypelet (tests) where - -import Data.SOP.BasicFunctors - -import Data.Record.Anon - -import qualified Data.Record.Anon.Advanced as A -import qualified Data.Record.Anon.Simple as S - -import Test.Tasty -import Test.Tasty.HUnit - -{------------------------------------------------------------------------------- - Tests proper --------------------------------------------------------------------------------} - -tests :: TestTree -tests = testGroup "Test.Sanity.SrcPlugin.WithoutTypelet" [ - testCase "simple" test_simple - , testCase "advanced" test_advanced - ] - -test_simple :: Assertion -test_simple = do - assertEqual "inorder" expected $ example_simple - assertEqual "reordered" expected $ example_simple_reordered - where - expected :: S.Record '[ "a" := Int, "b" := Char, "c" := Bool ] - expected = - S.insert #a 1 - $ S.insert #b 'a' - $ S.insert #c True - $ S.empty - -test_advanced :: Assertion -test_advanced = do - assertEqual "I" expectedI $ example_advanced_I - assertEqual "Maybe" expectedMaybe $ example_advanced_Maybe - where - expectedI :: A.Record I [ "a" := Int, "b" := Char, "c" := Bool] - expectedI = - A.insert #a (I 1) - $ A.insert #b (I 'a') - $ A.insert #c (I True) - $ A.empty - - expectedMaybe :: Maybe (A.Record I '[ "b" := Char, "a" := Bool ]) - expectedMaybe = Just $ - A.insert #b (I 'a') - $ A.insert #a (I True) - $ A.empty - -{------------------------------------------------------------------------------- - Examples --------------------------------------------------------------------------------} - -example_simple :: S.Record '[ "a" := Int, "b" := Char, "c" := Bool ] -example_simple = ANON { - a = 1 - , b = 'a' - , c = True - } - --- | Example showing that we can easily reorder fields --- --- Importantly, the @a = 1@ assignment does /not/ lead to warnings about --- defaulting @1@: the projection causes a unificaiton to happen between its --- type and @Int@ (provided we have a type annotation, of course). -example_simple_reordered :: S.Record '[ "a" := Int, "b" := Char, "c" := Bool ] -example_simple_reordered = S.project $ ANON { - a = 1 - , c = True - , b = 'a' - } - -example_advanced_I :: A.Record I '[ "a" := Int, "b" := Char, "c" := Bool ] -example_advanced_I = ANON_F { - a = I 1 - , b = I 'a' - , c = I True - } - -example_advanced_Maybe :: Maybe (A.Record I '[ "b" := Char, "a" := Bool ]) -example_advanced_Maybe = A.sequenceA' $ ANON_F { - b = Just 'a' - , a = Just True - } diff --git a/test/Test/Sanity/TypeLevelMetadata.hs b/test/Test/Sanity/TypeLevelMetadata.hs --- a/test/Test/Sanity/TypeLevelMetadata.hs +++ b/test/Test/Sanity/TypeLevelMetadata.hs @@ -1,13 +1,4 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE KindSignatures #-} -{-# LANGUAGE OverloadedLabels #-} -{-# LANGUAGE PolyKinds #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TypeApplications #-} -{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE TypeOperators #-} -{-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE OverloadedLabels #-} {-# OPTIONS_GHC -fplugin=Data.Record.Anon.Plugin #-} @@ -27,9 +18,8 @@ import Test.Tasty.HUnit import Data.Record.Anon - -import qualified Data.Record.Anon.Simple as S -import qualified Data.Record.Anon.Advanced as A +import Data.Record.Anon.Advanced qualified as A +import Data.Record.Anon.Simple qualified as S tests :: TestTree tests = testGroup "Test.Sanity.TypeLevelMetadata" [ diff --git a/test/TestLargeAnon.hs b/test/TestLargeAnon.hs --- a/test/TestLargeAnon.hs +++ b/test/TestLargeAnon.hs @@ -2,30 +2,29 @@ import Test.Tasty -import qualified Test.Prop.Record.Combinators.Constrained -import qualified Test.Prop.Record.Combinators.Simple -import qualified Test.Prop.Record.Diff -import qualified Test.Sanity.AllFields -import qualified Test.Sanity.Applicative -import qualified Test.Sanity.BlogPost -import qualified Test.Sanity.CheckIsSubRow -import qualified Test.Sanity.Discovery -import qualified Test.Sanity.DuplicateFields -import qualified Test.Sanity.Generics -import qualified Test.Sanity.HasField -import qualified Test.Sanity.Intersection -import qualified Test.Sanity.Merging -import qualified Test.Sanity.OverloadedRecordDot -import qualified Test.Sanity.OverloadedRecordUpdate -import qualified Test.Sanity.PolyKinds -import qualified Test.Sanity.RebindableSyntax.Disabled -import qualified Test.Sanity.RebindableSyntax.Enabled -import qualified Test.Sanity.RecordLens -import qualified Test.Sanity.Regression -import qualified Test.Sanity.Simple -import qualified Test.Sanity.SrcPlugin.WithoutTypelet -import qualified Test.Sanity.SrcPlugin.WithTypelet -import qualified Test.Sanity.TypeLevelMetadata +import Test.Prop.Record.Combinators.Constrained qualified +import Test.Prop.Record.Combinators.Simple qualified +import Test.Prop.Record.Diff qualified +import Test.Sanity.AllFields qualified +import Test.Sanity.Applicative qualified +import Test.Sanity.BlogPost qualified +import Test.Sanity.CheckIsSubRow qualified +import Test.Sanity.Discovery qualified +import Test.Sanity.DuplicateFields qualified +import Test.Sanity.Generics qualified +import Test.Sanity.HasField qualified +import Test.Sanity.Intersection qualified +import Test.Sanity.Merging qualified +import Test.Sanity.OverloadedRecordDot qualified +import Test.Sanity.OverloadedRecordUpdate qualified +import Test.Sanity.PolyKinds qualified +import Test.Sanity.RebindableSyntax.Disabled qualified +import Test.Sanity.RebindableSyntax.Enabled qualified +import Test.Sanity.RecordLens qualified +import Test.Sanity.Regression qualified +import Test.Sanity.Simple qualified +import Test.Sanity.SrcPlugin qualified +import Test.Sanity.TypeLevelMetadata qualified main :: IO () main = defaultMain $ testGroup "large-anon" [ @@ -42,8 +41,7 @@ , Test.Sanity.PolyKinds.tests , Test.Sanity.CheckIsSubRow.tests , Test.Sanity.Discovery.tests - , Test.Sanity.SrcPlugin.WithoutTypelet.tests - , Test.Sanity.SrcPlugin.WithTypelet.tests + , Test.Sanity.SrcPlugin.tests , Test.Sanity.Intersection.tests , Test.Sanity.BlogPost.tests , Test.Sanity.OverloadedRecordDot.tests