So I've used syb for a long time, and often have functions like
friendlyNames :: Data a => a -> a
friendlyNames = everywhere (mkT (\(Name x _) -> Name x NameS))
What is the equivalent of this using GHC.Generics, assuming Generic a?
So I've used syb for a long time, and often have functions like
friendlyNames :: Data a => a -> a
friendlyNames = everywhere (mkT (\(Name x _) -> Name x NameS))
What is the equivalent of this using GHC.Generics, assuming Generic a?
This might be the wrong problem to solve with GHC.Generics, but here's now you'd do it!
{-# Language TypeOperators #-}
{-# Language DeriveGeneric #-}
{-# Language DefaultSignatures #-}
{-# Language FlexibleContexts #-}
module Demo where
import GHC.Generics
import Language.Haskell.TH
import Language.Haskell.TH.Syntax
data Record = Record { field0 :: Int, field1 :: Maybe Record, field2 :: Name } deriving Generic
instance FriendlyNames Record -- body omitted and derived with GHC.Generics
instance FriendlyNames a => FriendlyNames (Maybe a)
instance FriendlyNames Int where friendlyNames = id -- no-op
------------------------------------------------------------------------
-- | Class for types that can be made friendly
class FriendlyNames a where
friendlyNames :: a -> a
default friendlyNames :: (GFriendlyNames (Rep a), Generic a) => a -> a
friendlyNames = to . gfriendlyNames . from
-- | Replaces the second component of a name with 'NameS'
instance FriendlyNames Name where
friendlyNames (Name x _) = Name x NameS
------------------------------------------------------------------------
-- | Class for generic structures that can have names made friendly
class GFriendlyNames f where
gfriendlyNames :: f p -> f p
-- | Case for metadata (type constructor, data constructor, field selector)
instance GFriendlyNames f => GFriendlyNames (M1 i c f) where
gfriendlyNames (M1 x) = M1 (gfriendlyNames x)
-- | Case for product types
instance (GFriendlyNames f, GFriendlyNames g) => GFriendlyNames (f :*: g) where
gfriendlyNames (x :*: y) = gfriendlyNames x :*: gfriendlyNames y
-- | Case for sum types
instance (GFriendlyNames f, GFriendlyNames g) => GFriendlyNames (f :+: g) where
gfriendlyNames (L1 x) = L1 (gfriendlyNames x)
gfriendlyNames (R1 y) = R1 (gfriendlyNames y)
-- | Case for datatypes without any data constructors (why not?)
instance GFriendlyNames V1 where
gfriendlyNames v1 = v1 `seq` error "gfriendlyNames.V1"
-- | Case for datatypes without any fields
instance GFriendlyNames U1 where
gfriendlyNames U1 = U1
-- | Case for data constructor fields
instance FriendlyNames a => GFriendlyNames (K1 i a) where
gfriendlyNames (K1 x) = K1 (friendlyNames x)
The GHC.Generics approach is more suited to situations where this kind of complexity can be written once and hidden away in a library. While the SYB approach relies on runtime checks, observe the GHC core that is generated for a friendlyNames that makes Record values friendly
-- RHS size: {terms: 14, types: 18, coercions: 0}
recordFriendlyNames
recordFriendlyNames =
\ w_s63w ->
case w_s63w of _ { Record ww1_s63z ww2_s63A ww3_s63B ->
case $recordFriendlyNames ww1_s63z ww2_s63A ww3_s63B
of _ { (# ww5_s63H, ww6_s63I, ww7_s63J #) ->
Record ww5_s63H ww6_s63I ww7_s63J
}
}
-- RHS size: {terms: 19, types: 19, coercions: 0}
$recordFriendlyNames
$recordFriendlyNames =
\ ww_s63z ww1_s63A ww2_s63B ->
(# ww_s63z,
case ww1_s63A of _ {
Nothing -> Nothing;
Just g1_a601 -> Just (recordFriendlyNames g1_a601)
},
case ww2_s63B of _ { Name x_a3Z3 ds_d5Z5 -> Name x_a3Z3 NameS } #)
Well, I finally have a satisfying answer to this question. The guts of it are taken from glguy's answer above, but I'll add some wrappers and explanation that helped me connect the dots. I will also make it more generic so it corresponds more closely with the tools provide by Data.Data
.
The everywhere
function will apply a function to every occurence of some Typeable
type b
within the argument value, which is represented as type a
. The Typeable
instance is used to determine when a ~ b
during the recursion. Note that because everywhere
is a method of class Everywhere
and a default instance is provided, it will accept any type that satisfies the class constraints
{-# LANGUAGE UndecidableInstances #-}
import Data.Typeable (cast, Typeable)
import GHC.Generics
import Data.Ratio (Ratio)
import Data.Word (Word8)
class (Typeable b, Typeable a) => Everywhere b a where
everywhere :: (b -> b) -> a -> a
Here is the basic instance of Everywhere
, it can be applied to any type which satisfies its constraints, in particular GEverywhere
which is defined below for any instance of Generic
. The OVERLAPPABLE
lets us supply instances for additional types that are not instances of Generic
.
instance {-# OVERLAPPABLE #-} (Typeable b, Typeable a, Generic a, GEverywhere b (Rep a))
=> Everywhere b a where
everywhere f = to . geverywhere f . from
Now we write a class GEverywhere
which includes the instances that cover the type representation. Ultimately, the job of this code is to recurse on the values of the fields inside this value.
class GEverywhere b f where
geverywhere :: (b -> b) -> f p -> f p
instance GEverywhere b f => GEverywhere b (M1 i c f) where
geverywhere f (M1 x) = M1 (geverywhere f x)
instance (GEverywhere b f, GEverywhere b g) => GEverywhere b (f :*: g) where
geverywhere f (x :*: y) = geverywhere f x :*: geverywhere f y
instance (GEverywhere b f, GEverywhere b g) => GEverywhere b (f :+: g) where
geverywhere f (L1 x) = L1 (geverywhere f x)
geverywhere f (R1 y) = R1 (geverywhere f y)
instance GEverywhere b V1 where geverywhere _ v1 =
v1 `seq` error "geverywhere.V1"
instance GEverywhere b U1 where geverywhere _ U1 = U1
This final instance is where the subtype is encountered. We check whether it is the type we are looking for using the cast
function from Data.Typeable
:
instance Everywhere b a => GEverywhere b (K1 i a) where
geverywhere f (K1 x) =
case cast x :: Maybe b of
Nothing -> K1 (everywhere f x)
Just x' -> case cast (f x') :: Maybe a of
-- This should never happen - we got here because a ~ b
Nothing -> K1 (everywhere f x)
Just x'' -> K1 x''
Finally, there may be primitive types that occur within the types we are interested in that have no Generic instances.
instance (Typeable b, Typeable a) => Everywhere b (Ratio a) where everywhere _ r = r
instance (Typeable b) => Everywhere b Char where everywhere _ r = r
instance (Typeable b) => Everywhere b Integer where everywhere _ r = r
instance (Typeable b) => Everywhere b Word8 where everywhere _ r = r
instance (Typeable b) => Everywhere b Int where everywhere _ r = r
That's it, now we can use everywhere to do generic modification:
λ> everywhere (succ :: Char -> Char) ("abc", 123)
("bcd",123)
λ> everywhere @Int succ ("abc", 123 :: Int)
("abc",124)