generic-data 0.9.2.1 → 1.0.0.0

raw patch · 10 files changed

+225/−76 lines, 10 filesdep ~basePVP ok

version bump matches the API change (PVP)

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• CHANGELOG.md +18/−0
• generic-data.cabal +18/−11
• src/Generic/Data.hs +4/−4
• src/Generic/Data/Internal/Generically.hs +63/−45
• src/Generic/Data/Internal/Meta.hs +1/−1
• src/Generic/Data/Internal/Microsurgery.hs +73/−1
• src/Generic/Data/Internal/Read.hs +2/−2
• src/Generic/Data/Microsurgery.hs +19/−7
• test/microsurgery.hs +25/−4
• test/unit.hs +2/−1

@@ -1,3 +1,21 @@+# 1.0.0.0++- `Generically` and `Generically1` are in *base* 4.17 (GHC 9.4.1)!++    + *generic-data* reexports `Generically` and `Generically1` if using *base* >= 4.17.+      The following instances remain as orphans: `Eq`, `Ord`, `Read`, `Show`,+      `Enum`, `Ix`, `Bounded`, `Foldable`, `Traversable`, `Read1`, `Show1`.+    + base 4.17 includes instances for the non-stock-derivable classes:+      `Semigroup` and `Monoid` for `Generically`; `Eq1`, `Ord1`, `Functor`,+      `Applicative`, and `Alternative` for `Generically1`.+    + Note: the `Semigroup` and `Monoid` instances of *base*'s `Generically`+      are those of *generic-data*'s `GenericProduct` (which is subtly different+      from `Generically`'s previous instance in *generic-data*).+    + `Generically` and `Generically1` are no longer defined using record syntax,+      so the `unGenerically`(`1`) field accessor no longer exists.+      The field accessors for `FiniteEnumeration` and `GenericProduct` were also+      removed for uniformity.+ # 0.9.2.1  - No external changes.

@@ -1,5 +1,5 @@ name:                generic-data-version:             0.9.2.1+version:             1.0.0.0 synopsis:            Deriving instances with GHC.Generics and related utilities description:   Generic implementations of standard type classes.@@ -15,8 +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.1,-                     GHC == 8.6.3, GHC == 8.6.5, GHC == 8.8.2+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  library   hs-source-dirs:      src@@ -124,22 +125,23 @@   default-language: Haskell2010   type: exitcode-stdio-1.0 -test-suite generic-data-inspection-test+test-suite inspect   hs-source-dirs: test   main-is: inspection.hs   other-modules:     Inspection.Boilerplate-  build-depends:-    generic-data,-    inspection-testing,-    template-haskell,-    unordered-containers,-    base   ghc-options: -Wall -threaded   default-language: Haskell2010   type: exitcode-stdio-1.0-  if impl(ghc < 8.2) || os(windows)+  if !flag(enable-inspect)     buildable: False+  else+    build-depends:+      generic-data,+      inspection-testing,+      template-haskell,+      unordered-containers,+      base  benchmark bench   hs-source-dirs: test@@ -154,6 +156,11 @@   type: exitcode-stdio-1.0   if !impl(ghc >= 8.6)     buildable: False++flag enable-inspect+  description: Enable inspection tests (broken on ghc < 8.2 or >= 9.2)+  default: False+  manual: True  source-repository head   type:     git

@@ -61,9 +61,9 @@ -- -- This is due to a particular encoding choice of @GHC.Generics@, where -- composition are nested to the right instead of to the left. @f (g (h _))@ is--- represented by the functor @f ':.:' (g ':.:' 'Rec1' h)@, so one must use--- `fmap` on `f` to convert that back to `f (g (h _))`. A better choice would--- have been to encode it as @('Rec1' f ':.:' g) ':.:' h@, because that is+-- represented by the functor @f 'GHC.Generics.:.:' (g 'GHC.Generics.:.:' 'GHC.Generics.Rec1' h)@, so one must use+-- 'fmap' on @f@ to convert that back to @f (g (h _))@. A better choice would+-- have been to encode it as @('GHC.Generics.Rec1' f 'GHC.Generics.:.:' g) 'GHC.Generics.:.:' h@, because that is -- coercible back to @f (g (h _))@.  module Generic.Data@@ -129,7 +129,7 @@   , gmaxBound   , GBounded() -    -- ** 'Ix'+    -- ** 'Data.Ix.Ix'     -- | Can also be derived by GHC as part of the standard.   , grange   , gindex

@@ -4,6 +4,10 @@   TypeFamilies,   UndecidableInstances,   UndecidableSuperClasses #-}+{-# OPTIONS_GHC -Wno-noncanonical-monoid-instances #-}+#if __GLASGOW_HASKELL__ >= 904+{-# OPTIONS_GHC -Wno-orphans #-}+#endif  -- | Newtypes with instances implemented using generic combinators. --@@ -15,13 +19,15 @@ -- If something here seems useful, please report it or create a pull request to -- export it from an external module. -module Generic.Data.Internal.Generically where+module Generic.Data.Internal.Generically+  ( Generically(..)+  , Generically1(..)+  , FiniteEnumeration(..)+  , GenericProduct(..) ) where -import Control.Applicative+import GHC.Generics import Data.Functor.Classes-import Data.Semigroup import Data.Ix-import GHC.Generics import Text.Read  import Generic.Data.Internal.Prelude hiding (gfoldMap, gtraverse, gsequenceA)@@ -31,10 +37,16 @@ import Generic.Data.Internal.Show import Generic.Data.Internal.Traversable (GFoldable, GTraversable, gfoldMap, gtraverse, gsequenceA) +#if __GLASGOW_HASKELL__ < 904+import Control.Applicative+import Data.Semigroup+#endif+ -- $setup -- >>> :set -XDerivingVia -XDeriveGeneric -- >>> import GHC.Generics (Generic, Generic1) +#if __GLASGOW_HASKELL__ < 904 -- | Type with instances derived via 'Generic'. -- -- === Examples@@ -68,12 +80,24 @@ --   deriving Generic --   deriving (Eq, Ord, Enum, Bounded) via (Generically V) -- :}-newtype Generically a = Generically { unGenerically :: a }+newtype Generically a = Generically a +instance (AssertNoSum Semigroup a, Generic a, Semigroup (Rep a ())) => Semigroup (Generically a) where+  (<>) = gmappend++-- | This uses the 'Semigroup' instance of the wrapped type @a@ to define 'mappend'.+-- The purpose of this instance is to derive 'mempty', while remaining consistent+-- with possibly custom 'Semigroup' instances.+instance (AssertNoSum Semigroup a, Semigroup a, Generic a, Monoid (Rep a ())) => Monoid (Generically a) where+  mempty = gmempty+  mappend (Generically x) (Generically y) = Generically (x <> y)+#endif++-- | This is a hack to implicitly wrap/unwrap in the instances of 'Generically'. instance Generic a => Generic (Generically a) where   type Rep (Generically a) = Rep a   to = Generically . to-  from = from . unGenerically+  from (Generically x) = from x  instance (Generic a, Eq (Rep a ())) => Eq (Generically a) where   (==) = geq@@ -88,16 +112,6 @@ instance (Generic a, GShow0 (Rep a)) => Show (Generically a) where   showsPrec = gshowsPrec -instance (AssertNoSum Semigroup a, Generic a, Semigroup (Rep a ())) => Semigroup (Generically a) where-  (<>) = gmappend---- | This uses the 'Semigroup' instance of the wrapped type 'a' to define 'mappend'.--- The purpose of this instance is to derive 'mempty', while remaining consistent--- with possibly custom 'Semigroup' instances.-instance (AssertNoSum Semigroup a, Semigroup a, Generic a, Monoid (Rep a ())) => Monoid (Generically a) where-  mempty = gmempty-  mappend (Generically x) (Generically y) = Generically (x <> y)- instance (Generic a, GEnum StandardEnum (Rep a)) => Enum (Generically a) where   toEnum = gtoEnum   fromEnum = gfromEnum@@ -115,6 +129,7 @@   minBound = gminBound   maxBound = gmaxBound + -- | Type with 'Enum' instance derived via 'Generic' with 'FiniteEnum' option. -- This allows deriving 'Enum' for types whose constructors have fields. --@@ -127,12 +142,12 @@ --   deriving Generic --   deriving (Enum, Bounded) via (FiniteEnumeration Booool) -- :}-newtype FiniteEnumeration a = FiniteEnumeration { unFiniteEnumeration :: a }+newtype FiniteEnumeration a = FiniteEnumeration a  instance Generic a => Generic (FiniteEnumeration a) where   type Rep (FiniteEnumeration a) = Rep a   to = FiniteEnumeration . to-  from = from . unFiniteEnumeration+  from (FiniteEnumeration x) = from x  instance (Generic a, GEnum FiniteEnum (Rep a)) => Enum (FiniteEnumeration a) where   toEnum = gtoFiniteEnum@@ -147,6 +162,7 @@   minBound = gminBound   maxBound = gmaxBound +#if __GLASGOW_HASKELL__ < 904 -- | Type with instances derived via 'Generic1'. -- -- === Examples@@ -195,27 +211,45 @@ --   deriving Generic1 --   deriving (Eq1, Ord1) via (Generically1 I) -- :}-newtype Generically1 f a = Generically1 { unGenerically1 :: f a }+newtype Generically1 f a = Generically1 (f a) +instance (Generic1 f, Eq1 (Rep1 f)) => Eq1 (Generically1 f) where+  liftEq = gliftEq++instance (Generic1 f, Ord1 (Rep1 f)) => Ord1 (Generically1 f) where+  liftCompare = gliftCompare++instance (Generic1 f, Functor (Rep1 f)) => Functor (Generically1 f) where+  fmap = gfmap+  (<$) = gconstmap++instance (Generic1 f, Applicative (Rep1 f)) => Applicative (Generically1 f) where+  pure = gpure+  (<*>) = gap+#if MIN_VERSION_base(4,10,0)+  liftA2 = gliftA2+#endif++instance (Generic1 f, Alternative (Rep1 f)) => Alternative (Generically1 f) where+  empty = gempty+  (<|>) = galt+#endif++-- | This is a hack to implicitly wrap/unwrap in the instances of 'Generically1'. instance Generic (f a) => Generic (Generically1 f a) where   type Rep (Generically1 f a) = Rep (f a)   to = Generically1 . to-  from = from . unGenerically1+  from (Generically1 x) = from x +-- | This is a hack to implicitly wrap/unwrap in the instances of 'Generically1'. instance Generic1 f => Generic1 (Generically1 f) where   type Rep1 (Generically1 f) = Rep1 f   to1 = Generically1 . to1-  from1 = from1 . unGenerically1--instance (Generic1 f, Eq1 (Rep1 f)) => Eq1 (Generically1 f) where-  liftEq = gliftEq+  from1 (Generically1 x) = from1 x  instance (Generic1 f, Eq1 (Rep1 f), Eq a) => Eq (Generically1 f a) where   (==) = eq1 -instance (Generic1 f, Ord1 (Rep1 f)) => Ord1 (Generically1 f) where-  liftCompare = gliftCompare- instance (Generic1 f, Ord1 (Rep1 f), Ord a) => Ord (Generically1 f a) where   compare = compare1 @@ -242,21 +276,6 @@ instance (Generic1 f, GShow1 (Rep1 f), Show a) => Show (Generically1 f a) where   showsPrec = showsPrec1 -instance (Generic1 f, Functor (Rep1 f)) => Functor (Generically1 f) where-  fmap = gfmap-  (<$) = gconstmap--instance (Generic1 f, Applicative (Rep1 f)) => Applicative (Generically1 f) where-  pure = gpure-  (<*>) = gap-#if MIN_VERSION_base(4,10,0)-  liftA2 = gliftA2-#endif--instance (Generic1 f, Alternative (Rep1 f)) => Alternative (Generically1 f) where-  empty = gempty-  (<|>) = galt- instance (Generic1 f, GFoldable (Rep1 f)) => Foldable (Generically1 f) where   foldMap = gfoldMap   foldr = gfoldr@@ -266,7 +285,6 @@   traverse = gtraverse   sequenceA = gsequenceA - -- | Product type with generic instances of 'Semigroup' and 'Monoid'. -- -- This is similar to 'Generic.Data.Generically' in most cases, but@@ -290,12 +308,12 @@ -- @('<>')@ (the 'Semigroup' method), which might not exist, or might not be -- equivalent to @Vector@'s generic 'Semigroup' instance, which would be -- unlawful.-newtype GenericProduct a = GenericProduct { unGenericProduct :: a }+newtype GenericProduct a = GenericProduct a  instance Generic a => Generic (GenericProduct a) where   type Rep (GenericProduct a) = Rep a   to = GenericProduct . to-  from = from . unGenericProduct+  from (GenericProduct x) = from x  instance (AssertNoSum Semigroup a, Generic a, Semigroup (Rep a ())) => Semigroup (GenericProduct a) where   (<>) = gmappend

@@ -273,7 +273,7 @@ -- | Constraint that a generic type @a@ is not empty. -- Producing an error message otherwise. ----- The 'Symbol' parameter 'fname' is used only for error messages.+-- The 'Symbol' parameter @fname@ is used only for error messages. -- -- It is implied by the simpler constraint @'IsEmptyType' a ~ 'False@ class    NonEmptyType_ fname a => NonEmptyType fname a

@@ -56,6 +56,12 @@ -- 'Data.Monoid.Monoid' class. type ProductSurgery (s :: *) (a :: *) = GenericProduct (Surgery' s a) +-- | Plural of 'Surgery'. Apply a list of microsurgeries.+type Surgeries (s :: [*]) (a :: *) = Surgery (Cat s) a++-- | Plural of 'ProductSurgery'. Apply a list of microsurgeries.+type ProductSurgeries (s :: [*]) (a :: *) = ProductSurgery (Cat s) a+ -- | See 'Surgery'. newtype Surgery' (s :: *) (a :: *) = Surgery' { unSurgery' :: a } @@ -290,9 +296,75 @@ type instance GOnFields f U1 = U1 type instance GOnFields f V1 = V1 --- | Apply a type constructor to every field type of a type @a@ to make a+-- | 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)) ()++-- | Apply a type constructor @f@ to the field named @s@ in a generic record @r@.+--+-- > data Vec a = Vec+-- >   { len :: Int+-- >   , contents :: [a] }+-- >+-- > -- with (OnField "len" Sum) becomes --+-- >+-- > data Vec a = Vec+-- >   { len :: Sum Int+-- >   , contents :: [a] }+--+-- This is a defunctionalized symbol, applied using 'GSurgery' or 'Surgery'.+-- See also the synonym @('%~')@.+data OnField (s :: Symbol) (f :: * -> *) :: *+type instance GSurgery (OnField s f) g = GOnField s f g++type family GOnField (x :: Symbol) (f :: * -> *) (g :: k -> *) :: k -> * 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)+  GOnField x f (M1 D m r) = M1 D m (GOnField x f r)+  GOnField x f (r :+: s) = GOnField x f r :+: GOnField x f s+  GOnField x f (r :*: s) = GOnField x f r :*: GOnField x f s+  GOnField x f (K1 i a) = K1 i (f a)+  GOnField x f U1 = U1+  GOnField x f V1 = V1++-- | Infix name for 'OnField'. To be used with 'Surgeries' or 'Cat'.+--+-- === __Examples__+--+-- Transform one @Int@ field into @'Data.Monoid.Sum' Int@ for deriving 'Monoid':+--+-- @+-- data Vec a = Vec+--   { len :: Int+--   , contents :: [a] }+--   deriving Generic+--   deriving (Eq, Show) via Generically (Vec a)+--   deriving (Semigroup, Monoid) via 'ProductSurgeries' '[\"len\" '%~' 'Data.Monoid.Sum'] (Vec a)+-- @+--+-- Wrap unshowable fields in 'Generic.Data.Opaque' for deriving 'Show':+--+-- @+-- data Unshowable = Unshowable+--   { fun :: Int -> Int+--   , io :: IO Bool+--   , int :: Int }+--   deriving Generic+--   deriving Show via 'Surgeries' '[\"fun\" '%~' 'Generic.Data.Opaque', \"io\" '%~' 'Generic.Data.Opaque'] Unshowable+--+-- -- show (Unshowable id (pure True) 42) = \"Unshowable _ _ 42\"+-- @+type (%~) = OnField+infixr 4 %~++-- | Compose surgeries together.+data Cat (ss :: [*]) :: *+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)) ()  -- | Change the generic representation to that of another type @a@. data CopyRep (a :: *) :: *

@@ -38,8 +38,8 @@ -- -- @ -- instance 'Read' MyType where---   'readPrec' = 'greadPrec'---   'readListPrec' = 'readListPrecDefault'+--   'readPrec' = 'Text.Read.greadPrec'+--   'readListPrec' = 'Text.Read.readListPrecDefault' -- @ greadPrec :: (Generic a, GRead0 (Rep a)) => ReadPrec a greadPrec = to <$> gPrecRead Proxy

@@ -37,6 +37,8 @@      Surgery   , ProductSurgery+  , Surgeries+  , ProductSurgeries   , Surgery'(..)   , GSurgery   , Generically(..)@@ -105,8 +107,8 @@     -- ** Wrap every field in a type constructor      -- | Give every field a type @f FieldType@ (where @f@ is a parameter), to-    -- obtain a family of types with a shared structure. This-    -- \"higher-kindification\" technique is presented in the following+    -- obtain a family of types with a shared structure. Some applications of+    -- this \"higher-kindification\" technique may be found in the following     -- blogposts:     --     -- - https://www.benjamin.pizza/posts/2017-12-15-functor-functors.html@@ -122,6 +124,15 @@     -- a product of 'Prelude.Num' types:     --     -- @+    -- data TwoCounters = MkTwoCounters { c1 :: Int, c2 :: Int }+    --   deriving 'GHC.Generics.Generic'+    --   deriving ('Data.Semigroup.Semigroup', 'Data.Monoid.Monoid')+    --     via ('ProductSurgery' ('OnFields' 'Data.Monoid.Sum') TwoCounters)  -- Surgery here+    -- @+    --+    -- ==== __Extensions and imports__+    --+    -- @     -- {-\# LANGUAGE DeriveGeneric, DerivingVia \#-}     -- import "Data.Monoid" ('Data.Monoid.Sum'(..))  -- Constructors must be in scope     -- import "GHC.Generics" ('GHC.Generics.Generic')@@ -131,15 +142,16 @@     --   , 'GenericProduct'(..)  -- Constructors must be in scope     --   , 'Surgery''(..)        --     --   )-    ---    -- data TwoCounters = MkTwoCounters { c1 :: Int, c2 :: Int }-    --   deriving 'GHC.Generics.Generic'-    --   deriving ('Data.Semigroup.Semigroup', 'Data.Monoid.Monoid')-    --     via ('ProductSurgery' ('OnFields' 'Data.Monoid.Sum') TwoCounters)  -- Surgery here     -- @    , OnFields()   , DOnFields++  , OnField()+  , type (%~)++  , Cat()+  , DCat()      -- ** Substitute a generic representation from another type 

@@ -5,7 +5,10 @@     TypeApplications #-}  #if __GLASGOW_HASKELL__ >= 806-{-# LANGUAGE DerivingVia #-}+{-# LANGUAGE+    DerivingVia,+    ExplicitNamespaces,+    TypeOperators #-} #endif  -- @DataKinds@ and @TypeApplications@ for @renameFields@ and @renameConstrs@@@ -21,13 +24,15 @@   )  #if __GLASGOW_HASKELL__ >= 806-import Data.Monoid (Sum(..), Product(..))- -- DerivingVia test -- Constructors must be visible for Coercible+import Data.Monoid (Sum(..), Product(..))++import Generic.Data (Opaque(..)) import Generic.Data.Microsurgery-  ( Surgery, ProductSurgery, Surgery'(..), Generically(..), GenericProduct(..)+  ( Surgery, Surgeries, ProductSurgery, ProductSurgeries, Surgery'(..), Generically(..), GenericProduct(..)   , Derecordify, OnFields, CopyRep+  , type (%~)   ) #endif @@ -58,6 +63,20 @@   deriving Generic   deriving Show via (Surgery Derecordify (Polar a))   deriving (Semigroup, Monoid) via (ProductSurgery (CopyRep (Product a, Sum a)) (Polar a))++data Vec a = Vec+  { len :: Int+  , contents :: [a] }+  deriving Generic+  deriving (Eq, Show) via Generically (Vec a)+  deriving (Semigroup, Monoid) via ProductSurgeries '["len" %~ Data.Monoid.Sum] (Vec a)++data Unshowable = Unshowable+  { fun :: Int -> Int+  , io :: IO Bool+  , int :: Int }+  deriving Generic+  deriving Show via Surgeries '["fun" %~ Opaque, "io" %~ Opaque] Unshowable #endif  main :: IO ()@@ -72,5 +91,7 @@   , testCase "Semigroup V" $ "V 5 6" @?= show (V 2 3 <> V 3 3)   , testCase "Monoid Polar" $ "Exp 1 0" @?= show (mempty :: Polar Int)   , testCase "Semigroup Polar" $ "Exp 9 6" @?= show (Exp 3 4 <> Exp 3 2 :: Polar Int)+  , testCase "Vec" $ Vec 3 [1,2,3] @?= (Vec 1 [1 :: Int] <> Vec 2 [2,3])+  , testCase "Unshowable" $ "Unshowable {fun = _, io = _, int = 42}" @?= show (Unshowable id (pure True) 42) #endif   ]

@@ -21,7 +21,8 @@   deriving (Generic, Generic1)  instance Semigroup a => Semigroup (P a) where-  x <> y = unGenerically (Generically x <> Generically y)+  x <> y = case Generically x <> Generically y of+    Generically z -> z  type PTy a = a -> a -> Generically (P a)