Add tests for deriving Generic1

Most of these tests were written by Nicolas Frisby.

5 files changed, 78 insertions, 0 deletions

diff --git a/testsuite/tests/generics/GMap/GMap.hs b/testsuite/tests/generics/GMap/GMap.hs
new file mode 100644
index 0000000000..e7d57dea70
--- /dev/null
+++ b/testsuite/tests/generics/GMap/GMap.hs
@@ -0,0 +1,41 @@
+{-# 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)
diff --git a/testsuite/tests/generics/GMap/GMap1.stdout b/testsuite/tests/generics/GMap/GMap1.stdout
new file mode 100644
index 0000000000..f24d682c7c
--- /dev/null
+++ b/testsuite/tests/generics/GMap/GMap1.stdout
@@ -0,0 +1,3 @@
+D0
+D1 {d11 = True, d12 = D0}
+D1 {d11 = 3, d12 = D0}
diff --git a/testsuite/tests/generics/GMap/Main.hs b/testsuite/tests/generics/GMap/Main.hs
new file mode 100644
index 0000000000..0d44621a2c
--- /dev/null
+++ b/testsuite/tests/generics/GMap/Main.hs
@@ -0,0 +1,27 @@
+{-# 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
diff --git a/testsuite/tests/generics/GMap/Makefile b/testsuite/tests/generics/GMap/Makefile
new file mode 100644
index 0000000000..9101fbd40a
--- /dev/null
+++ b/testsuite/tests/generics/GMap/Makefile
@@ -0,0 +1,3 @@
+TOP=../../..
+include $(TOP)/mk/boilerplate.mk
+include $(TOP)/mk/test.mk
diff --git a/testsuite/tests/generics/GMap/test.T b/testsuite/tests/generics/GMap/test.T
new file mode 100644
index 0000000000..e83a2d857e
--- /dev/null
+++ b/testsuite/tests/generics/GMap/test.T
@@ -0,0 +1,4 @@
+setTestOpts(only_compiler_types(['ghc']))
+
+test('GMap1', extra_clean(['GMap.hi', 'GMap.o', 'Main.hi', 'Main.o']),
+     multimod_compile_and_run, ['Main', ''])