diff --git a/generics-sop/generics-sop.cabal b/generics-sop/generics-sop.cabal index 2f75cff..0336023 100644 --- a/generics-sop/generics-sop.cabal +++ b/generics-sop/generics-sop.cabal @@ -70,6 +70,7 @@ library template-haskell >= 2.8 && < 2.20, th-abstraction >= 0.4 && < 0.5, ghc-prim >= 0.3 && < 0.10 + generically >= 0.1 hs-source-dirs: src default-language: Haskell2010 ghc-options: -Wall diff --git a/generics-sop/src/Generics/SOP.hs b/generics-sop/src/Generics/SOP.hs index 9b13241..1d445bc 100644 --- a/generics-sop/src/Generics/SOP.hs +++ b/generics-sop/src/Generics/SOP.hs @@ -50,20 +50,30 @@ -- > data A = C Bool | D A Int | E (B ()) -- > data B a = F | G a Char Bool -- --- To create 'Generic' instances for @A@ and @B@ via "GHC.Generics", we say +-- To create 'Generic' instances for @A@ and @B@ via "GHC.Generics", +-- we first derive @GHC.Generic@ and use that to @GHC.Generically@ +-- derive @SOP.Generic@: -- --- > {-# LANGUAGE DeriveGeneric #-} +-- > {-# LANGUAGE DeriveGeneric #-} +-- > {-# LANGUAGE DerivingStrategies #-} +-- > {-# LANGUAGE DerivingVia #-} -- > -- > import qualified GHC.Generics as GHC -- > import Generics.SOP -- > --- > data A = C Bool | D A Int | E (B ()) --- > deriving (Show, GHC.Generic) +-- > data A = C Bool | D A Int | E (B ()) +-- > deriving +-- > stock (Show, GHC.Generic) +-- > +-- > deriving Generic +-- > via GHC.Generically A +-- > -- > data B a = F | G a Char Bool --- > deriving (Show, GHC.Generic) +-- > deriving +-- > stock (Show, GHC.Generic) -- > --- > instance Generic A -- empty --- > instance Generic (B a) -- empty +-- > deriving Generic +-- > via GHC.Generically B -- -- Now we can convert between @A@ and @'Rep' A@ (and between @B@ and @'Rep' B@). -- For example, @@ -82,6 +92,9 @@ -- -- == Defining a generic function -- +-- To define a type class generically write an instance of +-- @SOP.Generically@. +-- -- As an example of a generic function, let us define a generic -- version of 'Control.DeepSeq.rnf' from the @deepseq@ package. -- @@ -100,24 +113,54 @@ -- sums and products, looks as follows: -- -- @ --- grnf :: ('Generic' a, 'All2' NFData ('Code' a)) => a -> () +-- grnf :: 'Generic' a => 'All2' NFData ('Code' a) => a -> () -- grnf x = grnfS ('from' x) -- --- grnfS :: ('All2' NFData xss) => 'SOP' 'I' xss -> () +-- grnfS :: 'All2' NFData xss => 'SOP' 'I' xss -> () -- grnfS ('SOP' ('Z' xs)) = grnfP xs -- grnfS ('SOP' ('S' xss)) = grnfS ('SOP' xss) -- --- grnfP :: ('All' NFData xs) => 'NP' 'I' xs -> () +-- grnfP :: 'All' NFData xs => 'NP' 'I' xs -> () -- grnfP 'Nil' = () -- grnfP ('I' x ':*' xs) = x \`deepseq\` (grnfP xs) -- @ -- --- The @grnf@ function performs the conversion between @a@ and @'Rep' a@ --- by applying 'from' and then applies @grnfS@. The type of @grnf@ --- indicates that @a@ must be in the 'Generic' class so that we can --- apply 'from', and that all the components of @a@ (i.e., all the types --- that occur as constructor arguments) must be in the 'NFData' class --- ('All2'). +-- This defines the generic 'Control.DeepEq.NFData' instance: +-- +-- @ +-- instance (SOP.Generic a, All2 NFData (Code a)) => NFData (SOP.Generically a) where +-- rnf :: SOP.Generically a -> () +-- rnf (SOP.Generically a) = grnf a +-- @ +-- +-- We can now derive an instance of 'NFData' using the SOP mechanism. +-- +-- @ +-- {-# Language DerivingStrategies #-} +-- {-# Language DerivingVia #-} +-- +-- import qualified Generics.SOP as SOP +-- import qualified GHC.Generics as GHC +-- +-- -- >> rnf (N 10 False [undefined]) +-- -- *** Exception: Prelude.undefined +-- data Nice = N Int Bool [Nice] +-- deriving +-- stock GHC.Generic +-- +-- deriving SOP.Generic +-- via GHC.Generically Nice +-- +-- deriving NFData +-- via SOP.Generically Nice +-- @ +-- +-- The 'from' function performs the conversion between @a@ and @'Rep' +-- a@ and then @grnfS@ is applied to evaluate it to normal form. The +-- constraints indicate that @a@ must be in the 'Generic' class so +-- that we can apply 'from', and that all the components of @a@ (i.e., +-- all the types that occur as constructor arguments) must be in the +-- 'NFData' class ('All2'). -- -- The function @grnfS@ traverses the outer sum structure of the -- sum of products (note that @'Rep' a = 'SOP' 'I' ('Code' a)@). It @@ -144,7 +187,7 @@ -- as follows: -- -- @ --- grnf :: ('Generic' a, 'All2' NFData ('Code' a)) => a -> () +-- grnf :: 'Generic' a => 'All2' NFData ('Code' a) => a -> () -- grnf = 'rnf' . 'hcollapse' . 'hcmap' ('Proxy' :: 'Proxy' NFData) ('mapIK' rnf) . 'from' -- @ -- @@ -192,8 +235,8 @@ -- in order to be able to use the 'grnf' function. But we can use 'grnf' -- to supply the instance definitions: -- --- > instance NFData A where rnf = grnf --- > instance NFData a => NFData (B a) where rnf = grnf +-- > deriving via SOP.Generically A instance NFData A +-- > deriving via SOP.Generically A instance NFData a => NFData (B a) -- -- = More examples -- @@ -222,6 +265,7 @@ module Generics.SOP ( -- * Codes and interpretations Generic(..) + , Generically(..) , Rep , IsProductType , ProductCode diff --git a/generics-sop/src/Generics/SOP/Universe.hs b/generics-sop/src/Generics/SOP/Universe.hs index 4b67a48..d68d904 100644 --- a/generics-sop/src/Generics/SOP/Universe.hs +++ b/generics-sop/src/Generics/SOP/Universe.hs @@ -1,5 +1,7 @@ -{-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE InstanceSigs #-} +{-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE UndecidableSuperClasses #-} + -- | Codes and interpretations module Generics.SOP.Universe where @@ -10,10 +12,11 @@ import qualified GHC.Generics as GHC import Generics.SOP.BasicFunctors import Generics.SOP.Constraint -import Generics.SOP.NP -import Generics.SOP.NS import Generics.SOP.GGP import Generics.SOP.Metadata +import Generics.SOP.NP +import Generics.SOP.NS +import qualified GHC.Generics.Generically as GHC import qualified Generics.SOP.Type.Metadata as T -- | The (generic) representation of a datatype. @@ -41,26 +44,38 @@ type Rep a = SOP I (Code a) -- 'from' '.' 'to' === 'id' :: 'Rep' a -> 'Rep' a -- @ -- +-- Implementations that are based on 'Generic' are given to the +-- 'Generically' datatype. +-- -- You typically don't define instances of this class by hand, but -- rather derive the class instance automatically. -- -- /Option 1:/ Derive via the built-in GHC-generics. For this, you -- need to use the @DeriveGeneric@ extension to first derive an -- instance of the 'GHC.Generics.Generic' class from module "GHC.Generics". --- With this, you can then give an empty instance for 'Generic', and +-- With this you can derive it via 'GHC.Generics.Generically' or give an +-- empty instance for 'Generic' (deriving @anyclass@) and -- the default definitions will just work. The pattern looks as -- follows: -- -- @ +-- {-# Language DerivingVia #-} +-- {-# Language DerivingStrategies #-} +-- -- import qualified "GHC.Generics" as GHC -- import "Generics.SOP" -- -- ... -- --- data T = ... deriving (GHC.'GHC.Generics.Generic', ...) --- --- instance 'Generic' T -- empty --- instance 'HasDatatypeInfo' T -- empty, if you want/need metadata +-- data T = ... +-- deriving +-- stock GHC.'GHC.Generics.Generic' +-- +-- deriving +-- ( Generic +-- , HasDatatypeInfo --^ if you want metadata +-- ) +-- via GHC.Generically T -- @ -- -- /Option 2:/ Derive via Template Haskell. For this, you need to @@ -128,6 +143,78 @@ class (All SListI (Code a)) => Generic (a :: Type) where => Rep a -> a to = gto +-- | A generic ('GHC.Generics') implementation of SOP generic +-- behaviour. +-- +-- @ +-- {-# Language DerivingStrategies #-} +-- {-# Language DerivingVia #-} +-- +-- import qualified GHC.Generics as GHC +-- import qualified Generics.SOP as SOP +-- +-- data T = ... +-- deriving +-- stock GHC.Generic +-- +-- deriving (SOP.Generic, SOP.HasDatatypeInfo) +-- via GHC.Generically T +-- @ +instance (GHC.Generic a, GFrom a, GTo a, All SListI (GCode a)) => Generic (GHC.Generically a) where + type Code (GHC.Generically a) = GCode a + + from :: GHC.Generically a -> Rep (GHC.Generically a) + from (GHC.Generically a) = gfrom a + + to :: Rep (GHC.Generically a) -> GHC.Generically a + to rep = GHC.Generically (gto rep) + +-- | An implementation of 'GHC.Generics.Generically' for +-- 'Generics.SOP.Generics'. Should be imported qualified when used +-- with 'GHC.Generics': +-- +-- @ +-- import Generics.SOP hiding (Generic, Generically) +-- import GHC.Generics hiding (Generic, Generically) +-- import qualified Generics.SOP as SOP +-- import qualified GHC.Generics as GHC +-- @ +-- +-- Type classes that have SOP-generic behaviour should be given an +-- instance of this newtype. +-- +-- @ +-- instance (SOP.Generic a, All2 Eq (Code a)) => Eq (SOP.Generically a) where +-- (==) :: SOP.Generically a -> SOP.Generically a -> Bool +-- SOP.Generically a == SOP.Generically b = geq a b +-- @ +-- +-- The process of deriving an SOP-instance: +-- 1. Derive @GHC.Generic@. +-- 2. Use that to derive @SOP.Generic@. +-- 3. Use that to derive your instance of choice via @SOP.Generically@. +-- +-- @ +-- {-# Language DerivingStrategies #-} +-- {-# Language DerivingVia #-} +-- +-- import qualified GHC.Generics as GHC +-- import qualified Generics.SOP as SOP +-- +-- -- >> Ok 1 2 == Ok 1 300 +-- -- False +-- data Ok = Ok Int Int +-- deriving -- (1) +-- stock GHC.Generic +-- +-- deriving SOP.Generic -- (2) +-- via GHC.Generically T +-- +-- deriving Eq -- (3) +-- via SOP.Generically T +-- @ +newtype Generically a = Generically a + -- | A class of datatypes that have associated metadata. -- -- It is possible to use the sum-of-products approach to generic programming @@ -150,6 +237,29 @@ class Generic a => HasDatatypeInfo a where default datatypeInfo :: (GDatatypeInfo a, GCode a ~ Code a) => proxy a -> DatatypeInfo (Code a) datatypeInfo = gdatatypeInfo +-- | A generic ('GHC.Generics') implementation of datatype metadata. +-- +-- @ +-- {-# Language DerivingStrategies #-} +-- {-# Language DerivingVia #-} +-- +-- import qualified GHC.Generics as GHC +-- import qualified Generics.SOP as SOP +-- import Generics.SOP +-- +-- data T = ... +-- deriving +-- stock GHC.Generic +-- +-- deriving (SOP.Generic, HasDatatypeInfo) +-- via GHC.Generically T +-- @ +instance (All SListI (GCode a), GHC.Generic a, GFrom a, GTo a, GDatatypeInfo a) => SOP.HasDatatypeInfo (GHC.Generically a) where + type DatatypeInfoOf (GHC.Generically a) = GDatatypeInfoOf a + + datatypeInfo :: proxy (GHC.Generically a) -> SOP.DatatypeInfo (SOP.Code (GHC.Generically a)) + datatypeInfo _ = gdatatypeInfo (Proxy :: Proxy a) + -- | Constraint that captures that a datatype is a product type, -- i.e., a type with a single constructor. -- diff --git a/generics-sop/test/Example.hs b/generics-sop/test/Example.hs index f10c3d8..87884f9 100644 --- a/generics-sop/test/Example.hs +++ b/generics-sop/test/Example.hs @@ -1,23 +1,32 @@ +{-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE EmptyCase #-} +{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE GADTs #-} -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE InstanceSigs #-} {-# LANGUAGE PolyKinds #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeFamilies #-} {-# OPTIONS_GHC -fno-warn-deprecations #-} module Main (main, toTreeC, toDataFamC) where +import Data.Coerce import qualified GHC.Generics as GHC +import qualified GHC.Generics.Generically as GHC import Generics.SOP +import qualified Generics.SOP as SOP import Generics.SOP.TH import qualified Generics.SOP.Type.Metadata as T import HTransExample +instance (Generic a, All2 Show (Code a)) => Show (SOP.Generically a) where + show :: SOP.Generically a -> String + show (SOP.Generically a) = gshow a + -- Generic show, kind of gshow :: (Generic a, All2 Show (Code a)) => a -> String gshow x = gshowS (from x) @@ -34,6 +43,10 @@ gshowP (I x :* xs) = show x ++ (gshowP xs) class Enumerable a where enum :: [a] +instance (Generic a, All2 Enumerable (Code a)) => Enumerable (SOP.Generically a) where + enum :: [SOPGenerically a] + enum = coerce (genum @a) + genum :: (Generic a, All2 Enumerable (Code a)) => [a] genum = fmap to genumS @@ -45,7 +58,14 @@ genumS = -- GHC.Generics data Tree = Leaf Int | Node Tree Tree - deriving (GHC.Generic) + deriving + stock GHC.Generic + + deriving (SOP.Generic, HasDatatypeInfo) + via GHC.Generically Tree + + deriving Show + via SOP.Generically Tree tree :: Tree tree = Node (Leaf 1) (Leaf 2) @@ -53,48 +73,39 @@ tree = Node (Leaf 1) (Leaf 2) abc :: ABC abc = B -instance Generic Tree -instance HasDatatypeInfo Tree - data ABC = A | B | C - deriving (GHC.Generic) + deriving + stock GHC.Generic + + deriving (Generic, HasDatatypeInfo) + via GHC.Generically ABC -instance Generic ABC -instance HasDatatypeInfo ABC + deriving (Show, Enumerable) + via SOP.Generically ABC data Void - deriving (GHC.Generic) + deriving + stock GHC.Generic -instance Generic Void -instance HasDatatypeInfo Void + deriving (Generic, HasDatatypeInfo) + via GHC.Generically Void + + deriving (Show, Enumerable) + via SOP.Generically Void data family DataFam a b c data instance DataFam Int (Maybe b) c = DF b c - deriving (GHC.Generic) - -dataFam :: DataFam Int (Maybe Int) Int -dataFam = DF 1 2 - -instance Generic (DataFam Int (Maybe b) c) -instance HasDatatypeInfo (DataFam Int (Maybe b) c) - -instance Show Tree where - show = gshow - -instance Show ABC where - show = gshow - -instance Show Void where - show = gshow + deriving + stock GHC.Generic -instance (Show b, Show c) => Show (DataFam Int (Maybe b) c) where - show = gshow + deriving (Generic, HasDatatypeInfo) + via GHC.Generically (DataFam Int (Maybe b) c) -instance Enumerable ABC where - enum = genum + deriving Show + via SOP.Generically (DataFam Int (Maybe b) c) -instance Enumerable Void where - enum = genum +dataFam :: DataFam Int (Maybe Int) Int +dataFam = DF 1 2 -- Template Haskell data TreeB = LeafB Int | NodeB TreeB TreeB