Created
June 6, 2017 16:30
-
-
Save RyanGlScott/596fc1267c3e1195894e77d17ff68e69 to your computer and use it in GitHub Desktop.
Fleshing out a new design for Generic1 that doesn't use Functor contexts for derived instances, but rather Coercible.
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
{-# LANGUAGE DataKinds #-} | |
{-# LANGUAGE StandaloneDeriving #-} | |
{-# LANGUAGE TypeFamilies #-} | |
{-# LANGUAGE TypeOperators #-} | |
{-# LANGUAGE UndecidableInstances #-} | |
-- | Fleshing out a new design for Generic1 that doesn't use Functor contexts | |
-- for derived instances, but rather Coercible. Why would we want this? | |
-- Consider this derived Generic1 instance: | |
-- | |
-- data T f a = T (f [a]) deriving Generic1 | |
-- ==> | |
-- instance Functor f => Generic1 (T f a) where | |
-- type Rep1 (T f) = | |
-- D1 ('MetaData "T" "module" "package" 'True) | |
-- (C1 ('MetaCons "T" 'PrefixI 'False) | |
-- (S1 ('MetaSel 'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) | |
-- (f :.: Rec []))) | |
-- from1 (T x) = M1 (M1 (M1 (Comp1 (fmap Rec1 x)))) | |
-- to1 (M1 (M1 (M1 x))) = T (fmap unRec1 (unComp1 x)) | |
-- | |
-- This is unsavory for two reasons: | |
-- | |
-- 1. This requires that f be a Functor. This completely rules out some types | |
-- that we might want to use here. | |
-- 2. Moreover, it's inefficient! We're fmapping into a type just to run Rec1 | |
-- and unRec1 (i.e., to wrap and unwrap a newtype). | |
-- | |
-- Using Coercible instead of Functor resolves these two issues. Coercible | |
-- instances are autogenerated, so we don't need to worry about a type being | |
-- a Functor instance. And obviously, it's far more efficient to use coerce | |
-- than fmap. | |
module NewGenerics where | |
import Data.Coerce | |
import Data.Type.Coercion | |
import GHC.Generics | |
import NewGenericsAbstract | |
-- We don't have quantified contexts, so we'll fake them with this class. | |
class Representational f where | |
rep :: Coercible a b => Coercion (f a) (f b) | |
data T f a = T (f [a]) | |
deriving instance Show (f [a]) => Show (T f a) | |
-- In the language of -XQuantifiedContexts, this would be: | |
-- | |
-- instance (forall a. Coercible (f [a]) (f (Rec1 [] a))) => Generic1 (T f) where ... | |
-- | |
-- If we wanted to be less ad hoc, we could generalize this to: | |
-- | |
-- instance (forall a. Coercible a b => Coercible (f a) (f b)) => Generic (T f) where ... | |
-- | |
-- But this would require -XImplicationConstraints in addition to -XQuantifiedContexts. | |
instance Representational f => Generic1 (T f) where | |
type Rep1 (T f) = | |
D1 ('MetaData "T" "module" "package" 'True) | |
(C1 ('MetaCons "T" 'PrefixI 'False) | |
(S1 ('MetaSel 'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) | |
(f :.: Rec1 []))) | |
from1 (T x) = M1 (M1 (M1 (Comp1 (coerceWith rep x)))) | |
to1 (M1 (M1 (M1 x))) = T (coerceWith rep (unComp1 x)) | |
roundtrip :: Representational f => T f a -> T f a | |
roundtrip = to1 . from1 | |
instance Representational Maybe where | |
rep = Coercion | |
-- This works for your favorite types... | |
roundtripMaybe :: T Maybe a -> T Maybe a | |
roundtripMaybe = roundtrip | |
instance Representational Abstract where | |
rep = Coercion | |
-- ...and it works for abstract types! That is, abstract types whose type parameter's | |
-- role is either representational or phantom. | |
-- | |
-- It wouldn't work for abstract types whose parameter's role is nominal, but then | |
-- again, such a datatype shouldn't have a Functor instance anyways, so we're | |
-- not losing anything here. | |
roundtripAbstract :: T Abstract a -> T Abstract a | |
roundtripAbstract = roundtrip | |
newtype NotAFunctor a = NotAFunctor (a -> Int) | |
instance Representational NotAFunctor where | |
rep = Coercion | |
-- Most importantly, it works for things that aren't Functor instances. | |
roundtripNotAFunctor :: T NotAFunctor a -> T NotAFunctor a | |
roundtripNotAFunctor = roundtrip |
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
{-# LANGUAGE DeriveFunctor #-} | |
{-# LANGUAGE RoleAnnotations #-} | |
-- | A simple abstract type | |
module NewGenericsAbstract (Abstract) where | |
data Abstract a = Abstract a | |
deriving (Functor, Show) |
glguy
commented
Jun 6, 2017
For a modern version of this gist (using proper QuantifiedConstraints
), see https://gist.github.com/RyanGlScott/cca1a0605a3b460c4af073cfce3c15fb.
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment