packages feed

large-anon 0.1.0.0 → 0.1.1

raw patch · 10 files changed

+116/−54 lines, 10 filesdep ~aesondep ~ghcdep ~ghc-tcplugin-apiPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: aeson, ghc, ghc-tcplugin-api, hashable

API changes (from Hackage documentation)

Files

CHANGELOG.md view
@@ -1,5 +1,9 @@ # Revision history for large-anon +## 0.1.1 -- 2022-07-22++* Support for ghc 9.2 (#116)+ ## 0.1.0.0 -- 2022-04-06 -* First public release +* First public release
large-anon.cabal view
@@ -1,6 +1,6 @@ cabal-version:      2.4 name:               large-anon-version:            0.1.0.0+version:            0.1.1 synopsis:           Scalable anonymous records description:        The @large-anon@ package provides support for anonymous                     records in Haskell, with a focus on compile-time (and@@ -11,7 +11,7 @@ maintainer:         edsko@well-typed.com category:           Records extra-source-files: CHANGELOG.md-tested-with:        GHC ==8.8.4 || ==8.10.7 || ==9.0.2+tested-with:        GHC ==8.8.4 || ==8.10.7 || ==9.0.2 || ==9.2.2  library   exposed-modules:@@ -69,10 +69,10 @@    build-depends:       base             >= 4.13  && < 4.18-    , aeson            >= 1.4.4 && < 2.1+    , aeson            >= 1.4.4 && < 2.2     , containers       >= 0.6.2 && < 0.7-    , ghc-tcplugin-api >= 0.7.1 && < 0.8-    , hashable         >= 1.3   && < 1.4+    , ghc-tcplugin-api >= 0.8   && < 0.9+    , hashable         >= 1.3   && < 1.5     , mtl              >= 2.2.1 && < 2.3     , optics-core      >= 0.3   && < 0.5     , primitive        >= 0.7.1 && < 0.8@@ -173,11 +173,13 @@       -Wno-unticked-promoted-constructors       -fno-show-valid-hole-fits -  if impl(ghc >= 8.10)-    ghc-options: -Wunused-packages+  -- Not sure why, but ghc warns about record-hasfield being unused,+  -- despite it actually being required. So for now we just disable this check.+  -- if impl(ghc >= 8.10)+  --   ghc-options: -Wunused-packages    if impl(ghc >= 9.0.1)-    -- Work out ghc problem. See more detailed discussion in large-records.+    -- Work around ghc problem. See more detailed discussion in large-records.     ghc-options: -Wno-unused-imports  Flag debug
src/Data/Record/Anon/Internal/Plugin/Source.hs view
@@ -1,6 +1,7 @@ {-# LANGUAGE NamedFieldPuns  #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE TupleSections   #-}+{-# LANGUAGE ViewPatterns    #-}  module Data.Record.Anon.Internal.Plugin.Source (sourcePlugin) where @@ -37,7 +38,7 @@       }  transformExpr :: Options -> LHsExpr GhcPs -> NamingT Hsc (LHsExpr GhcPs)-transformExpr options@Options{debug} e@(L l expr)+transformExpr options@Options{debug} e@(reLoc -> L l expr)   | RecordCon _ext (L _ nm) (HsRecFields flds dotdot) <- expr   , Unqual nm' <- nm   , Nothing    <- dotdot@@ -53,7 +54,10 @@     getField ::          LHsRecField GhcPs (LHsExpr GhcPs)       -> Maybe (FastString, LHsExpr GhcPs)-    getField (L _ (HsRecField (L _ fieldOcc) arg pun))+    getField (L _ (HsRecField+                    { hsRecFieldLbl = L _ fieldOcc+                    , hsRecFieldArg = arg+                    , hsRecPun = pun }))       | FieldOcc _ (L _ nm) <- fieldOcc       , Unqual nm' <- nm       , not pun@@ -160,10 +164,7 @@ -------------------------------------------------------------------------------}  mkVar :: SrcSpan -> RdrName -> LHsExpr GhcPs-mkVar l name = L l $ HsVar defExt (L l name)--mkLabel :: SrcSpan -> FastString -> LHsExpr GhcPs-mkLabel l n = L l $ HsOverLabel defExt Nothing n+mkVar l name = reLocA $ L l $ HsVar defExt (reLocA $ L l name)  -- | Construct simple lambda --
src/Data/Record/Anon/Internal/Plugin/Source/GhcShim.hs view
@@ -11,9 +11,15 @@     -- * Extensions     HasDefaultExt(..) +#if __GLASGOW_HASKELL__ < 902+    -- * Exact-print annotations+  , reLoc, reLocA+#endif+     -- * Miscellaneous   , importDecl   , issueWarning+  , mkLabel #if __GLASGOW_HASKELL__ < 900   , mkHsApps #endif@@ -35,14 +41,21 @@   , module GHC   , module GHC.Data.FastString   , module GHC.Driver.Main-  , module GHC.Driver.Types   , module GHC.Types.Name   , module GHC.Types.Name.Cache   , module GHC.Types.Name.Occurrence   , module GHC.Types.Name.Reader   , module GHC.Types.Unique.Supply   , module GHC.Utils.Outputable++#if __GLASGOW_HASKELL__ < 902+  , module GHC.Driver.Types+#else+  , module GHC.Driver.Errors+  , module GHC.Driver.Env.Types+  , module GHC.Types.SourceText #endif+#endif   ) where  #if __GLASGOW_HASKELL__ < 900@@ -70,7 +83,14 @@ import GHC.Data.Bag (listToBag) import GHC.Data.FastString (FastString) import GHC.Driver.Main (getHscEnv)++#if __GLASGOW_HASKELL__ >= 902+import GHC.Driver.Errors+import GHC.Driver.Env.Types+import GHC.Types.SourceText+#else import GHC.Driver.Types+#endif import GHC.Plugins import GHC.Types.Name (mkInternalName) import GHC.Types.Name.Cache (NameCache(nsUniqs))@@ -88,10 +108,10 @@  -- | Optionally @qualified@ import declaration importDecl :: Bool -> ModuleName -> LImportDecl GhcPs-importDecl qualified name = noLoc $ ImportDecl {+importDecl qualified name = reLocA $ noLoc $ ImportDecl {       ideclExt       = defExt     , ideclSourceSrc = NoSourceText-    , ideclName      = noLoc name+    , ideclName      = reLocA $ noLoc name     , ideclPkgQual   = Nothing     , ideclSafe      = False     , ideclImplicit  = False@@ -112,8 +132,14 @@ issueWarning :: SrcSpan -> SDoc -> Hsc () issueWarning l errMsg = do     dynFlags <- getDynFlags+#if __GLASGOW_HASKELL__ >= 902+    logger <- getLogger+    liftIO $ printOrThrowWarnings logger dynFlags . listToBag . (:[]) $+      mkWarnMsg l neverQualify errMsg+#else     liftIO $ printOrThrowWarnings dynFlags . listToBag . (:[]) $       mkWarnMsg dynFlags l neverQualify errMsg+#endif  #if __GLASGOW_HASKELL__ < 900 mkHsApps ::@@ -143,3 +169,32 @@   defExt = NoLayoutInfo #endif +#if __GLASGOW_HASKELL__ >= 902+instance HasDefaultExt (EpAnn ann) where+  defExt = noAnn+#endif++{-------------------------------------------------------------------------------+  Exact-print annotations+-------------------------------------------------------------------------------}++#if __GLASGOW_HASKELL__ < 902+reLoc :: Located a -> Located a+reLoc = id++reLocA :: Located a -> Located a+reLocA = id+#endif+++{-------------------------------------------------------------------------------+  mkLabel+-------------------------------------------------------------------------------}++mkLabel :: SrcSpan -> FastString -> LHsExpr GhcPs+mkLabel l n = reLocA $ L l+            $ HsOverLabel defExt+#if __GLASGOW_HASKELL__ < 902+                 Nothing+#endif+                 n
src/Data/Record/Anon/Internal/Plugin/TC/Constraints/RowHasField.hs view
@@ -76,18 +76,21 @@   -> Ct   -> ParseResult Void (GenLocated CtLoc CRowHasField) parseRowHasField tcs rn@ResolvedNames{..} =-    parseConstraint' clsRowHasField $ \[k, n, r, a] -> do-      label  <- ParsedRow.parseFieldLabel n-      fields <- ParsedRow.parseFields tcs rn r--      return $ CRowHasField {-          hasFieldLabel     = label-        , hasFieldRecord    = fields-        , hasFieldTypeKind  = k-        , hasFieldTypeLabel = n-        , hasFieldTypeRow   = r-        , hasFieldTypeField = a-        }+    parseConstraint' clsRowHasField $ \ args ->+      case args of+        [k, n, r, a] -> do+          label  <- ParsedRow.parseFieldLabel n+          fields <- ParsedRow.parseFields tcs rn r+          return $ CRowHasField {+              hasFieldLabel     = label+            , hasFieldRecord    = fields+            , hasFieldTypeKind  = k+            , hasFieldTypeLabel = n+            , hasFieldTypeRow   = r+            , hasFieldTypeField = a+            }+        _ -> pprPanic "parseRowHasField: expected 4 arguments" $+               ( text "args:" <+> ppr args )  {-------------------------------------------------------------------------------   Evidence
src/Data/Record/Anon/Internal/Plugin/TC/Constraints/SubRow.hs view
@@ -67,16 +67,20 @@   -> Ct   -> ParseResult Void (GenLocated CtLoc CSubRow) parseSubRow tcs rn@ResolvedNames{..} =-    parseConstraint' clsSubRow $ \[typeKind, typeLHS, typeRHS] -> do-      fieldsLHS <- ParsedRow.parseFields tcs rn typeLHS-      fieldsRHS <- ParsedRow.parseFields tcs rn typeRHS-      return $ CSubRow {-            subrowParsedLHS = fieldsLHS-          , subrowParsedRHS = fieldsRHS-          , subrowTypeLHS   = typeLHS-          , subrowTypeRHS   = typeRHS-          , subrowTypeKind  = typeKind-          }+    parseConstraint' clsSubRow $ \ args ->+      case args of+        [typeKind, typeLHS, typeRHS] -> do+          fieldsLHS <- ParsedRow.parseFields tcs rn typeLHS+          fieldsRHS <- ParsedRow.parseFields tcs rn typeRHS+          return $ CSubRow {+                subrowParsedLHS = fieldsLHS+              , subrowParsedRHS = fieldsRHS+              , subrowTypeLHS   = typeLHS+              , subrowTypeRHS   = typeRHS+              , subrowTypeKind  = typeKind+              }+        _ -> pprPanic "parseSubRow: expected 3 arguments" $+               text "args" <+> ppr args  {-------------------------------------------------------------------------------   Evidence
src/Data/Record/Anon/Internal/Plugin/TC/GhcTcPluginAPI.hs view
@@ -18,10 +18,6 @@   , module GHC.Core.Make   , module GHC.Utils.Outputable -    -- * Additional exports-  , splitAppTys-  , unpackFS-     -- * New functonality   , isCanonicalVarEq   ) where@@ -38,26 +34,18 @@ import GHC.Utils.Outputable  #if __GLASGOW_HASKELL__ >= 808 &&  __GLASGOW_HASKELL__ < 810-import FastString (unpackFS) import TcRnTypes (Ct(..))-import Type (splitAppTys) #endif  #if __GLASGOW_HASKELL__ >= 810 &&  __GLASGOW_HASKELL__ < 900 import Constraint (Ct(..))-import FastString (unpackFS)-import Type (splitAppTys) #endif  #if __GLASGOW_HASKELL__ >= 900 &&  __GLASGOW_HASKELL__ < 902-import GHC.Core.Type (splitAppTys)-import GHC.Data.FastString (unpackFS) import GHC.Tc.Types.Constraint (Ct(..)) #endif  #if __GLASGOW_HASKELL__ >= 902-import GHC.Core.Type (splitAppTys)-import GHC.Data.FastString (unpackFS) import GHC.Tc.Types.Constraint (Ct(..), CanEqLHS(..)) #endif
src/Data/Record/Anon/Internal/Plugin/TC/NameResolution.hs view
@@ -76,7 +76,7 @@  getModule :: MonadTcPlugin m => String -> String -> m Module getModule pkg modl = do-    r <- findImportedModule (mkModuleName modl) (Just (fsLit pkg))+    r <- findImportedModule (mkModuleName modl) (OtherPkg $ stringToUnitId pkg)     case r of       Found _ m  -> return m       _otherwise -> panic $ "Could not find " ++ modl ++ " in package " ++ pkg
src/Data/Record/Anon/Internal/Util/SmallHashMap.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TupleSections       #-} {-# LANGUAGE TypeApplications    #-}@@ -47,7 +48,11 @@ newtype Hashed k = Hashed k   deriving (Show) +#if MIN_VERSION_hashable(1,4,0)+instance Hashable k => Eq (Hashed k) where+#else instance (Hashable k, Eq k) => Eq (Hashed k) where+#endif   Hashed a == Hashed b = and [       hash a == hash b     ,      a ==      b
test/Test/Infra/DynRecord/Advanced.hs view
@@ -138,7 +138,7 @@         setter :: Record f r -> Record f r'         (getter, setter) = Anon.lens r -toRecord :: forall k (r :: Row k) (f :: k -> *) proxy.+toRecord :: forall k (r :: Row k) (f :: k -> Type) proxy.      ( IsValue f      , KnownFields r      , SubRow r r