generics-sop 0.2.5.0 → 0.3.0.0

raw patch · 7 files changed

+486/−11 lines, 7 filesdep ~basedep ~template-haskelldep ~transformers-compatPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: base, template-haskell, transformers-compat

API changes (from Hackage documentation)

Files

• CHANGELOG.md +33/−0
• generics-sop.cabal +2/−1
• src/Generics/SOP/GGP.hs +61/−1
• src/Generics/SOP/TH.hs +98/−6
• src/Generics/SOP/Type/Metadata.hs +270/−0
• src/Generics/SOP/Universe.hs +13/−2
• test/Example.hs +9/−1

@@ -1,3 +1,36 @@+# 0.3.0.0 (2017-04-29)++* No longer compatible with GHC 7.6, due to the lack of+  support for type-level literals.++* Support type-level metadata. This is provided by the+  `Generics.SOP.Type.Metadata` module. The two modules+  `Generics.SOP.Metadata` and `Generics.SOP.Type.Metadata`+  export nearly the same names, so for backwards compatibility,+  we keep exporting `Generics.SOP.Metadata` directly from+  `Generics.SOP`, whereas `Generics.SOP.Type.Metadata` is+  supposed to be imported explicitly (and qualified).++  Term-level metadata is still available, but is now usually+  computed automatically from the type-level metadata which+  contains the same information, using the function+  `demoteDatatypeInfo`. Term-level metadata is unchanged+  from generics-sop-0.2, so in most cases, even if your+  code makes use of metadata, you should not need to change+  anything.++  If you use TH deriving, then both type-level metadata and+  term-level metadata is generated for you automatically,+  for all supported GHC versions.++  If you use GGP deriving, then type-level metadata is+  available if you use GHC 8.0 or newer. If you use GHC 7.x,+  then GHC.Generics supports only term-level metadata, so+  we cannot translate that into type-level metadata. In+  this combination, you cannot use code that relies on+  type-level metadata, so you should either upgrade GHC or+  switch to TH-based deriving.+ # 0.2.5.0 (2017-04-21)  * GHC 8.2 compatibility.

@@ -1,5 +1,5 @@ name:                generics-sop-version:             0.2.5.0+version:             0.3.0.0 synopsis:            Generic Programming using True Sums of Products description:   A library to support the definition of generic functions.@@ -48,6 +48,7 @@                        Generics.SOP.GGP                        Generics.SOP.TH                        Generics.SOP.Dict+                       Generics.SOP.Type.Metadata                        -- exposed via Generics.SOP:                        Generics.SOP.BasicFunctors                        Generics.SOP.Classes

@@ -1,4 +1,7 @@-{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE PolyKinds, UndecidableInstances #-}+#if __GLASGOW_HASKELL__ >= 780+{-# OPTIONS_GHC -fno-warn-unticked-promoted-constructors #-}+#endif -- | Derive @generics-sop@ boilerplate instances from GHC's 'GHC.Generic'. -- -- The technique being used here is described in the following paper:@@ -12,6 +15,9 @@   , GFrom   , GTo   , GDatatypeInfo+#if MIN_VERSION_base(4,9,0)+  , GDatatypeInfoOf+#endif   , gfrom   , gto   , gdatatypeInfo@@ -22,9 +28,16 @@ import Generics.SOP.NP as SOP import Generics.SOP.NS as SOP import Generics.SOP.BasicFunctors as SOP+#if !(MIN_VERSION_base(4,9,0)) import Generics.SOP.Constraint as SOP+#endif+#if MIN_VERSION_base(4,9,0)+import qualified Generics.SOP.Type.Metadata as SOP.T+#endif import Generics.SOP.Metadata as SOP+#if !(MIN_VERSION_base(4,9,0)) import Generics.SOP.Sing+#endif  type family ToSingleCode (a :: * -> *) :: * type instance ToSingleCode (K1 _i a) = a@@ -46,6 +59,7 @@ data InfoProxy (c :: *) (f :: * -> *) (x :: *) = InfoProxy #endif +#if !(MIN_VERSION_base(4,9,0)) class GDatatypeInfo' (a :: * -> *) where   gDatatypeInfo' :: proxy a -> DatatypeInfo (ToSumCode a '[]) @@ -105,7 +119,37 @@     where       p :: InfoProxy c a x       p = InfoProxy+#endif +#if MIN_VERSION_base(4,9,0)+type family ToInfo (a :: * -> *) :: SOP.T.DatatypeInfo+type instance ToInfo (M1 D (MetaData n m p False) a) =+  SOP.T.ADT m n (ToSumInfo a '[])+type instance ToInfo (M1 D (MetaData n m p True) a) =+  SOP.T.Newtype m n (ToSingleConstructorInfo a)++type family ToSumInfo (a :: * -> *) (xs :: [SOP.T.ConstructorInfo]) :: [SOP.T.ConstructorInfo]+type instance ToSumInfo (a :+: b)  xs = ToSumInfo a (ToSumInfo b xs)+type instance ToSumInfo V1         xs = xs+type instance ToSumInfo (M1 C c a) xs = ToSingleConstructorInfo (M1 C c a) ': xs++type family ToSingleConstructorInfo (a :: * -> *) :: SOP.T.ConstructorInfo+type instance ToSingleConstructorInfo (M1 C (MetaCons n PrefixI False) a) =+  SOP.T.Constructor n+type instance ToSingleConstructorInfo (M1 C (MetaCons n (InfixI assoc fix) False) a) =+  SOP.T.Infix n assoc fix+type instance ToSingleConstructorInfo (M1 C (MetaCons n f True) a) =+  SOP.T.Record n (ToProductInfo a '[])++type family ToProductInfo (a :: * -> *) (xs :: [SOP.T.FieldInfo]) :: [SOP.T.FieldInfo]+type instance ToProductInfo (a :*: b)  xs = ToProductInfo a (ToProductInfo b xs)+type instance ToProductInfo U1         xs = xs+type instance ToProductInfo (M1 S c a) xs = ToSingleInfo (M1 S c a) ': xs++type family ToSingleInfo (a :: * -> *) :: SOP.T.FieldInfo+type instance ToSingleInfo (M1 S (MetaSel (Just n) _su _ss _ds) a) = 'SOP.T.FieldInfo n+#endif+ class GFieldInfos (a :: * -> *) where   gFieldInfos :: proxy a -> NP FieldInfo xs -> NP FieldInfo (ToProductCode a xs) @@ -209,8 +253,20 @@ type GTo a = GSumTo (GHC.Rep a)  -- | Constraint for the class that computes 'gdatatypeInfo'.+#if MIN_VERSION_base(4,9,0)+type GDatatypeInfo a = SOP.T.DemoteDatatypeInfo (GDatatypeInfoOf a) (GCode a)+#else type GDatatypeInfo a = GDatatypeInfo' (GHC.Rep a)+#endif +#if MIN_VERSION_base(4,9,0)+-- | Compute the datatype info of a datatype.+--+-- @since 0.3.0.0+--+type GDatatypeInfoOf (a :: *) = ToInfo (GHC.Rep a)+#endif+ -- | An automatically computed version of 'Generics.SOP.from'. -- -- This requires that the type being converted has a@@ -242,5 +298,9 @@ -- For more info, see 'Generics.SOP.HasDatatypeInfo'. -- gdatatypeInfo :: forall proxy a. (GDatatypeInfo a) => proxy a -> DatatypeInfo (GCode a)+#if MIN_VERSION_base(4,9,0)+gdatatypeInfo _ = SOP.T.demoteDatatypeInfo (Proxy :: Proxy (GDatatypeInfoOf a))+#else gdatatypeInfo _ = gDatatypeInfo' (Proxy :: Proxy (GHC.Rep a))+#endif 

@@ -5,15 +5,18 @@   , deriveGenericOnly   , deriveGenericFunctions   , deriveMetadataValue+  , deriveMetadataType   ) where  import Control.Monad (replicateM) import Data.Maybe (fromMaybe)+import Data.Proxy import Language.Haskell.TH import Language.Haskell.TH.Syntax  import Generics.SOP.BasicFunctors import qualified Generics.SOP.Metadata as SOP+import qualified Generics.SOP.Type.Metadata as SOP.T import Generics.SOP.NP import Generics.SOP.NS import Generics.SOP.Universe@@ -51,8 +54,12 @@ -- >   to _ = error "unreachable" -- to avoid GHC warnings -- > -- > instance HasDatatypeInfo Tree where--- >   datatypeInfo _ = ADT "Main" "Tree"--- >     (Constructor "Leaf" :* Constructor "Node" :* Nil)+-- >   type DatatypeInfoOf Tree =+-- >     T.ADT "Main" "Tree"+-- >       '[ T.Constructor "Leaf", T.Constructor "Node" ]+-- >+-- >   datatypeInfo _ =+-- >     T.demoteDatatypeInfo (Proxy :: Proxy (DatatypeInfoOf Tree)) -- -- /Limitations:/ Generation does not work for GADTs, for -- datatypes that involve existential quantification, for@@ -134,7 +141,30 @@     sequence [ sigD datatypeInfoName' [t| SOP.DatatypeInfo $(conT codeName') |]                    -- treeDatatypeInfo :: DatatypeInfo TreeCode              , funD datatypeInfoName' [clause [] (normalB $ metadata' isNewtype name cons) []] -- treeDatatypeInfo = ...              ]+{-# DEPRECATED deriveMetadataValue "Use 'deriveMetadataType' and 'demoteDatatypeInfo' instead." #-} +-- | Derive @DatatypeInfo@ type for the type.+--+-- /Example:/ If you say+--+-- > deriveMetadataType ''Tree "TreeDatatypeInfo"+--+-- then you get code that is equivalent to:+--+-- > type TreeDatatypeInfo =+-- >   T.ADT "Main" "Tree"+-- >     [ T.Constructor "Leaf", T.Constructor "Node" ]+--+-- @since 0.3.0.0+--+deriveMetadataType :: Name -> String -> Q [Dec]+deriveMetadataType n datatypeInfoName = do+  let datatypeInfoName' = mkName datatypeInfoName+  dec <- reifyDec n+  withDataDec dec $ \ isNewtype _ctx name _bndrs cons _derivs ->+    sequence+      [ tySynD datatypeInfoName' [] (metadataType' isNewtype name cons) ]+ deriveGenericForDataDec :: Bool -> Cxt -> Name -> [TyVarBndr] -> [Con] -> Derivings -> Q [Dec] deriveGenericForDataDec _isNewtype _cxt name bndrs cons _derivs = do   let typ = appTyVars name bndrs@@ -154,7 +184,14 @@   let typ = appTyVars name bndrs   md   <- instanceD (cxt [])             [t| HasDatatypeInfo $typ |]-            [metadata isNewtype name cons]+            [ metadataType typ isNewtype name cons+            , funD 'datatypeInfo+                [ clause [wildP]+                  (normalB [| SOP.T.demoteDatatypeInfo (Proxy :: Proxy (DatatypeInfoOf $typ)) |])+                  []+                ]+            ]+            -- [metadata isNewtype name cons]   return [md]  @@ -212,10 +249,11 @@   Compute metadata -------------------------------------------------------------------------------} -metadata :: Bool -> Name -> [Con] -> Q Dec-metadata isNewtype typeName cs =-    funD 'datatypeInfo [clause [wildP] (normalB $ metadata' isNewtype typeName cs) []]+metadataType :: Q Type -> Bool -> Name -> [Con] -> Q Dec+metadataType typ isNewtype typeName cs =+  tySynInstD ''DatatypeInfoOf (tySynEqn [typ] (metadataType' isNewtype typeName cs)) +-- | Derive term-level metadata. metadata' :: Bool -> Name -> [Con] -> Q Exp metadata' isNewtype typeName cs = md   where@@ -263,6 +301,54 @@     mdAssociativity InfixR = [| SOP.RightAssociative |]     mdAssociativity InfixN = [| SOP.NotAssociative   |] +-- | Derive type-level metadata.+metadataType' :: Bool -> Name -> [Con] -> Q Type+metadataType' isNewtype typeName cs = md+  where+    md :: Q Type+    md | isNewtype = [t| 'SOP.T.Newtype $(stringT (nameModule' typeName))+                                        $(stringT (nameBase typeName))+                                        $(mdCon (head cs))+                       |]+       | otherwise = [t| 'SOP.T.ADT     $(stringT (nameModule' typeName))+                                        $(stringT (nameBase typeName))+                                        $(promotedTypeList $ map mdCon cs)+                       |]+++    mdCon :: Con -> Q Type+    mdCon (NormalC n _)   = [t| 'SOP.T.Constructor $(stringT (nameBase n)) |]+    mdCon (RecC n ts)     = [t| 'SOP.T.Record      $(stringT (nameBase n))+                                                   $(promotedTypeList (map mdField ts))+                              |]+    mdCon (InfixC _ n _)  = do+#if MIN_VERSION_template_haskell(2,11,0)+      fixity <- reifyFixity n+      case fromMaybe defaultFixity fixity of+        Fixity f a ->+#else+      i <- reify n+      case i of+        DataConI _ _ _ (Fixity f a) ->+#endif+                            [t| 'SOP.T.Infix       $(stringT (nameBase n)) $(mdAssociativity a) $(natT f) |]+#if !MIN_VERSION_template_haskell(2,11,0)+        _                -> fail "Strange infix operator"+#endif+    mdCon (ForallC _ _ _) = fail "Existentials not supported"+#if MIN_VERSION_template_haskell(2,11,0)+    mdCon (GadtC _ _ _)    = fail "GADTs not supported"+    mdCon (RecGadtC _ _ _) = fail "GADTs not supported"+#endif++    mdField :: VarStrictType -> Q Type+    mdField (n, _, _) = [t| 'SOP.T.FieldInfo $(stringT (nameBase n)) |]++    mdAssociativity :: FixityDirection -> Q Type+    mdAssociativity InfixL = [t| 'SOP.T.LeftAssociative  |]+    mdAssociativity InfixR = [t| 'SOP.T.RightAssociative |]+    mdAssociativity InfixN = [t| 'SOP.T.NotAssociative   |]+ nameModule' :: Name -> String nameModule' = fromMaybe "" . nameModule @@ -299,6 +385,12 @@ conInfo (GadtC _ _ _)    = fail "GADTs not supported" conInfo (RecGadtC _ _ _) = fail "GADTs not supported" #endif++stringT :: String -> Q Type+stringT = litT . strTyLit++natT :: Int -> Q Type+natT = litT . numTyLit . fromIntegral  promotedTypeList :: [Q Type] -> Q Type promotedTypeList []     = promotedNilT

@@ -0,0 +1,270 @@+{-# LANGUAGE PolyKinds, UndecidableInstances #-}+-- | Type-level metadata+--+-- This module provides datatypes (to be used promoted) that can represent the+-- metadata of Haskell datatypes on the type level.+--+-- We do not reuse the term-level metadata types, because these are GADTs that+-- incorporate additional invariants. We could (at least in GHC 8) impose the+-- same invariants on the type level as well, but some tests have revealed that+-- the resulting type are rather inconvenient to work with.+--+-- So we use simple datatypes to represent the type-level metadata, even if+-- this means that some invariants are not explicitly captured.+--+-- We establish a relation between the term- and type-level versions of the+-- metadata by automatically computing the term-level version from the type-level+-- version.+--+-- As we now have two versions of metadata (term-level and type-level)+-- with very similar, yet slightly different datatype definitions, the names+-- between the modules clash, and this module is recommended to be imported+-- qualified when needed.+--+-- The interface exported by this module is still somewhat experimental.+--+-- @since 0.3.0.0+--+module Generics.SOP.Type.Metadata+  ( module Generics.SOP.Type.Metadata+    -- * re-exports+  , Associativity(..)+  ) where++import Data.Proxy+import GHC.Generics (Associativity(..))+#if __GLASGOW_HASKELL__ >= 800+import GHC.Types+#endif+import GHC.TypeLits++import qualified Generics.SOP.Metadata as M+import Generics.SOP.NP+import Generics.SOP.Sing++-- Regarding the CPP in the datatype definitions below:+--+-- We cannot promote type synonyms in GHC 7, so we+-- use equivalent yet less descriptive definitions+-- for the older GHCs.++-- | Metadata for a datatype (to be used promoted).+--+-- A type of kind @'DatatypeInfo'@ contains meta-information about a datatype+-- that is not contained in its code. This information consists+-- primarily of the names of the datatype, its constructors, and possibly its+-- record selectors.+--+-- The constructor indicates whether the datatype has been declared using @newtype@+-- or not.+--+-- @since 0.3.0.0+--+data DatatypeInfo =+#if __GLASGOW_HASKELL__ >= 800+    ADT ModuleName DatatypeName [ConstructorInfo]+    -- ^ Standard algebraic datatype+  | Newtype ModuleName DatatypeName ConstructorInfo+    -- ^ Newtype+#else+    ADT Symbol Symbol [ConstructorInfo]+    -- ^ Standard algebraic datatype+  | Newtype Symbol Symbol ConstructorInfo+    -- ^ Newtype+#endif++-- | Metadata for a single constructors (to be used promoted).+--+-- @since 0.3.0.0+--+data ConstructorInfo =+#if __GLASGOW_HASKELL__ >= 800+    Constructor ConstructorName+    -- ^ Normal constructor+  | Infix ConstructorName Associativity Fixity+    -- ^ Infix constructor+  | Record ConstructorName [FieldInfo]+    -- ^ Record constructor+#else+    Constructor Symbol+    -- ^ Normal constructor+  | Infix Symbol Associativity Nat+    -- ^ Infix constructor+  | Record Symbol [FieldInfo]+    -- ^ Record constructor+#endif++-- | Metadata for a single record field (to be used promoted).+--+-- @since 0.3.0.0+--+data FieldInfo =+#if __GLASGOW_HASKELL__ >= 800+    FieldInfo FieldName+#else+    FieldInfo Symbol+#endif++#if __GLASGOW_HASKELL__ >= 800+-- | The name of a datatype.+type DatatypeName    = Symbol++-- | The name of a module.+type ModuleName      = Symbol++-- | The name of a data constructor.+type ConstructorName = Symbol++-- | The name of a field / record selector.+type FieldName       = Symbol++-- | The fixity of an infix constructor.+type Fixity          = Nat+#endif++-- Demotion+--+-- The following classes are concerned with computing the+-- term-level metadata from the type-level metadata.++-- | Class for computing term-level datatype information from+-- type-level datatype information.+--+-- @since 0.3.0.0+--+class DemoteDatatypeInfo (x :: DatatypeInfo) (xss :: [[*]]) where+  -- | Given a proxy of some type-level datatype information,+  -- return the corresponding term-level information.+  --+  -- @since 0.3.0.0+  --+  demoteDatatypeInfo :: proxy x -> M.DatatypeInfo xss++instance+     (KnownSymbol m, KnownSymbol d, DemoteConstructorInfos cs xss)+  => DemoteDatatypeInfo ('ADT m d cs) xss where+  demoteDatatypeInfo _ =+    M.ADT+      (symbolVal (Proxy :: Proxy m))+      (symbolVal (Proxy :: Proxy d))+      (demoteConstructorInfos (Proxy :: Proxy cs))++instance+     (KnownSymbol m, KnownSymbol d, DemoteConstructorInfo c '[ x ])+  => DemoteDatatypeInfo ('Newtype m d c) '[ '[ x ] ] where+  demoteDatatypeInfo _ =+    M.Newtype+      (symbolVal (Proxy :: Proxy m))+      (symbolVal (Proxy :: Proxy d))+      (demoteConstructorInfo (Proxy :: Proxy c))++-- | Class for computing term-level constructor information from+-- type-level constructor information.+--+-- @since 0.3.0.0+--+class DemoteConstructorInfos (cs :: [ConstructorInfo]) (xss :: [[*]]) where+  -- | Given a proxy of some type-level constructor information,+  -- return the corresponding term-level information as a product.+  --+  -- @since 0.3.0.0+  --+  demoteConstructorInfos :: proxy cs -> NP M.ConstructorInfo xss++instance DemoteConstructorInfos '[] '[] where+  demoteConstructorInfos _ = Nil++instance+     (DemoteConstructorInfo c xs, DemoteConstructorInfos cs xss)+  => DemoteConstructorInfos (c ': cs) (xs ': xss) where+  demoteConstructorInfos _ =+    demoteConstructorInfo (Proxy :: Proxy c) :* demoteConstructorInfos (Proxy :: Proxy cs)++-- | Class for computing term-level constructor information from+-- type-level constructor information.+--+-- @since 0.3.0.0+--+class DemoteConstructorInfo (x :: ConstructorInfo) (xs :: [*]) where+  -- | Given a proxy of some type-level constructor information,+  -- return the corresponding term-level information.+  --+  -- @since 0.3.0.0+  --+  demoteConstructorInfo :: proxy x -> M.ConstructorInfo xs++instance (KnownSymbol s, SListI xs) => DemoteConstructorInfo ('Constructor s) xs where+  demoteConstructorInfo _ = M.Constructor (symbolVal (Proxy :: Proxy s))++instance+     (KnownSymbol s, DemoteAssociativity a, KnownNat f)+  => DemoteConstructorInfo ('Infix s a f) [y, z] where+  demoteConstructorInfo _ =+    M.Infix+      (symbolVal (Proxy :: Proxy s))+      (demoteAssociativity (Proxy :: Proxy a))+      (fromInteger (natVal (Proxy :: Proxy f)))++instance (KnownSymbol s, DemoteFieldInfos fs xs) => DemoteConstructorInfo ('Record s fs) xs where+  demoteConstructorInfo _ =+    M.Record (symbolVal (Proxy :: Proxy s)) (demoteFieldInfos (Proxy :: Proxy fs))++-- | Class for computing term-level field information from+-- type-level field information.+--+-- @since 0.3.0.0+--+class SListI xs => DemoteFieldInfos (fs :: [FieldInfo]) (xs :: [*]) where+  -- | Given a proxy of some type-level field information,+  -- return the corresponding term-level information as a product.+  --+  -- @since 0.3.0.0+  --+  demoteFieldInfos :: proxy fs -> NP M.FieldInfo xs++instance DemoteFieldInfos '[] '[] where+  demoteFieldInfos _ = Nil++instance+     (DemoteFieldInfo f x, DemoteFieldInfos fs xs)+  => DemoteFieldInfos (f ': fs) (x ': xs) where+  demoteFieldInfos _ = demoteFieldInfo (Proxy :: Proxy f) :* demoteFieldInfos (Proxy :: Proxy fs)++-- | Class for computing term-level field information from+-- type-level field information.+--+-- @since 0.3.0.0+--+class DemoteFieldInfo (x :: FieldInfo) (a :: *) where+  -- | Given a proxy of some type-level field information,+  -- return the corresponding term-level information.+  --+  -- @since 0.3.0.0+  --+  demoteFieldInfo :: proxy x -> M.FieldInfo a++instance KnownSymbol s => DemoteFieldInfo ('FieldInfo s) a where+  demoteFieldInfo _ = M.FieldInfo (symbolVal (Proxy :: Proxy s))++-- | Class for computing term-level associativity information+-- from type-level associativity information.+--+-- @since 0.3.0.0+--+class DemoteAssociativity (a :: Associativity) where+  -- | Given a proxy of some type-level associativity information,+  -- return the corresponding term-level information.+  --+  -- @since 0.3.0.0+  --+  demoteAssociativity :: proxy a -> M.Associativity++instance DemoteAssociativity 'LeftAssociative where+  demoteAssociativity _ = M.LeftAssociative++instance DemoteAssociativity 'RightAssociative where+  demoteAssociativity _ = M.RightAssociative++instance DemoteAssociativity 'NotAssociative where+  demoteAssociativity _ = M.NotAssociative+

@@ -13,6 +13,7 @@ import Generics.SOP.Sing import Generics.SOP.GGP import Generics.SOP.Metadata+import qualified Generics.SOP.Type.Metadata as T  -- | The (generic) representation of a datatype. --@@ -137,7 +138,17 @@ -- of 'Generic' for the options. -- class HasDatatypeInfo a where+  -- | Type-level datatype info+  type DatatypeInfoOf a :: T.DatatypeInfo+#if MIN_VERSION_base(4,9,0)+  type DatatypeInfoOf a = GDatatypeInfoOf a+#else+  type DatatypeInfoOf a = DatatypeInfoOf a+#endif++  -- | Term-level datatype info; by default, the term-level datatype info is produced+  -- from the type-level info.+  --   datatypeInfo         :: proxy a -> DatatypeInfo (Code a)-  default datatypeInfo :: (GDatatypeInfo a, Code a ~ GCode a)-                       => proxy a -> DatatypeInfo (Code a)+  default datatypeInfo :: (GDatatypeInfo a, GCode a ~ Code a) => proxy a -> DatatypeInfo (Code a)   datatypeInfo = gdatatypeInfo

@@ -10,6 +10,7 @@ import qualified GHC.Generics as GHC import Generics.SOP import Generics.SOP.TH+import qualified Generics.SOP.Type.Metadata as T  -- Generic show, kind of gshow :: (Generic a, All2 Show (Code a)) => a -> String@@ -43,7 +44,7 @@ treeB :: TreeB treeB = NodeB (LeafB 1) (LeafB 2) -deriveGenericOnly ''TreeB+deriveGeneric ''TreeB  instance Show TreeB where   show = gshow@@ -56,7 +57,11 @@  deriveGenericFunctions ''TreeC "TreeCCode" "fromTreeC" "toTreeC" deriveMetadataValue ''TreeC "TreeCCode" "treeDatatypeInfo"+deriveMetadataType ''TreeC "TreeDatatypeInfo" +demotedTreeDatatypeInfo :: DatatypeInfo TreeCCode+demotedTreeDatatypeInfo = T.demoteDatatypeInfo (Proxy :: Proxy TreeDatatypeInfo)+ instance Show TreeC where   show x = gshowS (fromTreeC x) @@ -66,5 +71,8 @@   print tree   print $ datatypeInfo (Proxy :: Proxy Tree)   print treeB+  print $ datatypeInfo (Proxy :: Proxy TreeB)   print treeC   print treeDatatypeInfo+  print demotedTreeDatatypeInfo+  print (treeDatatypeInfo == demotedTreeDatatypeInfo)