Move tests from tests/ghc-regress/* to just tests/*

5 files changed, 80 insertions, 0 deletions

diff --git a/testsuite/tests/generics/Uniplate/GUniplate.hs b/testsuite/tests/generics/Uniplate/GUniplate.hs
new file mode 100644
index 0000000000..76f387d636
--- /dev/null
+++ b/testsuite/tests/generics/Uniplate/GUniplate.hs
@@ -0,0 +1,53 @@
+{-# LANGUAGE MultiParamTypeClasses      #-}
+{-# LANGUAGE TypeSynonymInstances       #-}
+{-# LANGUAGE FlexibleInstances          #-}
+{-# LANGUAGE FlexibleContexts           #-}
+{-# LANGUAGE TypeOperators              #-}
+{-# LANGUAGE DefaultSignatures          #-}
+{-# LANGUAGE IncoherentInstances        #-} -- necessary, unfortunately
+
+module GUniplate where
+
+import GHC.Generics
+
+--------------------------------------------------------------------------------
+-- Generic Uniplate
+--------------------------------------------------------------------------------
+
+class Uniplate' f b where
+  children' :: f a -> [b]
+
+instance Uniplate' U1 a where
+  children' U1 = []
+
+instance Uniplate' (K1 i a) a where
+  children' (K1 a) = [a]
+
+instance Uniplate' (K1 i a) b where
+  children' (K1 _) = []
+
+instance (Uniplate' f b) => Uniplate' (M1 i c f) b where
+  children' (M1 a) = children' a
+
+instance (Uniplate' f b, Uniplate' g b) => Uniplate' (f :+: g) b where
+  children' (L1 a) = children' a
+  children' (R1 a) = children' a
+
+instance (Uniplate' f b, Uniplate' g b) => Uniplate' (f :*: g) b where
+  children' (a :*: b) = children' a ++ children' b 
+
+
+class Uniplate a where 
+  children :: a -> [a]
+  default children :: (Generic a, Uniplate' (Rep a) a) => a -> [a]
+  children = children' . from
+
+
+-- Base types instances
+instance Uniplate Char  where children _ = []
+instance Uniplate Int   where children _ = []
+instance Uniplate Float where children _ = []
+
+instance Uniplate [a] where
+  children []    = []
+  children (_:t) = [t]
diff --git a/testsuite/tests/generics/Uniplate/GUniplate1.stdout b/testsuite/tests/generics/Uniplate/GUniplate1.stdout
new file mode 100644
index 0000000000..f560e40162
--- /dev/null
+++ b/testsuite/tests/generics/Uniplate/GUniplate1.stdout
@@ -0,0 +1 @@
+("",[],[Leaf,Leaf])
diff --git a/testsuite/tests/generics/Uniplate/Main.hs b/testsuite/tests/generics/Uniplate/Main.hs
new file mode 100644
index 0000000000..95d84244fa
--- /dev/null
+++ b/testsuite/tests/generics/Uniplate/Main.hs
@@ -0,0 +1,20 @@
+{-# LANGUAGE DeriveGeneric #-}
+
+module Main where
+
+import GHC.Generics
+import GUniplate
+
+
+data Tree     = Leaf | Node Int Tree Tree deriving (Show, Generic)
+data Pair a b = Pair a b                  deriving (Show, Generic)
+
+instance Uniplate Tree
+instance Uniplate (Pair a b)
+
+-- Tests
+t1 = children ('p')
+t2 = children (Pair "abc" (Pair "abc" 2))
+t3 = children (Node 2 Leaf Leaf)
+
+main = print (t1, t2, t3)
diff --git a/testsuite/tests/generics/Uniplate/Makefile b/testsuite/tests/generics/Uniplate/Makefile
new file mode 100644
index 0000000000..9101fbd40a
--- /dev/null
+++ b/testsuite/tests/generics/Uniplate/Makefile
@@ -0,0 +1,3 @@
+TOP=../../..
+include $(TOP)/mk/boilerplate.mk
+include $(TOP)/mk/test.mk
diff --git a/testsuite/tests/generics/Uniplate/test.T b/testsuite/tests/generics/Uniplate/test.T
new file mode 100644
index 0000000000..a1e610726e
--- /dev/null
+++ b/testsuite/tests/generics/Uniplate/test.T
@@ -0,0 +1,3 @@
+setTestOpts(only_compiler_types(['ghc']))
+
+test('GUniplate1', normal, multimod_compile_and_run, ['Main', ''])
\ No newline at end of file