deriving-compat 0.5.10 → 0.6

raw patch · 18 files changed

+304/−132 lines, 18 filesdep ~template-haskellPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: template-haskell

API changes (from Hackage documentation)

Files

• CHANGELOG.md +15/−1
• README.md +1/−1
• deriving-compat.cabal +7/−5
• src/Data/Deriving.hs +3/−1
• src/Data/Deriving/Internal.hs +132/−50
• src/Data/Deriving/Via/Internal.hs +23/−9
• src/Data/Enum/Deriving.hs +3/−0
• src/Data/Functor/Deriving/Internal.hs +13/−5
• src/Data/Ix/Deriving.hs +3/−0
• src/Text/Show/Deriving/Internal.hs +25/−13
• tests/BoundedEnumIxSpec.hs +7/−0
• tests/FunctorSpec.hs +39/−35
• tests/GH24Spec.hs +5/−1
• tests/GH27Spec.hs +0/−5
• tests/OrdSpec.hs +3/−3
• tests/ReadSpec.hs +3/−3
• tests/ShowSpec.hs +11/−0
• tests/Types/EqOrd.hs +11/−0

@@ -1,3 +1,17 @@+## 0.6 [2021.08.29]+* Allow building with `template-haskell-2.18.0.0` (GHC 9.2).+* Using `deriveEnum` and `deriveIx` on poly-kinded data family instances may+  now require the use of the `TypeInType` extension if using GHC 8.0, 8.2, or+  8.4. (On later versions of GHC, `TypeInType`'s functionality has been folded+  into `PolyKinds`.)+* Support deriving `Eq`, `Ord`, and `Show` instances for data types with fields+  of type `Int32#` or `Word32#` on GHC 9.2 or later.+* `deriveVia` now instantiates "floating" `via` type variables (i.e., type+  variables mentioned in the `via` type that are not mentioned in the instance+  context or the first argument to `Via`) to `Any` in the generated code. As a+  result, `deriveVia` no longer generates code that produces `-Wunused-foralls`+  warnings.+ ### 0.5.10 [2020.09.30] * Allow building with `template-haskell-2.17.0.0` (GHC 9.0). @@ -45,7 +59,7 @@ * Have `deriveGND`/`deriveVia` throw an error if an incorrect number of   arguments are supplied to the type class. -### 0.5 [2018.07.01]+## 0.5 [2018.07.01] * Backport the changes to `GeneralizedNewtypeDeriving` and `DerivingVia` code   generation from   [Trac #15290](https://ghc.haskell.org/trac/ghc/ticket/15290).

@@ -3,7 +3,7 @@ [![Hackage Dependencies](https://img.shields.io/hackage-deps/v/deriving-compat.svg)](http://packdeps.haskellers.com/reverse/deriving-compat) [![Haskell Programming Language](https://img.shields.io/badge/language-Haskell-blue.svg)][Haskell.org] [![BSD3 License](http://img.shields.io/badge/license-BSD3-brightgreen.svg)][tl;dr Legal: BSD3]-[![Build](https://img.shields.io/travis/haskell-compat/deriving-compat.svg)](https://travis-ci.org/haskell-compat/deriving-compat)+[![Build Status](https://github.com/haskell-compat/deriving-compat/workflows/Haskell-CI/badge.svg)](https://github.com/haskell-compat/deriving-compat/actions?query=workflow%3AHaskell-CI)  [Hackage: deriving-compat]:   http://hackage.haskell.org/package/deriving-compat

@@ -1,5 +1,5 @@ name:                deriving-compat-version:             0.5.10+version:             0.6 synopsis:            Backports of GHC deriving extensions description:         Provides Template Haskell functions that mimic deriving                      extensions that were introduced or modified in recent versions@@ -72,8 +72,10 @@                    , GHC == 8.2.2                    , GHC == 8.4.4                    , GHC == 8.6.5-                   , GHC == 8.8.3-                   , GHC == 8.10.1+                   , GHC == 8.8.4+                   , GHC == 8.10.7+                   , GHC == 9.0.1+                   , GHC == 9.2.* cabal-version:       >=1.10  source-repository head@@ -131,7 +133,7 @@     build-depends:     base                >= 4.3   && < 4.9    if flag(template-haskell-2-11)-    build-depends:     template-haskell    >= 2.11  && < 2.18+    build-depends:     template-haskell    >= 2.11  && < 2.19                      , ghc-boot-th   else     build-depends:     template-haskell    >= 2.5   && < 2.11@@ -170,7 +172,7 @@                      , hspec               >= 1.8                      , QuickCheck          >= 2      && < 3                      , tagged              >= 0.7    && < 1-                     , template-haskell    >= 2.5    && < 2.18+                     , template-haskell    >= 2.5    && < 2.19                      , void                >= 0.5.10 && < 1   build-tool-depends:  hspec-discover:hspec-discover >= 1.8 

@@ -118,8 +118,10 @@  * In GHC 8.10, @DerivingVia@ permits \"floating\" type variables in @via@ types,   such as the @a@ in @'deriveVia' [t| forall a. Show MyInt ``Via`` Const Int a |]@.+  @deriving-compat@ does so by instantiating the @a@ to @GHC.Exts.Any@ in the+  generated instance. -* In GHC 8.12, @DeriveFunctor@ was changed so that it works on more+* In GHC 9.0, @DeriveFunctor@ was changed so that it works on more   constructors with rank-n field types. -} 

@@ -35,7 +35,7 @@ import           Data.Functor.Classes (Eq2(..), Ord2(..), Read2(..), Show2(..)) # endif #endif-import           Data.List+import qualified Data.List as List import qualified Data.Map as Map import           Data.Map (Map) import           Data.Maybe@@ -376,7 +376,7 @@         --   instance C (Fam [Char])         remainingTysOrigSubst :: [Type]         remainingTysOrigSubst =-          map (substNamesWithKindStar (union droppedKindVarNames kvNames'))+          map (substNamesWithKindStar (List.union droppedKindVarNames kvNames'))             $ take remainingLength varTysOrig          isDataFamily :: Bool@@ -969,7 +969,7 @@  -- | Construct a type via curried application. applyTy :: Type -> [Type] -> Type-applyTy = foldl' AppT+applyTy = List.foldl' AppT  -- | Fully applies a type constructor to its type variables. applyTyCon :: Name -> [Type] -> Type@@ -1041,10 +1041,9 @@ tag2ConExpr ty = do     iHash  <- newName "i#"     ty' <- freshenType ty-    let tvbs = avoidTypeInType $ freeVariablesWellScoped [ty']     lam1E (conP iHashDataName [varP iHash]) $         varE tagToEnumHashValName `appE` varE iHash-            `sigE` return (ForallT (changeTVFlags SpecifiedSpec tvbs) [] ty')+            `sigE` return (quantifyType ty')             -- tagToEnum# is a hack, and won't typecheck unless it's in the             -- immediate presence of a type ascription like so:             --@@ -1057,40 +1056,7 @@             -- (using th-abstraction's quantifyType function). Also make sure             -- to freshen the bound type variables to avoid shadowed variable             -- warnings on old versions of GHC when -Wall is enabled.-  where-    -- Somewhat annoyingly, it's possible to generate code that requires-    -- TypeInType (on old versions of GHC) for data types which didn't require-    -- TypeInType to define. To avoid users having to turn on more language-    -- extensions than is necessary, we filter out all kind variable binders.-    -- Fortunately, old versions of GHC are quite alright with implicitly-    -- quantifying kind variables, even in the type of a SigE.-    ---    -- This is rather tiresome, and while writing this function, I debated-    -- whether to just forget about this nonsense and require users to-    -- enable TypeInType to use the generated code. Alas, that would entail-    -- a breaking change, so I decided against it at the time. If we ever make-    -- some breaking change in the future, however, this would be at the top-    -- of the list of things that I'd rip out.-    avoidTypeInType :: [TyVarBndrUnit] -> [TyVarBndrUnit]-#if __GLASGOW_HASKELL__ >= 806-    avoidTypeInType = id-#else-    avoidTypeInType = go . map attachFreeKindVars-      where-        attachFreeKindVars :: TyVarBndrUnit -> (TyVarBndrUnit, [Name])-        attachFreeKindVars tvb = (tvb, freeVariables (tvKind tvb)) -        go :: [(TyVarBndrUnit, [Name])] -> [TyVarBndrUnit]-        go [] = []-        go ((tvb, _):tvbsAndFVs)-          | any (\(_, kindVars) -> tvName tvb `elem` kindVars) tvbsAndFVs-          = tvbs'-          | otherwise-          = tvb:tvbs'-          where-            tvbs' = go tvbsAndFVs-#endif- primOrdFunTbl :: Map Name (Name, Name, Name, Name, Name) primOrdFunTbl = Map.fromList     [ (addrHashTypeName,   ( ltAddrHashValName@@ -1155,6 +1121,20 @@                            , gtWord16HashValName                            )) #endif+#if MIN_VERSION_base(4,16,0)+    , (int32HashTypeName,  ( ltInt32HashValName+                           , leInt32HashValName+                           , eqInt32HashValName+                           , geInt32HashValName+                           , gtInt32HashValName+                           ))+    , (word32HashTypeName, ( ltWord32HashValName+                           , leWord32HashValName+                           , eqWord32HashValName+                           , geWord32HashValName+                           , gtWord32HashValName+                           ))+#endif     ]  removeClassApp :: Type -> Type@@ -2145,18 +2125,6 @@ eqWord16HashValName :: Name eqWord16HashValName = mkNameG_v "ghc-prim" "GHC.Prim" "eqWord16#" -extendInt8HashValName :: Name-extendInt8HashValName = mkNameG_v "ghc-prim" "GHC.Prim" "extendInt8#"--extendInt16HashValName :: Name-extendInt16HashValName = mkNameG_v "ghc-prim" "GHC.Prim" "extendInt16#"--extendWord8HashValName :: Name-extendWord8HashValName = mkNameG_v "ghc-prim" "GHC.Prim" "extendWord8#"--extendWord16HashValName :: Name-extendWord16HashValName = mkNameG_v "ghc-prim" "GHC.Prim" "extendWord16#"- geInt8HashValName :: Name geInt8HashValName = mkNameG_v "ghc-prim" "GHC.Prim" "geInt8#" @@ -2184,9 +2152,41 @@ int8HashTypeName :: Name int8HashTypeName = mkNameG_tc "ghc-prim" "GHC.Prim" "Int8#" +int8ToIntHashValName :: Name+int8ToIntHashValName = mkNameG_v "ghc-prim" "GHC.Prim"+# if MIN_VERSION_base(4,16,0)+  "int8ToInt#"+# else+  "extendInt8#"+# endif+ int16HashTypeName :: Name int16HashTypeName = mkNameG_tc "ghc-prim" "GHC.Prim" "Int16#" +int16ToIntHashValName :: Name+int16ToIntHashValName = mkNameG_v "ghc-prim" "GHC.Prim"+# if MIN_VERSION_base(4,16,0)+  "int16ToInt#"+# else+  "extendInt16#"+# endif++intToInt8HashValName :: Name+intToInt8HashValName = mkNameG_v "ghc-prim" "GHC.Prim"+# if MIN_VERSION_base(4,16,0)+  "intToInt8#"+# else+  "narrowInt8#"+# endif++intToInt16HashValName :: Name+intToInt16HashValName = mkNameG_v "ghc-prim" "GHC.Prim"+# if MIN_VERSION_base(4,16,0)+  "intToInt16#"+# else+  "narrowInt16#"+# endif+ leInt8HashValName :: Name leInt8HashValName = mkNameG_v "ghc-prim" "GHC.Prim" "leInt8#" @@ -2214,6 +2214,88 @@ word8HashTypeName :: Name word8HashTypeName = mkNameG_tc "ghc-prim" "GHC.Prim" "Word8#" +word8ToWordHashValName :: Name+word8ToWordHashValName = mkNameG_v "ghc-prim" "GHC.Prim"+# if MIN_VERSION_base(4,16,0)+  "word8ToWord#"+# else+  "extendWord8#"+# endif+ word16HashTypeName :: Name word16HashTypeName = mkNameG_tc "ghc-prim" "GHC.Prim" "Word16#"++word16ToWordHashValName :: Name+word16ToWordHashValName = mkNameG_v "ghc-prim" "GHC.Prim"+# if MIN_VERSION_base(4,16,0)+  "word16ToWord#"+# else+  "extendWord16#"+# endif++wordToWord8HashValName :: Name+wordToWord8HashValName = mkNameG_v "ghc-prim" "GHC.Prim"+# if MIN_VERSION_base(4,16,0)+  "wordToWord8#"+# else+  "narrowWord8#"+# endif++wordToWord16HashValName :: Name+wordToWord16HashValName = mkNameG_v "ghc-prim" "GHC.Prim"+# if MIN_VERSION_base(4,16,0)+  "wordToWord16#"+# else+  "narrowWord16#"+# endif+#endif++#if MIN_VERSION_base(4,16,0)+eqInt32HashValName :: Name+eqInt32HashValName = mkNameG_v "ghc-prim" "GHC.Prim" "eqInt32#"++eqWord32HashValName :: Name+eqWord32HashValName = mkNameG_v "ghc-prim" "GHC.Prim" "eqWord32#"++geInt32HashValName :: Name+geInt32HashValName = mkNameG_v "ghc-prim" "GHC.Prim" "geInt32#"++geWord32HashValName :: Name+geWord32HashValName = mkNameG_v "ghc-prim" "GHC.Prim" "geWord32#"++gtInt32HashValName :: Name+gtInt32HashValName = mkNameG_v "ghc-prim" "GHC.Prim" "gtInt32#"++gtWord32HashValName :: Name+gtWord32HashValName = mkNameG_v "ghc-prim" "GHC.Prim" "gtWord32#"++int32HashTypeName :: Name+int32HashTypeName = mkNameG_tc "ghc-prim" "GHC.Prim" "Int32#"++int32ToIntHashValName :: Name+int32ToIntHashValName = mkNameG_v "ghc-prim" "GHC.Prim" "int32ToInt#"++intToInt32HashValName :: Name+intToInt32HashValName = mkNameG_v "ghc-prim" "GHC.Prim" "intToInt32#"++leInt32HashValName :: Name+leInt32HashValName = mkNameG_v "ghc-prim" "GHC.Prim" "leInt32#"++leWord32HashValName :: Name+leWord32HashValName = mkNameG_v "ghc-prim" "GHC.Prim" "leWord32#"++ltInt32HashValName :: Name+ltInt32HashValName = mkNameG_v "ghc-prim" "GHC.Prim" "ltInt32#"++ltWord32HashValName :: Name+ltWord32HashValName = mkNameG_v "ghc-prim" "GHC.Prim" "ltWord32#"++word32HashTypeName :: Name+word32HashTypeName = mkNameG_tc "ghc-prim" "GHC.Prim" "Word32#"++word32ToWordHashValName :: Name+word32ToWordHashValName = mkNameG_v "ghc-prim" "GHC.Prim" "word32ToWord#"++wordToWord32HashValName :: Name+wordToWord32HashValName = mkNameG_v "ghc-prim" "GHC.Prim" "wordToWord32#" #endif

@@ -1,5 +1,10 @@ {-# LANGUAGE CPP #-}+{-# LANGUAGE TupleSections #-} +#if __GLASGOW_HASKELL__ >= 800+{-# LANGUAGE TemplateHaskellQuotes #-}+#endif+ {-| Module:      Data.Deriving.Via.Internal Copyright:   (C) 2015-2017 Ryan Scott@@ -23,10 +28,13 @@ import           Control.Monad ((<=<), unless)  import           Data.Deriving.Internal+import qualified Data.List as L import qualified Data.Map as M import           Data.Map (Map) import           Data.Maybe (catMaybes) +import           GHC.Exts (Any)+ import           Language.Haskell.TH import           Language.Haskell.TH.Datatype import           Language.Haskell.TH.Datatype.TyVarBndr@@ -46,12 +54,11 @@ deriveGND :: Q Type -> Q [Dec] deriveGND qty = do   ty <- qty-  let (instanceTvbs, instanceCxt, instanceTy) = decomposeType ty+  let (_instanceTvbs, instanceCxt, instanceTy) = decomposeType ty   instanceTy' <- (resolveTypeSynonyms <=< resolveInfixT) instanceTy   decs <- deriveViaDecs instanceTy' Nothing-  let instanceHeader = ForallT instanceTvbs instanceCxt instanceTy-  (:[]) `fmap` instanceD (return [])-                         (return instanceHeader)+  (:[]) `fmap` instanceD (return instanceCxt)+                         (return instanceTy)                          (map return decs)  {- | Generates an instance for a type class by emulating the behavior of the@@ -71,7 +78,7 @@ deriveVia :: Q Type -> Q [Dec] deriveVia qty = do   ty <- qty-  let (instanceTvbs, instanceCxt, viaApp) = decomposeType ty+  let (_instanceTvbs, instanceCxt, viaApp) = decomposeType ty   viaApp' <- (resolveTypeSynonyms <=< resolveInfixT) viaApp   (instanceTy, viaTy)     <- case unapplyTy viaApp' of@@ -83,10 +90,17 @@                 , "\tThe ‘Via‘ type must be used, e.g."                 , "\t[t| forall a. C (T a) `Via` V a |]"                 ]-  decs <- deriveViaDecs instanceTy (Just viaTy)-  let instanceHeader = ForallT instanceTvbs instanceCxt instanceTy-  (:[]) `fmap` instanceD (return [])-                         (return instanceHeader)+  -- This is a stronger requirement than what GHC's implementation of+  -- DerivingVia imposes, but due to Template Haskell restrictions, we+  -- currently can't do better. See #27.+  let viaTyFVs           = freeVariables viaTy+      otherFVs           = concat [freeVariables instanceCxt, freeVariables instanceTy]+      floatingViaTyFVs   = viaTyFVs L.\\ otherFVs+      floatingViaTySubst = M.fromList $ map (, ConT ''Any) floatingViaTyFVs+      viaTy'             = applySubstitution floatingViaTySubst viaTy+  decs <- deriveViaDecs instanceTy (Just viaTy')+  (:[]) `fmap` instanceD (return instanceCxt)+                         (return instanceTy)                          (map return decs)  deriveViaDecs :: Type       -- ^ The instance head (e.g., @Eq (Foo a)@)

@@ -28,4 +28,7 @@  * Type variables of kind @*@ are assumed to have 'Enum' constraints.   If this is not desirable, use 'makeToEnum' or one of its cousins.++* Generated 'Enum' instances for poly-kinded data family instances are likely+  to require the use of the @TypeInType@ extension on GHC 8.0, 8.2, or 8.4. -}

@@ -56,7 +56,7 @@ import           Control.Monad (guard)  import           Data.Deriving.Internal-import           Data.List+import qualified Data.List as List import qualified Data.Map as Map ((!), keys, lookup, member, singleton) import           Data.Maybe @@ -590,7 +590,7 @@         mkApCon :: Exp -> [Exp] -> Exp         mkApCon conExp []  = VarE pureValName `AppE` conExp         mkApCon conExp [e] = VarE fmapValName `AppE` conExp `AppE` e-        mkApCon conExp (e1:e2:es) = foldl' appAp+        mkApCon conExp (e1:e2:es) = List.foldl' appAp           (VarE liftA2ValName `AppE` conExp `AppE` e1 `AppE` e2) es           where appAp se1 se2 = InfixE (Just se1) (VarE apValName) (Just se2) @@ -703,7 +703,7 @@ conWildPat :: ConstructorInfo -> Pat conWildPat (ConstructorInfo { constructorName = conName                             , constructorFields = ts }) =-  ConP conName $ replicate (length ts) WildP+  conPCompat conName $ replicate (length ts) WildP  ------------------------------------------------------------------------------- -- Generic traversal for functor-like deriving@@ -861,7 +861,7 @@                  -> Q Match mkSimpleConMatch fold conName insides = do   varsNeeded <- newNameList "_arg" $ length insides-  let pat = ConP conName (map VarP varsNeeded)+  let pat = conPCompat conName (map VarP varsNeeded)   rhs <- fold conName (zipWith (\i v -> i $ VarE v) insides varsNeeded)   return $ Match pat (NormalB rhs) [] @@ -885,7 +885,7 @@                   -> Q Match mkSimpleConMatch2 fold conName insides = do   varsNeeded <- newNameList "_arg" lengthInsides-  let pat = ConP conName (map VarP varsNeeded)+  let pat = conPCompat conName (map VarP varsNeeded)       -- Make sure to zip BEFORE invoking catMaybes. We want the variable       -- indicies in each expression to match up with the argument indices       -- in conExpr (defined below).@@ -933,3 +933,11 @@ #endif   m <- matchForCon tupDataName insides   return $ CaseE x [m]++-- Adapt to the type of ConP changing in template-haskell-2.18.0.0.+conPCompat :: Name -> [Pat] -> Pat+conPCompat n pats = ConP n+#if MIN_VERSION_template_haskell(2,18,0)+                         []+#endif+                         pats

@@ -25,4 +25,7 @@  * Type variables of kind @*@ are assumed to have 'Ix' constraints.   If this is not desirable, use 'makeRange' or one of its cousins.++* Generated 'Ix' instances for poly-kinded data family instances are likely+  to require the use of the @TypeInType@ extension on GHC 8.0, 8.2, or 8.4. -}

@@ -52,7 +52,7 @@     ) where  import           Data.Deriving.Internal-import           Data.List+import qualified Data.List as List import qualified Data.Map as Map import           Data.Map (Map) import           Data.Maybe (fromMaybe)@@ -398,7 +398,7 @@        then do          let showArgs       = zipWith (makeShowForArg 0 sClass opts conName tvMap) argTys' args              parenCommaArgs = (varE showCharValName `appE` charE '(')-                              : intersperse (varE showCharValName `appE` charE ',') showArgs+                              : List.intersperse (varE showCharValName `appE` charE ',') showArgs              mappendArgs    = foldr (`infixApp` varE composeValName)                                     (varE showCharValName `appE` charE ')')                                     parenCommaArgs@@ -692,34 +692,46 @@                              }) #if MIN_VERSION_base(4,13,0)     , (int8HashTypeName,   PrimShow-                             { primShowBoxer      = appE (conE iHashDataName) . appE (varE extendInt8HashValName)+                             { primShowBoxer      = appE (conE iHashDataName) . appE (varE int8ToIntHashValName)                              , primShowPostfixMod = oneHashE-                             , primShowConv       = mkNarrowE "narrowInt8#"+                             , primShowConv       = mkNarrowE intToInt8HashValName                              })     , (int16HashTypeName,  PrimShow-                             { primShowBoxer      = appE (conE iHashDataName) . appE (varE extendInt16HashValName)+                             { primShowBoxer      = appE (conE iHashDataName) . appE (varE int16ToIntHashValName)                              , primShowPostfixMod = oneHashE-                             , primShowConv       = mkNarrowE "narrowInt16#"+                             , primShowConv       = mkNarrowE intToInt16HashValName                              })     , (word8HashTypeName,  PrimShow-                             { primShowBoxer      = appE (conE wHashDataName) . appE (varE extendWord8HashValName)+                             { primShowBoxer      = appE (conE wHashDataName) . appE (varE word8ToWordHashValName)                              , primShowPostfixMod = twoHashE-                             , primShowConv       = mkNarrowE "narrowWord8#"+                             , primShowConv       = mkNarrowE wordToWord8HashValName                              })     , (word16HashTypeName, PrimShow-                             { primShowBoxer      = appE (conE wHashDataName) . appE (varE extendWord16HashValName)+                             { primShowBoxer      = appE (conE wHashDataName) . appE (varE word16ToWordHashValName)                              , primShowPostfixMod = twoHashE-                             , primShowConv       = mkNarrowE "narrowWord16#"+                             , primShowConv       = mkNarrowE wordToWord16HashValName                              }) #endif+#if MIN_VERSION_base(4,16,0)+    , (int32HashTypeName,  PrimShow+                             { primShowBoxer      = appE (conE iHashDataName) . appE (varE int32ToIntHashValName)+                             , primShowPostfixMod = oneHashE+                             , primShowConv       = mkNarrowE intToInt32HashValName+                             })+    , (word32HashTypeName, PrimShow+                             { primShowBoxer      = appE (conE wHashDataName) . appE (varE word32ToWordHashValName)+                             , primShowPostfixMod = twoHashE+                             , primShowConv       = mkNarrowE wordToWord32HashValName+                             })+#endif     ]  #if MIN_VERSION_base(4,13,0)-mkNarrowE :: String -> Q Exp -> Q Exp-mkNarrowE narrowStr e =+mkNarrowE :: Name -> Q Exp -> Q Exp+mkNarrowE narrowName e =   foldr (`infixApp` varE composeValName)         (varE showCharValName `appE` charE ')')-        [ varE showStringValName `appE` stringE ('(':narrowStr ++ " ")+        [ varE showStringValName `appE` stringE ('(':nameBase narrowName ++ " ")         , e         ] #endif

@@ -10,6 +10,10 @@ {-# LANGUAGE PolyKinds #-} #endif +#if __GLASGOW_HASKELL__ >= 800 && __GLASGOW_HASKELL__ < 806+{-# LANGUAGE TypeInType #-}+#endif+ {-| Module:      BoundedEnumSpec Copyright:   (C) 2015-2017 Ryan Scott@@ -22,6 +26,9 @@ module BoundedEnumIxSpec where  import Data.Deriving+#if __GLASGOW_HASKELL__ >= 800 && __GLASGOW_HASKELL__ < 806+import Data.Kind+#endif  import GHC.Arr (Ix(..)) 

@@ -34,7 +34,7 @@ import Data.Char (chr) import Data.Foldable (fold) import Data.Deriving-import Data.Functor.Classes (Eq1)+import Data.Functor.Classes (Eq1, Show1) import Data.Functor.Compose (Compose(..)) import Data.Functor.Identity (Identity(..)) import Data.Monoid@@ -310,41 +310,44 @@  ------------------------------------------------------------------------------- -prop_FunctorLaws :: (Functor f, Eq (f a), Eq (f c))-                 => (b -> c) -> (a -> b) -> f a -> Bool-prop_FunctorLaws f g x =-       fmap id      x == x-    && fmap (f . g) x == (fmap f . fmap g) x+prop_FunctorLaws :: (Functor f, Eq (f a), Eq (f c), Show (f a), Show (f c))+                 => (b -> c) -> (a -> b) -> f a -> Expectation+prop_FunctorLaws f g x = do+    fmap id      x `shouldBe` x+    fmap (f . g) x `shouldBe` (fmap f . fmap g) x -prop_FunctorEx :: (Functor f, Eq (f [Int])) => f [Int] -> Bool+prop_FunctorEx :: (Functor f, Eq (f [Int]), Show (f [Int])) => f [Int] -> Expectation prop_FunctorEx = prop_FunctorLaws reverse (++ [42]) -prop_FoldableLaws :: (Eq a, Eq b, Eq z, Monoid a, Monoid b, Foldable f)-                  => (a -> b) -> (a -> z -> z) -> z -> f a -> Bool-prop_FoldableLaws f h z x =-       fold      x == foldMap id x-    && foldMap f x == foldr (mappend . f) mempty x-    && foldr h z x == appEndo (foldMap (Endo . h) x) z+prop_FoldableLaws :: (Eq a, Eq b, Eq z, Show a, Show b, Show z,+                      Monoid a, Monoid b, Foldable f)+                  => (a -> b) -> (a -> z -> z) -> z -> f a -> Expectation+prop_FoldableLaws f h z x = do+    fold      x `shouldBe` foldMap id x+    foldMap f x `shouldBe` foldr (mappend . f) mempty x+    foldr h z x `shouldBe` appEndo (foldMap (Endo . h) x) z -prop_FoldableEx :: Foldable f => f [Int] -> Bool+prop_FoldableEx :: Foldable f => f [Int] -> Expectation prop_FoldableEx = prop_FoldableLaws reverse ((+) . length) 0  prop_TraversableLaws :: forall t f g a b c.                         (Applicative f, Applicative g, Traversable t,-                         Eq (t (f a)),  Eq (g (t a)),  Eq (g (t b)),-                         Eq (t a),      Eq (t c),      Eq1 f, Eq1 g)+                         Eq (t (f a)),   Eq (g (t a)),   Eq (g (t b)),+                         Eq (t a),       Eq (t c),       Eq1 f, Eq1 g,+                         Show (t (f a)), Show (g (t a)), Show (g (t b)),+                         Show (t a),     Show (t c),     Show1 f, Show1 g)                        => (a -> f b) -> (b -> f c)-                       -> (forall x. f x -> g x) -> t a -> Bool-prop_TraversableLaws f g t x =-       (t . traverse f)  x == traverse (t . f)   x-    && traverse Identity x == Identity           x-    && traverse (Compose . fmap g . f) x-         == (Compose . fmap (traverse g) . traverse f) x+                       -> (forall x. f x -> g x) -> t a -> Expectation+prop_TraversableLaws f g t x = do+    (t . traverse f)  x `shouldBe` traverse (t . f)   x+    traverse Identity x `shouldBe` Identity           x+    traverse (Compose . fmap g . f) x+      `shouldBe` (Compose . fmap (traverse g) . traverse f) x -    && (t . sequenceA)             y == (sequenceA . fmap t) y-    && (sequenceA . fmap Identity) y == Identity             y-    && (sequenceA . fmap Compose)  z-         == (Compose . fmap sequenceA . sequenceA) z+    (t . sequenceA)             y `shouldBe` (sequenceA . fmap t) y+    (sequenceA . fmap Identity) y `shouldBe` Identity             y+    (sequenceA . fmap Compose)  z+      `shouldBe` (Compose . fmap sequenceA . sequenceA) z   where     y :: t (f a)     y = fmap pure x@@ -352,9 +355,10 @@     z :: t (f (g a))     z = fmap (fmap pure) y -prop_TraversableEx :: (Traversable t, Eq (t [[Int]]),-                       Eq (t [Int]), Eq (t String), Eq (t Char))-                   => t [Int] -> Bool+prop_TraversableEx :: (Traversable t,+                       Eq   (t [[Int]]), Eq   (t [Int]), Eq   (t String), Eq   (t Char),+                       Show (t [[Int]]), Show (t [Int]), Show (t String), Show (t Char))+                   => t [Int] -> Expectation prop_TraversableEx = prop_TraversableLaws     (replicate 2 . map (chr . abs))     (++ "Hello")@@ -369,17 +373,17 @@ spec = parallel $ do     describe "OneTwoCompose Maybe ((,) Bool) [Int] [Int]" $ do         prop "satisfies the Functor laws"-            (prop_FunctorEx     :: OneTwoCompose Maybe ((,) Bool) [Int] [Int] -> Bool)+            (prop_FunctorEx     :: OneTwoCompose Maybe ((,) Bool) [Int] [Int] -> Expectation)         prop "satisfies the Foldable laws"-            (prop_FoldableEx    :: OneTwoCompose Maybe ((,) Bool) [Int] [Int] -> Bool)+            (prop_FoldableEx    :: OneTwoCompose Maybe ((,) Bool) [Int] [Int] -> Expectation)         prop "satisfies the Traversable laws"-            (prop_TraversableEx :: OneTwoCompose Maybe ((,) Bool) [Int] [Int] -> Bool)+            (prop_TraversableEx :: OneTwoCompose Maybe ((,) Bool) [Int] [Int] -> Expectation) #if MIN_VERSION_template_haskell(2,7,0)     describe "OneTwoComposeFam Maybe ((,) Bool) [Int] [Int]" $ do         prop "satisfies the Functor laws"-            (prop_FunctorEx     :: OneTwoComposeFam Maybe ((,) Bool) [Int] [Int] -> Bool)+            (prop_FunctorEx     :: OneTwoComposeFam Maybe ((,) Bool) [Int] [Int] -> Expectation)         prop "satisfies the Foldable laws"-            (prop_FoldableEx    :: OneTwoComposeFam Maybe ((,) Bool) [Int] [Int] -> Bool)+            (prop_FoldableEx    :: OneTwoComposeFam Maybe ((,) Bool) [Int] [Int] -> Expectation)         prop "satisfies the Traversable laws"-            (prop_TraversableEx :: OneTwoComposeFam Maybe ((,) Bool) [Int] [Int] -> Bool)+            (prop_TraversableEx :: OneTwoComposeFam Maybe ((,) Bool) [Int] [Int] -> Expectation) #endif

@@ -2,7 +2,11 @@ {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} -#if __GLASGOW_HASKELL__ >= 800+#if __GLASGOW_HASKELL__ >= 706+{-# LANGUAGE PolyKinds #-}+#endif++#if __GLASGOW_HASKELL__ >= 800 && __GLASGOW_HASKELL__ < 806 {-# LANGUAGE TypeInType #-} #endif 

@@ -6,7 +6,6 @@ #if MIN_VERSION_template_haskell(2,12,0) {-# LANGUAGE InstanceSigs #-} {-# LANGUAGE TypeApplications #-}-{-# OPTIONS_GHC -Wno-unused-foralls #-} -- Due to GHC #13512. Sigh. #endif  {-|@@ -18,10 +17,6 @@  A regression test for https://github.com/haskell-compat/deriving-compat/issues/27.-We isolate this test case from the rest of "DerivingViaSpec" because-we have to disable @-Wunused-foralls@ due to-https://gitlab.haskell.org/ghc/ghc/issues/13512, and we would prefer not to-contaminate the rest of "DerivingViaSpec" with this hack. -} module GH27Spec where 

@@ -24,13 +24,13 @@  ------------------------------------------------------------------------------- -prop_Ord :: (Ord a, Ord (f a), Ord1 f) => f a -> f a -> Bool-prop_Ord x y = compare x y == compare1 x y+prop_Ord :: (Ord a, Ord (f a), Ord1 f) => f a -> f a -> Expectation+prop_Ord x y = compare x y `shouldBe` compare1 x y  ordSpec :: forall proxy f a. (Arbitrary (f a), Show (f a),                               Ord a, Ord (f a), Ord1 f)         => proxy (f a) -> Spec-ordSpec _ = prop "has a valid Ord1 instance" (prop_Ord :: f a -> f a -> Bool)+ordSpec _ = prop "has a valid Ord1 instance" (prop_Ord :: f a -> f a -> Expectation)  ------------------------------------------------------------------------------- 

@@ -87,8 +87,8 @@  prop_Read :: forall f a. (Read a, Read (f a), Read1 f,                           Eq (f a), Show (f a))-          => f a -> Bool-prop_Read x = readArb readsPrec == readArb readsPrec1+          => f a -> Expectation+prop_Read x = readArb readsPrec `shouldBe` readArb readsPrec1   where     readArb :: (Int -> ReadS (f a)) -> f a     readArb = read' (show x)@@ -96,7 +96,7 @@ readSpec :: forall f a. (Arbitrary (f a), Eq (f a), Show (f a),                          Read a, Read (f a), Read1 f)          => Proxy (f a) -> Spec-readSpec _ = prop "has a valid Read1 instance" (prop_Read :: f a -> Bool)+readSpec _ = prop "has a valid Read1 instance" (prop_Read :: f a -> Expectation)  -- Adapted from the definition of readEither readEither' :: String -> (Int -> ReadS a) -> Either String a

@@ -26,6 +26,9 @@ #if MIN_VERSION_base(4,13,0)                 , Int8#, Int16#, Word8#, Word16# #endif+#if MIN_VERSION_base(4,16,0)+                , Int32#, Word32#+#endif                 )  import Prelude ()@@ -53,6 +56,10 @@   , tcWord8#  :: Word8#   , tcWord16# :: Word16# #endif+#if MIN_VERSION_base(4,16,0)+  , tcInt32#  :: Int32#+  , tcWord32# :: Word32#+#endif }  data TyCon2 a b c d where@@ -93,6 +100,10 @@   , tfInt16#  :: Int16#   , tfWord8#  :: Word8#   , tfWord16# :: Word16#+#endif+#if MIN_VERSION_base(4,16,0)+  , tfInt32#  :: Int32#+  , tfWord32# :: Word32# #endif } 

@@ -26,6 +26,9 @@ #if MIN_VERSION_base(4,13,0)                 , Int8#, Int16#, Word8#, Word16# #endif+#if MIN_VERSION_base(4,16,0)+                , Int32#, Word32#+#endif                 )  -- Plain data types@@ -60,6 +63,10 @@   , tcWord8#  :: Word8#   , tcWord16# :: Word16# #endif+#if MIN_VERSION_base(4,16,0)+  , tcInt32#  :: Int32#+  , tcWord32# :: Word32#+#endif }  data TyCon2 a b c d where@@ -115,6 +122,10 @@   , tfInt16#  :: Int16#   , tfWord8#  :: Word8#   , tfWord16# :: Word16#+#endif+#if MIN_VERSION_base(4,16,0)+  , tfInt32#  :: Int32#+  , tfWord32# :: Word32# #endif }