How do I replace Data.Generics with GHC.Generics? - haskell

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)

Related

Generics: Current status of syb with class

I'm trying to use generic programming as described in the paper Scrap Your Boilerplate with class. That is, being able to "recurse" down with the members of a user-defined class, as opposed to a fixed set of types that are known when the traversal code is written.
It appears the corresponding hackage package http://hackage.haskell.org/package/syb-with-class can be used for this purpose, but most of the online discussion (for instance this question from 7 years ago: Does the current SYB permit extension of generic functions with new types?) implies current GHC.Generics to be preferred. In particular, that implementation seems to predate the use of constraint-kinds which is supposed to make this sort of programming easier. However, the GHC.Generics framework does not seem to permit traversals with extensible functions.
What's the best alternative these days for doing generic functions with extensible types? If at all possible, I'd like to avoid using "internal" representations (i.e., any sort of K1, M1 etc. combinators) and would love to be able to use a Uniplate like interface. Any pointers to papers, blog-posts, or general advice would be appreciated.
Well, here's a blog post for you...
If you want to do generic programming as described in the "Scrap Your Boilerplate with class" paper, then the recommended method is to use the syb-with-class package, notwithstanding that Stack Overflow answer, since the syb-with-class package is actively maintained and works just fine.
If you want to do generic programming with extensible types directly with GHC.Generics, then -- as with any other direct use of GHC.Generic -- you can't really avoid using the K1, M1, etc. representation. It's unfortunate that the documentation makes this representation sound like an internal implementation detail that is subject to change at any minute.
The potential advantage of GHC.Generics is that it's naturally type-class-based, so you get the type extensibility for free. For example, to take the gsize example from the SYB with class paper, you can implement it in GHC.Generics directly with a pair of classes, one for handling the generic structure, and another for handling the specific types along the way:
-- Handle the generic structure
class Size' f where
size' :: f p -> Int
instance (Size' f) => Size' (M1 i c f) where
size' (M1 x) = size' x
instance (Size' f, Size' g) => Size' (f :+: g) where
size' (L1 x) = size' x
size' (R1 x) = size' x
instance (Size' f, Size' g) => Size' (f :*: g) where
size' (f :*: g) = size' f + size' g
instance (Size' U1) where
size' U1 = 0 -- constructor already counted by Size class
instance (Size' V1) where
size' _ = undefined
instance (Size c) => Size' (K1 i c) where
size' (K1 x) = size x
-- Handle the types
class Size t where
size :: t -> Int
default size :: (Generic t, Size' (Rep t)) => t -> Int
size t = 1 + size' (from t)
Generally, there would be no need to extend Size', as it's -- by construction -- a type-agnostic, generic implementation that will have an exhaustive (or nearly exhaustive) set of instances. However, the Size type class is, obviously, open and can be extended at will:
data Name = N String
instance Size Name where
size (N _) = 1
-- a fanciful example of a custom recursive type
newtype Negative a = Neg a
instance Size a => Size (Negative a) where
size (Neg x) = -size x
-- a user-defined type using a default instance
data Something = Something Int (Name, Name) Bool deriving (Generic)
instance Size Something
-- needs some supporting default instances:
instance Size Bool
instance (Size a, Size b) => Size (a,b)
-- and a custom instance. This could be defaulted, but
-- then we'd need an instance for unboxed Int#
instance Size Int where size _ = 1
main = do
print $ size (Something 10 (N "John", N "Doe") False)
print $ size (Neg (1 :: Int, 2 :: Int), True)
Because the generic Size' class is indeed generic, it's possible to generalize it to an "SYB with class"-like query, and we can use ConstraintKinds to make the syntax a little clearer:
class Query' cls f where
gmapQm :: Monoid a => Proxy cls -> (forall t. cls t => t -> a) -> f p -> a
instance (Query' cls f) => Query' cls (M1 i c f) where
gmapQm p h (M1 x) = gmapQm p h x
instance (Query' cls f, Query' cls g) => Query' cls (f :+: g) where
gmapQm p h (L1 x) = gmapQm p h x
gmapQm p h (R1 x) = gmapQm p h x
instance (Query' cls U1) where
gmapQm _ _ U1 = mempty
instance (Query' cls f, Query' cls g) => Query' cls (f :*: g) where
gmapQm p h (f :*: g) = gmapQm p h f <> gmapQm p h g
instance (cls c) => Query' cls (K1 i c) where
gmapQm p h (K1 x) = h x
and then define multiple extensible generic queries:
class Size2 t where
size2 :: t -> Sum Int
default size2 :: (Generic t, Query' Size2 (Rep t)) => t -> Sum Int
size2 t = Sum 1 <> gmapQm #Size2 Proxy size2 (from t)
instance Size2 Something
instance (Size2 a, Size2 b) => Size2 (a,b)
instance Size2 Bool
instance Size2 Int where size2 _ = 1
instance Size2 Name where size2 (N _) = 1
class Tags t where
tags :: t -> [String]
default tags :: (Generic t, Query' Tags (Rep t)) => t -> [String]
tags t = gmapQm #Tags Proxy tags (from t)
instance Tags Something
instance (Tags a, Tags b) => Tags (a,b)
instance Tags Name where tags (N str) = ["Name", str]
instance Tags Int where tags _ = ["Int"]
instance Tags Double where tags _ = ["Double"]
instance Tags Bool where
tags True = ["Bool:True"]
tags False = ["Bool:False"]
main2 = do
print $ size2 (Something 10 (N "John", N "Doe") False)
print $ tags (Something 10 (N "John", N "Doe") False)
The full code with a bonus gmapT implementation and example:
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE RankNTypes #-}
import GHC.Generics
import Data.Proxy
import Data.Monoid
--
-- Size'/Size directly implemented with GHC.Generics
---
-- Handle the generic structure
class Size' f where
size' :: f p -> Int
instance (Size' f) => Size' (M1 i c f) where
size' (M1 x) = size' x
instance (Size' f, Size' g) => Size' (f :+: g) where
size' (L1 x) = size' x
size' (R1 x) = size' x
instance (Size' f, Size' g) => Size' (f :*: g) where
size' (f :*: g) = size' f + size' g
instance (Size' U1) where
size' U1 = 0
instance (Size' V1) where
size' _ = undefined
instance (Size c) => Size' (K1 i c) where
size' (K1 x) = size x
-- Handle the types
class Size t where
size :: t -> Int
default size :: (Generic t, Size' (Rep t)) => t -> Int
size t = 1 + size' (from t)
data Name = N String deriving (Show)
instance Size Name where
size (N _) = 1
-- a fanciful example of a custom recursive type
newtype Negative a = Neg a
instance Size a => Size (Negative a) where
size (Neg x) = -size x
-- a user-defined type using a default instance
data Something = Something Int (Name, Name) Bool deriving (Show, Generic)
instance Size Something
-- needs some supporting default instances:
instance Size Bool
instance (Size a, Size b) => Size (a,b)
-- and a custom instance. This could be defaulted, but
-- then we'd need an instance for unboxed Int#
instance Size Int where size _ = 1
--
-- gmapQm "with class" implemented using GHC.Generics and ConstraintKinds
--
class SYB cls f where
gmapQm :: Monoid a => Proxy cls -> (forall t. cls t => t -> a) -> f p -> a
gmapT :: Proxy cls -> (forall t. cls t => t -> t) -> f p -> f p
instance (SYB cls f) => SYB cls (M1 i c f) where
gmapQm p h (M1 x) = gmapQm p h x
gmapT p h (M1 x) = M1 $ gmapT p h x
instance (SYB cls f, SYB cls g) => SYB cls (f :+: g) where
gmapQm p h (L1 x) = gmapQm p h x
gmapQm p h (R1 x) = gmapQm p h x
gmapT p h (L1 x) = L1 $ gmapT p h x
gmapT p h (R1 x) = R1 $ gmapT p h x
instance (SYB cls U1) where
gmapQm _ _ U1 = mempty
gmapT _ _ U1 = U1
instance (SYB cls f, SYB cls g) => SYB cls (f :*: g) where
gmapQm p h (f :*: g) = gmapQm p h f <> gmapQm p h g
gmapT p h (f :*: g) = gmapT p h f :*: gmapT p h g
instance (cls c) => SYB cls (K1 i c) where
gmapQm p h (K1 x) = h x
gmapT p h (K1 x) = K1 (h x)
-- Size query using gmapQm
class Size2 t where
size2 :: t -> Sum Int
default size2 :: (Generic t, SYB Size2 (Rep t)) => t -> Sum Int
size2 t = Sum 1 <> gmapQm #Size2 Proxy size2 (from t)
instance Size2 Something
instance (Size2 a, Size2 b) => Size2 (a,b)
instance Size2 Bool
instance Size2 Int where size2 _ = 1
instance Size2 Name where size2 (N _) = 1
-- another generic query using gmapQm
class Tags t where
tags :: t -> [String]
default tags :: (Generic t, SYB Tags (Rep t)) => t -> [String]
tags t = gmapQm #Tags Proxy tags (from t)
instance Tags Something
instance (Tags a, Tags b) => Tags (a,b)
instance Tags Name where tags (N str) = ["Name", str]
instance Tags Int where tags _ = ["Int"]
instance Tags Double where tags _ = ["Double"]
instance Tags Bool where
tags True = ["Bool:True"]
tags False = ["Bool:False"]
-- a generic transform
class Zero t where
zero :: t -> t
default zero :: (Generic t, SYB Zero (Rep t)) => t -> t
zero t = to $ gmapT #Zero Proxy zero (from t)
instance Zero Something
instance (Zero a, Zero b) => Zero (a,b)
instance Zero String where zero _ = [] -- zero strings
instance Zero Name where zero = id -- but don't zero names!
instance Zero Bool where zero _ = False
instance Zero Int where zero _ = 0
instance Zero Double where zero _ = 0
-- some tests
main = do
let s = Something 10 (N "John", N "Doe") False
print $ size s
print $ size (Neg (1 :: Int, 2 :: Int), True)
print $ size2 s
print $ tags s
print $ zero (s, "this string will be zeroed")

Automatically generate mapping function for data with higher-kinded parameter

Consider the data type
data Foo f = Foo {fooInt :: f Int, fooBool :: f Bool}
I would like a function mapFoo :: (forall a. f a -> g a) -> Foo f -> Foo g. My options:
I could write it manually. This is mildly annoying, but the killer objection is that I expect Foo to gain fields over time and I want that to be as frictionless as possible, so having to add a case to this function is annoying.
I could write Template Haskell. I'm pretty sure this isn't too hard, but I tend to view TH as a last resort, so I'm hoping for something better.
Could I use generics? I derived Generic, but when I tried to implement the K1 case (specifically to handle Rec0) I couldn't figure out how to do it; I needed it to change the type.
Is there a fourth option that I just missed?
If there is a generic way to write mapFoo without reaching for Template Haskell, I'd love to know about it! Thanks.
The rank2classes package can derive this for you.
{-# LANGUAGE TemplateHaskell #-}
import Rank2.TH (deriveFunctor)
data Foo f = Foo {fooInt :: f Int, fooBool :: f Bool}
$(deriveFunctor ''Foo)
Now you can write mapFoo = Rank2.(<$>).
EDIT: Oh, I should be explicit that this is a manual method - it's a pointer to a package that has lots of useful functions and type classes but afaik no TH to generate what you want. Pull requests welcome, I'm sure.
The parameterized-utils package provides a rich set of higher rank classes. For your needs there's FunctorF:
-- | A parameterized type that is a function on all instances.
class FunctorF m where
fmapF :: (forall x . f x -> g x) -> m f -> m g
And the instances are what you probably expect:
{-# LANGUAGE RankNTypes #-}
import Data.Parameterized.TraversableF
data Foo f = Foo {fooInt :: f Int, fooBool :: f Bool}
instance FunctorF Foo where
fmapF op (Foo a b) = Foo (op a) (op b)
Here is GHC.Generics-based implementation if you still prefer not to use TemplateHaskell:
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
import GHC.Generics
data Foo f = Foo {
fooInt :: f Int,
fooBool :: f Bool,
fooString :: f String
} deriving (Generic)
class Functor2 p q f where
fmap2 :: (forall a. p a -> q a) -> f p -> f q
instance (Generic (f p), Generic (f q), GFunctor2 p q (Rep (f p)) (Rep (f q))) => Functor2 p q f where
fmap2 f = to . (gfmap2 f) . from
class GFunctor2 p q f g where
gfmap2 :: (forall a. p a -> q a) -> f x -> g x
instance (GFunctor2 p q a b) => GFunctor2 p q (D1 m1 (C1 m2 a)) (D1 m1 (C1 m2 b)) where
gfmap2 f (M1 (M1 a)) = M1 (M1 (gfmap2 f a))
instance (GFunctor2 p q a c, GFunctor2 p q b d) => GFunctor2 p q (a :*: b) (c :*: d) where
gfmap2 f (a :*: b) = gfmap2 f a :*: gfmap2 f b
instance GFunctor2 p q (S1 m1 (Rec0 (p a))) (S1 m1 (Rec0 (q a))) where
gfmap2 f (M1 (K1 g)) = M1 (K1 (f g))
-- Tests
foo = Foo (Just 1) (Just True) (Just "foo")
test1 = fmap2 (\(Just a) -> [a]) foo
test2 = fmap2 (\[a] -> Left "Oops") test1
I'm not sure though if it is possible to avoid MultiParamTypeClasses to make class Functor2 identical to the one defined rank2classes.

GHC Generics: How to write an implementation of (:+:) that converts sum types from/to integers?

I would like to write an implementation of
instance (GMySerialize a, GMySerialize b) => GMySerialize (a :+: b)
Where GMySerialize is defined as:
class GMySerialize f where
gtoMyS :: f a -> MySerialize
gfromMyS :: MySerialize -> Maybe (f a)
That will, for any sum type consisting solely of nullary data constructors (such as data MyType = A | B | C | D | E | f), convert it to and from MySerializeInt, where MySerializeInt is a constructor for MySerialize that takes one int parameter.
I started out with
instance (GMySerialize a, GMySerialize b) => GMySerialize (a :+: b) where
gtoMyS (L1 x) = MySerializeInt (0 + rest)
where rest = case gtoMyS x of
MySerializeInt n -> n
MySerializeNil -> 0
err -> error $ show err
gtoMyS (R1 x) = MySerializeInt (1 + rest)
where rest = case gtoMyS x of
MySerializeInt n -> n
MySerializeNil -> 0
err -> error $ show err
But realised that's horribly wrong, and am not sure how to fix it. How is it wrong? As an example, the following produce the same integer, but they should not as they represent different constructors:
M1 {unM1 = L1 (R1 (M1 {unM1 = U1}))}
M1 {unM1 = R1 (L1 (M1 {unM1 = U1}))}
I'm also unsure how I'd go about writing the gfromMyS instances even if I got gtoMyS working.
To phrase it another way, what I'm looking to do has an equivalent effect to writing a Template Haskell function that generates:
instance MySerialize t where
toMyS x = MySerializeInt (toEnum x)
fromMyS (MySerializeInt n) -> Just (fromEnum n)
fromMyS _ -> Nothing
For every single t where t is sum types with only nullary constructors that implement Enum.
The trick is to make another class that counts the number of constructors
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts #-}
import Data.Functor ((<$>))
import Data.Tagged
import GHC.Generics
class GNumConstructors (f :: * -> *) where
-- Is this close enough to CAF to get memoed in the dictionary?
gnumConstructors :: Tagged f Int
instance GNumConstructors (M1 C c f) where
gnumConstructors = Tagged 1
instance (GNumConstructors a, GNumConstructors b) => GNumConstructors (a :+: b) where
gnumConstructors = Tagged $ unTagged (gnumConstructors :: Tagged a Int) + unTagged (gnumConstructors :: Tagged b Int)
Then you can easily divide up the integers between those on the left side (less than the number of possibilities on the left) and those on the right side (any larger numbers).
type MyS = Int
class GMySerialize f where
gtoMyS :: f a -> MyS
gfromMyS :: MyS -> Maybe (f a)
instance (GNumConstructors a, GMySerialize a, GMySerialize b) => GMySerialize (a :+: b) where
gtoMyS (L1 l) = gtoMyS l
gtoMyS (R1 r) = unTagged (gnumConstructors :: Tagged a Int) + gtoMyS r
gfromMyS x = if x < unTagged (gnumConstructors :: Tagged a Int)
then L1 <$> gfromMyS x
else R1 <$> gfromMyS (x - unTagged (gnumConstructors :: Tagged a Int))
Any individual constructor is represented by 0 and we peek straight through metadata.
instance GMySerialize U1 where
gtoMyS U1 = 0
gfromMyS 0 = Just U1
gfromMyS _ = Nothing
instance GMySerialize f => GMySerialize (M1 i c f) where
gtoMyS (M1 a) = gtoMyS a
gfromMyS ms = M1 <$> gfromMyS ms
Combined with a MySerialize class we can flesh out a complete example for MyType and test it
class MySerialize a where
toMyS :: a -> MyS
fromMyS :: MyS -> Maybe a
default toMyS :: (Generic a, GMySerialize (Rep a)) => a -> MyS
toMyS a = gtoMyS $ from a
default fromMyS :: (Generic a, GMySerialize (Rep a)) => MyS -> Maybe a
fromMyS a = to <$> gfromMyS a
data MyType = A | B | C | D | E | F
deriving (Generic, Show)
instance MySerialize MyType
main = do
print . map toMyS $ [A, B, C, D, E, F]
print . map (fromMyS :: MyS -> Maybe MyType) $ [-1, 0, 1, 2, 3, 4, 5, 6]
A through F are mapped to the numbers 0 through 5. Reading in those numbers reproduces A through F. Trying to read in a number outside that range produces Nothing.
[0,1,2,3,4,5]
[Nothing,Just A,Just B,Just C,Just D,Just E,Just F,Nothing]

Datatype-generic programming and the mysterious gdmXXX

I'm using datatype-generic programming for a class called Generic that contains a method called get. If my end user defines a type and forgets to add deriving Generic, and calls put, they will see an error message such as this:
No instance for (ALife.Creatur.Genetics.Code.BRGCWord8.GGene
(GHC.Generics.Rep ClassifierGene))
arising from a use of `ALife.Creatur.Genetics.Code.BRGCWord8.$gdmput'
I can tell users how to fix the error, but I am curious about this $gdmput. I assume it's a function or symbol that's automatically generated, but by what? Is it the use of the DefaultSignatures pragma, or the DeriveGeneric pragma? I read a few papers about datatype-generic programming, but did not see any reference to gdmXXX symbols.
Here's the definition of the Generic class.
{-# LANGUAGE TypeFamilies, FlexibleContexts, FlexibleInstances,
DefaultSignatures, DeriveGeneric, TypeOperators #-}
. . .
-- | A class representing anything which is represented in, and
-- determined by, an agent's genome.
-- This might include traits, parameters, "organs" (components of
-- agents), or even entire agents.
-- Instances of this class can be thought of as genes, i.e.,
-- instructions for building an agent.
class Genetic g where
-- | Writes a gene to a sequence.
put :: g -> Writer ()
default put :: (Generic g, GGenetic (Rep g)) => g -> Writer ()
put = gput . from
-- | Reads the next gene in a sequence.
get :: Reader (Either [String] g)
default get :: (Generic g, GGenetic (Rep g)) => Reader (Either [String] g)
get = do
a <- gget
return $ fmap to a
getWithDefault :: g -> Reader g
getWithDefault d = fmap (fromEither d) get
class GGenetic f where
gput :: f a -> Writer ()
gget :: Reader (Either [String] (f a))
-- | Unit: used for constructors without arguments
instance GGenetic U1 where
gput U1 = return ()
gget = return (Right U1)
-- | Constants, additional parameters and recursion of kind *
instance (GGenetic a, GGenetic b) => GGenetic (a :*: b) where
gput (a :*: b) = gput a >> gput b
gget = do
a <- gget
b <- gget
return $ (:*:) <$> a <*> b
-- | Meta-information (constructor names, etc.)
instance (GGenetic a, GGenetic b) => GGenetic (a :+: b) where
gput (L1 x) = putRawWord16 0 >> gput x
gput (R1 x) = putRawWord16 1 >> gput x
gget = do
a <- getRawWord16
case a of
Right x -> do
if even x -- Only care about the last bit
then fmap (fmap L1) gget
else fmap (fmap R1) gget
Left s -> return $ Left s
-- | Sums: encode choice between constructors
instance (GGenetic a) => GGenetic (M1 i c a) where
gput (M1 x) = gput x
gget = fmap (fmap M1) gget
-- | Products: encode multiple arguments to constructors
instance (Genetic a) => GGenetic (K1 i a) where
gput (K1 x) = put x
gget = do
a <- get
return $ fmap K1 a
The $gdm comes from DefaultSignatures. Here's a minimal example that produces a similar error message
{-# LANGUAGE DefaultSignatures #-}
data NoInstances = NoInstances
class Display a where
display :: a -> String
default display :: Show a => a -> String
display = show
instance Display NoInstances
The error message produced is
defaultsignatures.hs:11:10:
No instance for (Show NoInstances)
arising from a use of `Main.$gdmdisplay'
In the expression: Main.$gdmdisplay
In an equation for `display': display = Main.$gdmdisplay
In the instance declaration for `Display NoInstances'

Template data type in function definition

I have two functions in my program:
getWidth :: Size -> GLint
getWidth (Size a b) = a
getXPos :: Position -> GLint
getXPos (Position a b) = a
I realized that those two functions are doing the same thing and the only difference is parameter type. Question is: how do i write such a generic function:
getFirst :: ANYTHING -> a
getFirst (ANYTHING a b) -> a
This is probably a little bit overkill for your problem, but maybe it'll be
useful for someone else that stumbles upon this question.
You can implement a truly generic function that works on any datatype that has
a single constructor with two fields by using GHC's generic programming.
Let's look at the type signature first. You'd like to write a function such as
getFirst :: ANYTHING -> a
In Haskell, a type that can be "anything" is signified with a type variable
(just like the result type a), so let's write
getFirst :: t -> a
However, having a fully polymorphic type doesn't let us operate on the type in
any way since we can't make any assumptions about its internal structure.
Therefore we need to write in some constraints about the type t.
The second thing is that a polymorphic return type (the a above) means that the
return type is inferred based on the call site, essentially meaning that the caller is able
to "request" any possible type for the first field. This is clearly impossible,
since for example for Size the only valid return type is GLint. So we need
to declare the return type so that it depends on the type t.
getFirst :: (Generic t, GPair (Rep t)) => t -> FirstT (Rep t)
Now, this is a rather complicated type signature, but the essence is that for
any type t that is generic and has a generic representation Rep t that is
a valid, generic pair (GPair), we can access the first field of the pair
which has the type FirstT (Rep t).
The type-class GPair can be defined like this
class GPair g where
type FirstT g -- type of the first field in the pair
type SecondT g -- type of the second field in the pair
gGetFirst :: g x -> FirstT g
gGetSecond :: g x -> SecondT g
This type-class introduces the function gGetFirst and gGetSecond that do not
operate on the pair type itself but its generic representation. The type
delcarations FirstT and SecondT are so called associated type synonyms that
are part of the TypeFamilies language extension. What we declare here
is that FirstT and SecondT are a synonym for some existing, unknown type
that is determined by the type g.
The generic representations of types are wrapped in meta-data descriptions that
contain information such as the data type name, constructor names, record field
names etc. We are not going to need any of that information for this case, so
the first instance of GPair simply strips out the meta-data layer.
instance GPair f => GPair (M1 i c f) where
type FirstT (M1 i c f) = FirstT f
type SecondT (M1 i c f) = SecondT f
gGetFirst = gGetFirst . unM1
gGetSecond = gGetSecond . unM1
Next we need to make an instance for the generic constuctor with two fields.
instance (GField l, GField r) => GPair (l :*: r) where
type FirstT (l :*: r) = FieldT l
type SecondT (l :*: r) = FieldT r
gGetFirst (l :*: _) = gGet l
gGetSecond (_ :*: r) = gGet r
And then we define the generic field type-class GField which operates on a
single field of the pair.
class GField g where
type FieldT g
gGet :: g x -> FieldT g
We strip out the meta-data layer from GField as we did above
instance GField f => GField (M1 i c f) where
type FieldT (M1 i c f) = FieldT f
gGet = gGet . unM1
And now we just need to add an instance for generic constructor fields.
instance GField (K1 r t) where
type FieldT (K1 r t) = t
gGet (K1 x) = x
Now we can implement the truly generic accessor functions getFirst and getSecond.
getFirst :: (Generic t, GPair (Rep t)) => t -> FirstT (Rep t)
getFirst = gGetFirst . from
getSecond :: (Generic t, GPair (Rep t)) => t -> SecondT (Rep t)
getSecond = gGetSecond . from
The function from is part of GHC.Generics and it converts a value to its
generic form. For this, the data types Size and Position need to implement
the Generic type-class.
{-# LANGUAGE DeriveGeneric #-}
data Position = Position GLInt GLInt deriving Generic
data Size = Size GLInt GLInt deriving Generic
Let's test it out:
> let sz = Size 1 2
> let pos = Position 4 6
> getFirst sz
1
> getSecond pos
6
The functions also work automatically for appropriate built-in types, such as
tuples:
> getSecond (1, "foo")
"foo"
Now, you might think that this is an awful lot of code for a simple, generic
function and that's a valid concern. However, in practice the generic instances are rather easy and quick to write once you are familiar with how the generic representation types are structured.
Also, the great thing about GHC's generic
programming is that it's completely type-safe (unlike, for example, the
reflection APIs in Java). This means that if you try to use the generic
functions with incompatible types, you get a compile time error instead of
a run-time exception.
For example:
a = getFirst (1,2,3) -- compile error because value has more than two fields
data Foo = Foo Int Int | Bar Float Float deriving Generic
b = getFirst $ Foo 1 2 -- compile error because the type has multiple constuctors
Here's the complete code for trying this out:
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE DeriveGeneric #-}
import GHC.Generics
class GPair g where
type FirstT g
type SecondT g
gGetFirst :: g x -> FirstT g
gGetSecond :: g x -> SecondT g
instance GPair f => GPair (M1 i c f) where
type FirstT (M1 i c f) = FirstT f
type SecondT (M1 i c f) = SecondT f
gGetFirst = gGetFirst . unM1
gGetSecond = gGetSecond . unM1
instance (GField l, GField r) => GPair (l :*: r) where
type FirstT (l :*: r) = FieldT l
type SecondT (l :*: r) = FieldT r
gGetFirst (l :*: _) = gGet l
gGetSecond (_ :*: r) = gGet r
class GField g where
type FieldT g
gGet :: g x -> FieldT g
instance GField f => GField (M1 i c f) where
type FieldT (M1 i c f) = FieldT f
gGet = gGet . unM1
instance GField (K1 r t) where
type FieldT (K1 r t) = t
gGet (K1 x) = x
getFirst :: (Generic t, GPair (Rep t)) => t -> FirstT (Rep t)
getFirst = gGetFirst . from
getSecond :: (Generic t, GPair (Rep t)) => t -> SecondT (Rep t)
getSecond = gGetSecond . from
You need a type class (although IMO it isn't a good idea to generalize these two functions):
class Dimension d where
getX :: d -> GLint
getY :: d -> GLint
instance Dimension Size where
getX (Size x y) = x
getY (Size x y) = y
instance Dimension Position where
getX (Position x y) = x
getY (Position x y) = y
If you just want to write less code, employ record syntax:
data Size = Size { getWidth :: GLint, getHeight :: GLint }
data Position = Position { getXPos :: GLint, getYPos :: GLint }

Resources