From 69b98a99ce4de93ea0e6082bd11edb3baaf2fa6e Mon Sep 17 00:00:00 2001 From: Alexander Biehl Date: Fri, 2 Mar 2018 15:43:21 +0100 Subject: Make testsuite work with haddock-1.19.0 release (#766) --- html-test/Main.hs | 15 + html-test/ref/A.html | 12 +- html-test/ref/Bug1.html | 2 +- html-test/ref/Bug2.html | 2 +- html-test/ref/Bug253.html | 2 +- html-test/ref/Bug26.html | 4 +- html-test/ref/Bug280.html | 2 +- html-test/ref/Bug294.html | 154 +++++- html-test/ref/Bug298.html | 8 +- html-test/ref/Bug3.html | 4 +- html-test/ref/Bug310.html | 16 +- html-test/ref/Bug387.html | 8 +- html-test/ref/Bug4.html | 4 +- html-test/ref/Bug546.html | 12 +- html-test/ref/Bug548.html | 244 +++++----- html-test/ref/Bug6.html | 78 ++-- html-test/ref/Bug613.html | 26 +- html-test/ref/Bug647.html | 2 +- html-test/ref/Bug679.html | 18 +- html-test/ref/Bug7.html | 12 +- html-test/ref/Bug8.html | 16 +- html-test/ref/Bug85.html | 16 +- html-test/ref/BugDeprecated.html | 24 +- html-test/ref/BugExportHeadings.html | 24 +- html-test/ref/Bugs.html | 2 +- html-test/ref/BundledPatterns.html | 64 +-- html-test/ref/BundledPatterns2.html | 98 ++-- html-test/ref/ConstructorPatternExport.html | 18 +- html-test/ref/DeprecatedClass.html | 4 +- html-test/ref/DeprecatedFunction.html | 10 +- html-test/ref/DeprecatedFunction2.html | 4 +- html-test/ref/DeprecatedFunction3.html | 4 +- html-test/ref/DeprecatedModule.html | 2 +- html-test/ref/DeprecatedModule2.html | 2 +- html-test/ref/DeprecatedNewtype.html | 8 +- html-test/ref/DeprecatedReExport.html | 6 +- html-test/ref/DeprecatedRecord.html | 8 +- html-test/ref/DeprecatedTypeFamily.html | 16 +- html-test/ref/DeprecatedTypeSynonym.html | 8 +- html-test/ref/Examples.html | 10 +- html-test/ref/FunArgs.html | 8 +- html-test/ref/GADTRecords.html | 34 +- html-test/ref/Hash.html | 80 ++-- html-test/ref/HiddenInstances.html | 50 +- html-test/ref/HiddenInstancesB.html | 8 +- html-test/ref/Hyperlinks.html | 4 +- html-test/ref/ImplicitParams.html | 14 +- html-test/ref/Instances.html | 566 +++++++++++------------ html-test/ref/Math.html | 4 +- html-test/ref/Minimal.html | 24 +- html-test/ref/ModuleWithWarning.html | 2 +- html-test/ref/NoLayout.html | 6 +- html-test/ref/Operators.html | 40 +- html-test/ref/OrphanInstances.html | 18 +- html-test/ref/OrphanInstancesClass.html | 52 ++- html-test/ref/OrphanInstancesType.html | 50 +- html-test/ref/PatternSyns.html | 72 +-- html-test/ref/PromotedTypes.html | 40 +- html-test/ref/Properties.html | 10 +- html-test/ref/QuasiExpr.html | 54 +-- html-test/ref/QuasiQuote.html | 2 +- html-test/ref/SpuriousSuperclassConstraints.html | 48 +- html-test/ref/Table.html | 2 +- html-test/ref/Test.html | 424 ++++++++++------- html-test/ref/Threaded.html | 4 +- html-test/ref/Ticket112.html | 2 +- html-test/ref/Ticket61.html | 2 +- html-test/ref/Ticket75.html | 6 +- html-test/ref/TitledPicture.html | 12 +- html-test/ref/TypeFamilies.html | 544 +++++++++------------- html-test/ref/TypeFamilies2.html | 50 +- html-test/ref/TypeOperators.html | 14 +- html-test/ref/Unicode.html | 4 +- html-test/ref/Visible.html | 4 +- 74 files changed, 1687 insertions(+), 1536 deletions(-) diff --git a/html-test/Main.hs b/html-test/Main.hs index 67dbeec6..d65a5087 100755 --- a/html-test/Main.hs +++ b/html-test/Main.hs @@ -47,7 +47,22 @@ stripIfRequired mdl = preserveLinksModules :: [String] preserveLinksModules = ["Bug253"] +ingoredTests :: [FilePath] +ingoredTests = + [ + -- Currently some declarations are exported twice + -- we need a reliable way to deduplicate here. + -- Happens since PR #688. + "B" + + -- ignore-exports flag broke with PR #688. We use + -- the Avails calculated by GHC now. Probably + -- requires a change to GHC to "ignore" a modules + -- export list reliably. + , "IgnoreExports" + ] checkIgnore :: FilePath -> Bool +checkIgnore file | takeBaseName file `elem` ingoredTests = True checkIgnore file@(c:_) | takeExtension file == ".html" && isUpper c = False checkIgnore _ = True diff --git a/html-test/ref/A.html b/html-test/ref/A.html index 1fbfb371..e4802966 100644 --- a/html-test/ref/A.html +++ b/html-test/ref/A.html @@ -54,13 +54,13 @@ >
  • other :: :: Int
  • test2 :: :: Bool
  • reExport :: :: Int
  • other :: :: Int #

    test2 :: :: Bool #

    reExport :: :: Int #

    We should have different anchors for constructors and types/classes. This hyperlink should point to the type constructor by default: T.

    x :: :: A #This link should generate #v anchor: fakeFakeFake

    Minimal complete definition

    c_f

    C ()

    x :: [ :: [Char] # data DP A

    data DP A = ProblemCtor' A
    data TP TP A
    data TP TP A = ProblemCtor A

    problemField :: TO :: TO A -> -> A #

    problemField' :: DO :: DO A -> -> A #

    gadtField :: ({..} -> GADT :: ({..} -> GADT A) -> ) -> A #

    data family TP t :: * #

    Instances
    data TP A #
    Instance details
    data TP A = ProblemCtor A

    data family DP t :: t :: * # data DP A

    data family TO' t :: * #

    Instances
    data TO' a #
    Instance details
    data TO' a = PolyCtor
  • test1 :: :: Int
  • test2 :: :: Int
  • test1 :: :: Int #

    test2 :: :: Int #

  • foo :: :: Int
  • foo :: :: Int #

  • x :: :: Integer
  • compile :: :: String -> -> String
  • x :: :: Integer #

    compile :: :: String -> -> String #newtype WrappedArrow (a :: (a :: * -> -> * -> -> *) b c # Generic1 * ( (WrappedArrow a b) a b :: * -> *)

    type Rep1 (WrappedArrow a b) (f :: (WrappedArrow a b -> *) :: k -> a b) :: k -> * #

    from1 :: f a0 -> :: WrappedArrow a b a0 -> Rep1 ( (WrappedArrow a b) f a0 a b) a0 #

    to1 :: :: Rep1 ( (WrappedArrow a b) a0 -> WrappedArrow a b) f a0 -> f a0 a b a0 #

    Arrow a => a => Functor ( (WrappedArrow a b)

    fmap :: (a0 -> b0) -> :: (a0 -> b0) -> WrappedArrow a b a0 -> a b a0 -> WrappedArrow a b b0 #

    (<$) :: a0 -> :: a0 -> WrappedArrow a b b0 -> a b b0 -> WrappedArrow a b a0 # Arrow a => a => Applicative ( (WrappedArrow a b)

    pure :: a0 -> :: a0 -> WrappedArrow a b a0 #

    (<*>) :: :: WrappedArrow a b (a0 -> b0) -> a b (a0 -> b0) -> WrappedArrow a b a0 -> a b a0 -> WrappedArrow a b b0 #

    liftA2 :: (a0 -> b0 -> c) -> :: (a0 -> b0 -> c) -> WrappedArrow a b a0 -> a b a0 -> WrappedArrow a b b0 -> a b b0 -> WrappedArrow a b c #

    (*>) :: :: WrappedArrow a b a0 -> a b a0 -> WrappedArrow a b b0 -> a b b0 -> WrappedArrow a b b0 #

    (<*) :: :: WrappedArrow a b a0 -> a b a0 -> WrappedArrow a b b0 -> a b b0 -> WrappedArrow a b a0 # ( (ArrowZero a, a, ArrowPlus a) => a) => Alternative ( (WrappedArrow a b)

    empty :: :: WrappedArrow a b a0 #

    (<|>) :: :: WrappedArrow a b a0 -> a b a0 -> WrappedArrow a b a0 -> a b a0 -> WrappedArrow a b a0 #

    some :: :: WrappedArrow a b a0 -> a b a0 -> WrappedArrow a b [a0] #

    many :: :: WrappedArrow a b a0 -> a b a0 -> WrappedArrow a b [a0] # Generic ( (WrappedArrow a b c)

    type Rep ( (WrappedArrow a b c) :: a b c) :: * -> -> * #

    from :: :: WrappedArrow a b c -> a b c -> Rep ( (WrappedArrow a b c) x #

    to :: :: Rep ( (WrappedArrow a b c) x -> a b c) x -> WrappedArrow a b c # type Rep1 * ( (WrappedArrow a b) a b :: * -> *)

    type Rep1 * ( (WrappedArrow a b) = D1 a b :: * ( -> *) = D1 (MetaData "WrappedArrow" "Control.Applicative" "base" "WrappedArrow" "Control.Applicative" "base" True) () (C1 * ( (MetaCons "WrapArrow" "WrapArrow" PrefixI True) () (S1 * ( (MetaSel ( (Just Symbol "unwrapArrow") "unwrapArrow") NoSourceUnpackedness NoSourceStrictness DecidedLazy) () (Rec1 * (a b))))
    type Rep ( (WrappedArrow a b c)
    type Rep ( (WrappedArrow a b c) = a b c) = D1 * ( (MetaData "WrappedArrow" "Control.Applicative" "base" "WrappedArrow" "Control.Applicative" "base" True) () (C1 * ( (MetaCons "WrapArrow" "WrapArrow" PrefixI True) () (S1 * ( (MetaSel ( (Just Symbol "unwrapArrow") "unwrapArrow") NoSourceUnpackedness NoSourceStrictness DecidedLazy) () (Rec0 * (a b c))))
    A = A Int
  • B = B {}
  • Int
  • b :: B -> Int
  • data
  • c1 :: :: Int
  • c2 :: :: Int
  • D = D Int Int
  • E = E Int
  • A IntB Int

    Fields

    b :: B -> Int #

    datac1 :: :: Int

    c2 :: :: Int
    D Int IntE Int

    Minimal complete definition

    fmap

    Functor ( (Either a)

    fmap :: (a0 -> b) -> :: (a0 -> b) -> Either a a0 -> a a0 -> Either a b # Functor ( (ThreeVars a0 a)

    fmap :: (a1 -> b) -> :: (a1 -> b) -> ThreeVars a0 a a1 -> a0 a a1 -> ThreeVars a0 a b # Functor ( (ThreeVars a0 a)

    fmap :: (a1 -> b) -> :: (a1 -> b) -> ThreeVars a0 a a1 -> a0 a a1 -> ThreeVars a0 a b #

    Minimal complete definition

    f

    Foo ( (Bar a)

    foo :: :: Bar a -> a -> Bar a #

    Minimal complete definition

    foo

    Foo ( (Bar a)

    foo :: :: Bar a -> a -> Bar a # Bar Foo Foo Bar Foo Foo Type ( (Typ, [, [Typ])TFree ( (Typ, [, [Typ])

    (-->) :: p1 -> p2 -> :: p1 -> p2 -> Typ infix 9

    (--->) :: :: Foldable t0 => t0 t -> t0 => t0 t -> Typ -> -> Typ infix 9data Foo :: ( :: (* -> -> *) -> ) -> * -> -> * whereBar :: f x -> :: f x -> Foo f (f x)data Baz :: :: * whereBaz' :: :: BazQuux :: :: Qux

  • foo :: :: Int
  • bar :: :: Int
  • baz :: :: Int
  • one :: :: Int
  • two :: :: Int
  • three :: :: Int
  • foo :: :: Int #

    bar :: :: Int #

    baz :: :: Int #

    one :: :: Int #

    two :: :: Int #

    three :: :: Int #

  • foo :: :: Int
  • bar :: :: Int
  • baz :: :: Int
  • one :: :: Int
  • two :: :: Int
  • three :: :: Int
  • foo :: :: Int #

    bar :: :: Int #

    baz :: :: Int #

    one :: :: Int #

    two :: :: Int #

    three :: :: Int #A a (a -> a (a -> Int)data Vec :: :: Nat -> -> * -> -> * where

  • Nil :: :: Vec 0 a
  • pattern (:>) :: a -> :: a -> Vec n a -> n a -> Vec (n (n + 1) a
  • data RTree :: :: Nat -> -> * -> -> * wherepattern LR :: a -> :: a -> RTree 0 a
  • pattern BR :: :: RTree d a -> d a -> RTree d a -> d a -> RTree (d (d + 1) a
  • data Vec :: :: Nat -> -> * -> -> * whereLists with their length encoded in their type
  • Vector elements have an subscript starting from 0 and ending at length - 1Nil :: :: Vec 0 apattern (:>) :: a -> :: a -> Vec n a -> n a -> Vec (n (n + 1) a infixr 5data RTree :: :: Nat -> -> * -> -> * wherepattern LR :: a -> :: a -> RTree 0 apattern BR :: :: RTree d a -> d a -> RTree d a -> d a -> RTree (d (d + 1) adata Vec :: :: Nat -> -> * -> -> * wherepattern Empty :: (:>) :: a -> Vec 0 a
  • n a -> Vec (n + 1) a
  • pattern (:>) :: a -> Vec n a -> Empty :: Vec (n + 1) a
  • 0 a
  • data RTree :: :: Nat -> -> * -> -> * wherepattern LR :: a -> :: a -> RTree 0 a
  • pattern BR :: :: RTree d a -> d a -> RTree d a -> d a -> RTree (d (d + 1) a
  • data Vec :: :: Nat -> -> * -> -> * whereLists with their length encoded in their type
  • Vector elements have an subscript starting from 0 and ending at length - 1Bundled Patterns

    pattern Empty :: Vec 0 a
    pattern (:>) :: a -> :: a -> Vec n a -> n a -> Vec (n (n + 1) a infixr 5
    pattern Empty :: Vec 0 a
    data RTree :: :: Nat -> -> * -> -> * wherepattern LR :: a -> :: a -> RTree 0 apattern BR :: :: RTree d a -> d a -> RTree d a -> d a -> RTree (d (d + 1) apattern FooCons :: :: String -> a -> Foo a #pattern MyRecCons :: :: Bool -> -> Int -> MyRec #pattern (:+) :: :: String -> a -> MyInfix a #pattern BlubCons :: () => :: () => Show b => b -> Blub #MyGADTCons :: () => forall a. a. Eq a => a -> a => a -> Int -> MyGADT ( -> MyGADT (Maybe String) #

    Minimal complete definition

    foo

    Minimal complete definition

    bar

  • foo :: :: Int
  • bar :: :: Int
  • foo :: :: Int #

    Deprecated: use bar instead

    bar :: :: Int #

  • foo :: :: Int
  • foo :: :: Int #

  • foo :: :: Integer
  • foo :: :: Integer #

    foo :: :: Int #

    foo :: :: Int #SomeNewType = SomeNewTypeConst String

  • SomeOtherNewType = SomeOtherNewTypeConst String
  • SomeNewTypeConst StringSomeOtherNewTypeConst String
  • foo :: :: Int
  • foo :: :: Int #

    Deprecated: use bar instead

  • fooName :: :: String
  • fooValue :: :: Int
  • fooName :: :: String
    fooValue :: :: Int
    data family SomeTypeFamily k :: k :: * -> -> *
  • data family SomeOtherTypeFamily k :: k :: * -> -> *
  • data family SomeTypeFamily k :: k :: * -> -> * #data family SomeOtherTypeFamily k :: k :: * -> -> * #type TypeSyn = = String
  • type OtherTypeSyn = = String
  • type TypeSyn = = String #type OtherTypeSyn = = String #
  • fib :: :: Integer -> -> Integer
  • fib :: :: Integer -> -> Integer #

    Fibonacci number of given Integer.

    foo :: (LiftedRep -> LiftedRep) a :: (a -> Int -> a0 -> (LiftedRep -> LiftedRep) a a0 ) -> a0 -> a -> a0 #

    foo' :: (LiftedRep -> LiftedRep) a ((LiftedRep -> LiftedRep) a a0) -> :: (a -> a -> a0) -> Int -> (LiftedRep -> LiftedRep) a ((LiftedRep -> LiftedRep) a -> a -> a -> Int) #

    class Foo f => Bar

    bar :: f a -> f :: f a -> f Bool -> a # Bar Maybe Bool

    bar :: :: Maybe Bool -> -> Maybe Bool -> -> Bool #

    bar' :: :: Maybe ( (Maybe Bool) -> ) -> Maybe ( (Maybe ( (Maybe b)) #

    bar0 :: ( :: (Maybe Bool, , Maybe Bool) -> () -> (Maybe b, b, Maybe c) #

    bar1 :: ( :: (Maybe Bool, , Maybe Bool) -> () -> (Maybe b, b, Maybe c) # Bar Maybe [a]

    bar :: :: Maybe [a] -> [a] -> Maybe Bool -> [a] #

    bar' :: :: Maybe ( (Maybe [a]) -> [a]) -> Maybe ( (Maybe ( (Maybe b)) #

    bar0 :: ( :: (Maybe [a], [a], Maybe [a]) -> ( [a]) -> (Maybe b, b, Maybe c) #

    bar1 :: ( :: (Maybe [a], [a], Maybe [a]) -> ( [a]) -> (Maybe b, b, Maybe c) # Bar [] (a, a)

    bar :: [(a, a)] -> [ :: [(a, a)] -> [Bool] -> (a, a) # Foo f => f => Bar ( (Either a) (f a)

    bar :: :: Either a (f a) -> a (f a) -> Either a a Bool -> f a #

    bar' :: :: Either a ( a (Either a (f a)) -> a (f a)) -> Either a ( a (Either a ( a (Either a b)) #

    bar0 :: ( :: (Either a (f a), a (f a), Either a (f a)) -> ( a (f a)) -> (Either a b, a b, Either a c) #

    bar1 :: ( :: (Either a (f a), a (f a), Either a (f a)) -> ( a (f a)) -> (Either a b, a b, Either a c) # Foo ( ((,,) a b) => a b) => Bar ( ((,,) a b) (a, b, a)

    bar :: (a, b, (a, b, a)) -> (a, b, :: (a, b, (a, b, a)) -> (a, b, Bool) -> (a, b, a) # Bar ( (Quux a c) ( a c) (Quux a b c)

    bar :: :: Quux a c ( a c (Quux a b c) -> a b c) -> Quux a c a c Bool -> -> Quux a b c #

    bar' :: :: Quux a c ( a c (Quux a c ( a c (Quux a b c)) -> a b c)) -> Quux a c ( a c (Quux a c ( a c (Quux a c b0)) #

    bar0 :: ( :: (Quux a c ( a c (Quux a b c), a b c), Quux a c ( a c (Quux a b c)) -> ( a b c)) -> (Quux a c b0, a c b0, Quux a c c0) #

    bar1 :: ( :: (Quux a c ( a c (Quux a b c), a b c), Quux a c ( a c (Quux a b c)) -> ( a b c)) -> (Quux a c b0, a c b0, Quux a c c0) # Baz [c] Baz (a -> b) Baz (a, b, c) Baz ( (Quux a b c)

    baz :: :: Quux a b c -> (forall a0. a0 -> a0) -> (b0, forall c0. c0 -> c0. c0 -> Quux a b c) -> (b0, c1) #baz' :: b0 -> (forall b1. b1 -> b1. b1 -> Quux a b c) -> (forall b2. b2 -> b2. b2 -> Quux a b c) -> [(b0, a b c) -> [(b0, Quux a b c)] #forall b1. (forall b2. b2 -> b2. b2 -> Quux a b c) -> c0) -> forall Baz (a, [b], b, a) Foo ( (Quux a b)

    foo :: :: Quux a b a b Int -> a0 -> -> a0 -> Quux a b a0 #

    foo' :: :: Quux a b ( a b (Quux a b a0) -> a b a0) -> Int -> -> Quux a b ( a b (Quux a b a b Int) # Bar ( (Quux a c) ( a c) (Quux a b c)

    bar :: :: Quux a c ( a c (Quux a b c) -> a b c) -> Quux a c a c Bool -> -> Quux a b c #

    bar' :: :: Quux a c ( a c (Quux a c ( a c (Quux a b c)) -> a b c)) -> Quux a c ( a c (Quux a c ( a c (Quux a c b0)) #

    bar0 :: ( :: (Quux a c ( a c (Quux a b c), a b c), Quux a c ( a c (Quux a b c)) -> ( a b c)) -> (Quux a c b0, a c b0, Quux a c c0) #

    bar1 :: ( :: (Quux a c ( a c (Quux a b c), a b c), Quux a c ( a c (Quux a b c)) -> ( a b c)) -> (Quux a c b0, a c b0, Quux a c c0) # Baz ( (Quux a b c)

    baz :: :: Quux a b c -> (forall a0. a0 -> a0) -> (b0, forall c0. c0 -> c0. c0 -> Quux a b c) -> (b0, c1) #baz' :: b0 -> (forall b1. b1 -> b1. b1 -> Quux a b c) -> (forall b2. b2 -> b2. b2 -> Quux a b c) -> [(b0, a b c) -> [(b0, Quux a b c)] #forall b1. (forall b2. b2 -> b2. b2 -> Quux a b c) -> c0) -> forall data Thud Int ( (Quux a [a] c)

    data Thud Int ( (Quux a [a] c)

    norf :: :: Plugh a c b -> a -> (a -> c) -> b # Norf Int Bool

    type Plugh Int c c Bool :: :: * #

    data Thud Int c :: c :: * #

    norf :: :: Plugh Int c c Bool -> -> Int -> ( -> (Int -> c) -> -> c) -> Bool # Norf [a] [b]

    type Plugh [a] c [b] :: [a] c [b] :: * #

    data Thud [a] c :: [a] c :: * #

    norf :: :: Plugh [a] c [b] -> [a] -> ([a] -> c) -> [b] #

  • f :: :: Integer
  • f :: :: Integer #

    Minimal complete definition

    foo, , bar | | bar, , bat | | foo, , bat | | fooBarBat

    Minimal complete definition

    x, , y

    Minimal complete definition

    aaa, , bbb

    Minimal complete definition

    ccc, ddd

    foo :: :: Int #

  • g :: :: Int
  • g :: :: Int #

    the function g

    Foo
  • (:<->) :: a -> b -> a :: a -> b -> a <-> b
  • type a <>< b :: b :: *
  • type (>-<) a b = a a b = a <-> b
  • :: :: Ord a
    => => Int
    -> -> Bool:: forall (b :: ()). d ~ (b :: ()). d ~ ()
  • C1 :: :: H1 a b
  • C2 :: :: Ord a => [a] -> a => [a] -> H1 a a
  • C3 :: {..} -> :: {..} -> H1 Int Int
  • C4 :: {..} -> :: {..} -> H1 Int a
  • C1 :: :: H1 a bC2 :: :: Ord a => [a] -> a => [a] -> H1 a aC3 :: {..} -> :: {..} -> H1 Int Intfield :: :: Int
    C4 :: {..} -> :: {..} -> H1 Int a
  • new :: ( :: (Eq key, key, Hash key) => key) => Int -> -> IO ( (HashTable key val)
  • insert :: ( :: (Eq key, key, Hash key) => key -> val -> key) => key -> val -> IO ()
  • lookup :: :: Hash key => key -> key => key -> IO ( (Maybe val)
  • key should be an instance of Eq.

    new :: ( :: (Eq key, key, Hash key) => key) => Int -> -> IO ( (HashTable key val) #

    insert :: ( :: (Eq key, key, Hash key) => key -> val -> key) => key -> val -> IO () #

    lookup :: :: Hash key => key -> key => key -> IO ( (Maybe val) #

    Looks up a key in the hash table, returns Just val if the key was found, or Nothing otherwise.

    Minimal complete definition

    hash

    hash :: a -> :: a -> Int #hashes the value of type a into an Int

    Hash Float

    hash :: :: Float -> -> Int # Hash Int

    hash :: :: Int -> -> Int # ( (Hash a, a, Hash b) => b) => Hash (a, b)

    hash :: (a, b) -> :: (a, b) -> Int # VisibleClass Int VisibleClass VisibleData Num VisibleData

    (+) :: :: VisibleData -> -> VisibleData -> -> VisibleData #

    (-) :: :: VisibleData -> -> VisibleData -> -> VisibleData #

    (*) :: :: VisibleData -> -> VisibleData -> -> VisibleData #

    negate :: :: VisibleData -> -> VisibleData #

    abs :: :: VisibleData -> -> VisibleData #

    signum :: :: VisibleData -> -> VisibleData #

    fromInteger :: :: Integer -> -> VisibleData # VisibleClass VisibleData Foo Bar Foo Bar

  • foo :: :: Int
  • foo :: :: Int #

    c :: (?x :: :: (?x :: X) => ) => X #

    d :: (?x :: :: (?x :: X, ?y :: , ?y :: X) => () => (X, , X) #

    f :: ((?x :: :: ((?x :: X) => a) -> a # Foo ( ((<~~) a)

    foo :: (a :: (a <~~ Int) -> a0 -> a ) -> a0 -> a <~~ a0 #

    foo' :: (a :: (a <~~ (a (a <~~ a0)) -> a0)) -> Int -> a -> a <~~ (a (a <~~ Int) #

    foo :: f :: f Int -> a -> f a #

    foo' :: f (f a) -> :: f (f a) -> Int -> f (f -> f (f Int) # Foo []

    foo :: [ :: [Int] -> a -> [a] #

    foo' :: [[a]] -> :: [[a]] -> Int -> [[ -> [[Int]] # Foo Maybe

    foo :: :: Maybe Int -> a -> -> a -> Maybe a #

    foo' :: :: Maybe ( (Maybe a) -> a) -> Int -> -> Maybe ( (Maybe Int) # Foo ( (Either a)

    foo :: :: Either a a Int -> a0 -> -> a0 -> Either a a0 #

    foo' :: :: Either a ( a (Either a a0) -> a a0) -> Int -> -> Either a ( a (Either a a Int) # ( (Eq a, a, Foo f) => f) => Foo ( ((,) (f a))

    foo :: (f a, :: (f a, Int) -> a0 -> (f a, a0) #

    foo' :: (f a, (f a, a0)) -> :: (f a, (f a, a0)) -> Int -> (f a, (f a, -> (f a, (f a, Int)) # Foo ( ((<~~) a)

    foo :: (a :: (a <~~ Int) -> a0 -> a ) -> a0 -> a <~~ a0 #

    foo' :: (a :: (a <~~ (a (a <~~ a0)) -> a0)) -> Int -> a -> a <~~ (a (a <~~ Int) # Foo ( ((,,) a a)

    foo :: (a, a, :: (a, a, Int) -> a0 -> (a, a, a0) #

    foo' :: (a, a, (a, a, a0)) -> :: (a, a, (a, a, a0)) -> Int -> (a, a, (a, a, -> (a, a, (a, a, Int)) # Foo ( (Quux a b)

    foo :: :: Quux a b a b Int -> a0 -> -> a0 -> Quux a b a0 #

    foo' :: :: Quux a b ( a b (Quux a b a0) -> a b a0) -> Int -> -> Quux a b ( a b (Quux a b a b Int) # Foo ((->) LiftedRep LiftedRep a) ((->) a :: * -> *) #

    Foo `Bar` Foo infixl 3
    Foo :- Foo infixr 5(:<->) :: a -> b -> a :: a -> b -> a <-> b infixr 6

    Minimal complete definition

    (>><), , (<<>), , (**>), , (**<), , (>**), , (<**)

    type a <>< b :: b :: * infixl 2type (>-<) a b = a a b = a <-> b infixl 6
    Synopsis

      Documentation

      Orphan instances

      AClass AType

      aClass :: :: AType -> -> Int #

      Minimal complete definition

      aClass

      aClass :: a -> :: a -> Int #

      Instances
      AClass AType #

      This is an orphan instance.

      Instance details

      Methods

      aClass :: AType -> Int #

      AType Int
      Instances
      AClass AType #

      This is an orphan instance.

      Instance details

      Methods

      aClass :: AType -> Int #

      Foo :: forall x. x -> x. x -> FooType x
    • Bar :: forall x. x -> x. x -> FooType ( (FooType x)
    • (:<->) :: forall x x1. x -> x1 -> ( x x1. x -> x1 -> (FooType x, x, FooType ( (FooType x1))
    • data BlubType = = Show x => BlubCtorBlub :: () => forall x. x. Show x => x -> x => x -> BlubType
    • data (a :: (a :: *) ><E :: forall k a (b :: k). (><) k a b
    • k a (b :: k). a >< b
    • pattern PatWithExplicitSig :: :: Eq somex => somex -> somex => somex -> FooType somex
    • Foo :: forall x. x -> x. x -> FooType x #

      Pattern synonym for Foo x

      Bar :: forall x. x -> x. x -> FooType ( (FooType x) #

      Pattern synonym for Bar x

      (:<->) :: forall x x1. x -> x1 -> ( x x1. x -> x1 -> (FooType x, x, FooType ( (FooType x1)) #

      Pattern synonym for (:<->)

      This module illustrates & tests most of the features of Haddock. Testing references from the description: T, f, g, visible.

    • = A Int ( (Maybe Float)
    • | B ( (T a b, a b, T Int Float)
    • p :: :: Int
    • r, s :: :: Int
    • t :: T1 -> :: T1 -> T2 Int Int -> -> T3 Bool Bool -> -> T4 Float Float -> -> T5 () ()
    • u, v :: :: Int
    • s1 :: :: Int
    • s2 :: :: Int
    • s3 :: :: Int
    • }
    • p :: R -> Int
    • q :: R -> forall a. a -> a
    • u :: R -> Int
    • class D a => C
    • a :: :: C a => a => IO a
    • f :: :: C a => a -> a => a -> Int
    • g :: :: Int -> -> IO CInt
    • hidden :: :: Int -> -> Int
    • Ex a
    • Show x => BlubCtorBlub :: () => forall x. x. Show x => x -> x => x -> BlubType #

      Pattern synonym for Blub x

      data (a :: (a :: *) ><

      Doc for (><)

      E :: forall k a (b :: k). (><) k a b k a (b :: k). a >< b #

      Pattern for Empty

      pattern PatWithExplicitSig :: :: Eq somex => somex -> somex => somex -> FooType somex #
      ((RevList a) :>data Pattern :: [ :: [*] -> ] -> * whereNil :: :: Pattern '[]Cons :: :: Maybe h -> h -> Pattern t -> t -> Pattern (h ': t)data RevPattern :: :: RevList * -> -> * whereRevNil :: :: RevPattern RNilRevCons :: :: Maybe h -> h -> RevPattern t -> t -> RevPattern (t (t :> h)data Tuple :: ( :: (*, , *) -> ) -> * whereTuple :: a -> b -> :: a -> b -> Tuple '(a, b)
    • fib :: :: Integer -> -> Integer
    • fib :: :: Integer -> -> Integer #

      Fibonacci number of given Integer.

      IntExpr IntegerAntiIntExpr StringBinopExpr BinOp Expr ExprAntiExpr String Show Expr

      showsPrec :: :: Int -> -> Expr -> -> ShowS #

      show :: :: Expr -> -> String #

      showList :: [ :: [Expr] -> ] -> ShowS # Show BinOp

      showsPrec :: :: Int -> -> BinOp -> -> ShowS #

      show :: :: BinOp -> -> String #

      showList :: [ :: [BinOp] -> ] -> ShowS #

      eval :: :: Expr -> -> Integer #

      parseExprExp :: :: String -> Q Exp #

      val :: :: Integer #data SomeType (f :: (f :: * -> -> *) a # Functor ( (SomeType f)

      fmap :: (a -> b) -> :: (a -> b) -> SomeType f a -> f a -> SomeType f b #

      (<$) :: a -> :: a -> SomeType f b -> f b -> SomeType f a # Applicative f => f => Applicative ( (SomeType f)

      pure :: a -> :: a -> SomeType f a #

      (<*>) :: :: SomeType f (a -> b) -> f (a -> b) -> SomeType f a -> f a -> SomeType f b #

      liftA2 :: (a -> b -> c) -> :: (a -> b -> c) -> SomeType f a -> f a -> SomeType f b -> f b -> SomeType f c #

      (*>) :: :: SomeType f a -> f a -> SomeType f b -> f b -> SomeType f b #

      (<*) :: :: SomeType f a -> f a -> SomeType f b -> f b -> SomeType f a #

      tableWithHeader A Int ( (Maybe Float)

      This comment describes the A constructor

      B ( (T a b, a b, T Int Float)

      This comment describes the B constructor

      documents A3

      documents B3

      This is the doc for A4

      This is the doc for B4

      This is the doc for C4

      this is the n3 field

      The N7 constructor

      This is the documentation for the R record, which has four fields, p, q, r, and s.

      This is the C1 record constructor, with the following fields:

      p :: :: Int

      This comment applies to the p field

      This comment applies to the q field

      r, s :: :: Int

      This comment applies to both r and s

      This is the C2 record constructor, also with some fields:

      t :: T1 -> :: T1 -> T2 Int Int -> -> T3 Bool Bool -> -> T4 Float Float -> -> T5 () ()
      u, v :: :: Int

      This is the C3 record constructor

      s1 :: :: Int

      The s1 record selector

      s2 :: :: Int

      The s2 record selector

      s3 :: :: Int

      The s3 record selector

      test that we can export record selectors on their own:

      p :: R -> Int #

      This comment applies to the p field

      q :: R -> forall a. a -> a #

      This comment applies to the q field

      u :: R -> Int #

      Class declarations

      class D a => CThis comment applies to the previous declaration (the C class)

      Minimal complete definition

      a, , b

      a :: :: IO a #

      this is a description of the a method

      this is a description of the b method

      Minimal complete definition

      d, , e

      d :: :: T a b # D Float

      d :: :: T Float b #

      e :: ( :: (Float, , Float) # D Int

      d :: :: T Int b #

      e :: ( :: (Int, , Int) #

      Minimal complete definition

      ff

      a :: :: C a => a => IO a #

      this is a description of the a method

      f :: :: C a => a -> a => a -> Int #

      In a comment string we can refer to identifiers in scope with single quotes like this: T, and we can refer to modules by @@ -1801,7 +1877,7 @@ using double quotes:

           This is a block of code, which can include other markup: R
      @@ -1821,9 +1897,9 @@ using double quotes: 

      g :: :: Int -> -> IO CInt #

      hidden :: :: Int -> -> Int #
      C b => Ex1
      C a => Ex3
      :: :: T () ()

      This argument has type T

      -> -> T2 Int Int
      -> (-> (T3 Bool Bool -> -> T4 Float Float)
      -> -> T5 () ()
      -> -> IO ()
      :: (:: (Int, , Int, , Float)
      -> -> Int

      returns an Int

      :: :: R
      -> -> N1 ()
      -> -> IO Intdata Bat* X
      :: :: Float
      -> -> IO Float

      f' :: :: Int #

      a function with a prime can be referred to as f' @@ -2283,7 +2359,7 @@ is at the beginning of the line).

      withType :: :: Int #

    • f :: :: Integer
    • f :: :: Integer #

      ...given a raw Addr# to the string, and the length of the string.

      Minimal complete definition

      f

    • f :: :: Int
    • f :: :: Int #

      type (<>) * Y a = a
      <> (a :: *) = atype(<>)* X a<> (a :: *)#
      type (<>) * X a = <> (a :: *) = X
      (><) X XX >< XXX data Bar W
      Bar X = = X
      Bar y = y = Y type (<>) X XXX <> XX type (<>) * Y a <> (a :: *) #