Merge pull request #1 from haskell/ghc-head

Ghc head

12 files changed, 186 insertions, 22 deletions

diff --git a/html-test/src/AdvanceTypes.hs b/html-test/src/AdvanceTypes.hs
deleted file mode 100644
index 939fdf07..00000000
--- a/html-test/src/AdvanceTypes.hs
+++ /dev/null
@@ -1,9 +0,0 @@
-{-# LANGUAGE DataKinds #-}
-{-# LANGUAGE GADTs #-}
-{-# LANGUAGE KindSignatures #-}
-{-# LANGUAGE TypeOperators #-}
-module AdvanceTypes where
-
-data Pattern :: [*] -> * where
-  Nil :: Pattern '[]
-  Cons :: Maybe h -> Pattern t -> Pattern (h ': t)
diff --git a/html-test/src/Bug253.hs b/html-test/src/Bug253.hs
new file mode 100644
index 00000000..499f6cd4
--- /dev/null
+++ b/html-test/src/Bug253.hs
@@ -0,0 +1,10 @@
+-- | This module tests that if we're trying to link to a /qualified/
+-- identifier that's not in scope, we get an anchor as if it was a
+-- variable. Previous behaviour was to treat it as a type constructor
+-- so issue like #253 arose. Also see @rename@ function comments in
+-- source.
+module Bug253 where
+
+-- | This link should generate @#v@ anchor: 'DoesNotExist.fakeFakeFake'
+foo :: ()
+foo = ()
diff --git a/html-test/src/Bug387.hs b/html-test/src/Bug387.hs
new file mode 100644
index 00000000..d9fed34e
--- /dev/null
+++ b/html-test/src/Bug387.hs
@@ -0,0 +1,12 @@
+module Bug387
+  ( -- * Section1#a:section1#
+    test1
+    -- * Section2#a:section2#
+  , test2
+  ) where
+
+test1 :: Int
+test1 = 223
+
+test2 :: Int
+test2 = 42
diff --git a/html-test/src/Bug8.hs b/html-test/src/Bug8.hs
index e569b01d..30afae1f 100644
--- a/html-test/src/Bug8.hs
+++ b/html-test/src/Bug8.hs
@@ -7,6 +7,7 @@ data Typ = Type (Typ,[Typ])
          | TFree (Typ, [Typ])
 
 x --> y = Type(s,[s,t])
+(--->) :: (Foldable t0) => t0 t -> Typ -> Typ
 (--->) = flip $ foldr (-->)
 
 s = undefined
diff --git a/html-test/src/Bugs.hs b/html-test/src/Bugs.hs
index 8e1f0079..e60bbe8f 100644
--- a/html-test/src/Bugs.hs
+++ b/html-test/src/Bugs.hs
@@ -1,3 +1,3 @@
 module Bugs where
 
-data A a = A a (a -> Int) 
+data A a = A a (a -> Int)
diff --git a/html-test/src/Instances.hs b/html-test/src/Instances.hs
new file mode 100644
index 00000000..545c8534
--- /dev/null
+++ b/html-test/src/Instances.hs
@@ -0,0 +1,99 @@
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE ImpredicativeTypes #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE TypeOperators #-}
+
+
+module Instances where
+
+
+newtype (<~~) a b = Xyzzy (b -> (a, a))
+
+
+class Foo f where
+
+    foo :: f Int -> a -> f a
+    foo' :: f (f a) -> Int -> f (f Int)
+
+    foo = undefined
+    foo' = undefined
+
+instance Foo Maybe
+instance Foo []
+instance (Eq a, Foo f) => Foo ((,) (f a))
+instance Foo (Either a)
+instance Foo ((,,) a a)
+instance Foo ((->) a)
+instance Foo ((<~~) a)
+
+
+class Foo f => Bar f a where
+
+    bar :: f a -> f Bool -> a
+    bar' :: f (f a) -> f (f (f b))
+    bar0, bar1 :: (f a, f a) -> (f b, f c)
+
+    bar = undefined
+    bar' = undefined
+    bar0 = undefined
+    bar1 = undefined
+
+
+instance Bar Maybe Bool
+instance Bar Maybe [a]
+instance Bar [] (a, a)
+instance Foo f => Bar (Either a) (f a)
+instance Foo ((,,) a b) => Bar ((,,) a b) (a, b, a)
+
+
+class Baz a where
+
+    baz :: a -> (forall a. a -> a) -> (b, forall c. c -> a) -> (b, c)
+    baz' :: b -> (forall b. b -> a) -> (forall b. b -> a) -> [(b, a)]
+    baz'' :: b -> (forall b. (forall b. b -> a) -> c) -> (forall c. c -> b)
+
+    baz = undefined
+    baz' = undefined
+    baz'' = undefined
+
+
+instance Baz (a -> b)
+instance Baz [c]
+instance Baz (a, b, c)
+instance Baz (a, [b], b, a)
+
+
+data Quux a b c = Qx a | Qux a b | Quux a b c
+
+instance Foo (Quux a b)
+instance Bar (Quux a c) (Quux a b c)
+instance Baz (Quux a b c)
+
+
+class Norf a b where
+
+    type Plugh a c b
+    data Thud a c
+
+    norf :: Plugh a c b -> a -> (a -> c) -> b
+
+    norf = undefined
+
+
+instance Norf Int Bool where
+
+    type Plugh Int [a] Bool = a
+    type Plugh Int (a, b) Bool = (a, [b])
+
+    data Thud Int (Quux a [a] c) = Thuud a | Thuuud Int Int
+    data Thud Int [a] = Thuuuud Bool
+
+
+instance Norf [a] [b] where
+
+    type Plugh [a] (Maybe a) [b] = a
+    type Plugh [a] [b] [b] = Quux a b (a, b)
+
+    data Thud [a] (a, a, a) = Thd a
diff --git a/html-test/src/Nesting.hs b/html-test/src/Nesting.hs
index 34177442..f88be87d 100644
--- a/html-test/src/Nesting.hs
+++ b/html-test/src/Nesting.hs
@@ -119,3 +119,18 @@ definition lists too.
 -}
 j :: t
 j = undefined
+
+{-|
+      - list may start at arbitrary depth
+
+      - and consecutive items at that depth
+      belong to the same list
+
+      - of course we can still
+
+          * nest items like we are used to
+
+      - and then get back to initial list
+-}
+k :: t
+k = undefined
diff --git a/html-test/src/PromotedTypes.hs b/html-test/src/PromotedTypes.hs
new file mode 100644
index 00000000..ae3ad375
--- /dev/null
+++ b/html-test/src/PromotedTypes.hs
@@ -0,0 +1,25 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE KindSignatures #-}
+{-# LANGUAGE TypeOperators #-}
+
+
+module PromotedTypes where
+
+
+data RevList a = RNil | RevList a :> a
+
+
+data Pattern :: [*] -> * where
+  Nil :: Pattern '[]
+  Cons :: Maybe h -> Pattern t -> Pattern (h ': t)
+
+
+-- Unlike (:), (:>) does not have to be quoted on type level.
+data RevPattern :: RevList * -> * where
+    RevNil :: RevPattern RNil
+    RevCons :: Maybe h -> RevPattern t -> RevPattern (t :> h)
+
+
+data Tuple :: (*, *) -> * where
+    Tuple :: a -> b -> Tuple '(a, b)
diff --git a/html-test/src/Threaded.hs b/html-test/src/Threaded.hs
new file mode 100644
index 00000000..7f3073ad
--- /dev/null
+++ b/html-test/src/Threaded.hs
@@ -0,0 +1,10 @@
+{-# LANGUAGE TemplateHaskell #-}
+
+-- | Ensures haddock built with @-threaded@.
+module Threaded where
+
+import Threaded_TH
+
+-- | @$(forkTH)@ fails at compile time if haddock isn't using the
+-- threaded RTS.
+f = $(forkTH)
diff --git a/html-test/src/Threaded_TH.hs b/html-test/src/Threaded_TH.hs
new file mode 100644
index 00000000..53e5a399
--- /dev/null
+++ b/html-test/src/Threaded_TH.hs
@@ -0,0 +1,13 @@
+-- | Imported by 'Threaded', since a TH splice can't be used in the
+-- module where it is defined.
+module Threaded_TH where
+
+import Control.Concurrent (forkOS)
+import Language.Haskell.TH.Syntax (Exp (LitE), Lit (IntegerL), Q, runIO)
+
+-- | forkOS requires the threaded RTS, so this TH fails if haddock was
+-- built without @-threaded@.
+forkTH :: Q Exp
+forkTH = do
+  _ <- runIO (forkOS (return ()))
+  return (LitE (IntegerL 0))
diff --git a/html-test/src/Ticket253_1.hs b/html-test/src/Ticket253_1.hs
deleted file mode 100644
index 62ab4b17..00000000
--- a/html-test/src/Ticket253_1.hs
+++ /dev/null
@@ -1,6 +0,0 @@
-module Ticket253_1 where
--- | See 'Ticket253_2.bar'.
---
--- Also see 'Ticket253_2.Baz'
-foo :: Int
-foo = 0
diff --git a/html-test/src/Ticket253_2.hs b/html-test/src/Ticket253_2.hs
deleted file mode 100644
index a19d4cee..00000000
--- a/html-test/src/Ticket253_2.hs
+++ /dev/null
@@ -1,6 +0,0 @@
-module Ticket253_2 where
--- | Comment
-bar :: Int
-bar = 0
-
-data Baz = Baz