generic-data 0.5.0.0 → 0.6.0.0

raw patch · 12 files changed

+202/−71 lines, 12 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGELOG.md +7/−0
• README.md +22/−4
• generic-data.cabal +6/−4
• orphans/Generic/Data/Orphans.hs +2/−0
• src/Generic/Data.hs +3/−3
• src/Generic/Data/Internal/Enum.hs +3/−1
• src/Generic/Data/Internal/Functions.hs +2/−0
• src/Generic/Data/Internal/Meta.hs +1/−1
• src/Generic/Data/Internal/Microsurgery.hs +107/−50
• src/Generic/Data/Internal/Newtype.hs +9/−1
• src/Generic/Data/Microsurgery.hs +14/−6
• test/microsurgery.hs +26/−1

@@ -1,3 +1,10 @@+# 0.6.0.0++- Add `Surgery` newtype for DerivingVia+- `Derecordify`, `Typeage`, `RenameFields`, `RenameConstrs`, `OnFields`+  are no longer type families, but defunctionalized symbols+  to be applied using `GSurgery`.+ # 0.5.0.0  - Specialize `onData` to `Data`

@@ -53,7 +53,8 @@  ## Type surgery -generic-data offers simple operations on generic representations.+generic-data offers simple operations (microsurgeries) on generic+representations.  More surgeries can be found in [generic-data-surgery](https://hackage.haskell.org/package/generic-data-surgery),@@ -97,6 +98,23 @@ -- This example can be found in test/microsurgery.hs ``` +Alternatively, using `DerivingVia`:++```haskell+{-# LANGUAGE DeriveGeneric, DerivingVia #-}++import GHC.Generic (Generic)++-- Constructors must be visible to use DerivingVia+import Generic.Data.Microsurgery (Surgery, Surgery'(..), Generically(..), Derecordify)++data V = V { v1 :: Int, v2 :: Int }+  deriving Generic+  deriving Show via (Surgery Derecordify V)++-- show (V {v1 = 3, v2 = 4}) = "V 3 4"+```+ ---  ## Related links@@ -105,14 +123,14 @@ packages:  - [semigroups](https://hackage.haskell.org/package/semigroups): generic-  `Semigroup`, `Monoid`, but with a heavy dependency footprint.+  `Semigroup`, `Monoid`, but with a heavier dependency footprint. - [transformers-compat](https://hackage.haskell.org/package/transformers-compat):   generic `Eq1`, `Ord1`, `Show1`. - [generic-deriving](https://hackage.haskell.org/package/generic-deriving):   doesn't derive the classes in base (defines clones of these classes as a toy-  example); has Template Haskell code to derive `Generic`.+  example); has Template Haskell code to derive `Generic` (not in generic-data). -Here are other relevant links.+Other relevant links.  - [deriving-compat](https://hackage.haskell.org/package/deriving-compat):   deriving with Template Haskell.

@@ -1,8 +1,10 @@ name:                generic-data-version:             0.5.0.0-synopsis:            Utilities for GHC.Generics-description:         This package provides common functions on generic types.-                     See README.+version:             0.6.0.0+synopsis:            Deriving instances with GHC.Generics and related utilities+description:+  Generic implementations of standard type classes.+  Operations on generic representations to help using "GHC.Generics".+  See README. homepage:            https://github.com/Lysxia/generic-data#readme license:             MIT license-file:        LICENSE

@@ -5,6 +5,8 @@ {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TypeOperators #-} +-- | Orphan instances. They should probably be upstreamed.+ module Generic.Data.Orphans where  import Data.Functor.Classes

@@ -64,17 +64,17 @@     -- * Higher-kinded classes      -- ** 'Functor'-    -- | Can also be derived by GHC (`DeriveFunctor` extension).+    -- | Can also be derived by GHC (@DeriveFunctor@ extension).   , gfmap   , gconstmap      -- ** 'Foldable'-    -- | Can also be derived by GHC (`DeriveFoldable` extension).+    -- | Can also be derived by GHC (@DeriveFoldable@ extension).   , gfoldMap   , gfoldr      -- ** 'Traversable'-    -- | Can also be derived by GHC (`DeriveTraversable` extension).+    -- | Can also be derived by GHC (@DeriveTraversable@ extension).   , gtraverse   , gsequenceA 

@@ -8,6 +8,8 @@ {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeOperators #-} +-- | Generic deriving for 'Enum'.+ module Generic.Data.Internal.Enum where  import GHC.Generics@@ -199,7 +201,7 @@ -- Particularly 'Int' is an unfit field type, because the enumeration of the  -- negative values starts before 0.  ----- * There can only be up to 'maxBound' values (because the implementation+-- * There can only be up to @'maxBound' :: 'Int'@ values (because the implementation -- represents the cardinality explicitly as an 'Int'). This restriction makes -- 'Word' an invalid field type. Notably, it is insufficient for each -- individual field types to stay below this limit. Instead it applies to the

@@ -23,6 +23,7 @@ type instance NConstructors (f :+: g)  = NConstructors f + NConstructors g type instance NConstructors (M1 C c f) = 1 +-- | Number of constructors of a data type. nconstructors :: forall r. KnownNat (NConstructors r) => Integer nconstructors = natVal @(NConstructors r) Proxy @@ -32,5 +33,6 @@ type instance NFields (f :*: g)  = NFields f + NFields g type instance NFields (M1 S c f) = 1 +-- | Arity of a constructor. nfields :: forall r. KnownNat (NFields r) => Integer nfields = natVal @(NFields r) Proxy

@@ -144,7 +144,7 @@ conIdMax :: forall a. Constructors a => ConId a conIdMax = toConId gConIdMax --- | Constraint synonym for 'Generic' and 'GConstructor'.+-- | Constraint synonym for 'Generic' and 'GConstructors'. class (Generic a, GConstructors (Rep a)) => Constructors a instance (Generic a, GConstructors (Rep a)) => Constructors a 

@@ -18,19 +18,53 @@ import GHC.Generics import GHC.TypeLits (ErrorMessage(..), Symbol, TypeError) -import Generic.Data.Types+import Generic.Data.Types (Data)+import Generic.Data.Internal.Generically (Generically(..)) +-- * Surgery++-- | Apply a microsurgery @s@ to a type @a@ for @DerivingVia@.+--+-- === __Example__+--+-- @+-- {-\# LANGUAGE DerivingVia \#-}+--+-- -- The constructors must be visible.+-- import "Generic.Data.Microsurgery"+--   ('Surgery', 'Surgery''(..), 'Generically'(..), 'Derecordify')+--+-- data T = T { unT :: Int }+--   deriving 'Show' via ('Surgery' 'Derecordify' T)+--+-- -- T won't be shown as a record:+-- --   show (T {unT = 3}) == "T 3"+-- @+type Surgery (s :: *) (a :: *) = Generically (Surgery' s a)++-- | See 'Surgery''.+newtype Surgery' (s :: *) (a :: *) = 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)+  from = (coerce :: forall x. (a -> Rep a x) -> Surgery' s a -> GSurgery s (Rep a) x) from+  to = (coerce :: forall x. (Rep a x -> a) -> GSurgery s (Rep a) x -> Surgery' s a) to++-- | 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 -> *+ -- * Derecordify  derecordify ::-  Coercible (Derecordify f) f =>+  Coercible (GSurgery Derecordify f) f =>   -- Coercible is not symmetric!??-  Data f p -> Data (Derecordify f) p+  Data f p -> Data (GSurgery Derecordify f) p derecordify = coerce  underecordify ::-  Coercible f (Derecordify f) =>-  Data (Derecordify f) p -> Data f p+  Coercible f (GSurgery Derecordify f) =>+  Data (GSurgery Derecordify f) p -> Data f p underecordify = coerce  -- | Forget that a type was declared using record syntax.@@ -43,61 +77,69 @@ -- -- Concretely, set the last field of 'MetaCons' to 'False' and forget field -- names.-type family Derecordify (f :: k -> *) :: k -> *-type instance Derecordify (M1 D m f) = M1 D m (Derecordify f)-type instance Derecordify (f :+: g) = Derecordify f :+: Derecordify g-type instance Derecordify (f :*: g) = Derecordify f :*: Derecordify g-type instance Derecordify (M1 C ('MetaCons nm fx _isRecord) f) = M1 C ('MetaCons nm fx 'False) (Derecordify f)-type instance Derecordify (M1 S ('MetaSel _nm su ss ds) f) = M1 S ('MetaSel 'Nothing su ss ds) f-type instance Derecordify V1 = V1-type instance Derecordify U1 = U1+--+-- This is a defunctionalized symbol, to be applied using 'GSurgery'.+data Derecordify :: *+type instance GSurgery Derecordify f = GDerecordify f +type family GDerecordify (f :: k -> *) :: k -> *+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+type instance GDerecordify (M1 C ('MetaCons nm fx _isRecord) f) = M1 C ('MetaCons nm fx 'False) (GDerecordify f)+type instance GDerecordify (M1 S ('MetaSel _nm su ss ds) f) = M1 S ('MetaSel 'Nothing su ss ds) f+type instance GDerecordify V1 = V1+type instance GDerecordify U1 = U1+ -- * Type aging ("denewtypify")  typeage ::-  Coercible (Typeage f) f =>-  Data f p -> Data (Typeage f) p+  Coercible (GSurgery Typeage f) f =>+  Data f p -> Data (GSurgery Typeage f) p typeage = coerce  untypeage ::-  Coercible f (Typeage f) =>-  Data (Typeage f) p -> Data f p+  Coercible f (GSurgery Typeage f) =>+  Data (GSurgery Typeage f) p -> Data f p untypeage = coerce --- | Forget that a type is a @newtype@.+-- | Forget that a type is a @newtype@. (The pun is that \"aging\" a type makes+-- it no longer \"new\".) -- -- > newtype Foo = Bar Baz -- > -- > -- becomes -- -- > -- > data Foo = Bar Baz-type family Typeage (f :: k -> *) :: k -> *-type instance Typeage (M1 D ('MetaData nm md pk _nt) f) = M1 D ('MetaData nm md pk 'False) f+--+-- This is a defunctionalized symbol, to be applied using 'GSurgery'.+data Typeage :: *+type instance GSurgery Typeage (M1 D ('MetaData nm md pk _nt) f) = M1 D ('MetaData nm md pk 'False) f  -- * Renaming  renameFields ::   forall rnm f p.-  Coercible (RenameFields rnm f) f =>-  Data f p -> Data (RenameFields rnm f) p+  Coercible (GSurgery (RenameFields rnm) f) f =>+  Data f p -> Data (GSurgery (RenameFields rnm) f) p renameFields = coerce  unrenameFields ::   forall rnm f p.-  Coercible (RenameFields rnm f) f =>-  Data f p -> Data (RenameFields rnm f) p+  Coercible (GSurgery (RenameFields rnm) f) f =>+  Data f p -> Data (GSurgery (RenameFields rnm) f) p unrenameFields = coerce  renameConstrs ::   forall rnm f p.-  Coercible (RenameConstrs rnm f) f =>-  Data f p -> Data (RenameConstrs rnm f) p+  Coercible (GSurgery (RenameConstrs rnm) f) f =>+  Data f p -> Data (GSurgery (RenameConstrs rnm) f) p renameConstrs = coerce  unrenameConstrs ::   forall rnm f p.-  Coercible (RenameConstrs rnm f) f =>-  Data f p -> Data (RenameConstrs rnm f) p+  Coercible (GSurgery (RenameConstrs rnm) f) f =>+  Data f p -> Data (GSurgery (RenameConstrs rnm) f) p unrenameConstrs = coerce  -- | Rename fields using the function @rnm@ given as a parameter.@@ -107,15 +149,20 @@ -- > -- becomes, renaming "baz" to "bag" -- -- > -- > data Foo = Bar { bag :: Zap }-type family RenameFields (rnm :: *) (f :: k -> *) :: k -> *-type instance RenameFields rnm (M1 D m f) = M1 D m (RenameFields rnm f)-type instance RenameFields rnm (f :+: g) = RenameFields rnm f :+: RenameFields rnm g-type instance RenameFields rnm (f :*: g) = RenameFields rnm f :*: RenameFields rnm g-type instance RenameFields rnm (M1 C m f) = M1 C m (RenameFields rnm f)-type instance RenameFields rnm (M1 S ('MetaSel ('Just nm) su ss ds) f) = M1 S ('MetaSel ('Just (rnm @@ nm)) su ss ds) f-type instance RenameFields rnm V1 = V1-type instance RenameFields rnm U1 = U1+--+-- This is a defunctionalized symbol, to be applied using 'GSurgery'.+data RenameFields (rnm :: *) :: *+type instance GSurgery (RenameFields rnm) f = GRenameFields rnm f +type family GRenameFields (rnm :: *) (f :: k -> *) :: k -> *+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+type instance GRenameFields rnm (M1 C m f) = M1 C m (GRenameFields rnm f)+type instance GRenameFields rnm (M1 S ('MetaSel ('Just nm) su ss ds) f) = M1 S ('MetaSel ('Just (rnm @@ nm)) su ss ds) f+type instance GRenameFields rnm V1 = V1+type instance GRenameFields rnm U1 = U1+ -- | Rename constructors using the function @rnm@ given as a parameter. -- -- > data Foo = Bar { baz :: Zap }@@ -123,13 +170,18 @@ -- > -- becomes, renaming "Bar" to "Car" -- -- > -- > data Foo = Car { baz :: Zap }-type family RenameConstrs (rnm :: *) (f :: k -> *) :: k -> *-type instance RenameConstrs rnm (M1 D m f) = M1 D m (RenameConstrs rnm f)-type instance RenameConstrs rnm (f :+: g) = RenameConstrs rnm f :+: RenameConstrs rnm g-type instance RenameConstrs rnm (f :*: g) = RenameConstrs rnm f :*: RenameConstrs rnm g-type instance RenameConstrs rnm (M1 C ('MetaCons nm fi ir) f) = M1 C ('MetaCons (rnm @@ nm) fi ir) f-type instance RenameConstrs rnm V1 = V1+--+-- This is a defunctionalized symbol, to be applied using 'GSurgery'.+data RenameConstrs (rnm :: *) :: *+type instance GSurgery (RenameConstrs rnm) f = GRenameConstrs rnm f +type family GRenameConstrs (rnm :: *) (f :: k -> *) :: k -> *+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+type instance GRenameConstrs rnm (M1 C ('MetaCons nm fi ir) f) = M1 C ('MetaCons (rnm @@ nm) fi ir) f+type instance GRenameConstrs rnm V1 = V1+ -- ** Defining symbol functions  -- | @f \@\@ s@ is the application of a type-level function symbolized by @f@@@ -199,14 +251,19 @@  -- | Apply a type constructor @f@ to every field type of a generic -- representation @r@.-type family OnFields (f :: * -> *) (r :: k -> *) :: k -> *-type instance OnFields f (M1 s m r) = M1 s m (OnFields f r)-type instance OnFields f (r :+: s) = OnFields f r :+: OnFields f s-type instance OnFields f (r :*: s) = OnFields f r :*: OnFields f s-type instance OnFields f (K1 i a) = K1 i (f a)-type instance OnFields f U1 = U1-type instance OnFields f V1 = V1+--+-- This is a defunctionalized symbol, to be applied using 'GSurgery'.+data OnFields (f :: * -> *) :: *+type instance GSurgery (OnFields f) g = GOnFields f g +type family GOnFields (f :: * -> *) (g :: k -> *) :: k -> *+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+type instance GOnFields f (K1 i a) = K1 i (f a)+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 -- synthetic type.-type DOnFields (f :: * -> *) (a :: *) = Data (OnFields f (Rep a)) ()+type DOnFields (f :: * -> *) (a :: *) = Data (GSurgery (OnFields f) (Rep a)) ()

@@ -18,15 +18,23 @@  import Generic.Data.Internal.Meta (MetaDataNewtype, MetaOf) --- | Class of newtypes.+-- | Class of newtypes. There is an instance @'Newtype' a@ if and only if @a@+-- is a newtype and an instance of 'Generic'. class (Generic a, Coercible a (Old a), Newtype' a) => Newtype a instance (Generic a, Coercible a (Old a), Newtype' a) => Newtype a +-- | The type wrapped by a newtype.+--+-- @+-- newtype Foo = Foo { bar :: Bar } deriving 'Generic'+-- -- Old Foo ~ Bar+-- @ type Old a = GOld (Rep a)  type family GOld (f :: * -> *) where   GOld (D1 _d (C1 _c (S1 _s (K1 _i b)))) = b +-- | Use 'Newtype' instead. type Newtype' a = NewtypeErr a (MetaDataNewtype (MetaOf (Rep a)))  type family NewtypeErr a (b :: Bool) :: Constraint where

@@ -15,9 +15,16 @@      -- $lens-surgery +    -- * Deriving via++    Surgery+  , Surgery'(..)+  , GSurgery+  , Generically(..)+     -- * Synthetic types -    Data+  , Data   , toData   , fromData   , onData@@ -44,13 +51,13 @@      -- ** Derecordify -  , Derecordify+  , Derecordify()   , derecordify   , underecordify      -- ** Type aging ("denewtypify") -  , Typeage+  , Typeage()   , typeage   , untypeage @@ -71,11 +78,11 @@     -- 'renameConstrs' \@('SRename' '[ '(\"Bar\", \"Baz\") ] 'SId')     -- @ -  , RenameFields+  , RenameFields()   , renameFields   , unrenameFields -  , RenameConstrs+  , RenameConstrs()   , renameConstrs   , unrenameConstrs @@ -101,12 +108,13 @@     -- example of using one-liner and generic-lens with a synthetic type     -- constructed with 'DOnFields'. -  , OnFields+  , OnFields()   , DOnFields    ) where  import Generic.Data.Internal.Data+import Generic.Data.Internal.Generically import Generic.Data.Internal.Microsurgery  -- $lens-surgery

@@ -1,8 +1,13 @@ {-# LANGUAGE+    CPP,     DeriveGeneric,     DataKinds,     TypeApplications #-} +#if __GLASGOW_HASKELL__ >= 806+{-# LANGUAGE DerivingVia #-}+#endif+ -- @DataKinds@ and @TypeApplications@ for @renameFields@ and @renameConstrs@  import GHC.Generics (Generic)@@ -11,8 +16,19 @@  import Generic.Data (gshowsPrec) import Generic.Data.Microsurgery-  ( toData, derecordify, typeage, renameFields, renameConstrs, SConst, SError, SRename )+  ( toData+  , derecordify, typeage, renameFields, renameConstrs+  , SConst, SError, SRename+  ) +#if __GLASGOW_HASKELL__ >= 806+-- DerivingVia test+-- Constructors must be visible for Coercible+import Generic.Data.Microsurgery+  ( Surgery, Surgery'(..), Generically(..), Derecordify+  )+#endif+ -- From https://stackoverflow.com/questions/53864911/derive-positional-show  newtype T = T { _unT :: Int } deriving Generic@@ -30,6 +46,12 @@       . typeage  -- doesn't change anything, just a sanity check.       . toData +#if __GLASGOW_HASKELL__ >= 806+data V = V { v1 :: Int, v2 :: Int }+  deriving Generic+  deriving Show via (Surgery Derecordify V)+#endif+ main :: IO () main = defaultMain test @@ -37,4 +59,7 @@ test = testGroup "microsurgery"   [ testCase "Show T" $ "T 3" @?= show (T 3)   , testCase "Show U" $ "V {unV = 3}" @?= show (U 3)+#if __GLASGOW_HASKELL__ >= 806+  , testCase "Show V" $ "V 3 4" @?= show (V 3 4)+#endif   ]