generic-data 0.3.0.0 → 0.4.0.0

raw patch · 9 files changed

+592/−34 lines, 9 filesdep +generic-lensdep ~basePVP ok

version bump matches the API change (PVP)

Dependencies added: generic-lens

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• CHANGELOG.md +9/−0
• README.md +73/−2
• generic-data.cabal +39/−2
• src/Generic/Data/Internal/Enum.hs +30/−30
• src/Generic/Data/Internal/Microsurgery.hs +195/−0
• src/Generic/Data/Microsurgery.hs +143/−0
• test/example.hs +27/−0
• test/lens-surgery.hs +37/−0
• test/microsurgery.hs +39/−0

@@ -1,3 +1,12 @@+# 0.4.0.0++- Created `Microsurgery` module. Initial set of surgeries:++    + `Derecordify`+    + `Typeage`+    + `RenameFields`, `RenameConstrs`+    + Some doc about using generic-lens for surgeries+ # 0.3.0.0  - Add generic implementations of `enumFrom`, `enumFromThen`, `enumFromTo`,

@@ -4,6 +4,35 @@  ## Generic deriving for standard classes +```haskell+{-# LANGUAGE DeriveGeneric #-}++-- base+import Data.Semigroup (Semigroup(..))+import GHC.Generics++-- generic-data+import Generic.Data (gmappend, Generically(..))+import Generic.Data.Orphans ()++data Foo a = Bar [a] [a] deriving Generic++instance Semigroup (Foo a) where+  (<>) = gmappend++-- also with some additional extensions --++{-# LANGUAGE+    DerivingStrategies,+    DerivingVia #-}  -- since GHC 8.6.1++data Foo a = Bar [a] [a]+  deriving Generic+  deriving Semigroup via (Generically (Foo a))++-- This example can be found in test/example.hs+```+ Supported classes that GHC currently can't derive: `Semigroup`, `Monoid`, `Applicative`, `Alternative`, `Eq1`, `Ord1`, `Show1`. @@ -15,13 +44,45 @@  (`Read` is currently not implemented.) -To derive type classes defined elsewhere, it might be worth taking a look at-[one-liner](https://hackage.haskell.org/package/one-liner).+To derive type classes outside of the standard library, it might be worth+taking a look at [one-liner](https://hackage.haskell.org/package/one-liner).  ## Type metadata  Extract type names, constructor names, number and arities of constructors, etc.. +## Type surgery++generic-data offers simple operations on generic representations.++More surgeries can be found in+[generic-data-surgery](https://hackage.haskell.org/package/generic-data-surgery).++```haskell+{-# LANGUAGE DeriveGeneric #-}++import GHC.Generic++import Generic.Data (gshowsPrec)+import Generic.Data.Microsurgery (unrecordify)++newtype T = T { unT :: Int } deriving Generic++-- Naively deriving Show would result in this being shown:+--+-- show (T 3) = "T {unT = 3}"+--+-- But instead, with a simple surgery, unrecordify, we can forget T was+-- declared as a record:+--+-- show (T 3) = "T 3"++instance Show T where+  showsPrec n = gshowsPrec n . unrecordify . toData++-- This example can be found in test/microsurgery.hs+```+ ---  ## Related links@@ -49,6 +110,16 @@   [first-class-families](https://hackage.haskell.org/package/first-class-families)   (second one written by me)   libraries for dependently-typed programming in Haskell.++---++## Internal module policy++Modules under `Generic.Data.Internal` are not subject to any versioning policy.+Breaking changes may apply to them at any time.++If something in those modules seems useful, please report it or create a pull+request to export it from an external module.  --- 

@@ -1,5 +1,5 @@ name:                generic-data-version:             0.3.0.0+version:             0.4.0.0 synopsis:            Utilities for GHC.Generics description:         This package provides common functions on generic types.                      See README.@@ -13,19 +13,21 @@ 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+tested-with:         GHC == 8.0.2, GHC == 8.2.2, GHC == 8.4.3, GHC == 8.6.1, GHC == 8.6.3  library   hs-source-dirs:      src   exposed-modules:     Generic.Data     Generic.Data.Types+    Generic.Data.Microsurgery     Generic.Data.Internal.Compat     Generic.Data.Internal.Data     Generic.Data.Internal.Enum     Generic.Data.Internal.Functions     Generic.Data.Internal.Generically     Generic.Data.Internal.Meta+    Generic.Data.Internal.Microsurgery     Generic.Data.Internal.Newtype     Generic.Data.Internal.Prelude     Generic.Data.Internal.Resolvers@@ -59,6 +61,41 @@   main-is: record.hs   build-depends:     generic-data,+    base+  ghc-options: -Wall+  default-language: Haskell2010+  type: exitcode-stdio-1.0++test-suite example-test+  hs-source-dirs: test+  main-is: example.hs+  build-depends:+    generic-data,+    base+  ghc-options: -Wall+  default-language: Haskell2010+  type: exitcode-stdio-1.0++test-suite microsurgery-test+  hs-source-dirs: test+  main-is: microsurgery.hs+  build-depends:+    tasty,+    tasty-hunit,+    generic-data,+    base+  ghc-options: -Wall+  default-language: Haskell2010+  type: exitcode-stdio-1.0++test-suite lens-surgery-test+  hs-source-dirs: test+  main-is: lens-surgery.hs+  build-depends:+    tasty,+    tasty-hunit,+    generic-data,+    generic-lens >= 1.1.0.0,     base   ghc-options: -Wall   default-language: Haskell2010

@@ -123,7 +123,7 @@ genumMin :: Int genumMin = 0 --- | > genumMin == gfromEnum gmaxBound+-- | > genumMax == gfromEnum gmaxBound genumMax :: forall opts a. (Generic a, GEnum opts (Rep a)) => Int genumMax = gCardinality @opts @(Rep a) - 1 @@ -199,36 +199,36 @@ -- Particularly 'Int' is an unfit field type, because the enumeration of the  -- negative values starts before 0.  ----- * Since 'GEnum' represents the cardinality explicitly as an 'Int', there can--- only be up to 'maxBound' values. 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 generic type as a whole.--- --- The resulting 'GEnum' instance starts enumerating from @0@ up to --- @(cardinality - 1)@ and respects the generic 'Ord' instance. --- Implied by this the values from different constructors are enumerated--- sequentially. They are not interleaved. +-- * There can only be up to 'maxBound' 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+-- generic type as a whole. ----- To be very exact: The aforementioned generic 'Ord' instance can be determined--- by constraining the field types to 'Enum' instead of 'Ord'. Each field's --- order on its values is given by their enumeration.--- --- > data Example = C0 Bool Bool | C1 Bool--- >   deriving (Eq, Ord, Show, Generic)--- >--- > gCardinality == 6  -- 2 * 2 + 2--- > --- > enumeration = --- >     [ C0 False False--- >     , C0 False  True--- >     , C0  True False--- >     , C0  True  True--- >     , C1 False--- >     , C1 True--- >     ]--- >--- > enumeration == map gtoFiniteEnum [0 .. 5]--- > [0 .. 5] == map gfromFiniteEnum enumeration+-- The resulting 'GEnum' instance starts enumerating from @0@ up to+-- @(cardinality - 1)@ and respects the generic 'Ord' instance (defined by+-- 'Generic.Data.gcompare'). The values from different constructors are enumerated+-- sequentially; they are not interleaved.+--+-- @+-- data Example = C0 Bool Bool | C1 Bool+--   deriving ('Eq', 'Ord', 'Show', 'Generic')+--+-- cardinality = 6  -- 2    * 2    + 2+--                  -- Bool * Bool | Bool+--+-- enumeration =+--     [ C0 False False+--     , C0 False  True+--     , C0  True False+--     , C0  True  True+--     , C1 False+--     , C1 True+--     ]+--+-- enumeration == map 'gtoFiniteEnum' [0 .. 5]+-- [0 .. 5] == map 'gfromFiniteEnum' enumeration+-- @ data FiniteEnum  instance GEnum opts f => GEnum opts (M1 i c f) where

@@ -0,0 +1,195 @@+{-# LANGUAGE+    AllowAmbiguousTypes,+    DataKinds,+    FlexibleContexts,+    FlexibleInstances,+    MultiParamTypeClasses,+    PolyKinds,+    ScopedTypeVariables,+    TypeFamilies,+    TypeOperators,+    UndecidableInstances #-}++-- | Surgeries that are just 'coerce'.++module Generic.Data.Internal.Microsurgery where++import Data.Coerce (Coercible, coerce)+import GHC.Generics+import GHC.TypeLits (ErrorMessage(..), Symbol, TypeError)++import Generic.Data.Types++-- * Derecordify++derecordify ::+  Coercible (Derecordify f) f =>+  -- Coercible is not symmetric!??+  Data f p -> Data (Derecordify f) p+derecordify = coerce++underecordify ::+  Coercible f (Derecordify f) =>+  Data (Derecordify f) p -> Data f p+underecordify = coerce++-- | Forget that a type was declared using record syntax.+--+-- > data Foo = Bar { baz :: Zap }+-- >+-- > -- becomes --+-- >+-- > data Foo = Bar Zap+--+-- 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++-- * Type aging ("denewtypify")++typeage ::+  Coercible (Typeage f) f =>+  Data f p -> Data (Typeage f) p+typeage = coerce++untypeage ::+  Coercible f (Typeage f) =>+  Data (Typeage f) p -> Data f p+untypeage = coerce++-- | Forget that a type is a @newtype@.+--+-- > 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++-- * Renaming++renameFields ::+  forall rnm f p.+  Coercible (RenameFields rnm f) f =>+  Data f p -> Data (RenameFields rnm f) p+renameFields = coerce++unrenameFields ::+  forall rnm f p.+  Coercible (RenameFields rnm f) f =>+  Data f p -> Data (RenameFields rnm f) p+unrenameFields = coerce++renameConstrs ::+  forall rnm f p.+  Coercible (RenameConstrs rnm f) f =>+  Data f p -> Data (RenameConstrs rnm f) p+renameConstrs = coerce++unrenameConstrs ::+  forall rnm f p.+  Coercible (RenameConstrs rnm f) f =>+  Data f p -> Data (RenameConstrs rnm f) p+unrenameConstrs = coerce++-- | Rename fields using the function @rnm@ given as a parameter.+--+-- > data Foo = Bar { baz :: Zap }+-- >+-- > -- 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++-- | Rename constructors using the function @rnm@ given as a parameter.+--+-- > data Foo = Bar { baz :: Zap }+-- >+-- > -- 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++-- ** Defining symbol functions++-- | @f \@\@ s@ is the application of a type-level function symbolized by @f@+-- to a @s :: 'Symbol'@.+--+-- A function @FooToBar@ can be defined as follows:+--+-- @+-- data FooToBar+-- type instance FooToBar '@@' \"foo\" = \"bar\"+-- @+type family (f :: *) @@ (s :: Symbol) :: Symbol++-- | Identity function @'Symbol' -> 'Symbol'@.+data SId+type instance SId @@ s = s++-- | Empty function (compile-time error when applied).+data SError+type instance SError @@ s = TypeError ('Text "Invalid name: " ':<>: 'ShowType s)++-- | Constant function.+data SConst (s :: Symbol)+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 :: *)+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+  SRename' '[] f s = f @@ s+  SRename' ('( s,  t) ': _xs) _f s = t+  SRename' ('(_r, _t) ':  xs)  f s = SRename' xs f s++-- * Other++-- This can be used with generic-lens (see Generic.Data.Microsurgery)++-- | Unify the "spines" of two generic representations (the "spine" is+-- everything except the field types).+class UnifyRep (f :: k -> *) (g :: k -> *)+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'+instance (g' ~ (g1 :*: g2), UnifyRep f1 g1, UnifyRep f2 g2)+  => UnifyRep (f1 :*: f2) g'+instance (g' ~ K1 i b) => UnifyRep (K1 i a) g'+instance (g' ~ U1) => UnifyRep U1 g'+instance (g' ~ V1) => UnifyRep V1 g'++-- |+--+-- > onData :: _ => (a -> b) -> (a -> b)  -- possible specialization+--+-- Can be used with @generic-lens@ for type-changing field updates with @field_@+-- (and possibly other generic optics).+--+-- A specialization of the identity function to be used to fix types+-- of functions using 'Data' as input or output, unifying the "spines" of input+-- and output generic representations (the "spine" is everything except field+-- types, which may thus change).+onData+  :: (UnifyRep (Rep a) (Rep b), UnifyRep (Rep a) (Rep b))+  => p a b -> p a b+onData = id

@@ -0,0 +1,143 @@+{-# LANGUAGE ExplicitNamespaces #-}++-- | Simple operations on generic representations, that only change the+-- type-level metadata used by certain generic functions.+--+-- More complex ones can be found in+-- <https://hackage.haskell.org/package/generic-data-surgery generic-data-surgery>+-- and, surprisingly, in <https://hackage.haskell.org/package/generic-lens generic-lens>+-- (read more about this just below).++module Generic.Data.Microsurgery+  ( -- * Surgeries with generic-lens++    -- $lens-surgery++    -- * Synthetic types++    Data+  , toData+  , fromData+  , onData++    -- * Microsurgeries+    --+    -- | Each microsurgery consists of a type family @F@ to modify metadata in+    -- GHC Generic representations, and two mappings (that are just+    -- 'Data.Coerce.coerce'):+    --+    -- @+    --   f :: 'Data' ('GHC.Generics.Rep' a) p -> 'Data' (F ('GHC.Generics.Rep' a)) p+    -- unf :: 'Data' (F ('GHC.Generics.Rep' a)) p -> 'Data' ('GHC.Generics.Rep' a) p+    -- @+    --+    -- Use @f@ with 'toData' for generic functions that consume generic values,+    -- and @unf@ with 'fromData' for generic functions that produce generic+    -- values. Abstract example:+    --+    -- @+    -- genericSerialize . f . 'toData'+    -- 'fromData' . unf . genericDeserialize+    -- @++    -- ** Derecordify++  , Derecordify+  , derecordify+  , underecordify++    -- ** Type aging ("denewtypify")++  , Typeage+  , typeage+  , untypeage++    -- ** Renaming of fields and constructors+    -- | These surgeries require @DataKinds@ and @TypeApplications@.+    --+    -- ==== Examples+    --+    -- @+    -- {-# LANGUAGE+    --     DataKinds,+    --     TypeApplications #-}+    --+    -- -- Rename all fields to \"foo\"+    -- 'renameFields' \@('SConst' \"foo\")+    --+    -- -- Rename constructor \"Bar\" to \"Baz\", and leave all others the same+    -- 'renameConstrs' \@('SRename' '[ '(\"Bar\", \"Baz\") ] 'SId')+    -- @++  , RenameFields+  , renameFields+  , unrenameFields++  , RenameConstrs+  , renameConstrs+  , unrenameConstrs++    -- *** Renaming functions++  , type (@@)+  , SId+  , SError+  , SConst+  , SRename++  ) where++import Generic.Data.Internal.Data+import Generic.Data.Internal.Microsurgery++-- $lens-surgery+-- One common and simple situation is to modify the type of some fields,+-- for example wrapping them in a newtype.+--+-- We can leverage the @generic-lens@ library, with the two functions below.+--+-- @+-- -- Lens to a field named @fd@ in a Generic record.+-- field_ :: HasField_ fd s t a b => Lens s t a b  -- from generic-lens+--+-- -- Update a value through a lens (ASetter is a specialization of Lens).+-- over :: ASetter s t a b -> (a -> b) -> s -> t   -- from lens or microlens+-- @+--+-- For example, here is a record type:+--+-- @+-- data R = R { myField :: Int } deriving 'GHC.Generics.Generic'+-- @+--+-- The function @over (field_ \@\"myField\") 'Generic.Data.Opaque'@+-- applies the newtype constructor 'Generic.Data.Opaque' to the field+-- @\"myField\"@, but this actually doesn't typecheck as-is. With a bit of help+-- from this module, we can wrap that function as follows:+--+-- @+-- 'onData' (over (field_ \@\"myField\") 'Generic.Data.Opaque') . 'toData'+--   :: R -> 'Data' _ _   -- type arguments hidden+-- @+--+-- The result has a type @'Data' _ _@, that from the point of view of "GHC.Generics"+-- looks just like @R@ but with the field @\"myField\"@ wrapped in+-- 'Generic.Data.Opaque', as if we had defined:+--+-- @+-- data R = R { myField :: 'Generic.Data.Opaque' Int } deriving 'GHC.Generics.Generic'+-- @+--+-- ==== Example usage+--+-- We derive an instance of 'Show' that hides the @\"myField\"@ field,+-- whatever its type.+--+-- @+-- instance 'Show' R where+--   'showsPrec' n = 'Generic.Data.gshowsPrec' n+--     . 'onData' (over (field_ \@\"myField\") 'Generic.Data.Opaque')+--     . 'toData'+--+-- 'show' (R 3) = \"R {myField = _}\"+-- @

@@ -0,0 +1,27 @@+{-# LANGUAGE+    CPP,+    DeriveGeneric #-}+#if __GLASGOW_HASKELL__ >= 806+{-# LANGUAGE+    DerivingStrategies,+    DerivingVia #-}+#endif++import Data.Semigroup (Semigroup(..))+import GHC.Generics+import Generic.Data (gmappend, Generically(..))+import Generic.Data.Orphans ()++data Foo a = Bar [a] [a] deriving Generic++instance Semigroup (Foo a) where+  (<>) = gmappend++#if __GLASGOW_HASKELL__ >= 806+data Foo2 a = Bar2 [a] [a]+  deriving Generic+  deriving Semigroup via (Generically (Foo2 a))+#endif++main :: IO ()+main = pure ()

@@ -0,0 +1,37 @@+{-# LANGUAGE+    DataKinds,+    DeriveGeneric,+    TypeApplications,+    TypeOperators #-}++{-# OPTIONS_GHC -Wno-unused-top-binds #-}++import Data.Coerce (coerce)+import Data.Functor.Identity (Identity(..))+import GHC.Generics (Generic)+import Test.Tasty+import Test.Tasty.HUnit++import Data.Generics.Product (field_)++import Generic.Data (gshowsPrec, Opaque(Opaque))+import Generic.Data.Microsurgery (onData, toData)++data T = R { f :: Int -> Int } deriving Generic++instance Show T where +  showsPrec n = gshowsPrec n+    . onData (field_ @"f" %~ Opaque)+    . toData++(%~) :: ((a -> Identity b) -> s -> Identity t) -> (a -> b) -> s -> t+(%~) = coerce++main :: IO ()+main = defaultMain test++test :: TestTree+test = testGroup "lens-surgery"+  [ testCase "update" $+      "R {f = _}" @?= show (R id)+  ]

@@ -0,0 +1,39 @@+{-# LANGUAGE+    DeriveGeneric,+    DataKinds,+    TypeApplications #-}++-- @DataKinds@ and @TypeApplications@ for @renameFields@ and @renameConstrs@++import GHC.Generics -- We need to import the constructors for Coercible to resolve+import Test.Tasty+import Test.Tasty.HUnit++import Generic.Data+import Generic.Data.Microsurgery++-- From https://stackoverflow.com/questions/53864911/derive-positional-show++newtype T = T { _unT :: Int } deriving Generic++instance Show T where+  showsPrec n = gshowsPrec n . derecordify . toData++newtype U = U { _unU :: Int } deriving Generic++instance Show U where+  showsPrec n =+    gshowsPrec n+      . renameFields @(SRename '[ '("_unU", "unV")] SError)+      . renameConstrs @(SConst "V")+      . typeage  -- doesn't change anything, just a sanity check.+      . toData++main :: IO ()+main = defaultMain test++test :: TestTree+test = testGroup "microsurgery"+  [ testCase "Show T" $ "T 3" @?= show (T 3)+  , testCase "Show U" $ "V {unV = 3}" @?= show (U 3)+  ]