generic-data 1.0.0.1 → 1.1.0.0

raw patch · 10 files changed

+58/−50 lines, 10 filesdep +tasty-benchdep −criteriondep ~basedep ~base-orphansPVP ok

version bump matches the API change (PVP)

Dependencies added: tasty-bench

Dependencies removed: criterion

Dependency ranges changed: base, base-orphans

API changes (from Hackage documentation)

Files

• CHANGELOG.md +6/−0
• generic-data.cabal +6/−6
• src/Generic/Data.hs +1/−0
• src/Generic/Data/Internal/Error.hs +1/−1
• src/Generic/Data/Internal/Generically.hs +6/−8
• src/Generic/Data/Internal/Meta.hs +7/−6
• src/Generic/Data/Internal/Microsurgery.hs +26/−25
• src/Generic/Data/Internal/Newtype.hs +2/−2
• test/bench.hs +1/−1
• test/one-liner-surgery.hs +2/−1

@@ -1,3 +1,9 @@+# 1.1.0.0++- Remove `Eq` and `Ord` for `Generically1` instances.+  They are now available in *base* 4.18, and *base-orphans* 0.8.8+  for backwards compatibility.+ # 1.0.0.1  - Compatibility with *base* 4.18 (GHC 9.6)

@@ -1,5 +1,5 @@ name:                generic-data-version:             1.0.0.1+version:             1.1.0.0 synopsis:            Deriving instances with GHC.Generics and related utilities description:   Generic implementations of standard type classes.@@ -15,9 +15,9 @@ build-type:          Simple extra-source-files:  README.md, CHANGELOG.md cabal-version:       >=1.10-tested-with:         GHC == 8.0.2, GHC == 8.2.2, GHC == 8.4.3,-                     GHC == 8.6.5, GHC == 8.8.2, GHC == 9.0.2,-                     GHC == 9.2.4, GHC == 9.4.1+tested-with:         GHC == 8.0.2, GHC == 8.2.2, GHC == 8.4.4,+                     GHC == 8.6.5, GHC == 8.10.7, GHC == 9.0.2,+                     GHC == 9.2.7, GHC == 9.4.4, GHC == 9.6.1  library   hs-source-dirs:      src@@ -42,7 +42,7 @@     Generic.Data.Internal.Utils   build-depends:     ap-normalize >= 0.1 && < 0.2,-    base-orphans >= 0.8,+    base-orphans >= 0.8.8,     contravariant,     ghc-boot-th,     show-combinators,@@ -147,7 +147,7 @@   hs-source-dirs: test   main-is: bench.hs   build-depends:-    criterion,+    tasty-bench,     deepseq,     generic-data,     base

@@ -260,3 +260,4 @@ import Generic.Data.Internal.Utils  import GHC.Generics (Generic, Generic1)+import Data.Orphans ()  -- Eq and Ord of Generically1

@@ -47,7 +47,7 @@ -- ... --     • Cannot derive Semigroup instance for AB due to sum type --     • When deriving the instance for (Semigroup AB)-type AssertNoSum (constraint :: * -> Constraint) a =+type AssertNoSum (constraint :: Type -> Constraint) a =     Assert (Not (HasSum (Rep a)))     ('Text "Cannot derive " ':<>: 'ShowType constraint ':<>:         'Text " instance for " ':<>: 'ShowType a ':<>: 'Text " due to sum type")

@@ -233,6 +233,12 @@ instance (Generic1 f, Alternative (Rep1 f)) => Alternative (Generically1 f) where   empty = gempty   (<|>) = galt++instance (Generic1 f, Eq1 (Rep1 f), Eq a) => Eq (Generically1 f a) where+  (==) = eq1++instance (Generic1 f, Ord1 (Rep1 f), Ord a) => Ord (Generically1 f a) where+  compare = compare1 #endif  -- | This is a hack to implicitly wrap/unwrap in the instances of 'Generically1'.@@ -246,14 +252,6 @@   type Rep1 (Generically1 f) = Rep1 f   to1 = Generically1 . to1   from1 (Generically1 x) = from1 x--#if !MIN_VERSION_base(4,18,0)-instance (Generic1 f, Eq1 (Rep1 f), Eq a) => Eq (Generically1 f a) where-  (==) = eq1--instance (Generic1 f, Ord1 (Rep1 f), Ord a) => Ord (Generically1 f a) where-  compare = compare1-#endif  instance (Generic1 f, GRead1 (Rep1 f)) => Read1 (Generically1 f) where #if MIN_VERSION_base(4,10,0)

@@ -29,6 +29,7 @@ module Generic.Data.Internal.Meta where  import Data.Proxy+import Data.Kind (Type) import GHC.Generics import GHC.TypeLits (Symbol, Nat, KnownNat, type (+), natVal, TypeError, ErrorMessage(..)) @@ -255,14 +256,14 @@  type GConIdNamed n f = GConIdNamed' n f 0 'Nothing -type family GConIdNamed' (n :: Symbol) (f :: k -> *) (i :: Nat) (o :: Maybe Nat) :: Maybe Nat where+type family GConIdNamed' (n :: Symbol) (f :: k -> Type) (i :: Nat) (o :: Maybe Nat) :: Maybe Nat where   GConIdNamed' n (M1 D _c f) i r = GConIdNamed' n f i r   GConIdNamed' n (f :+: g) i r = GConIdNamed' n f i (GConIdNamed' n g (i + NConstructors f) r)   GConIdNamed' n (M1 C ('MetaCons n _f _s) _g) i _r = 'Just i   GConIdNamed' n (M1 C ('MetaCons _n _f _s) _g) _i r = r   GConIdNamed' _n V1 _i r = r -type family GConIdNamedIf (n :: Symbol) (t :: *) (o :: Maybe Nat) :: Nat where+type family GConIdNamedIf (n :: Symbol) (t :: Type) (o :: Maybe Nat) :: Nat where   GConIdNamedIf _n _t ('Just i) = i   GConIdNamedIf  n  t 'Nothing = TypeError     ('Text "No constructor named " ':<>: 'ShowType n@@ -295,7 +296,7 @@ type NonEmptyType_ fname a = (ErrorIfEmpty fname a (IsEmptyType a) ~ '())  -- 'True' if the generic representation is @M1 D _ V1@.-type family GIsEmptyType (r :: k -> *) :: Bool where+type family GIsEmptyType (r :: k -> Type) :: Bool where   GIsEmptyType (M1 D _d V1) = 'True   GIsEmptyType (M1 D _d (M1 C _c _f)) = 'False   GIsEmptyType (M1 D _d (_f :+: _g)) = 'False@@ -316,7 +317,7 @@ -- Error message: -- -- > The function 'conIdMin' cannot be used with the empty type E-type family ErrorIfEmpty (fname :: Symbol) (a :: *) (b :: Bool) :: () where+type family ErrorIfEmpty (fname :: Symbol) (a :: Type) (b :: Bool) :: () where   ErrorIfEmpty fname a 'True = TypeError     ('Text "The function '" ':<>: 'Text fname     ':<>: 'Text "' cannot be used with the empty type " ':<>: 'ShowType a)@@ -325,7 +326,7 @@ -- * Type families  -- | 'Meta' field of the 'M1' type constructor.-type family MetaOf (f :: * -> *) :: Meta where+type family MetaOf (f :: Type -> Type) :: Meta where   MetaOf (M1 i d f) = d  -- Variable names borrowed from the documentation on 'Meta'.@@ -382,5 +383,5 @@ type DummyMeta = 'MetaData "" "" "" 'False  -- | Remove an 'M1' type constructor.-type family   UnM1 (f :: k -> *) :: k -> *+type family   UnM1 (f :: k -> Type) :: k -> Type type instance UnM1 (M1 i c f) = f

@@ -23,6 +23,7 @@ module Generic.Data.Internal.Microsurgery where  import Data.Coerce (Coercible, coerce)+import Data.Kind (Type) import GHC.Generics import GHC.TypeLits (ErrorMessage(..), Symbol, TypeError) @@ -50,20 +51,20 @@ -- -- T won't be shown as a record: -- --   show (T {unT = 3}) == "T 3" -- @-type Surgery (s :: *) (a :: *) = Generically (Surgery' s a)+type Surgery (s :: Type) (a :: Type) = Generically (Surgery' s a)  -- | Apply a microsurgery @s@ to a type @a@ for @DerivingVia@ for the -- 'Data.Monoid.Monoid' class.-type ProductSurgery (s :: *) (a :: *) = GenericProduct (Surgery' s a)+type ProductSurgery (s :: Type) (a :: Type) = GenericProduct (Surgery' s a)  -- | Plural of 'Surgery'. Apply a list of microsurgeries.-type Surgeries (s :: [*]) (a :: *) = Surgery (Cat s) a+type Surgeries (s :: [Type]) (a :: Type) = Surgery (Cat s) a  -- | Plural of 'ProductSurgery'. Apply a list of microsurgeries.-type ProductSurgeries (s :: [*]) (a :: *) = ProductSurgery (Cat s) a+type ProductSurgeries (s :: [Type]) (a :: Type) = ProductSurgery (Cat s) a  -- | See 'Surgery'.-newtype Surgery' (s :: *) (a :: *) = Surgery' { unSurgery' :: a }+newtype Surgery' (s :: Type) (a :: Type) = Surgery' { unSurgery' :: a }  instance (Generic a, Coercible (GSurgery s (Rep a)) (Rep a)) => Generic (Surgery' s a) where   type Rep (Surgery' s a) = GSurgery s (Rep a)@@ -72,7 +73,7 @@  -- | Apply a microsurgery represented by a symbol @s@ (declared as a dummy data -- type) to a generic representation @f@.-type family GSurgery (s :: *) (f :: k -> *) :: k -> *+type family GSurgery (s :: Type) (f :: k -> Type) :: k -> Type  -- * Derecordify @@ -99,10 +100,10 @@ -- names. -- -- This is a defunctionalized symbol, applied using 'GSurgery' or 'Surgery'.-data Derecordify :: *+data Derecordify :: Type type instance GSurgery Derecordify f = GDerecordify f -type family GDerecordify (f :: k -> *) :: k -> *+type family GDerecordify (f :: k -> Type) :: k -> Type type instance GDerecordify (M1 D m f) = M1 D m (GDerecordify f) type instance GDerecordify (f :+: g) = GDerecordify f :+: GDerecordify g type instance GDerecordify (f :*: g) = GDerecordify f :*: GDerecordify g@@ -133,7 +134,7 @@ -- > data Foo = Bar Baz -- -- This is a defunctionalized symbol, applied using 'GSurgery' or 'Surgery'.-data Typeage :: *+data Typeage :: Type type instance GSurgery Typeage (M1 D ('MetaData nm md pk _nt) f) = M1 D ('MetaData nm md pk 'False) f  -- * Renaming@@ -171,10 +172,10 @@ -- > data Foo = Bar { bag :: Zap } -- -- This is a defunctionalized symbol, applied using 'GSurgery' or 'Surgery'.-data RenameFields (rnm :: *) :: *+data RenameFields (rnm :: Type) :: Type type instance GSurgery (RenameFields rnm) f = GRenameFields rnm f -type family GRenameFields (rnm :: *) (f :: k -> *) :: k -> *+type family GRenameFields (rnm :: Type) (f :: k -> Type) :: k -> Type type instance GRenameFields rnm (M1 D m f) = M1 D m (GRenameFields rnm f) type instance GRenameFields rnm (f :+: g) = GRenameFields rnm f :+: GRenameFields rnm g type instance GRenameFields rnm (f :*: g) = GRenameFields rnm f :*: GRenameFields rnm g@@ -192,10 +193,10 @@ -- > data Foo = Car { baz :: Zap } -- -- This is a defunctionalized symbol, applied using 'GSurgery' or 'Surgery'.-data RenameConstrs (rnm :: *) :: *+data RenameConstrs (rnm :: Type) :: Type type instance GSurgery (RenameConstrs rnm) f = GRenameConstrs rnm f -type family GRenameConstrs (rnm :: *) (f :: k -> *) :: k -> *+type family GRenameConstrs (rnm :: Type) (f :: k -> Type) :: k -> Type type instance GRenameConstrs rnm (M1 D m f) = M1 D m (GRenameConstrs rnm f) type instance GRenameConstrs rnm (f :+: g) = GRenameConstrs rnm f :+: GRenameConstrs rnm g type instance GRenameConstrs rnm (f :*: g) = GRenameConstrs rnm f :*: GRenameConstrs rnm g@@ -213,7 +214,7 @@ -- data FooToBar -- type instance FooToBar '@@' \"foo\" = \"bar\" -- @-type family (f :: *) @@ (s :: Symbol) :: Symbol+type family (f :: Type) @@ (s :: Symbol) :: Symbol  -- | Identity function @'Symbol' -> 'Symbol'@. data SId@@ -228,11 +229,11 @@ type instance SConst z @@ _s = z  -- | Define a function for a fixed set of strings, and fall back to @f@ for the others.-data SRename (xs :: [(Symbol, Symbol)]) (f :: *)+data SRename (xs :: [(Symbol, Symbol)]) (f :: Type) type instance SRename xs f @@ s = SRename' xs f s  -- | Closed type family for 'SRename'.-type family SRename' (xs :: [(Symbol, Symbol)]) (f :: *) (s :: Symbol) where+type family SRename' (xs :: [(Symbol, Symbol)]) (f :: Type) (s :: Symbol) where   SRename' '[] f s = f @@ s   SRename' ('( s,  t) ': _xs) _f s = t   SRename' ('(_r, _t) ':  xs)  f s = SRename' xs f s@@ -243,7 +244,7 @@  -- | Unify the "spines" of two generic representations (the "spine" is -- everything except the field types).-class UnifyRep (f :: k -> *) (g :: k -> *)+class UnifyRep (f :: k -> Type) (g :: k -> Type) instance (g' ~ M1 s c g, UnifyRep f g) => UnifyRep (M1 s c f) g' instance (g' ~ (g1 :+: g2), UnifyRep f1 g1, UnifyRep f2 g2)   => UnifyRep (f1 :+: f2) g'@@ -285,10 +286,10 @@ -- >   , b :: f Int } -- -- This is a defunctionalized symbol, applied using 'GSurgery' or 'Surgery'.-data OnFields (f :: * -> *) :: *+data OnFields (f :: Type -> Type) :: Type type instance GSurgery (OnFields f) g = GOnFields f g -type family GOnFields (f :: * -> *) (g :: k -> *) :: k -> *+type family GOnFields (f :: Type -> Type) (g :: k -> Type) :: k -> Type type instance GOnFields f (M1 s m r) = M1 s m (GOnFields f r) type instance GOnFields f (r :+: s) = GOnFields f r :+: GOnFields f s type instance GOnFields f (r :*: s) = GOnFields f r :*: GOnFields f s@@ -298,7 +299,7 @@  -- | Apply a type constructor @f@ to every field type of a type @a@ to make a -- synthetic type.-type DOnFields (f :: * -> *) (a :: *) = Data (GSurgery (OnFields f) (Rep a)) ()+type DOnFields (f :: Type -> Type) (a :: Type) = Data (GSurgery (OnFields f) (Rep a)) ()  -- | Apply a type constructor @f@ to the field named @s@ in a generic record @r@. --@@ -314,10 +315,10 @@ -- -- This is a defunctionalized symbol, applied using 'GSurgery' or 'Surgery'. -- See also the synonym @('%~')@.-data OnField (s :: Symbol) (f :: * -> *) :: *+data OnField (s :: Symbol) (f :: Type -> Type) :: Type type instance GSurgery (OnField s f) g = GOnField s f g -type family GOnField (x :: Symbol) (f :: * -> *) (g :: k -> *) :: k -> * where+type family GOnField (x :: Symbol) (f :: Type -> Type) (g :: k -> Type) :: k -> Type where   GOnField x f (M1 S ('MetaSel ('Just x) a b c) (K1 i t)) = M1 S ('MetaSel ('Just x) a b c) (K1 i (f t))   GOnField x f (M1 S m r) = M1 S m r   GOnField x f (M1 C m r) = M1 C m (GOnField x f r)@@ -359,15 +360,15 @@ infixr 4 %~  -- | Compose surgeries together.-data Cat (ss :: [*]) :: *+data Cat (ss :: [Type]) :: Type type instance GSurgery (Cat '[]) g = g type instance GSurgery (Cat (s ': ss)) g = GSurgery s (GSurgery (Cat ss) g)  -- | Make a synthetic type ('Data') by chaining multiple surgeries.-type DCat (ss :: [*]) (a :: *) = Data (GSurgery (Cat ss) (Rep a)) ()+type DCat (ss :: [Type]) (a :: Type) = Data (GSurgery (Cat ss) (Rep a)) ()  -- | Change the generic representation to that of another type @a@.-data CopyRep (a :: *) :: *+data CopyRep (a :: Type) :: Type type instance GSurgery (CopyRep a) _ = Rep a  copyRep :: forall a f p.

@@ -20,7 +20,7 @@ module Generic.Data.Internal.Newtype where  import Data.Coerce (Coercible, coerce)-import Data.Kind (Constraint)+import Data.Kind (Constraint, Type) import GHC.Generics (Generic(..), D1, C1, S1, K1) import GHC.TypeLits (TypeError, ErrorMessage(..)) @@ -39,7 +39,7 @@ -- @ type Old a = GOld (Rep a) -type family GOld (f :: * -> *) where+type family GOld (f :: Type -> Type) where   GOld (D1 _d (C1 _c (S1 _s (K1 _i b)))) = b  -- | Use 'Newtype' instead.

@@ -13,7 +13,7 @@ import Text.Show (showParen, showString)  import Control.DeepSeq-import Criterion.Main+import Test.Tasty.Bench  import Generic.Data import Generic.Data.Microsurgery

@@ -17,6 +17,7 @@ import Control.Applicative ((<|>)) import Data.Coerce (coerce) import Data.Functor.Identity (Identity(..))+import Data.Kind (Type) import GHC.Generics (Generic) import Text.Read (readMaybe) import Test.Tasty@@ -69,7 +70,7 @@ instance (a ~ Maybe (UnMaybe a)) => IsMaybe a  -- | Helper for 'IsMaybe' above.-type family UnMaybe (a :: *) :: * where+type family UnMaybe (a :: Type) :: Type where   UnMaybe (Maybe b) = b  -- |