Commit 686628d2 authored by jpm@cs.ox.ac.uk's avatar jpm@cs.ox.ac.uk
Browse files

Add tests for deriving Generic1

Most of these tests were written by Nicolas Frisby.
parent 9d3bf7df
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE DefaultSignatures #-}
module GFunctor (
-- * Generic Functor class
GFunctor(..)
) where
import GHC.Generics
--------------------------------------------------------------------------------
-- Generic fmap
--------------------------------------------------------------------------------
class GFunctor' f where
gmap' :: (a -> b) -> f a -> f b
instance GFunctor' U1 where
gmap' _ U1 = U1
instance GFunctor' Par1 where
gmap' f (Par1 a) = Par1 (f a)
instance GFunctor' (K1 i c) where
gmap' _ (K1 a) = K1 a
instance (GFunctor f) => GFunctor' (Rec1 f) where
gmap' f (Rec1 a) = Rec1 (gmap f a)
instance (GFunctor' f) => GFunctor' (M1 i c f) where
gmap' f (M1 a) = M1 (gmap' f a)
instance (GFunctor' f, GFunctor' g) => GFunctor' (f :+: g) where
gmap' f (L1 a) = L1 (gmap' f a)
gmap' f (R1 a) = R1 (gmap' f a)
instance (GFunctor' f, GFunctor' g) => GFunctor' (f :*: g) where
gmap' f (a :*: b) = gmap' f a :*: gmap' f b
instance (GFunctor f, GFunctor' g) => GFunctor' (f :.: g) where
gmap' f (Comp1 x) = Comp1 (gmap (gmap' f) x)
class GFunctor f where
gmap :: (a -> b) -> f a -> f b
default gmap :: (Generic1 f, GFunctor' (Rep1 f))
=> (a -> b) -> f a -> f b
gmap f = to1 . gmap' f . from1
-- Base types instances
instance GFunctor Maybe
instance GFunctor []
(D0,D1 {d11 = 'q', d12 = D0},D1 {d11 = 3.14, d12 = D0})
{-# LANGUAGE DeriveGeneric #-}
module Main where
import GHC.Generics hiding (C, D)
import GFunctor
-- We should be able to generate a generic representation for these types
data D a = D0 | D1 { d11 :: a, d12 :: (D a) }
deriving (Show, Generic, Generic1)
-- Example values
d0 :: D Char
d0 = D0
d1 = D1 (Just 'p') D0
d2 :: (Fractional a) => D (a,a)
d2 = D1 (3,0.14) D0
-- Generic instances
instance GFunctor D
-- Tests
main = print ( gmap undefined d0 :: D ()
, gmap (const 'q') d1
, gmap (\(a,b) -> a + b) d2 :: D Float)
TOP=../../..
include $(TOP)/mk/boilerplate.mk
include $(TOP)/mk/test.mk
setTestOpts(only_compiler_types(['ghc']))
test('GFunctor1', extra_clean(['GFunctor.hi', 'GFunctor.o', 'Main.hi', 'Main.o']),
multimod_compile_and_run, ['Main', ''])
\ No newline at end of file
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE DefaultSignatures #-}
module GMap (
-- * Generic map class
GMap(..)
) where
import GHC.Generics
--------------------------------------------------------------------------------
-- Generic map
--------------------------------------------------------------------------------
class GMap t where
gmap :: (a -> b) -> t a -> t b
default gmap :: (Generic1 t, GMap (Rep1 t)) => (a -> b) -> t a -> t b
gmap f = to1 . gmap f . from1
instance GMap Par1 where gmap f (Par1 x) = Par1 $ f x
instance GMap f => GMap (Rec1 f) where gmap f (Rec1 x) = Rec1 $ gmap f x
instance GMap U1 where gmap _ U1 = U1
instance GMap (K1 i c) where gmap _ (K1 x) = K1 x
instance (GMap a) => GMap (M1 i d a) where gmap f (M1 x) = M1 $ gmap f x
instance (GMap a, GMap b) => GMap (a :+: b) where
gmap f (L1 x) = L1 $ gmap f x
gmap f (R1 x) = R1 $ gmap f x
instance (GMap a, GMap b) => GMap (a :*: b) where
gmap f (x :*: y) = gmap f x :*: gmap f y
-- Base types instances
instance GMap [] where gmap = map
instance GMap Maybe where gmap = fmap
instance GMap ((,) a) where gmap f ~(x, y) = (x, f y)
D0
D1 {d11 = True, d12 = D0}
D1 {d11 = 3, d12 = D0}
{-# LANGUAGE DeriveGeneric #-}
module Main where
import GHC.Generics (Generic1)
import GMap
-- We should be able to generate a generic representation for these types
data D a = D0 | D1 { d11 :: a, d12 :: (D a) } deriving (Show, Generic1)
-- Example values
d0 :: D Char
d0 = D0
d1 = D1 (Just 'p') D0
d2 :: D (Int,Float)
d2 = D1 (3,0.14) D0
-- Generic instances
instance GMap D
-- Tests
main = do
print $ gmap id d0
(let isJust (Just _) = True
isJust Nothing = False in print $ gmap isJust d1)
print $ gmap fst d2
TOP=../../..
include $(TOP)/mk/boilerplate.mk
include $(TOP)/mk/test.mk
setTestOpts(only_compiler_types(['ghc']))
test('GMap1', extra_clean(['GMap.hi', 'GMap.o', 'Main.hi', 'Main.o']),
multimod_compile_and_run, ['Main', ''])
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TypeOperators #-}
module CanDoRep1 where
import GHC.Generics (Generic, Generic1)
-- We should be able to generate a generic representation for these types
data A a
deriving Generic1
data B a = B0 | B1
deriving Generic1
data C a = C0 | C1 { c11 :: a, c12 :: (C a) }
deriving (Generic, Generic1)
data (:*:) a b = a :*: b
deriving (Generic, Generic1)
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TypeOperators #-}
module GenCanDoRep1_0 where
import GHC.Generics (Generic1(..), Rep1)
-- We should be able to generate a generic representation for these types
data B a
deriving Generic1
data C a = C0 | C1
deriving Generic1
data D a = D0 | D1 { d11 :: a, d12 :: (D a) }
deriving Generic1
data (:*:) a b = a :*: b
deriving Generic1
data E b a = E0 | E1 (E b b) deriving Generic1
data F c b a = F (c, b, a) deriving Generic1
data G c b a = G [(c, c, c, c, b, a)] deriving (Generic1, Show)
data Odd a = Odd a (Even a) deriving Generic1
data Even a = NilEven | Even a (Odd a) deriving Generic1
data Odd' a = Odd' a (Even' a) deriving Generic1
data Even' a = NilEven' | Even' a (Odd' a)
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE DatatypeContexts #-}
module CannotDoRep0 where
import GHC.Generics
import GHC.Generics hiding (P, D)
-- We do not support existential quantification
data Dynamic = forall a. Dynamic a deriving Generic
-- Partial instantiation of types is not allowed
data P a = P a
deriving instance Generic (P Int)
-- This gets trickier for data families
data family D a b
data instance D Char b
data instance (Show b) => D Int b
data instance D () ()
-- Bad: second argument is instantiated
deriving instance Generic (D Char Char)
-- Bad: has context
deriving instance Generic (D Int a)
-- Ok
deriving instance Generic (D () ())
GenCannotDoRep0.hs:9:45:
Can't make a derived instance of `Generic Dynamic':
Dynamic must be a vanilla data constructor
In the data declaration for `Dynamic'
GenCannotDoRep0.hs:6:14: Warning:
-XDatatypeContexts is deprecated: It was widely considered a misfeature, and has been removed from the Haskell language.
GenCannotDoRep0.hs:13:45:
Can't make a derived instance of `Generic Dynamic':
Dynamic must be a vanilla data constructor
In the data declaration for `Dynamic'
GenCannotDoRep0.hs:17:1:
Can't make a derived instance of `Generic (P Int)':
P must not be instantiated; try deriving `P Int' instead
In the stand-alone deriving instance for `Generic (P Int)'
GenCannotDoRep0.hs:26:1:
Can't make a derived instance of `Generic (D Char Char)':
D must not be instantiated; try deriving `D Char b' instead
In the stand-alone deriving instance for `Generic (D Char Char)'
GenCannotDoRep0.hs:28:1:
Can't make a derived instance of `Generic (D Int a)':
D must not have a datatype context
In the stand-alone deriving instance for `Generic (D Int a)'
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE ExistentialQuantification #-}
module CannotDoRep1_0 where
import GHC.Generics
-- We do not support existential quantification
data Dynamic a = forall b. Dynamic b a deriving Generic1
GenCannotDoRep1_0.hs:9:49:
Can't make a derived instance of `Generic1 Dynamic':
Dynamic must be a vanilla data constructor
In the data declaration for `Dynamic'
{-# LANGUAGE DeriveGeneric, DatatypeContexts #-}
module CannotDoRep1_1 where
import GHC.Generics
-- We do not support datatypes with context
data (Show a) => Context a = Context a deriving Generic1
GenCannotDoRep1_1.hs:1:29: Warning:
-XDatatypeContexts is deprecated: It was widely considered a misfeature, and has been removed from the Haskell language.
GenCannotDoRep1_1.hs:8:49:
Can't make a derived instance of `Generic1 Context':
Context must not have a datatype context
In the data declaration for `Context'
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE GADTs #-}
module CannotDoRep1_2 where
import GHC.Generics
-- We do not support GADTs
data Term a where
Int :: Term Int
deriving instance Generic1 Term
GenCannotDoRep1_2.hs:13:1:
Can't make a derived instance of `Generic1 Term':
Int must be a vanilla data constructor
In the stand-alone deriving instance for `Generic1 Term'
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment