Create hyperlinker test case for type classes.

1 files changed, 38 insertions, 0 deletions

diff --git a/hypsrc-test/src/Classes.hs b/hypsrc-test/src/Classes.hs
new file mode 100644
index 00000000..bddb9939
--- /dev/null
+++ b/hypsrc-test/src/Classes.hs
@@ -0,0 +1,38 @@
+module Classes where
+
+
+class Foo a where
+    bar :: a -> Int
+    baz :: Int -> (a, a)
+
+instance Foo Int where
+    bar = id
+    baz x = (x, x)
+
+instance Foo [a] where
+    bar = length
+    baz _ = ([], [])
+
+
+class Foo a => Foo' a where
+    quux :: (a, a) -> a
+    quux (x, y) = norf [x, y] 
+
+    norf :: [a] -> a
+    norf = quux . baz . sum . map bar
+
+instance Foo' Int where
+    norf = sum
+
+instance Foo' [a] where
+    quux = uncurry (++)
+
+
+class Plugh p where
+    plugh :: p a a -> p b b -> p (a -> b) (b -> a)
+
+instance Plugh Either where
+    plugh (Left a) _ = Right $ const a
+    plugh (Right a) _ = Right $ const a
+    plugh _ (Left b) = Left $ const b
+    plugh _ (Right b) = Left $ const b