diff --git a/CHANGES b/CHANGES --- a/CHANGES +++ b/CHANGES @@ -1,3 +1,36 @@ +Changes in version 2.0.0.0: + + * The GHC API is used as the front-end + + * Haddock now understands all syntax understood by GHC 6.8.2 + + * Haddock can generate documentation for some of the language extensions + in GHC 6.8.2 + + * Format of module attributes has changed. The only way of specifiying + module attributes is via a new OPTIONS_HADDOCK pragma. Example: + {-# OPTIONS_HADDOCK hide, prune #-} + + * Haddock understands literate source files + + * Add a small library to read Haddock's interface files + + * Add a flag -B for passing the path to the GHC lib dir + + * Add a flag --optghc for passing options to GHC + + * Add a flag --ghc-version for printing the GHC version + + * Remove --use-package, --allow-missing-html, --ghc-pkg, in favour of only + supporting --read-interface + + * Remove --package flag, the GHC flag -package-name can be used instead + + * Remove --no-implicit-prelude flag, the GHC flag -XNoImplicitPrelude can + be used instead + +----------------------------------------------------------------------------- + Changes in version 0.9: * Infix type operators, e.g., first :: a~>a' -> (a,b)~>(a',b) diff --git a/Setup.lhs b/Setup.lhs --- a/Setup.lhs +++ b/Setup.lhs @@ -1,5 +1,4 @@ -#!/usr/bin/runhaskell - +#! /usr/bin/runhaskell \begin{code} import Distribution.Simple main = defaultMain diff --git a/TODO b/TODO --- a/TODO +++ b/TODO @@ -1,3 +1,14 @@ +----------------------------------------------------------------------------- +-- Small improvements + +* When no GHC can be found, give an error message that tells you to use + --with-ghc= + +* Instead of receiving the GHC lib dir as input, try to autodetect it with + ghc --print-libdir. Add a --with-ghc flag instead of -B. + +* Print an error message when given -optghc=.. instead of --optghc=.. + -- --------------------------------------------------------------------------- -- Before next release diff --git a/dist/build/haddock/haddock-tmp/HaddockLex.hs b/dist/build/haddock/haddock-tmp/HaddockLex.hs deleted file mode 100644 --- a/dist/build/haddock/haddock-tmp/HaddockLex.hs +++ /dev/null @@ -1,359 +0,0 @@ -{-# OPTIONS -fglasgow-exts -cpp #-} -{-# LINE 7 "src/HaddockLex.x" #-} -module HaddockLex ( - Token(..), - tokenise - ) where - -import Char -import Numeric -import HsSyn -import HsLexer hiding (Token) -import HsParseMonad ---import Debug.Trace - -#if __GLASGOW_HASKELL__ >= 603 -#include "ghcconfig.h" -#else -#include "config.h" -#endif -#if __GLASGOW_HASKELL__ >= 503 -import Data.Array -import Data.Char (ord) -import Data.Array.Base (unsafeAt) -#else -import Array -import Char (ord) -#endif -#if __GLASGOW_HASKELL__ >= 503 -import GHC.Exts -#else -import GlaExts -#endif -alex_base :: AlexAddr -alex_base = AlexA# "\xf8\xff\xff\xff\xfc\xff\xff\xff\x01\x00\x00\x00\x06\x00\x00\x00\x11\x00\x00\x00\x23\x00\x00\x00\x4b\x00\x00\x00\x00\x00\x00\x00\x5b\x00\x00\x00\x64\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x62\x00\x00\x00\x73\x00\x00\x00\x00\x00\x00\x00\x7c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xfd\xff\xff\xff\x00\x00\x00\x00\xfe\xff\xff\xff\x02\x00\x00\x00\x04\x00\x00\x00\x0a\x00\x00\x00\x0f\x00\x00\x00\x22\x00\x00\x00\x24\x00\x00\x00\x0c\x00\x00\x00\x15\x00\x00\x00\x17\x00\x00\x00\x00\x00\x00\x00\x03\x00\x00\x00\x1f\x00\x00\x00\x00\x00\x00\x00\x9d\x00\x00\x00\xf9\x00\x00\x00\x55\x01\x00\x00\x00\x00\x00\x00\xff\xff\xff\xff\x00\x00\x00\x00\x7d\x00\x00\x00\xa4\x01\x00\x00\xe7\xff\xff\xff\x00\x00\x00\x00\xae\x01\x00\x00\xd4\x01\x00\x00\x00\x00\x00\x00\x04\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00"# - -alex_table :: AlexAddr -alex_table = AlexA# "\x00\x00\x09\x00\x07\x00\x09\x00\x09\x00\x09\x00\x13\x00\x13\x00\xff\xff\xff\xff\x2b\x00\x30\x00\xff\xff\xff\xff\xff\xff\x11\x00\x12\x00\x11\x00\x11\x00\x11\x00\xff\xff\x00\x00\xff\xff\x00\x00\x09\x00\xff\xff\x09\x00\x07\x00\x09\x00\x09\x00\x09\x00\xff\xff\x0f\x00\xff\xff\x0b\x00\x15\x00\x1e\x00\x0b\x00\x11\x00\x2c\x00\x26\x00\xff\xff\x00\x00\x00\x00\xff\xff\x30\x00\xff\xff\x1d\x00\x21\x00\x09\x00\x20\x00\x00\x00\x00\x00\x00\x00\x0a\x00\x00\x00\x1d\x00\x0f\x00\x1d\x00\x0b\x00\x16\x00\x1a\x00\x0b\x00\x00\x00\x16\x00\x15\x00\x17\x00\x00\x00\x10\x00\x15\x00\x1e\x00\x00\x00\x17\x00\x2c\x00\x26\x00\x18\x00\x00\x00\x1b\x00\x20\x00\x0a\x00\x00\x00\x00\x00\x21\x00\x0c\x00\x08\x00\x07\x00\x08\x00\x08\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x28\x00\x32\x00\x1a\x00\x1b\x00\x26\x00\x1b\x00\x15\x00\x08\x00\x07\x00\x08\x00\x08\x00\x08\x00\x00\x00\x00\x00\x08\x00\x0c\x00\x09\x00\x07\x00\x09\x00\x09\x00\x09\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x28\x00\x33\x00\x00\x00\x00\x00\x26\x00\x09\x00\x11\x00\x12\x00\x11\x00\x11\x00\x11\x00\x00\x00\x0d\x00\x0f\x00\x00\x00\x0b\x00\x00\x00\x00\x00\x0b\x00\x0e\x00\x0e\x00\x0e\x00\x0e\x00\x0e\x00\x0e\x00\x0e\x00\x0e\x00\x0e\x00\x0e\x00\x11\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0a\x00\x0e\x00\x0e\x00\x0e\x00\x0e\x00\x0e\x00\x0e\x00\x0e\x00\x0e\x00\x0e\x00\x0e\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x00\x00\x29\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x25\x00\x0c\x00\x25\x00\x25\x00\x25\x00\x25\x00\x24\x00\x00\x00\x00\x00\x25\x00\x25\x00\x00\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x00\x00\x00\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x00\x00\x25\x00\x00\x00\x25\x00\x25\x00\x23\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x00\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x24\x00\x00\x00\x00\x00\x25\x00\x25\x00\x00\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x00\x00\x00\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x00\x00\x25\x00\x00\x00\x25\x00\x25\x00\x23\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x00\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x00\x00\x00\x00\x25\x00\x25\x00\x00\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x00\x00\x00\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x00\x00\x25\x00\x00\x00\x25\x00\x25\x00\x00\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x25\x00\x00\x00\x25\x00\x00\x00\x25\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2a\x00\x2e\x00\x2e\x00\x2e\x00\x2e\x00\x2e\x00\x2e\x00\x2e\x00\x2e\x00\x2e\x00\x2e\x00\x00\x00\x2d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x2e\x00\x2e\x00\x2e\x00\x2e\x00\x2e\x00\x2e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x2f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x2e\x00\x2e\x00\x2e\x00\x2e\x00\x2e\x00\x2e\x00\x2e\x00\x2e\x00\x2e\x00\x2e\x00\x30\x00\x2e\x00\x2e\x00\x2e\x00\x2e\x00\x2e\x00\x2e\x00\x2e\x00\x2e\x00\x2e\x00\x2e\x00\x2e\x00\x2e\x00\x00\x00\x2f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xff\xff\xff\xff\x00\x00\x00\x00\xff\xff\xff\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xff\xff\x00\x00\x2e\x00\x2e\x00\x2e\x00\x2e\x00\x2e\x00\x2e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xff\xff\x00\x00\x00\x00\x00\x00\xff\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xff\xff\xff\xff\x00\x00\x00\x00\xff\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00"# - -alex_check :: AlexAddr -alex_check = AlexA# "\xff\xff\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x23\x00\x0a\x00\x0a\x00\x0a\x00\x0a\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x0a\x00\xff\xff\x0a\x00\xff\xff\x20\x00\x0a\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x0a\x00\x28\x00\x0a\x00\x2a\x00\x22\x00\x23\x00\x2d\x00\x20\x00\x26\x00\x27\x00\x0a\x00\xff\xff\xff\xff\x0a\x00\x0a\x00\x0a\x00\x23\x00\x2f\x00\x20\x00\x2f\x00\xff\xff\xff\xff\xff\xff\x3e\x00\xff\xff\x23\x00\x28\x00\x23\x00\x2a\x00\x3e\x00\x3c\x00\x2d\x00\xff\xff\x3e\x00\x40\x00\x3e\x00\xff\xff\x3e\x00\x22\x00\x23\x00\xff\xff\x3e\x00\x26\x00\x27\x00\x3c\x00\xff\xff\x3e\x00\x2f\x00\x3e\x00\xff\xff\xff\xff\x2f\x00\x5b\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\xff\xff\xff\xff\xff\xff\xff\xff\x5c\x00\x5d\x00\x3c\x00\x3e\x00\x60\x00\x3e\x00\x40\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\xff\xff\xff\xff\x20\x00\x5b\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x20\x00\xff\xff\xff\xff\xff\xff\x5c\x00\x5d\x00\xff\xff\xff\xff\x60\x00\x20\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\xff\xff\x29\x00\x28\x00\xff\xff\x2a\x00\xff\xff\xff\xff\x2d\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x20\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3e\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\x3b\x00\xff\xff\x3e\x00\xff\xff\xff\xff\xff\xff\x21\x00\x5b\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\x2a\x00\x2b\x00\xff\xff\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\xff\xff\x5c\x00\xff\xff\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xff\xff\x7c\x00\x21\x00\x7e\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\x2a\x00\x2b\x00\xff\xff\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\xff\xff\x5c\x00\xff\xff\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xff\xff\x7c\x00\x21\x00\x7e\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\xff\xff\xff\xff\x2a\x00\x2b\x00\xff\xff\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\xff\xff\x5c\x00\xff\xff\x5e\x00\x5f\x00\xff\xff\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x68\x00\x69\x00\x6a\x00\x6b\x00\x6c\x00\x6d\x00\x6e\x00\x6f\x00\x70\x00\x71\x00\x72\x00\x73\x00\x74\x00\x75\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\xff\xff\x7c\x00\xff\xff\x7e\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\xff\xff\x3b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x58\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x0a\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\xff\xff\x78\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x22\x00\x23\x00\xff\xff\xff\xff\x26\x00\x27\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2f\x00\xff\xff\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3c\x00\xff\xff\xff\xff\xff\xff\x40\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x5c\x00\x5d\x00\xff\xff\xff\xff\x60\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff"# - -alex_deflt :: AlexAddr -alex_deflt = AlexA# "\xff\xff\x14\x00\x31\x00\xff\xff\xff\xff\x31\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x14\x00\xff\xff\x19\x00\x19\x00\x19\x00\x19\x00\x1c\x00\x1c\x00\x1c\x00\x1f\x00\x1f\x00\x1f\x00\xff\xff\x22\x00\x22\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x27\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x31\x00\xff\xff\xff\xff"# - -alex_accept = listArray (0::Int,51) [[(AlexAcc (alex_action_5))],[(AlexAcc (alex_action_9))],[],[(AlexAcc (alex_action_8))],[(AlexAcc (alex_action_5))],[],[],[(AlexAccSkip)],[],[(AlexAcc (alex_action_5))],[(AlexAcc (alex_action_1))],[(AlexAcc (alex_action_2))],[(AlexAcc (alex_action_3))],[(AlexAcc (alex_action_4))],[],[],[(AlexAcc (alex_action_6))],[],[(AlexAcc (alex_action_7))],[(AlexAcc (alex_action_9))],[(AlexAcc (alex_action_9))],[(AlexAcc (alex_action_10))],[(AlexAcc (alex_action_11))],[(AlexAcc (alex_action_12))],[],[],[(AlexAcc (alex_action_19))],[(AlexAcc (alex_action_12))],[],[(AlexAcc (alex_action_13))],[(AlexAcc (alex_action_19))],[],[(AlexAcc (alex_action_14))],[(AlexAcc (alex_action_19))],[],[(AlexAcc (alex_action_15))],[(AlexAcc (alex_action_15))],[],[(AlexAcc (alex_action_19))],[(AlexAcc (alex_action_16))],[(AlexAcc (alex_action_19))],[(AlexAcc (alex_action_17))],[],[],[(AlexAcc (alex_action_19))],[(AlexAcc (alex_action_18))],[],[],[(AlexAcc (alex_action_20))],[(AlexAcc (alex_action_21))],[(AlexAcc (alex_action_22))],[(AlexAcc (alex_action_23))]] -{-# LINE 82 "src/HaddockLex.x" #-} -data Token - = TokPara - | TokNumber - | TokBullet - | TokDefStart - | TokDefEnd - | TokSpecial Char - | TokIdent [HsQName] - | TokString String - | TokURL String - | TokPic String - | TokEmphasis String - | TokAName String - | TokBirdTrack String - deriving Show - --- ----------------------------------------------------------------------------- --- Alex support stuff - -type StartCode = Int -type Action = String -> StartCode -> (StartCode -> [Token]) -> [Token] - -type AlexInput = (Char,String) - -alexGetChar (_, []) = Nothing -alexGetChar (_, c:cs) = Just (c, (c,cs)) - -alexInputPrevChar (c,_) = c - -tokenise :: String -> [Token] -tokenise str = let toks = go ('\n', eofHack str) para in {-trace (show toks)-} toks - where go inp@(_,str) sc = - case alexScan inp sc of - AlexEOF -> [] - AlexError _ -> error "lexical error" - AlexSkip inp' len -> go inp' sc - AlexToken inp' len act -> act (take len str) sc (\sc -> go inp' sc) - --- NB. we add a final \n to the string, (see comment in the beginning of line --- production above). -eofHack str = str++"\n" - -andBegin :: Action -> StartCode -> Action -andBegin act new_sc = \str sc cont -> act str new_sc cont - -token :: Token -> Action -token t = \str sc cont -> t : cont sc - -strtoken :: (String -> Token) -> Action -strtoken t = \str sc cont -> t str : cont sc - -begin :: StartCode -> Action -begin sc = \str _ cont -> cont sc - --- ----------------------------------------------------------------------------- --- Lex a string as a Haskell identifier - -ident :: Action -ident str sc cont = - case strToHsQNames id of - Just names -> TokIdent names : cont sc - Nothing -> TokString str : cont sc - where id = init (tail str) - -strToHsQNames :: String -> Maybe [HsQName] -strToHsQNames str0 - = case lexer (\t -> returnP t) str0 (SrcLoc 1 1 "") 1 1 "" [] of - Ok _ (VarId str) - -> Just [ UnQual (HsVarName (HsIdent str)) ] - Ok _ (QVarId (mod0,str)) - -> Just [ Qual (Module mod0) (HsVarName (HsIdent str)) ] - Ok _ (ConId str) - -> Just [ UnQual (HsTyClsName (HsIdent str)), - UnQual (HsVarName (HsIdent str)) ] - Ok _ (QConId (mod0,str)) - -> Just [ Qual (Module mod0) (HsTyClsName (HsIdent str)), - Qual (Module mod0) (HsVarName (HsIdent str)) ] - Ok _ (VarSym str) - -> Just [ UnQual (HsVarName (HsSymbol str)) ] - Ok _ (ConSym str) - -> Just [ UnQual (HsTyClsName (HsSymbol str)), - UnQual (HsVarName (HsSymbol str)) ] - Ok _ (QVarSym (mod0,str)) - -> Just [ Qual (Module mod0) (HsVarName (HsSymbol str)) ] - Ok _ (QConSym (mod0,str)) - -> Just [ Qual (Module mod0) (HsTyClsName (HsSymbol str)), - Qual (Module mod0) (HsVarName (HsSymbol str)) ] - _other - -> Nothing - - -birdtrack,def,line,para,string :: Int -birdtrack = 1 -def = 2 -line = 3 -para = 4 -string = 5 -alex_action_1 = begin birdtrack -alex_action_2 = token TokBullet `andBegin` string -alex_action_3 = token TokDefStart `andBegin` def -alex_action_4 = token TokNumber `andBegin` string -alex_action_5 = begin string -alex_action_6 = begin birdtrack -alex_action_7 = token TokPara `andBegin` para -alex_action_8 = begin string -alex_action_9 = strtoken TokBirdTrack `andBegin` line -alex_action_10 = strtoken $ \s -> TokSpecial (head s) -alex_action_11 = strtoken $ \s -> TokPic (init $ init $ tail $ tail s) -alex_action_12 = strtoken $ \s -> TokURL (init (tail s)) -alex_action_13 = strtoken $ \s -> TokAName (init (tail s)) -alex_action_14 = strtoken $ \s -> TokEmphasis (init (tail s)) -alex_action_15 = ident -alex_action_16 = strtoken (TokString . tail) -alex_action_17 = strtoken $ \s -> TokString [chr (read (init (drop 2 s)))] -alex_action_18 = strtoken $ \s -> case readHex (init (drop 3 s)) of [(n,_)] -> TokString [chr n] -alex_action_19 = strtoken TokString -alex_action_20 = strtoken TokString `andBegin` line -alex_action_21 = strtoken TokString -alex_action_22 = token TokDefEnd `andBegin` string -alex_action_23 = strtoken TokString -{-# LINE 1 "GenericTemplate.hs" #-} -{-# LINE 1 "" #-} -{-# LINE 1 "" #-} -{-# LINE 1 "GenericTemplate.hs" #-} --- ----------------------------------------------------------------------------- --- ALEX TEMPLATE --- --- This code is in the PUBLIC DOMAIN; you may copy it freely and use --- it for any purpose whatsoever. - --- ----------------------------------------------------------------------------- --- INTERNALS and main scanner engine - -{-# LINE 35 "GenericTemplate.hs" #-} - -{-# LINE 45 "GenericTemplate.hs" #-} - - -data AlexAddr = AlexA# Addr# - -#if __GLASGOW_HASKELL__ < 503 -uncheckedShiftL# = shiftL# -#endif - -{-# INLINE alexIndexInt16OffAddr #-} -alexIndexInt16OffAddr (AlexA# arr) off = -#ifdef WORDS_BIGENDIAN - narrow16Int# i - where - i = word2Int# ((high `uncheckedShiftL#` 8#) `or#` low) - high = int2Word# (ord# (indexCharOffAddr# arr (off' +# 1#))) - low = int2Word# (ord# (indexCharOffAddr# arr off')) - off' = off *# 2# -#else - indexInt16OffAddr# arr off -#endif - - - - - -{-# INLINE alexIndexInt32OffAddr #-} -alexIndexInt32OffAddr (AlexA# arr) off = -#ifdef WORDS_BIGENDIAN - narrow32Int# i - where - i = word2Int# ((b3 `uncheckedShiftL#` 24#) `or#` - (b2 `uncheckedShiftL#` 16#) `or#` - (b1 `uncheckedShiftL#` 8#) `or#` b0) - b3 = int2Word# (ord# (indexCharOffAddr# arr (off' +# 3#))) - b2 = int2Word# (ord# (indexCharOffAddr# arr (off' +# 2#))) - b1 = int2Word# (ord# (indexCharOffAddr# arr (off' +# 1#))) - b0 = int2Word# (ord# (indexCharOffAddr# arr off')) - off' = off *# 4# -#else - indexInt32OffAddr# arr off -#endif - - - - - -#if __GLASGOW_HASKELL__ < 503 -quickIndex arr i = arr ! i -#else --- GHC >= 503, unsafeAt is available from Data.Array.Base. -quickIndex = unsafeAt -#endif - - - - --- ----------------------------------------------------------------------------- --- Main lexing routines - -data AlexReturn a - = AlexEOF - | AlexError !AlexInput - | AlexSkip !AlexInput !Int - | AlexToken !AlexInput !Int a - --- alexScan :: AlexInput -> StartCode -> AlexReturn a -alexScan input (I# (sc)) - = alexScanUser undefined input (I# (sc)) - -alexScanUser user input (I# (sc)) - = case alex_scan_tkn user input 0# input sc AlexNone of - (AlexNone, input') -> - case alexGetChar input of - Nothing -> - - - - AlexEOF - Just _ -> - - - - AlexError input' - - (AlexLastSkip input len, _) -> - - - - AlexSkip input len - - (AlexLastAcc k input len, _) -> - - - - AlexToken input len k - - --- Push the input through the DFA, remembering the most recent accepting --- state it encountered. - -alex_scan_tkn user orig_input len input s last_acc = - input `seq` -- strict in the input - let - new_acc = check_accs (alex_accept `quickIndex` (I# (s))) - in - new_acc `seq` - case alexGetChar input of - Nothing -> (new_acc, input) - Just (c, new_input) -> - - - - let - base = alexIndexInt32OffAddr alex_base s - (I# (ord_c)) = ord c - offset = (base +# ord_c) - check = alexIndexInt16OffAddr alex_check offset - - new_s = if (offset >=# 0#) && (check ==# ord_c) - then alexIndexInt16OffAddr alex_table offset - else alexIndexInt16OffAddr alex_deflt s - in - case new_s of - -1# -> (new_acc, input) - -- on an error, we want to keep the input *before* the - -- character that failed, not after. - _ -> alex_scan_tkn user orig_input (len +# 1#) - new_input new_s new_acc - - where - check_accs [] = last_acc - check_accs (AlexAcc a : _) = AlexLastAcc a input (I# (len)) - check_accs (AlexAccSkip : _) = AlexLastSkip input (I# (len)) - check_accs (AlexAccPred a pred : rest) - | pred user orig_input (I# (len)) input - = AlexLastAcc a input (I# (len)) - check_accs (AlexAccSkipPred pred : rest) - | pred user orig_input (I# (len)) input - = AlexLastSkip input (I# (len)) - check_accs (_ : rest) = check_accs rest - -data AlexLastAcc a - = AlexNone - | AlexLastAcc a !AlexInput !Int - | AlexLastSkip !AlexInput !Int - -data AlexAcc a user - = AlexAcc a - | AlexAccSkip - | AlexAccPred a (AlexAccPred user) - | AlexAccSkipPred (AlexAccPred user) - -type AlexAccPred user = user -> AlexInput -> Int -> AlexInput -> Bool - --- ----------------------------------------------------------------------------- --- Predicates on a rule - -alexAndPred p1 p2 user in1 len in2 - = p1 user in1 len in2 && p2 user in1 len in2 - ---alexPrevCharIsPred :: Char -> AlexAccPred _ -alexPrevCharIs c _ input _ _ = c == alexInputPrevChar input - ---alexPrevCharIsOneOfPred :: Array Char Bool -> AlexAccPred _ -alexPrevCharIsOneOf arr _ input _ _ = arr ! alexInputPrevChar input - ---alexRightContext :: Int -> AlexAccPred _ -alexRightContext (I# (sc)) user _ _ input = - case alex_scan_tkn user input 0# input sc AlexNone of - (AlexNone, _) -> False - _ -> True - -- TODO: there's no need to find the longest - -- match when checking the right context, just - -- the first match will do. - --- used by wrappers -iUnbox (I# (i)) = i diff --git a/dist/build/haddock/haddock-tmp/HaddockParse.hs b/dist/build/haddock/haddock-tmp/HaddockParse.hs deleted file mode 100644 --- a/dist/build/haddock/haddock-tmp/HaddockParse.hs +++ /dev/null @@ -1,715 +0,0 @@ -{-# OPTIONS -fglasgow-exts -cpp #-} -module HaddockParse (parseParas, parseString) where - -import HaddockLex -import HsSyn -#if __GLASGOW_HASKELL__ >= 503 -import Data.Array -#else -import Array -#endif -#if __GLASGOW_HASKELL__ >= 503 -import GHC.Exts -#else -import GlaExts -#endif - --- parser produced by Happy Version 1.16 - -newtype HappyAbsSyn = HappyAbsSyn HappyAny -#if __GLASGOW_HASKELL__ >= 607 -type HappyAny = GHC.Exts.Any -#else -type HappyAny = forall a . a -#endif -happyIn5 :: (Doc) -> (HappyAbsSyn ) -happyIn5 x = unsafeCoerce# x -{-# INLINE happyIn5 #-} -happyOut5 :: (HappyAbsSyn ) -> (Doc) -happyOut5 x = unsafeCoerce# x -{-# INLINE happyOut5 #-} -happyIn6 :: (Doc) -> (HappyAbsSyn ) -happyIn6 x = unsafeCoerce# x -{-# INLINE happyIn6 #-} -happyOut6 :: (HappyAbsSyn ) -> (Doc) -happyOut6 x = unsafeCoerce# x -{-# INLINE happyOut6 #-} -happyIn7 :: (Doc) -> (HappyAbsSyn ) -happyIn7 x = unsafeCoerce# x -{-# INLINE happyIn7 #-} -happyOut7 :: (HappyAbsSyn ) -> (Doc) -happyOut7 x = unsafeCoerce# x -{-# INLINE happyOut7 #-} -happyIn8 :: (Doc) -> (HappyAbsSyn ) -happyIn8 x = unsafeCoerce# x -{-# INLINE happyIn8 #-} -happyOut8 :: (HappyAbsSyn ) -> (Doc) -happyOut8 x = unsafeCoerce# x -{-# INLINE happyOut8 #-} -happyIn9 :: ((Doc,Doc)) -> (HappyAbsSyn ) -happyIn9 x = unsafeCoerce# x -{-# INLINE happyIn9 #-} -happyOut9 :: (HappyAbsSyn ) -> ((Doc,Doc)) -happyOut9 x = unsafeCoerce# x -{-# INLINE happyOut9 #-} -happyIn10 :: (Doc) -> (HappyAbsSyn ) -happyIn10 x = unsafeCoerce# x -{-# INLINE happyIn10 #-} -happyOut10 :: (HappyAbsSyn ) -> (Doc) -happyOut10 x = unsafeCoerce# x -{-# INLINE happyOut10 #-} -happyIn11 :: (Doc) -> (HappyAbsSyn ) -happyIn11 x = unsafeCoerce# x -{-# INLINE happyIn11 #-} -happyOut11 :: (HappyAbsSyn ) -> (Doc) -happyOut11 x = unsafeCoerce# x -{-# INLINE happyOut11 #-} -happyIn12 :: (Doc) -> (HappyAbsSyn ) -happyIn12 x = unsafeCoerce# x -{-# INLINE happyIn12 #-} -happyOut12 :: (HappyAbsSyn ) -> (Doc) -happyOut12 x = unsafeCoerce# x -{-# INLINE happyOut12 #-} -happyIn13 :: (Doc) -> (HappyAbsSyn ) -happyIn13 x = unsafeCoerce# x -{-# INLINE happyIn13 #-} -happyOut13 :: (HappyAbsSyn ) -> (Doc) -happyOut13 x = unsafeCoerce# x -{-# INLINE happyOut13 #-} -happyIn14 :: (Doc) -> (HappyAbsSyn ) -happyIn14 x = unsafeCoerce# x -{-# INLINE happyIn14 #-} -happyOut14 :: (HappyAbsSyn ) -> (Doc) -happyOut14 x = unsafeCoerce# x -{-# INLINE happyOut14 #-} -happyIn15 :: (Doc) -> (HappyAbsSyn ) -happyIn15 x = unsafeCoerce# x -{-# INLINE happyIn15 #-} -happyOut15 :: (HappyAbsSyn ) -> (Doc) -happyOut15 x = unsafeCoerce# x -{-# INLINE happyOut15 #-} -happyIn16 :: (String) -> (HappyAbsSyn ) -happyIn16 x = unsafeCoerce# x -{-# INLINE happyIn16 #-} -happyOut16 :: (HappyAbsSyn ) -> (String) -happyOut16 x = unsafeCoerce# x -{-# INLINE happyOut16 #-} -happyInTok :: Token -> (HappyAbsSyn ) -happyInTok x = unsafeCoerce# x -{-# INLINE happyInTok #-} -happyOutTok :: (HappyAbsSyn ) -> Token -happyOutTok x = unsafeCoerce# x -{-# INLINE happyOutTok #-} - - -happyActOffsets :: HappyAddr -happyActOffsets = HappyA# "\xff\xff\x25\x00\x0d\x00\x61\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x25\x00\x00\x00\x51\x00\x25\x00\x6a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x19\x00\x19\x00\x5d\x00\x00\x00\x00\x00\x4d\x00\x4d\x00\x46\x00\xff\xff\x00\x00\xff\xff\x00\x00\x00\x00\x00\x00\x44\x00\x2f\x00\x2b\x00\x27\x00\x51\x00\x51\x00\x00\x00\x00\x00\x00\x00\x00\x00\x25\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00"# - -happyGotoOffsets :: HappyAddr -happyGotoOffsets = HappyA# "\x4b\x00\x78\x00\x60\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x74\x00\x00\x00\x7a\x00\x70\x00\x12\x00\x00\x00\x00\x00\x00\x00\x00\x00\x6c\x00\x66\x00\x0b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x35\x00\x00\x00\x00\x00\x00\x00\x00\x00\xf8\xff\x00\x00\x00\x00\x52\x00\x1a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x29\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00"# - -happyDefActions :: HappyAddr -happyDefActions = HappyA# "\xfa\xff\x00\x00\x00\x00\x00\x00\xf9\xff\xf8\xff\xf7\xff\xf6\xff\xf1\xff\xf2\xff\xed\xff\xec\xff\x00\x00\x00\x00\x00\x00\xe5\xff\xe4\xff\xe3\xff\xe6\xff\x00\x00\x00\x00\xef\xff\xe2\xff\xe7\xff\x00\x00\x00\x00\xfb\xff\xfa\xff\xfc\xff\xfa\xff\xf0\xff\xf4\xff\xf5\xff\x00\x00\xe0\xff\x00\x00\x00\x00\xe8\xff\x00\x00\xee\xff\xea\xff\xe9\xff\xeb\xff\x00\x00\xdf\xff\xe1\xff\xfd\xff\xf3\xff"# - -happyCheck :: HappyAddr -happyCheck = HappyA# "\xff\xff\x02\x00\x03\x00\x0b\x00\x05\x00\x06\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x02\x00\x03\x00\x06\x00\x05\x00\x06\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x02\x00\x0f\x00\x0b\x00\x05\x00\x06\x00\x07\x00\x08\x00\x09\x00\x09\x00\x0a\x00\x0c\x00\x0d\x00\x02\x00\x0f\x00\x02\x00\x05\x00\x06\x00\x07\x00\x08\x00\x09\x00\x04\x00\x07\x00\x08\x00\x0d\x00\x0a\x00\x0f\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x0f\x00\x0a\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x05\x00\x0a\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x0e\x00\x0a\x00\x05\x00\x06\x00\x07\x00\x08\x00\x09\x00\x09\x00\x0a\x00\x10\x00\x0d\x00\x0e\x00\x0f\x00\x01\x00\x02\x00\x03\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x0c\x00\x0a\x00\x05\x00\x06\x00\x07\x00\x08\x00\x0e\x00\x0a\x00\x05\x00\x06\x00\x07\x00\x08\x00\xff\xff\x0a\x00\x07\x00\x08\x00\x0f\x00\x0a\x00\x07\x00\x08\x00\xff\xff\x0a\x00\x07\x00\x08\x00\xff\xff\x0a\x00\x09\x00\x0a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff"# - -happyTable :: HappyAddr -happyTable = HappyA# "\x00\x00\x0d\x00\x0e\x00\x2c\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x14\x00\x15\x00\x16\x00\x17\x00\x1c\x00\x18\x00\x0d\x00\x0e\x00\x1e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x14\x00\x15\x00\x16\x00\x17\x00\x0d\x00\x18\x00\x21\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x28\x00\x25\x00\x16\x00\x17\x00\x0d\x00\x18\x00\x2b\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x2c\x00\x2f\x00\x0a\x00\x17\x00\x0b\x00\x18\x00\x2e\x00\x1a\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x23\x00\x0b\x00\x1c\x00\x1a\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x2e\x00\x0b\x00\x19\x00\x1a\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x1e\x00\x0b\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x29\x00\x25\x00\xff\xff\x17\x00\x27\x00\x18\x00\x03\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x16\x00\x0b\x00\x1f\x00\x08\x00\x09\x00\x0a\x00\x1e\x00\x0b\x00\x20\x00\x08\x00\x09\x00\x0a\x00\x00\x00\x0b\x00\x23\x00\x0a\x00\x23\x00\x0b\x00\x27\x00\x0a\x00\x00\x00\x0b\x00\x18\x00\x0a\x00\x00\x00\x0b\x00\x24\x00\x25\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00"# - -happyReduceArr = array (2, 32) [ - (2 , happyReduce_2), - (3 , happyReduce_3), - (4 , happyReduce_4), - (5 , happyReduce_5), - (6 , happyReduce_6), - (7 , happyReduce_7), - (8 , happyReduce_8), - (9 , happyReduce_9), - (10 , happyReduce_10), - (11 , happyReduce_11), - (12 , happyReduce_12), - (13 , happyReduce_13), - (14 , happyReduce_14), - (15 , happyReduce_15), - (16 , happyReduce_16), - (17 , happyReduce_17), - (18 , happyReduce_18), - (19 , happyReduce_19), - (20 , happyReduce_20), - (21 , happyReduce_21), - (22 , happyReduce_22), - (23 , happyReduce_23), - (24 , happyReduce_24), - (25 , happyReduce_25), - (26 , happyReduce_26), - (27 , happyReduce_27), - (28 , happyReduce_28), - (29 , happyReduce_29), - (30 , happyReduce_30), - (31 , happyReduce_31), - (32 , happyReduce_32) - ] - -happy_n_terms = 17 :: Int -happy_n_nonterms = 12 :: Int - -happyReduce_2 = happySpecReduce_3 0# happyReduction_2 -happyReduction_2 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOut6 happy_x_1 of { happy_var_1 -> - case happyOut5 happy_x_3 of { happy_var_3 -> - happyIn5 - (docAppend happy_var_1 happy_var_3 - )}} - -happyReduce_3 = happySpecReduce_2 0# happyReduction_3 -happyReduction_3 happy_x_2 - happy_x_1 - = case happyOut5 happy_x_2 of { happy_var_2 -> - happyIn5 - (happy_var_2 - )} - -happyReduce_4 = happySpecReduce_1 0# happyReduction_4 -happyReduction_4 happy_x_1 - = case happyOut6 happy_x_1 of { happy_var_1 -> - happyIn5 - (happy_var_1 - )} - -happyReduce_5 = happySpecReduce_0 0# happyReduction_5 -happyReduction_5 = happyIn5 - (DocEmpty - ) - -happyReduce_6 = happySpecReduce_1 1# happyReduction_6 -happyReduction_6 happy_x_1 - = case happyOut7 happy_x_1 of { happy_var_1 -> - happyIn6 - (DocUnorderedList [happy_var_1] - )} - -happyReduce_7 = happySpecReduce_1 1# happyReduction_7 -happyReduction_7 happy_x_1 - = case happyOut8 happy_x_1 of { happy_var_1 -> - happyIn6 - (DocOrderedList [happy_var_1] - )} - -happyReduce_8 = happySpecReduce_1 1# happyReduction_8 -happyReduction_8 happy_x_1 - = case happyOut9 happy_x_1 of { happy_var_1 -> - happyIn6 - (DocDefList [happy_var_1] - )} - -happyReduce_9 = happySpecReduce_1 1# happyReduction_9 -happyReduction_9 happy_x_1 - = case happyOut10 happy_x_1 of { happy_var_1 -> - happyIn6 - (happy_var_1 - )} - -happyReduce_10 = happySpecReduce_2 2# happyReduction_10 -happyReduction_10 happy_x_2 - happy_x_1 - = case happyOut10 happy_x_2 of { happy_var_2 -> - happyIn7 - (happy_var_2 - )} - -happyReduce_11 = happySpecReduce_2 3# happyReduction_11 -happyReduction_11 happy_x_2 - happy_x_1 - = case happyOut10 happy_x_2 of { happy_var_2 -> - happyIn8 - (happy_var_2 - )} - -happyReduce_12 = happyReduce 4# 4# happyReduction_12 -happyReduction_12 (happy_x_4 `HappyStk` - happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) - = case happyOut12 happy_x_2 of { happy_var_2 -> - case happyOut12 happy_x_4 of { happy_var_4 -> - happyIn9 - ((happy_var_2, happy_var_4) - ) `HappyStk` happyRest}} - -happyReduce_13 = happySpecReduce_1 5# happyReduction_13 -happyReduction_13 happy_x_1 - = case happyOut12 happy_x_1 of { happy_var_1 -> - happyIn10 - (docParagraph happy_var_1 - )} - -happyReduce_14 = happySpecReduce_1 5# happyReduction_14 -happyReduction_14 happy_x_1 - = case happyOut11 happy_x_1 of { happy_var_1 -> - happyIn10 - (DocCodeBlock happy_var_1 - )} - -happyReduce_15 = happySpecReduce_2 6# happyReduction_15 -happyReduction_15 happy_x_2 - happy_x_1 - = case happyOutTok happy_x_1 of { (TokBirdTrack happy_var_1) -> - case happyOut11 happy_x_2 of { happy_var_2 -> - happyIn11 - (docAppend (DocString happy_var_1) happy_var_2 - )}} - -happyReduce_16 = happySpecReduce_1 6# happyReduction_16 -happyReduction_16 happy_x_1 - = case happyOutTok happy_x_1 of { (TokBirdTrack happy_var_1) -> - happyIn11 - (DocString happy_var_1 - )} - -happyReduce_17 = happySpecReduce_2 7# happyReduction_17 -happyReduction_17 happy_x_2 - happy_x_1 - = case happyOut13 happy_x_1 of { happy_var_1 -> - case happyOut12 happy_x_2 of { happy_var_2 -> - happyIn12 - (docAppend happy_var_1 happy_var_2 - )}} - -happyReduce_18 = happySpecReduce_1 7# happyReduction_18 -happyReduction_18 happy_x_1 - = case happyOut13 happy_x_1 of { happy_var_1 -> - happyIn12 - (happy_var_1 - )} - -happyReduce_19 = happySpecReduce_1 8# happyReduction_19 -happyReduction_19 happy_x_1 - = case happyOut15 happy_x_1 of { happy_var_1 -> - happyIn13 - (happy_var_1 - )} - -happyReduce_20 = happySpecReduce_3 8# happyReduction_20 -happyReduction_20 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOut14 happy_x_2 of { happy_var_2 -> - happyIn13 - (DocMonospaced happy_var_2 - )} - -happyReduce_21 = happySpecReduce_2 9# happyReduction_21 -happyReduction_21 happy_x_2 - happy_x_1 - = case happyOut14 happy_x_2 of { happy_var_2 -> - happyIn14 - (docAppend (DocString "\n") happy_var_2 - )} - -happyReduce_22 = happySpecReduce_2 9# happyReduction_22 -happyReduction_22 happy_x_2 - happy_x_1 - = case happyOut15 happy_x_1 of { happy_var_1 -> - case happyOut14 happy_x_2 of { happy_var_2 -> - happyIn14 - (docAppend happy_var_1 happy_var_2 - )}} - -happyReduce_23 = happySpecReduce_1 9# happyReduction_23 -happyReduction_23 happy_x_1 - = case happyOut15 happy_x_1 of { happy_var_1 -> - happyIn14 - (happy_var_1 - )} - -happyReduce_24 = happySpecReduce_1 10# happyReduction_24 -happyReduction_24 happy_x_1 - = case happyOutTok happy_x_1 of { (TokString happy_var_1) -> - happyIn15 - (DocString happy_var_1 - )} - -happyReduce_25 = happySpecReduce_1 10# happyReduction_25 -happyReduction_25 happy_x_1 - = case happyOutTok happy_x_1 of { (TokEmphasis happy_var_1) -> - happyIn15 - (DocEmphasis (DocString happy_var_1) - )} - -happyReduce_26 = happySpecReduce_1 10# happyReduction_26 -happyReduction_26 happy_x_1 - = case happyOutTok happy_x_1 of { (TokURL happy_var_1) -> - happyIn15 - (DocURL happy_var_1 - )} - -happyReduce_27 = happySpecReduce_1 10# happyReduction_27 -happyReduction_27 happy_x_1 - = case happyOutTok happy_x_1 of { (TokPic happy_var_1) -> - happyIn15 - (DocPic happy_var_1 - )} - -happyReduce_28 = happySpecReduce_1 10# happyReduction_28 -happyReduction_28 happy_x_1 - = case happyOutTok happy_x_1 of { (TokAName happy_var_1) -> - happyIn15 - (DocAName happy_var_1 - )} - -happyReduce_29 = happySpecReduce_1 10# happyReduction_29 -happyReduction_29 happy_x_1 - = case happyOutTok happy_x_1 of { (TokIdent happy_var_1) -> - happyIn15 - (DocIdentifier happy_var_1 - )} - -happyReduce_30 = happySpecReduce_3 10# happyReduction_30 -happyReduction_30 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOut16 happy_x_2 of { happy_var_2 -> - happyIn15 - (DocModule happy_var_2 - )} - -happyReduce_31 = happySpecReduce_1 11# happyReduction_31 -happyReduction_31 happy_x_1 - = case happyOutTok happy_x_1 of { (TokString happy_var_1) -> - happyIn16 - (happy_var_1 - )} - -happyReduce_32 = happySpecReduce_2 11# happyReduction_32 -happyReduction_32 happy_x_2 - happy_x_1 - = case happyOutTok happy_x_1 of { (TokString happy_var_1) -> - case happyOut16 happy_x_2 of { happy_var_2 -> - happyIn16 - (happy_var_1 ++ happy_var_2 - )}} - -happyNewToken action sts stk [] = - happyDoAction 16# notHappyAtAll action sts stk [] - -happyNewToken action sts stk (tk:tks) = - let cont i = happyDoAction i tk action sts stk tks in - case tk of { - TokSpecial '/' -> cont 1#; - TokSpecial '@' -> cont 2#; - TokDefStart -> cont 3#; - TokDefEnd -> cont 4#; - TokSpecial '\"' -> cont 5#; - TokURL happy_dollar_dollar -> cont 6#; - TokPic happy_dollar_dollar -> cont 7#; - TokAName happy_dollar_dollar -> cont 8#; - TokEmphasis happy_dollar_dollar -> cont 9#; - TokBullet -> cont 10#; - TokNumber -> cont 11#; - TokBirdTrack happy_dollar_dollar -> cont 12#; - TokIdent happy_dollar_dollar -> cont 13#; - TokPara -> cont 14#; - TokString happy_dollar_dollar -> cont 15#; - _ -> happyError' (tk:tks) - } - -happyError_ tk tks = happyError' (tk:tks) - -happyThen :: () => Either String a -> (a -> Either String b) -> Either String b -happyThen = (>>=) -happyReturn :: () => a -> Either String a -happyReturn = (return) -happyThen1 m k tks = (>>=) m (\a -> k a tks) -happyReturn1 :: () => a -> b -> Either String a -happyReturn1 = \a tks -> (return) a -happyError' :: () => [Token] -> Either String a -happyError' = happyError - -parseParas tks = happySomeParser where - happySomeParser = happyThen (happyParse 0# tks) (\x -> happyReturn (happyOut5 x)) - -parseString tks = happySomeParser where - happySomeParser = happyThen (happyParse 1# tks) (\x -> happyReturn (happyOut12 x)) - -happySeq = happyDontSeq - - -happyError :: [Token] -> Either String a -happyError toks = - Left ("parse error in doc string: " ++ show (take 3 toks)) - --- Either monad (we can't use MonadError because GHC < 5.00 has --- an older incompatible version). -instance Monad (Either String) where - return = Right - Left l >>= _ = Left l - Right r >>= k = k r - fail msg = Left msg -{-# LINE 1 "GenericTemplate.hs" #-} -{-# LINE 1 "GenericTemplate.hs" #-} -{-# LINE 1 "" #-} -{-# LINE 1 "" #-} -{-# LINE 1 "GenericTemplate.hs" #-} --- Id: GenericTemplate.hs,v 1.26 2005/01/14 14:47:22 simonmar Exp - -{-# LINE 28 "GenericTemplate.hs" #-} - - -data Happy_IntList = HappyCons Int# Happy_IntList - - - - - -{-# LINE 49 "GenericTemplate.hs" #-} - -{-# LINE 59 "GenericTemplate.hs" #-} - -{-# LINE 68 "GenericTemplate.hs" #-} - -infixr 9 `HappyStk` -data HappyStk a = HappyStk a (HappyStk a) - ------------------------------------------------------------------------------ --- starting the parse - -happyParse start_state = happyNewToken start_state notHappyAtAll notHappyAtAll - ------------------------------------------------------------------------------ --- Accepting the parse - --- If the current token is 0#, it means we've just accepted a partial --- parse (a %partial parser). We must ignore the saved token on the top of --- the stack in this case. -happyAccept 0# tk st sts (_ `HappyStk` ans `HappyStk` _) = - happyReturn1 ans -happyAccept j tk st sts (HappyStk ans _) = - (happyTcHack j (happyTcHack st)) (happyReturn1 ans) - ------------------------------------------------------------------------------ --- Arrays only: do the next action - - - -happyDoAction i tk st - = {- nothing -} - - - case action of - 0# -> {- nothing -} - happyFail i tk st - -1# -> {- nothing -} - happyAccept i tk st - n | (n <# (0# :: Int#)) -> {- nothing -} - - (happyReduceArr ! rule) i tk st - where rule = (I# ((negateInt# ((n +# (1# :: Int#)))))) - n -> {- nothing -} - - - happyShift new_state i tk st - where new_state = (n -# (1# :: Int#)) - where off = indexShortOffAddr happyActOffsets st - off_i = (off +# i) - check = if (off_i >=# (0# :: Int#)) - then (indexShortOffAddr happyCheck off_i ==# i) - else False - action | check = indexShortOffAddr happyTable off_i - | otherwise = indexShortOffAddr happyDefActions st - -{-# LINE 127 "GenericTemplate.hs" #-} - - -indexShortOffAddr (HappyA# arr) off = -#if __GLASGOW_HASKELL__ > 500 - narrow16Int# i -#elif __GLASGOW_HASKELL__ == 500 - intToInt16# i -#else - (i `iShiftL#` 16#) `iShiftRA#` 16# -#endif - where -#if __GLASGOW_HASKELL__ >= 503 - i = word2Int# ((high `uncheckedShiftL#` 8#) `or#` low) -#else - i = word2Int# ((high `shiftL#` 8#) `or#` low) -#endif - high = int2Word# (ord# (indexCharOffAddr# arr (off' +# 1#))) - low = int2Word# (ord# (indexCharOffAddr# arr off')) - off' = off *# 2# - - - - - -data HappyAddr = HappyA# Addr# - - - - ------------------------------------------------------------------------------ --- HappyState data type (not arrays) - -{-# LINE 170 "GenericTemplate.hs" #-} - ------------------------------------------------------------------------------ --- Shifting a token - -happyShift new_state 0# tk st sts stk@(x `HappyStk` _) = - let i = (case unsafeCoerce# x of { (I# (i)) -> i }) in --- trace "shifting the error token" $ - happyDoAction i tk new_state (HappyCons (st) (sts)) (stk) - -happyShift new_state i tk st sts stk = - happyNewToken new_state (HappyCons (st) (sts)) ((happyInTok (tk))`HappyStk`stk) - --- happyReduce is specialised for the common cases. - -happySpecReduce_0 i fn 0# tk st sts stk - = happyFail 0# tk st sts stk -happySpecReduce_0 nt fn j tk st@((action)) sts stk - = happyGoto nt j tk st (HappyCons (st) (sts)) (fn `HappyStk` stk) - -happySpecReduce_1 i fn 0# tk st sts stk - = happyFail 0# tk st sts stk -happySpecReduce_1 nt fn j tk _ sts@((HappyCons (st@(action)) (_))) (v1`HappyStk`stk') - = let r = fn v1 in - happySeq r (happyGoto nt j tk st sts (r `HappyStk` stk')) - -happySpecReduce_2 i fn 0# tk st sts stk - = happyFail 0# tk st sts stk -happySpecReduce_2 nt fn j tk _ (HappyCons (_) (sts@((HappyCons (st@(action)) (_))))) (v1`HappyStk`v2`HappyStk`stk') - = let r = fn v1 v2 in - happySeq r (happyGoto nt j tk st sts (r `HappyStk` stk')) - -happySpecReduce_3 i fn 0# tk st sts stk - = happyFail 0# tk st sts stk -happySpecReduce_3 nt fn j tk _ (HappyCons (_) ((HappyCons (_) (sts@((HappyCons (st@(action)) (_))))))) (v1`HappyStk`v2`HappyStk`v3`HappyStk`stk') - = let r = fn v1 v2 v3 in - happySeq r (happyGoto nt j tk st sts (r `HappyStk` stk')) - -happyReduce k i fn 0# tk st sts stk - = happyFail 0# tk st sts stk -happyReduce k nt fn j tk st sts stk - = case happyDrop (k -# (1# :: Int#)) sts of - sts1@((HappyCons (st1@(action)) (_))) -> - let r = fn stk in -- it doesn't hurt to always seq here... - happyDoSeq r (happyGoto nt j tk st1 sts1 r) - -happyMonadReduce k nt fn 0# tk st sts stk - = happyFail 0# tk st sts stk -happyMonadReduce k nt fn j tk st sts stk = - happyThen1 (fn stk tk) (\r -> happyGoto nt j tk st1 sts1 (r `HappyStk` drop_stk)) - where sts1@((HappyCons (st1@(action)) (_))) = happyDrop k (HappyCons (st) (sts)) - drop_stk = happyDropStk k stk - -happyMonad2Reduce k nt fn 0# tk st sts stk - = happyFail 0# tk st sts stk -happyMonad2Reduce k nt fn j tk st sts stk = - happyThen1 (fn stk tk) (\r -> happyNewToken new_state sts1 (r `HappyStk` drop_stk)) - where sts1@((HappyCons (st1@(action)) (_))) = happyDrop k (HappyCons (st) (sts)) - drop_stk = happyDropStk k stk - - off = indexShortOffAddr happyGotoOffsets st1 - off_i = (off +# nt) - new_state = indexShortOffAddr happyTable off_i - - - - -happyDrop 0# l = l -happyDrop n (HappyCons (_) (t)) = happyDrop (n -# (1# :: Int#)) t - -happyDropStk 0# l = l -happyDropStk n (x `HappyStk` xs) = happyDropStk (n -# (1#::Int#)) xs - ------------------------------------------------------------------------------ --- Moving to a new state after a reduction - - -happyGoto nt j tk st = - {- nothing -} - happyDoAction j tk new_state - where off = indexShortOffAddr happyGotoOffsets st - off_i = (off +# nt) - new_state = indexShortOffAddr happyTable off_i - - - - ------------------------------------------------------------------------------ --- Error recovery (0# is the error token) - --- parse error if we are in recovery and we fail again -happyFail 0# tk old_st _ stk = --- trace "failing" $ - happyError_ tk - -{- We don't need state discarding for our restricted implementation of - "error". In fact, it can cause some bogus parses, so I've disabled it - for now --SDM - --- discard a state -happyFail 0# tk old_st (HappyCons ((action)) (sts)) - (saved_tok `HappyStk` _ `HappyStk` stk) = --- trace ("discarding state, depth " ++ show (length stk)) $ - happyDoAction 0# tk action sts ((saved_tok`HappyStk`stk)) --} - --- Enter error recovery: generate an error token, --- save the old token and carry on. -happyFail i tk (action) sts stk = --- trace "entering error recovery" $ - happyDoAction 0# tk action sts ( (unsafeCoerce# (I# (i))) `HappyStk` stk) - --- Internal happy errors: - -notHappyAtAll = error "Internal Happy error\n" - ------------------------------------------------------------------------------ --- Hack to get the typechecker to accept our action functions - - -happyTcHack :: Int# -> a -> a -happyTcHack x y = y -{-# INLINE happyTcHack #-} - - ------------------------------------------------------------------------------ --- Seq-ing. If the --strict flag is given, then Happy emits --- happySeq = happyDoSeq --- otherwise it emits --- happySeq = happyDontSeq - -happyDoSeq, happyDontSeq :: a -> b -> b -happyDoSeq a b = a `seq` b -happyDontSeq a b = b - ------------------------------------------------------------------------------ --- Don't inline any functions from the template. GHC has a nasty habit --- of deciding to inline happyGoto everywhere, which increases the size of --- the generated parser quite a bit. - - -{-# NOINLINE happyDoAction #-} -{-# NOINLINE happyTable #-} -{-# NOINLINE happyCheck #-} -{-# NOINLINE happyActOffsets #-} -{-# NOINLINE happyGotoOffsets #-} -{-# NOINLINE happyDefActions #-} - -{-# NOINLINE happyShift #-} -{-# NOINLINE happySpecReduce_0 #-} -{-# NOINLINE happySpecReduce_1 #-} -{-# NOINLINE happySpecReduce_2 #-} -{-# NOINLINE happySpecReduce_3 #-} -{-# NOINLINE happyReduce #-} -{-# NOINLINE happyMonadReduce #-} -{-# NOINLINE happyGoto #-} -{-# NOINLINE happyFail #-} - --- end of Happy Template. diff --git a/dist/build/haddock/haddock-tmp/HsParser.hs b/dist/build/haddock/haddock-tmp/HsParser.hs deleted file mode 100644 --- a/dist/build/haddock/haddock-tmp/HsParser.hs +++ /dev/null @@ -1,5021 +0,0 @@ -{-# OPTIONS -fglasgow-exts -cpp #-} -module HsParser (parse) where - -import Monad -import HsSyn -import HsParseMonad -import HsLexer -import HsParseUtils -import HaddockLex hiding (Token) -import HaddockParse -import HaddockUtil hiding (splitTyConApp) -import Char ( isSpace ) -#if __GLASGOW_HASKELL__ >= 503 -import Data.Array -#else -import Array -#endif -#if __GLASGOW_HASKELL__ >= 503 -import GHC.Exts -#else -import GlaExts -#endif - --- parser produced by Happy Version 1.16 - -newtype HappyAbsSyn = HappyAbsSyn HappyAny -#if __GLASGOW_HASKELL__ >= 607 -type HappyAny = GHC.Exts.Any -#else -type HappyAny = forall a . a -#endif -happyIn4 :: (HsModule) -> (HappyAbsSyn ) -happyIn4 x = unsafeCoerce# x -{-# INLINE happyIn4 #-} -happyOut4 :: (HappyAbsSyn ) -> (HsModule) -happyOut4 x = unsafeCoerce# x -{-# INLINE happyOut4 #-} -happyIn5 :: ((Maybe String,ModuleInfo,Maybe Doc)) -> (HappyAbsSyn ) -happyIn5 x = unsafeCoerce# x -{-# INLINE happyIn5 #-} -happyOut5 :: (HappyAbsSyn ) -> ((Maybe String,ModuleInfo,Maybe Doc)) -happyOut5 x = unsafeCoerce# x -{-# INLINE happyOut5 #-} -happyIn6 :: (([HsImportDecl],[HsDecl])) -> (HappyAbsSyn ) -happyIn6 x = unsafeCoerce# x -{-# INLINE happyIn6 #-} -happyOut6 :: (HappyAbsSyn ) -> (([HsImportDecl],[HsDecl])) -happyOut6 x = unsafeCoerce# x -{-# INLINE happyOut6 #-} -happyIn7 :: (([HsImportDecl],[HsDecl])) -> (HappyAbsSyn ) -happyIn7 x = unsafeCoerce# x -{-# INLINE happyIn7 #-} -happyOut7 :: (HappyAbsSyn ) -> (([HsImportDecl],[HsDecl])) -happyOut7 x = unsafeCoerce# x -{-# INLINE happyOut7 #-} -happyIn8 :: (()) -> (HappyAbsSyn ) -happyIn8 x = unsafeCoerce# x -{-# INLINE happyIn8 #-} -happyOut8 :: (HappyAbsSyn ) -> (()) -happyOut8 x = unsafeCoerce# x -{-# INLINE happyOut8 #-} -happyIn9 :: (Maybe [HsExportSpec]) -> (HappyAbsSyn ) -happyIn9 x = unsafeCoerce# x -{-# INLINE happyIn9 #-} -happyOut9 :: (HappyAbsSyn ) -> (Maybe [HsExportSpec]) -happyOut9 x = unsafeCoerce# x -{-# INLINE happyOut9 #-} -happyIn10 :: ([HsExportSpec]) -> (HappyAbsSyn ) -happyIn10 x = unsafeCoerce# x -{-# INLINE happyIn10 #-} -happyOut10 :: (HappyAbsSyn ) -> ([HsExportSpec]) -happyOut10 x = unsafeCoerce# x -{-# INLINE happyOut10 #-} -happyIn11 :: ([HsExportSpec]) -> (HappyAbsSyn ) -happyIn11 x = unsafeCoerce# x -{-# INLINE happyIn11 #-} -happyOut11 :: (HappyAbsSyn ) -> ([HsExportSpec]) -happyOut11 x = unsafeCoerce# x -{-# INLINE happyOut11 #-} -happyIn12 :: ([HsExportSpec]) -> (HappyAbsSyn ) -happyIn12 x = unsafeCoerce# x -{-# INLINE happyIn12 #-} -happyOut12 :: (HappyAbsSyn ) -> ([HsExportSpec]) -happyOut12 x = unsafeCoerce# x -{-# INLINE happyOut12 #-} -happyIn13 :: (HsExportSpec) -> (HappyAbsSyn ) -happyIn13 x = unsafeCoerce# x -{-# INLINE happyIn13 #-} -happyOut13 :: (HappyAbsSyn ) -> (HsExportSpec) -happyOut13 x = unsafeCoerce# x -{-# INLINE happyOut13 #-} -happyIn14 :: (HsExportSpec) -> (HappyAbsSyn ) -happyIn14 x = unsafeCoerce# x -{-# INLINE happyIn14 #-} -happyOut14 :: (HappyAbsSyn ) -> (HsExportSpec) -happyOut14 x = unsafeCoerce# x -{-# INLINE happyOut14 #-} -happyIn15 :: ([HsQName]) -> (HappyAbsSyn ) -happyIn15 x = unsafeCoerce# x -{-# INLINE happyIn15 #-} -happyOut15 :: (HappyAbsSyn ) -> ([HsQName]) -happyOut15 x = unsafeCoerce# x -{-# INLINE happyOut15 #-} -happyIn16 :: (HsQName) -> (HappyAbsSyn ) -happyIn16 x = unsafeCoerce# x -{-# INLINE happyIn16 #-} -happyOut16 :: (HappyAbsSyn ) -> (HsQName) -happyOut16 x = unsafeCoerce# x -{-# INLINE happyOut16 #-} -happyIn17 :: ([HsImportDecl]) -> (HappyAbsSyn ) -happyIn17 x = unsafeCoerce# x -{-# INLINE happyIn17 #-} -happyOut17 :: (HappyAbsSyn ) -> ([HsImportDecl]) -happyOut17 x = unsafeCoerce# x -{-# INLINE happyOut17 #-} -happyIn18 :: (HsImportDecl) -> (HappyAbsSyn ) -happyIn18 x = unsafeCoerce# x -{-# INLINE happyIn18 #-} -happyOut18 :: (HappyAbsSyn ) -> (HsImportDecl) -happyOut18 x = unsafeCoerce# x -{-# INLINE happyOut18 #-} -happyIn19 :: (Bool) -> (HappyAbsSyn ) -happyIn19 x = unsafeCoerce# x -{-# INLINE happyIn19 #-} -happyOut19 :: (HappyAbsSyn ) -> (Bool) -happyOut19 x = unsafeCoerce# x -{-# INLINE happyOut19 #-} -happyIn20 :: (Maybe Module) -> (HappyAbsSyn ) -happyIn20 x = unsafeCoerce# x -{-# INLINE happyIn20 #-} -happyOut20 :: (HappyAbsSyn ) -> (Maybe Module) -happyOut20 x = unsafeCoerce# x -{-# INLINE happyOut20 #-} -happyIn21 :: (Maybe (Bool, [HsImportSpec])) -> (HappyAbsSyn ) -happyIn21 x = unsafeCoerce# x -{-# INLINE happyIn21 #-} -happyOut21 :: (HappyAbsSyn ) -> (Maybe (Bool, [HsImportSpec])) -happyOut21 x = unsafeCoerce# x -{-# INLINE happyOut21 #-} -happyIn22 :: ((Bool, [HsImportSpec])) -> (HappyAbsSyn ) -happyIn22 x = unsafeCoerce# x -{-# INLINE happyIn22 #-} -happyOut22 :: (HappyAbsSyn ) -> ((Bool, [HsImportSpec])) -happyOut22 x = unsafeCoerce# x -{-# INLINE happyOut22 #-} -happyIn23 :: ([HsImportSpec]) -> (HappyAbsSyn ) -happyIn23 x = unsafeCoerce# x -{-# INLINE happyIn23 #-} -happyOut23 :: (HappyAbsSyn ) -> ([HsImportSpec]) -happyOut23 x = unsafeCoerce# x -{-# INLINE happyOut23 #-} -happyIn24 :: (HsImportSpec) -> (HappyAbsSyn ) -happyIn24 x = unsafeCoerce# x -{-# INLINE happyIn24 #-} -happyOut24 :: (HappyAbsSyn ) -> (HsImportSpec) -happyOut24 x = unsafeCoerce# x -{-# INLINE happyOut24 #-} -happyIn25 :: (HsName) -> (HappyAbsSyn ) -happyIn25 x = unsafeCoerce# x -{-# INLINE happyIn25 #-} -happyOut25 :: (HappyAbsSyn ) -> (HsName) -happyOut25 x = unsafeCoerce# x -{-# INLINE happyOut25 #-} -happyIn26 :: ([HsName]) -> (HappyAbsSyn ) -happyIn26 x = unsafeCoerce# x -{-# INLINE happyIn26 #-} -happyOut26 :: (HappyAbsSyn ) -> ([HsName]) -happyOut26 x = unsafeCoerce# x -{-# INLINE happyOut26 #-} -happyIn27 :: (HsName) -> (HappyAbsSyn ) -happyIn27 x = unsafeCoerce# x -{-# INLINE happyIn27 #-} -happyOut27 :: (HappyAbsSyn ) -> (HsName) -happyOut27 x = unsafeCoerce# x -{-# INLINE happyOut27 #-} -happyIn28 :: (HsDecl) -> (HappyAbsSyn ) -happyIn28 x = unsafeCoerce# x -{-# INLINE happyIn28 #-} -happyOut28 :: (HappyAbsSyn ) -> (HsDecl) -happyOut28 x = unsafeCoerce# x -{-# INLINE happyOut28 #-} -happyIn29 :: (Int) -> (HappyAbsSyn ) -happyIn29 x = unsafeCoerce# x -{-# INLINE happyIn29 #-} -happyOut29 :: (HappyAbsSyn ) -> (Int) -happyOut29 x = unsafeCoerce# x -{-# INLINE happyOut29 #-} -happyIn30 :: (HsAssoc) -> (HappyAbsSyn ) -happyIn30 x = unsafeCoerce# x -{-# INLINE happyIn30 #-} -happyOut30 :: (HappyAbsSyn ) -> (HsAssoc) -happyOut30 x = unsafeCoerce# x -{-# INLINE happyOut30 #-} -happyIn31 :: ([HsName]) -> (HappyAbsSyn ) -happyIn31 x = unsafeCoerce# x -{-# INLINE happyIn31 #-} -happyOut31 :: (HappyAbsSyn ) -> ([HsName]) -happyOut31 x = unsafeCoerce# x -{-# INLINE happyOut31 #-} -happyIn32 :: ([HsDecl]) -> (HappyAbsSyn ) -happyIn32 x = unsafeCoerce# x -{-# INLINE happyIn32 #-} -happyOut32 :: (HappyAbsSyn ) -> ([HsDecl]) -happyOut32 x = unsafeCoerce# x -{-# INLINE happyOut32 #-} -happyIn33 :: (HsDecl) -> (HappyAbsSyn ) -happyIn33 x = unsafeCoerce# x -{-# INLINE happyIn33 #-} -happyOut33 :: (HappyAbsSyn ) -> (HsDecl) -happyOut33 x = unsafeCoerce# x -{-# INLINE happyOut33 #-} -happyIn34 :: ([HsType]) -> (HappyAbsSyn ) -happyIn34 x = unsafeCoerce# x -{-# INLINE happyIn34 #-} -happyOut34 :: (HappyAbsSyn ) -> ([HsType]) -happyOut34 x = unsafeCoerce# x -{-# INLINE happyOut34 #-} -happyIn35 :: ([HsDecl]) -> (HappyAbsSyn ) -happyIn35 x = unsafeCoerce# x -{-# INLINE happyIn35 #-} -happyOut35 :: (HappyAbsSyn ) -> ([HsDecl]) -happyOut35 x = unsafeCoerce# x -{-# INLINE happyOut35 #-} -happyIn36 :: (HsDecl) -> (HappyAbsSyn ) -happyIn36 x = unsafeCoerce# x -{-# INLINE happyIn36 #-} -happyOut36 :: (HappyAbsSyn ) -> (HsDecl) -happyOut36 x = unsafeCoerce# x -{-# INLINE happyOut36 #-} -happyIn37 :: (HsDecl) -> (HappyAbsSyn ) -happyIn37 x = unsafeCoerce# x -{-# INLINE happyIn37 #-} -happyOut37 :: (HappyAbsSyn ) -> (HsDecl) -happyOut37 x = unsafeCoerce# x -{-# INLINE happyOut37 #-} -happyIn38 :: ([HsDecl]) -> (HappyAbsSyn ) -happyIn38 x = unsafeCoerce# x -{-# INLINE happyIn38 #-} -happyOut38 :: (HappyAbsSyn ) -> ([HsDecl]) -happyOut38 x = unsafeCoerce# x -{-# INLINE happyOut38 #-} -happyIn39 :: (HsDecl) -> (HappyAbsSyn ) -happyIn39 x = unsafeCoerce# x -{-# INLINE happyIn39 #-} -happyOut39 :: (HappyAbsSyn ) -> (HsDecl) -happyOut39 x = unsafeCoerce# x -{-# INLINE happyOut39 #-} -happyIn40 :: ([HsName]) -> (HappyAbsSyn ) -happyIn40 x = unsafeCoerce# x -{-# INLINE happyIn40 #-} -happyOut40 :: (HappyAbsSyn ) -> ([HsName]) -happyOut40 x = unsafeCoerce# x -{-# INLINE happyOut40 #-} -happyIn41 :: (HsDecl) -> (HappyAbsSyn ) -happyIn41 x = unsafeCoerce# x -{-# INLINE happyIn41 #-} -happyOut41 :: (HappyAbsSyn ) -> (HsDecl) -happyOut41 x = unsafeCoerce# x -{-# INLINE happyOut41 #-} -happyIn42 :: (HsCallConv) -> (HappyAbsSyn ) -happyIn42 x = unsafeCoerce# x -{-# INLINE happyIn42 #-} -happyOut42 :: (HappyAbsSyn ) -> (HsCallConv) -happyOut42 x = unsafeCoerce# x -{-# INLINE happyOut42 #-} -happyIn43 :: (HsFISafety) -> (HappyAbsSyn ) -happyIn43 x = unsafeCoerce# x -{-# INLINE happyIn43 #-} -happyOut43 :: (HappyAbsSyn ) -> (HsFISafety) -happyOut43 x = unsafeCoerce# x -{-# INLINE happyOut43 #-} -happyIn44 :: ((String, HsName, HsType)) -> (HappyAbsSyn ) -happyIn44 x = unsafeCoerce# x -{-# INLINE happyIn44 #-} -happyOut44 :: (HappyAbsSyn ) -> ((String, HsName, HsType)) -happyOut44 x = unsafeCoerce# x -{-# INLINE happyOut44 #-} -happyIn45 :: (HsType) -> (HappyAbsSyn ) -happyIn45 x = unsafeCoerce# x -{-# INLINE happyIn45 #-} -happyOut45 :: (HappyAbsSyn ) -> (HsType) -happyOut45 x = unsafeCoerce# x -{-# INLINE happyOut45 #-} -happyIn46 :: (HsType) -> (HappyAbsSyn ) -happyIn46 x = unsafeCoerce# x -{-# INLINE happyIn46 #-} -happyOut46 :: (HappyAbsSyn ) -> (HsType) -happyOut46 x = unsafeCoerce# x -{-# INLINE happyOut46 #-} -happyIn47 :: (HsType) -> (HappyAbsSyn ) -happyIn47 x = unsafeCoerce# x -{-# INLINE happyIn47 #-} -happyOut47 :: (HappyAbsSyn ) -> (HsType) -happyOut47 x = unsafeCoerce# x -{-# INLINE happyOut47 #-} -happyIn48 :: (HsType) -> (HappyAbsSyn ) -happyIn48 x = unsafeCoerce# x -{-# INLINE happyIn48 #-} -happyOut48 :: (HappyAbsSyn ) -> (HsType) -happyOut48 x = unsafeCoerce# x -{-# INLINE happyOut48 #-} -happyIn49 :: (HsType) -> (HappyAbsSyn ) -happyIn49 x = unsafeCoerce# x -{-# INLINE happyIn49 #-} -happyOut49 :: (HappyAbsSyn ) -> (HsType) -happyOut49 x = unsafeCoerce# x -{-# INLINE happyOut49 #-} -happyIn50 :: (HsType) -> (HappyAbsSyn ) -happyIn50 x = unsafeCoerce# x -{-# INLINE happyIn50 #-} -happyOut50 :: (HappyAbsSyn ) -> (HsType) -happyOut50 x = unsafeCoerce# x -{-# INLINE happyOut50 #-} -happyIn51 :: (HsQName) -> (HappyAbsSyn ) -happyIn51 x = unsafeCoerce# x -{-# INLINE happyIn51 #-} -happyOut51 :: (HappyAbsSyn ) -> (HsQName) -happyOut51 x = unsafeCoerce# x -{-# INLINE happyOut51 #-} -happyIn52 :: (HsType) -> (HappyAbsSyn ) -happyIn52 x = unsafeCoerce# x -{-# INLINE happyIn52 #-} -happyOut52 :: (HappyAbsSyn ) -> (HsType) -happyOut52 x = unsafeCoerce# x -{-# INLINE happyOut52 #-} -happyIn53 :: (HsType) -> (HappyAbsSyn ) -happyIn53 x = unsafeCoerce# x -{-# INLINE happyIn53 #-} -happyOut53 :: (HappyAbsSyn ) -> (HsType) -happyOut53 x = unsafeCoerce# x -{-# INLINE happyOut53 #-} -happyIn54 :: (HsIPContext) -> (HappyAbsSyn ) -happyIn54 x = unsafeCoerce# x -{-# INLINE happyIn54 #-} -happyOut54 :: (HappyAbsSyn ) -> (HsIPContext) -happyOut54 x = unsafeCoerce# x -{-# INLINE happyOut54 #-} -happyIn55 :: ([HsType]) -> (HappyAbsSyn ) -happyIn55 x = unsafeCoerce# x -{-# INLINE happyIn55 #-} -happyOut55 :: (HappyAbsSyn ) -> ([HsType]) -happyOut55 x = unsafeCoerce# x -{-# INLINE happyOut55 #-} -happyIn56 :: ((HsName, [HsName])) -> (HappyAbsSyn ) -happyIn56 x = unsafeCoerce# x -{-# INLINE happyIn56 #-} -happyOut56 :: (HappyAbsSyn ) -> ((HsName, [HsName])) -happyOut56 x = unsafeCoerce# x -{-# INLINE happyOut56 #-} -happyIn57 :: ([HsName]) -> (HappyAbsSyn ) -happyIn57 x = unsafeCoerce# x -{-# INLINE happyIn57 #-} -happyOut57 :: (HappyAbsSyn ) -> ([HsName]) -happyOut57 x = unsafeCoerce# x -{-# INLINE happyOut57 #-} -happyIn58 :: ([HsConDecl]) -> (HappyAbsSyn ) -happyIn58 x = unsafeCoerce# x -{-# INLINE happyIn58 #-} -happyOut58 :: (HappyAbsSyn ) -> ([HsConDecl]) -happyOut58 x = unsafeCoerce# x -{-# INLINE happyOut58 #-} -happyIn59 :: ([HsConDecl]) -> (HappyAbsSyn ) -happyIn59 x = unsafeCoerce# x -{-# INLINE happyIn59 #-} -happyOut59 :: (HappyAbsSyn ) -> ([HsConDecl]) -happyOut59 x = unsafeCoerce# x -{-# INLINE happyOut59 #-} -happyIn60 :: (HsConDecl) -> (HappyAbsSyn ) -happyIn60 x = unsafeCoerce# x -{-# INLINE happyIn60 #-} -happyOut60 :: (HappyAbsSyn ) -> (HsConDecl) -happyOut60 x = unsafeCoerce# x -{-# INLINE happyOut60 #-} -happyIn61 :: ([HsName]) -> (HappyAbsSyn ) -happyIn61 x = unsafeCoerce# x -{-# INLINE happyIn61 #-} -happyOut61 :: (HappyAbsSyn ) -> ([HsName]) -happyOut61 x = unsafeCoerce# x -{-# INLINE happyOut61 #-} -happyIn62 :: ((HsName, [HsBangType])) -> (HappyAbsSyn ) -happyIn62 x = unsafeCoerce# x -{-# INLINE happyIn62 #-} -happyOut62 :: (HappyAbsSyn ) -> ((HsName, [HsBangType])) -happyOut62 x = unsafeCoerce# x -{-# INLINE happyOut62 #-} -happyIn63 :: ((HsName, [HsBangType])) -> (HappyAbsSyn ) -happyIn63 x = unsafeCoerce# x -{-# INLINE happyIn63 #-} -happyOut63 :: (HappyAbsSyn ) -> ((HsName, [HsBangType])) -happyOut63 x = unsafeCoerce# x -{-# INLINE happyOut63 #-} -happyIn64 :: ((HsName, [HsBangType])) -> (HappyAbsSyn ) -happyIn64 x = unsafeCoerce# x -{-# INLINE happyIn64 #-} -happyOut64 :: (HappyAbsSyn ) -> ((HsName, [HsBangType])) -happyOut64 x = unsafeCoerce# x -{-# INLINE happyOut64 #-} -happyIn65 :: (HsBangType) -> (HappyAbsSyn ) -happyIn65 x = unsafeCoerce# x -{-# INLINE happyIn65 #-} -happyOut65 :: (HappyAbsSyn ) -> (HsBangType) -happyOut65 x = unsafeCoerce# x -{-# INLINE happyOut65 #-} -happyIn66 :: (HsBangType) -> (HappyAbsSyn ) -happyIn66 x = unsafeCoerce# x -{-# INLINE happyIn66 #-} -happyOut66 :: (HappyAbsSyn ) -> (HsBangType) -happyOut66 x = unsafeCoerce# x -{-# INLINE happyOut66 #-} -happyIn67 :: ([HsFieldDecl]) -> (HappyAbsSyn ) -happyIn67 x = unsafeCoerce# x -{-# INLINE happyIn67 #-} -happyOut67 :: (HappyAbsSyn ) -> ([HsFieldDecl]) -happyOut67 x = unsafeCoerce# x -{-# INLINE happyOut67 #-} -happyIn68 :: (HsFieldDecl) -> (HappyAbsSyn ) -happyIn68 x = unsafeCoerce# x -{-# INLINE happyIn68 #-} -happyOut68 :: (HappyAbsSyn ) -> (HsFieldDecl) -happyOut68 x = unsafeCoerce# x -{-# INLINE happyOut68 #-} -happyIn69 :: (HsBangType) -> (HappyAbsSyn ) -happyIn69 x = unsafeCoerce# x -{-# INLINE happyIn69 #-} -happyOut69 :: (HappyAbsSyn ) -> (HsBangType) -happyOut69 x = unsafeCoerce# x -{-# INLINE happyOut69 #-} -happyIn70 :: ([HsQName]) -> (HappyAbsSyn ) -happyIn70 x = unsafeCoerce# x -{-# INLINE happyIn70 #-} -happyOut70 :: (HappyAbsSyn ) -> ([HsQName]) -happyOut70 x = unsafeCoerce# x -{-# INLINE happyOut70 #-} -happyIn71 :: ([HsQName]) -> (HappyAbsSyn ) -happyIn71 x = unsafeCoerce# x -{-# INLINE happyIn71 #-} -happyOut71 :: (HappyAbsSyn ) -> ([HsQName]) -happyOut71 x = unsafeCoerce# x -{-# INLINE happyOut71 #-} -happyIn72 :: ([HsFunDep]) -> (HappyAbsSyn ) -happyIn72 x = unsafeCoerce# x -{-# INLINE happyIn72 #-} -happyOut72 :: (HappyAbsSyn ) -> ([HsFunDep]) -happyOut72 x = unsafeCoerce# x -{-# INLINE happyOut72 #-} -happyIn73 :: ([HsFunDep]) -> (HappyAbsSyn ) -happyIn73 x = unsafeCoerce# x -{-# INLINE happyIn73 #-} -happyOut73 :: (HappyAbsSyn ) -> ([HsFunDep]) -happyOut73 x = unsafeCoerce# x -{-# INLINE happyOut73 #-} -happyIn74 :: (HsFunDep) -> (HappyAbsSyn ) -happyIn74 x = unsafeCoerce# x -{-# INLINE happyIn74 #-} -happyOut74 :: (HappyAbsSyn ) -> (HsFunDep) -happyOut74 x = unsafeCoerce# x -{-# INLINE happyOut74 #-} -happyIn75 :: ([HsName]) -> (HappyAbsSyn ) -happyIn75 x = unsafeCoerce# x -{-# INLINE happyIn75 #-} -happyOut75 :: (HappyAbsSyn ) -> ([HsName]) -happyOut75 x = unsafeCoerce# x -{-# INLINE happyOut75 #-} -happyIn76 :: ([HsDecl]) -> (HappyAbsSyn ) -happyIn76 x = unsafeCoerce# x -{-# INLINE happyIn76 #-} -happyOut76 :: (HappyAbsSyn ) -> ([HsDecl]) -happyOut76 x = unsafeCoerce# x -{-# INLINE happyOut76 #-} -happyIn77 :: ([HsDecl]) -> (HappyAbsSyn ) -happyIn77 x = unsafeCoerce# x -{-# INLINE happyIn77 #-} -happyOut77 :: (HappyAbsSyn ) -> ([HsDecl]) -happyOut77 x = unsafeCoerce# x -{-# INLINE happyOut77 #-} -happyIn78 :: (HsDecl) -> (HappyAbsSyn ) -happyIn78 x = unsafeCoerce# x -{-# INLINE happyIn78 #-} -happyOut78 :: (HappyAbsSyn ) -> (HsDecl) -happyOut78 x = unsafeCoerce# x -{-# INLINE happyOut78 #-} -happyIn79 :: ([HsDecl]) -> (HappyAbsSyn ) -happyIn79 x = unsafeCoerce# x -{-# INLINE happyIn79 #-} -happyOut79 :: (HappyAbsSyn ) -> ([HsDecl]) -happyOut79 x = unsafeCoerce# x -{-# INLINE happyOut79 #-} -happyIn80 :: ([HsDecl]) -> (HappyAbsSyn ) -happyIn80 x = unsafeCoerce# x -{-# INLINE happyIn80 #-} -happyOut80 :: (HappyAbsSyn ) -> ([HsDecl]) -happyOut80 x = unsafeCoerce# x -{-# INLINE happyOut80 #-} -happyIn81 :: ([HsDecl]) -> (HappyAbsSyn ) -happyIn81 x = unsafeCoerce# x -{-# INLINE happyIn81 #-} -happyOut81 :: (HappyAbsSyn ) -> ([HsDecl]) -happyOut81 x = unsafeCoerce# x -{-# INLINE happyOut81 #-} -happyIn82 :: ([HsDecl]) -> (HappyAbsSyn ) -happyIn82 x = unsafeCoerce# x -{-# INLINE happyIn82 #-} -happyOut82 :: (HappyAbsSyn ) -> ([HsDecl]) -happyOut82 x = unsafeCoerce# x -{-# INLINE happyOut82 #-} -happyIn83 :: (HsDecl) -> (HappyAbsSyn ) -happyIn83 x = unsafeCoerce# x -{-# INLINE happyIn83 #-} -happyOut83 :: (HappyAbsSyn ) -> (HsDecl) -happyOut83 x = unsafeCoerce# x -{-# INLINE happyOut83 #-} -happyIn84 :: (HsRhs) -> (HappyAbsSyn ) -happyIn84 x = unsafeCoerce# x -{-# INLINE happyIn84 #-} -happyOut84 :: (HappyAbsSyn ) -> (HsRhs) -happyOut84 x = unsafeCoerce# x -{-# INLINE happyOut84 #-} -happyIn85 :: ([HsGuardedRhs]) -> (HappyAbsSyn ) -happyIn85 x = unsafeCoerce# x -{-# INLINE happyIn85 #-} -happyOut85 :: (HappyAbsSyn ) -> ([HsGuardedRhs]) -happyOut85 x = unsafeCoerce# x -{-# INLINE happyOut85 #-} -happyIn86 :: (HsGuardedRhs) -> (HappyAbsSyn ) -happyIn86 x = unsafeCoerce# x -{-# INLINE happyIn86 #-} -happyOut86 :: (HappyAbsSyn ) -> (HsGuardedRhs) -happyOut86 x = unsafeCoerce# x -{-# INLINE happyOut86 #-} -happyIn87 :: (HsExp) -> (HappyAbsSyn ) -happyIn87 x = unsafeCoerce# x -{-# INLINE happyIn87 #-} -happyOut87 :: (HappyAbsSyn ) -> (HsExp) -happyOut87 x = unsafeCoerce# x -{-# INLINE happyOut87 #-} -happyIn88 :: (HsExp) -> (HappyAbsSyn ) -happyIn88 x = unsafeCoerce# x -{-# INLINE happyIn88 #-} -happyOut88 :: (HappyAbsSyn ) -> (HsExp) -happyOut88 x = unsafeCoerce# x -{-# INLINE happyOut88 #-} -happyIn89 :: (HsExp) -> (HappyAbsSyn ) -happyIn89 x = unsafeCoerce# x -{-# INLINE happyIn89 #-} -happyOut89 :: (HappyAbsSyn ) -> (HsExp) -happyOut89 x = unsafeCoerce# x -{-# INLINE happyOut89 #-} -happyIn90 :: (HsExp) -> (HappyAbsSyn ) -happyIn90 x = unsafeCoerce# x -{-# INLINE happyIn90 #-} -happyOut90 :: (HappyAbsSyn ) -> (HsExp) -happyOut90 x = unsafeCoerce# x -{-# INLINE happyOut90 #-} -happyIn91 :: (HsExp) -> (HappyAbsSyn ) -happyIn91 x = unsafeCoerce# x -{-# INLINE happyIn91 #-} -happyOut91 :: (HappyAbsSyn ) -> (HsExp) -happyOut91 x = unsafeCoerce# x -{-# INLINE happyOut91 #-} -happyIn92 :: (HsExp) -> (HappyAbsSyn ) -happyIn92 x = unsafeCoerce# x -{-# INLINE happyIn92 #-} -happyOut92 :: (HappyAbsSyn ) -> (HsExp) -happyOut92 x = unsafeCoerce# x -{-# INLINE happyOut92 #-} -happyIn93 :: (HsExp) -> (HappyAbsSyn ) -happyIn93 x = unsafeCoerce# x -{-# INLINE happyIn93 #-} -happyOut93 :: (HappyAbsSyn ) -> (HsExp) -happyOut93 x = unsafeCoerce# x -{-# INLINE happyOut93 #-} -happyIn94 :: ([HsExp]) -> (HappyAbsSyn ) -happyIn94 x = unsafeCoerce# x -{-# INLINE happyIn94 #-} -happyOut94 :: (HappyAbsSyn ) -> ([HsExp]) -happyOut94 x = unsafeCoerce# x -{-# INLINE happyOut94 #-} -happyIn95 :: (HsExp) -> (HappyAbsSyn ) -happyIn95 x = unsafeCoerce# x -{-# INLINE happyIn95 #-} -happyOut95 :: (HappyAbsSyn ) -> (HsExp) -happyOut95 x = unsafeCoerce# x -{-# INLINE happyOut95 #-} -happyIn96 :: (HsExp) -> (HappyAbsSyn ) -happyIn96 x = unsafeCoerce# x -{-# INLINE happyIn96 #-} -happyOut96 :: (HappyAbsSyn ) -> (HsExp) -happyOut96 x = unsafeCoerce# x -{-# INLINE happyOut96 #-} -happyIn97 :: (Int) -> (HappyAbsSyn ) -happyIn97 x = unsafeCoerce# x -{-# INLINE happyIn97 #-} -happyOut97 :: (HappyAbsSyn ) -> (Int) -happyOut97 x = unsafeCoerce# x -{-# INLINE happyOut97 #-} -happyIn98 :: ([HsExp]) -> (HappyAbsSyn ) -happyIn98 x = unsafeCoerce# x -{-# INLINE happyIn98 #-} -happyOut98 :: (HappyAbsSyn ) -> ([HsExp]) -happyOut98 x = unsafeCoerce# x -{-# INLINE happyOut98 #-} -happyIn99 :: (HsExp) -> (HappyAbsSyn ) -happyIn99 x = unsafeCoerce# x -{-# INLINE happyIn99 #-} -happyOut99 :: (HappyAbsSyn ) -> (HsExp) -happyOut99 x = unsafeCoerce# x -{-# INLINE happyOut99 #-} -happyIn100 :: ([HsExp]) -> (HappyAbsSyn ) -happyIn100 x = unsafeCoerce# x -{-# INLINE happyIn100 #-} -happyOut100 :: (HappyAbsSyn ) -> ([HsExp]) -happyOut100 x = unsafeCoerce# x -{-# INLINE happyOut100 #-} -happyIn101 :: ([HsStmt]) -> (HappyAbsSyn ) -happyIn101 x = unsafeCoerce# x -{-# INLINE happyIn101 #-} -happyOut101 :: (HappyAbsSyn ) -> ([HsStmt]) -happyOut101 x = unsafeCoerce# x -{-# INLINE happyOut101 #-} -happyIn102 :: ([[HsStmt]]) -> (HappyAbsSyn ) -happyIn102 x = unsafeCoerce# x -{-# INLINE happyIn102 #-} -happyOut102 :: (HappyAbsSyn ) -> ([[HsStmt]]) -happyOut102 x = unsafeCoerce# x -{-# INLINE happyOut102 #-} -happyIn103 :: ([HsStmt]) -> (HappyAbsSyn ) -happyIn103 x = unsafeCoerce# x -{-# INLINE happyIn103 #-} -happyOut103 :: (HappyAbsSyn ) -> ([HsStmt]) -happyOut103 x = unsafeCoerce# x -{-# INLINE happyOut103 #-} -happyIn104 :: (HsStmt) -> (HappyAbsSyn ) -happyIn104 x = unsafeCoerce# x -{-# INLINE happyIn104 #-} -happyOut104 :: (HappyAbsSyn ) -> (HsStmt) -happyOut104 x = unsafeCoerce# x -{-# INLINE happyOut104 #-} -happyIn105 :: ([HsAlt]) -> (HappyAbsSyn ) -happyIn105 x = unsafeCoerce# x -{-# INLINE happyIn105 #-} -happyOut105 :: (HappyAbsSyn ) -> ([HsAlt]) -happyOut105 x = unsafeCoerce# x -{-# INLINE happyOut105 #-} -happyIn106 :: ([HsAlt]) -> (HappyAbsSyn ) -happyIn106 x = unsafeCoerce# x -{-# INLINE happyIn106 #-} -happyOut106 :: (HappyAbsSyn ) -> ([HsAlt]) -happyOut106 x = unsafeCoerce# x -{-# INLINE happyOut106 #-} -happyIn107 :: (HsAlt) -> (HappyAbsSyn ) -happyIn107 x = unsafeCoerce# x -{-# INLINE happyIn107 #-} -happyOut107 :: (HappyAbsSyn ) -> (HsAlt) -happyOut107 x = unsafeCoerce# x -{-# INLINE happyOut107 #-} -happyIn108 :: (HsGuardedAlts) -> (HappyAbsSyn ) -happyIn108 x = unsafeCoerce# x -{-# INLINE happyIn108 #-} -happyOut108 :: (HappyAbsSyn ) -> (HsGuardedAlts) -happyOut108 x = unsafeCoerce# x -{-# INLINE happyOut108 #-} -happyIn109 :: ([HsGuardedAlt]) -> (HappyAbsSyn ) -happyIn109 x = unsafeCoerce# x -{-# INLINE happyIn109 #-} -happyOut109 :: (HappyAbsSyn ) -> ([HsGuardedAlt]) -happyOut109 x = unsafeCoerce# x -{-# INLINE happyOut109 #-} -happyIn110 :: (HsGuardedAlt) -> (HappyAbsSyn ) -happyIn110 x = unsafeCoerce# x -{-# INLINE happyIn110 #-} -happyOut110 :: (HappyAbsSyn ) -> (HsGuardedAlt) -happyOut110 x = unsafeCoerce# x -{-# INLINE happyOut110 #-} -happyIn111 :: (HsPat) -> (HappyAbsSyn ) -happyIn111 x = unsafeCoerce# x -{-# INLINE happyIn111 #-} -happyOut111 :: (HappyAbsSyn ) -> (HsPat) -happyOut111 x = unsafeCoerce# x -{-# INLINE happyOut111 #-} -happyIn112 :: ([HsStmt]) -> (HappyAbsSyn ) -happyIn112 x = unsafeCoerce# x -{-# INLINE happyIn112 #-} -happyOut112 :: (HappyAbsSyn ) -> ([HsStmt]) -happyOut112 x = unsafeCoerce# x -{-# INLINE happyOut112 #-} -happyIn113 :: ([HsStmt]) -> (HappyAbsSyn ) -happyIn113 x = unsafeCoerce# x -{-# INLINE happyIn113 #-} -happyOut113 :: (HappyAbsSyn ) -> ([HsStmt]) -happyOut113 x = unsafeCoerce# x -{-# INLINE happyOut113 #-} -happyIn114 :: ([HsStmt]) -> (HappyAbsSyn ) -happyIn114 x = unsafeCoerce# x -{-# INLINE happyIn114 #-} -happyOut114 :: (HappyAbsSyn ) -> ([HsStmt]) -happyOut114 x = unsafeCoerce# x -{-# INLINE happyOut114 #-} -happyIn115 :: ([HsFieldUpdate]) -> (HappyAbsSyn ) -happyIn115 x = unsafeCoerce# x -{-# INLINE happyIn115 #-} -happyOut115 :: (HappyAbsSyn ) -> ([HsFieldUpdate]) -happyOut115 x = unsafeCoerce# x -{-# INLINE happyOut115 #-} -happyIn116 :: (HsFieldUpdate) -> (HappyAbsSyn ) -happyIn116 x = unsafeCoerce# x -{-# INLINE happyIn116 #-} -happyOut116 :: (HappyAbsSyn ) -> (HsFieldUpdate) -happyOut116 x = unsafeCoerce# x -{-# INLINE happyOut116 #-} -happyIn117 :: (HsQName) -> (HappyAbsSyn ) -happyIn117 x = unsafeCoerce# x -{-# INLINE happyIn117 #-} -happyOut117 :: (HappyAbsSyn ) -> (HsQName) -happyOut117 x = unsafeCoerce# x -{-# INLINE happyOut117 #-} -happyIn118 :: (HsName) -> (HappyAbsSyn ) -happyIn118 x = unsafeCoerce# x -{-# INLINE happyIn118 #-} -happyOut118 :: (HappyAbsSyn ) -> (HsName) -happyOut118 x = unsafeCoerce# x -{-# INLINE happyOut118 #-} -happyIn119 :: (HsQName) -> (HappyAbsSyn ) -happyIn119 x = unsafeCoerce# x -{-# INLINE happyIn119 #-} -happyOut119 :: (HappyAbsSyn ) -> (HsQName) -happyOut119 x = unsafeCoerce# x -{-# INLINE happyOut119 #-} -happyIn120 :: (HsName) -> (HappyAbsSyn ) -happyIn120 x = unsafeCoerce# x -{-# INLINE happyIn120 #-} -happyOut120 :: (HappyAbsSyn ) -> (HsName) -happyOut120 x = unsafeCoerce# x -{-# INLINE happyOut120 #-} -happyIn121 :: (HsName) -> (HappyAbsSyn ) -happyIn121 x = unsafeCoerce# x -{-# INLINE happyIn121 #-} -happyOut121 :: (HappyAbsSyn ) -> (HsName) -happyOut121 x = unsafeCoerce# x -{-# INLINE happyOut121 #-} -happyIn122 :: (HsQName) -> (HappyAbsSyn ) -happyIn122 x = unsafeCoerce# x -{-# INLINE happyIn122 #-} -happyOut122 :: (HappyAbsSyn ) -> (HsQName) -happyOut122 x = unsafeCoerce# x -{-# INLINE happyOut122 #-} -happyIn123 :: (HsName) -> (HappyAbsSyn ) -happyIn123 x = unsafeCoerce# x -{-# INLINE happyIn123 #-} -happyOut123 :: (HappyAbsSyn ) -> (HsName) -happyOut123 x = unsafeCoerce# x -{-# INLINE happyOut123 #-} -happyIn124 :: (HsQName) -> (HappyAbsSyn ) -happyIn124 x = unsafeCoerce# x -{-# INLINE happyIn124 #-} -happyOut124 :: (HappyAbsSyn ) -> (HsQName) -happyOut124 x = unsafeCoerce# x -{-# INLINE happyOut124 #-} -happyIn125 :: (HsQName) -> (HappyAbsSyn ) -happyIn125 x = unsafeCoerce# x -{-# INLINE happyIn125 #-} -happyOut125 :: (HappyAbsSyn ) -> (HsQName) -happyOut125 x = unsafeCoerce# x -{-# INLINE happyOut125 #-} -happyIn126 :: (HsName) -> (HappyAbsSyn ) -happyIn126 x = unsafeCoerce# x -{-# INLINE happyIn126 #-} -happyOut126 :: (HappyAbsSyn ) -> (HsName) -happyOut126 x = unsafeCoerce# x -{-# INLINE happyOut126 #-} -happyIn127 :: (HsQName) -> (HappyAbsSyn ) -happyIn127 x = unsafeCoerce# x -{-# INLINE happyIn127 #-} -happyOut127 :: (HappyAbsSyn ) -> (HsQName) -happyOut127 x = unsafeCoerce# x -{-# INLINE happyOut127 #-} -happyIn128 :: (HsName) -> (HappyAbsSyn ) -happyIn128 x = unsafeCoerce# x -{-# INLINE happyIn128 #-} -happyOut128 :: (HappyAbsSyn ) -> (HsName) -happyOut128 x = unsafeCoerce# x -{-# INLINE happyOut128 #-} -happyIn129 :: (HsExp) -> (HappyAbsSyn ) -happyIn129 x = unsafeCoerce# x -{-# INLINE happyIn129 #-} -happyOut129 :: (HappyAbsSyn ) -> (HsExp) -happyOut129 x = unsafeCoerce# x -{-# INLINE happyOut129 #-} -happyIn130 :: (HsExp) -> (HappyAbsSyn ) -happyIn130 x = unsafeCoerce# x -{-# INLINE happyIn130 #-} -happyOut130 :: (HappyAbsSyn ) -> (HsExp) -happyOut130 x = unsafeCoerce# x -{-# INLINE happyOut130 #-} -happyIn131 :: (HsQName) -> (HappyAbsSyn ) -happyIn131 x = unsafeCoerce# x -{-# INLINE happyIn131 #-} -happyOut131 :: (HappyAbsSyn ) -> (HsQName) -happyOut131 x = unsafeCoerce# x -{-# INLINE happyOut131 #-} -happyIn132 :: (HsName) -> (HappyAbsSyn ) -happyIn132 x = unsafeCoerce# x -{-# INLINE happyIn132 #-} -happyOut132 :: (HappyAbsSyn ) -> (HsName) -happyOut132 x = unsafeCoerce# x -{-# INLINE happyOut132 #-} -happyIn133 :: (HsName) -> (HappyAbsSyn ) -happyIn133 x = unsafeCoerce# x -{-# INLINE happyIn133 #-} -happyOut133 :: (HappyAbsSyn ) -> (HsName) -happyOut133 x = unsafeCoerce# x -{-# INLINE happyOut133 #-} -happyIn134 :: (HsQName) -> (HappyAbsSyn ) -happyIn134 x = unsafeCoerce# x -{-# INLINE happyIn134 #-} -happyOut134 :: (HappyAbsSyn ) -> (HsQName) -happyOut134 x = unsafeCoerce# x -{-# INLINE happyOut134 #-} -happyIn135 :: (HsName) -> (HappyAbsSyn ) -happyIn135 x = unsafeCoerce# x -{-# INLINE happyIn135 #-} -happyOut135 :: (HappyAbsSyn ) -> (HsName) -happyOut135 x = unsafeCoerce# x -{-# INLINE happyOut135 #-} -happyIn136 :: (HsQName) -> (HappyAbsSyn ) -happyIn136 x = unsafeCoerce# x -{-# INLINE happyIn136 #-} -happyOut136 :: (HappyAbsSyn ) -> (HsQName) -happyOut136 x = unsafeCoerce# x -{-# INLINE happyOut136 #-} -happyIn137 :: (HsName) -> (HappyAbsSyn ) -happyIn137 x = unsafeCoerce# x -{-# INLINE happyIn137 #-} -happyOut137 :: (HappyAbsSyn ) -> (HsName) -happyOut137 x = unsafeCoerce# x -{-# INLINE happyOut137 #-} -happyIn138 :: (HsQName) -> (HappyAbsSyn ) -happyIn138 x = unsafeCoerce# x -{-# INLINE happyIn138 #-} -happyOut138 :: (HappyAbsSyn ) -> (HsQName) -happyOut138 x = unsafeCoerce# x -{-# INLINE happyOut138 #-} -happyIn139 :: (HsQName) -> (HappyAbsSyn ) -happyIn139 x = unsafeCoerce# x -{-# INLINE happyIn139 #-} -happyOut139 :: (HappyAbsSyn ) -> (HsQName) -happyOut139 x = unsafeCoerce# x -{-# INLINE happyOut139 #-} -happyIn140 :: (HsName) -> (HappyAbsSyn ) -happyIn140 x = unsafeCoerce# x -{-# INLINE happyIn140 #-} -happyOut140 :: (HappyAbsSyn ) -> (HsName) -happyOut140 x = unsafeCoerce# x -{-# INLINE happyOut140 #-} -happyIn141 :: (HsName) -> (HappyAbsSyn ) -happyIn141 x = unsafeCoerce# x -{-# INLINE happyIn141 #-} -happyOut141 :: (HappyAbsSyn ) -> (HsName) -happyOut141 x = unsafeCoerce# x -{-# INLINE happyOut141 #-} -happyIn142 :: (HsQName) -> (HappyAbsSyn ) -happyIn142 x = unsafeCoerce# x -{-# INLINE happyIn142 #-} -happyOut142 :: (HappyAbsSyn ) -> (HsQName) -happyOut142 x = unsafeCoerce# x -{-# INLINE happyOut142 #-} -happyIn143 :: (HsExp) -> (HappyAbsSyn ) -happyIn143 x = unsafeCoerce# x -{-# INLINE happyIn143 #-} -happyOut143 :: (HappyAbsSyn ) -> (HsExp) -happyOut143 x = unsafeCoerce# x -{-# INLINE happyOut143 #-} -happyIn144 :: (SrcLoc) -> (HappyAbsSyn ) -happyIn144 x = unsafeCoerce# x -{-# INLINE happyIn144 #-} -happyOut144 :: (HappyAbsSyn ) -> (SrcLoc) -happyOut144 x = unsafeCoerce# x -{-# INLINE happyOut144 #-} -happyIn145 :: (()) -> (HappyAbsSyn ) -happyIn145 x = unsafeCoerce# x -{-# INLINE happyIn145 #-} -happyOut145 :: (HappyAbsSyn ) -> (()) -happyOut145 x = unsafeCoerce# x -{-# INLINE happyOut145 #-} -happyIn146 :: (()) -> (HappyAbsSyn ) -happyIn146 x = unsafeCoerce# x -{-# INLINE happyIn146 #-} -happyOut146 :: (HappyAbsSyn ) -> (()) -happyOut146 x = unsafeCoerce# x -{-# INLINE happyOut146 #-} -happyIn147 :: (Module) -> (HappyAbsSyn ) -happyIn147 x = unsafeCoerce# x -{-# INLINE happyIn147 #-} -happyOut147 :: (HappyAbsSyn ) -> (Module) -happyOut147 x = unsafeCoerce# x -{-# INLINE happyOut147 #-} -happyIn148 :: (HsName) -> (HappyAbsSyn ) -happyIn148 x = unsafeCoerce# x -{-# INLINE happyIn148 #-} -happyOut148 :: (HappyAbsSyn ) -> (HsName) -happyOut148 x = unsafeCoerce# x -{-# INLINE happyOut148 #-} -happyIn149 :: (HsName) -> (HappyAbsSyn ) -happyIn149 x = unsafeCoerce# x -{-# INLINE happyIn149 #-} -happyOut149 :: (HappyAbsSyn ) -> (HsName) -happyOut149 x = unsafeCoerce# x -{-# INLINE happyOut149 #-} -happyIn150 :: (HsQName) -> (HappyAbsSyn ) -happyIn150 x = unsafeCoerce# x -{-# INLINE happyIn150 #-} -happyOut150 :: (HappyAbsSyn ) -> (HsQName) -happyOut150 x = unsafeCoerce# x -{-# INLINE happyOut150 #-} -happyIn151 :: (HsName) -> (HappyAbsSyn ) -happyIn151 x = unsafeCoerce# x -{-# INLINE happyIn151 #-} -happyOut151 :: (HappyAbsSyn ) -> (HsName) -happyOut151 x = unsafeCoerce# x -{-# INLINE happyOut151 #-} -happyIn152 :: (HsType) -> (HappyAbsSyn ) -happyIn152 x = unsafeCoerce# x -{-# INLINE happyIn152 #-} -happyOut152 :: (HappyAbsSyn ) -> (HsType) -happyOut152 x = unsafeCoerce# x -{-# INLINE happyOut152 #-} -happyIn153 :: (Doc) -> (HappyAbsSyn ) -happyIn153 x = unsafeCoerce# x -{-# INLINE happyIn153 #-} -happyOut153 :: (HappyAbsSyn ) -> (Doc) -happyOut153 x = unsafeCoerce# x -{-# INLINE happyOut153 #-} -happyIn154 :: (Doc) -> (HappyAbsSyn ) -happyIn154 x = unsafeCoerce# x -{-# INLINE happyIn154 #-} -happyOut154 :: (HappyAbsSyn ) -> (Doc) -happyOut154 x = unsafeCoerce# x -{-# INLINE happyOut154 #-} -happyIn155 :: ((String,Doc)) -> (HappyAbsSyn ) -happyIn155 x = unsafeCoerce# x -{-# INLINE happyIn155 #-} -happyOut155 :: (HappyAbsSyn ) -> ((String,Doc)) -happyOut155 x = unsafeCoerce# x -{-# INLINE happyOut155 #-} -happyIn156 :: ((Int,Doc)) -> (HappyAbsSyn ) -happyIn156 x = unsafeCoerce# x -{-# INLINE happyIn156 #-} -happyOut156 :: (HappyAbsSyn ) -> ((Int,Doc)) -happyOut156 x = unsafeCoerce# x -{-# INLINE happyOut156 #-} -happyIn157 :: (Maybe Doc) -> (HappyAbsSyn ) -happyIn157 x = unsafeCoerce# x -{-# INLINE happyIn157 #-} -happyOut157 :: (HappyAbsSyn ) -> (Maybe Doc) -happyOut157 x = unsafeCoerce# x -{-# INLINE happyOut157 #-} -happyIn158 :: (Maybe Doc) -> (HappyAbsSyn ) -happyIn158 x = unsafeCoerce# x -{-# INLINE happyIn158 #-} -happyOut158 :: (HappyAbsSyn ) -> (Maybe Doc) -happyOut158 x = unsafeCoerce# x -{-# INLINE happyOut158 #-} -happyIn159 :: ((ModuleInfo,Maybe Doc)) -> (HappyAbsSyn ) -happyIn159 x = unsafeCoerce# x -{-# INLINE happyIn159 #-} -happyOut159 :: (HappyAbsSyn ) -> ((ModuleInfo,Maybe Doc)) -happyOut159 x = unsafeCoerce# x -{-# INLINE happyOut159 #-} -happyInTok :: Token -> (HappyAbsSyn ) -happyInTok x = unsafeCoerce# x -{-# INLINE happyInTok #-} -happyOutTok :: (HappyAbsSyn ) -> Token -happyOutTok x = unsafeCoerce# x -{-# INLINE happyOutTok #-} - - -happyActOffsets :: HappyAddr -happyActOffsets = HappyA# "\x0e\x00\xb4\x01\x68\x04\x97\x04\x00\x00\x94\x04\x53\x04\x00\x00\x21\x05\x17\x06\x87\x04\x88\x04\x00\x00\x00\x00\x00\x00\x7f\x04\x00\x00\x73\x05\x00\x00\x7b\x04\x00\x00\xc5\x04\x00\x00\x7f\x0c\x7a\x04\x00\x00\x00\x00\x7b\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x25\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc5\x05\x37\x0b\x73\x05\xb1\x07\x00\x00\x7f\x0c\x7f\x0c\x00\x00\x37\x0b\x00\x00\x00\x00\x4f\x0f\x00\x00\x79\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4f\x0f\x00\x00\x00\x00\x00\x00\x8b\x04\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb2\x02\x00\x00\x00\x00\x00\x00\x00\x00\xd8\x0f\x00\x00\x00\x00\x00\x00\x76\x0d\x00\x00\x00\x00\x00\x00\x57\x04\x5e\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xfd\x0c\x12\x11\x26\x0f\xd8\x0f\xfd\x0e\x2f\x04\x00\x00\x01\x02\x00\x00\x5f\x07\x5f\x07\x55\x04\x00\x00\xfd\x0e\x39\x04\x00\x00\x00\x00\x78\x02\x00\x00\x4d\x04\x7f\x0c\x37\x0b\x63\x04\x7f\x0c\x00\x00\x79\x01\x3e\x04\x40\x04\x00\x00\x00\x00\x6d\x01\x4c\x04\xdb\x01\x78\x02\xd5\x01\x47\x04\x00\x00\x00\x00\x37\x0b\x45\x04\x00\x00\x43\x04\x00\x00\x00\x00\x00\x00\x42\x04\x3f\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xf8\x11\x37\x04\x7f\x0c\x36\x04\x44\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7f\x0c\xd6\x11\x30\x04\x00\x00\x00\x00\xdb\x0b\x00\x00\x00\x00\x00\x00\x5a\x02\x00\x00\xbb\x11\x00\x00\x00\x00\x00\x00\x24\x04\xa6\x12\x00\x00\x73\x05\x21\x05\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xcb\x01\xe9\x10\x28\x04\x26\x04\x00\x00\x1c\x00\x00\x00\x37\x0b\x00\x00\x00\x00\x93\x01\x00\x00\x20\x04\x5d\x04\x00\x00\x23\x04\x2c\x00\x00\x00\x10\x04\x00\x00\x00\x00\x19\x04\xc5\x04\x00\x00\x00\x00\x00\x00\x0d\x07\x00\x00\x00\x00\x37\x0b\x00\x00\x00\x00\x37\x0b\x00\x00\x00\x00\x06\x04\x37\x0b\x37\x0b\xe5\x0a\x00\x00\xef\x03\x69\x06\x89\x0b\xe2\x03\x2d\x0c\x11\x04\x93\x0a\x04\x04\xfb\x03\x16\x00\xc0\x10\x00\x00\x2c\x0d\x02\x04\xee\x03\xfa\x03\xbb\x06\xf9\x03\x40\x00\xb7\x00\xb7\x00\xb2\x02\x00\x00\xb3\x03\xe8\x03\xd8\x0f\xcb\x01\xe0\x03\xef\x0d\x00\x00\xa8\x00\xe1\x03\xdd\x03\xdf\x03\xda\x03\xbc\x01\xd9\x03\x00\x00\xd7\x03\x7e\x11\xc0\x10\xc9\x03\x00\x00\x00\x00\x7e\x11\xd8\x0f\x7e\x11\x00\x00\xc7\x03\xd0\x03\x00\x00\x00\x00\x96\x03\x00\x00\xf8\x0d\x97\x10\x00\x00\xc2\x03\x7e\x11\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x6e\x10\x00\x00\x00\x00\x00\x00\x00\x00\xfd\x0e\x00\x00\xc8\x03\xb0\x03\x80\x12\x00\x00\x00\x00\x00\x00\x65\x12\x00\x00\xa2\x03\x00\x00\x00\x00\x93\x0a\x00\x00\xbb\x06\xc6\x03\xb9\x03\x00\x00\xa0\x03\x00\x00\xae\x03\x7e\x03\x00\x00\x00\x00\xdb\x0b\xdb\x0b\x00\x00\xaf\x03\x93\x0a\x93\x0a\xa7\x03\xa3\x03\x69\x06\x11\x02\x00\x00\x98\x03\x69\x06\x40\x00\xd3\x00\x93\x0a\x9c\x03\x00\x00\x00\x00\x93\x03\x41\x0a\x00\x00\x9b\x03\x00\x00\xfd\x0e\x00\x00\x00\x00\x00\x00\x94\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4a\x12\xef\x09\x00\x00\x13\x12\x9d\x09\x64\x03\x00\x00\x00\x00\x97\x03\x00\x00\x00\x00\x00\x00\x87\x03\x3a\x0d\x00\x00\x82\x03\xd8\x0f\x90\x03\x00\x00\x8d\x03\x7e\x11\x7e\x11\x00\x00\x7e\x11\x00\x00\x00\x00\xc2\x00\x00\x00\x00\x00\x8c\x03\x84\x03\x2c\x00\x00\x00\x85\x03\x4b\x09\xf9\x08\x00\x00\x00\x00\xa4\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x69\x06\x00\x00\x6a\x03\x00\x00\xc5\x04\x71\x03\x00\x00\x00\x00\x71\x03\x67\x03\x00\x00\x28\x12\x00\x00\x69\x03\x00\x00\x00\x00\xf0\x00\x00\x00\x00\x00\x00\x00\x00\x00\x79\x03\xc1\x12\x64\x0c\x00\x00\x75\x03\x74\x03\x72\x03\x0b\x00\xb2\x02\xdb\x0b\xdb\x0b\x00\x00\x5f\x03\x00\x00\x48\x03\x6c\x03\x00\x00\x00\x00\x61\x03\xf8\x0d\xe1\x02\x66\x03\x00\x00\x00\x00\x00\x00\x00\x00\xa4\x0c\x56\x03\xb2\x02\x55\x03\x00\x00\x00\x00\xd4\x0e\x00\x00\xe1\x02\xf8\x0d\x00\x00\x00\x00\x36\x03\x00\x00\xa1\x01\x00\x00\x54\x00\x00\x00\x00\x00\x00\x00\x99\x11\x59\x03\x00\x00\x42\x03\x45\x10\x00\x00\x31\x01\x00\x00\xbe\x00\x00\x00\x69\x06\x89\x0b\x00\x00\x00\x00\x00\x00\x40\x00\xdb\x0b\xd4\x01\x41\x03\xa7\x08\x00\x00\xa7\x08\x00\x00\x40\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa7\x08\x00\x00\xb3\x0d\x7e\x11\x00\x00\x45\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x16\x03\x37\x03\x00\x00\x00\x00\xa7\x08\x00\x00\x00\x00\x00\x00\x34\x0f\x33\x03\x96\x01\x00\x00\x00\x00\x00\x00\x45\x10\x99\x11\x59\x01\x00\x00\x3a\x03\x00\x00\x00\x00\x00\x00\xb0\x04\x3b\x03\x00\x00\xdb\x0b\x00\x00\x1c\x10\x34\x0f\x00\x00\x00\x00\x3b\x01\x00\x00\x00\x00\x00\x00\xd4\x0c\x00\x00\x30\x03\x35\x03\x00\x00\x31\x03\x00\x00\xf3\x0f\x22\x03\x48\x0e\x13\x03\x2d\x03\x00\x00\xca\x0f\x28\x00\x1e\x03\x00\x00\x15\x03\xbe\x0c\x7e\x11\x00\x00\x00\x00\x37\x01\x00\x00\x12\x03\x58\x11\x00\x00\x99\x11\x15\x01\x00\x00\x00\x00\xad\x02\x0e\x03\x00\x00\x55\x08\x00\x00\x00\x00\x42\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe5\x00\x00\x00\x00\x00\x00\x00\xf7\x03\x00\x00\x0c\x03\x00\x00\x00\x00\x00\x00\x07\x03\xfd\x00\xa1\x0f\x1a\x03\x00\x00\x00\x00\x3b\x11\x00\x00\x78\x0f\x3b\x11\x00\x00\x00\x00\x00\x00\xab\x0e\x09\x03\xfd\x02\x00\x00\x3b\x11\x00\x00\xf8\x02\x1d\x00\x13\x12\xfd\x00\x00\x00\x00\x00\x00\x00\x12\x0c\x00\x00\x03\x08\x00\x00\x00\x00\x00\x00\xfb\x01\x00\x00\xf0\x02\xf7\x02\xfd\x00\x00\x00\xf1\x02\x00\x00\xf4\x02\x6e\x0e\x00\x00\xf4\x02\x3b\x11\xfd\x00\xf4\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00"# - -happyGotoOffsets :: HappyAddr -happyGotoOffsets = HappyA# "\x01\x00\x03\x00\x00\x00\x00\x00\x00\x00\x61\x02\x00\x00\x76\x02\xe9\x00\xa4\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x6f\x02\x00\x00\x6d\x02\x00\x00\x7c\x0b\x00\x00\x64\x18\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xf0\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1e\x13\x55\x15\x2d\x02\x10\x15\x00\x00\x6a\x18\x0a\x0e\x00\x00\x88\x17\x00\x00\x67\x02\x27\x04\x5f\x02\xcb\xff\x00\x00\x00\x00\x00\x00\x05\x00\x00\x00\x5d\x02\x5c\x02\x17\x04\x00\x00\x00\x00\x00\x00\xe7\xff\x00\x00\x00\x00\x59\x02\x00\x00\x00\x00\x00\x00\x4f\x02\x54\x02\x00\x00\x00\x00\x00\x00\x4b\x02\xa7\x00\x00\x00\x00\x00\x00\x00\xd2\x02\x00\x00\x00\x00\x4a\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x67\x01\x46\x04\x66\x04\xa1\x00\x0f\x04\xc1\x02\x00\x00\x00\x00\x00\x00\xae\x14\x7d\x14\x00\x00\x47\x02\xe5\x03\x00\x00\x00\x00\x00\x00\x10\x06\x00\x00\x00\x00\xcc\x14\x75\x17\x13\x00\x64\x18\x00\x00\x13\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xbe\x05\x00\x00\x00\x00\x00\x00\x00\x00\xb9\x17\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xf0\x01\x00\x00\x0a\x0e\x00\x00\xb0\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x48\x18\xb1\x01\x00\x00\x00\x00\x00\x00\x2c\x18\x00\x00\x00\x00\x00\x00\xe6\x02\x00\x00\xee\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe6\x00\x00\x00\xeb\x01\x2b\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x44\x02\xea\x02\x00\x00\x00\x00\x00\x00\xe2\xff\x00\x00\x44\x17\x38\x02\x00\x00\x00\x00\x00\x00\x00\x00\x9d\x01\x00\x00\x00\x00\x61\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1a\x05\x00\x00\x00\x00\x00\x00\x26\x18\x33\x02\x00\x00\x24\x15\x00\x00\x00\x00\x31\x17\x00\x00\x00\x00\x00\x00\x00\x17\xed\x16\x4c\x14\x00\x00\x00\x00\xa9\x01\x6a\x01\x00\x00\x5f\x0d\x00\x00\x26\x18\xbd\xff\x79\x02\xdf\xff\xfe\x00\x00\x00\x1a\x05\x4c\x02\x00\x00\x00\x00\x1b\x14\x0a\x00\x1e\x02\x7b\x02\x6e\x02\x02\x02\x00\x00\x41\x02\x00\x00\x83\x00\xf5\x01\x00\x00\xd2\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x94\x02\x50\x04\x00\x00\x00\x00\x00\x00\x5c\x04\x66\x00\xe4\xff\x00\x00\x00\x00\xa0\x02\x00\x00\x00\x00\x00\x00\x00\x00\x0d\x00\xab\x02\x00\x00\x00\x00\x8e\x04\x17\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x3d\x04\x00\x00\x00\x00\x00\x00\x00\x00\xa5\x03\x00\x00\xd8\x01\x4d\x02\xb2\x00\x00\x00\x00\x00\x00\x00\xbd\x00\x00\x00\x00\x00\x00\x00\x00\x00\xbc\x16\x00\x00\xea\x13\x00\x00\x00\x00\x00\x00\xfd\x01\x00\x00\x00\x00\xee\x01\xee\x02\x00\x00\xf1\x17\xc0\x17\x00\x00\x00\x00\xa9\x16\x78\x16\x00\x00\x00\x00\xaa\x03\x00\x00\x00\x00\x00\x00\x6b\x03\xcc\x01\x8a\x01\x65\x16\x00\x00\x00\x00\x00\x00\x00\x00\xb9\x13\x00\x00\x00\x00\x00\x00\x68\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5e\x02\x34\x16\x00\x00\x34\x02\x88\x13\xcf\x01\x00\x00\x00\x00\xfd\xff\x00\x00\x00\x00\x00\x00\x00\x00\x28\x01\x00\x00\x00\x00\x81\x00\x00\x00\x00\x00\x00\x00\x6c\x02\x47\x03\x00\x00\x4f\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x70\x02\x00\x00\x00\x00\x21\x16\xdf\x14\x00\x00\x00\x00\xde\xff\x00\x00\x00\x00\x87\x01\x00\x00\x00\x00\x2c\x03\x00\x00\x00\x00\x00\x00\xc8\x04\x06\x02\x00\x00\x65\x01\xe3\x01\x00\x00\x00\x00\xa3\xff\x00\x00\xf6\xff\x2f\x00\x00\x00\x48\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x17\x02\xbb\x00\x00\x00\x00\x00\x00\x00\x00\x00\x43\x02\x23\x01\xcc\x12\xab\x12\x00\x00\x00\x00\x00\x00\x4a\x01\x78\x01\x00\x00\x00\x00\x00\x00\x02\x00\x15\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xbf\xff\x00\x00\x18\x01\x04\x00\x00\x00\x00\x00\x4c\x00\x00\x00\x11\x00\xfe\xff\x00\x00\x00\x00\x2a\x01\x00\x00\x00\x00\x00\x00\xc0\x00\x00\x00\x00\x00\x00\x00\x2e\x00\x00\x00\x00\x00\x00\x00\x29\x02\x00\x00\xdd\xff\x00\x00\xeb\x00\x00\x00\xed\x02\xae\x02\x00\x00\xff\x00\x1a\x00\x8b\x00\xf8\x17\xc0\x02\x00\x00\xf0\x15\x00\x00\xdd\x15\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xac\x15\x00\x00\x28\x01\x8e\x04\x00\x00\xe7\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7a\x00\x33\x00\x00\x00\xe6\xff\x99\x15\x00\x00\x00\x00\x00\x00\xa3\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa5\x01\xfa\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xca\xff\x00\x00\x00\x00\xed\x12\x00\x00\x71\x04\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xdf\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5f\x00\x00\x00\x8e\x04\x00\x00\xf4\x01\x00\x00\xe4\x00\x76\x00\x00\x00\x00\x00\x00\x00\xdc\x03\x89\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x9d\x00\x00\x00\x39\x00\x00\x00\x00\x00\x00\x00\x94\xff\xe2\x01\x00\x00\x57\x13\x00\x00\x00\x00\x00\x00\x00\x00\x2b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xda\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa6\x01\xf5\x03\xc1\xff\x00\x00\x00\x00\x6b\x04\x00\x00\x86\x04\x62\x03\x00\x00\x00\x00\x00\x00\x11\x03\xb6\x01\x00\x00\x00\x00\x11\x03\x00\x00\x00\x00\xc6\x00\x25\x01\xa4\x01\x00\x00\x00\x00\x00\x00\xe1\x00\x00\x00\x68\x15\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb2\x01\x99\x01\x00\x00\x00\x00\x00\x00\x70\x01\x29\x03\x00\x00\x75\x00\xbf\x00\x1b\x00\x3e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00"# - -happyDefActions :: HappyAddr -happyDefActions = HappyA# "\x8d\xfe\x00\x00\x00\x00\xfc\xff\x7a\xfe\xfb\xff\x00\x00\x90\xfe\xb1\xff\x90\xfe\x00\x00\xf3\xff\xd9\xff\x9f\xff\xf4\xff\xb2\xff\xa9\xff\xb1\xff\xa0\xff\x90\xfe\x9e\xff\x90\xfe\x1e\xff\x17\xff\x15\xff\x10\xff\x0d\xff\x0e\xff\x0f\xff\xd4\xfe\xd1\xfe\xba\xfe\xb7\xfe\xcc\xfe\xab\xfe\x0c\xff\x00\x00\xb6\xfe\xcd\xfe\xb9\xfe\xa9\xfe\xaa\xfe\x99\xfe\x97\xfe\x98\xfe\x96\xfe\x95\xfe\x91\xfe\x93\xfe\x92\xfe\x94\xfe\x00\x00\x00\x00\xb1\xff\x00\x00\x03\xff\x00\x00\x00\x00\xb5\xfe\x00\x00\xad\xfe\x90\xfe\x00\x00\x90\xfe\x8d\xfe\xac\xfe\xaf\xfe\xb8\xfe\x90\xfe\xb0\xfe\x90\xfe\x90\xfe\x00\x00\xb3\xfe\xae\xfe\xb2\xfe\x00\x00\xb4\xfe\xb1\xfe\x00\x00\xfd\xff\xfa\xff\xf9\xff\x90\xfe\x00\x00\xf6\xff\x8e\xfe\x8f\xfe\x90\xfe\x66\xff\x89\xfe\x6f\xff\x83\xff\x82\xff\x7e\xff\x7d\xff\x90\xfe\x00\x00\x00\x00\x86\xfe\x76\xff\x7c\xff\x88\xfe\x87\xfe\x00\x00\x00\x00\x00\x00\x66\xff\x00\x00\xd6\xff\xaa\xff\x00\x00\x18\xff\xdd\xfe\xdd\xfe\x00\x00\x90\xfe\x00\x00\x00\x00\x24\xff\x23\xff\x22\xff\x20\xff\x0e\xff\x00\x00\x00\x00\x8d\xfe\x19\xff\x02\xff\xfd\xfe\x00\x00\xfc\xfe\xd6\xfe\xb4\xff\x00\x00\x00\x00\x00\x00\x22\xff\x00\x00\x00\x00\xbc\xfe\xbb\xfe\x00\x00\xc2\xfe\xa8\xfe\x00\x00\xc6\xfe\xa5\xfe\xa3\xfe\xa2\xfe\x9d\xfe\xa6\xfe\x9a\xfe\xa7\xfe\xd7\xfe\x00\xff\x00\x00\x9c\xfe\x9f\xfe\x9b\xfe\xbc\xff\x9d\xff\x9c\xff\x9b\xff\x9a\xff\x82\xfe\x81\xfe\x80\xfe\x7f\xfe\xba\xff\xb9\xff\xb8\xff\x00\x00\x00\x00\x16\xff\xbe\xfe\xbd\xfe\x00\x00\xc2\xfe\xc8\xfe\xa4\xfe\x00\x00\xa1\xfe\x00\x00\xa0\xfe\x9f\xfe\x9e\xfe\x00\x00\x00\x00\xb3\xff\xb1\xff\xb1\xff\xf7\xff\xda\xff\xf5\xff\xb5\xff\x96\xff\xd3\xfe\x00\x00\x00\x00\x00\x00\x00\x00\x2b\xff\x33\xff\x27\xff\x00\x00\x90\xfe\x1f\xff\x00\x00\xd9\xfe\x00\x00\x00\x00\x12\xff\x04\xff\x00\x00\xbb\xff\x00\x00\xd0\xfe\xcb\xfe\x00\x00\x22\xff\x0a\xff\xd5\xfe\x01\xff\x00\x00\x90\xfe\x0b\xff\x00\x00\x08\xff\x09\xff\x00\x00\x07\xff\xf7\xfe\xf4\xfe\x00\x00\xfb\xfe\x00\x00\x37\xff\x00\x00\xa1\xff\x90\xfe\x00\x00\x00\x00\x13\xff\x00\x00\x8d\xfe\x44\xff\x65\xff\xa6\xff\xee\xfe\x22\xff\xdb\xfe\x00\x00\x00\x00\xdd\xfe\x8d\xfe\x00\x00\x00\x00\x00\x00\x00\x00\xd7\xff\x30\xff\x00\x00\x66\xff\x00\x00\x00\x00\x82\xff\x73\xff\x00\x00\x00\x00\x6f\xff\x00\x00\x00\x00\x00\x00\x00\x00\x75\xff\x00\x00\x00\x00\x00\x00\x00\x00\x7f\xff\x83\xfe\x00\x00\x00\x00\x00\x00\x68\xff\x00\x00\xef\xff\x8c\xfe\x8b\xfe\x00\x00\xf0\xff\xeb\xff\x00\x00\x80\xff\x00\x00\x81\xff\x90\xfe\x70\xff\x84\xff\x74\xff\x85\xfe\x72\xff\x7b\xff\x77\xff\x00\x00\x79\xff\x7a\xff\x78\xff\x67\xff\x00\x00\xac\xff\x8d\xfe\xd4\xff\x00\x00\x90\xff\x8f\xff\x91\xff\x00\x00\xe0\xfe\xed\xfe\xde\xfe\xe1\xfe\x00\x00\xdf\xfe\xdd\xfe\x00\x00\xa7\xff\xa8\xff\x4a\xff\x7c\xfe\x00\x00\x3c\xff\x3f\xff\x1a\xff\x00\x00\x00\x00\x21\xff\x14\xff\x00\x00\x00\x00\x00\x00\xa2\xff\xa1\xff\x00\x00\x39\xff\x0f\xff\xa1\xff\x00\x00\x00\x00\x00\x00\xf2\xfe\xf0\xfe\xf9\xfe\xf5\xfe\x00\x00\xf6\xfe\xfe\xfe\xff\xfe\x00\x00\x06\xff\x05\xff\xc5\xfe\xbd\xff\xc0\xfe\xbf\xfe\xb6\xff\xc4\xfe\xca\xfe\x00\x00\x00\x00\x11\xff\x00\x00\x00\x00\x33\xff\x29\xff\x28\xff\x8d\xfe\xc1\xfe\xc7\xfe\x6c\xff\x88\xff\x87\xff\x97\xff\x00\x00\x66\xff\x00\x00\xd2\xfe\x00\x00\x00\x00\x00\x00\x86\xff\x00\x00\x34\xff\x2a\xff\x00\x00\xda\xfe\xd8\xfe\x00\x00\x00\x00\x00\x00\x25\xff\xf3\xfe\xfa\xfe\x00\x00\x1c\xff\x35\xff\x3a\xff\x98\xff\xa3\xff\x90\xfe\x36\xff\xa4\xff\xa1\xff\x99\xff\x00\x00\x1d\xff\xe2\xfe\xf1\xff\xe9\xfe\x90\xfe\xf1\xff\x43\xff\x41\xff\x00\x00\xad\xff\x8d\xfe\x90\xfe\xaf\xff\x00\x00\xab\xff\xdc\xfe\xef\xfe\x92\xff\x00\x00\x00\x00\x00\x00\x93\xff\x8d\xff\x8c\xff\x8e\xff\xd2\xff\x00\x00\x2c\xff\x2c\xff\x71\xff\x69\xff\x6a\xff\x4a\xff\x7b\xfe\x84\xfe\xb0\xff\x00\x00\xeb\xff\xe8\xff\xe3\xff\xe4\xff\xe5\xff\xe6\xff\xe7\xff\x00\x00\x00\x00\x00\x00\x8d\xfe\xfe\xff\xdf\xff\x00\x00\xed\xff\xe8\xff\xeb\xff\xec\xff\xee\xff\x5c\xff\xae\xff\x00\x00\x2d\xff\x00\x00\xd5\xff\xd8\xff\xd3\xff\xcc\xff\x00\x00\x94\xff\x00\x00\x00\x00\x49\xff\x00\x00\x64\xff\x62\xff\x3d\xff\xa1\xff\x90\xfe\x3e\xff\x3f\xff\x3f\xff\x00\x00\xf2\xff\x00\x00\x00\x00\x00\x00\xa5\xff\x00\x00\x3b\xff\x00\x00\xf1\xfe\xf8\xfe\xb7\xff\xc3\xfe\xc9\xfe\x00\x00\x89\xff\x87\xff\x85\xff\x6d\xff\x00\x00\x6e\xff\x26\xff\x38\xff\x1b\xff\xec\xfe\x33\xff\xe6\xfe\xe4\xfe\x90\xfe\x00\x00\xea\xfe\xeb\xfe\x42\xff\x40\xff\x00\x00\x00\x00\x45\xff\x48\xff\x8a\xff\x00\x00\xcc\xff\x00\x00\xcd\xff\xca\xff\xcb\xff\xc6\xff\x8a\xfe\x00\x00\x00\x00\x31\xff\x2e\xff\x32\xff\x00\x00\x66\xff\xe9\xff\xea\xff\x00\x00\xdd\xff\xdb\xff\xdc\xff\x00\x00\xe1\xff\x00\x00\x00\x00\xe2\xff\x00\x00\xe0\xff\x00\x00\x00\x00\x59\xff\x00\x00\x7d\xfe\x5b\xff\x58\xff\x00\x00\x00\x00\xcf\xfe\x88\xfe\x00\x00\x00\x00\x2f\xff\xc3\xff\x00\x00\xc5\xff\x00\x00\x00\x00\xd1\xff\xce\xff\x00\x00\x8b\xff\x47\xff\x00\x00\x7d\xfe\xe7\xfe\x00\x00\xe5\xfe\xe8\xfe\x00\x00\x7e\xfe\x90\xfe\x46\xff\xd0\xff\xcf\xff\x00\x00\xc0\xff\xbf\xff\xbe\xff\x00\x00\xc8\xff\x00\x00\xc4\xff\xc2\xff\x52\xff\x00\x00\x7b\xfe\x00\x00\x00\x00\x55\xff\x56\xff\x00\x00\x61\xff\x00\x00\x00\x00\x5d\xff\xde\xff\x57\xff\x59\xff\x7d\xfe\x00\x00\x54\xff\x53\xff\x5a\xff\x00\x00\x4f\xff\x00\x00\x7b\xfe\xce\xfe\xc9\xff\xc7\xff\x00\x00\x63\xff\x00\x00\xe3\xfe\xc1\xff\x50\xff\x00\x00\x95\xff\x00\x00\x7d\xfe\x7b\xfe\x60\xff\x00\x00\x5f\xff\x7d\xfe\x00\x00\x4c\xff\x7d\xfe\x00\x00\x7b\xfe\x7d\xfe\x5e\xff\x51\xff\x4b\xff\x4d\xff"# - -happyCheck :: HappyAddr -happyCheck = HappyA# "\xff\xff\x00\x00\x01\x00\x02\x00\x01\x00\x07\x00\x02\x00\x09\x00\x0a\x00\x07\x00\x1a\x00\x09\x00\x0a\x00\x13\x00\x14\x00\x15\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x07\x00\x36\x00\x09\x00\x0a\x00\x22\x00\x08\x00\x09\x00\x34\x00\x5d\x00\x08\x00\x09\x00\x22\x00\x43\x00\x13\x00\x65\x00\x18\x00\x81\x00\x17\x00\x92\x00\x5d\x00\x4a\x00\x13\x00\x25\x00\x1d\x00\x22\x00\x2f\x00\x4c\x00\x07\x00\x13\x00\x2f\x00\x06\x00\x07\x00\x52\x00\x22\x00\x93\x00\x6c\x00\x13\x00\x14\x00\x15\x00\x16\x00\x2f\x00\x35\x00\x28\x00\x22\x00\x00\x00\x13\x00\x14\x00\x15\x00\x83\x00\x86\x00\x2a\x00\x88\x00\x4b\x00\x8a\x00\x3f\x00\x8e\x00\x24\x00\x14\x00\x15\x00\x38\x00\x24\x00\x25\x00\x88\x00\x75\x00\x00\x00\x4b\x00\x48\x00\x0b\x00\x0c\x00\x8e\x00\x3f\x00\x40\x00\x30\x00\x31\x00\x4b\x00\x1f\x00\x46\x00\x47\x00\x37\x00\x38\x00\x22\x00\x81\x00\x37\x00\x38\x00\x43\x00\x44\x00\x45\x00\x0c\x00\x72\x00\x51\x00\x2c\x00\x92\x00\x1c\x00\x73\x00\x8c\x00\x1f\x00\x95\x00\x73\x00\x92\x00\x93\x00\x91\x00\x9a\x00\x80\x00\x81\x00\x1b\x00\x7f\x00\x80\x00\x81\x00\x73\x00\x7f\x00\x80\x00\x81\x00\x8e\x00\x95\x00\x96\x00\x97\x00\x98\x00\x81\x00\x90\x00\x8e\x00\x7f\x00\x80\x00\x81\x00\x8e\x00\x92\x00\x8c\x00\x8e\x00\x95\x00\x92\x00\x97\x00\x98\x00\x95\x00\x8e\x00\x97\x00\x98\x00\x93\x00\x9b\x00\x6a\x00\x9b\x00\x92\x00\x72\x00\x8e\x00\x95\x00\x8c\x00\x97\x00\x98\x00\x95\x00\x03\x00\x97\x00\x98\x00\x95\x00\x72\x00\x97\x00\x98\x00\x80\x00\x81\x00\x95\x00\x0d\x00\x0e\x00\x16\x00\x17\x00\x9a\x00\x35\x00\x8c\x00\x35\x00\x80\x00\x81\x00\x8c\x00\x18\x00\x71\x00\x90\x00\x73\x00\x1c\x00\x1d\x00\x76\x00\x1b\x00\x20\x00\x21\x00\x4c\x00\x23\x00\x24\x00\x90\x00\x22\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x71\x00\x13\x00\x73\x00\x00\x00\x96\x00\x76\x00\x35\x00\x99\x00\x77\x00\x27\x00\x28\x00\x7a\x00\x35\x00\x7c\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x28\x00\x22\x00\x28\x00\x85\x00\x81\x00\x2a\x00\x88\x00\x28\x00\x34\x00\x03\x00\x2e\x00\x2f\x00\x1c\x00\x7a\x00\x3a\x00\x1f\x00\x4f\x00\x04\x00\x05\x00\x0d\x00\x0e\x00\x17\x00\x93\x00\x56\x00\x85\x00\x58\x00\x59\x00\x19\x00\x5b\x00\x5c\x00\x18\x00\x81\x00\x4c\x00\x81\x00\x1c\x00\x1d\x00\x22\x00\x18\x00\x20\x00\x21\x00\x96\x00\x23\x00\x24\x00\x99\x00\x72\x00\x13\x00\x74\x00\x2e\x00\x2f\x00\x93\x00\x71\x00\x93\x00\x73\x00\x8d\x00\x75\x00\x76\x00\x1e\x00\x1e\x00\x80\x00\x81\x00\x22\x00\x83\x00\x3d\x00\x81\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x81\x00\x2b\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x19\x00\x8b\x00\x8c\x00\x33\x00\x80\x00\x81\x00\x93\x00\x04\x00\x05\x00\x22\x00\x4f\x00\x0e\x00\x93\x00\x80\x00\x81\x00\x80\x00\x81\x00\x56\x00\x81\x00\x58\x00\x59\x00\x18\x00\x5b\x00\x5c\x00\x47\x00\x1c\x00\x1d\x00\x24\x00\x19\x00\x20\x00\x21\x00\x8d\x00\x23\x00\x24\x00\x19\x00\x92\x00\x93\x00\x72\x00\x19\x00\x74\x00\x2e\x00\x2f\x00\x72\x00\x22\x00\x71\x00\x95\x00\x73\x00\x22\x00\x75\x00\x76\x00\x9a\x00\x80\x00\x81\x00\x39\x00\x83\x00\x81\x00\x80\x00\x81\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x19\x00\x75\x00\x8b\x00\x8c\x00\x92\x00\x93\x00\x29\x00\x2a\x00\x4f\x00\x22\x00\x2d\x00\x2e\x00\x2f\x00\x81\x00\x95\x00\x56\x00\x18\x00\x58\x00\x59\x00\x9a\x00\x5b\x00\x5c\x00\x1b\x00\x1f\x00\x20\x00\x21\x00\x42\x00\x23\x00\x24\x00\x22\x00\x92\x00\x93\x00\x2b\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x30\x00\x73\x00\x32\x00\x33\x00\x22\x00\x71\x00\x22\x00\x73\x00\x26\x00\x75\x00\x76\x00\x27\x00\x2a\x00\x7f\x00\x80\x00\x81\x00\x8f\x00\x2d\x00\x81\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x19\x00\x88\x00\x1e\x00\x8f\x00\x49\x00\x4a\x00\x22\x00\x8b\x00\x8c\x00\x22\x00\x4f\x00\x92\x00\x93\x00\x94\x00\x1c\x00\x96\x00\x1e\x00\x56\x00\x18\x00\x58\x00\x59\x00\x5d\x00\x5b\x00\x5c\x00\x13\x00\x1f\x00\x20\x00\x21\x00\x17\x00\x23\x00\x24\x00\x29\x00\x2a\x00\x81\x00\x06\x00\x2d\x00\x2e\x00\x2f\x00\x19\x00\x31\x00\x32\x00\x3f\x00\x40\x00\x92\x00\x71\x00\x75\x00\x73\x00\x22\x00\x75\x00\x76\x00\x92\x00\x93\x00\x3f\x00\x40\x00\x3f\x00\x40\x00\x04\x00\x81\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x19\x00\x88\x00\x25\x00\x8c\x00\x49\x00\x4a\x00\x19\x00\x8b\x00\x8c\x00\x22\x00\x4f\x00\x92\x00\x93\x00\x30\x00\x31\x00\x22\x00\x2a\x00\x56\x00\x2c\x00\x58\x00\x59\x00\x18\x00\x5b\x00\x5c\x00\x96\x00\x1c\x00\x1d\x00\x99\x00\x04\x00\x20\x00\x21\x00\x95\x00\x23\x00\x24\x00\x29\x00\x2a\x00\x9a\x00\x8c\x00\x2d\x00\x2e\x00\x2f\x00\x8d\x00\x31\x00\x32\x00\x71\x00\x4c\x00\x73\x00\x22\x00\x75\x00\x76\x00\x6f\x00\x70\x00\x27\x00\x86\x00\x73\x00\x88\x00\x81\x00\x8a\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x1c\x00\x95\x00\x1e\x00\x7f\x00\x80\x00\x81\x00\x9a\x00\x8b\x00\x8c\x00\x48\x00\x92\x00\x93\x00\x95\x00\x4f\x00\x95\x00\x5d\x00\x3c\x00\x9a\x00\x42\x00\x9a\x00\x56\x00\x41\x00\x58\x00\x59\x00\x18\x00\x5b\x00\x5c\x00\x96\x00\x1c\x00\x1d\x00\x99\x00\x96\x00\x20\x00\x21\x00\x99\x00\x23\x00\x24\x00\x29\x00\x2a\x00\x11\x00\x12\x00\x2d\x00\x2e\x00\x2f\x00\x8d\x00\x31\x00\x32\x00\x71\x00\x10\x00\x73\x00\x85\x00\x75\x00\x76\x00\x88\x00\x84\x00\x85\x00\x86\x00\x8e\x00\x88\x00\x81\x00\x8a\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x61\x00\x62\x00\x8b\x00\x8c\x00\x96\x00\x92\x00\x93\x00\x99\x00\x4f\x00\x88\x00\x06\x00\x07\x00\x08\x00\x09\x00\x28\x00\x56\x00\x2a\x00\x58\x00\x59\x00\x18\x00\x5b\x00\x5c\x00\x96\x00\x1c\x00\x1d\x00\x99\x00\x4d\x00\x20\x00\x21\x00\x8f\x00\x23\x00\x24\x00\x26\x00\x29\x00\x2a\x00\x80\x00\x81\x00\x2d\x00\x2e\x00\x2f\x00\x24\x00\x25\x00\x71\x00\x27\x00\x73\x00\x26\x00\x75\x00\x76\x00\x70\x00\x05\x00\x06\x00\x73\x00\x30\x00\x31\x00\x81\x00\x8d\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x04\x00\x05\x00\x7f\x00\x80\x00\x81\x00\x04\x00\x05\x00\x8b\x00\x8c\x00\x6e\x00\x92\x00\x93\x00\x44\x00\x4f\x00\x8c\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x8c\x00\x56\x00\x18\x00\x58\x00\x59\x00\x19\x00\x5b\x00\x5c\x00\x88\x00\x1f\x00\x20\x00\x21\x00\x0f\x00\x23\x00\x24\x00\x8c\x00\x29\x00\x2a\x00\x8c\x00\x8c\x00\x2d\x00\x2e\x00\x2f\x00\x8c\x00\x31\x00\x32\x00\x80\x00\x81\x00\x71\x00\x83\x00\x73\x00\x8f\x00\x75\x00\x76\x00\x8d\x00\x77\x00\x8c\x00\x8c\x00\x7a\x00\x8c\x00\x7c\x00\x81\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x8c\x00\x13\x00\x85\x00\x15\x00\x16\x00\x88\x00\x8c\x00\x8b\x00\x8c\x00\x9b\x00\x4f\x00\x92\x00\x93\x00\x2e\x00\x2f\x00\x8c\x00\x22\x00\x56\x00\x18\x00\x58\x00\x59\x00\x14\x00\x5b\x00\x5c\x00\x14\x00\x1f\x00\x20\x00\x21\x00\x1e\x00\x23\x00\x24\x00\x22\x00\x29\x00\x2a\x00\x81\x00\x1e\x00\x2d\x00\x2e\x00\x2f\x00\x1d\x00\x31\x00\x32\x00\x14\x00\x04\x00\x71\x00\x19\x00\x73\x00\x14\x00\x75\x00\x76\x00\x19\x00\x92\x00\x93\x00\x68\x00\x69\x00\x6a\x00\x19\x00\x81\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x1d\x00\x45\x00\x46\x00\x47\x00\x50\x00\x51\x00\x52\x00\x8b\x00\x8c\x00\x1d\x00\x4f\x00\x92\x00\x93\x00\x2e\x00\x2f\x00\x14\x00\x2f\x00\x56\x00\x18\x00\x58\x00\x59\x00\x25\x00\x5b\x00\x5c\x00\x19\x00\x1f\x00\x20\x00\x21\x00\x19\x00\x23\x00\x24\x00\x21\x00\x18\x00\x81\x00\x2b\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x30\x00\x88\x00\x32\x00\x21\x00\x2a\x00\x71\x00\x1e\x00\x73\x00\x2a\x00\x75\x00\x76\x00\x92\x00\x93\x00\x94\x00\x51\x00\x28\x00\x27\x00\x41\x00\x81\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x18\x00\x1d\x00\x3d\x00\x2d\x00\x2e\x00\x2f\x00\x21\x00\x8b\x00\x8c\x00\x19\x00\x4f\x00\x92\x00\x93\x00\x18\x00\x13\x00\x38\x00\x22\x00\x56\x00\x18\x00\x58\x00\x59\x00\x1d\x00\x5b\x00\x5c\x00\x22\x00\x1f\x00\x20\x00\x21\x00\x1c\x00\x23\x00\x24\x00\x2e\x00\x2f\x00\x81\x00\x2b\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x30\x00\x27\x00\x32\x00\x27\x00\x27\x00\x71\x00\x75\x00\x73\x00\x27\x00\x75\x00\x76\x00\x92\x00\x93\x00\x3b\x00\x02\x00\x22\x00\x24\x00\x19\x00\x81\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x24\x00\x2f\x00\x25\x00\x2c\x00\x1d\x00\x51\x00\x22\x00\x8b\x00\x8c\x00\x26\x00\x4f\x00\x92\x00\x93\x00\x22\x00\x22\x00\x1c\x00\x28\x00\x56\x00\x18\x00\x58\x00\x59\x00\x1e\x00\x5b\x00\x5c\x00\x81\x00\x1f\x00\x20\x00\x21\x00\x1d\x00\x23\x00\x24\x00\x51\x00\x2b\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x30\x00\x28\x00\x32\x00\x38\x00\x92\x00\x93\x00\x22\x00\x71\x00\x75\x00\x73\x00\x19\x00\x75\x00\x76\x00\x32\x00\x81\x00\x42\x00\x1d\x00\x24\x00\x51\x00\x18\x00\x81\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x28\x00\x19\x00\x28\x00\x19\x00\x19\x00\x92\x00\x93\x00\x8b\x00\x8c\x00\x19\x00\x4f\x00\x92\x00\x93\x00\x1b\x00\x06\x00\x07\x00\x22\x00\x56\x00\x21\x00\x58\x00\x59\x00\x51\x00\x5b\x00\x5c\x00\x2b\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x30\x00\x25\x00\x32\x00\x33\x00\x2b\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x30\x00\x1d\x00\x32\x00\x1e\x00\x2b\x00\x75\x00\x71\x00\x25\x00\x73\x00\x1c\x00\x75\x00\x76\x00\x1d\x00\x2d\x00\x2e\x00\x2f\x00\x2a\x00\x81\x00\x30\x00\x31\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x1d\x00\x4d\x00\x2a\x00\x42\x00\x19\x00\x3e\x00\x24\x00\x8b\x00\x8c\x00\x92\x00\x93\x00\x5d\x00\x2b\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x30\x00\x1d\x00\x32\x00\x2b\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x30\x00\x28\x00\x32\x00\x24\x00\x27\x00\x24\x00\x1d\x00\x0a\x00\x19\x00\x19\x00\x75\x00\x2b\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x30\x00\x19\x00\x32\x00\x75\x00\x19\x00\x19\x00\x81\x00\x19\x00\x21\x00\x19\x00\x85\x00\x22\x00\x06\x00\x88\x00\x08\x00\x81\x00\x1b\x00\x2b\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x18\x00\x92\x00\x93\x00\x33\x00\x2b\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x81\x00\x92\x00\x93\x00\x33\x00\x2d\x00\x2b\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x1d\x00\x52\x00\x25\x00\x4a\x00\x75\x00\x27\x00\x2f\x00\x92\x00\x93\x00\x2d\x00\x2e\x00\x2f\x00\x75\x00\x30\x00\x31\x00\x04\x00\x81\x00\x2b\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x1d\x00\x1d\x00\x81\x00\x2e\x00\x2f\x00\x1c\x00\x75\x00\x22\x00\x2d\x00\x2e\x00\x2f\x00\x92\x00\x93\x00\x32\x00\x1c\x00\x1e\x00\x53\x00\x13\x00\x81\x00\x92\x00\x93\x00\x3a\x00\x3b\x00\x3c\x00\x17\x00\x3e\x00\x48\x00\xff\xff\x75\x00\x2d\x00\x2e\x00\x2f\x00\x06\x00\x2e\x00\x2f\x00\x92\x00\x93\x00\x75\x00\x2e\x00\x2f\x00\x81\x00\xff\xff\x3a\x00\x3b\x00\x3c\x00\xff\xff\x3e\x00\x75\x00\xff\xff\x81\x00\xff\xff\x19\x00\xff\xff\x06\x00\x07\x00\x08\x00\x09\x00\x92\x00\x93\x00\x81\x00\x22\x00\xff\xff\xff\xff\x25\x00\xff\xff\xff\xff\x92\x00\x93\x00\xff\xff\x75\x00\x2c\x00\x81\x00\xff\xff\xff\xff\x30\x00\x31\x00\x92\x00\x93\x00\xff\xff\x74\x00\xff\xff\x81\x00\xff\xff\x24\x00\x25\x00\xff\xff\x81\x00\xff\xff\x92\x00\x93\x00\xff\xff\xff\xff\x81\x00\xff\xff\x83\x00\x30\x00\x31\x00\xff\xff\x92\x00\x93\x00\x74\x00\xff\xff\xff\xff\x92\x00\x93\x00\xff\xff\xff\xff\xff\xff\xff\xff\x92\x00\x93\x00\xff\xff\xff\xff\x81\x00\xff\xff\x83\x00\x81\x00\xff\xff\xff\xff\xff\xff\xff\xff\x81\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x92\x00\x93\x00\xff\xff\x92\x00\x93\x00\xff\xff\xff\xff\xff\xff\x92\x00\x93\x00\x01\x00\x02\x00\x03\x00\x04\x00\x05\x00\xff\xff\xff\xff\xff\xff\xff\xff\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x14\x00\x15\x00\x16\x00\xff\xff\x18\x00\xff\xff\x1a\x00\xff\xff\x1c\x00\xff\xff\xff\xff\x78\x00\x20\x00\xff\xff\x7b\x00\x23\x00\x7d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x84\x00\x85\x00\x86\x00\x2e\x00\x88\x00\x30\x00\x8a\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\xff\xff\x39\x00\x3a\x00\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\x41\x00\xff\xff\x43\x00\x44\x00\x45\x00\x46\x00\xff\xff\xff\xff\x49\x00\xff\xff\x4b\x00\x4c\x00\xff\xff\x4e\x00\x4f\x00\x50\x00\xff\xff\x52\x00\x01\x00\x02\x00\x03\x00\x04\x00\x05\x00\xff\xff\xff\xff\xff\xff\xff\xff\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x14\x00\x15\x00\x16\x00\xff\xff\x18\x00\xff\xff\x1a\x00\xff\xff\x1c\x00\xff\xff\xff\xff\x78\x00\x20\x00\xff\xff\x7b\x00\x23\x00\x7d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x84\x00\x85\x00\x86\x00\x2e\x00\x88\x00\x30\x00\x8a\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\xff\xff\x39\x00\x3a\x00\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\xff\xff\xff\xff\x43\x00\x44\x00\x45\x00\x46\x00\xff\xff\xff\xff\x49\x00\xff\xff\x4b\x00\x4c\x00\xff\xff\x4e\x00\x4f\x00\x50\x00\xff\xff\x52\x00\x01\x00\x02\x00\x03\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x18\x00\x19\x00\x1a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x20\x00\xff\xff\x22\x00\x23\x00\x24\x00\x25\x00\xff\xff\xff\xff\xff\xff\x29\x00\xff\xff\xff\xff\xff\xff\xff\xff\x2e\x00\xff\xff\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\xff\xff\xff\xff\xff\xff\xff\xff\x39\x00\x3a\x00\xff\xff\x3c\x00\x3d\x00\xff\xff\x3f\x00\x40\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x47\x00\xff\xff\xff\xff\xff\xff\x4b\x00\x4c\x00\xff\xff\x4e\x00\xff\xff\x50\x00\xff\xff\x52\x00\x01\x00\x02\x00\x03\x00\x04\x00\x05\x00\xff\xff\xff\xff\xff\xff\xff\xff\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x18\x00\xff\xff\x1a\x00\xff\xff\x1c\x00\xff\xff\x1e\x00\x78\x00\x20\x00\xff\xff\x7b\x00\x23\x00\x7d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x84\x00\x85\x00\x86\x00\x2e\x00\x88\x00\x30\x00\x8a\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\xff\xff\x39\x00\x3a\x00\xff\xff\x3c\x00\x3d\x00\x3e\x00\x3f\x00\xff\xff\x41\x00\xff\xff\xff\xff\xff\xff\xff\xff\x46\x00\xff\xff\xff\xff\x49\x00\xff\xff\x4b\x00\x4c\x00\xff\xff\x4e\x00\x4f\x00\x50\x00\xff\xff\x52\x00\x01\x00\x02\x00\x03\x00\x04\x00\x05\x00\xff\xff\xff\xff\xff\xff\xff\xff\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x14\x00\x15\x00\x16\x00\xff\xff\x18\x00\xff\xff\x1a\x00\xff\xff\x1c\x00\xff\xff\xff\xff\x78\x00\x20\x00\xff\xff\x7b\x00\x23\x00\x7d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x84\x00\x85\x00\x86\x00\x2e\x00\x88\x00\x30\x00\x8a\x00\x32\x00\x33\x00\x34\x00\xff\xff\xff\xff\xff\xff\xff\xff\x39\x00\x3a\x00\xff\xff\x3c\x00\x3d\x00\xff\xff\x3f\x00\xff\xff\xff\xff\xff\xff\x43\x00\x44\x00\x45\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4b\x00\x4c\x00\xff\xff\x4e\x00\xff\xff\x50\x00\xff\xff\x52\x00\x01\x00\x02\x00\x03\x00\x04\x00\x05\x00\xff\xff\xff\xff\xff\xff\xff\xff\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x18\x00\xff\xff\x1a\x00\xff\xff\x1c\x00\xff\xff\xff\xff\xff\xff\x20\x00\xff\xff\xff\xff\x23\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x29\x00\xff\xff\xff\xff\xff\xff\xff\xff\x2e\x00\xff\xff\x30\x00\xff\xff\x32\x00\x33\x00\x34\x00\xff\xff\xff\xff\xff\xff\xff\xff\x39\x00\x3a\x00\xff\xff\x3c\x00\x3d\x00\xff\xff\x3f\x00\x40\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x47\x00\xff\xff\xff\xff\xff\xff\x4b\x00\x4c\x00\xff\xff\x4e\x00\xff\xff\x50\x00\xff\xff\x52\x00\x01\x00\x02\x00\x03\x00\x04\x00\x05\x00\xff\xff\xff\xff\xff\xff\xff\xff\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x18\x00\x19\x00\x1a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x20\x00\xff\xff\xff\xff\x23\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x29\x00\xff\xff\xff\xff\xff\xff\xff\xff\x2e\x00\xff\xff\x30\x00\xff\xff\x32\x00\x33\x00\x34\x00\xff\xff\xff\xff\xff\xff\xff\xff\x39\x00\x3a\x00\xff\xff\x3c\x00\x3d\x00\xff\xff\x3f\x00\x40\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x47\x00\xff\xff\xff\xff\xff\xff\x4b\x00\x4c\x00\xff\xff\x4e\x00\xff\xff\x50\x00\xff\xff\x52\x00\x01\x00\x02\x00\x03\x00\x04\x00\x05\x00\xff\xff\xff\xff\xff\xff\xff\xff\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x18\x00\xff\xff\x1a\x00\xff\xff\x1c\x00\xff\xff\xff\xff\xff\xff\x20\x00\xff\xff\xff\xff\x23\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x29\x00\xff\xff\xff\xff\xff\xff\xff\xff\x2e\x00\xff\xff\x30\x00\xff\xff\x32\x00\x33\x00\x34\x00\xff\xff\xff\xff\xff\xff\xff\xff\x39\x00\x3a\x00\xff\xff\x3c\x00\x3d\x00\xff\xff\x3f\x00\x40\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x47\x00\xff\xff\xff\xff\xff\xff\x4b\x00\x4c\x00\xff\xff\x4e\x00\xff\xff\x50\x00\xff\xff\x52\x00\x01\x00\x02\x00\x03\x00\x04\x00\x05\x00\xff\xff\xff\xff\xff\xff\xff\xff\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x18\x00\xff\xff\x1a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x20\x00\x21\x00\xff\xff\x23\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x29\x00\xff\xff\xff\xff\xff\xff\xff\xff\x2e\x00\xff\xff\x30\x00\xff\xff\x32\x00\x33\x00\x34\x00\xff\xff\xff\xff\xff\xff\xff\xff\x39\x00\x3a\x00\xff\xff\x3c\x00\x3d\x00\xff\xff\x3f\x00\x40\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x47\x00\xff\xff\xff\xff\xff\xff\x4b\x00\x4c\x00\xff\xff\x4e\x00\xff\xff\x50\x00\xff\xff\x52\x00\x01\x00\x02\x00\x03\x00\x04\x00\x05\x00\xff\xff\xff\xff\xff\xff\xff\xff\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x18\x00\xff\xff\x1a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x20\x00\xff\xff\xff\xff\x23\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x29\x00\xff\xff\xff\xff\xff\xff\xff\xff\x2e\x00\xff\xff\x30\x00\xff\xff\x32\x00\x33\x00\x34\x00\xff\xff\xff\xff\xff\xff\xff\xff\x39\x00\x3a\x00\xff\xff\x3c\x00\x3d\x00\xff\xff\x3f\x00\x40\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x47\x00\xff\xff\xff\xff\xff\xff\x4b\x00\x4c\x00\xff\xff\x4e\x00\xff\xff\x50\x00\xff\xff\x52\x00\x01\x00\x02\x00\x03\x00\x04\x00\x05\x00\xff\xff\xff\xff\xff\xff\xff\xff\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x18\x00\xff\xff\x1a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x20\x00\xff\xff\xff\xff\x23\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x29\x00\xff\xff\xff\xff\xff\xff\xff\xff\x2e\x00\xff\xff\x30\x00\xff\xff\x32\x00\x33\x00\x34\x00\xff\xff\xff\xff\xff\xff\xff\xff\x39\x00\x3a\x00\xff\xff\x3c\x00\x3d\x00\xff\xff\x3f\x00\x40\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x47\x00\xff\xff\xff\xff\xff\xff\x4b\x00\x4c\x00\xff\xff\x4e\x00\xff\xff\x50\x00\xff\xff\x52\x00\x01\x00\x02\x00\x03\x00\x04\x00\x05\x00\xff\xff\xff\xff\xff\xff\xff\xff\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x18\x00\xff\xff\x1a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x20\x00\xff\xff\xff\xff\x23\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x29\x00\xff\xff\xff\xff\xff\xff\xff\xff\x2e\x00\xff\xff\x30\x00\xff\xff\x32\x00\x33\x00\x34\x00\xff\xff\xff\xff\xff\xff\xff\xff\x39\x00\x3a\x00\xff\xff\x3c\x00\x3d\x00\xff\xff\x3f\x00\x40\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x47\x00\xff\xff\xff\xff\xff\xff\x4b\x00\x4c\x00\xff\xff\x4e\x00\xff\xff\x50\x00\xff\xff\x52\x00\x01\x00\x02\x00\x03\x00\x04\x00\x05\x00\xff\xff\xff\xff\xff\xff\xff\xff\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x18\x00\xff\xff\x1a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x20\x00\xff\xff\xff\xff\x23\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x29\x00\xff\xff\xff\xff\xff\xff\xff\xff\x2e\x00\xff\xff\x30\x00\xff\xff\x32\x00\x33\x00\x34\x00\xff\xff\xff\xff\xff\xff\xff\xff\x39\x00\x3a\x00\xff\xff\x3c\x00\x3d\x00\xff\xff\x3f\x00\x40\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x47\x00\xff\xff\xff\xff\xff\xff\x4b\x00\x4c\x00\xff\xff\x4e\x00\xff\xff\x50\x00\xff\xff\x52\x00\x01\x00\x02\x00\x03\x00\x04\x00\x05\x00\xff\xff\xff\xff\xff\xff\xff\xff\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x18\x00\xff\xff\x1a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x20\x00\xff\xff\xff\xff\x23\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x29\x00\xff\xff\xff\xff\xff\xff\xff\xff\x2e\x00\xff\xff\x30\x00\xff\xff\x32\x00\x33\x00\x34\x00\xff\xff\xff\xff\xff\xff\xff\xff\x39\x00\x3a\x00\xff\xff\x3c\x00\x3d\x00\xff\xff\x3f\x00\x40\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x47\x00\xff\xff\xff\xff\xff\xff\x4b\x00\x4c\x00\xff\xff\x4e\x00\xff\xff\x50\x00\xff\xff\x52\x00\x01\x00\x02\x00\x03\x00\x04\x00\x05\x00\xff\xff\xff\xff\xff\xff\xff\xff\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x18\x00\xff\xff\x1a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x20\x00\xff\xff\xff\xff\x23\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x29\x00\xff\xff\xff\xff\xff\xff\xff\xff\x2e\x00\xff\xff\x30\x00\xff\xff\x32\x00\x33\x00\x34\x00\xff\xff\xff\xff\xff\xff\xff\xff\x39\x00\x3a\x00\xff\xff\x3c\x00\x3d\x00\xff\xff\x3f\x00\x40\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x47\x00\xff\xff\xff\xff\xff\xff\x4b\x00\x4c\x00\xff\xff\x4e\x00\xff\xff\x50\x00\xff\xff\x52\x00\x01\x00\x02\x00\x03\x00\x04\x00\x05\x00\xff\xff\xff\xff\xff\xff\xff\xff\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x18\x00\xff\xff\x1a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x20\x00\xff\xff\xff\xff\x23\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x29\x00\xff\xff\xff\xff\xff\xff\xff\xff\x2e\x00\xff\xff\x30\x00\xff\xff\x32\x00\x33\x00\x34\x00\xff\xff\xff\xff\xff\xff\xff\xff\x39\x00\x3a\x00\xff\xff\x3c\x00\x3d\x00\xff\xff\x3f\x00\x40\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x47\x00\xff\xff\xff\xff\xff\xff\x4b\x00\x4c\x00\xff\xff\x4e\x00\xff\xff\x50\x00\xff\xff\x52\x00\x01\x00\x02\x00\x03\x00\x04\x00\x05\x00\xff\xff\xff\xff\xff\xff\xff\xff\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x18\x00\xff\xff\x1a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x20\x00\xff\xff\xff\xff\x23\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x29\x00\xff\xff\xff\xff\xff\xff\xff\xff\x2e\x00\xff\xff\x30\x00\xff\xff\x32\x00\x33\x00\x34\x00\xff\xff\xff\xff\xff\xff\xff\xff\x39\x00\x3a\x00\xff\xff\x3c\x00\x3d\x00\xff\xff\x3f\x00\x40\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x47\x00\xff\xff\xff\xff\xff\xff\x4b\x00\x4c\x00\xff\xff\x4e\x00\xff\xff\x50\x00\xff\xff\x52\x00\x01\x00\x02\x00\x03\x00\x04\x00\x05\x00\xff\xff\xff\xff\xff\xff\xff\xff\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x18\x00\xff\xff\x1a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x20\x00\xff\xff\xff\xff\x23\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x29\x00\xff\xff\xff\xff\xff\xff\xff\xff\x2e\x00\xff\xff\x30\x00\xff\xff\x32\x00\x33\x00\x34\x00\xff\xff\xff\xff\xff\xff\xff\xff\x39\x00\x3a\x00\xff\xff\x3c\x00\x3d\x00\xff\xff\x3f\x00\x40\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x47\x00\xff\xff\xff\xff\xff\xff\x4b\x00\x4c\x00\xff\xff\x4e\x00\xff\xff\x50\x00\xff\xff\x52\x00\x01\x00\x02\x00\x03\x00\x04\x00\x05\x00\xff\xff\xff\xff\xff\xff\xff\xff\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x18\x00\xff\xff\x1a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x20\x00\xff\xff\xff\xff\x23\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x29\x00\xff\xff\xff\xff\xff\xff\xff\xff\x2e\x00\xff\xff\x30\x00\xff\xff\x32\x00\x33\x00\x34\x00\xff\xff\xff\xff\xff\xff\xff\xff\x39\x00\x3a\x00\xff\xff\x3c\x00\x3d\x00\xff\xff\x3f\x00\x40\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x47\x00\xff\xff\xff\xff\xff\xff\x4b\x00\x4c\x00\xff\xff\x4e\x00\xff\xff\x50\x00\xff\xff\x52\x00\x01\x00\x02\x00\x03\x00\x04\x00\x05\x00\xff\xff\xff\xff\xff\xff\xff\xff\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x18\x00\xff\xff\x1a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x20\x00\xff\xff\xff\xff\x23\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x29\x00\xff\xff\xff\xff\xff\xff\xff\xff\x2e\x00\xff\xff\x30\x00\xff\xff\x32\x00\x33\x00\x34\x00\xff\xff\xff\xff\xff\xff\xff\xff\x39\x00\x3a\x00\xff\xff\x3c\x00\x3d\x00\xff\xff\x3f\x00\x40\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x47\x00\xff\xff\xff\xff\xff\xff\x4b\x00\x4c\x00\xff\xff\x4e\x00\xff\xff\x50\x00\xff\xff\x52\x00\x01\x00\x02\x00\x03\x00\x04\x00\x05\x00\xff\xff\xff\xff\xff\xff\xff\xff\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x18\x00\xff\xff\x1a\x00\xff\xff\x1c\x00\xff\xff\x1e\x00\xff\xff\x20\x00\xff\xff\xff\xff\x23\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2e\x00\xff\xff\x30\x00\xff\xff\x32\x00\x33\x00\x34\x00\xff\xff\xff\xff\xff\xff\xff\xff\x39\x00\x3a\x00\xff\xff\x3c\x00\x3d\x00\xff\xff\x3f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4b\x00\x4c\x00\xff\xff\x4e\x00\xff\xff\x50\x00\xff\xff\x52\x00\x01\x00\x02\x00\x03\x00\x04\x00\x05\x00\xff\xff\xff\xff\xff\xff\xff\xff\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x18\x00\x78\x00\x1a\x00\xff\xff\x7b\x00\xff\xff\x7d\x00\xff\xff\x20\x00\xff\xff\xff\xff\x23\x00\xff\xff\x84\x00\x85\x00\x86\x00\xff\xff\x88\x00\xff\xff\x8a\x00\xff\xff\x8c\x00\x2e\x00\xff\xff\x30\x00\xff\xff\x32\x00\x33\x00\x34\x00\xff\xff\xff\xff\xff\xff\x01\x00\x39\x00\x3a\x00\x04\x00\x3c\x00\x3d\x00\xff\xff\x3f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4b\x00\x4c\x00\xff\xff\x4e\x00\x18\x00\x50\x00\xff\xff\x52\x00\x01\x00\x02\x00\x03\x00\x04\x00\x05\x00\xff\xff\xff\xff\xff\xff\xff\xff\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\xff\xff\xff\xff\xff\xff\xff\xff\x32\x00\x18\x00\x34\x00\x1a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x3a\x00\x20\x00\x3c\x00\x3d\x00\x23\x00\x3f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2c\x00\xff\xff\x2e\x00\xff\xff\x4b\x00\x4c\x00\x32\x00\x4e\x00\x34\x00\x50\x00\xff\xff\x52\x00\x01\x00\xff\xff\x3a\x00\xff\xff\x3c\x00\x3d\x00\xff\xff\x3f\x00\xff\xff\xff\xff\xff\xff\xff\xff\x0d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4b\x00\x4c\x00\xff\xff\x4e\x00\xff\xff\x50\x00\xff\xff\x52\x00\x01\x00\x02\x00\x03\x00\x04\x00\x05\x00\xff\xff\xff\xff\xff\xff\xff\xff\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\xff\xff\xff\xff\xff\xff\xff\xff\x32\x00\x18\x00\x34\x00\x1a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x3a\x00\x20\x00\x3c\x00\x3d\x00\x23\x00\x3f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x06\x00\xff\xff\x08\x00\x2e\x00\xff\xff\x4b\x00\x4c\x00\x32\x00\x4e\x00\x34\x00\x50\x00\xff\xff\x52\x00\xff\xff\xff\xff\x3a\x00\xff\xff\x3c\x00\x3d\x00\x19\x00\x3f\x00\x01\x00\x02\x00\xff\xff\x04\x00\x05\x00\x06\x00\x07\x00\x22\x00\xff\xff\xff\xff\x25\x00\x4b\x00\x4c\x00\xff\xff\x4e\x00\xff\xff\x50\x00\x2c\x00\x52\x00\xff\xff\xff\xff\x30\x00\x31\x00\x18\x00\x19\x00\x1a\x00\xff\xff\x06\x00\x07\x00\x08\x00\x09\x00\x20\x00\xff\xff\x22\x00\xff\xff\xff\xff\x25\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2c\x00\xff\xff\xff\xff\x19\x00\x30\x00\x31\x00\x32\x00\xff\xff\x34\x00\xff\xff\xff\xff\xff\xff\x22\x00\xff\xff\x3a\x00\x25\x00\x3c\x00\x3d\x00\xff\xff\x3f\x00\x01\x00\x02\x00\xff\xff\x04\x00\x05\x00\x06\x00\x30\x00\x31\x00\xff\xff\xff\xff\xff\xff\x4b\x00\x4c\x00\xff\xff\x4e\x00\xff\xff\x50\x00\xff\xff\x52\x00\xff\xff\xff\xff\xff\xff\xff\xff\x18\x00\x19\x00\x1a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x20\x00\xff\xff\x22\x00\xff\xff\xff\xff\x25\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2c\x00\xff\xff\xff\xff\xff\xff\x30\x00\x31\x00\x32\x00\xff\xff\x34\x00\x06\x00\x07\x00\x08\x00\x09\x00\xff\xff\x3a\x00\xff\xff\x3c\x00\x3d\x00\x01\x00\x3f\x00\xff\xff\x04\x00\x05\x00\x06\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4b\x00\x4c\x00\xff\xff\x4e\x00\xff\xff\x50\x00\x14\x00\x52\x00\x24\x00\x25\x00\x18\x00\x27\x00\x1a\x00\xff\xff\xff\xff\x2b\x00\xff\xff\xff\xff\x20\x00\xff\xff\x30\x00\x31\x00\x24\x00\x25\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2f\x00\x30\x00\x31\x00\x32\x00\xff\xff\x34\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3a\x00\xff\xff\x3c\x00\x01\x00\xff\xff\x3f\x00\x04\x00\x05\x00\x06\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4b\x00\x4c\x00\xff\xff\x4e\x00\xff\xff\x50\x00\xff\xff\x52\x00\xff\xff\x18\x00\xff\xff\x1a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x20\x00\xff\xff\xff\xff\xff\xff\x24\x00\x25\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x2c\x00\xff\xff\xff\xff\x2f\x00\x30\x00\x31\x00\x32\x00\xff\xff\x34\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3a\x00\xff\xff\x3c\x00\xff\xff\x01\x00\x3f\x00\xff\xff\x04\x00\x05\x00\x06\x00\x5b\x00\x5c\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4b\x00\x4c\x00\xff\xff\x4e\x00\xff\xff\x50\x00\x14\x00\x52\x00\xff\xff\xff\xff\x18\x00\xff\xff\x1a\x00\xff\xff\xff\xff\x71\x00\xff\xff\x73\x00\x20\x00\x75\x00\x76\x00\xff\xff\x24\x00\x25\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x30\x00\x31\x00\x32\x00\xff\xff\x34\x00\xff\xff\xff\xff\x8b\x00\xff\xff\xff\xff\x3a\x00\xff\xff\x3c\x00\x01\x00\xff\xff\x3f\x00\x04\x00\x05\x00\x06\x00\xff\xff\xff\xff\xff\xff\x01\x00\xff\xff\x03\x00\x04\x00\x05\x00\x4b\x00\x4c\x00\xff\xff\x4e\x00\xff\xff\x50\x00\xff\xff\x52\x00\xff\xff\x18\x00\xff\xff\x1a\x00\xff\xff\x13\x00\xff\xff\x15\x00\x16\x00\x20\x00\x18\x00\xff\xff\xff\xff\x24\x00\x25\x00\xff\xff\xff\xff\xff\xff\x20\x00\xff\xff\xff\xff\x2c\x00\xff\xff\xff\xff\xff\xff\x30\x00\x31\x00\x32\x00\xff\xff\x34\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3a\x00\x32\x00\x3c\x00\x34\x00\xff\xff\x3f\x00\xff\xff\xff\xff\xff\xff\x3a\x00\xff\xff\x3c\x00\x3d\x00\xff\xff\x3f\x00\xff\xff\xff\xff\x4b\x00\x4c\x00\xff\xff\x4e\x00\xff\xff\x50\x00\x48\x00\x52\x00\xff\xff\x4b\x00\x4c\x00\xff\xff\x4e\x00\xff\xff\x50\x00\x01\x00\x52\x00\xff\xff\x04\x00\x05\x00\xff\xff\x07\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x18\x00\xff\xff\x1a\x00\x59\x00\xff\xff\x5b\x00\x5c\x00\xff\xff\x20\x00\xff\xff\xff\xff\xff\xff\x24\x00\xff\xff\xff\xff\x01\x00\x02\x00\xff\xff\x04\x00\x05\x00\xff\xff\xff\xff\xff\xff\x2f\x00\xff\xff\x31\x00\x32\x00\x71\x00\x34\x00\x73\x00\xff\xff\x75\x00\x76\x00\xff\xff\x3a\x00\xff\xff\x3c\x00\xff\xff\x18\x00\x3f\x00\x1a\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x20\x00\xff\xff\xff\xff\xff\xff\xff\xff\x4b\x00\x4c\x00\x8b\x00\x4e\x00\xff\xff\x50\x00\xff\xff\x52\x00\xff\xff\xff\xff\xff\xff\xff\xff\x31\x00\x32\x00\xff\xff\x34\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3a\x00\xff\xff\x3c\x00\x3d\x00\x01\x00\x3f\x00\xff\xff\x04\x00\x05\x00\xff\xff\x07\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4b\x00\x4c\x00\xff\xff\x4e\x00\xff\xff\x50\x00\xff\xff\x52\x00\xff\xff\xff\xff\x18\x00\xff\xff\x1a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x20\x00\xff\xff\xff\xff\xff\xff\x24\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x01\x00\xff\xff\x03\x00\x04\x00\x05\x00\xff\xff\xff\xff\x31\x00\x32\x00\xff\xff\x34\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3a\x00\xff\xff\x3c\x00\xff\xff\xff\xff\x3f\x00\xff\xff\x18\x00\x19\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x20\x00\xff\xff\x4b\x00\x4c\x00\xff\xff\x4e\x00\x26\x00\x50\x00\xff\xff\x52\x00\x01\x00\x02\x00\xff\xff\x04\x00\x05\x00\xff\xff\xff\xff\xff\xff\x32\x00\xff\xff\x34\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3a\x00\xff\xff\x3c\x00\x3d\x00\xff\xff\x3f\x00\xff\xff\x18\x00\xff\xff\x1a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x20\x00\xff\xff\x4b\x00\x4c\x00\xff\xff\x4e\x00\xff\xff\x50\x00\xff\xff\x52\x00\x01\x00\x02\x00\xff\xff\x04\x00\x05\x00\xff\xff\xff\xff\xff\xff\x32\x00\xff\xff\x34\x00\xff\xff\xff\xff\xff\xff\x01\x00\xff\xff\x3a\x00\xff\xff\x3c\x00\x3d\x00\xff\xff\x3f\x00\xff\xff\x18\x00\xff\xff\x1a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x20\x00\x21\x00\x4b\x00\x4c\x00\xff\xff\x4e\x00\x18\x00\x50\x00\xff\xff\x52\x00\x01\x00\x02\x00\xff\xff\x04\x00\x05\x00\xff\xff\xff\xff\xff\xff\x32\x00\xff\xff\x34\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3a\x00\xff\xff\x3c\x00\xff\xff\xff\xff\x3f\x00\x32\x00\x18\x00\x34\x00\x1a\x00\xff\xff\xff\xff\xff\xff\xff\xff\x3a\x00\x20\x00\x3c\x00\x4b\x00\x4c\x00\x3f\x00\x4e\x00\xff\xff\x50\x00\xff\xff\x52\x00\x01\x00\xff\xff\xff\xff\x04\x00\x05\x00\xff\xff\x4b\x00\x4c\x00\x32\x00\x4e\x00\x34\x00\x50\x00\xff\xff\x52\x00\xff\xff\xff\xff\x3a\x00\xff\xff\x3c\x00\x3d\x00\xff\xff\x3f\x00\xff\xff\x18\x00\xff\xff\x1a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x20\x00\xff\xff\x4b\x00\x4c\x00\xff\xff\x4e\x00\xff\xff\x50\x00\xff\xff\x52\x00\x01\x00\xff\xff\xff\xff\x04\x00\x05\x00\xff\xff\xff\xff\x31\x00\x32\x00\xff\xff\x34\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3a\x00\xff\xff\x3c\x00\xff\xff\xff\xff\x3f\x00\xff\xff\x18\x00\xff\xff\x1a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x20\x00\xff\xff\x4b\x00\x4c\x00\xff\xff\x4e\x00\xff\xff\x50\x00\xff\xff\x52\x00\x01\x00\xff\xff\xff\xff\x04\x00\x05\x00\xff\xff\xff\xff\x31\x00\x32\x00\xff\xff\x34\x00\xff\xff\xff\xff\xff\xff\x01\x00\xff\xff\x3a\x00\xff\xff\x3c\x00\xff\xff\xff\xff\x3f\x00\xff\xff\x18\x00\xff\xff\x1a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x20\x00\xff\xff\x4b\x00\x4c\x00\xff\xff\x4e\x00\x18\x00\x50\x00\xff\xff\x52\x00\x01\x00\xff\xff\x03\x00\x04\x00\x05\x00\xff\xff\xff\xff\x31\x00\x32\x00\xff\xff\x34\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3a\x00\xff\xff\x3c\x00\xff\xff\xff\xff\x3f\x00\x32\x00\x18\x00\x34\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3a\x00\x20\x00\x3c\x00\x4b\x00\x4c\x00\x3f\x00\x4e\x00\xff\xff\x50\x00\xff\xff\x52\x00\x01\x00\xff\xff\xff\xff\x04\x00\x05\x00\xff\xff\x4b\x00\x4c\x00\x32\x00\x4e\x00\x34\x00\x50\x00\xff\xff\x52\x00\xff\xff\xff\xff\x3a\x00\xff\xff\x3c\x00\x3d\x00\xff\xff\x3f\x00\xff\xff\x18\x00\xff\xff\x1a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x20\x00\xff\xff\x4b\x00\x4c\x00\xff\xff\x4e\x00\xff\xff\x50\x00\xff\xff\x52\x00\x01\x00\xff\xff\xff\xff\x04\x00\x05\x00\xff\xff\xff\xff\x31\x00\x32\x00\xff\xff\x34\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3a\x00\xff\xff\x3c\x00\xff\xff\xff\xff\x3f\x00\xff\xff\x18\x00\xff\xff\x1a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x20\x00\xff\xff\x4b\x00\x4c\x00\xff\xff\x4e\x00\xff\xff\x50\x00\xff\xff\x52\x00\x01\x00\x02\x00\xff\xff\x04\x00\x05\x00\xff\xff\xff\xff\xff\xff\x32\x00\xff\xff\x34\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3a\x00\xff\xff\x3c\x00\x3d\x00\xff\xff\x3f\x00\xff\xff\x18\x00\xff\xff\x1a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x20\x00\xff\xff\x4b\x00\x4c\x00\xff\xff\x4e\x00\xff\xff\x50\x00\xff\xff\x52\x00\x01\x00\xff\xff\xff\xff\x04\x00\x05\x00\xff\xff\xff\xff\xff\xff\x32\x00\xff\xff\x34\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3a\x00\xff\xff\x3c\x00\xff\xff\xff\xff\x3f\x00\xff\xff\x18\x00\xff\xff\x1a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x20\x00\xff\xff\x4b\x00\x4c\x00\xff\xff\x4e\x00\xff\xff\x50\x00\xff\xff\x52\x00\x01\x00\x02\x00\xff\xff\x04\x00\x05\x00\xff\xff\xff\xff\xff\xff\x32\x00\xff\xff\x34\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3a\x00\xff\xff\x3c\x00\x3d\x00\xff\xff\x3f\x00\xff\xff\x18\x00\xff\xff\x1a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x20\x00\xff\xff\x4b\x00\x4c\x00\xff\xff\x4e\x00\xff\xff\x50\x00\xff\xff\x52\x00\x01\x00\xff\xff\xff\xff\x04\x00\x05\x00\xff\xff\xff\xff\xff\xff\x32\x00\xff\xff\x34\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3a\x00\xff\xff\x3c\x00\xff\xff\xff\xff\x3f\x00\xff\xff\x18\x00\xff\xff\x1a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x20\x00\xff\xff\x4b\x00\x4c\x00\xff\xff\x4e\x00\xff\xff\x50\x00\xff\xff\x52\x00\x01\x00\x02\x00\xff\xff\x04\x00\x05\x00\xff\xff\xff\xff\xff\xff\x32\x00\xff\xff\x34\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3a\x00\xff\xff\x3c\x00\x3d\x00\xff\xff\x3f\x00\xff\xff\x18\x00\xff\xff\x1a\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x20\x00\xff\xff\x4b\x00\x4c\x00\xff\xff\x4e\x00\xff\xff\x50\x00\xff\xff\x52\x00\x01\x00\xff\xff\xff\xff\x04\x00\x05\x00\xff\xff\xff\xff\xff\xff\x32\x00\xff\xff\x34\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3a\x00\xff\xff\x3c\x00\xff\xff\xff\xff\x3f\x00\xff\xff\x18\x00\xff\xff\x1a\x00\xff\xff\xff\xff\xff\xff\x01\x00\xff\xff\x20\x00\x04\x00\x4b\x00\x4c\x00\xff\xff\x4e\x00\xff\xff\x50\x00\xff\xff\x52\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x32\x00\xff\xff\x34\x00\x18\x00\x19\x00\xff\xff\xff\xff\xff\xff\x3a\x00\xff\xff\x3c\x00\xff\xff\xff\xff\x3f\x00\xff\xff\xff\xff\xff\xff\x26\x00\x01\x00\xff\xff\xff\xff\x04\x00\x05\x00\xff\xff\xff\xff\x4b\x00\x4c\x00\xff\xff\x4e\x00\x32\x00\x50\x00\x34\x00\x52\x00\xff\xff\xff\xff\xff\xff\xff\xff\x3a\x00\xff\xff\x3c\x00\x3d\x00\x18\x00\x3f\x00\x1a\x00\xff\xff\x01\x00\xff\xff\xff\xff\x04\x00\x20\x00\xff\xff\xff\xff\xff\xff\xff\xff\x4b\x00\x4c\x00\xff\xff\x4e\x00\xff\xff\x50\x00\xff\xff\x52\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x32\x00\x18\x00\x34\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3a\x00\x20\x00\x3c\x00\xff\xff\x01\x00\x3f\x00\x03\x00\x04\x00\x05\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4b\x00\x4c\x00\x32\x00\x4e\x00\x34\x00\x50\x00\xff\xff\x52\x00\xff\xff\xff\xff\x3a\x00\xff\xff\x3c\x00\x3d\x00\x01\x00\x3f\x00\x03\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4b\x00\x4c\x00\xff\xff\x4e\x00\xff\xff\x50\x00\xff\xff\x52\x00\xff\xff\x32\x00\x18\x00\x34\x00\xff\xff\xff\xff\xff\xff\xff\xff\x1e\x00\x3a\x00\xff\xff\x3c\x00\x3d\x00\x01\x00\x3f\x00\x03\x00\x04\x00\x05\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4b\x00\x4c\x00\x32\x00\x4e\x00\x34\x00\x50\x00\xff\xff\x52\x00\xff\xff\xff\xff\x3a\x00\xff\xff\x3c\x00\x3d\x00\x01\x00\x3f\x00\x03\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4b\x00\x4c\x00\xff\xff\x4e\x00\xff\xff\x50\x00\xff\xff\x52\x00\x01\x00\x32\x00\x18\x00\x34\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3a\x00\xff\xff\x3c\x00\x3d\x00\xff\xff\x3f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x18\x00\xff\xff\xff\xff\x4b\x00\x4c\x00\x32\x00\x4e\x00\x34\x00\x50\x00\xff\xff\x52\x00\x01\x00\xff\xff\x3a\x00\x04\x00\x3c\x00\x3d\x00\xff\xff\x3f\x00\xff\xff\x2c\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x32\x00\xff\xff\x34\x00\xff\xff\x4b\x00\x4c\x00\xff\xff\x4e\x00\x3a\x00\x50\x00\x3c\x00\x52\x00\x01\x00\x3f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0d\x00\x4b\x00\x4c\x00\xff\xff\x4e\x00\xff\xff\x50\x00\xff\xff\x52\x00\xff\xff\x32\x00\xff\xff\x34\x00\xff\xff\xff\xff\x01\x00\xff\xff\xff\xff\x3a\x00\xff\xff\x3c\x00\x3d\x00\xff\xff\x3f\x00\xff\xff\xff\xff\xff\xff\x0d\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4b\x00\x4c\x00\x32\x00\x4e\x00\x34\x00\x50\x00\xff\xff\x52\x00\xff\xff\xff\xff\x3a\x00\xff\xff\x3c\x00\x3d\x00\xff\xff\x3f\x00\xff\xff\xff\xff\x01\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4b\x00\x4c\x00\x32\x00\x4e\x00\x34\x00\x50\x00\xff\xff\x52\x00\xff\xff\xff\xff\x3a\x00\xff\xff\x3c\x00\x3d\x00\x18\x00\x3f\x00\xff\xff\xff\xff\x01\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4b\x00\x4c\x00\xff\xff\x4e\x00\xff\xff\x50\x00\xff\xff\x52\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x32\x00\xff\xff\x34\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3a\x00\xff\xff\x3c\x00\x3d\x00\xff\xff\x3f\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4b\x00\x4c\x00\x32\x00\x4e\x00\x34\x00\x50\x00\xff\xff\x52\x00\x4e\x00\x4f\x00\x3a\x00\xff\xff\x3c\x00\x3d\x00\xff\xff\x3f\x00\x56\x00\xff\xff\x58\x00\x59\x00\xff\xff\x5b\x00\x5c\x00\xff\xff\xff\xff\xff\xff\xff\xff\x4b\x00\x4c\x00\xff\xff\x4e\x00\xff\xff\x50\x00\xff\xff\x52\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4e\x00\x4f\x00\x71\x00\xff\xff\x73\x00\xff\xff\x75\x00\x76\x00\x56\x00\xff\xff\x58\x00\x59\x00\xff\xff\x5b\x00\x5c\x00\xff\xff\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x8b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4f\x00\x71\x00\xff\xff\x73\x00\xff\xff\x75\x00\x76\x00\x56\x00\xff\xff\x58\x00\x59\x00\xff\xff\x5b\x00\x5c\x00\xff\xff\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x8b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x71\x00\xff\xff\x73\x00\xff\xff\x75\x00\x76\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x8b\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x71\x00\xff\xff\x73\x00\xff\xff\x75\x00\x76\x00\xff\xff\xff\xff\x79\x00\xff\xff\x7b\x00\xff\xff\xff\xff\x7e\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x84\x00\x85\x00\x86\x00\x87\x00\x88\x00\x89\x00\x8a\x00\x8b\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\xff\xff\x5b\x00\x5c\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x63\x00\x64\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x6b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x71\x00\xff\xff\x73\x00\xff\xff\x75\x00\x76\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x8b\x00\x5b\x00\x5c\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x63\x00\x64\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x6b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x71\x00\xff\xff\x73\x00\xff\xff\x75\x00\x76\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x8b\x00\x5b\x00\x5c\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x63\x00\x64\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x6b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x71\x00\xff\xff\x73\x00\xff\xff\x75\x00\x76\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x8b\x00\x5b\x00\x5c\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x64\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x6b\x00\xff\xff\x6d\x00\xff\xff\xff\xff\xff\xff\x71\x00\xff\xff\x73\x00\xff\xff\x75\x00\x76\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x8b\x00\x5b\x00\x5c\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x64\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x6b\x00\xff\xff\x6d\x00\xff\xff\xff\xff\xff\xff\x71\x00\xff\xff\x73\x00\xff\xff\x75\x00\x76\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x8b\x00\x5b\x00\x5c\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x63\x00\x64\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x6b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x71\x00\xff\xff\x73\x00\xff\xff\x75\x00\x76\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x8b\x00\x5b\x00\x5c\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x64\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x6b\x00\xff\xff\x6d\x00\xff\xff\xff\xff\xff\xff\x71\x00\xff\xff\x73\x00\xff\xff\x75\x00\x76\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x8b\x00\x5b\x00\x5c\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x64\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x6b\x00\xff\xff\x6d\x00\xff\xff\xff\xff\xff\xff\x71\x00\xff\xff\x73\x00\xff\xff\x75\x00\x76\x00\xff\xff\x5a\x00\x5b\x00\x5c\x00\xff\xff\xff\xff\xff\xff\xff\xff\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x8b\x00\x5b\x00\x5c\x00\xff\xff\x71\x00\xff\xff\x73\x00\xff\xff\x75\x00\x76\x00\x64\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x6b\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x71\x00\xff\xff\x73\x00\xff\xff\x75\x00\x76\x00\xff\xff\x8b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x8b\x00\x5b\x00\x5c\x00\xff\xff\xff\xff\x5f\x00\x60\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\xff\xff\x5b\x00\x5c\x00\x71\x00\x5e\x00\x73\x00\xff\xff\x75\x00\x76\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\xff\xff\x71\x00\xff\xff\x73\x00\xff\xff\x75\x00\x76\x00\x8b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x8b\x00\x5b\x00\x5c\x00\xff\xff\x5e\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\xff\xff\x5b\x00\x5c\x00\xff\xff\x71\x00\xff\xff\x73\x00\xff\xff\x75\x00\x76\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x71\x00\xff\xff\x73\x00\xff\xff\x75\x00\x76\x00\xff\xff\x8b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x8b\x00\x5b\x00\x5c\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\xff\xff\x5b\x00\x5c\x00\xff\xff\x71\x00\xff\xff\x73\x00\xff\xff\x75\x00\x76\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x71\x00\xff\xff\x73\x00\xff\xff\x75\x00\x76\x00\xff\xff\x8b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x8b\x00\x5b\x00\x5c\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\xff\xff\x5b\x00\x5c\x00\xff\xff\x71\x00\xff\xff\x73\x00\xff\xff\x75\x00\x76\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x71\x00\xff\xff\x73\x00\xff\xff\x75\x00\x76\x00\xff\xff\x8b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x8b\x00\x5b\x00\x5c\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\xff\xff\x5b\x00\x5c\x00\xff\xff\x71\x00\xff\xff\x73\x00\xff\xff\x75\x00\x76\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x71\x00\xff\xff\x73\x00\xff\xff\x75\x00\x76\x00\xff\xff\x8b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x8b\x00\x5b\x00\x5c\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\xff\xff\x5b\x00\x5c\x00\xff\xff\x71\x00\xff\xff\x73\x00\xff\xff\x75\x00\x76\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x71\x00\xff\xff\x73\x00\xff\xff\x75\x00\x76\x00\xff\xff\x8b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x8b\x00\x5b\x00\x5c\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\xff\xff\x5b\x00\x5c\x00\xff\xff\x71\x00\xff\xff\x73\x00\xff\xff\x75\x00\x76\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x71\x00\xff\xff\x73\x00\xff\xff\x75\x00\x76\x00\xff\xff\x8b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x8b\x00\x5b\x00\x5c\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\xff\xff\x5b\x00\x5c\x00\xff\xff\x71\x00\xff\xff\x73\x00\xff\xff\x75\x00\x76\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x71\x00\xff\xff\x73\x00\xff\xff\x75\x00\x76\x00\xff\xff\x8b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x8b\x00\x5b\x00\x5c\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\xff\xff\x5b\x00\x5c\x00\xff\xff\x71\x00\xff\xff\x73\x00\xff\xff\x75\x00\x76\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x71\x00\xff\xff\x73\x00\xff\xff\x75\x00\x76\x00\xff\xff\x8b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x8b\x00\x5b\x00\x5c\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\xff\xff\x5b\x00\x5c\x00\xff\xff\x71\x00\xff\xff\x73\x00\xff\xff\x75\x00\x76\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x71\x00\xff\xff\x73\x00\xff\xff\x75\x00\x76\x00\xff\xff\x8b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\xff\xff\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x8b\x00\x5b\x00\x5c\x00\x56\x00\xff\xff\x58\x00\x59\x00\xff\xff\x5b\x00\x5c\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x66\x00\x67\x00\xff\xff\xff\xff\x71\x00\x6b\x00\x73\x00\xff\xff\x75\x00\x76\x00\xff\xff\x71\x00\xff\xff\x73\x00\xff\xff\x75\x00\x76\x00\xff\xff\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\xff\xff\xff\xff\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x8b\x00\xff\xff\xff\xff\x56\x00\xff\xff\x58\x00\x59\x00\x8b\x00\x5b\x00\x5c\x00\x56\x00\xff\xff\x58\x00\x59\x00\xff\xff\x5b\x00\x5c\x00\xff\xff\xff\xff\x66\x00\x67\x00\xff\xff\xff\xff\xff\xff\x6b\x00\xff\xff\xff\xff\x67\x00\xff\xff\xff\xff\x71\x00\x6b\x00\x73\x00\xff\xff\x75\x00\x76\x00\xff\xff\x71\x00\xff\xff\x73\x00\xff\xff\x75\x00\x76\x00\xff\xff\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\xff\xff\xff\xff\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\x8b\x00\x57\x00\x58\x00\x59\x00\xff\xff\x5b\x00\x5c\x00\x8b\x00\x58\x00\x59\x00\xff\xff\x5b\x00\x5c\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x71\x00\xff\xff\x73\x00\xff\xff\x75\x00\x76\x00\x71\x00\xff\xff\x73\x00\xff\xff\x75\x00\x76\x00\x5b\x00\x5c\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\xff\xff\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\xff\xff\x8b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x8b\x00\xff\xff\x71\x00\xff\xff\x73\x00\xff\xff\x75\x00\x76\x00\x5b\x00\x5c\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x5c\x00\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x8b\x00\xff\xff\x71\x00\xff\xff\x73\x00\xff\xff\x75\x00\x76\x00\x71\x00\xff\xff\x73\x00\xff\xff\x75\x00\x76\x00\xff\xff\xff\xff\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\xff\xff\x7f\x00\x80\x00\x81\x00\x82\x00\x83\x00\xff\xff\x8b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x8b\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff"# - -happyTable :: HappyAddr -happyTable = HappyA# "\x00\x00\x06\x00\x02\x00\x07\x00\x02\x00\x25\x02\xd0\x01\xc5\x01\xc6\x01\xd6\x01\xa0\x00\xc5\x01\xc6\x01\x47\x02\x19\x02\x1a\x02\x26\x01\x0a\x01\x5e\x00\x5f\x00\xc4\x01\x49\x01\xc5\x01\xc6\x01\xe9\x01\x26\x02\xd4\x01\x58\x00\x11\x01\xd3\x01\xd4\x01\xed\x00\x12\x02\x05\x00\x4e\x01\xe1\x01\x63\x00\x06\x00\x53\x02\x41\x02\xf6\x01\xa6\x00\x6e\x00\x0a\x00\xed\x00\xc7\x01\x77\x01\x98\x00\xa6\x00\xc7\x01\xb7\x00\x98\x00\x78\x01\xed\x00\xec\x01\x70\x00\xa6\x00\xa7\x00\xa8\x00\xa9\x00\xc7\x01\x33\x02\x7b\xfe\x7b\xfe\x57\x00\x18\x02\x19\x02\x1a\x02\x8f\x01\x91\x00\xcf\x00\x93\x00\x89\x01\xb4\x00\xe2\x01\x4f\x01\x64\x02\x55\x02\x1a\x02\xc0\x01\x72\x01\xb9\x00\x82\x01\xf7\x01\x57\x00\x40\x01\xf8\xff\x27\x02\x28\x02\x71\x00\x90\x02\x74\x02\xba\x00\xbb\x00\xee\x00\x58\x00\x0f\x02\xa8\x01\x7b\x02\xe8\x01\x95\x01\x63\x00\xe7\x01\xe8\x01\xaa\x00\xab\x00\xac\x00\x6b\x02\x1b\x02\x7a\x01\x7d\x02\x13\x02\x22\x02\xc8\x01\x4d\x02\x58\x00\x4a\x01\xc8\x01\x64\x00\x65\x00\x59\x00\x4b\x01\xc5\x00\x20\x00\x6b\x01\x1e\x00\x1f\x00\x20\x00\xc8\x01\x1e\x00\x1f\x00\x20\x00\xea\x01\xa1\x00\xa2\x00\xa3\x00\xa4\x00\x63\x00\x1c\x02\xef\x00\x1e\x00\x1f\x00\x20\x00\x08\x00\x64\x00\x6f\x00\x08\x00\xc9\x01\x64\x00\xca\x01\xcb\x01\xc9\x01\xef\x00\xca\x01\xcb\x01\x07\x01\x03\x00\x4e\x02\x03\x00\x64\x00\x1b\x02\xef\x00\xc9\x01\xc1\x01\xca\x01\xcb\x01\xc9\x01\x0a\x00\xca\x01\xcb\x01\xc9\x01\x1b\x02\xca\x01\xcb\x01\xc5\x00\x20\x00\x4a\x01\x0b\x00\x0c\x00\x56\x02\x57\x02\x75\x02\x84\x01\xc1\x01\x35\x01\xc5\x00\x20\x00\xc1\x01\x0d\x00\x29\x02\x1c\x02\x2a\x02\x0e\x00\x0f\x00\x1d\x00\x34\x01\x10\x00\x11\x00\x4f\x02\x12\x00\x13\x00\x1c\x02\x32\x01\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x29\x02\xa6\x00\x2a\x02\x57\x00\x51\x02\x1d\x00\x06\x01\x8f\x02\x6c\x01\xb4\x01\xb5\x01\x6d\x01\x1d\x01\x6e\x01\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\xe2\x01\x95\x01\xb1\x01\x6f\x01\x63\x00\x7b\xfe\x70\x01\xfe\x01\x3c\x01\x4f\x00\x91\x02\x5f\x00\x98\x01\x62\x02\x3d\x01\x58\x00\x14\x00\x67\x00\x68\x00\x0b\x00\x0c\x00\x7e\x02\x27\x01\x15\x00\x6f\x01\x16\x00\x17\x00\x7a\x02\x18\x00\x19\x00\x0d\x00\x63\x00\x3e\x01\x63\x00\x0e\x00\x0f\x00\x7b\x02\xe7\x01\x10\x00\x11\x00\x51\x02\x12\x00\x13\x00\x92\x02\x58\x02\xa6\x00\x59\x02\x64\x02\x5f\x00\x07\x01\x1a\x00\x07\x01\x1b\x00\x0e\x02\x1c\x00\x1d\x00\x4e\xff\x46\x01\xc5\x00\x20\x00\x77\x02\x3b\x02\x65\x02\x63\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x63\x00\x47\x01\x5c\x00\x0a\x01\x5e\x00\x5f\x00\x55\x02\x23\x00\x24\x00\x48\x01\xb2\x01\x20\x00\x07\x01\x67\x00\x68\x00\x47\x02\x14\x00\xc1\x00\x07\x01\xb2\x01\x20\x00\xb2\x01\x20\x00\x15\x00\x63\x00\x16\x00\x17\x00\x0d\x00\x18\x00\x19\x00\x10\x02\xc2\x00\x0f\x00\x80\x02\x15\x02\x10\x00\x11\x00\x20\x02\x12\x00\x13\x00\x5f\x02\x64\x00\x65\x00\x58\x02\x32\x02\x59\x02\x18\x01\x5f\x00\xc4\x00\xe0\x00\x1a\x00\x4a\x01\x1b\x00\x33\x02\x1c\x00\x1d\x00\x82\x02\xc5\x00\x20\x00\x23\x02\x3b\x02\x63\x00\xc5\x00\x20\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\xc8\x00\x1f\x00\x20\x00\xc9\x00\x22\x00\x46\x02\x62\x00\x23\x00\x24\x00\x64\x00\x65\x00\xfe\x01\x7d\x01\x14\x00\x47\x02\xff\x01\x5e\x00\x5f\x00\x63\x00\x4a\x01\x15\x00\x0d\x00\x16\x00\x17\x00\x11\x02\x18\x00\x19\x00\xe6\x00\x55\x01\x56\x01\x57\x01\xd9\x01\x12\x00\x13\x00\xe4\x00\x64\x00\x65\x00\x0e\x01\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x0f\x01\x81\x02\x61\x00\x10\x01\xeb\x00\x1a\x00\x95\xff\x1b\x00\xec\x00\x1c\x00\x1d\x00\x95\xff\xed\x00\x1e\x00\x1f\x00\x20\x00\xd1\x01\xad\x00\x63\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x4a\x02\x19\x01\x74\x01\xdd\x01\x58\x01\x59\x01\x75\x01\x23\x00\x24\x00\x4b\x02\x14\x00\x64\x00\x65\x00\x86\x01\x22\x02\x87\x01\x23\x02\x15\x00\x0d\x00\x16\x00\x17\x00\x11\x01\x18\x00\x19\x00\x05\x00\x5c\x01\x56\x01\x57\x01\x06\x00\x12\x00\x13\x00\x7c\x01\x7d\x01\x63\x00\xb7\x00\x7e\x01\x5e\x00\x5f\x00\x2f\x01\x48\x02\x80\x01\x86\x02\x74\x02\xe5\x01\x1a\x00\x62\x00\x1b\x00\xe0\x00\x5a\x01\x1d\x00\x64\x00\x65\x00\x7f\x02\x74\x02\x73\x02\x74\x02\xef\x01\x63\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\xdf\x00\x12\x01\xb9\x00\xf1\x01\x5d\x01\x59\x01\xe3\x00\x23\x00\x24\x00\xe0\x00\x14\x00\x64\x00\x65\x00\xba\x00\xbb\x00\xe4\x00\x0c\x02\x15\x00\x0d\x02\x16\x00\x17\x00\x0d\x00\x18\x00\x19\x00\x51\x02\xc3\x00\x0f\x00\x8d\x02\xf2\x01\x10\x00\x11\x00\x4a\x01\x12\x00\x13\x00\x7c\x01\x7d\x01\xd8\x01\xf5\x01\x7e\x01\x5e\x00\x5f\x00\x96\x01\x03\x02\x80\x01\x1a\x00\x8a\x01\x1b\x00\xbd\x00\x5a\x01\x1d\x00\xd0\x00\xd1\x00\x8a\x02\x91\x00\xd2\x00\x93\x00\x63\x00\xb4\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x98\x01\x4a\x01\x9c\x01\x1e\x00\x1f\x00\x20\x00\x75\x02\x23\x00\x24\x00\xa9\x01\x64\x00\x65\x00\x4a\x01\x14\x00\x4a\x01\x8a\x00\x02\x01\x75\x02\xac\x01\x75\x02\x15\x00\x03\x01\x16\x00\x17\x00\x0d\x00\x18\x00\x19\x00\x51\x02\x85\x00\x0f\x00\x87\x02\x51\x02\x10\x00\x11\x00\x85\x02\x12\x00\x13\x00\x7c\x01\x7d\x01\xde\x01\xdf\x01\x7e\x01\x5e\x00\x5f\x00\x98\x01\x15\x02\x80\x01\x1a\x00\xb9\x01\x1b\x00\x60\x02\x1c\x00\x1d\x00\x82\x01\x30\x02\x90\x00\x91\x00\xbb\x01\x93\x00\x63\x00\xb4\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\xd8\x00\x1f\x00\x20\x00\xc9\x00\x22\x00\xe8\x00\xe9\x00\x23\x00\x24\x00\x51\x02\x64\x00\x65\x00\x52\x02\x14\x00\x12\x01\xb7\x00\x98\x00\x99\x00\x9a\x00\xce\x00\x15\x00\xcf\x00\x16\x00\x17\x00\x0d\x00\x18\x00\x19\x00\x51\x02\xbd\x00\x0f\x00\x67\x02\x37\x01\x10\x00\x11\x00\x39\x01\x12\x00\x13\x00\x3a\x01\x01\x02\x7d\x01\xe3\x01\x20\x00\xff\x01\x5e\x00\x5f\x00\xb8\x00\xb9\x00\x1a\x00\xe2\x00\x1b\x00\x3e\x01\x1c\x00\x1d\x00\x8c\x01\x22\x01\x23\x01\xd2\x00\xba\x00\xbb\x00\x63\x00\x3f\x01\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x67\x00\x68\x00\x1e\x00\x1f\x00\x20\x00\x21\x01\x22\x01\x23\x00\x24\x00\x44\x01\x64\x00\x65\x00\x4c\x01\x14\x00\x67\x01\x2b\x01\x0a\x01\x5e\x00\x5f\x00\x75\x01\x15\x00\x0d\x00\x16\x00\x17\x00\xd6\x00\x18\x00\x19\x00\x82\x01\x55\x01\x56\x01\x57\x01\x03\x01\x12\x00\x13\x00\xf7\x00\x7c\x01\x7d\x01\x17\x01\x1e\x01\x7e\x01\x5e\x00\x5f\x00\x54\x00\xc3\x01\x80\x01\x8e\x01\x20\x00\x1a\x00\x8f\x01\x1b\x00\x1f\x01\x1c\x00\x1d\x00\x55\x00\x6c\x01\x6c\x00\x6d\x00\x6d\x01\x73\x00\xfa\x01\x63\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x75\x00\xa6\x00\x6f\x01\xa8\x00\xa9\x00\x70\x01\xbb\x00\x23\x00\x24\x00\x51\x00\x14\x00\x64\x00\x65\x00\x18\x01\x5f\x00\x50\x00\xd6\x01\x15\x00\x0d\x00\x16\x00\x17\x00\xa7\x00\x18\x00\x19\x00\xa7\x00\x5c\x01\x56\x01\x57\x01\x8f\x02\x12\x00\x13\x00\x89\x02\x7c\x01\x7d\x01\x63\x00\x84\x02\x7e\x01\x5e\x00\x5f\x00\x85\x02\x7f\x01\x80\x01\xa7\x00\x29\x00\x1a\x00\x78\x02\x1b\x00\xa7\x00\x1c\x00\x1d\x00\x79\x02\x64\x00\x65\x00\x08\x02\x09\x02\x0a\x02\x5e\x02\x63\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\xa9\xfe\xa6\x01\xa7\x01\xa8\x01\xca\x00\xcb\x00\xcc\x00\x23\x00\x24\x00\x62\x02\x14\x00\x64\x00\x65\x00\x18\x01\x5f\x00\xa7\x00\x69\x02\x15\x00\x0d\x00\x16\x00\x17\x00\x6b\x02\x18\x00\x19\x00\xdb\x00\xf4\x01\x56\x01\x57\x01\x30\x02\x12\x00\x13\x00\x85\x00\x45\x02\x63\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x8a\x02\x19\x01\x61\x00\x41\x02\x4c\x02\x1a\x00\x08\x02\x1b\x00\x0c\x02\x1c\x00\x1d\x00\x64\x00\x65\x00\x1a\x01\x7a\x01\x9b\x01\x17\x02\x8b\x02\x63\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x18\x02\x0a\x00\x25\x02\x00\x02\x5e\x00\x5f\x00\x0c\x01\x23\x00\x24\x00\xd8\x01\x14\x00\x64\x00\x65\x00\xd3\x01\xa6\x00\xae\x01\x32\x01\x15\x00\x0d\x00\x16\x00\x17\x00\xec\x01\x18\x00\x19\x00\xef\x01\x99\x01\x56\x01\x57\x01\xf1\x01\x12\x00\x13\x00\x6c\x02\x5f\x00\x63\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x91\x01\xb4\xfe\x61\x00\xb2\xfe\xb3\xfe\x1a\x00\x62\x00\x1b\x00\xe5\x01\x1c\x00\x1d\x00\x64\x00\x65\x00\xf4\x01\x27\x00\x95\x01\xfc\x01\x84\x01\x63\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\xfd\x01\x86\x01\x03\x02\x89\x01\xf1\x00\x7a\x01\x91\x01\x23\x00\x24\x00\x94\x01\x14\x00\x64\x00\x65\x00\xe4\x00\x95\x01\x9e\x01\x9b\x01\x15\x00\x0d\x00\x16\x00\x17\x00\x9f\x01\x18\x00\x19\x00\x63\x00\x9c\x01\x56\x01\x57\x01\xae\x00\x12\x00\x13\x00\xab\x01\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\xbd\x01\xac\x01\x61\x00\xae\x01\x64\x00\x65\x00\x32\x01\x1a\x00\x62\x00\x1b\x00\xaf\x01\x1c\x00\x1d\x00\xbb\x01\x63\x00\x5f\x01\xbd\x01\xc3\x01\xd0\x01\x25\x01\x63\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x26\x01\x2d\x01\x2a\x01\x2e\x01\x30\x01\x64\x00\x65\x00\x23\x00\x24\x00\x31\x01\x14\x00\x64\x00\x65\x00\x33\x01\xb7\x00\x98\x00\x32\x01\x15\x00\x35\x01\x16\x00\x17\x00\x39\x01\x18\x00\x19\x00\x0e\x01\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x0f\x01\x37\x01\x61\x00\x10\x01\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\xf6\x00\xf1\x00\x61\x00\x43\x01\x44\x01\x62\x00\x1a\x00\xb9\x00\x1b\x00\x46\x01\x1c\x00\x1d\x00\x51\x01\x71\x02\x5e\x00\x5f\x00\x4e\x01\x63\x00\xba\x00\xbb\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\xae\x00\x55\x01\x64\x01\x5f\x01\x6a\x01\x72\x02\x6b\x01\x23\x00\x24\x00\x64\x00\x65\x00\x11\x01\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x05\x01\xae\x00\x61\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x73\x01\x61\x00\x7b\x01\xc8\x00\x7c\x01\xae\x00\xd8\x00\x9e\xfe\xa0\xfe\x62\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x74\x00\xa1\xfe\x61\x00\x62\x00\xa4\xfe\xda\x00\x63\x00\xdb\x00\xe8\x00\xde\x00\x60\x02\xe7\x00\xb7\x00\x12\x01\x99\x00\x63\x00\xe5\x00\xbe\x01\x5c\x00\x0a\x01\x5e\x00\x5f\x00\xf9\x00\x64\x00\x65\x00\xbf\x01\x0c\x01\x5c\x00\x0a\x01\x5e\x00\x5f\x00\x63\x00\x64\x00\x65\x00\x0d\x01\xad\x00\x2a\x01\x5c\x00\x0a\x01\x5e\x00\x5f\x00\xf1\x00\x05\x01\xb9\x00\xf6\x00\x62\x00\x16\x01\x17\x01\x64\x00\x65\x00\x28\x01\x5e\x00\x5f\x00\x62\x00\xba\x00\xbb\x00\x5b\x00\x63\x00\x09\x01\x5c\x00\x0a\x01\x5e\x00\x5f\x00\x73\x00\xae\x00\x63\x00\x70\x02\x5f\x00\xbf\x00\x62\x00\xbd\x00\x34\x02\x5e\x00\x5f\x00\x64\x00\x65\x00\x35\x02\xc0\x00\xc1\x00\xff\xff\x05\x00\x63\x00\x64\x00\x65\x00\x36\x02\x37\x02\x38\x02\x53\x00\x39\x02\x54\x00\x00\x00\x62\x00\x6d\x02\x5e\x00\x5f\x00\xb7\x00\x5f\x02\x5f\x00\x64\x00\x65\x00\x62\x00\x18\x01\x5f\x00\x63\x00\x00\x00\x6e\x02\x37\x02\x38\x02\x00\x00\x39\x02\x62\x00\x00\x00\x63\x00\x00\x00\x43\x02\x00\x00\xb7\x00\x98\x00\x99\x00\x9a\x00\x64\x00\x65\x00\x63\x00\x9c\x00\x00\x00\x00\x00\xb9\x00\x00\x00\x00\x00\x64\x00\x65\x00\x00\x00\x62\x00\x44\x02\x63\x00\x00\x00\x00\x00\xba\x00\xbb\x00\x64\x00\x65\x00\x00\x00\x3a\x02\x00\x00\x63\x00\x00\x00\xb8\x00\xb9\x00\x00\x00\x63\x00\x00\x00\x64\x00\x65\x00\x00\x00\x00\x00\x63\x00\x00\x00\x3b\x02\xba\x00\xbb\x00\x00\x00\x64\x00\x65\x00\x6f\x02\x00\x00\x00\x00\x64\x00\x65\x00\x00\x00\x00\x00\x00\x00\x00\x00\x64\x00\x65\x00\x00\x00\x00\x00\x63\x00\x00\x00\x3b\x02\x63\x00\x00\x00\x00\x00\x00\x00\x00\x00\x63\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x64\x00\x65\x00\x00\x00\x64\x00\x65\x00\x00\x00\x00\x00\x00\x00\x64\x00\x65\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x2b\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x90\xfe\x90\xfe\x90\xfe\x90\xfe\x00\x00\x34\x00\x00\x00\x35\x00\x00\x00\x36\x00\x00\x00\x00\x00\xaf\x00\x37\x00\x00\x00\xb0\x00\x38\x00\xb1\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb2\x00\x90\x00\xb3\x00\x39\x00\x93\x00\x3a\x00\xb4\x00\x3b\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\x00\x00\x41\x00\x42\x00\x00\x00\x43\x00\x44\x00\x45\x00\x46\x00\x00\x00\x47\x00\x00\x00\x90\xfe\x90\xfe\x90\xfe\x48\x00\x00\x00\x00\x00\x49\x00\x00\x00\x4a\x00\x4b\x00\x00\x00\x4c\x00\x4d\x00\x4e\x00\x00\x00\x4f\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x2b\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x90\xfe\x90\xfe\x90\xfe\x90\xfe\x00\x00\x34\x00\x00\x00\x35\x00\x00\x00\x36\x00\x00\x00\x00\x00\xaf\x00\x37\x00\x00\x00\xb0\x00\x38\x00\xf4\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb2\x00\x90\x00\xb3\x00\x39\x00\x93\x00\x3a\x00\xb4\x00\x3b\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\x00\x00\x41\x00\x42\x00\x00\x00\x43\x00\x44\x00\x45\x00\x46\x00\x00\x00\x00\x00\x00\x00\x90\xfe\x90\xfe\x90\xfe\x48\x00\x00\x00\x00\x00\x49\x00\x00\x00\x4a\x00\x4b\x00\x00\x00\x4c\x00\x4d\x00\x4e\x00\x00\x00\x4f\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x97\x00\x98\x00\x99\x00\x9a\x00\x2b\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x34\x00\x9b\x00\x35\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x37\x00\x00\x00\x9c\x00\x38\x00\x9d\x00\x9e\x00\x00\x00\x00\x00\x00\x00\x7d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x39\x00\x00\x00\x9f\x00\xa0\x00\x3b\x00\x3c\x00\x3d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x41\x00\x42\x00\x00\x00\x43\x00\x44\x00\x00\x00\x46\x00\x7e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7f\x00\x00\x00\x00\x00\x00\x00\x4a\x00\x4b\x00\x00\x00\x4c\x00\x00\x00\x4e\x00\x00\x00\x4f\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x2b\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x34\x00\x00\x00\x35\x00\x00\x00\x36\x00\x00\x00\xb1\xff\xaf\x00\x37\x00\x00\x00\xb0\x00\x38\x00\xe0\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb2\x00\x90\x00\xb3\x00\x39\x00\x93\x00\x3a\x00\xb4\x00\x3b\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\x00\x00\x41\x00\x42\x00\x00\x00\x43\x00\x44\x00\x45\x00\x46\x00\x00\x00\x47\x00\x00\x00\x00\x00\x00\x00\x00\x00\x48\x00\x00\x00\x00\x00\x49\x00\x00\x00\x4a\x00\x4b\x00\x00\x00\x4c\x00\x4d\x00\x4e\x00\x00\x00\x4f\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x2b\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x90\xfe\x90\xfe\x90\xfe\x90\xfe\x00\x00\x34\x00\x00\x00\x35\x00\x00\x00\x5c\x01\x00\x00\x00\x00\xaf\x00\x37\x00\x00\x00\xb0\x00\x38\x00\xf4\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb2\x00\x90\x00\xb3\x00\x39\x00\x93\x00\x3a\x00\xb4\x00\x3b\x00\x3c\x00\x3d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x41\x00\x42\x00\x00\x00\x43\x00\x44\x00\x00\x00\x46\x00\x00\x00\x00\x00\x00\x00\x90\xfe\x90\xfe\x90\xfe\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4a\x00\x4b\x00\x00\x00\x4c\x00\x00\x00\x4e\x00\x00\x00\x4f\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x2b\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x34\x00\x00\x00\x35\x00\x00\x00\xff\x00\x00\x00\x00\x00\x00\x00\x37\x00\x00\x00\x00\x00\x38\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x39\x00\x00\x00\x3a\x00\x00\x00\x3b\x00\x3c\x00\x3d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x41\x00\x42\x00\x00\x00\x43\x00\x44\x00\x00\x00\x46\x00\x7e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x4a\x00\x4b\x00\x00\x00\x4c\x00\x00\x00\x4e\x00\x00\x00\x4f\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x2b\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x34\x00\x69\x01\x35\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x37\x00\x00\x00\x00\x00\x38\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x39\x00\x00\x00\x3a\x00\x00\x00\x3b\x00\x3c\x00\x3d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x41\x00\x42\x00\x00\x00\x43\x00\x44\x00\x00\x00\x46\x00\x7e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7f\x00\x00\x00\x00\x00\x00\x00\x4a\x00\x4b\x00\x00\x00\x4c\x00\x00\x00\x4e\x00\x00\x00\x4f\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x2b\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x34\x00\x00\x00\x35\x00\x00\x00\xff\x00\x00\x00\x00\x00\x00\x00\x37\x00\x00\x00\x00\x00\x38\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x39\x00\x00\x00\x3a\x00\x00\x00\x3b\x00\x3c\x00\x3d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x41\x00\x42\x00\x00\x00\x43\x00\x44\x00\x00\x00\x46\x00\x7e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x4a\x00\x4b\x00\x00\x00\x4c\x00\x00\x00\x4e\x00\x00\x00\x4f\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x2b\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x34\x00\x00\x00\x35\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x37\x00\x85\x00\x00\x00\x38\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x39\x00\x00\x00\x3a\x00\x00\x00\x3b\x00\x3c\x00\x3d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x41\x00\x42\x00\x00\x00\x43\x00\x44\x00\x00\x00\x46\x00\x7e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7f\x00\x00\x00\x00\x00\x00\x00\x4a\x00\x4b\x00\x00\x00\x4c\x00\x00\x00\x4e\x00\x00\x00\x4f\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x2b\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x34\x00\x00\x00\x35\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x37\x00\x00\x00\x00\x00\x38\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x39\x00\x00\x00\x3a\x00\x00\x00\x3b\x00\x3c\x00\x3d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x41\x00\x42\x00\x00\x00\x43\x00\x44\x00\x00\x00\x46\x00\x7e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7f\x00\x00\x00\x00\x00\x00\x00\x4a\x00\x4b\x00\x00\x00\x4c\x00\x00\x00\x4e\x00\x00\x00\x4f\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x2b\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x34\x00\x00\x00\x35\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x37\x00\x00\x00\x00\x00\x38\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x39\x00\x00\x00\x3a\x00\x00\x00\x3b\x00\x3c\x00\x3d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x41\x00\x42\x00\x00\x00\x43\x00\x44\x00\x00\x00\x46\x00\x7e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x4a\x00\x4b\x00\x00\x00\x4c\x00\x00\x00\x4e\x00\x00\x00\x4f\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x2b\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x34\x00\x00\x00\x35\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x37\x00\x00\x00\x00\x00\x38\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x39\x00\x00\x00\x3a\x00\x00\x00\x3b\x00\x3c\x00\x3d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x41\x00\x42\x00\x00\x00\x43\x00\x44\x00\x00\x00\x46\x00\x7e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7f\x00\x00\x00\x00\x00\x00\x00\x4a\x00\x4b\x00\x00\x00\x4c\x00\x00\x00\x4e\x00\x00\x00\x4f\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x2b\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x34\x00\x00\x00\x35\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x37\x00\x00\x00\x00\x00\x38\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x39\x00\x00\x00\x3a\x00\x00\x00\x3b\x00\x3c\x00\x3d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x41\x00\x42\x00\x00\x00\x43\x00\x44\x00\x00\x00\x46\x00\x7e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x4a\x00\x4b\x00\x00\x00\x4c\x00\x00\x00\x4e\x00\x00\x00\x4f\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x2b\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x34\x00\x00\x00\x35\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x37\x00\x00\x00\x00\x00\x38\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x39\x00\x00\x00\x3a\x00\x00\x00\x3b\x00\x3c\x00\x3d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x41\x00\x42\x00\x00\x00\x43\x00\x44\x00\x00\x00\x46\x00\x7e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7f\x00\x00\x00\x00\x00\x00\x00\x4a\x00\x4b\x00\x00\x00\x4c\x00\x00\x00\x4e\x00\x00\x00\x4f\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x2b\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x34\x00\x00\x00\x35\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x37\x00\x00\x00\x00\x00\x38\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x39\x00\x00\x00\x3a\x00\x00\x00\x3b\x00\x3c\x00\x3d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x41\x00\x42\x00\x00\x00\x43\x00\x44\x00\x00\x00\x46\x00\x7e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x4a\x00\x4b\x00\x00\x00\x4c\x00\x00\x00\x4e\x00\x00\x00\x4f\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x2b\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x34\x00\x00\x00\x35\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x37\x00\x00\x00\x00\x00\x38\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x39\x00\x00\x00\x3a\x00\x00\x00\x3b\x00\x3c\x00\x3d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x41\x00\x42\x00\x00\x00\x43\x00\x44\x00\x00\x00\x46\x00\x7e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7f\x00\x00\x00\x00\x00\x00\x00\x4a\x00\x4b\x00\x00\x00\x4c\x00\x00\x00\x4e\x00\x00\x00\x4f\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x2b\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x34\x00\x00\x00\x35\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x37\x00\x00\x00\x00\x00\x38\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x39\x00\x00\x00\x3a\x00\x00\x00\x3b\x00\x3c\x00\x3d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x41\x00\x42\x00\x00\x00\x43\x00\x44\x00\x00\x00\x46\x00\x7e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x4a\x00\x4b\x00\x00\x00\x4c\x00\x00\x00\x4e\x00\x00\x00\x4f\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x2b\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x34\x00\x00\x00\x35\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x37\x00\x00\x00\x00\x00\x38\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x39\x00\x00\x00\x3a\x00\x00\x00\x3b\x00\x3c\x00\x3d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x41\x00\x42\x00\x00\x00\x43\x00\x44\x00\x00\x00\x46\x00\x7e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7f\x00\x00\x00\x00\x00\x00\x00\x4a\x00\x4b\x00\x00\x00\x4c\x00\x00\x00\x4e\x00\x00\x00\x4f\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x2b\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x34\x00\x00\x00\x35\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x37\x00\x00\x00\x00\x00\x38\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x39\x00\x00\x00\x3a\x00\x00\x00\x3b\x00\x3c\x00\x3d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x41\x00\x42\x00\x00\x00\x43\x00\x44\x00\x00\x00\x46\x00\x7e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x4a\x00\x4b\x00\x00\x00\x4c\x00\x00\x00\x4e\x00\x00\x00\x4f\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x2b\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x34\x00\x00\x00\x35\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x37\x00\x00\x00\x00\x00\x38\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x39\x00\x00\x00\x3a\x00\x00\x00\x3b\x00\x3c\x00\x3d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x41\x00\x42\x00\x00\x00\x43\x00\x44\x00\x00\x00\x46\x00\x7e\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7f\x00\x00\x00\x00\x00\x00\x00\x4a\x00\x4b\x00\x00\x00\x4c\x00\x00\x00\x4e\x00\x00\x00\x4f\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x2b\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x34\x00\x00\x00\x35\x00\x00\x00\x5c\x01\x00\x00\xa1\xff\x00\x00\x37\x00\x00\x00\x00\x00\x38\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x39\x00\x00\x00\x3a\x00\x00\x00\x3b\x00\x3c\x00\x3d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x41\x00\x42\x00\x00\x00\x43\x00\x44\x00\x00\x00\x46\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4a\x00\x4b\x00\x00\x00\x4c\x00\x00\x00\x4e\x00\x00\x00\x4f\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x2b\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x34\x00\xaf\x00\x35\x00\x00\x00\xb0\x00\x00\x00\xb1\x00\x00\x00\x37\x00\x00\x00\x00\x00\x38\x00\x00\x00\xb2\x00\x90\x00\xb3\x00\x00\x00\x93\x00\x00\x00\xb4\x00\x00\x00\xb5\x00\x39\x00\x00\x00\x3a\x00\x00\x00\x3b\x00\x3c\x00\x3d\x00\x00\x00\x00\x00\x00\x00\x26\x00\x41\x00\x42\x00\x29\x00\x43\x00\x44\x00\x00\x00\x46\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4a\x00\x4b\x00\x00\x00\x4c\x00\x5b\x02\x4e\x00\x00\x00\x4f\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x2b\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x00\x00\x00\x00\x00\x00\x00\x00\x3b\x00\x34\x00\x3d\x00\x35\x00\x00\x00\x00\x00\x00\x00\x00\x00\x42\x00\x37\x00\x43\x00\x44\x00\x38\x00\x46\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x54\x01\x00\x00\x39\x00\x00\x00\x4a\x00\x4b\x00\x3b\x00\x4c\x00\x3d\x00\x4e\x00\x00\x00\x4f\x00\x26\x00\x00\x00\x42\x00\x00\x00\x43\x00\x44\x00\x00\x00\x46\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb4\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4a\x00\x4b\x00\x00\x00\x4c\x00\x00\x00\x4e\x00\x00\x00\x4f\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x2b\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x00\x00\x00\x00\x00\x00\x00\x00\x3b\x00\x34\x00\x3d\x00\x35\x00\x00\x00\x00\x00\x00\x00\x00\x00\x42\x00\x37\x00\x43\x00\x44\x00\x38\x00\x46\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb7\x00\x00\x00\x99\x00\x39\x00\x00\x00\x4a\x00\x4b\x00\x3b\x00\x4c\x00\x3d\x00\x4e\x00\x00\x00\x4f\x00\x00\x00\x00\x00\x42\x00\x00\x00\x43\x00\x44\x00\x14\x01\x46\x00\x26\x00\x27\x00\x00\x00\x67\x00\x68\x00\xb7\x00\x98\x00\x9c\x00\x00\x00\x00\x00\xb9\x00\x4a\x00\x4b\x00\x00\x00\x4c\x00\x00\x00\x4e\x00\x15\x01\x4f\x00\x00\x00\x00\x00\xba\x00\xbb\x00\x69\x00\x14\x01\x6a\x00\x00\x00\xb7\x00\x98\x00\x99\x00\x9a\x00\x6b\x00\x00\x00\x9c\x00\x00\x00\x00\x00\xb9\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x15\x01\x00\x00\x00\x00\x9b\x00\xba\x00\xbb\x00\x3b\x00\x00\x00\x3d\x00\x00\x00\x00\x00\x00\x00\x9c\x00\x00\x00\x42\x00\xb9\x00\x43\x00\x6c\x00\x00\x00\x46\x00\x26\x00\x27\x00\x00\x00\x67\x00\x68\x00\xb7\x00\xba\x00\xbb\x00\x00\x00\x00\x00\x00\x00\x4a\x00\x4b\x00\x00\x00\x4c\x00\x00\x00\x4e\x00\x00\x00\x4f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x69\x00\x14\x01\x6a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x6b\x00\x00\x00\x9c\x00\x00\x00\x00\x00\xb9\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x15\x01\x00\x00\x00\x00\x00\x00\xba\x00\xbb\x00\x3b\x00\x00\x00\x3d\x00\xb7\x00\x98\x00\x99\x00\x9a\x00\x00\x00\x42\x00\x00\x00\x43\x00\x6c\x00\x26\x00\x46\x00\x00\x00\x67\x00\x68\x00\xb7\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4a\x00\x4b\x00\x00\x00\x4c\x00\x00\x00\x4e\x00\xa7\x00\x4f\x00\xb8\x00\xb9\x00\x69\x00\xe2\x00\x6a\x00\x00\x00\x00\x00\xe2\xfe\x00\x00\x00\x00\x6b\x00\x00\x00\xba\x00\xbb\x00\x1c\x01\xb9\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x6b\xff\xba\x00\xbb\x00\x3b\x00\x00\x00\x3d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x42\x00\x00\x00\x43\x00\x26\x00\x00\x00\x46\x00\x67\x00\x68\x00\xb7\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4a\x00\x4b\x00\x00\x00\x4c\x00\x00\x00\x4e\x00\x00\x00\x4f\x00\x00\x00\x69\x00\x00\x00\x6a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x6b\x00\x00\x00\x00\x00\x00\x00\x1c\x01\xb9\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1d\x01\x00\x00\x00\x00\x6b\xff\xba\x00\xbb\x00\x3b\x00\x00\x00\x3d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x42\x00\x00\x00\x43\x00\x00\x00\x26\x00\x46\x00\x00\x00\x67\x00\x68\x00\xb7\x00\x52\x01\x19\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4a\x00\x4b\x00\x00\x00\x4c\x00\x00\x00\x4e\x00\xa7\x00\x4f\x00\x00\x00\x00\x00\x69\x00\x00\x00\x6a\x00\x00\x00\x00\x00\x1a\x00\x00\x00\x7b\x00\x6b\x00\x1c\x00\x1d\x00\x00\x00\x1c\x01\xb9\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\xba\x00\xbb\x00\x3b\x00\x00\x00\x3d\x00\x00\x00\x00\x00\x23\x00\x00\x00\x00\x00\x42\x00\x00\x00\x43\x00\x26\x00\x00\x00\x46\x00\x67\x00\x68\x00\xb7\x00\x00\x00\x00\x00\x00\x00\x26\x00\x00\x00\x28\x00\x67\x00\x68\x00\x4a\x00\x4b\x00\x00\x00\x4c\x00\x00\x00\x4e\x00\x00\x00\x4f\x00\x00\x00\x69\x00\x00\x00\x6a\x00\x00\x00\xa6\x00\x00\x00\xa8\x00\xa9\x00\x6b\x00\xcd\x01\x00\x00\x00\x00\x1c\x01\xb9\x00\x00\x00\x00\x00\x00\x00\xce\x01\x00\x00\x00\x00\x1d\x01\x00\x00\x00\x00\x00\x00\xba\x00\xbb\x00\x3b\x00\x00\x00\x3d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x42\x00\x3b\x00\x43\x00\x3d\x00\x00\x00\x46\x00\x00\x00\x00\x00\x00\x00\x42\x00\x00\x00\x43\x00\x44\x00\x00\x00\x46\x00\x00\x00\x00\x00\x4a\x00\x4b\x00\x00\x00\x4c\x00\x00\x00\x4e\x00\xcf\x01\x4f\x00\x00\x00\x4a\x00\x4b\x00\x00\x00\x4c\x00\x00\x00\x4e\x00\x26\x00\x4f\x00\x00\x00\x67\x00\x68\x00\x00\x00\x53\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x69\x00\x00\x00\x6a\x00\x7f\x00\x00\x00\x18\x00\x19\x00\x00\x00\x6b\x00\x00\x00\x00\x00\x00\x00\x53\xff\x00\x00\x00\x00\x26\x00\x27\x00\x00\x00\x67\x00\x68\x00\x00\x00\x00\x00\x00\x00\x6b\xff\x00\x00\x6a\x02\x3b\x00\x1a\x00\x3d\x00\x7b\x00\x00\x00\x1c\x00\x1d\x00\x00\x00\x42\x00\x00\x00\x43\x00\x00\x00\x69\x00\x46\x00\x6a\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x6b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4a\x00\x4b\x00\x23\x00\x4c\x00\x00\x00\x4e\x00\x00\x00\x4f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x8d\x02\x3b\x00\x00\x00\x3d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x42\x00\x00\x00\x43\x00\x6c\x00\x26\x00\x46\x00\x00\x00\x67\x00\x68\x00\x00\x00\x53\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4a\x00\x4b\x00\x00\x00\x4c\x00\x00\x00\x4e\x00\x00\x00\x4f\x00\x00\x00\x00\x00\x69\x00\x00\x00\x6a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x6b\x00\x00\x00\x00\x00\x00\x00\x53\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x26\x00\x00\x00\x28\x00\x29\x00\x2a\x00\x00\x00\x00\x00\x6a\x02\x3b\x00\x00\x00\x3d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x42\x00\x00\x00\x43\x00\x00\x00\x00\x00\x46\x00\x00\x00\x2c\x02\x2d\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x2e\x02\x00\x00\x4a\x00\x4b\x00\x00\x00\x4c\x00\x2f\x02\x4e\x00\x00\x00\x4f\x00\x26\x00\x27\x00\x00\x00\x67\x00\x68\x00\x00\x00\x00\x00\x00\x00\x3b\x00\x00\x00\x3d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x42\x00\x00\x00\x43\x00\x44\x00\x00\x00\x46\x00\x00\x00\x69\x00\x00\x00\x6a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x6b\x00\x00\x00\x4a\x00\x4b\x00\x00\x00\x4c\x00\x00\x00\x4e\x00\x00\x00\x4f\x00\x26\x00\x27\x00\x00\x00\x67\x00\x68\x00\x00\x00\x00\x00\x00\x00\x3b\x00\x00\x00\x3d\x00\x00\x00\x00\x00\x00\x00\x26\x00\x00\x00\x42\x00\x00\x00\x43\x00\x6c\x00\x00\x00\x46\x00\x00\x00\x69\x00\x00\x00\x6a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x6b\x00\x0c\x01\x4a\x00\x4b\x00\x00\x00\x4c\x00\x09\x01\x4e\x00\x00\x00\x4f\x00\x26\x00\x27\x00\x00\x00\x67\x00\x68\x00\x00\x00\x00\x00\x00\x00\x3b\x00\x00\x00\x3d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x42\x00\x00\x00\x43\x00\x00\x00\x00\x00\x46\x00\x3b\x00\x69\x00\x3d\x00\x6a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x42\x00\x6b\x00\x43\x00\x4a\x00\x4b\x00\x46\x00\x4c\x00\x00\x00\x4e\x00\x00\x00\x4f\x00\x26\x00\x00\x00\x00\x00\x3d\x02\x68\x00\x00\x00\x4a\x00\x4b\x00\x3b\x00\x4c\x00\x3d\x00\x4e\x00\x00\x00\x4f\x00\x00\x00\x00\x00\x42\x00\x00\x00\x43\x00\x6c\x00\x00\x00\x46\x00\x00\x00\x3e\x02\x00\x00\x6a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x6b\x00\x00\x00\x4a\x00\x4b\x00\x00\x00\x4c\x00\x00\x00\x4e\x00\x00\x00\x4f\x00\x26\x00\x00\x00\x00\x00\x67\x00\x68\x00\x00\x00\x00\x00\x3f\x02\x3b\x00\x00\x00\x3d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x42\x00\x00\x00\x43\x00\x00\x00\x00\x00\x46\x00\x00\x00\x69\x00\x00\x00\x6a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x6b\x00\x00\x00\x4a\x00\x4b\x00\x00\x00\x4c\x00\x00\x00\x4e\x00\x00\x00\x4f\x00\x26\x00\x00\x00\x00\x00\x67\x00\x68\x00\x00\x00\x00\x00\x3f\x02\x3b\x00\x00\x00\x3d\x00\x00\x00\x00\x00\x00\x00\x26\x00\x00\x00\x42\x00\x00\x00\x43\x00\x00\x00\x00\x00\x46\x00\x00\x00\x69\x00\x00\x00\x6a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x6b\x00\x00\x00\x4a\x00\x4b\x00\x00\x00\x4c\x00\x09\x01\x4e\x00\x00\x00\x4f\x00\x26\x00\x00\x00\x28\x00\x29\x00\x2a\x00\x00\x00\x00\x00\x67\x02\x3b\x00\x00\x00\x3d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x42\x00\x00\x00\x43\x00\x00\x00\x00\x00\x46\x00\x3b\x00\x2c\x02\x3d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x42\x00\x2e\x02\x43\x00\x4a\x00\x4b\x00\x46\x00\x4c\x00\x00\x00\x4e\x00\x00\x00\x4f\x00\x26\x00\x00\x00\x00\x00\x3d\x02\x68\x00\x00\x00\x4a\x00\x4b\x00\x3b\x00\x4c\x00\x3d\x00\x4e\x00\x00\x00\x4f\x00\x00\x00\x00\x00\x42\x00\x00\x00\x43\x00\x44\x00\x00\x00\x46\x00\x00\x00\x3e\x02\x00\x00\x6a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x6b\x00\x00\x00\x4a\x00\x4b\x00\x00\x00\x4c\x00\x00\x00\x4e\x00\x00\x00\x4f\x00\x26\x00\x00\x00\x00\x00\x67\x00\x68\x00\x00\x00\x00\x00\x3f\x02\x3b\x00\x00\x00\x3d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x42\x00\x00\x00\x43\x00\x00\x00\x00\x00\x46\x00\x00\x00\x69\x00\x00\x00\x6a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x6b\x00\x00\x00\x4a\x00\x4b\x00\x00\x00\x4c\x00\x00\x00\x4e\x00\x00\x00\x4f\x00\x26\x00\x27\x00\x00\x00\x67\x00\x68\x00\x00\x00\x00\x00\x00\x00\x3b\x00\x00\x00\x3d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x42\x00\x00\x00\x43\x00\x82\x01\x00\x00\x46\x00\x00\x00\x69\x00\x00\x00\x6a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x6b\x00\x00\x00\x4a\x00\x4b\x00\x00\x00\x4c\x00\x00\x00\x4e\x00\x00\x00\x4f\x00\x26\x00\x00\x00\x00\x00\x67\x00\x68\x00\x00\x00\x00\x00\x00\x00\x3b\x00\x00\x00\x3d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x42\x00\x00\x00\x43\x00\x00\x00\x00\x00\x46\x00\x00\x00\x69\x00\x00\x00\x6a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x6b\x00\x00\x00\x4a\x00\x4b\x00\x00\x00\x4c\x00\x00\x00\x4e\x00\x00\x00\x4f\x00\x26\x00\x27\x00\x00\x00\x67\x00\x68\x00\x00\x00\x00\x00\x00\x00\x3b\x00\x00\x00\x3d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x42\x00\x00\x00\x43\x00\x82\x01\x00\x00\x46\x00\x00\x00\x69\x00\x00\x00\x6a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x6b\x00\x00\x00\x4a\x00\x4b\x00\x00\x00\x4c\x00\x00\x00\x4e\x00\x00\x00\x4f\x00\x26\x00\x00\x00\x00\x00\x67\x00\x68\x00\x00\x00\x00\x00\x00\x00\x3b\x00\x00\x00\x3d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x42\x00\x00\x00\x43\x00\x00\x00\x00\x00\x46\x00\x00\x00\x69\x00\x00\x00\x6a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x6b\x00\x00\x00\x4a\x00\x4b\x00\x00\x00\x4c\x00\x00\x00\x4e\x00\x00\x00\x4f\x00\x26\x00\x27\x00\x00\x00\x67\x00\x68\x00\x00\x00\x00\x00\x00\x00\x3b\x00\x00\x00\x3d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x42\x00\x00\x00\x43\x00\x82\x01\x00\x00\x46\x00\x00\x00\x69\x00\x00\x00\x6a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x6b\x00\x00\x00\x4a\x00\x4b\x00\x00\x00\x4c\x00\x00\x00\x4e\x00\x00\x00\x4f\x00\x26\x00\x00\x00\x00\x00\x67\x00\x68\x00\x00\x00\x00\x00\x00\x00\x3b\x00\x00\x00\x3d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x42\x00\x00\x00\x43\x00\x00\x00\x00\x00\x46\x00\x00\x00\x69\x00\x00\x00\x6a\x00\x00\x00\x00\x00\x00\x00\x26\x00\x00\x00\x6b\x00\x29\x00\x4a\x00\x4b\x00\x00\x00\x4c\x00\x00\x00\x4e\x00\x00\x00\x4f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x3b\x00\x00\x00\x3d\x00\x5b\x02\x5c\x02\x00\x00\x00\x00\x00\x00\x42\x00\x00\x00\x43\x00\x00\x00\x00\x00\x46\x00\x00\x00\x00\x00\x00\x00\x5d\x02\x26\x00\x00\x00\x00\x00\x67\x00\x68\x00\x00\x00\x00\x00\x4a\x00\x4b\x00\x00\x00\x4c\x00\x3b\x00\x4e\x00\x3d\x00\x4f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x42\x00\x00\x00\x43\x00\x44\x00\x69\x00\x46\x00\x6a\x00\x00\x00\x26\x00\x00\x00\x00\x00\x1e\x02\x6b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4a\x00\x4b\x00\x00\x00\x4c\x00\x00\x00\x4e\x00\x00\x00\x4f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x3b\x00\x1f\x02\x3d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x42\x00\x20\x02\x43\x00\x00\x00\x26\x00\x46\x00\x28\x00\x29\x00\x2a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4a\x00\x4b\x00\x3b\x00\x4c\x00\x3d\x00\x4e\x00\x00\x00\x4f\x00\x00\x00\x00\x00\x42\x00\x00\x00\x43\x00\x44\x00\x26\x00\x46\x00\x28\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4a\x00\x4b\x00\x00\x00\x4c\x00\x00\x00\x4e\x00\x00\x00\x4f\x00\x00\x00\x3b\x00\xd4\x00\x3d\x00\x00\x00\x00\x00\x00\x00\x00\x00\xd5\x00\x42\x00\x00\x00\x43\x00\x44\x00\x26\x00\x46\x00\x28\x00\x29\x00\x2a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4a\x00\x4b\x00\x3b\x00\x4c\x00\x3d\x00\x4e\x00\x00\x00\x4f\x00\x00\x00\x00\x00\x42\x00\x00\x00\x43\x00\x44\x00\x26\x00\x46\x00\x28\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4a\x00\x4b\x00\x00\x00\x4c\x00\x00\x00\x4e\x00\x00\x00\x4f\x00\x26\x00\x3b\x00\xd4\x00\x3d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x42\x00\x00\x00\x43\x00\x44\x00\x00\x00\x46\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x09\x01\x00\x00\x00\x00\x4a\x00\x4b\x00\x3b\x00\x4c\x00\x3d\x00\x4e\x00\x00\x00\x4f\x00\x26\x00\x00\x00\x42\x00\x29\x00\x43\x00\x44\x00\x00\x00\x46\x00\x00\x00\xee\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x3b\x00\x00\x00\x3d\x00\x00\x00\x4a\x00\x4b\x00\x00\x00\x4c\x00\x42\x00\x4e\x00\x43\x00\x4f\x00\x26\x00\x46\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb4\x01\x4a\x00\x4b\x00\x00\x00\x4c\x00\x00\x00\x4e\x00\x00\x00\x4f\x00\x00\x00\x3b\x00\x00\x00\x3d\x00\x00\x00\x00\x00\x26\x00\x00\x00\x00\x00\x42\x00\x00\x00\x43\x00\x44\x00\x00\x00\x46\x00\x00\x00\x00\x00\x00\x00\xb4\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4a\x00\x4b\x00\x3b\x00\x4c\x00\x3d\x00\x4e\x00\x00\x00\x4f\x00\x00\x00\x00\x00\x42\x00\x00\x00\x43\x00\x44\x00\x00\x00\x46\x00\x00\x00\x00\x00\x26\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4a\x00\x4b\x00\x3b\x00\x4c\x00\x3d\x00\x4e\x00\x00\x00\x4f\x00\x00\x00\x00\x00\x42\x00\x00\x00\x43\x00\x44\x00\xc7\x00\x46\x00\x00\x00\x00\x00\x26\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb7\x01\x4b\x00\x00\x00\xb8\x01\x00\x00\xb9\x01\x00\x00\x4f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x3b\x00\x00\x00\x3d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x42\x00\x00\x00\x43\x00\x44\x00\x00\x00\x46\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4a\x00\x4b\x00\x3b\x00\x4c\x00\x3d\x00\x4e\x00\x00\x00\x4f\x00\xda\x01\xdb\x01\x42\x00\x00\x00\x43\x00\x44\x00\x00\x00\x46\x00\x15\x00\x00\x00\x16\x00\x17\x00\x00\x00\x18\x00\x19\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4a\x00\x4b\x00\x00\x00\x4c\x00\x00\x00\x4e\x00\x00\x00\x4f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xdc\x01\xdb\x01\x1a\x00\x00\x00\x7b\x00\x00\x00\x1c\x00\x1d\x00\x15\x00\x00\x00\x16\x00\x17\x00\x00\x00\x18\x00\x19\x00\x00\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x3f\x02\x1a\x00\x00\x00\x7b\x00\x00\x00\x1c\x00\x1d\x00\x15\x00\x00\x00\x16\x00\x17\x00\x00\x00\x18\x00\x19\x00\x00\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1a\x00\x00\x00\x7b\x00\x00\x00\x1c\x00\x1d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x88\x00\x77\x00\x78\x00\x89\x00\x7a\x00\x16\x00\x17\x00\x23\x00\x18\x00\x19\x00\x8a\x00\x8b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1a\x00\x00\x00\x7b\x00\x00\x00\x1c\x00\x1d\x00\x00\x00\x00\x00\x8c\x00\x00\x00\x8d\x00\x00\x00\x00\x00\x8e\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x8f\x00\x90\x00\x91\x00\x92\x00\x93\x00\x94\x00\x95\x00\x23\x00\xf9\x00\x77\x00\x78\x00\xfa\x00\x7a\x00\x16\x00\x17\x00\x00\x00\x18\x00\x19\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x50\x02\x60\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xfc\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1a\x00\x00\x00\x7b\x00\x00\x00\x1c\x00\x1d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\xf9\x00\x77\x00\x78\x00\xfa\x00\x7a\x00\x16\x00\x17\x00\x23\x00\x18\x00\x19\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x8b\x01\x60\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xfc\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1a\x00\x00\x00\x7b\x00\x00\x00\x1c\x00\x1d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\xf9\x00\x77\x00\x78\x00\xfa\x00\x7a\x00\x16\x00\x17\x00\x23\x00\x18\x00\x19\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x92\x01\x60\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xfc\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1a\x00\x00\x00\x7b\x00\x00\x00\x1c\x00\x1d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\xf9\x00\x77\x00\x78\x00\xfa\x00\x7a\x00\x16\x00\x17\x00\x23\x00\x18\x00\x19\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xfb\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xfc\x00\x00\x00\xaf\x01\x00\x00\x00\x00\x00\x00\x1a\x00\x00\x00\x7b\x00\x00\x00\x1c\x00\x1d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\xf9\x00\x77\x00\x78\x00\xfa\x00\x7a\x00\x16\x00\x17\x00\x23\x00\x18\x00\x19\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xfb\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xfc\x00\x00\x00\x41\x01\x00\x00\x00\x00\x00\x00\x1a\x00\x00\x00\x7b\x00\x00\x00\x1c\x00\x1d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\xf9\x00\x77\x00\x78\x00\xfa\x00\x7a\x00\x16\x00\x17\x00\x23\x00\x18\x00\x19\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x5f\x01\x60\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xfc\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1a\x00\x00\x00\x7b\x00\x00\x00\x1c\x00\x1d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\xf9\x00\x77\x00\x78\x00\xfa\x00\x7a\x00\x16\x00\x17\x00\x23\x00\x18\x00\x19\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xfb\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xfc\x00\x00\x00\xfd\x00\x00\x00\x00\x00\x00\x00\x1a\x00\x00\x00\x7b\x00\x00\x00\x1c\x00\x1d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\xf9\x00\x77\x00\x78\x00\xfa\x00\x7a\x00\x16\x00\x17\x00\x23\x00\x18\x00\x19\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xfb\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xfc\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x1a\x00\x00\x00\x7b\x00\x00\x00\x1c\x00\x1d\x00\x00\x00\xf2\x00\xf3\x00\x19\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\xf9\x00\x77\x00\x78\x00\xfa\x00\x7a\x00\x16\x00\x17\x00\x23\x00\x18\x00\x19\x00\x00\x00\x1a\x00\x00\x00\x7b\x00\x00\x00\x1c\x00\x1d\x00\xf8\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xfc\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x1a\x00\x00\x00\x7b\x00\x00\x00\x1c\x00\x1d\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x81\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x16\x00\x17\x00\x23\x00\x18\x00\x19\x00\x00\x00\x00\x00\x82\x00\x83\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x65\x01\x77\x00\x78\x00\x79\x00\x7a\x00\x16\x00\x17\x00\x00\x00\x18\x00\x19\x00\x1a\x00\x66\x01\x7b\x00\x00\x00\x1c\x00\x1d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x00\x00\x1a\x00\x00\x00\x7b\x00\x00\x00\x1c\x00\x1d\x00\x23\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x86\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x16\x00\x17\x00\x23\x00\x18\x00\x19\x00\x00\x00\x87\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x7d\x02\x77\x00\x78\x00\x79\x00\x7a\x00\x16\x00\x17\x00\x00\x00\x18\x00\x19\x00\x00\x00\x1a\x00\x00\x00\x7b\x00\x00\x00\x1c\x00\x1d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x1a\x00\x00\x00\x7b\x00\x00\x00\x1c\x00\x1d\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x4c\x02\x77\x00\x78\x00\x79\x00\x7a\x00\x16\x00\x17\x00\x23\x00\x18\x00\x19\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x02\x77\x00\x78\x00\x79\x00\x7a\x00\x16\x00\x17\x00\x00\x00\x18\x00\x19\x00\x00\x00\x1a\x00\x00\x00\x7b\x00\x00\x00\x1c\x00\x1d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x1a\x00\x00\x00\x7b\x00\x00\x00\x1c\x00\x1d\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x05\x02\x77\x00\x78\x00\x79\x00\x7a\x00\x16\x00\x17\x00\x23\x00\x18\x00\x19\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x06\x02\x77\x00\x78\x00\x79\x00\x7a\x00\x16\x00\x17\x00\x00\x00\x18\x00\x19\x00\x00\x00\x1a\x00\x00\x00\x7b\x00\x00\x00\x1c\x00\x1d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x1a\x00\x00\x00\x7b\x00\x00\x00\x1c\x00\x1d\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\xf9\x01\x77\x00\x78\x00\x79\x00\x7a\x00\x16\x00\x17\x00\x23\x00\x18\x00\x19\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x8d\x01\x77\x00\x78\x00\x79\x00\x7a\x00\x16\x00\x17\x00\x00\x00\x18\x00\x19\x00\x00\x00\x1a\x00\x00\x00\x7b\x00\x00\x00\x1c\x00\x1d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x1a\x00\x00\x00\x7b\x00\x00\x00\x1c\x00\x1d\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x95\x01\x77\x00\x78\x00\x79\x00\x7a\x00\x16\x00\x17\x00\x23\x00\x18\x00\x19\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x9f\x01\x77\x00\x78\x00\x79\x00\x7a\x00\x16\x00\x17\x00\x00\x00\x18\x00\x19\x00\x00\x00\x1a\x00\x00\x00\x7b\x00\x00\x00\x1c\x00\x1d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x1a\x00\x00\x00\x7b\x00\x00\x00\x1c\x00\x1d\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\xa0\x01\x77\x00\x78\x00\x79\x00\x7a\x00\x16\x00\x17\x00\x23\x00\x18\x00\x19\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xb0\x01\x77\x00\x78\x00\x79\x00\x7a\x00\x16\x00\x17\x00\x00\x00\x18\x00\x19\x00\x00\x00\x1a\x00\x00\x00\x7b\x00\x00\x00\x1c\x00\x1d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x1a\x00\x00\x00\x7b\x00\x00\x00\x1c\x00\x1d\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x61\x01\x77\x00\x78\x00\x79\x00\x7a\x00\x16\x00\x17\x00\x23\x00\x18\x00\x19\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x62\x01\x77\x00\x78\x00\x79\x00\x7a\x00\x16\x00\x17\x00\x00\x00\x18\x00\x19\x00\x00\x00\x1a\x00\x00\x00\x7b\x00\x00\x00\x1c\x00\x1d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x1a\x00\x00\x00\x7b\x00\x00\x00\x1c\x00\x1d\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x64\x01\x77\x00\x78\x00\x79\x00\x7a\x00\x16\x00\x17\x00\x23\x00\x18\x00\x19\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x76\x01\x77\x00\x78\x00\x79\x00\x7a\x00\x16\x00\x17\x00\x00\x00\x18\x00\x19\x00\x00\x00\x1a\x00\x00\x00\x7b\x00\x00\x00\x1c\x00\x1d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x1a\x00\x00\x00\x7b\x00\x00\x00\x1c\x00\x1d\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\xf1\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x16\x00\x17\x00\x23\x00\x18\x00\x19\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x76\x00\x77\x00\x78\x00\x79\x00\x7a\x00\x16\x00\x17\x00\x00\x00\x18\x00\x19\x00\x00\x00\x1a\x00\x00\x00\x7b\x00\x00\x00\x1c\x00\x1d\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x1a\x00\x00\x00\x7b\x00\x00\x00\x1c\x00\x1d\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x00\x00\xdb\x00\x78\x00\xdc\x00\x7a\x00\x16\x00\x17\x00\x23\x00\x18\x00\x19\x00\xa1\x01\x00\x00\x16\x00\x17\x00\x00\x00\x18\x00\x19\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa2\x01\xa3\x01\x00\x00\x00\x00\x1a\x00\xa4\x01\x7b\x00\x00\x00\x1c\x00\x1d\x00\x00\x00\x1a\x00\x00\x00\x7b\x00\x00\x00\x1c\x00\x1d\x00\x00\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x00\x00\x00\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x00\x00\x00\x00\xa1\x01\x00\x00\x16\x00\x17\x00\x23\x00\x18\x00\x19\x00\xa1\x01\x00\x00\x16\x00\x17\x00\x00\x00\x18\x00\x19\x00\x00\x00\x00\x00\xa5\x01\xa3\x01\x00\x00\x00\x00\x00\x00\xa4\x01\x00\x00\x00\x00\x0d\x02\x00\x00\x00\x00\x1a\x00\xa4\x01\x7b\x00\x00\x00\x1c\x00\x1d\x00\x00\x00\x1a\x00\x00\x00\x7b\x00\x00\x00\x1c\x00\x1d\x00\x00\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x00\x00\x00\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x51\x01\xcf\x00\x17\x00\x00\x00\x18\x00\x19\x00\x23\x00\xcf\x00\x17\x00\x00\x00\x18\x00\x19\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1a\x00\x00\x00\x7b\x00\x00\x00\x1c\x00\x1d\x00\x1a\x00\x00\x00\x7b\x00\x00\x00\x1c\x00\x1d\x00\xd5\x00\x19\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x00\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x23\x00\x00\x00\x1a\x00\x00\x00\x7b\x00\x00\x00\x1c\x00\x1d\x00\xae\x00\x19\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x23\x00\x00\x00\x1a\x00\x00\x00\x7b\x00\x00\x00\x1c\x00\x1d\x00\x1a\x00\x00\x00\x7b\x00\x00\x00\x1c\x00\x1d\x00\x00\x00\x00\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x00\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x23\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00"# - -happyReduceArr = array (1, 389) [ - (1 , happyReduce_1), - (2 , happyReduce_2), - (3 , happyReduce_3), - (4 , happyReduce_4), - (5 , happyReduce_5), - (6 , happyReduce_6), - (7 , happyReduce_7), - (8 , happyReduce_8), - (9 , happyReduce_9), - (10 , happyReduce_10), - (11 , happyReduce_11), - (12 , happyReduce_12), - (13 , happyReduce_13), - (14 , happyReduce_14), - (15 , happyReduce_15), - (16 , happyReduce_16), - (17 , happyReduce_17), - (18 , happyReduce_18), - (19 , happyReduce_19), - (20 , happyReduce_20), - (21 , happyReduce_21), - (22 , happyReduce_22), - (23 , happyReduce_23), - (24 , happyReduce_24), - (25 , happyReduce_25), - (26 , happyReduce_26), - (27 , happyReduce_27), - (28 , happyReduce_28), - (29 , happyReduce_29), - (30 , happyReduce_30), - (31 , happyReduce_31), - (32 , happyReduce_32), - (33 , happyReduce_33), - (34 , happyReduce_34), - (35 , happyReduce_35), - (36 , happyReduce_36), - (37 , happyReduce_37), - (38 , happyReduce_38), - (39 , happyReduce_39), - (40 , happyReduce_40), - (41 , happyReduce_41), - (42 , happyReduce_42), - (43 , happyReduce_43), - (44 , happyReduce_44), - (45 , happyReduce_45), - (46 , happyReduce_46), - (47 , happyReduce_47), - (48 , happyReduce_48), - (49 , happyReduce_49), - (50 , happyReduce_50), - (51 , happyReduce_51), - (52 , happyReduce_52), - (53 , happyReduce_53), - (54 , happyReduce_54), - (55 , happyReduce_55), - (56 , happyReduce_56), - (57 , happyReduce_57), - (58 , happyReduce_58), - (59 , happyReduce_59), - (60 , happyReduce_60), - (61 , happyReduce_61), - (62 , happyReduce_62), - (63 , happyReduce_63), - (64 , happyReduce_64), - (65 , happyReduce_65), - (66 , happyReduce_66), - (67 , happyReduce_67), - (68 , happyReduce_68), - (69 , happyReduce_69), - (70 , happyReduce_70), - (71 , happyReduce_71), - (72 , happyReduce_72), - (73 , happyReduce_73), - (74 , happyReduce_74), - (75 , happyReduce_75), - (76 , happyReduce_76), - (77 , happyReduce_77), - (78 , happyReduce_78), - (79 , happyReduce_79), - (80 , happyReduce_80), - (81 , happyReduce_81), - (82 , happyReduce_82), - (83 , happyReduce_83), - (84 , happyReduce_84), - (85 , happyReduce_85), - (86 , happyReduce_86), - (87 , happyReduce_87), - (88 , happyReduce_88), - (89 , happyReduce_89), - (90 , happyReduce_90), - (91 , happyReduce_91), - (92 , happyReduce_92), - (93 , happyReduce_93), - (94 , happyReduce_94), - (95 , happyReduce_95), - (96 , happyReduce_96), - (97 , happyReduce_97), - (98 , happyReduce_98), - (99 , happyReduce_99), - (100 , happyReduce_100), - (101 , happyReduce_101), - (102 , happyReduce_102), - (103 , happyReduce_103), - (104 , happyReduce_104), - (105 , happyReduce_105), - (106 , happyReduce_106), - (107 , happyReduce_107), - (108 , happyReduce_108), - (109 , happyReduce_109), - (110 , happyReduce_110), - (111 , happyReduce_111), - (112 , happyReduce_112), - (113 , happyReduce_113), - (114 , happyReduce_114), - (115 , happyReduce_115), - (116 , happyReduce_116), - (117 , happyReduce_117), - (118 , happyReduce_118), - (119 , happyReduce_119), - (120 , happyReduce_120), - (121 , happyReduce_121), - (122 , happyReduce_122), - (123 , happyReduce_123), - (124 , happyReduce_124), - (125 , happyReduce_125), - (126 , happyReduce_126), - (127 , happyReduce_127), - (128 , happyReduce_128), - (129 , happyReduce_129), - (130 , happyReduce_130), - (131 , happyReduce_131), - (132 , happyReduce_132), - (133 , happyReduce_133), - (134 , happyReduce_134), - (135 , happyReduce_135), - (136 , happyReduce_136), - (137 , happyReduce_137), - (138 , happyReduce_138), - (139 , happyReduce_139), - (140 , happyReduce_140), - (141 , happyReduce_141), - (142 , happyReduce_142), - (143 , happyReduce_143), - (144 , happyReduce_144), - (145 , happyReduce_145), - (146 , happyReduce_146), - (147 , happyReduce_147), - (148 , happyReduce_148), - (149 , happyReduce_149), - (150 , happyReduce_150), - (151 , happyReduce_151), - (152 , happyReduce_152), - (153 , happyReduce_153), - (154 , happyReduce_154), - (155 , happyReduce_155), - (156 , happyReduce_156), - (157 , happyReduce_157), - (158 , happyReduce_158), - (159 , happyReduce_159), - (160 , happyReduce_160), - (161 , happyReduce_161), - (162 , happyReduce_162), - (163 , happyReduce_163), - (164 , happyReduce_164), - (165 , happyReduce_165), - (166 , happyReduce_166), - (167 , happyReduce_167), - (168 , happyReduce_168), - (169 , happyReduce_169), - (170 , happyReduce_170), - (171 , happyReduce_171), - (172 , happyReduce_172), - (173 , happyReduce_173), - (174 , happyReduce_174), - (175 , happyReduce_175), - (176 , happyReduce_176), - (177 , happyReduce_177), - (178 , happyReduce_178), - (179 , happyReduce_179), - (180 , happyReduce_180), - (181 , happyReduce_181), - (182 , happyReduce_182), - (183 , happyReduce_183), - (184 , happyReduce_184), - (185 , happyReduce_185), - (186 , happyReduce_186), - (187 , happyReduce_187), - (188 , happyReduce_188), - (189 , happyReduce_189), - (190 , happyReduce_190), - (191 , happyReduce_191), - (192 , happyReduce_192), - (193 , happyReduce_193), - (194 , happyReduce_194), - (195 , happyReduce_195), - (196 , happyReduce_196), - (197 , happyReduce_197), - (198 , happyReduce_198), - (199 , happyReduce_199), - (200 , happyReduce_200), - (201 , happyReduce_201), - (202 , happyReduce_202), - (203 , happyReduce_203), - (204 , happyReduce_204), - (205 , happyReduce_205), - (206 , happyReduce_206), - (207 , happyReduce_207), - (208 , happyReduce_208), - (209 , happyReduce_209), - (210 , happyReduce_210), - (211 , happyReduce_211), - (212 , happyReduce_212), - (213 , happyReduce_213), - (214 , happyReduce_214), - (215 , happyReduce_215), - (216 , happyReduce_216), - (217 , happyReduce_217), - (218 , happyReduce_218), - (219 , happyReduce_219), - (220 , happyReduce_220), - (221 , happyReduce_221), - (222 , happyReduce_222), - (223 , happyReduce_223), - (224 , happyReduce_224), - (225 , happyReduce_225), - (226 , happyReduce_226), - (227 , happyReduce_227), - (228 , happyReduce_228), - (229 , happyReduce_229), - (230 , happyReduce_230), - (231 , happyReduce_231), - (232 , happyReduce_232), - (233 , happyReduce_233), - (234 , happyReduce_234), - (235 , happyReduce_235), - (236 , happyReduce_236), - (237 , happyReduce_237), - (238 , happyReduce_238), - (239 , happyReduce_239), - (240 , happyReduce_240), - (241 , happyReduce_241), - (242 , happyReduce_242), - (243 , happyReduce_243), - (244 , happyReduce_244), - (245 , happyReduce_245), - (246 , happyReduce_246), - (247 , happyReduce_247), - (248 , happyReduce_248), - (249 , happyReduce_249), - (250 , happyReduce_250), - (251 , happyReduce_251), - (252 , happyReduce_252), - (253 , happyReduce_253), - (254 , happyReduce_254), - (255 , happyReduce_255), - (256 , happyReduce_256), - (257 , happyReduce_257), - (258 , happyReduce_258), - (259 , happyReduce_259), - (260 , happyReduce_260), - (261 , happyReduce_261), - (262 , happyReduce_262), - (263 , happyReduce_263), - (264 , happyReduce_264), - (265 , happyReduce_265), - (266 , happyReduce_266), - (267 , happyReduce_267), - (268 , happyReduce_268), - (269 , happyReduce_269), - (270 , happyReduce_270), - (271 , happyReduce_271), - (272 , happyReduce_272), - (273 , happyReduce_273), - (274 , happyReduce_274), - (275 , happyReduce_275), - (276 , happyReduce_276), - (277 , happyReduce_277), - (278 , happyReduce_278), - (279 , happyReduce_279), - (280 , happyReduce_280), - (281 , happyReduce_281), - (282 , happyReduce_282), - (283 , happyReduce_283), - (284 , happyReduce_284), - (285 , happyReduce_285), - (286 , happyReduce_286), - (287 , happyReduce_287), - (288 , happyReduce_288), - (289 , happyReduce_289), - (290 , happyReduce_290), - (291 , happyReduce_291), - (292 , happyReduce_292), - (293 , happyReduce_293), - (294 , happyReduce_294), - (295 , happyReduce_295), - (296 , happyReduce_296), - (297 , happyReduce_297), - (298 , happyReduce_298), - (299 , happyReduce_299), - (300 , happyReduce_300), - (301 , happyReduce_301), - (302 , happyReduce_302), - (303 , happyReduce_303), - (304 , happyReduce_304), - (305 , happyReduce_305), - (306 , happyReduce_306), - (307 , happyReduce_307), - (308 , happyReduce_308), - (309 , happyReduce_309), - (310 , happyReduce_310), - (311 , happyReduce_311), - (312 , happyReduce_312), - (313 , happyReduce_313), - (314 , happyReduce_314), - (315 , happyReduce_315), - (316 , happyReduce_316), - (317 , happyReduce_317), - (318 , happyReduce_318), - (319 , happyReduce_319), - (320 , happyReduce_320), - (321 , happyReduce_321), - (322 , happyReduce_322), - (323 , happyReduce_323), - (324 , happyReduce_324), - (325 , happyReduce_325), - (326 , happyReduce_326), - (327 , happyReduce_327), - (328 , happyReduce_328), - (329 , happyReduce_329), - (330 , happyReduce_330), - (331 , happyReduce_331), - (332 , happyReduce_332), - (333 , happyReduce_333), - (334 , happyReduce_334), - (335 , happyReduce_335), - (336 , happyReduce_336), - (337 , happyReduce_337), - (338 , happyReduce_338), - (339 , happyReduce_339), - (340 , happyReduce_340), - (341 , happyReduce_341), - (342 , happyReduce_342), - (343 , happyReduce_343), - (344 , happyReduce_344), - (345 , happyReduce_345), - (346 , happyReduce_346), - (347 , happyReduce_347), - (348 , happyReduce_348), - (349 , happyReduce_349), - (350 , happyReduce_350), - (351 , happyReduce_351), - (352 , happyReduce_352), - (353 , happyReduce_353), - (354 , happyReduce_354), - (355 , happyReduce_355), - (356 , happyReduce_356), - (357 , happyReduce_357), - (358 , happyReduce_358), - (359 , happyReduce_359), - (360 , happyReduce_360), - (361 , happyReduce_361), - (362 , happyReduce_362), - (363 , happyReduce_363), - (364 , happyReduce_364), - (365 , happyReduce_365), - (366 , happyReduce_366), - (367 , happyReduce_367), - (368 , happyReduce_368), - (369 , happyReduce_369), - (370 , happyReduce_370), - (371 , happyReduce_371), - (372 , happyReduce_372), - (373 , happyReduce_373), - (374 , happyReduce_374), - (375 , happyReduce_375), - (376 , happyReduce_376), - (377 , happyReduce_377), - (378 , happyReduce_378), - (379 , happyReduce_379), - (380 , happyReduce_380), - (381 , happyReduce_381), - (382 , happyReduce_382), - (383 , happyReduce_383), - (384 , happyReduce_384), - (385 , happyReduce_385), - (386 , happyReduce_386), - (387 , happyReduce_387), - (388 , happyReduce_388), - (389 , happyReduce_389) - ] - -happy_n_terms = 84 :: Int -happy_n_nonterms = 156 :: Int - -happyReduce_1 = happyReduce 7# 0# happyReduction_1 -happyReduction_1 (happy_x_7 `HappyStk` - happy_x_6 `HappyStk` - happy_x_5 `HappyStk` - happy_x_4 `HappyStk` - happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) - = case happyOut5 happy_x_1 of { happy_var_1 -> - case happyOut144 happy_x_3 of { happy_var_3 -> - case happyOut147 happy_x_4 of { happy_var_4 -> - case happyOut9 happy_x_5 of { happy_var_5 -> - case happyOut6 happy_x_7 of { happy_var_7 -> - happyIn4 - (case happy_var_1 of { (opts,info,doc) -> - HsModule happy_var_3 happy_var_4 happy_var_5 (reverse (fst happy_var_7)) (snd happy_var_7) - opts info doc } - ) `HappyStk` happyRest}}}}} - -happyReduce_2 = happySpecReduce_2 0# happyReduction_2 -happyReduction_2 happy_x_2 - happy_x_1 - = case happyOut6 happy_x_1 of { happy_var_1 -> - case happyOut144 happy_x_2 of { happy_var_2 -> - happyIn4 - (HsModule happy_var_2 main_mod Nothing (reverse (fst happy_var_1)) (snd happy_var_1) - Nothing emptyModuleInfo Nothing - )}} - -happyReduce_3 = happySpecReduce_1 1# happyReduction_3 -happyReduction_3 happy_x_1 - = case happyOut159 happy_x_1 of { happy_var_1 -> - happyIn5 - ((Nothing, fst happy_var_1, snd happy_var_1) - )} - -happyReduce_4 = happySpecReduce_1 1# happyReduction_4 -happyReduction_4 happy_x_1 - = case happyOutTok happy_x_1 of { (DocOptions happy_var_1) -> - happyIn5 - ((Just happy_var_1, emptyModuleInfo,Nothing) - )} - -happyReduce_5 = happySpecReduce_2 1# happyReduction_5 -happyReduction_5 happy_x_2 - happy_x_1 - = case happyOutTok happy_x_1 of { (DocOptions happy_var_1) -> - case happyOut159 happy_x_2 of { happy_var_2 -> - happyIn5 - ((Just happy_var_1, fst happy_var_2, snd happy_var_2) - )}} - -happyReduce_6 = happySpecReduce_2 1# happyReduction_6 -happyReduction_6 happy_x_2 - happy_x_1 - = case happyOut159 happy_x_1 of { happy_var_1 -> - case happyOutTok happy_x_2 of { (DocOptions happy_var_2) -> - happyIn5 - ((Just happy_var_2, fst happy_var_1, snd happy_var_1) - )}} - -happyReduce_7 = happySpecReduce_0 1# happyReduction_7 -happyReduction_7 = happyIn5 - ((Nothing, emptyModuleInfo,Nothing) - ) - -happyReduce_8 = happySpecReduce_3 2# happyReduction_8 -happyReduction_8 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOut7 happy_x_2 of { happy_var_2 -> - happyIn6 - (happy_var_2 - )} - -happyReduce_9 = happySpecReduce_3 2# happyReduction_9 -happyReduction_9 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOut7 happy_x_2 of { happy_var_2 -> - happyIn6 - (happy_var_2 - )} - -happyReduce_10 = happySpecReduce_3 3# happyReduction_10 -happyReduction_10 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOut17 happy_x_1 of { happy_var_1 -> - case happyOut32 happy_x_3 of { happy_var_3 -> - happyIn7 - ((happy_var_1, happy_var_3) - )}} - -happyReduce_11 = happySpecReduce_1 3# happyReduction_11 -happyReduction_11 happy_x_1 - = case happyOut32 happy_x_1 of { happy_var_1 -> - happyIn7 - (([], happy_var_1) - )} - -happyReduce_12 = happySpecReduce_1 3# happyReduction_12 -happyReduction_12 happy_x_1 - = case happyOut17 happy_x_1 of { happy_var_1 -> - happyIn7 - ((happy_var_1, []) - )} - -happyReduce_13 = happySpecReduce_1 4# happyReduction_13 -happyReduction_13 happy_x_1 - = happyIn8 - (() - ) - -happyReduce_14 = happySpecReduce_0 4# happyReduction_14 -happyReduction_14 = happyIn8 - (() - ) - -happyReduce_15 = happySpecReduce_1 5# happyReduction_15 -happyReduction_15 happy_x_1 - = case happyOut10 happy_x_1 of { happy_var_1 -> - happyIn9 - (Just happy_var_1 - )} - -happyReduce_16 = happySpecReduce_0 5# happyReduction_16 -happyReduction_16 = happyIn9 - (Nothing - ) - -happyReduce_17 = happySpecReduce_3 6# happyReduction_17 -happyReduction_17 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOut11 happy_x_2 of { happy_var_2 -> - happyIn10 - (happy_var_2 - )} - -happyReduce_18 = happySpecReduce_2 7# happyReduction_18 -happyReduction_18 happy_x_2 - happy_x_1 - = case happyOut14 happy_x_1 of { happy_var_1 -> - case happyOut12 happy_x_2 of { happy_var_2 -> - happyIn11 - (happy_var_1 : happy_var_2 - )}} - -happyReduce_19 = happySpecReduce_2 7# happyReduction_19 -happyReduction_19 happy_x_2 - happy_x_1 - = case happyOut13 happy_x_1 of { happy_var_1 -> - case happyOut11 happy_x_2 of { happy_var_2 -> - happyIn11 - (happy_var_1 : happy_var_2 - )}} - -happyReduce_20 = happySpecReduce_0 7# happyReduction_20 -happyReduction_20 = happyIn11 - ([] - ) - -happyReduce_21 = happySpecReduce_2 8# happyReduction_21 -happyReduction_21 happy_x_2 - happy_x_1 - = case happyOut13 happy_x_1 of { happy_var_1 -> - case happyOut12 happy_x_2 of { happy_var_2 -> - happyIn12 - (happy_var_1 : happy_var_2 - )}} - -happyReduce_22 = happySpecReduce_2 8# happyReduction_22 -happyReduction_22 happy_x_2 - happy_x_1 - = case happyOut11 happy_x_2 of { happy_var_2 -> - happyIn12 - (happy_var_2 - )} - -happyReduce_23 = happySpecReduce_0 8# happyReduction_23 -happyReduction_23 = happyIn12 - ([] - ) - -happyReduce_24 = happySpecReduce_1 9# happyReduction_24 -happyReduction_24 happy_x_1 - = case happyOut156 happy_x_1 of { happy_var_1 -> - happyIn13 - (case happy_var_1 of { (i,s) -> HsEGroup i s } - )} - -happyReduce_25 = happySpecReduce_1 9# happyReduction_25 -happyReduction_25 happy_x_1 - = case happyOut155 happy_x_1 of { happy_var_1 -> - happyIn13 - (HsEDocNamed (fst happy_var_1) - )} - -happyReduce_26 = happySpecReduce_1 9# happyReduction_26 -happyReduction_26 happy_x_1 - = case happyOut153 happy_x_1 of { happy_var_1 -> - happyIn13 - (HsEDoc happy_var_1 - )} - -happyReduce_27 = happySpecReduce_1 10# happyReduction_27 -happyReduction_27 happy_x_1 - = case happyOut119 happy_x_1 of { happy_var_1 -> - happyIn14 - (HsEVar happy_var_1 - )} - -happyReduce_28 = happySpecReduce_1 10# happyReduction_28 -happyReduction_28 happy_x_1 - = case happyOut51 happy_x_1 of { happy_var_1 -> - happyIn14 - (HsEAbs happy_var_1 - )} - -happyReduce_29 = happyReduce 4# 10# happyReduction_29 -happyReduction_29 (happy_x_4 `HappyStk` - happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) - = case happyOut51 happy_x_1 of { happy_var_1 -> - happyIn14 - (HsEThingAll happy_var_1 - ) `HappyStk` happyRest} - -happyReduce_30 = happySpecReduce_3 10# happyReduction_30 -happyReduction_30 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOut51 happy_x_1 of { happy_var_1 -> - happyIn14 - (HsEThingWith happy_var_1 [] - )} - -happyReduce_31 = happyReduce 4# 10# happyReduction_31 -happyReduction_31 (happy_x_4 `HappyStk` - happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) - = case happyOut51 happy_x_1 of { happy_var_1 -> - case happyOut15 happy_x_3 of { happy_var_3 -> - happyIn14 - (HsEThingWith happy_var_1 (reverse happy_var_3) - ) `HappyStk` happyRest}} - -happyReduce_32 = happySpecReduce_2 10# happyReduction_32 -happyReduction_32 happy_x_2 - happy_x_1 - = case happyOut147 happy_x_2 of { happy_var_2 -> - happyIn14 - (HsEModuleContents happy_var_2 - )} - -happyReduce_33 = happySpecReduce_3 11# happyReduction_33 -happyReduction_33 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOut15 happy_x_1 of { happy_var_1 -> - case happyOut16 happy_x_3 of { happy_var_3 -> - happyIn15 - (happy_var_3 : happy_var_1 - )}} - -happyReduce_34 = happySpecReduce_1 11# happyReduction_34 -happyReduction_34 happy_x_1 - = case happyOut16 happy_x_1 of { happy_var_1 -> - happyIn15 - ([happy_var_1] - )} - -happyReduce_35 = happySpecReduce_1 12# happyReduction_35 -happyReduction_35 happy_x_1 - = case happyOut119 happy_x_1 of { happy_var_1 -> - happyIn16 - (happy_var_1 - )} - -happyReduce_36 = happySpecReduce_1 12# happyReduction_36 -happyReduction_36 happy_x_1 - = case happyOut117 happy_x_1 of { happy_var_1 -> - happyIn16 - (happy_var_1 - )} - -happyReduce_37 = happySpecReduce_3 13# happyReduction_37 -happyReduction_37 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOut17 happy_x_1 of { happy_var_1 -> - case happyOut18 happy_x_3 of { happy_var_3 -> - happyIn17 - (happy_var_3 : happy_var_1 - )}} - -happyReduce_38 = happySpecReduce_1 13# happyReduction_38 -happyReduction_38 happy_x_1 - = case happyOut18 happy_x_1 of { happy_var_1 -> - happyIn17 - ([happy_var_1] - )} - -happyReduce_39 = happyReduce 6# 14# happyReduction_39 -happyReduction_39 (happy_x_6 `HappyStk` - happy_x_5 `HappyStk` - happy_x_4 `HappyStk` - happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) - = case happyOut144 happy_x_2 of { happy_var_2 -> - case happyOut19 happy_x_3 of { happy_var_3 -> - case happyOut147 happy_x_4 of { happy_var_4 -> - case happyOut20 happy_x_5 of { happy_var_5 -> - case happyOut21 happy_x_6 of { happy_var_6 -> - happyIn18 - (HsImportDecl happy_var_2 happy_var_4 happy_var_3 happy_var_5 happy_var_6 - ) `HappyStk` happyRest}}}}} - -happyReduce_40 = happySpecReduce_1 15# happyReduction_40 -happyReduction_40 happy_x_1 - = happyIn19 - (True - ) - -happyReduce_41 = happySpecReduce_0 15# happyReduction_41 -happyReduction_41 = happyIn19 - (False - ) - -happyReduce_42 = happySpecReduce_2 16# happyReduction_42 -happyReduction_42 happy_x_2 - happy_x_1 - = case happyOut147 happy_x_2 of { happy_var_2 -> - happyIn20 - (Just happy_var_2 - )} - -happyReduce_43 = happySpecReduce_0 16# happyReduction_43 -happyReduction_43 = happyIn20 - (Nothing - ) - -happyReduce_44 = happySpecReduce_1 17# happyReduction_44 -happyReduction_44 happy_x_1 - = case happyOut22 happy_x_1 of { happy_var_1 -> - happyIn21 - (Just happy_var_1 - )} - -happyReduce_45 = happySpecReduce_0 17# happyReduction_45 -happyReduction_45 = happyIn21 - (Nothing - ) - -happyReduce_46 = happySpecReduce_3 18# happyReduction_46 -happyReduction_46 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOut23 happy_x_2 of { happy_var_2 -> - happyIn22 - ((False, reverse happy_var_2) - )} - -happyReduce_47 = happyReduce 4# 18# happyReduction_47 -happyReduction_47 (happy_x_4 `HappyStk` - happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) - = case happyOut23 happy_x_3 of { happy_var_3 -> - happyIn22 - ((True, reverse happy_var_3) - ) `HappyStk` happyRest} - -happyReduce_48 = happySpecReduce_3 19# happyReduction_48 -happyReduction_48 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOut23 happy_x_1 of { happy_var_1 -> - case happyOut24 happy_x_3 of { happy_var_3 -> - happyIn23 - (happy_var_3 : happy_var_1 - )}} - -happyReduce_49 = happySpecReduce_2 19# happyReduction_49 -happyReduction_49 happy_x_2 - happy_x_1 - = case happyOut23 happy_x_1 of { happy_var_1 -> - happyIn23 - (happy_var_1 - )} - -happyReduce_50 = happySpecReduce_1 19# happyReduction_50 -happyReduction_50 happy_x_1 - = case happyOut24 happy_x_1 of { happy_var_1 -> - happyIn23 - ([happy_var_1] - )} - -happyReduce_51 = happySpecReduce_0 19# happyReduction_51 -happyReduction_51 = happyIn23 - ([] - ) - -happyReduce_52 = happySpecReduce_1 20# happyReduction_52 -happyReduction_52 happy_x_1 - = case happyOut118 happy_x_1 of { happy_var_1 -> - happyIn24 - (HsIVar happy_var_1 - )} - -happyReduce_53 = happySpecReduce_1 20# happyReduction_53 -happyReduction_53 happy_x_1 - = case happyOut25 happy_x_1 of { happy_var_1 -> - happyIn24 - (HsIAbs happy_var_1 - )} - -happyReduce_54 = happyReduce 4# 20# happyReduction_54 -happyReduction_54 (happy_x_4 `HappyStk` - happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) - = case happyOut25 happy_x_1 of { happy_var_1 -> - happyIn24 - (HsIThingAll happy_var_1 - ) `HappyStk` happyRest} - -happyReduce_55 = happySpecReduce_3 20# happyReduction_55 -happyReduction_55 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOut25 happy_x_1 of { happy_var_1 -> - happyIn24 - (HsIThingWith happy_var_1 [] - )} - -happyReduce_56 = happyReduce 4# 20# happyReduction_56 -happyReduction_56 (happy_x_4 `HappyStk` - happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) - = case happyOut25 happy_x_1 of { happy_var_1 -> - case happyOut26 happy_x_3 of { happy_var_3 -> - happyIn24 - (HsIThingWith happy_var_1 (reverse happy_var_3) - ) `HappyStk` happyRest}} - -happyReduce_57 = happySpecReduce_1 21# happyReduction_57 -happyReduction_57 happy_x_1 - = case happyOut148 happy_x_1 of { happy_var_1 -> - happyIn25 - (happy_var_1 - )} - -happyReduce_58 = happySpecReduce_2 21# happyReduction_58 -happyReduction_58 happy_x_2 - happy_x_1 - = happyIn25 - (unit_tycon_name - ) - -happyReduce_59 = happySpecReduce_3 21# happyReduction_59 -happyReduction_59 happy_x_3 - happy_x_2 - happy_x_1 - = happyIn25 - (fun_tycon_name - ) - -happyReduce_60 = happySpecReduce_2 21# happyReduction_60 -happyReduction_60 happy_x_2 - happy_x_1 - = happyIn25 - (list_tycon_name - ) - -happyReduce_61 = happySpecReduce_3 21# happyReduction_61 -happyReduction_61 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOut97 happy_x_2 of { happy_var_2 -> - happyIn25 - (tuple_tycon_name happy_var_2 - )} - -happyReduce_62 = happySpecReduce_3 22# happyReduction_62 -happyReduction_62 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOut26 happy_x_1 of { happy_var_1 -> - case happyOut27 happy_x_3 of { happy_var_3 -> - happyIn26 - (happy_var_3 : happy_var_1 - )}} - -happyReduce_63 = happySpecReduce_1 22# happyReduction_63 -happyReduction_63 happy_x_1 - = case happyOut27 happy_x_1 of { happy_var_1 -> - happyIn26 - ([happy_var_1] - )} - -happyReduce_64 = happySpecReduce_1 23# happyReduction_64 -happyReduction_64 happy_x_1 - = case happyOut118 happy_x_1 of { happy_var_1 -> - happyIn27 - (happy_var_1 - )} - -happyReduce_65 = happySpecReduce_1 23# happyReduction_65 -happyReduction_65 happy_x_1 - = case happyOut120 happy_x_1 of { happy_var_1 -> - happyIn27 - (happy_var_1 - )} - -happyReduce_66 = happyReduce 4# 24# happyReduction_66 -happyReduction_66 (happy_x_4 `HappyStk` - happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) - = case happyOut144 happy_x_1 of { happy_var_1 -> - case happyOut30 happy_x_2 of { happy_var_2 -> - case happyOut29 happy_x_3 of { happy_var_3 -> - case happyOut31 happy_x_4 of { happy_var_4 -> - happyIn28 - (HsInfixDecl happy_var_1 happy_var_2 happy_var_3 (reverse happy_var_4) - ) `HappyStk` happyRest}}}} - -happyReduce_67 = happySpecReduce_0 25# happyReduction_67 -happyReduction_67 = happyIn29 - (9 - ) - -happyReduce_68 = happyMonadReduce 1# 25# happyReduction_68 -happyReduction_68 (happy_x_1 `HappyStk` - happyRest) tk - = happyThen (case happyOutTok happy_x_1 of { (IntTok happy_var_1) -> - ( checkPrec happy_var_1 `thenP` \p -> - returnP (fromIntegral happy_var_1))} - ) (\r -> happyReturn (happyIn29 r)) - -happyReduce_69 = happySpecReduce_1 26# happyReduction_69 -happyReduction_69 happy_x_1 - = happyIn30 - (HsAssocNone - ) - -happyReduce_70 = happySpecReduce_1 26# happyReduction_70 -happyReduction_70 happy_x_1 - = happyIn30 - (HsAssocLeft - ) - -happyReduce_71 = happySpecReduce_1 26# happyReduction_71 -happyReduction_71 happy_x_1 - = happyIn30 - (HsAssocRight - ) - -happyReduce_72 = happySpecReduce_3 27# happyReduction_72 -happyReduction_72 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOut31 happy_x_1 of { happy_var_1 -> - case happyOut128 happy_x_3 of { happy_var_3 -> - happyIn31 - (happy_var_3 : happy_var_1 - )}} - -happyReduce_73 = happySpecReduce_1 27# happyReduction_73 -happyReduction_73 happy_x_1 - = case happyOut128 happy_x_1 of { happy_var_1 -> - happyIn31 - ([happy_var_1] - )} - -happyReduce_74 = happySpecReduce_3 28# happyReduction_74 -happyReduction_74 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOut33 happy_x_1 of { happy_var_1 -> - case happyOut32 happy_x_3 of { happy_var_3 -> - happyIn32 - (happy_var_1 : happy_var_3 - )}} - -happyReduce_75 = happySpecReduce_2 28# happyReduction_75 -happyReduction_75 happy_x_2 - happy_x_1 - = case happyOut32 happy_x_2 of { happy_var_2 -> - happyIn32 - (happy_var_2 - )} - -happyReduce_76 = happySpecReduce_2 28# happyReduction_76 -happyReduction_76 happy_x_2 - happy_x_1 - = case happyOut37 happy_x_1 of { happy_var_1 -> - case happyOut32 happy_x_2 of { happy_var_2 -> - happyIn32 - (happy_var_1 : happy_var_2 - )}} - -happyReduce_77 = happySpecReduce_1 28# happyReduction_77 -happyReduction_77 happy_x_1 - = case happyOut33 happy_x_1 of { happy_var_1 -> - happyIn32 - ([happy_var_1] - )} - -happyReduce_78 = happySpecReduce_0 28# happyReduction_78 -happyReduction_78 = happyIn32 - ([] - ) - -happyReduce_79 = happyReduce 5# 29# happyReduction_79 -happyReduction_79 (happy_x_5 `HappyStk` - happy_x_4 `HappyStk` - happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) - = case happyOut56 happy_x_2 of { happy_var_2 -> - case happyOut144 happy_x_3 of { happy_var_3 -> - case happyOut53 happy_x_5 of { happy_var_5 -> - happyIn33 - (HsTypeDecl happy_var_3 (fst happy_var_2) (snd happy_var_2) happy_var_5 Nothing - ) `HappyStk` happyRest}}} - -happyReduce_80 = happyMonadReduce 5# 29# happyReduction_80 -happyReduction_80 (happy_x_5 `HappyStk` - happy_x_4 `HappyStk` - happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen (case happyOut52 happy_x_2 of { happy_var_2 -> - case happyOut144 happy_x_3 of { happy_var_3 -> - case happyOut58 happy_x_4 of { happy_var_4 -> - case happyOut70 happy_x_5 of { happy_var_5 -> - ( checkDataHeader happy_var_2 `thenP` \(cs,c,t) -> - returnP (HsDataDecl happy_var_3 cs c t happy_var_4 happy_var_5 Nothing))}}}} - ) (\r -> happyReturn (happyIn33 r)) - -happyReduce_81 = happyMonadReduce 6# 29# happyReduction_81 -happyReduction_81 (happy_x_6 `HappyStk` - happy_x_5 `HappyStk` - happy_x_4 `HappyStk` - happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen (case happyOut52 happy_x_2 of { happy_var_2 -> - case happyOut144 happy_x_3 of { happy_var_3 -> - case happyOut60 happy_x_5 of { happy_var_5 -> - case happyOut70 happy_x_6 of { happy_var_6 -> - ( checkDataHeader happy_var_2 `thenP` \(cs,c,t) -> - returnP (HsNewTypeDecl happy_var_3 cs c t happy_var_5 happy_var_6 Nothing))}}}} - ) (\r -> happyReturn (happyIn33 r)) - -happyReduce_82 = happyMonadReduce 5# 29# happyReduction_82 -happyReduction_82 (happy_x_5 `HappyStk` - happy_x_4 `HappyStk` - happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen (case happyOut144 happy_x_2 of { happy_var_2 -> - case happyOut52 happy_x_3 of { happy_var_3 -> - case happyOut72 happy_x_4 of { happy_var_4 -> - case happyOut76 happy_x_5 of { happy_var_5 -> - ( checkClassHeader happy_var_3 `thenP` \(ctxt,n,tys) -> - returnP (HsClassDecl happy_var_2 ctxt n tys happy_var_4 happy_var_5 Nothing))}}}} - ) (\r -> happyReturn (happyIn33 r)) - -happyReduce_83 = happyMonadReduce 4# 29# happyReduction_83 -happyReduction_83 (happy_x_4 `HappyStk` - happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen (case happyOut144 happy_x_2 of { happy_var_2 -> - case happyOut52 happy_x_3 of { happy_var_3 -> - case happyOut81 happy_x_4 of { happy_var_4 -> - ( checkInstHeader happy_var_3 `thenP` \(ctxt,asst) -> - returnP (HsInstDecl happy_var_2 ctxt asst happy_var_4))}}} - ) (\r -> happyReturn (happyIn33 r)) - -happyReduce_84 = happyReduce 5# 29# happyReduction_84 -happyReduction_84 (happy_x_5 `HappyStk` - happy_x_4 `HappyStk` - happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) - = case happyOut144 happy_x_2 of { happy_var_2 -> - case happyOut34 happy_x_4 of { happy_var_4 -> - happyIn33 - (HsDefaultDecl happy_var_2 happy_var_4 - ) `HappyStk` happyRest}} - -happyReduce_85 = happySpecReduce_2 29# happyReduction_85 -happyReduction_85 happy_x_2 - happy_x_1 - = case happyOut41 happy_x_2 of { happy_var_2 -> - happyIn33 - (happy_var_2 - )} - -happyReduce_86 = happySpecReduce_1 29# happyReduction_86 -happyReduction_86 happy_x_1 - = case happyOut36 happy_x_1 of { happy_var_1 -> - happyIn33 - (happy_var_1 - )} - -happyReduce_87 = happySpecReduce_1 30# happyReduction_87 -happyReduction_87 happy_x_1 - = case happyOut55 happy_x_1 of { happy_var_1 -> - happyIn34 - (happy_var_1 - )} - -happyReduce_88 = happySpecReduce_1 30# happyReduction_88 -happyReduction_88 happy_x_1 - = case happyOut47 happy_x_1 of { happy_var_1 -> - happyIn34 - ([happy_var_1] - )} - -happyReduce_89 = happySpecReduce_0 30# happyReduction_89 -happyReduction_89 = happyIn34 - ([] - ) - -happyReduce_90 = happySpecReduce_3 31# happyReduction_90 -happyReduction_90 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOut36 happy_x_1 of { happy_var_1 -> - case happyOut35 happy_x_3 of { happy_var_3 -> - happyIn35 - (happy_var_1 : happy_var_3 - )}} - -happyReduce_91 = happySpecReduce_2 31# happyReduction_91 -happyReduction_91 happy_x_2 - happy_x_1 - = case happyOut37 happy_x_1 of { happy_var_1 -> - case happyOut35 happy_x_2 of { happy_var_2 -> - happyIn35 - (happy_var_1 : happy_var_2 - )}} - -happyReduce_92 = happySpecReduce_2 31# happyReduction_92 -happyReduction_92 happy_x_2 - happy_x_1 - = case happyOut35 happy_x_2 of { happy_var_2 -> - happyIn35 - (happy_var_2 - )} - -happyReduce_93 = happySpecReduce_1 31# happyReduction_93 -happyReduction_93 happy_x_1 - = case happyOut36 happy_x_1 of { happy_var_1 -> - happyIn35 - ([happy_var_1] - )} - -happyReduce_94 = happySpecReduce_0 31# happyReduction_94 -happyReduction_94 = happyIn35 - ([] - ) - -happyReduce_95 = happySpecReduce_1 32# happyReduction_95 -happyReduction_95 happy_x_1 - = case happyOut39 happy_x_1 of { happy_var_1 -> - happyIn36 - (happy_var_1 - )} - -happyReduce_96 = happySpecReduce_1 32# happyReduction_96 -happyReduction_96 happy_x_1 - = case happyOut28 happy_x_1 of { happy_var_1 -> - happyIn36 - (happy_var_1 - )} - -happyReduce_97 = happySpecReduce_1 32# happyReduction_97 -happyReduction_97 happy_x_1 - = case happyOut83 happy_x_1 of { happy_var_1 -> - happyIn36 - (happy_var_1 - )} - -happyReduce_98 = happySpecReduce_2 33# happyReduction_98 -happyReduction_98 happy_x_2 - happy_x_1 - = case happyOut144 happy_x_1 of { happy_var_1 -> - case happyOut153 happy_x_2 of { happy_var_2 -> - happyIn37 - (HsDocCommentNext happy_var_1 happy_var_2 - )}} - -happyReduce_99 = happySpecReduce_2 33# happyReduction_99 -happyReduction_99 happy_x_2 - happy_x_1 - = case happyOut144 happy_x_1 of { happy_var_1 -> - case happyOut154 happy_x_2 of { happy_var_2 -> - happyIn37 - (HsDocCommentPrev happy_var_1 happy_var_2 - )}} - -happyReduce_100 = happySpecReduce_2 33# happyReduction_100 -happyReduction_100 happy_x_2 - happy_x_1 - = case happyOut144 happy_x_1 of { happy_var_1 -> - case happyOut155 happy_x_2 of { happy_var_2 -> - happyIn37 - (case happy_var_2 of { (n,s) -> - HsDocCommentNamed happy_var_1 n s } - )}} - -happyReduce_101 = happySpecReduce_2 33# happyReduction_101 -happyReduction_101 happy_x_2 - happy_x_1 - = case happyOut144 happy_x_1 of { happy_var_1 -> - case happyOut156 happy_x_2 of { happy_var_2 -> - happyIn37 - (case happy_var_2 of { (i,s) -> HsDocGroup happy_var_1 i s } - )}} - -happyReduce_102 = happySpecReduce_3 34# happyReduction_102 -happyReduction_102 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOut35 happy_x_2 of { happy_var_2 -> - happyIn38 - (happy_var_2 - )} - -happyReduce_103 = happySpecReduce_3 34# happyReduction_103 -happyReduction_103 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOut35 happy_x_2 of { happy_var_2 -> - happyIn38 - (happy_var_2 - )} - -happyReduce_104 = happyReduce 4# 35# happyReduction_104 -happyReduction_104 (happy_x_4 `HappyStk` - happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) - = case happyOut40 happy_x_1 of { happy_var_1 -> - case happyOut144 happy_x_2 of { happy_var_2 -> - case happyOut53 happy_x_4 of { happy_var_4 -> - happyIn39 - (HsTypeSig happy_var_2 (reverse happy_var_1) happy_var_4 Nothing - ) `HappyStk` happyRest}}} - -happyReduce_105 = happySpecReduce_3 36# happyReduction_105 -happyReduction_105 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOut40 happy_x_1 of { happy_var_1 -> - case happyOut118 happy_x_3 of { happy_var_3 -> - happyIn40 - (happy_var_3 : happy_var_1 - )}} - -happyReduce_106 = happyMonadReduce 1# 36# happyReduction_106 -happyReduction_106 (happy_x_1 `HappyStk` - happyRest) tk - = happyThen (case happyOut119 happy_x_1 of { happy_var_1 -> - ( checkUnQual happy_var_1 `thenP` \n -> - returnP [n])} - ) (\r -> happyReturn (happyIn40 r)) - -happyReduce_107 = happyReduce 5# 37# happyReduction_107 -happyReduction_107 (happy_x_5 `HappyStk` - happy_x_4 `HappyStk` - happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) - = case happyOut144 happy_x_1 of { happy_var_1 -> - case happyOut42 happy_x_3 of { happy_var_3 -> - case happyOut43 happy_x_4 of { happy_var_4 -> - case happyOut44 happy_x_5 of { happy_var_5 -> - happyIn41 - (case happy_var_5 of (spec,nm,ty) -> HsForeignImport happy_var_1 happy_var_3 happy_var_4 spec nm ty Nothing - ) `HappyStk` happyRest}}}} - -happyReduce_108 = happyReduce 4# 37# happyReduction_108 -happyReduction_108 (happy_x_4 `HappyStk` - happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) - = case happyOut144 happy_x_1 of { happy_var_1 -> - case happyOut42 happy_x_3 of { happy_var_3 -> - case happyOut44 happy_x_4 of { happy_var_4 -> - happyIn41 - (case happy_var_4 of (spec,nm,ty) -> HsForeignImport happy_var_1 happy_var_3 HsFISafe spec nm ty Nothing - ) `HappyStk` happyRest}}} - -happyReduce_109 = happyReduce 4# 37# happyReduction_109 -happyReduction_109 (happy_x_4 `HappyStk` - happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) - = case happyOut144 happy_x_1 of { happy_var_1 -> - case happyOut42 happy_x_3 of { happy_var_3 -> - case happyOut44 happy_x_4 of { happy_var_4 -> - happyIn41 - (case happy_var_4 of (spec,nm,ty) -> HsForeignExport happy_var_1 happy_var_3 spec nm ty - ) `HappyStk` happyRest}}} - -happyReduce_110 = happySpecReduce_1 38# happyReduction_110 -happyReduction_110 happy_x_1 - = happyIn42 - (HsStdCall - ) - -happyReduce_111 = happySpecReduce_1 38# happyReduction_111 -happyReduction_111 happy_x_1 - = happyIn42 - (HsCCall - ) - -happyReduce_112 = happySpecReduce_1 38# happyReduction_112 -happyReduction_112 happy_x_1 - = happyIn42 - (HsDotNetCall - ) - -happyReduce_113 = happySpecReduce_1 39# happyReduction_113 -happyReduction_113 happy_x_1 - = happyIn43 - (HsFIUnsafe - ) - -happyReduce_114 = happySpecReduce_1 39# happyReduction_114 -happyReduction_114 happy_x_1 - = happyIn43 - (HsFISafe - ) - -happyReduce_115 = happySpecReduce_1 39# happyReduction_115 -happyReduction_115 happy_x_1 - = happyIn43 - (HsFIThreadSafe - ) - -happyReduce_116 = happyReduce 4# 40# happyReduction_116 -happyReduction_116 (happy_x_4 `HappyStk` - happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) - = case happyOutTok happy_x_1 of { (StringTok happy_var_1) -> - case happyOut132 happy_x_2 of { happy_var_2 -> - case happyOut53 happy_x_4 of { happy_var_4 -> - happyIn44 - ((happy_var_1, happy_var_2, happy_var_4) - ) `HappyStk` happyRest}}} - -happyReduce_117 = happySpecReduce_3 40# happyReduction_117 -happyReduction_117 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOut132 happy_x_1 of { happy_var_1 -> - case happyOut53 happy_x_3 of { happy_var_3 -> - happyIn44 - (("", happy_var_1, happy_var_3) - )}} - -happyReduce_118 = happySpecReduce_3 41# happyReduction_118 -happyReduction_118 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOut46 happy_x_1 of { happy_var_1 -> - case happyOut45 happy_x_3 of { happy_var_3 -> - happyIn45 - (HsTyFun happy_var_1 happy_var_3 - )}} - -happyReduce_119 = happySpecReduce_1 41# happyReduction_119 -happyReduction_119 happy_x_1 - = case happyOut46 happy_x_1 of { happy_var_1 -> - happyIn45 - (happy_var_1 - )} - -happyReduce_120 = happySpecReduce_1 42# happyReduction_120 -happyReduction_120 happy_x_1 - = case happyOut49 happy_x_1 of { happy_var_1 -> - happyIn46 - (happy_var_1 - )} - -happyReduce_121 = happySpecReduce_2 42# happyReduction_121 -happyReduction_121 happy_x_2 - happy_x_1 - = case happyOut49 happy_x_1 of { happy_var_1 -> - case happyOut154 happy_x_2 of { happy_var_2 -> - happyIn46 - (HsTyDoc happy_var_1 happy_var_2 - )}} - -happyReduce_122 = happySpecReduce_3 42# happyReduction_122 -happyReduction_122 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOut49 happy_x_1 of { happy_var_1 -> - case happyOut152 happy_x_2 of { happy_var_2 -> - case happyOut49 happy_x_3 of { happy_var_3 -> - happyIn46 - (HsTyApp (HsTyApp happy_var_2 happy_var_1) happy_var_3 - )}}} - -happyReduce_123 = happySpecReduce_3 43# happyReduction_123 -happyReduction_123 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOut121 happy_x_1 of { happy_var_1 -> - case happyOut48 happy_x_3 of { happy_var_3 -> - happyIn47 - (HsTyIP happy_var_1 happy_var_3 - )}} - -happyReduce_124 = happySpecReduce_1 43# happyReduction_124 -happyReduction_124 happy_x_1 - = case happyOut48 happy_x_1 of { happy_var_1 -> - happyIn47 - (happy_var_1 - )} - -happyReduce_125 = happySpecReduce_1 44# happyReduction_125 -happyReduction_125 happy_x_1 - = case happyOut49 happy_x_1 of { happy_var_1 -> - happyIn48 - (happy_var_1 - )} - -happyReduce_126 = happySpecReduce_3 44# happyReduction_126 -happyReduction_126 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOut49 happy_x_1 of { happy_var_1 -> - case happyOut152 happy_x_2 of { happy_var_2 -> - case happyOut49 happy_x_3 of { happy_var_3 -> - happyIn48 - (HsTyApp (HsTyApp happy_var_2 happy_var_1) happy_var_3 - )}}} - -happyReduce_127 = happySpecReduce_3 44# happyReduction_127 -happyReduction_127 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOut49 happy_x_1 of { happy_var_1 -> - case happyOut48 happy_x_3 of { happy_var_3 -> - happyIn48 - (HsTyFun happy_var_1 happy_var_3 - )}} - -happyReduce_128 = happySpecReduce_2 45# happyReduction_128 -happyReduction_128 happy_x_2 - happy_x_1 - = case happyOut49 happy_x_1 of { happy_var_1 -> - case happyOut50 happy_x_2 of { happy_var_2 -> - happyIn49 - (HsTyApp happy_var_1 happy_var_2 - )}} - -happyReduce_129 = happySpecReduce_1 45# happyReduction_129 -happyReduction_129 happy_x_1 - = case happyOut50 happy_x_1 of { happy_var_1 -> - happyIn49 - (happy_var_1 - )} - -happyReduce_130 = happySpecReduce_1 46# happyReduction_130 -happyReduction_130 happy_x_1 - = case happyOut51 happy_x_1 of { happy_var_1 -> - happyIn50 - (HsTyCon happy_var_1 - )} - -happyReduce_131 = happySpecReduce_1 46# happyReduction_131 -happyReduction_131 happy_x_1 - = case happyOut151 happy_x_1 of { happy_var_1 -> - happyIn50 - (HsTyVar happy_var_1 - )} - -happyReduce_132 = happySpecReduce_3 46# happyReduction_132 -happyReduction_132 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOut55 happy_x_2 of { happy_var_2 -> - happyIn50 - (HsTyTuple True happy_var_2 - )} - -happyReduce_133 = happySpecReduce_3 46# happyReduction_133 -happyReduction_133 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOut47 happy_x_2 of { happy_var_2 -> - happyIn50 - (HsTyTuple False [happy_var_2] - )} - -happyReduce_134 = happySpecReduce_3 46# happyReduction_134 -happyReduction_134 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOut55 happy_x_2 of { happy_var_2 -> - happyIn50 - (HsTyTuple False happy_var_2 - )} - -happyReduce_135 = happySpecReduce_3 46# happyReduction_135 -happyReduction_135 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOut47 happy_x_2 of { happy_var_2 -> - happyIn50 - (HsTyApp list_tycon happy_var_2 - )} - -happyReduce_136 = happySpecReduce_3 46# happyReduction_136 -happyReduction_136 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOut52 happy_x_2 of { happy_var_2 -> - happyIn50 - (happy_var_2 - )} - -happyReduce_137 = happySpecReduce_1 47# happyReduction_137 -happyReduction_137 happy_x_1 - = case happyOut150 happy_x_1 of { happy_var_1 -> - happyIn51 - (happy_var_1 - )} - -happyReduce_138 = happySpecReduce_2 47# happyReduction_138 -happyReduction_138 happy_x_2 - happy_x_1 - = happyIn51 - (unit_tycon_qname - ) - -happyReduce_139 = happySpecReduce_3 47# happyReduction_139 -happyReduction_139 happy_x_3 - happy_x_2 - happy_x_1 - = happyIn51 - (fun_tycon_qname - ) - -happyReduce_140 = happySpecReduce_2 47# happyReduction_140 -happyReduction_140 happy_x_2 - happy_x_1 - = happyIn51 - (list_tycon_qname - ) - -happyReduce_141 = happySpecReduce_3 47# happyReduction_141 -happyReduction_141 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOut97 happy_x_2 of { happy_var_2 -> - happyIn51 - (tuple_tycon_qname happy_var_2 - )} - -happyReduce_142 = happyReduce 4# 48# happyReduction_142 -happyReduction_142 (happy_x_4 `HappyStk` - happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) - = case happyOut57 happy_x_2 of { happy_var_2 -> - case happyOut52 happy_x_4 of { happy_var_4 -> - happyIn52 - (mkHsForAllType (Just happy_var_2) [] happy_var_4 - ) `HappyStk` happyRest}} - -happyReduce_143 = happySpecReduce_3 48# happyReduction_143 -happyReduction_143 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOut54 happy_x_1 of { happy_var_1 -> - case happyOut47 happy_x_3 of { happy_var_3 -> - happyIn52 - (mkHsForAllType Nothing happy_var_1 happy_var_3 - )}} - -happyReduce_144 = happySpecReduce_1 48# happyReduction_144 -happyReduction_144 happy_x_1 - = case happyOut47 happy_x_1 of { happy_var_1 -> - happyIn52 - (happy_var_1 - )} - -happyReduce_145 = happyReduce 4# 49# happyReduction_145 -happyReduction_145 (happy_x_4 `HappyStk` - happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) - = case happyOut57 happy_x_2 of { happy_var_2 -> - case happyOut53 happy_x_4 of { happy_var_4 -> - happyIn53 - (mkHsForAllType (Just happy_var_2) [] happy_var_4 - ) `HappyStk` happyRest}} - -happyReduce_146 = happySpecReduce_3 49# happyReduction_146 -happyReduction_146 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOut54 happy_x_1 of { happy_var_1 -> - case happyOut45 happy_x_3 of { happy_var_3 -> - happyIn53 - (mkHsForAllType Nothing happy_var_1 happy_var_3 - )}} - -happyReduce_147 = happySpecReduce_1 49# happyReduction_147 -happyReduction_147 happy_x_1 - = case happyOut45 happy_x_1 of { happy_var_1 -> - happyIn53 - (happy_var_1 - )} - -happyReduce_148 = happyMonadReduce 1# 50# happyReduction_148 -happyReduction_148 (happy_x_1 `HappyStk` - happyRest) tk - = happyThen (case happyOut49 happy_x_1 of { happy_var_1 -> - ( checkContext happy_var_1)} - ) (\r -> happyReturn (happyIn54 r)) - -happyReduce_149 = happySpecReduce_3 51# happyReduction_149 -happyReduction_149 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOut47 happy_x_1 of { happy_var_1 -> - case happyOut55 happy_x_3 of { happy_var_3 -> - happyIn55 - (happy_var_1 : happy_var_3 - )}} - -happyReduce_150 = happySpecReduce_3 51# happyReduction_150 -happyReduction_150 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOut47 happy_x_1 of { happy_var_1 -> - case happyOut47 happy_x_3 of { happy_var_3 -> - happyIn55 - ([happy_var_1,happy_var_3] - )}} - -happyReduce_151 = happySpecReduce_2 52# happyReduction_151 -happyReduction_151 happy_x_2 - happy_x_1 - = case happyOut149 happy_x_1 of { happy_var_1 -> - case happyOut57 happy_x_2 of { happy_var_2 -> - happyIn56 - ((happy_var_1,happy_var_2) - )}} - -happyReduce_152 = happySpecReduce_2 53# happyReduction_152 -happyReduction_152 happy_x_2 - happy_x_1 - = case happyOut151 happy_x_1 of { happy_var_1 -> - case happyOut57 happy_x_2 of { happy_var_2 -> - happyIn57 - (happy_var_1 : happy_var_2 - )}} - -happyReduce_153 = happySpecReduce_0 53# happyReduction_153 -happyReduction_153 = happyIn57 - ([] - ) - -happyReduce_154 = happySpecReduce_0 54# happyReduction_154 -happyReduction_154 = happyIn58 - ([] - ) - -happyReduce_155 = happySpecReduce_3 54# happyReduction_155 -happyReduction_155 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOut158 happy_x_1 of { happy_var_1 -> - case happyOut59 happy_x_3 of { happy_var_3 -> - happyIn58 - (addConDocs happy_var_3 happy_var_1 - )}} - -happyReduce_156 = happyReduce 5# 55# happyReduction_156 -happyReduction_156 (happy_x_5 `HappyStk` - happy_x_4 `HappyStk` - happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) - = case happyOut60 happy_x_1 of { happy_var_1 -> - case happyOut158 happy_x_2 of { happy_var_2 -> - case happyOut157 happy_x_4 of { happy_var_4 -> - case happyOut59 happy_x_5 of { happy_var_5 -> - happyIn59 - (addConDoc happy_var_1 happy_var_4 : addConDocs happy_var_5 happy_var_2 - ) `HappyStk` happyRest}}}} - -happyReduce_157 = happySpecReduce_1 55# happyReduction_157 -happyReduction_157 happy_x_1 - = case happyOut60 happy_x_1 of { happy_var_1 -> - happyIn59 - ([happy_var_1] - )} - -happyReduce_158 = happyReduce 5# 56# happyReduction_158 -happyReduction_158 (happy_x_5 `HappyStk` - happy_x_4 `HappyStk` - happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) - = case happyOut144 happy_x_1 of { happy_var_1 -> - case happyOut158 happy_x_2 of { happy_var_2 -> - case happyOut61 happy_x_3 of { happy_var_3 -> - case happyOut62 happy_x_4 of { happy_var_4 -> - case happyOut157 happy_x_5 of { happy_var_5 -> - happyIn60 - (HsConDecl happy_var_1 (fst happy_var_4) happy_var_3 [] (snd happy_var_4) (happy_var_2 `mplus` happy_var_5) - ) `HappyStk` happyRest}}}}} - -happyReduce_159 = happyMonadReduce 7# 56# happyReduction_159 -happyReduction_159 (happy_x_7 `HappyStk` - happy_x_6 `HappyStk` - happy_x_5 `HappyStk` - happy_x_4 `HappyStk` - happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen (case happyOut144 happy_x_1 of { happy_var_1 -> - case happyOut158 happy_x_2 of { happy_var_2 -> - case happyOut61 happy_x_3 of { happy_var_3 -> - case happyOut54 happy_x_4 of { happy_var_4 -> - case happyOut62 happy_x_6 of { happy_var_6 -> - case happyOut157 happy_x_7 of { happy_var_7 -> - ( checkIPContext happy_var_4 `thenP` \ ctxt -> returnP (HsConDecl happy_var_1 (fst happy_var_6) happy_var_3 ctxt (snd happy_var_6) (happy_var_2 `mplus` happy_var_7)))}}}}}} - ) (\r -> happyReturn (happyIn60 r)) - -happyReduce_160 = happyReduce 8# 56# happyReduction_160 -happyReduction_160 (happy_x_8 `HappyStk` - happy_x_7 `HappyStk` - happy_x_6 `HappyStk` - happy_x_5 `HappyStk` - happy_x_4 `HappyStk` - happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) - = case happyOut144 happy_x_1 of { happy_var_1 -> - case happyOut158 happy_x_2 of { happy_var_2 -> - case happyOut61 happy_x_3 of { happy_var_3 -> - case happyOut120 happy_x_4 of { happy_var_4 -> - case happyOut67 happy_x_6 of { happy_var_6 -> - case happyOut157 happy_x_8 of { happy_var_8 -> - happyIn60 - (HsRecDecl happy_var_1 happy_var_4 happy_var_3 [] happy_var_6 (happy_var_2 `mplus` happy_var_8) - ) `HappyStk` happyRest}}}}}} - -happyReduce_161 = happyMonadReduce 10# 56# happyReduction_161 -happyReduction_161 (happy_x_10 `HappyStk` - happy_x_9 `HappyStk` - happy_x_8 `HappyStk` - happy_x_7 `HappyStk` - happy_x_6 `HappyStk` - happy_x_5 `HappyStk` - happy_x_4 `HappyStk` - happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen (case happyOut144 happy_x_1 of { happy_var_1 -> - case happyOut158 happy_x_2 of { happy_var_2 -> - case happyOut61 happy_x_3 of { happy_var_3 -> - case happyOut54 happy_x_4 of { happy_var_4 -> - case happyOut120 happy_x_6 of { happy_var_6 -> - case happyOut67 happy_x_8 of { happy_var_8 -> - case happyOut157 happy_x_10 of { happy_var_10 -> - ( checkIPContext happy_var_4 `thenP` \ ctxt -> returnP (HsRecDecl happy_var_1 happy_var_6 happy_var_3 ctxt happy_var_8 (happy_var_2 `mplus` happy_var_10)))}}}}}}} - ) (\r -> happyReturn (happyIn60 r)) - -happyReduce_162 = happySpecReduce_3 57# happyReduction_162 -happyReduction_162 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOut57 happy_x_2 of { happy_var_2 -> - happyIn61 - (happy_var_2 - )} - -happyReduce_163 = happySpecReduce_0 57# happyReduction_163 -happyReduction_163 = happyIn61 - ([] - ) - -happyReduce_164 = happySpecReduce_1 58# happyReduction_164 -happyReduction_164 happy_x_1 - = case happyOut63 happy_x_1 of { happy_var_1 -> - happyIn62 - (happy_var_1 - )} - -happyReduce_165 = happySpecReduce_3 58# happyReduction_165 -happyReduction_165 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOut66 happy_x_1 of { happy_var_1 -> - case happyOut126 happy_x_2 of { happy_var_2 -> - case happyOut66 happy_x_3 of { happy_var_3 -> - happyIn62 - ((happy_var_2, [happy_var_1,happy_var_3]) - )}}} - -happyReduce_166 = happyMonadReduce 1# 59# happyReduction_166 -happyReduction_166 (happy_x_1 `HappyStk` - happyRest) tk - = happyThen (case happyOut49 happy_x_1 of { happy_var_1 -> - ( splitTyConApp happy_var_1 `thenP` \(c,ts) -> - returnP (toVarHsName c, - map HsUnBangedTy ts))} - ) (\r -> happyReturn (happyIn63 r)) - -happyReduce_167 = happySpecReduce_1 59# happyReduction_167 -happyReduction_167 happy_x_1 - = case happyOut64 happy_x_1 of { happy_var_1 -> - happyIn63 - (happy_var_1 - )} - -happyReduce_168 = happyMonadReduce 3# 60# happyReduction_168 -happyReduction_168 (happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen (case happyOut49 happy_x_1 of { happy_var_1 -> - case happyOut50 happy_x_3 of { happy_var_3 -> - ( splitTyConApp happy_var_1 `thenP` \(c,ts) -> - returnP (toVarHsName c, - map HsUnBangedTy ts++ - [HsBangedTy happy_var_3]))}} - ) (\r -> happyReturn (happyIn64 r)) - -happyReduce_169 = happySpecReduce_2 60# happyReduction_169 -happyReduction_169 happy_x_2 - happy_x_1 - = case happyOut64 happy_x_1 of { happy_var_1 -> - case happyOut65 happy_x_2 of { happy_var_2 -> - happyIn64 - ((fst happy_var_1, snd happy_var_1 ++ [happy_var_2] ) - )}} - -happyReduce_170 = happySpecReduce_1 61# happyReduction_170 -happyReduction_170 happy_x_1 - = case happyOut50 happy_x_1 of { happy_var_1 -> - happyIn65 - (HsUnBangedTy happy_var_1 - )} - -happyReduce_171 = happySpecReduce_2 61# happyReduction_171 -happyReduction_171 happy_x_2 - happy_x_1 - = case happyOut50 happy_x_2 of { happy_var_2 -> - happyIn65 - (HsBangedTy happy_var_2 - )} - -happyReduce_172 = happySpecReduce_1 62# happyReduction_172 -happyReduction_172 happy_x_1 - = case happyOut49 happy_x_1 of { happy_var_1 -> - happyIn66 - (HsUnBangedTy happy_var_1 - )} - -happyReduce_173 = happySpecReduce_2 62# happyReduction_173 -happyReduction_173 happy_x_2 - happy_x_1 - = case happyOut50 happy_x_2 of { happy_var_2 -> - happyIn66 - (HsBangedTy happy_var_2 - )} - -happyReduce_174 = happyReduce 5# 63# happyReduction_174 -happyReduction_174 (happy_x_5 `HappyStk` - happy_x_4 `HappyStk` - happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) - = case happyOut68 happy_x_1 of { happy_var_1 -> - case happyOut158 happy_x_2 of { happy_var_2 -> - case happyOut157 happy_x_4 of { happy_var_4 -> - case happyOut67 happy_x_5 of { happy_var_5 -> - happyIn67 - (addFieldDoc happy_var_1 happy_var_4 : addFieldDocs happy_var_5 happy_var_2 - ) `HappyStk` happyRest}}}} - -happyReduce_175 = happySpecReduce_2 63# happyReduction_175 -happyReduction_175 happy_x_2 - happy_x_1 - = case happyOut67 happy_x_2 of { happy_var_2 -> - happyIn67 - (happy_var_2 - )} - -happyReduce_176 = happySpecReduce_1 63# happyReduction_176 -happyReduction_176 happy_x_1 - = case happyOut68 happy_x_1 of { happy_var_1 -> - happyIn67 - ([happy_var_1] - )} - -happyReduce_177 = happySpecReduce_0 63# happyReduction_177 -happyReduction_177 = happyIn67 - ([] - ) - -happyReduce_178 = happyReduce 5# 64# happyReduction_178 -happyReduction_178 (happy_x_5 `HappyStk` - happy_x_4 `HappyStk` - happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) - = case happyOut158 happy_x_1 of { happy_var_1 -> - case happyOut40 happy_x_2 of { happy_var_2 -> - case happyOut69 happy_x_4 of { happy_var_4 -> - case happyOut157 happy_x_5 of { happy_var_5 -> - happyIn68 - (HsFieldDecl (reverse happy_var_2) happy_var_4 (happy_var_1 `mplus` happy_var_5) - ) `HappyStk` happyRest}}}} - -happyReduce_179 = happySpecReduce_1 65# happyReduction_179 -happyReduction_179 happy_x_1 - = case happyOut52 happy_x_1 of { happy_var_1 -> - happyIn69 - (HsUnBangedTy happy_var_1 - )} - -happyReduce_180 = happySpecReduce_2 65# happyReduction_180 -happyReduction_180 happy_x_2 - happy_x_1 - = case happyOut50 happy_x_2 of { happy_var_2 -> - happyIn69 - (HsBangedTy happy_var_2 - )} - -happyReduce_181 = happySpecReduce_0 66# happyReduction_181 -happyReduction_181 = happyIn70 - ([] - ) - -happyReduce_182 = happySpecReduce_2 66# happyReduction_182 -happyReduction_182 happy_x_2 - happy_x_1 - = case happyOut150 happy_x_2 of { happy_var_2 -> - happyIn70 - ([happy_var_2] - )} - -happyReduce_183 = happySpecReduce_3 66# happyReduction_183 -happyReduction_183 happy_x_3 - happy_x_2 - happy_x_1 - = happyIn70 - ([] - ) - -happyReduce_184 = happyReduce 4# 66# happyReduction_184 -happyReduction_184 (happy_x_4 `HappyStk` - happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) - = case happyOut71 happy_x_3 of { happy_var_3 -> - happyIn70 - (reverse happy_var_3 - ) `HappyStk` happyRest} - -happyReduce_185 = happySpecReduce_3 67# happyReduction_185 -happyReduction_185 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOut71 happy_x_1 of { happy_var_1 -> - case happyOut150 happy_x_3 of { happy_var_3 -> - happyIn71 - (happy_var_3 : happy_var_1 - )}} - -happyReduce_186 = happySpecReduce_1 67# happyReduction_186 -happyReduction_186 happy_x_1 - = case happyOut150 happy_x_1 of { happy_var_1 -> - happyIn71 - ([happy_var_1] - )} - -happyReduce_187 = happySpecReduce_0 68# happyReduction_187 -happyReduction_187 = happyIn72 - ([] - ) - -happyReduce_188 = happySpecReduce_2 68# happyReduction_188 -happyReduction_188 happy_x_2 - happy_x_1 - = case happyOut73 happy_x_2 of { happy_var_2 -> - happyIn72 - (reverse happy_var_2 - )} - -happyReduce_189 = happySpecReduce_3 69# happyReduction_189 -happyReduction_189 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOut73 happy_x_1 of { happy_var_1 -> - case happyOut74 happy_x_3 of { happy_var_3 -> - happyIn73 - (happy_var_3 : happy_var_1 - )}} - -happyReduce_190 = happySpecReduce_1 69# happyReduction_190 -happyReduction_190 happy_x_1 - = case happyOut74 happy_x_1 of { happy_var_1 -> - happyIn73 - ([happy_var_1] - )} - -happyReduce_191 = happySpecReduce_3 70# happyReduction_191 -happyReduction_191 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOut75 happy_x_1 of { happy_var_1 -> - case happyOut75 happy_x_3 of { happy_var_3 -> - happyIn74 - ((reverse happy_var_1, reverse happy_var_3) - )}} - -happyReduce_192 = happySpecReduce_0 71# happyReduction_192 -happyReduction_192 = happyIn75 - ([] - ) - -happyReduce_193 = happySpecReduce_2 71# happyReduction_193 -happyReduction_193 happy_x_2 - happy_x_1 - = case happyOut75 happy_x_1 of { happy_var_1 -> - case happyOut151 happy_x_2 of { happy_var_2 -> - happyIn75 - (happy_var_2 : happy_var_1 - )}} - -happyReduce_194 = happySpecReduce_2 72# happyReduction_194 -happyReduction_194 happy_x_2 - happy_x_1 - = case happyOut38 happy_x_2 of { happy_var_2 -> - happyIn76 - (happy_var_2 - )} - -happyReduce_195 = happySpecReduce_0 72# happyReduction_195 -happyReduction_195 = happyIn76 - ([] - ) - -happyReduce_196 = happySpecReduce_3 73# happyReduction_196 -happyReduction_196 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOut77 happy_x_1 of { happy_var_1 -> - case happyOut78 happy_x_3 of { happy_var_3 -> - happyIn77 - (happy_var_3 : happy_var_1 - )}} - -happyReduce_197 = happySpecReduce_2 73# happyReduction_197 -happyReduction_197 happy_x_2 - happy_x_1 - = case happyOut77 happy_x_1 of { happy_var_1 -> - happyIn77 - (happy_var_1 - )} - -happyReduce_198 = happySpecReduce_1 73# happyReduction_198 -happyReduction_198 happy_x_1 - = case happyOut78 happy_x_1 of { happy_var_1 -> - happyIn77 - ([happy_var_1] - )} - -happyReduce_199 = happyMonadReduce 4# 74# happyReduction_199 -happyReduction_199 (happy_x_4 `HappyStk` - happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen (case happyOut121 happy_x_1 of { happy_var_1 -> - case happyOut144 happy_x_3 of { happy_var_3 -> - case happyOut87 happy_x_4 of { happy_var_4 -> - ( checkValDef (happy_var_3, HsVar (UnQual happy_var_1), HsUnGuardedRhs happy_var_4, []))}}} - ) (\r -> happyReturn (happyIn78 r)) - -happyReduce_200 = happySpecReduce_1 75# happyReduction_200 -happyReduction_200 happy_x_1 - = case happyOut38 happy_x_1 of { happy_var_1 -> - happyIn79 - (happy_var_1 - )} - -happyReduce_201 = happySpecReduce_3 75# happyReduction_201 -happyReduction_201 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOut77 happy_x_2 of { happy_var_2 -> - happyIn79 - (happy_var_2 - )} - -happyReduce_202 = happySpecReduce_3 75# happyReduction_202 -happyReduction_202 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOut77 happy_x_2 of { happy_var_2 -> - happyIn79 - (happy_var_2 - )} - -happyReduce_203 = happySpecReduce_2 76# happyReduction_203 -happyReduction_203 happy_x_2 - happy_x_1 - = case happyOut79 happy_x_2 of { happy_var_2 -> - happyIn80 - (happy_var_2 - )} - -happyReduce_204 = happySpecReduce_0 76# happyReduction_204 -happyReduction_204 = happyIn80 - ([] - ) - -happyReduce_205 = happyReduce 4# 77# happyReduction_205 -happyReduction_205 (happy_x_4 `HappyStk` - happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) - = case happyOut82 happy_x_3 of { happy_var_3 -> - happyIn81 - (happy_var_3 - ) `HappyStk` happyRest} - -happyReduce_206 = happyReduce 4# 77# happyReduction_206 -happyReduction_206 (happy_x_4 `HappyStk` - happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) - = case happyOut82 happy_x_3 of { happy_var_3 -> - happyIn81 - (happy_var_3 - ) `HappyStk` happyRest} - -happyReduce_207 = happySpecReduce_0 77# happyReduction_207 -happyReduction_207 = happyIn81 - ([] - ) - -happyReduce_208 = happySpecReduce_3 78# happyReduction_208 -happyReduction_208 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOut82 happy_x_1 of { happy_var_1 -> - case happyOut83 happy_x_3 of { happy_var_3 -> - happyIn82 - (happy_var_3 : happy_var_1 - )}} - -happyReduce_209 = happySpecReduce_2 78# happyReduction_209 -happyReduction_209 happy_x_2 - happy_x_1 - = case happyOut82 happy_x_1 of { happy_var_1 -> - happyIn82 - (happy_var_1 - )} - -happyReduce_210 = happySpecReduce_1 78# happyReduction_210 -happyReduction_210 happy_x_1 - = case happyOut83 happy_x_1 of { happy_var_1 -> - happyIn82 - ([happy_var_1] - )} - -happyReduce_211 = happySpecReduce_0 78# happyReduction_211 -happyReduction_211 = happyIn82 - ([] - ) - -happyReduce_212 = happyMonadReduce 3# 79# happyReduction_212 -happyReduction_212 (happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen (case happyOut90 happy_x_1 of { happy_var_1 -> - case happyOut144 happy_x_2 of { happy_var_2 -> - case happyOut84 happy_x_3 of { happy_var_3 -> - ( checkValDef (happy_var_2, happy_var_1, happy_var_3, []))}}} - ) (\r -> happyReturn (happyIn83 r)) - -happyReduce_213 = happyMonadReduce 3# 80# happyReduction_213 -happyReduction_213 (happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen (case happyOut87 happy_x_2 of { happy_var_2 -> - ( checkExpr happy_var_2 `thenP` \e -> - returnP (HsUnGuardedRhs e))} - ) (\r -> happyReturn (happyIn84 r)) - -happyReduce_214 = happySpecReduce_2 80# happyReduction_214 -happyReduction_214 happy_x_2 - happy_x_1 - = case happyOut85 happy_x_1 of { happy_var_1 -> - happyIn84 - (HsGuardedRhss (reverse happy_var_1) - )} - -happyReduce_215 = happySpecReduce_2 81# happyReduction_215 -happyReduction_215 happy_x_2 - happy_x_1 - = case happyOut85 happy_x_1 of { happy_var_1 -> - case happyOut86 happy_x_2 of { happy_var_2 -> - happyIn85 - (happy_var_2 : happy_var_1 - )}} - -happyReduce_216 = happySpecReduce_1 81# happyReduction_216 -happyReduction_216 happy_x_1 - = case happyOut86 happy_x_1 of { happy_var_1 -> - happyIn85 - ([happy_var_1] - )} - -happyReduce_217 = happyMonadReduce 5# 82# happyReduction_217 -happyReduction_217 (happy_x_5 `HappyStk` - happy_x_4 `HappyStk` - happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen (case happyOut144 happy_x_2 of { happy_var_2 -> - case happyOut103 happy_x_3 of { happy_var_3 -> - case happyOut87 happy_x_5 of { happy_var_5 -> - ( checkExpr happy_var_5 `thenP` \e -> - returnP (HsGuardedRhs happy_var_2 happy_var_3 e))}}} - ) (\r -> happyReturn (happyIn86 r)) - -happyReduce_218 = happyReduce 4# 83# happyReduction_218 -happyReduction_218 (happy_x_4 `HappyStk` - happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) - = case happyOut90 happy_x_1 of { happy_var_1 -> - case happyOut144 happy_x_3 of { happy_var_3 -> - case happyOut52 happy_x_4 of { happy_var_4 -> - happyIn87 - (HsExpTypeSig happy_var_3 happy_var_1 happy_var_4 - ) `HappyStk` happyRest}}} - -happyReduce_219 = happySpecReduce_1 83# happyReduction_219 -happyReduction_219 happy_x_1 - = case happyOut88 happy_x_1 of { happy_var_1 -> - happyIn87 - (happy_var_1 - )} - -happyReduce_220 = happySpecReduce_1 84# happyReduction_220 -happyReduction_220 happy_x_1 - = case happyOut89 happy_x_1 of { happy_var_1 -> - happyIn88 - (happy_var_1 - )} - -happyReduce_221 = happySpecReduce_1 84# happyReduction_221 -happyReduction_221 happy_x_1 - = case happyOut90 happy_x_1 of { happy_var_1 -> - happyIn88 - (happy_var_1 - )} - -happyReduce_222 = happySpecReduce_3 85# happyReduction_222 -happyReduction_222 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOut90 happy_x_1 of { happy_var_1 -> - case happyOut129 happy_x_2 of { happy_var_2 -> - case happyOut91 happy_x_3 of { happy_var_3 -> - happyIn89 - (HsInfixApp happy_var_1 happy_var_2 happy_var_3 - )}}} - -happyReduce_223 = happySpecReduce_1 85# happyReduction_223 -happyReduction_223 happy_x_1 - = case happyOut91 happy_x_1 of { happy_var_1 -> - happyIn89 - (happy_var_1 - )} - -happyReduce_224 = happySpecReduce_3 86# happyReduction_224 -happyReduction_224 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOut90 happy_x_1 of { happy_var_1 -> - case happyOut129 happy_x_2 of { happy_var_2 -> - case happyOut92 happy_x_3 of { happy_var_3 -> - happyIn90 - (HsInfixApp happy_var_1 happy_var_2 happy_var_3 - )}}} - -happyReduce_225 = happySpecReduce_1 86# happyReduction_225 -happyReduction_225 happy_x_1 - = case happyOut92 happy_x_1 of { happy_var_1 -> - happyIn90 - (happy_var_1 - )} - -happyReduce_226 = happyMonadReduce 4# 87# happyReduction_226 -happyReduction_226 (happy_x_4 `HappyStk` - happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen (case happyOut94 happy_x_2 of { happy_var_2 -> - case happyOut87 happy_x_4 of { happy_var_4 -> - ( checkPatterns (reverse happy_var_2) `thenP` \ps -> - returnP (HsLambda ps happy_var_4))}} - ) (\r -> happyReturn (happyIn91 r)) - -happyReduce_227 = happyReduce 4# 87# happyReduction_227 -happyReduction_227 (happy_x_4 `HappyStk` - happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) - = case happyOut79 happy_x_2 of { happy_var_2 -> - case happyOut87 happy_x_4 of { happy_var_4 -> - happyIn91 - (HsLet happy_var_2 happy_var_4 - ) `HappyStk` happyRest}} - -happyReduce_228 = happyReduce 6# 87# happyReduction_228 -happyReduction_228 (happy_x_6 `HappyStk` - happy_x_5 `HappyStk` - happy_x_4 `HappyStk` - happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) - = case happyOut87 happy_x_2 of { happy_var_2 -> - case happyOut87 happy_x_4 of { happy_var_4 -> - case happyOut87 happy_x_6 of { happy_var_6 -> - happyIn91 - (HsIf happy_var_2 happy_var_4 happy_var_6 - ) `HappyStk` happyRest}}} - -happyReduce_229 = happyReduce 4# 88# happyReduction_229 -happyReduction_229 (happy_x_4 `HappyStk` - happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) - = case happyOut87 happy_x_2 of { happy_var_2 -> - case happyOut105 happy_x_4 of { happy_var_4 -> - happyIn92 - (HsCase happy_var_2 happy_var_4 - ) `HappyStk` happyRest}} - -happyReduce_230 = happySpecReduce_2 88# happyReduction_230 -happyReduction_230 happy_x_2 - happy_x_1 - = case happyOut93 happy_x_2 of { happy_var_2 -> - happyIn92 - (HsNegApp happy_var_2 - )} - -happyReduce_231 = happySpecReduce_2 88# happyReduction_231 -happyReduction_231 happy_x_2 - happy_x_1 - = case happyOut112 happy_x_2 of { happy_var_2 -> - happyIn92 - (HsDo happy_var_2 - )} - -happyReduce_232 = happySpecReduce_1 88# happyReduction_232 -happyReduction_232 happy_x_1 - = case happyOut93 happy_x_1 of { happy_var_1 -> - happyIn92 - (happy_var_1 - )} - -happyReduce_233 = happySpecReduce_2 89# happyReduction_233 -happyReduction_233 happy_x_2 - happy_x_1 - = case happyOut93 happy_x_1 of { happy_var_1 -> - case happyOut95 happy_x_2 of { happy_var_2 -> - happyIn93 - (HsApp happy_var_1 happy_var_2 - )}} - -happyReduce_234 = happySpecReduce_1 89# happyReduction_234 -happyReduction_234 happy_x_1 - = case happyOut95 happy_x_1 of { happy_var_1 -> - happyIn93 - (happy_var_1 - )} - -happyReduce_235 = happySpecReduce_2 90# happyReduction_235 -happyReduction_235 happy_x_2 - happy_x_1 - = case happyOut94 happy_x_1 of { happy_var_1 -> - case happyOut95 happy_x_2 of { happy_var_2 -> - happyIn94 - (happy_var_2 : happy_var_1 - )}} - -happyReduce_236 = happySpecReduce_1 90# happyReduction_236 -happyReduction_236 happy_x_1 - = case happyOut95 happy_x_1 of { happy_var_1 -> - happyIn94 - ([happy_var_1] - )} - -happyReduce_237 = happyMonadReduce 3# 91# happyReduction_237 -happyReduction_237 (happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen (case happyOut95 happy_x_1 of { happy_var_1 -> - ( mkRecConstrOrUpdate happy_var_1 [])} - ) (\r -> happyReturn (happyIn95 r)) - -happyReduce_238 = happyMonadReduce 4# 91# happyReduction_238 -happyReduction_238 (happy_x_4 `HappyStk` - happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen (case happyOut95 happy_x_1 of { happy_var_1 -> - case happyOut115 happy_x_3 of { happy_var_3 -> - ( mkRecConstrOrUpdate happy_var_1 (reverse happy_var_3))}} - ) (\r -> happyReturn (happyIn95 r)) - -happyReduce_239 = happySpecReduce_1 91# happyReduction_239 -happyReduction_239 happy_x_1 - = case happyOut96 happy_x_1 of { happy_var_1 -> - happyIn95 - (happy_var_1 - )} - -happyReduce_240 = happySpecReduce_1 92# happyReduction_240 -happyReduction_240 happy_x_1 - = case happyOut121 happy_x_1 of { happy_var_1 -> - happyIn96 - (HsIPVar (UnQual happy_var_1) - )} - -happyReduce_241 = happySpecReduce_1 92# happyReduction_241 -happyReduction_241 happy_x_1 - = case happyOut119 happy_x_1 of { happy_var_1 -> - happyIn96 - (HsVar happy_var_1 - )} - -happyReduce_242 = happySpecReduce_1 92# happyReduction_242 -happyReduction_242 happy_x_1 - = case happyOut117 happy_x_1 of { happy_var_1 -> - happyIn96 - (HsCon happy_var_1 - )} - -happyReduce_243 = happySpecReduce_1 92# happyReduction_243 -happyReduction_243 happy_x_1 - = case happyOut143 happy_x_1 of { happy_var_1 -> - happyIn96 - (happy_var_1 - )} - -happyReduce_244 = happySpecReduce_3 92# happyReduction_244 -happyReduction_244 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOut87 happy_x_2 of { happy_var_2 -> - happyIn96 - (HsParen happy_var_2 - )} - -happyReduce_245 = happySpecReduce_3 92# happyReduction_245 -happyReduction_245 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOut98 happy_x_2 of { happy_var_2 -> - happyIn96 - (HsTuple True happy_var_2 - )} - -happyReduce_246 = happySpecReduce_3 92# happyReduction_246 -happyReduction_246 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOut87 happy_x_2 of { happy_var_2 -> - happyIn96 - (HsTuple False [happy_var_2] - )} - -happyReduce_247 = happySpecReduce_3 92# happyReduction_247 -happyReduction_247 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOut98 happy_x_2 of { happy_var_2 -> - happyIn96 - (HsTuple False happy_var_2 - )} - -happyReduce_248 = happySpecReduce_3 92# happyReduction_248 -happyReduction_248 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOut99 happy_x_2 of { happy_var_2 -> - happyIn96 - (happy_var_2 - )} - -happyReduce_249 = happyReduce 4# 92# happyReduction_249 -happyReduction_249 (happy_x_4 `HappyStk` - happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) - = case happyOut90 happy_x_2 of { happy_var_2 -> - case happyOut129 happy_x_3 of { happy_var_3 -> - happyIn96 - (HsLeftSection happy_var_3 happy_var_2 - ) `HappyStk` happyRest}} - -happyReduce_250 = happyReduce 4# 92# happyReduction_250 -happyReduction_250 (happy_x_4 `HappyStk` - happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) - = case happyOut130 happy_x_2 of { happy_var_2 -> - case happyOut88 happy_x_3 of { happy_var_3 -> - happyIn96 - (HsRightSection happy_var_3 happy_var_2 - ) `HappyStk` happyRest}} - -happyReduce_251 = happyMonadReduce 3# 92# happyReduction_251 -happyReduction_251 (happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) tk - = happyThen (case happyOut119 happy_x_1 of { happy_var_1 -> - case happyOut95 happy_x_3 of { happy_var_3 -> - ( checkUnQual happy_var_1 `thenP` \n -> - returnP (HsAsPat n happy_var_3))}} - ) (\r -> happyReturn (happyIn96 r)) - -happyReduce_252 = happySpecReduce_1 92# happyReduction_252 -happyReduction_252 happy_x_1 - = happyIn96 - (HsWildCard - ) - -happyReduce_253 = happySpecReduce_2 92# happyReduction_253 -happyReduction_253 happy_x_2 - happy_x_1 - = case happyOut96 happy_x_2 of { happy_var_2 -> - happyIn96 - (HsIrrPat happy_var_2 - )} - -happyReduce_254 = happySpecReduce_2 93# happyReduction_254 -happyReduction_254 happy_x_2 - happy_x_1 - = case happyOut97 happy_x_1 of { happy_var_1 -> - happyIn97 - (happy_var_1 + 1 - )} - -happyReduce_255 = happySpecReduce_1 93# happyReduction_255 -happyReduction_255 happy_x_1 - = happyIn97 - (1 - ) - -happyReduce_256 = happySpecReduce_3 94# happyReduction_256 -happyReduction_256 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOut87 happy_x_1 of { happy_var_1 -> - case happyOut98 happy_x_3 of { happy_var_3 -> - happyIn98 - (happy_var_1 : happy_var_3 - )}} - -happyReduce_257 = happySpecReduce_3 94# happyReduction_257 -happyReduction_257 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOut87 happy_x_1 of { happy_var_1 -> - case happyOut87 happy_x_3 of { happy_var_3 -> - happyIn98 - ([happy_var_1,happy_var_3] - )}} - -happyReduce_258 = happySpecReduce_1 95# happyReduction_258 -happyReduction_258 happy_x_1 - = case happyOut87 happy_x_1 of { happy_var_1 -> - happyIn99 - (HsList [happy_var_1] - )} - -happyReduce_259 = happySpecReduce_1 95# happyReduction_259 -happyReduction_259 happy_x_1 - = case happyOut100 happy_x_1 of { happy_var_1 -> - happyIn99 - (HsList (reverse happy_var_1) - )} - -happyReduce_260 = happySpecReduce_2 95# happyReduction_260 -happyReduction_260 happy_x_2 - happy_x_1 - = case happyOut87 happy_x_1 of { happy_var_1 -> - happyIn99 - (HsEnumFrom happy_var_1 - )} - -happyReduce_261 = happyReduce 4# 95# happyReduction_261 -happyReduction_261 (happy_x_4 `HappyStk` - happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) - = case happyOut87 happy_x_1 of { happy_var_1 -> - case happyOut87 happy_x_3 of { happy_var_3 -> - happyIn99 - (HsEnumFromThen happy_var_1 happy_var_3 - ) `HappyStk` happyRest}} - -happyReduce_262 = happySpecReduce_3 95# happyReduction_262 -happyReduction_262 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOut87 happy_x_1 of { happy_var_1 -> - case happyOut87 happy_x_3 of { happy_var_3 -> - happyIn99 - (HsEnumFromTo happy_var_1 happy_var_3 - )}} - -happyReduce_263 = happyReduce 5# 95# happyReduction_263 -happyReduction_263 (happy_x_5 `HappyStk` - happy_x_4 `HappyStk` - happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) - = case happyOut87 happy_x_1 of { happy_var_1 -> - case happyOut87 happy_x_3 of { happy_var_3 -> - case happyOut87 happy_x_5 of { happy_var_5 -> - happyIn99 - (HsEnumFromThenTo happy_var_1 happy_var_3 happy_var_5 - ) `HappyStk` happyRest}}} - -happyReduce_264 = happySpecReduce_2 95# happyReduction_264 -happyReduction_264 happy_x_2 - happy_x_1 - = case happyOut87 happy_x_1 of { happy_var_1 -> - case happyOut101 happy_x_2 of { happy_var_2 -> - happyIn99 - (HsListComp happy_var_1 (reverse happy_var_2) - )}} - -happyReduce_265 = happySpecReduce_3 96# happyReduction_265 -happyReduction_265 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOut100 happy_x_1 of { happy_var_1 -> - case happyOut87 happy_x_3 of { happy_var_3 -> - happyIn100 - (happy_var_3 : happy_var_1 - )}} - -happyReduce_266 = happySpecReduce_3 96# happyReduction_266 -happyReduction_266 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOut87 happy_x_1 of { happy_var_1 -> - case happyOut87 happy_x_3 of { happy_var_3 -> - happyIn100 - ([happy_var_3,happy_var_1] - )}} - -happyReduce_267 = happySpecReduce_1 97# happyReduction_267 -happyReduction_267 happy_x_1 - = case happyOut102 happy_x_1 of { happy_var_1 -> - happyIn101 - (case happy_var_1 of - [qs] -> qs - qss -> [HsParStmt (concat qss)] - )} - -happyReduce_268 = happySpecReduce_3 98# happyReduction_268 -happyReduction_268 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOut102 happy_x_1 of { happy_var_1 -> - case happyOut103 happy_x_3 of { happy_var_3 -> - happyIn102 - (happy_var_3 : happy_var_1 - )}} - -happyReduce_269 = happySpecReduce_2 98# happyReduction_269 -happyReduction_269 happy_x_2 - happy_x_1 - = case happyOut103 happy_x_2 of { happy_var_2 -> - happyIn102 - ([happy_var_2] - )} - -happyReduce_270 = happySpecReduce_3 99# happyReduction_270 -happyReduction_270 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOut103 happy_x_1 of { happy_var_1 -> - case happyOut104 happy_x_3 of { happy_var_3 -> - happyIn103 - (happy_var_3 : happy_var_1 - )}} - -happyReduce_271 = happySpecReduce_1 99# happyReduction_271 -happyReduction_271 happy_x_1 - = case happyOut104 happy_x_1 of { happy_var_1 -> - happyIn103 - ([happy_var_1] - )} - -happyReduce_272 = happySpecReduce_3 100# happyReduction_272 -happyReduction_272 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOut111 happy_x_1 of { happy_var_1 -> - case happyOut87 happy_x_3 of { happy_var_3 -> - happyIn104 - (HsGenerator happy_var_1 happy_var_3 - )}} - -happyReduce_273 = happySpecReduce_1 100# happyReduction_273 -happyReduction_273 happy_x_1 - = case happyOut87 happy_x_1 of { happy_var_1 -> - happyIn104 - (HsQualifier happy_var_1 - )} - -happyReduce_274 = happySpecReduce_2 100# happyReduction_274 -happyReduction_274 happy_x_2 - happy_x_1 - = case happyOut79 happy_x_2 of { happy_var_2 -> - happyIn104 - (HsLetStmt happy_var_2 - )} - -happyReduce_275 = happyReduce 4# 101# happyReduction_275 -happyReduction_275 (happy_x_4 `HappyStk` - happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) - = case happyOut106 happy_x_2 of { happy_var_2 -> - happyIn105 - (reverse happy_var_2 - ) `HappyStk` happyRest} - -happyReduce_276 = happyReduce 4# 101# happyReduction_276 -happyReduction_276 (happy_x_4 `HappyStk` - happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) - = case happyOut106 happy_x_2 of { happy_var_2 -> - happyIn105 - (reverse happy_var_2 - ) `HappyStk` happyRest} - -happyReduce_277 = happySpecReduce_3 102# happyReduction_277 -happyReduction_277 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOut106 happy_x_1 of { happy_var_1 -> - case happyOut107 happy_x_3 of { happy_var_3 -> - happyIn106 - (happy_var_3 : happy_var_1 - )}} - -happyReduce_278 = happySpecReduce_1 102# happyReduction_278 -happyReduction_278 happy_x_1 - = case happyOut107 happy_x_1 of { happy_var_1 -> - happyIn106 - ([happy_var_1] - )} - -happyReduce_279 = happyReduce 4# 103# happyReduction_279 -happyReduction_279 (happy_x_4 `HappyStk` - happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) - = case happyOut111 happy_x_1 of { happy_var_1 -> - case happyOut144 happy_x_2 of { happy_var_2 -> - case happyOut108 happy_x_3 of { happy_var_3 -> - case happyOut80 happy_x_4 of { happy_var_4 -> - happyIn107 - (HsAlt happy_var_2 happy_var_1 happy_var_3 happy_var_4 - ) `HappyStk` happyRest}}}} - -happyReduce_280 = happySpecReduce_2 104# happyReduction_280 -happyReduction_280 happy_x_2 - happy_x_1 - = case happyOut87 happy_x_2 of { happy_var_2 -> - happyIn108 - (HsUnGuardedAlt happy_var_2 - )} - -happyReduce_281 = happySpecReduce_1 104# happyReduction_281 -happyReduction_281 happy_x_1 - = case happyOut109 happy_x_1 of { happy_var_1 -> - happyIn108 - (HsGuardedAlts (reverse happy_var_1) - )} - -happyReduce_282 = happySpecReduce_2 105# happyReduction_282 -happyReduction_282 happy_x_2 - happy_x_1 - = case happyOut109 happy_x_1 of { happy_var_1 -> - case happyOut110 happy_x_2 of { happy_var_2 -> - happyIn109 - (happy_var_2 : happy_var_1 - )}} - -happyReduce_283 = happySpecReduce_1 105# happyReduction_283 -happyReduction_283 happy_x_1 - = case happyOut110 happy_x_1 of { happy_var_1 -> - happyIn109 - ([happy_var_1] - )} - -happyReduce_284 = happyReduce 5# 106# happyReduction_284 -happyReduction_284 (happy_x_5 `HappyStk` - happy_x_4 `HappyStk` - happy_x_3 `HappyStk` - happy_x_2 `HappyStk` - happy_x_1 `HappyStk` - happyRest) - = case happyOut144 happy_x_2 of { happy_var_2 -> - case happyOut103 happy_x_3 of { happy_var_3 -> - case happyOut87 happy_x_5 of { happy_var_5 -> - happyIn110 - (HsGuardedAlt happy_var_2 happy_var_3 happy_var_5 - ) `HappyStk` happyRest}}} - -happyReduce_285 = happyMonadReduce 1# 107# happyReduction_285 -happyReduction_285 (happy_x_1 `HappyStk` - happyRest) tk - = happyThen (case happyOut90 happy_x_1 of { happy_var_1 -> - ( checkPattern happy_var_1)} - ) (\r -> happyReturn (happyIn111 r)) - -happyReduce_286 = happySpecReduce_3 108# happyReduction_286 -happyReduction_286 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOut113 happy_x_2 of { happy_var_2 -> - happyIn112 - (happy_var_2 - )} - -happyReduce_287 = happySpecReduce_3 108# happyReduction_287 -happyReduction_287 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOut113 happy_x_2 of { happy_var_2 -> - happyIn112 - (happy_var_2 - )} - -happyReduce_288 = happySpecReduce_2 109# happyReduction_288 -happyReduction_288 happy_x_2 - happy_x_1 - = case happyOut104 happy_x_1 of { happy_var_1 -> - case happyOut114 happy_x_2 of { happy_var_2 -> - happyIn113 - (happy_var_1 : happy_var_2 - )}} - -happyReduce_289 = happySpecReduce_2 109# happyReduction_289 -happyReduction_289 happy_x_2 - happy_x_1 - = case happyOut113 happy_x_2 of { happy_var_2 -> - happyIn113 - (happy_var_2 - )} - -happyReduce_290 = happySpecReduce_0 109# happyReduction_290 -happyReduction_290 = happyIn113 - ([] - ) - -happyReduce_291 = happySpecReduce_2 110# happyReduction_291 -happyReduction_291 happy_x_2 - happy_x_1 - = case happyOut113 happy_x_2 of { happy_var_2 -> - happyIn114 - (happy_var_2 - )} - -happyReduce_292 = happySpecReduce_0 110# happyReduction_292 -happyReduction_292 = happyIn114 - ([] - ) - -happyReduce_293 = happySpecReduce_3 111# happyReduction_293 -happyReduction_293 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOut115 happy_x_1 of { happy_var_1 -> - case happyOut116 happy_x_3 of { happy_var_3 -> - happyIn115 - (happy_var_3 : happy_var_1 - )}} - -happyReduce_294 = happySpecReduce_1 111# happyReduction_294 -happyReduction_294 happy_x_1 - = case happyOut116 happy_x_1 of { happy_var_1 -> - happyIn115 - ([happy_var_1] - )} - -happyReduce_295 = happySpecReduce_3 112# happyReduction_295 -happyReduction_295 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOut119 happy_x_1 of { happy_var_1 -> - case happyOut87 happy_x_3 of { happy_var_3 -> - happyIn116 - (HsFieldUpdate happy_var_1 happy_var_3 - )}} - -happyReduce_296 = happySpecReduce_2 113# happyReduction_296 -happyReduction_296 happy_x_2 - happy_x_1 - = happyIn117 - (unit_con_name - ) - -happyReduce_297 = happySpecReduce_2 113# happyReduction_297 -happyReduction_297 happy_x_2 - happy_x_1 - = happyIn117 - (nil_con_name - ) - -happyReduce_298 = happySpecReduce_3 113# happyReduction_298 -happyReduction_298 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOut97 happy_x_2 of { happy_var_2 -> - happyIn117 - (tuple_con_name happy_var_2 - )} - -happyReduce_299 = happySpecReduce_1 113# happyReduction_299 -happyReduction_299 happy_x_1 - = case happyOut122 happy_x_1 of { happy_var_1 -> - happyIn117 - (happy_var_1 - )} - -happyReduce_300 = happySpecReduce_1 114# happyReduction_300 -happyReduction_300 happy_x_1 - = case happyOut132 happy_x_1 of { happy_var_1 -> - happyIn118 - (happy_var_1 - )} - -happyReduce_301 = happySpecReduce_3 114# happyReduction_301 -happyReduction_301 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOut140 happy_x_2 of { happy_var_2 -> - happyIn118 - (happy_var_2 - )} - -happyReduce_302 = happySpecReduce_1 115# happyReduction_302 -happyReduction_302 happy_x_1 - = case happyOut131 happy_x_1 of { happy_var_1 -> - happyIn119 - (happy_var_1 - )} - -happyReduce_303 = happySpecReduce_3 115# happyReduction_303 -happyReduction_303 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOut138 happy_x_2 of { happy_var_2 -> - happyIn119 - (happy_var_2 - )} - -happyReduce_304 = happySpecReduce_1 116# happyReduction_304 -happyReduction_304 happy_x_1 - = case happyOut135 happy_x_1 of { happy_var_1 -> - happyIn120 - (happy_var_1 - )} - -happyReduce_305 = happySpecReduce_3 116# happyReduction_305 -happyReduction_305 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOut137 happy_x_2 of { happy_var_2 -> - happyIn120 - (happy_var_2 - )} - -happyReduce_306 = happySpecReduce_1 117# happyReduction_306 -happyReduction_306 happy_x_1 - = case happyOutTok happy_x_1 of { (IPVarId happy_var_1) -> - happyIn121 - (HsVarName (HsIdent happy_var_1) - )} - -happyReduce_307 = happySpecReduce_1 118# happyReduction_307 -happyReduction_307 happy_x_1 - = case happyOut134 happy_x_1 of { happy_var_1 -> - happyIn122 - (happy_var_1 - )} - -happyReduce_308 = happySpecReduce_3 118# happyReduction_308 -happyReduction_308 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOut136 happy_x_2 of { happy_var_2 -> - happyIn122 - (happy_var_2 - )} - -happyReduce_309 = happySpecReduce_1 119# happyReduction_309 -happyReduction_309 happy_x_1 - = case happyOut140 happy_x_1 of { happy_var_1 -> - happyIn123 - (happy_var_1 - )} - -happyReduce_310 = happySpecReduce_3 119# happyReduction_310 -happyReduction_310 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOut132 happy_x_2 of { happy_var_2 -> - happyIn123 - (happy_var_2 - )} - -happyReduce_311 = happySpecReduce_1 120# happyReduction_311 -happyReduction_311 happy_x_1 - = case happyOut138 happy_x_1 of { happy_var_1 -> - happyIn124 - (happy_var_1 - )} - -happyReduce_312 = happySpecReduce_3 120# happyReduction_312 -happyReduction_312 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOut131 happy_x_2 of { happy_var_2 -> - happyIn124 - (happy_var_2 - )} - -happyReduce_313 = happySpecReduce_1 121# happyReduction_313 -happyReduction_313 happy_x_1 - = case happyOut139 happy_x_1 of { happy_var_1 -> - happyIn125 - (happy_var_1 - )} - -happyReduce_314 = happySpecReduce_3 121# happyReduction_314 -happyReduction_314 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOut131 happy_x_2 of { happy_var_2 -> - happyIn125 - (happy_var_2 - )} - -happyReduce_315 = happySpecReduce_1 122# happyReduction_315 -happyReduction_315 happy_x_1 - = case happyOut137 happy_x_1 of { happy_var_1 -> - happyIn126 - (happy_var_1 - )} - -happyReduce_316 = happySpecReduce_3 122# happyReduction_316 -happyReduction_316 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOut135 happy_x_2 of { happy_var_2 -> - happyIn126 - (happy_var_2 - )} - -happyReduce_317 = happySpecReduce_1 123# happyReduction_317 -happyReduction_317 happy_x_1 - = case happyOut136 happy_x_1 of { happy_var_1 -> - happyIn127 - (happy_var_1 - )} - -happyReduce_318 = happySpecReduce_3 123# happyReduction_318 -happyReduction_318 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOut134 happy_x_2 of { happy_var_2 -> - happyIn127 - (happy_var_2 - )} - -happyReduce_319 = happySpecReduce_1 124# happyReduction_319 -happyReduction_319 happy_x_1 - = case happyOut123 happy_x_1 of { happy_var_1 -> - happyIn128 - (happy_var_1 - )} - -happyReduce_320 = happySpecReduce_1 124# happyReduction_320 -happyReduction_320 happy_x_1 - = case happyOut126 happy_x_1 of { happy_var_1 -> - happyIn128 - (happy_var_1 - )} - -happyReduce_321 = happySpecReduce_1 125# happyReduction_321 -happyReduction_321 happy_x_1 - = case happyOut124 happy_x_1 of { happy_var_1 -> - happyIn129 - (HsVar happy_var_1 - )} - -happyReduce_322 = happySpecReduce_1 125# happyReduction_322 -happyReduction_322 happy_x_1 - = case happyOut127 happy_x_1 of { happy_var_1 -> - happyIn129 - (HsCon happy_var_1 - )} - -happyReduce_323 = happySpecReduce_1 126# happyReduction_323 -happyReduction_323 happy_x_1 - = case happyOut125 happy_x_1 of { happy_var_1 -> - happyIn130 - (HsVar happy_var_1 - )} - -happyReduce_324 = happySpecReduce_1 126# happyReduction_324 -happyReduction_324 happy_x_1 - = case happyOut127 happy_x_1 of { happy_var_1 -> - happyIn130 - (HsCon happy_var_1 - )} - -happyReduce_325 = happySpecReduce_1 127# happyReduction_325 -happyReduction_325 happy_x_1 - = case happyOut132 happy_x_1 of { happy_var_1 -> - happyIn131 - (UnQual happy_var_1 - )} - -happyReduce_326 = happySpecReduce_1 127# happyReduction_326 -happyReduction_326 happy_x_1 - = case happyOutTok happy_x_1 of { (QVarId happy_var_1) -> - happyIn131 - (Qual (Module (fst happy_var_1)) (HsVarName (HsIdent (snd happy_var_1))) - )} - -happyReduce_327 = happySpecReduce_1 128# happyReduction_327 -happyReduction_327 happy_x_1 - = happyIn132 - (forall_name - ) - -happyReduce_328 = happySpecReduce_1 128# happyReduction_328 -happyReduction_328 happy_x_1 - = case happyOut133 happy_x_1 of { happy_var_1 -> - happyIn132 - (happy_var_1 - )} - -happyReduce_329 = happySpecReduce_1 129# happyReduction_329 -happyReduction_329 happy_x_1 - = case happyOutTok happy_x_1 of { (VarId happy_var_1) -> - happyIn133 - (HsVarName (HsIdent happy_var_1) - )} - -happyReduce_330 = happySpecReduce_1 129# happyReduction_330 -happyReduction_330 happy_x_1 - = happyIn133 - (as_name - ) - -happyReduce_331 = happySpecReduce_1 129# happyReduction_331 -happyReduction_331 happy_x_1 - = happyIn133 - (unsafe_name - ) - -happyReduce_332 = happySpecReduce_1 129# happyReduction_332 -happyReduction_332 happy_x_1 - = happyIn133 - (safe_name - ) - -happyReduce_333 = happySpecReduce_1 129# happyReduction_333 -happyReduction_333 happy_x_1 - = happyIn133 - (threadsafe_name - ) - -happyReduce_334 = happySpecReduce_1 129# happyReduction_334 -happyReduction_334 happy_x_1 - = happyIn133 - (qualified_name - ) - -happyReduce_335 = happySpecReduce_1 129# happyReduction_335 -happyReduction_335 happy_x_1 - = happyIn133 - (hiding_name - ) - -happyReduce_336 = happySpecReduce_1 129# happyReduction_336 -happyReduction_336 happy_x_1 - = happyIn133 - (export_name - ) - -happyReduce_337 = happySpecReduce_1 129# happyReduction_337 -happyReduction_337 happy_x_1 - = happyIn133 - (stdcall_name - ) - -happyReduce_338 = happySpecReduce_1 129# happyReduction_338 -happyReduction_338 happy_x_1 - = happyIn133 - (ccall_name - ) - -happyReduce_339 = happySpecReduce_1 129# happyReduction_339 -happyReduction_339 happy_x_1 - = happyIn133 - (dotnet_name - ) - -happyReduce_340 = happySpecReduce_1 130# happyReduction_340 -happyReduction_340 happy_x_1 - = case happyOut135 happy_x_1 of { happy_var_1 -> - happyIn134 - (UnQual happy_var_1 - )} - -happyReduce_341 = happySpecReduce_1 130# happyReduction_341 -happyReduction_341 happy_x_1 - = case happyOutTok happy_x_1 of { (QConId happy_var_1) -> - happyIn134 - (Qual (Module (fst happy_var_1)) (HsVarName (HsIdent (snd happy_var_1))) - )} - -happyReduce_342 = happySpecReduce_1 131# happyReduction_342 -happyReduction_342 happy_x_1 - = case happyOutTok happy_x_1 of { (ConId happy_var_1) -> - happyIn135 - (HsVarName (HsIdent happy_var_1) - )} - -happyReduce_343 = happySpecReduce_1 132# happyReduction_343 -happyReduction_343 happy_x_1 - = case happyOut137 happy_x_1 of { happy_var_1 -> - happyIn136 - (UnQual happy_var_1 - )} - -happyReduce_344 = happySpecReduce_1 132# happyReduction_344 -happyReduction_344 happy_x_1 - = case happyOutTok happy_x_1 of { (QConSym happy_var_1) -> - happyIn136 - (Qual (Module (fst happy_var_1)) (HsVarName (HsSymbol (snd happy_var_1))) - )} - -happyReduce_345 = happySpecReduce_1 133# happyReduction_345 -happyReduction_345 happy_x_1 - = case happyOutTok happy_x_1 of { (ConSym happy_var_1) -> - happyIn137 - (HsVarName (HsSymbol happy_var_1) - )} - -happyReduce_346 = happySpecReduce_1 134# happyReduction_346 -happyReduction_346 happy_x_1 - = case happyOut140 happy_x_1 of { happy_var_1 -> - happyIn138 - (UnQual happy_var_1 - )} - -happyReduce_347 = happySpecReduce_1 134# happyReduction_347 -happyReduction_347 happy_x_1 - = case happyOut142 happy_x_1 of { happy_var_1 -> - happyIn138 - (happy_var_1 - )} - -happyReduce_348 = happySpecReduce_1 135# happyReduction_348 -happyReduction_348 happy_x_1 - = case happyOut141 happy_x_1 of { happy_var_1 -> - happyIn139 - (UnQual happy_var_1 - )} - -happyReduce_349 = happySpecReduce_1 135# happyReduction_349 -happyReduction_349 happy_x_1 - = case happyOut142 happy_x_1 of { happy_var_1 -> - happyIn139 - (happy_var_1 - )} - -happyReduce_350 = happySpecReduce_1 136# happyReduction_350 -happyReduction_350 happy_x_1 - = case happyOutTok happy_x_1 of { (VarSym happy_var_1) -> - happyIn140 - (HsVarName (HsSymbol happy_var_1) - )} - -happyReduce_351 = happySpecReduce_1 136# happyReduction_351 -happyReduction_351 happy_x_1 - = happyIn140 - (dot_name - ) - -happyReduce_352 = happySpecReduce_1 136# happyReduction_352 -happyReduction_352 happy_x_1 - = happyIn140 - (minus_name - ) - -happyReduce_353 = happySpecReduce_1 136# happyReduction_353 -happyReduction_353 happy_x_1 - = happyIn140 - (pling_name - ) - -happyReduce_354 = happySpecReduce_1 137# happyReduction_354 -happyReduction_354 happy_x_1 - = case happyOutTok happy_x_1 of { (VarSym happy_var_1) -> - happyIn141 - (HsVarName (HsSymbol happy_var_1) - )} - -happyReduce_355 = happySpecReduce_1 137# happyReduction_355 -happyReduction_355 happy_x_1 - = happyIn141 - (dot_name - ) - -happyReduce_356 = happySpecReduce_1 137# happyReduction_356 -happyReduction_356 happy_x_1 - = happyIn141 - (pling_name - ) - -happyReduce_357 = happySpecReduce_1 138# happyReduction_357 -happyReduction_357 happy_x_1 - = case happyOutTok happy_x_1 of { (QVarSym happy_var_1) -> - happyIn142 - (Qual (Module (fst happy_var_1)) (HsVarName (HsSymbol (snd happy_var_1))) - )} - -happyReduce_358 = happySpecReduce_1 139# happyReduction_358 -happyReduction_358 happy_x_1 - = case happyOutTok happy_x_1 of { (IntTok happy_var_1) -> - happyIn143 - (HsLit (HsInt happy_var_1) - )} - -happyReduce_359 = happySpecReduce_1 139# happyReduction_359 -happyReduction_359 happy_x_1 - = case happyOutTok happy_x_1 of { (Character happy_var_1) -> - happyIn143 - (HsLit (HsChar happy_var_1) - )} - -happyReduce_360 = happySpecReduce_1 139# happyReduction_360 -happyReduction_360 happy_x_1 - = case happyOutTok happy_x_1 of { (FloatTok happy_var_1) -> - happyIn143 - (HsLit (HsFrac (readRational happy_var_1)) - )} - -happyReduce_361 = happySpecReduce_1 139# happyReduction_361 -happyReduction_361 happy_x_1 - = case happyOutTok happy_x_1 of { (StringTok happy_var_1) -> - happyIn143 - (HsLit (HsString happy_var_1) - )} - -happyReduce_362 = happySpecReduce_1 139# happyReduction_362 -happyReduction_362 happy_x_1 - = case happyOutTok happy_x_1 of { (PrimInt happy_var_1) -> - happyIn143 - (HsLit (HsIntPrim happy_var_1) - )} - -happyReduce_363 = happySpecReduce_1 139# happyReduction_363 -happyReduction_363 happy_x_1 - = case happyOutTok happy_x_1 of { (PrimChar happy_var_1) -> - happyIn143 - (HsLit (HsCharPrim happy_var_1) - )} - -happyReduce_364 = happySpecReduce_1 139# happyReduction_364 -happyReduction_364 happy_x_1 - = case happyOutTok happy_x_1 of { (PrimFloat happy_var_1) -> - happyIn143 - (HsLit (HsFloatPrim (readRational happy_var_1)) - )} - -happyReduce_365 = happySpecReduce_1 139# happyReduction_365 -happyReduction_365 happy_x_1 - = case happyOutTok happy_x_1 of { (PrimDouble happy_var_1) -> - happyIn143 - (HsLit (HsDoublePrim (readRational happy_var_1)) - )} - -happyReduce_366 = happySpecReduce_1 139# happyReduction_366 -happyReduction_366 happy_x_1 - = case happyOutTok happy_x_1 of { (PrimString happy_var_1) -> - happyIn143 - (HsLit (HsStringPrim happy_var_1) - )} - -happyReduce_367 = happyMonadReduce 0# 140# happyReduction_367 -happyReduction_367 (happyRest) tk - = happyThen (( getSrcLoc) - ) (\r -> happyReturn (happyIn144 r)) - -happyReduce_368 = happySpecReduce_1 141# happyReduction_368 -happyReduction_368 happy_x_1 - = happyIn145 - (() - ) - -happyReduce_369 = happyMonadReduce 1# 141# happyReduction_369 -happyReduction_369 (happy_x_1 `HappyStk` - happyRest) tk - = happyThen (( popContext) - ) (\r -> happyReturn (happyIn145 r)) - -happyReduce_370 = happyMonadReduce 0# 142# happyReduction_370 -happyReduction_370 (happyRest) tk - = happyThen (( getSrcLoc `thenP` \(SrcLoc r c f) -> - pushContext (Layout c)) - ) (\r -> happyReturn (happyIn146 r)) - -happyReduce_371 = happySpecReduce_1 143# happyReduction_371 -happyReduction_371 happy_x_1 - = case happyOutTok happy_x_1 of { (ConId happy_var_1) -> - happyIn147 - (Module happy_var_1 - )} - -happyReduce_372 = happySpecReduce_1 143# happyReduction_372 -happyReduction_372 happy_x_1 - = case happyOutTok happy_x_1 of { (QConId happy_var_1) -> - happyIn147 - (Module (fst happy_var_1 ++ '.':snd happy_var_1) - )} - -happyReduce_373 = happySpecReduce_1 144# happyReduction_373 -happyReduction_373 happy_x_1 - = case happyOutTok happy_x_1 of { (ConId happy_var_1) -> - happyIn148 - (HsTyClsName (HsIdent happy_var_1) - )} - -happyReduce_374 = happySpecReduce_1 145# happyReduction_374 -happyReduction_374 happy_x_1 - = case happyOutTok happy_x_1 of { (ConId happy_var_1) -> - happyIn149 - (HsTyClsName (HsIdent happy_var_1) - )} - -happyReduce_375 = happySpecReduce_1 146# happyReduction_375 -happyReduction_375 happy_x_1 - = case happyOutTok happy_x_1 of { (ConId happy_var_1) -> - happyIn150 - (UnQual (HsTyClsName (HsIdent happy_var_1)) - )} - -happyReduce_376 = happySpecReduce_1 146# happyReduction_376 -happyReduction_376 happy_x_1 - = case happyOutTok happy_x_1 of { (QConId happy_var_1) -> - happyIn150 - (Qual (Module (fst happy_var_1)) (HsTyClsName (HsIdent (snd happy_var_1))) - )} - -happyReduce_377 = happySpecReduce_1 147# happyReduction_377 -happyReduction_377 happy_x_1 - = case happyOut133 happy_x_1 of { happy_var_1 -> - happyIn151 - (happy_var_1 - )} - -happyReduce_378 = happySpecReduce_3 147# happyReduction_378 -happyReduction_378 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOut140 happy_x_2 of { happy_var_2 -> - happyIn151 - (happy_var_2 - )} - -happyReduce_379 = happySpecReduce_3 148# happyReduction_379 -happyReduction_379 happy_x_3 - happy_x_2 - happy_x_1 - = case happyOut151 happy_x_2 of { happy_var_2 -> - happyIn152 - (HsTyVar happy_var_2 - )} - -happyReduce_380 = happySpecReduce_1 148# happyReduction_380 -happyReduction_380 happy_x_1 - = case happyOut140 happy_x_1 of { happy_var_1 -> - happyIn152 - (HsTyVar happy_var_1 - )} - -happyReduce_381 = happyMonadReduce 1# 149# happyReduction_381 -happyReduction_381 (happy_x_1 `HappyStk` - happyRest) tk - = happyThen (case happyOutTok happy_x_1 of { (DocCommentNext happy_var_1) -> - ( case parseParas (tokenise happy_var_1) of { - Left err -> parseError err; - Right doc -> returnP doc })} - ) (\r -> happyReturn (happyIn153 r)) - -happyReduce_382 = happyMonadReduce 1# 150# happyReduction_382 -happyReduction_382 (happy_x_1 `HappyStk` - happyRest) tk - = happyThen (case happyOutTok happy_x_1 of { (DocCommentPrev happy_var_1) -> - ( case parseParas (tokenise happy_var_1) of { - Left err -> parseError err; - Right doc -> returnP doc })} - ) (\r -> happyReturn (happyIn154 r)) - -happyReduce_383 = happyMonadReduce 1# 151# happyReduction_383 -happyReduction_383 (happy_x_1 `HappyStk` - happyRest) tk - = happyThen (case happyOutTok happy_x_1 of { (DocCommentNamed happy_var_1) -> - ( let (name,rest) = break isSpace happy_var_1 in - case parseParas (tokenise rest) of { - Left err -> parseError err; - Right doc -> returnP (name,doc) })} - ) (\r -> happyReturn (happyIn155 r)) - -happyReduce_384 = happyMonadReduce 1# 152# happyReduction_384 -happyReduction_384 (happy_x_1 `HappyStk` - happyRest) tk - = happyThen (case happyOutTok happy_x_1 of { happy_var_1 -> - ( case happy_var_1 of { DocSection n s -> - case parseString (tokenise s) of { - Left err -> parseError err; - Right doc -> returnP (n, doc) } })} - ) (\r -> happyReturn (happyIn156 r)) - -happyReduce_385 = happySpecReduce_1 153# happyReduction_385 -happyReduction_385 happy_x_1 - = case happyOut154 happy_x_1 of { happy_var_1 -> - happyIn157 - (Just happy_var_1 - )} - -happyReduce_386 = happySpecReduce_0 153# happyReduction_386 -happyReduction_386 = happyIn157 - (Nothing - ) - -happyReduce_387 = happySpecReduce_1 154# happyReduction_387 -happyReduction_387 happy_x_1 - = case happyOut153 happy_x_1 of { happy_var_1 -> - happyIn158 - (Just happy_var_1 - )} - -happyReduce_388 = happySpecReduce_0 154# happyReduction_388 -happyReduction_388 = happyIn158 - (Nothing - ) - -happyReduce_389 = happyMonadReduce 1# 155# happyReduction_389 -happyReduction_389 (happy_x_1 `HappyStk` - happyRest) tk - = happyThen (case happyOutTok happy_x_1 of { (DocCommentNext happy_var_1) -> - ( case parseModuleHeader happy_var_1 of { - Right (str,info) -> - case parseParas (tokenise str) of { - Left err -> parseError err; - Right doc -> returnP (info,Just doc); - }; - Left err -> parseError err - })} - ) (\r -> happyReturn (happyIn159 r)) - -happyNewToken action sts stk - = lexer(\tk -> - let cont i = happyDoAction i tk action sts stk in - case tk of { - EOF -> happyDoAction 83# tk action sts stk; - VarId happy_dollar_dollar -> cont 1#; - IPVarId happy_dollar_dollar -> cont 2#; - QVarId happy_dollar_dollar -> cont 3#; - ConId happy_dollar_dollar -> cont 4#; - QConId happy_dollar_dollar -> cont 5#; - VarSym happy_dollar_dollar -> cont 6#; - ConSym happy_dollar_dollar -> cont 7#; - QVarSym happy_dollar_dollar -> cont 8#; - QConSym happy_dollar_dollar -> cont 9#; - IntTok happy_dollar_dollar -> cont 10#; - FloatTok happy_dollar_dollar -> cont 11#; - Character happy_dollar_dollar -> cont 12#; - StringTok happy_dollar_dollar -> cont 13#; - PrimInt happy_dollar_dollar -> cont 14#; - PrimString happy_dollar_dollar -> cont 15#; - PrimFloat happy_dollar_dollar -> cont 16#; - PrimDouble happy_dollar_dollar -> cont 17#; - PrimChar happy_dollar_dollar -> cont 18#; - DocCommentNext happy_dollar_dollar -> cont 19#; - DocCommentPrev happy_dollar_dollar -> cont 20#; - DocCommentNamed happy_dollar_dollar -> cont 21#; - DocSection _ _ -> cont 22#; - DocOptions happy_dollar_dollar -> cont 23#; - LeftParen -> cont 24#; - RightParen -> cont 25#; - LeftUT -> cont 26#; - RightUT -> cont 27#; - SemiColon -> cont 28#; - LeftCurly -> cont 29#; - RightCurly -> cont 30#; - VRightCurly -> cont 31#; - LeftSquare -> cont 32#; - RightSquare -> cont 33#; - Comma -> cont 34#; - Underscore -> cont 35#; - BackQuote -> cont 36#; - Dot -> cont 37#; - DotDot -> cont 38#; - DoubleColon -> cont 39#; - Equals -> cont 40#; - Backslash -> cont 41#; - Bar -> cont 42#; - LeftArrow -> cont 43#; - RightArrow -> cont 44#; - At -> cont 45#; - Tilde -> cont 46#; - DoubleArrow -> cont 47#; - Minus -> cont 48#; - Exclamation -> cont 49#; - KW_As -> cont 50#; - KW_Case -> cont 51#; - KW_CCall -> cont 52#; - KW_Class -> cont 53#; - KW_Data -> cont 54#; - KW_Default -> cont 55#; - KW_Deriving -> cont 56#; - KW_Do -> cont 57#; - KW_DotNet -> cont 58#; - KW_Else -> cont 59#; - KW_Export -> cont 60#; - KW_Forall -> cont 61#; - KW_Foreign -> cont 62#; - KW_Hiding -> cont 63#; - KW_If -> cont 64#; - KW_Import -> cont 65#; - KW_In -> cont 66#; - KW_Infix -> cont 67#; - KW_InfixL -> cont 68#; - KW_InfixR -> cont 69#; - KW_Instance -> cont 70#; - KW_Let -> cont 71#; - KW_Module -> cont 72#; - KW_NewType -> cont 73#; - KW_Of -> cont 74#; - KW_Safe -> cont 75#; - KW_StdCall -> cont 76#; - KW_Then -> cont 77#; - KW_ThreadSafe -> cont 78#; - KW_Type -> cont 79#; - KW_Unsafe -> cont 80#; - KW_Where -> cont 81#; - KW_Qualified -> cont 82#; - _ -> happyError' tk - }) - -happyError_ tk = happyError' tk - -happyThen :: () => P a -> (a -> P b) -> P b -happyThen = (thenP) -happyReturn :: () => a -> P a -happyReturn = (returnP) -happyThen1 = happyThen -happyReturn1 :: () => a -> P a -happyReturn1 = happyReturn -happyError' :: () => Token -> P a -happyError' tk = (\token -> happyError) tk - -parse = happySomeParser where - happySomeParser = happyThen (happyParse 0#) (\x -> happyReturn (happyOut4 x)) - -happySeq = happyDontSeq - - -happyError = parseError "Parse error" -{-# LINE 1 "GenericTemplate.hs" #-} -{-# LINE 1 "GenericTemplate.hs" #-} -{-# LINE 1 "" #-} -{-# LINE 1 "" #-} -{-# LINE 1 "GenericTemplate.hs" #-} --- Id: GenericTemplate.hs,v 1.26 2005/01/14 14:47:22 simonmar Exp - -{-# LINE 28 "GenericTemplate.hs" #-} - - -data Happy_IntList = HappyCons Int# Happy_IntList - - - - - -{-# LINE 49 "GenericTemplate.hs" #-} - -{-# LINE 59 "GenericTemplate.hs" #-} - -{-# LINE 68 "GenericTemplate.hs" #-} - -infixr 9 `HappyStk` -data HappyStk a = HappyStk a (HappyStk a) - ------------------------------------------------------------------------------ --- starting the parse - -happyParse start_state = happyNewToken start_state notHappyAtAll notHappyAtAll - ------------------------------------------------------------------------------ --- Accepting the parse - --- If the current token is 0#, it means we've just accepted a partial --- parse (a %partial parser). We must ignore the saved token on the top of --- the stack in this case. -happyAccept 0# tk st sts (_ `HappyStk` ans `HappyStk` _) = - happyReturn1 ans -happyAccept j tk st sts (HappyStk ans _) = - (happyTcHack j (happyTcHack st)) (happyReturn1 ans) - ------------------------------------------------------------------------------ --- Arrays only: do the next action - - - -happyDoAction i tk st - = {- nothing -} - - - case action of - 0# -> {- nothing -} - happyFail i tk st - -1# -> {- nothing -} - happyAccept i tk st - n | (n <# (0# :: Int#)) -> {- nothing -} - - (happyReduceArr ! rule) i tk st - where rule = (I# ((negateInt# ((n +# (1# :: Int#)))))) - n -> {- nothing -} - - - happyShift new_state i tk st - where new_state = (n -# (1# :: Int#)) - where off = indexShortOffAddr happyActOffsets st - off_i = (off +# i) - check = if (off_i >=# (0# :: Int#)) - then (indexShortOffAddr happyCheck off_i ==# i) - else False - action | check = indexShortOffAddr happyTable off_i - | otherwise = indexShortOffAddr happyDefActions st - -{-# LINE 127 "GenericTemplate.hs" #-} - - -indexShortOffAddr (HappyA# arr) off = -#if __GLASGOW_HASKELL__ > 500 - narrow16Int# i -#elif __GLASGOW_HASKELL__ == 500 - intToInt16# i -#else - (i `iShiftL#` 16#) `iShiftRA#` 16# -#endif - where -#if __GLASGOW_HASKELL__ >= 503 - i = word2Int# ((high `uncheckedShiftL#` 8#) `or#` low) -#else - i = word2Int# ((high `shiftL#` 8#) `or#` low) -#endif - high = int2Word# (ord# (indexCharOffAddr# arr (off' +# 1#))) - low = int2Word# (ord# (indexCharOffAddr# arr off')) - off' = off *# 2# - - - - - -data HappyAddr = HappyA# Addr# - - - - ------------------------------------------------------------------------------ --- HappyState data type (not arrays) - -{-# LINE 170 "GenericTemplate.hs" #-} - ------------------------------------------------------------------------------ --- Shifting a token - -happyShift new_state 0# tk st sts stk@(x `HappyStk` _) = - let i = (case unsafeCoerce# x of { (I# (i)) -> i }) in --- trace "shifting the error token" $ - happyDoAction i tk new_state (HappyCons (st) (sts)) (stk) - -happyShift new_state i tk st sts stk = - happyNewToken new_state (HappyCons (st) (sts)) ((happyInTok (tk))`HappyStk`stk) - --- happyReduce is specialised for the common cases. - -happySpecReduce_0 i fn 0# tk st sts stk - = happyFail 0# tk st sts stk -happySpecReduce_0 nt fn j tk st@((action)) sts stk - = happyGoto nt j tk st (HappyCons (st) (sts)) (fn `HappyStk` stk) - -happySpecReduce_1 i fn 0# tk st sts stk - = happyFail 0# tk st sts stk -happySpecReduce_1 nt fn j tk _ sts@((HappyCons (st@(action)) (_))) (v1`HappyStk`stk') - = let r = fn v1 in - happySeq r (happyGoto nt j tk st sts (r `HappyStk` stk')) - -happySpecReduce_2 i fn 0# tk st sts stk - = happyFail 0# tk st sts stk -happySpecReduce_2 nt fn j tk _ (HappyCons (_) (sts@((HappyCons (st@(action)) (_))))) (v1`HappyStk`v2`HappyStk`stk') - = let r = fn v1 v2 in - happySeq r (happyGoto nt j tk st sts (r `HappyStk` stk')) - -happySpecReduce_3 i fn 0# tk st sts stk - = happyFail 0# tk st sts stk -happySpecReduce_3 nt fn j tk _ (HappyCons (_) ((HappyCons (_) (sts@((HappyCons (st@(action)) (_))))))) (v1`HappyStk`v2`HappyStk`v3`HappyStk`stk') - = let r = fn v1 v2 v3 in - happySeq r (happyGoto nt j tk st sts (r `HappyStk` stk')) - -happyReduce k i fn 0# tk st sts stk - = happyFail 0# tk st sts stk -happyReduce k nt fn j tk st sts stk - = case happyDrop (k -# (1# :: Int#)) sts of - sts1@((HappyCons (st1@(action)) (_))) -> - let r = fn stk in -- it doesn't hurt to always seq here... - happyDoSeq r (happyGoto nt j tk st1 sts1 r) - -happyMonadReduce k nt fn 0# tk st sts stk - = happyFail 0# tk st sts stk -happyMonadReduce k nt fn j tk st sts stk = - happyThen1 (fn stk tk) (\r -> happyGoto nt j tk st1 sts1 (r `HappyStk` drop_stk)) - where sts1@((HappyCons (st1@(action)) (_))) = happyDrop k (HappyCons (st) (sts)) - drop_stk = happyDropStk k stk - -happyMonad2Reduce k nt fn 0# tk st sts stk - = happyFail 0# tk st sts stk -happyMonad2Reduce k nt fn j tk st sts stk = - happyThen1 (fn stk tk) (\r -> happyNewToken new_state sts1 (r `HappyStk` drop_stk)) - where sts1@((HappyCons (st1@(action)) (_))) = happyDrop k (HappyCons (st) (sts)) - drop_stk = happyDropStk k stk - - off = indexShortOffAddr happyGotoOffsets st1 - off_i = (off +# nt) - new_state = indexShortOffAddr happyTable off_i - - - - -happyDrop 0# l = l -happyDrop n (HappyCons (_) (t)) = happyDrop (n -# (1# :: Int#)) t - -happyDropStk 0# l = l -happyDropStk n (x `HappyStk` xs) = happyDropStk (n -# (1#::Int#)) xs - ------------------------------------------------------------------------------ --- Moving to a new state after a reduction - - -happyGoto nt j tk st = - {- nothing -} - happyDoAction j tk new_state - where off = indexShortOffAddr happyGotoOffsets st - off_i = (off +# nt) - new_state = indexShortOffAddr happyTable off_i - - - - ------------------------------------------------------------------------------ --- Error recovery (0# is the error token) - --- parse error if we are in recovery and we fail again -happyFail 0# tk old_st _ stk = --- trace "failing" $ - happyError_ tk - -{- We don't need state discarding for our restricted implementation of - "error". In fact, it can cause some bogus parses, so I've disabled it - for now --SDM - --- discard a state -happyFail 0# tk old_st (HappyCons ((action)) (sts)) - (saved_tok `HappyStk` _ `HappyStk` stk) = --- trace ("discarding state, depth " ++ show (length stk)) $ - happyDoAction 0# tk action sts ((saved_tok`HappyStk`stk)) --} - --- Enter error recovery: generate an error token, --- save the old token and carry on. -happyFail i tk (action) sts stk = --- trace "entering error recovery" $ - happyDoAction 0# tk action sts ( (unsafeCoerce# (I# (i))) `HappyStk` stk) - --- Internal happy errors: - -notHappyAtAll = error "Internal Happy error\n" - ------------------------------------------------------------------------------ --- Hack to get the typechecker to accept our action functions - - -happyTcHack :: Int# -> a -> a -happyTcHack x y = y -{-# INLINE happyTcHack #-} - - ------------------------------------------------------------------------------ --- Seq-ing. If the --strict flag is given, then Happy emits --- happySeq = happyDoSeq --- otherwise it emits --- happySeq = happyDontSeq - -happyDoSeq, happyDontSeq :: a -> b -> b -happyDoSeq a b = a `seq` b -happyDontSeq a b = b - ------------------------------------------------------------------------------ --- Don't inline any functions from the template. GHC has a nasty habit --- of deciding to inline happyGoto everywhere, which increases the size of --- the generated parser quite a bit. - - -{-# NOINLINE happyDoAction #-} -{-# NOINLINE happyTable #-} -{-# NOINLINE happyCheck #-} -{-# NOINLINE happyActOffsets #-} -{-# NOINLINE happyGotoOffsets #-} -{-# NOINLINE happyDefActions #-} - -{-# NOINLINE happyShift #-} -{-# NOINLINE happySpecReduce_0 #-} -{-# NOINLINE happySpecReduce_1 #-} -{-# NOINLINE happySpecReduce_2 #-} -{-# NOINLINE happySpecReduce_3 #-} -{-# NOINLINE happyReduce #-} -{-# NOINLINE happyMonadReduce #-} -{-# NOINLINE happyGoto #-} -{-# NOINLINE happyFail #-} - --- end of Happy Template. diff --git a/doc/haddock.xml b/doc/haddock.xml --- a/doc/haddock.xml +++ b/doc/haddock.xml @@ -16,7 +16,7 @@ Simon Marlow - This document describes Haddock version 0.9, a Haskell + This document describes Haddock version 2.0.0.0, a Haskell documentation tool. @@ -108,9 +108,7 @@ Up-to-date sources can also be obtained from our public darcs repository. The Haddock sources are at - http://darcs.haskell.org/haddock. The same - server also has separate repositories for GHC, Happy, and many - other projects. See + http://code.haskell.org/haddock. See darcs.net for more information on the darcs version control utility. @@ -205,9 +203,8 @@ Where each file is a filename - containing a Haskell source module. Only plain Haskell source - files are accepted (but see for instructions - on how to pre-process source files for feeding to Haddock). + containing a Haskell source module (.hs) or a Literate Haskell source + module (.lhs) or just a module name. All the modules specified on the command line will be processed together. When one module refers to an entity in @@ -226,8 +223,31 @@ The following options are available: + + + dir + + + Tell GHC that that its lib directory is + dir. Needed to do any processing. + + + + + + + =option + + + Pass option to GHC. + + + + + + dir @@ -276,22 +296,6 @@ - - =package - - - Like , but use - ghc-pkg to locate the interface file and - HTML documentation for package, - to reference when generating the documentation. - - Multiple options may - be given. - - - - - file @@ -515,13 +519,14 @@ The string %L or %{LINE} is replaced by the number of the line where the exported value or - type is defined. This is only valid for the - option. + type is defined. This is only valid for the + option. - + The string %% is replaced by - %. - + %. + + For example, if your sources are online under some directory, @@ -675,22 +680,6 @@ - - - - - - - - - Don't automatically import Prelude - in every module. Used when producing documentation for the - Prelude itself. - - - - - @@ -779,23 +768,6 @@ - - - P - - - - P - - - Set the package name for these modules to - P. In a combined index generated - with , the package name for each - module is shown in the right-hand column. - - - - @@ -822,56 +794,17 @@ atribute. (). - - - - - -  filename - - Specifies the ghc-pkg program to run. - - - - - - - - - - Allow links to another package's documentation to be - created even if the directory that allegedly contains the - package's HTML documentation does not exist. - -
Using literate or pre-processed source - Haddock only accepts plain, non-literate, Haskell source. - This means that if you program in Literate Haskell, or you need - to use the C pre-processor in your Haskell source, then you need - to pre-process the files before feeding them to Haddock. This - is easily accomplished using GHC; for example, suppose we have a - Literate Haskell source file Foo.lhs, on - which we also need to run the C pre-processor: - - -$ ghc -cpp -E -optP-P -D__HADDOCK__ Foo.lhs -o Foo.hs -$ haddock -h Foo.hs ... - - - The option to GHC says "stop after - pre-processing", the option turns on the C - pre-processor, the option tells the C - pre-processor not to leave any extra dropping behind (see the - description of the option in the gcc manual - for details), and the option - defines the symbol __HADDOCK__ when - pre-processing (this is sometimes handy if you need to any - pre-processing conditionals in your source which depend on - whether the source is going to be fed to Haddock). + Since Haddock uses GHC internally, both plain and + literate Haskell sources are accepted without the need for the user + to do anything. To use the C pre-processor, however, + the user must pass the the option to GHC + using . +
@@ -1347,63 +1280,25 @@ point locally to C.T. -
- Derived instances - - The deriving keyword in Haskell - presents a small problem for Haddock. Lacking a full type - system, Haddock has to figure out what the shape of the derived - instance is. There is currently a partial implementation of - this, but for some data types Haddock can't determine the shape - of the derived instance, and you see something like - “???” in the documentation. - - One workaround for this is to use CPP () to give Haddock explicit instance headers. Here is an - example from the OpenGL library: - - -data VertexArrayDescriptor a = - VertexArrayDescriptor !NumComponents !DataType !Stride !(Ptr a) -#ifdef __HADDOCK__ --- Help Haddock a bit, because it doesn't do any instance inference. -instance Eq (VertexArrayDescriptor a) -instance Ord (VertexArrayDescriptor a) -instance Show (VertexArrayDescriptor a) -#else - deriving ( Eq, Ord, Show ) -#endif - - - As a rule of thumb, try deriving first, - and if that doesn't work then use the above workaround. -
-
Module Attributes Certain attributes may be specified for each module which affects the way that Haddock generates documentation for that - module. Attributes are specified in a comma-separated list in a - -- # (or - {- # ... -}) comment at the + module. Attributes are specified in a comma-separated list in an + {-# OPTIONS_HADDOCK ... #-} pragma at the top of the module, either before or after the module description. For example: --- #hide, prune, ignore-exports +{-# OPTIONS_HADDOCK hide, prune, ignore-exports #-} -- |Module description module A where ... - The options and module description can be in either order, but - remember to separate them using a blank line if you are using the - -- style comments. Without the blank line in the - example above, the module description would be assumed to be part of - the options, and Haddock would complain about unrecognised - options. + The options and module description can be in either order. The following attributes are currently understood by Haddock: @@ -1599,19 +1494,14 @@
Emphasis and Monospaced text + Emphasis may be added by surrounding text with + /.../. + Monospaced (or typewriter) text is indicated by surrounding it with @...@. Other markup is valid inside a monospaced span: for example @'f' a b@ will hyperlink the identifier f inside the code fragment. - - Emphasis may be added by surrounding text with - /.../. Emphasis is limited to a single - line only; an unmatched / character on a - line is not treated as beginning emphasis (this is to reduce - accidental parse errors due to stray / - characters). Inside /.../, all characters - except / are interpreted literally.
@@ -1708,16 +1598,6 @@ <...>. If the output format supports it, the URL will be turned into a hyperlink when rendered. -
- -
- Images - - An image can be included in a documentation comment by - putting its URL in double angle brackets: - <<...>>. If the output format supports - it, the image specified by the URL will be included in the - rendered documentation at this point.
diff --git a/examples/Hidden.hs b/examples/Hidden.hs --- a/examples/Hidden.hs +++ b/examples/Hidden.hs @@ -1,3 +1,4 @@ -- #hide module Hidden where hidden :: Int -> Int +hidden a = a diff --git a/examples/Test.hs b/examples/Test.hs --- a/examples/Test.hs +++ b/examples/Test.hs @@ -66,10 +66,6 @@ -- $aux12 - -- $aux13 - - -- $aux14 - -- | This is some inline documentation in the export list -- -- > a code block using bird-tracks @@ -84,11 +80,11 @@ {-| nested-style doc comments -} - -- * Existential/Universal types + -- * Existential \/ Universal types Ex(..), -- * Type signatures with argument docs - k, l, m, n, o, + k, l, m, o, -- * A section -- and without an intervening comma: @@ -100,13 +96,15 @@ $ a non /literal/ line $ -} - p, - f', + f' ) where import Hidden import Visible +import Data.Maybe +bla = Nothing + -- | This comment applies to the /following/ declaration -- and it continues until the next non-comment line data T a b @@ -139,7 +137,7 @@ C4 -- | A newtype -newtype N1 a b = N1 (a b) +newtype N1 a = N1 a -- | A newtype with a fieldname newtype N2 a b = N2 {n :: a b} @@ -167,10 +165,10 @@ class (D a) => C a where -- |this is a description of the 'a' method - a :: Int - b :: Float + a :: IO a + b :: [a] -- ^ this is a description of the 'b' method - c :: Double -- c is hidden in the export list + c :: a -- c is hidden in the export list -- ^ This comment applies to the /previous/ declaration (the 'C' class) @@ -179,18 +177,22 @@ e :: (a,a) -- ^ This is a class declaration with no separate docs for the methods -instance D Int +instance D Int where + d = undefined + e = undefined -- instance with a qualified class name -instance Test.D Float +instance Test.D Float where + d = undefined + e = undefined class E a where - ee :: Int + ee :: a -- ^ This is a class declaration with no methods (or no methods exported) -- This is a class declaration with no documentation at all class F a where - ff :: Float + ff :: a -- | This is the documentation for the 'R' record, which has four fields, -- 'p', 'q', 'r', and 's'. @@ -201,7 +203,7 @@ , -- | This comment applies to both 'r' and 's' r,s :: Int } - | C2 { t :: T1 -> T2 -> T3 -> T4 -> T5, + | C2 { t :: T1 -> (T2 Int Int)-> (T3 Bool Bool) -> (T4 Float Float) -> T5 () (), u,v :: Int } -- ^ This is the 'C2' record constructor, also with some fields: @@ -214,7 +216,8 @@ s1 :: Int -- | The 's2' record selector , s2 :: Int - , s3 :: Int, + , s3 :: Int -- NOTE: In the original examples/Test.hs in Haddock, there is an extra "," here. + -- Since GHC doesn't allow that, I have removed it in this file. -- ^ The 's3' record selector } @@ -228,8 +231,7 @@ {-| In a comment string we can refer to identifiers in scope with single quotes like this: 'T', and we can refer to modules by -using double quotes: "Foo". We can add emphasis /like this/, -/and/ like /this/. +using double quotes: "Foo". We can add emphasis /like this/. * This is a bulleted list @@ -251,8 +253,7 @@ We can also include URLs in documentation: . -} -f :: C a => Int -> Int - +f :: C a => a -> Int -- | we can export foreign declarations too foreign import ccall g :: Int -> IO CInt @@ -276,8 +277,6 @@ -- $aux4 -- -- @ code block on its own in named doc (after newline) @ --- --- with some following text {- $aux5 a nested, named doc comment @@ -349,41 +348,21 @@ -- > bar -- --- $aux13 --- This is the code block example from the documentation. There should --- be no extra vertical space after the first code block, only a normal --- paragraph break. --- --- @ --- f x = x + x --- @ --- --- > g x = x * 42 - -{- $aux14 - -@ -blank - -line -@ --} - --- | A data-type using existential/universal types +-- | A data-type using existential\/universal types data Ex a = forall b . C b => Ex1 b | forall b . Ex2 b - | C a => Ex3 b + | forall b . C a => Ex3 b -- NOTE: I have added "forall b" here make GHC accept this file | Ex4 (forall a . a -> a) -- | This is a function with documentation for each argument -k :: T -- ^ This argument has type 'T' - -> T2 -- ^ This argument has type 'T2' - -> (T3 -> T4) -- ^ This argument has type @T3 -> T4@ - -> T5 -- ^ This argument has a very long description that should - -- hopefully cause some wrapping to happen when it is finally - -- rendered by Haddock in the generated HTML page. - -> IO () -- ^ This is the result type +k :: T () () -- ^ This argument has type 'T' + -> (T2 Int Int) -- ^ This argument has type 'T2 Int Int' + -> (T3 Bool Bool -> T4 Float Float) -- ^ This argument has type @T3 Bool Bool -> T4 Float Float@ + -> T5 () () -- ^ This argument has a very long description that should + -- hopefully cause some wrapping to happen when it is finally + -- rendered by Haddock in the generated HTML page. + -> IO () -- ^ This is the result type -- This function has arg docs but no docs for the function itself l :: (Int, Int, Float) -- ^ takes a triple @@ -391,22 +370,41 @@ -- | This function has some arg docs m :: R - -> N1 -- ^ one of the arguments + -> N1 () -- ^ one of the arguments -> IO Int -- ^ and the return value -- | This function has some arg docs but not a return value doc -n :: R -- ^ one of the arguments, an 'R' - -> N1 -- ^ one of the arguments - -> IO Int +-- can't use the original name ('n') with GHC +newn :: R -- ^ one of the arguments, an 'R' + -> N1 () -- ^ one of the arguments + -> IO Int +newn = undefined + + -- | A foreign import with argument docs foreign import ccall unsafe o :: Float -- ^ The input float -> IO Float -- ^ The output float -- | We should be able to escape this: \#\#\# -p :: Int +-- p :: Int +-- can't use the above original definition with GHC +newp :: Int +newp = undefined + -- | a function with a prime can be referred to as 'f'' -- but f' doesn't get link'd 'f\'' f' :: Int + + +-- Add some definitions here so that this file can be compiled with GHC + +data T1 +f = undefined +f' = undefined +type CInt = Int +k = undefined +l = undefined +m = undefined diff --git a/examples/Visible.hs b/examples/Visible.hs --- a/examples/Visible.hs +++ b/examples/Visible.hs @@ -1,2 +1,3 @@ module Visible where visible :: Int -> Int +visible a = a diff --git a/examples/hide-bug/B.hs b/examples/hide-bug/B.hs --- a/examples/hide-bug/B.hs +++ b/examples/hide-bug/B.hs @@ -1,1 +1,5 @@ -module B(f, T) where import A +module B(Test, vis) where + +vis = id + +data Test = Test diff --git a/examples/hide-bug/C.hs b/examples/hide-bug/C.hs --- a/examples/hide-bug/C.hs +++ b/examples/hide-bug/C.hs @@ -1,1 +1,6 @@ -module C(module B) where import B +module C(C.bla) where + +import D + +bla :: Test +bla = undefined diff --git a/examples/hide-bug/D.hs b/examples/hide-bug/D.hs --- a/examples/hide-bug/D.hs +++ b/examples/hide-bug/D.hs @@ -1,3 +1,7 @@ -- The link to the type T in the doc for this module should point to -- B.T, not A.T. Bug fixed in rev 1.59 of Main.hs. -module D(f) where import C +module D(Test, hej) where + +import B + +hej = vis diff --git a/haddock.cabal b/haddock.cabal --- a/haddock.cabal +++ b/haddock.cabal @@ -1,22 +1,41 @@ -name: haddock -version: 0.9 -license: BSD3 -license-file: LICENSE -copyright: (c) Simon Marlow -author: Simon Marlow -maintainer: Simon Marlow -stability: stable -homepage: http://www.haskell.org/haddock/ -synopsis: Haddock is a documentation-generation tool for Haskell libraries -category: Development -cabal-version: >= 1.2 +cabal-version: >= 1.2 +build-type: Simple +name: haddock +version: 2.0.0.0 +license: BSD3 +license-file: LICENSE +copyright: (c) Simon Marlow, David Waern +author: Simon Marlow, David Waern +maintainer: David Waern +stability: experimental +homepage: http://www.haskell.org/haddock/ +description: Haddock is a documentation-generation tool for Haskell + libraries +category: Development +build-depends: + base, + haskell98, + ghc >= 6.8.2 && < 6.9, + filepath, + directory, + pretty, + containers, + array +extensions: CPP, PatternGuards +ghc-options: -fglasgow-exts +hs-source-dirs: src +exposed-modules: Distribution.Haddock +other-modules: + Haddock.Types + Haddock.InterfaceFile + Haddock.Exception data-files: - html/haddock-DEBUG.css - html/haddock.css - html/haddock-util.js - html/haskell_icon.gif - html/minus.gif - html/plus.gif + html/haddock-DEBUG.css + html/haddock.css + html/haddock-util.js + html/haskell_icon.gif + html/minus.gif + html/plus.gif extra-source-files: CHANGES README @@ -53,46 +72,33 @@ haskell.vim src/haddock.sh -flag small_base - description: Choose the new smaller, split-up base package. - -executable haddock - executable: haddock - hs-source-dirs: src - main-is: Main.hs - - if flag(small_base) - build-depends: base >= 2.1, array, containers, directory, pretty, process - else - build-depends: base >= 1.0 - - build-depends: haskell98 >= 1.0 - - extensions: CPP - other-modules: - Binary - BlockTable - Digraph - FastMutInt - HaddockDB - HaddockDevHelp - HaddockHH - HaddockHH2 - HaddockHoogle - HaddockHtml - HaddockLex - HaddockModuleTree - HaddockParse - HaddockRename - HaddockTypes - HaddockUtil - HaddockVersion - HsLexer - HsParseMonad - HsParseUtils - HsParser - HsSyn - Html - Main - Map - Set +executable: haddock +hs-source-dirs: src +main-is: Main.hs +extensions: CPP, PatternGuards +ghc-options: -fglasgow-exts -funbox-strict-fields -O2 -fasm +other-modules: + Haddock.Interface + Haddock.Interface.Rename + Haddock.Interface.Create + Haddock.Interface.AttachInstances + Haddock.Utils.FastMutInt2 + Haddock.Utils.BlockTable + Haddock.Utils.Html + Haddock.Utils + Haddock.Backends.Html + Haddock.Backends.HaddockDB + Haddock.Backends.DevHelp + Haddock.Backends.HH + Haddock.Backends.HH2 + Haddock.Backends.Hoogle + Haddock.ModuleTree + Haddock.Types + Haddock.Version + Haddock.InterfaceFile + Haddock.Exception + Haddock.Options + Haddock.GHC.Typecheck + Haddock.GHC.Utils + Haddock.GHC + Haddock.Comments diff --git a/haddock.spec b/haddock.spec --- a/haddock.spec +++ b/haddock.spec @@ -17,7 +17,7 @@ # version label of your release tarball. %define name haddock -%define version 0.9 +%define version 2.0.0.0 %define release 1 Name: %{name} diff --git a/src/Binary.hs b/src/Binary.hs deleted file mode 100644 --- a/src/Binary.hs +++ /dev/null @@ -1,670 +0,0 @@ -{-# OPTIONS_GHC -cpp -fglasgow-exts #-} --- --- (c) The University of Glasgow 2002 --- --- Binary I/O library, with special tweaks for GHC --- --- Based on the nhc98 Binary library, which is copyright --- (c) Malcolm Wallace and Colin Runciman, University of York, 1998. --- Under the terms of the license for that software, we must tell you --- where you can obtain the original version of the Binary library, namely --- http://www.cs.york.ac.uk/fp/nhc98/ - -module Binary - ( {-type-} Bin, - {-class-} Binary(..), - {-type-} BinHandle, - - openBinIO, - openBinIO_, - openBinMem, --- closeBin, - --- getUserData, - - seekBin, - tellBin, - castBin, - - writeBinMem, - readBinMem, - - isEOFBin, - - -- for writing instances: - putByte, - getByte, - - putString, - getString, - - -- lazy Bin I/O - lazyGet, - lazyPut, - - -- GHC only: - ByteArray(..), - getByteArray, - putByteArray, - --- getBinFileWithDict, -- :: Binary a => FilePath -> IO a --- putBinFileWithDict, -- :: Binary a => FilePath -> Module -> a -> IO () - - -- re-export for the benefit of other modules. - openBinaryFile, - - FormatVersion, - nullFormatVersion, - mkFormatVersion, - ) where - -#include "MachDeps.h" - -import FastMutInt - -import Char -import Monad - -#if __GLASGOW_HASKELL__ < 503 -import IOExts -import Bits -import Int -import Word -import Char -import Monad -import Exception -import GlaExts hiding (ByteArray, newByteArray, freezeByteArray) -import Array -import IO -import PrelIOBase ( IOError(..), IOErrorType(..) -#if __GLASGOW_HASKELL__ > 411 - , IOException(..) -#endif - ) -import PrelReal ( Ratio(..) ) -import PrelIOBase ( IO(..) ) -#else -import Data.Array.IO -import Data.Array -import Data.Bits -import Data.Int -import Data.Word -import Data.IORef -import Data.Char ( ord, chr ) -import Data.Array.Base ( unsafeRead, unsafeWrite ) -import Control.Monad ( when ) -import Control.Exception ( throwDyn ) -import System.IO as IO -import System.IO.Unsafe ( unsafeInterleaveIO ) -import System.IO.Error ( mkIOError, eofErrorType ) -import GHC.Real ( Ratio(..) ) -import GHC.Exts -import GHC.IOBase ( IO(..) ) -import GHC.Word ( Word8(..) ) -#if __GLASGOW_HASKELL__ < 601 --- openFileEx is available from the lang package, but we want to --- be independent of hslibs libraries. -import GHC.Handle ( openFileEx, IOModeEx(..) ) -#endif -#endif - -import IO - -#if __GLASGOW_HASKELL__ < 601 -openBinaryFile f mode = openFileEx f (BinaryMode mode) -#endif - -#if __GLASGOW_HASKELL__ < 503 -type BinArray = MutableByteArray RealWorld Int -newArray_ bounds = stToIO (newCharArray bounds) -unsafeWrite arr ix e = stToIO (writeWord8Array arr ix e) -unsafeRead arr ix = stToIO (readWord8Array arr ix) -#if __GLASGOW_HASKELL__ < 411 -newByteArray# = newCharArray# -#endif -hPutArray h arr sz = hPutBufBAFull h arr sz -hGetArray h sz = hGetBufBAFull h sz - -mkIOError :: IOErrorType -> String -> Maybe Handle -> Maybe FilePath -> Exception -mkIOError t location maybe_hdl maybe_filename - = IOException (IOError maybe_hdl t location "" -#if __GLASGOW_HASKELL__ > 411 - maybe_filename -#endif - ) - -eofErrorType = EOF - -#else -type BinArray = IOUArray Int Word8 -#endif - -data BinHandle - = BinMem { -- binary data stored in an unboxed array - state :: Int, -- sigh, need parameterized modules :-) - off_r :: !FastMutInt, -- the current offset - sz_r :: !FastMutInt, -- size of the array (cached) - arr_r :: !(IORef BinArray) -- the array (bounds: (0,size-1)) - } - -- XXX: should really store a "high water mark" for dumping out - -- the binary data to a file. - - | BinIO { -- binary data stored in a file - state :: Int, - off_r :: !FastMutInt, -- the current offset (cached) - hdl :: !IO.Handle -- the file handle (must be seekable) - } - -- cache the file ptr in BinIO; using hTell is too expensive - -- to call repeatedly. If anyone else is modifying this Handle - -- at the same time, we'll be screwed. - -newtype Bin a = BinPtr Int - deriving (Eq, Ord, Show, Bounded) - -castBin :: Bin a -> Bin b -castBin (BinPtr i) = BinPtr i - -class Binary a where - put_ :: BinHandle -> a -> IO () - put :: BinHandle -> a -> IO (Bin a) - get :: BinHandle -> IO a - - -- define one of put_, put. Use of put_ is recommended because it - -- is more likely that tail-calls can kick in, and we rarely need the - -- position return value. - put_ bh a = do put bh a; return () - put bh a = do p <- tellBin bh; put_ bh a; return p - -putAt :: Binary a => BinHandle -> Bin a -> a -> IO () -putAt bh p x = do seekBin bh p; put bh x; return () - -getAt :: Binary a => BinHandle -> Bin a -> IO a -getAt bh p = do seekBin bh p; get bh - -openBinIO_ :: IO.Handle -> IO BinHandle -openBinIO_ h = openBinIO h - -openBinIO :: IO.Handle -> IO BinHandle -openBinIO h = do - r <- newFastMutInt - writeFastMutInt r 0 - return (BinIO undefined r h) - -openBinMem :: Int -> IO BinHandle -openBinMem size - | size <= 0 = error "Data.Binary.openBinMem: size must be >= 0" - | otherwise = do - arr <- newArray_ (0,size-1) - arr_r0 <- newIORef arr - ix_r <- newFastMutInt - writeFastMutInt ix_r 0 - sz_r0 <- newFastMutInt - writeFastMutInt sz_r0 size - return (BinMem undefined ix_r sz_r0 arr_r0) - ---noBinHandleUserData :: a ---noBinHandleUserData = error "Binary.BinHandle: no user data" - ---getUserData :: BinHandle -> BinHandleState ---getUserData bh = state bh - -tellBin :: BinHandle -> IO (Bin a) -tellBin (BinIO _ r _) = do ix <- readFastMutInt r; return (BinPtr ix) -tellBin (BinMem _ r _ _) = do ix <- readFastMutInt r; return (BinPtr ix) - -seekBin :: BinHandle -> Bin a -> IO () -seekBin (BinIO _ ix_r h) (BinPtr p) = do - writeFastMutInt ix_r p - hSeek h AbsoluteSeek (fromIntegral p) -seekBin h@(BinMem _ ix_r sz_r0 _) (BinPtr p) = do - sz <- readFastMutInt sz_r0 - if (p >= sz) - then do expandBin h p; writeFastMutInt ix_r p - else writeFastMutInt ix_r p - -isEOFBin :: BinHandle -> IO Bool -isEOFBin (BinMem _ ix_r sz_r0 _) = do - ix <- readFastMutInt ix_r - sz <- readFastMutInt sz_r0 - return (ix >= sz) -isEOFBin (BinIO _ _ h) = hIsEOF h - -writeBinMem :: BinHandle -> FilePath -> IO () -writeBinMem (BinIO _ _ _) _ = error "Data.Binary.writeBinMem: not a memory handle" -writeBinMem (BinMem _ ix_r _ arr_r0) fn = do - h <- openBinaryFile fn WriteMode - arr <- readIORef arr_r0 - ix <- readFastMutInt ix_r - hPutArray h arr ix - hClose h - -readBinMem :: FilePath -> IO BinHandle -readBinMem filename = do - h <- openBinaryFile filename ReadMode - filesize' <- hFileSize h - let filesize = fromIntegral filesize' - arr <- newArray_ (0,filesize-1) - count <- hGetArray h arr filesize - when (count /= filesize) - (error ("Binary.readBinMem: only read " ++ show count ++ " bytes")) - hClose h - arr_r0 <- newIORef arr - ix_r <- newFastMutInt - writeFastMutInt ix_r 0 - sz_r0 <- newFastMutInt - writeFastMutInt sz_r0 filesize - return (BinMem undefined {-initReadState-} ix_r sz_r0 arr_r0) - --- expand the size of the array to include a specified offset -expandBin :: BinHandle -> Int -> IO () -expandBin (BinMem _ _ sz_r0 arr_r0) off = do - sz <- readFastMutInt sz_r0 - let sz' = head (dropWhile (<= off) (iterate (* 2) sz)) - arr <- readIORef arr_r0 - arr' <- newArray_ (0,sz'-1) - sequence_ [ unsafeRead arr i >>= unsafeWrite arr' i - | i <- [ 0 .. sz-1 ] ] - writeFastMutInt sz_r0 sz' - writeIORef arr_r0 arr' --- hPutStrLn stderr ("expanding to size: " ++ show sz') - return () -expandBin (BinIO _ _ _) _ = return () - -- no need to expand a file, we'll assume they expand by themselves. - --- ----------------------------------------------------------------------------- --- Low-level reading/writing of bytes - -putWord8 :: BinHandle -> Word8 -> IO () -putWord8 h@(BinMem _ ix_r sz_r0 arr_r0) w = do - ix <- readFastMutInt ix_r - sz <- readFastMutInt sz_r0 - -- double the size of the array if it overflows - if (ix >= sz) - then do expandBin h ix - putWord8 h w - else do arr <- readIORef arr_r0 - unsafeWrite arr ix w - writeFastMutInt ix_r (ix+1) - return () -putWord8 (BinIO _ ix_r h) w = do - ix <- readFastMutInt ix_r - hPutChar h (chr (fromIntegral w)) -- XXX not really correct - writeFastMutInt ix_r (ix+1) - return () - -getWord8 :: BinHandle -> IO Word8 -getWord8 (BinMem _ ix_r sz_r0 arr_r0) = do - ix <- readFastMutInt ix_r - sz <- readFastMutInt sz_r0 - when (ix >= sz) $ - ioError (mkIOError eofErrorType "Data.Binary.getWord8" Nothing Nothing) - arr <- readIORef arr_r0 - w <- unsafeRead arr ix - writeFastMutInt ix_r (ix+1) - return w -getWord8 (BinIO _ ix_r h) = do - ix <- readFastMutInt ix_r - c <- hGetChar h - writeFastMutInt ix_r (ix+1) - return $! (fromIntegral (ord c)) -- XXX not really correct - --- | Get the next byte, but don't change the pointer. -peekWord8 :: BinHandle -> IO Word8 -peekWord8 (BinMem _ ix_r sz_r0 arr_r0) = do - ix <- readFastMutInt ix_r - sz <- readFastMutInt sz_r0 - when (ix >= sz) $ - ioError (mkIOError eofErrorType "Data.Binary.getWord8" Nothing Nothing) - arr <- readIORef arr_r0 - w <- unsafeRead arr ix - return w -peekWord8 (BinIO _ ix_r h) = do - c <- hLookAhead h - return $! (fromIntegral (ord c)) -- XXX not really correct - -putByte :: BinHandle -> Word8 -> IO () -putByte bh w = put_ bh w - -getByte :: BinHandle -> IO Word8 -getByte = getWord8 - --- ----------------------------------------------------------------------------- --- Primitve Word writes - -instance Binary Word8 where - put_ = putWord8 - get = getWord8 - -instance Binary Word16 where - put_ h w = do -- XXX too slow.. inline putWord8? - putByte h (fromIntegral (w `shiftR` 8)) - putByte h (fromIntegral (w .&. 0xff)) - get h = do - w1 <- getWord8 h - w2 <- getWord8 h - return $! ((fromIntegral w1 `shiftL` 8) .|. fromIntegral w2) - - -instance Binary Word32 where - put_ h w = do - putByte h (fromIntegral (w `shiftR` 24)) - putByte h (fromIntegral ((w `shiftR` 16) .&. 0xff)) - putByte h (fromIntegral ((w `shiftR` 8) .&. 0xff)) - putByte h (fromIntegral (w .&. 0xff)) - get h = do - w1 <- getWord8 h - w2 <- getWord8 h - w3 <- getWord8 h - w4 <- getWord8 h - return $! ((fromIntegral w1 `shiftL` 24) .|. - (fromIntegral w2 `shiftL` 16) .|. - (fromIntegral w3 `shiftL` 8) .|. - (fromIntegral w4)) - - -instance Binary Word64 where - put_ h w = do - putByte h (fromIntegral (w `shiftR` 56)) - putByte h (fromIntegral ((w `shiftR` 48) .&. 0xff)) - putByte h (fromIntegral ((w `shiftR` 40) .&. 0xff)) - putByte h (fromIntegral ((w `shiftR` 32) .&. 0xff)) - putByte h (fromIntegral ((w `shiftR` 24) .&. 0xff)) - putByte h (fromIntegral ((w `shiftR` 16) .&. 0xff)) - putByte h (fromIntegral ((w `shiftR` 8) .&. 0xff)) - putByte h (fromIntegral (w .&. 0xff)) - get h = do - w1 <- getWord8 h - w2 <- getWord8 h - w3 <- getWord8 h - w4 <- getWord8 h - w5 <- getWord8 h - w6 <- getWord8 h - w7 <- getWord8 h - w8 <- getWord8 h - return $! ((fromIntegral w1 `shiftL` 56) .|. - (fromIntegral w2 `shiftL` 48) .|. - (fromIntegral w3 `shiftL` 40) .|. - (fromIntegral w4 `shiftL` 32) .|. - (fromIntegral w5 `shiftL` 24) .|. - (fromIntegral w6 `shiftL` 16) .|. - (fromIntegral w7 `shiftL` 8) .|. - (fromIntegral w8)) - --- ----------------------------------------------------------------------------- --- Primitve Int writes - -instance Binary Int8 where - put_ h w = put_ h (fromIntegral w :: Word8) - get h = do w <- get h; return $! (fromIntegral (w::Word8)) - -instance Binary Int16 where - put_ h w = put_ h (fromIntegral w :: Word16) - get h = do w <- get h; return $! (fromIntegral (w::Word16)) - -instance Binary Int32 where - put_ h w = put_ h (fromIntegral w :: Word32) - get h = do w <- get h; return $! (fromIntegral (w::Word32)) - -instance Binary Int64 where - put_ h w = put_ h (fromIntegral w :: Word64) - get h = do w <- get h; return $! (fromIntegral (w::Word64)) - --- ----------------------------------------------------------------------------- --- Instances for standard types - -instance Binary () where - put_ _ () = return () - get _ = return () --- getF bh p = case getBitsF bh 0 p of (_,b) -> ((),b) - -instance Binary Bool where - put_ bh b = putByte bh (fromIntegral (fromEnum b)) - get bh = do x <- getWord8 bh; return $! (toEnum (fromIntegral x)) --- getF bh p = case getBitsF bh 1 p of (x,b) -> (toEnum x,b) - -instance Binary Char where - put_ bh c = put_ bh (fromIntegral (ord c) :: Word32) - get bh = do x <- get bh; return $! (chr (fromIntegral (x :: Word32))) --- getF bh p = case getBitsF bh 8 p of (x,b) -> (toEnum x,b) - -instance Binary Int where - put_ bh i = put_ bh (fromIntegral i :: Int64) - get bh = do - x <- get bh - return $! (fromIntegral (x :: Int64)) --- getF bh = getBitsF bh 64 - -{- -instance Binary a => Binary [a] where - put_ bh [] = putByte bh 0 - put_ bh (x:xs) = do putByte bh 1; put_ bh x; put_ bh xs - get bh = do h <- getWord8 bh - case h of - 0 -> return [] - _ -> do x <- get bh - xs <- get bh - return (x:xs) --} -instance Binary a => Binary [a] where - put_ bh l = - do put_ bh (length l) - mapM (put_ bh) l - return () - get bh = - do len <- get bh - mapM (\_ -> get bh) [1..(len::Int)] - -instance (Binary a, Binary b) => Binary (a,b) where - put_ bh (a,b) = do put_ bh a; put_ bh b - get bh = do a <- get bh - b <- get bh - return (a,b) - -instance (Binary a, Binary b, Binary c) => Binary (a,b,c) where - put_ bh (a,b,c) = do put_ bh a; put_ bh b; put_ bh c - get bh = do a <- get bh - b <- get bh - c <- get bh - return (a,b,c) - -instance (Binary a, Binary b, Binary c, Binary d) => Binary (a,b,c,d) where - put_ bh (a,b,c,d) = do put_ bh a; put_ bh b; put_ bh c; put_ bh d - get bh = do a <- get bh - b <- get bh - c <- get bh - d <- get bh - return (a,b,c,d) - -instance (Binary a, Binary b, Binary c, Binary d, Binary e) => Binary (a,b,c,d,e) where - put_ bh (a,b,c,d,e) = do put_ bh a; put_ bh b; put_ bh c; put_ bh d; put_ bh e - get bh = do a <- get bh - b <- get bh - c <- get bh - d <- get bh - e <- get bh - return (a,b,c,d,e) - -instance (Binary a, Binary b, Binary c, Binary d, Binary e, Binary f) => Binary (a,b,c,d,e,f) where - put_ bh (a,b,c,d,e,f) = do put_ bh a; put_ bh b; put_ bh c; put_ bh d; put_ bh e; put_ bh f - get bh = do a <- get bh - b <- get bh - c <- get bh - d <- get bh - e <- get bh - f <- get bh - return (a,b,c,d,e,f) - -instance (Binary a, Binary b, Binary c, Binary d, Binary e, Binary f,Binary g) => Binary (a,b,c,d,e,f,g) where - put_ bh (a,b,c,d,e,f,g) = do put_ bh a; put_ bh b; put_ bh c; put_ bh d; put_ bh e; put_ bh f; put_ bh g - get bh = do a <- get bh - b <- get bh - c <- get bh - d <- get bh - e <- get bh - f <- get bh - g <- get bh - return (a,b,c,d,e,f,g) - -instance Binary a => Binary (Maybe a) where - put_ bh Nothing = putByte bh 0 - put_ bh (Just a) = do putByte bh 1; put_ bh a - get bh = do h <- getWord8 bh - case h of - 0 -> return Nothing - _ -> do x <- get bh; return (Just x) - -instance (Binary a, Binary b) => Binary (Either a b) where - put_ bh (Left a) = do putByte bh 0; put_ bh a - put_ bh (Right b) = do putByte bh 1; put_ bh b - get bh = do h <- getWord8 bh - case h of - 0 -> do a <- get bh ; return (Left a) - _ -> do b <- get bh ; return (Right b) - -instance Binary Integer where - put_ bh (S# i#) = do putByte bh 0; put_ bh (I# i#) - put_ bh (J# s# a#) = do - p <- putByte bh 1; - put_ bh (I# s#) - let sz# = sizeofByteArray# a# -- in *bytes* - put_ bh (I# sz#) -- in *bytes* - putByteArray bh a# sz# - - get bh = do - b <- getByte bh - case b of - 0 -> do (I# i#) <- get bh - return (S# i#) - _ -> do (I# s#) <- get bh - sz <- get bh - (BA a#) <- getByteArray bh sz - return (J# s# a#) - -putByteArray :: BinHandle -> ByteArray# -> Int# -> IO () -putByteArray bh a s# = loop 0# - where loop n# - | n# ==# s# = return () - | otherwise = do - putByte bh (indexByteArray a n#) - loop (n# +# 1#) - -getByteArray :: BinHandle -> Int -> IO ByteArray -getByteArray bh (I# sz) = do - (MBA arr) <- newByteArray sz - let loop n - | n ==# sz = return () - | otherwise = do - w <- getByte bh - writeByteArray arr n w - loop (n +# 1#) - loop 0# - freezeByteArray arr - - -data ByteArray = BA ByteArray# -data MBA = MBA (MutableByteArray# RealWorld) - -newByteArray :: Int# -> IO MBA -newByteArray sz = IO $ \s0 -> - case newByteArray# sz s0 of { (# s, arr #) -> - (# s, MBA arr #) } - -freezeByteArray :: MutableByteArray# RealWorld -> IO ByteArray -freezeByteArray arr0 = IO $ \s0 -> - case unsafeFreezeByteArray# arr0 s0 of { (# s, arr #) -> - (# s, BA arr #) } - -writeByteArray :: MutableByteArray# RealWorld -> Int# -> Word8 -> IO () - -writeByteArray arr i w8 = IO $ \s0 -> - case fromIntegral w8 of { W# w# -> - case writeCharArray# arr i (chr# (word2Int# w#)) s0 of { s -> - (# s , () #) }} - -indexByteArray :: ByteArray# -> Int# -> Word8 -indexByteArray a# n# = fromIntegral (I# (ord# (indexCharArray# a# n#))) - -instance (Integral a, Binary a) => Binary (Ratio a) where - put_ bh (a :% b) = do put_ bh a; put_ bh b - get bh = do a <- get bh; b <- get bh; return (a :% b) - -instance Binary (Bin a) where - put_ bh (BinPtr i) = put_ bh i - get bh = do i <- get bh; return (BinPtr i) - --- ----------------------------------------------------------------------------- --- Strings - --- should put a string in UTF-8 (just throws away top 24 bits at the moment) -putString :: BinHandle -> String -> IO () -putString bh str = put_ bh word8s - where - word8s :: [Word8] - word8s = map (fromIntegral.ord) str - -getString :: BinHandle -> IO String -getString bh = do - word8s <- get bh - return (map (chr.fromIntegral) (word8s :: [Word8])) - --- ----------------------------------------------------------------------------- --- Lazy reading/writing - -lazyPut :: Binary a => BinHandle -> a -> IO () -lazyPut bh a = do - -- output the obj with a ptr to skip over it: - pre_a <- tellBin bh - put_ bh pre_a -- save a slot for the ptr - put_ bh a -- dump the object - q <- tellBin bh -- q = ptr to after object - putAt bh pre_a q -- fill in slot before a with ptr to q - seekBin bh q -- finally carry on writing at q - -lazyGet :: Binary a => BinHandle -> IO a -lazyGet bh = do - p <- get bh -- a BinPtr - p_a <- tellBin bh - a <- unsafeInterleaveIO (getAt bh p_a) - seekBin bh p -- skip over the object for now - return a - --- ----------------------------------------------------------------------------- --- FormatVersion's. --- The FormatVersion is always non-negative. Furthermore, if the --- FormatVersion is 0, nothing is output. --- --- FormatVersion should only be encoded before something we KNOW to have --- an encoding which never begins with a negative byte, such as a non-negative --- integer or a list. --- --- The advantage of this is that we can read a FormatVersion (which will --- be the nullFormatVersion) even when we didn't write one in the first --- place, such as from earlier versions of this program, just so long --- as we did at any rate write a list. - -newtype FormatVersion = FormatVersion Int deriving (Eq,Ord) - -nullFormatVersion :: FormatVersion -nullFormatVersion = mkFormatVersion 0 - -mkFormatVersion :: Int -> FormatVersion -mkFormatVersion i = FormatVersion i - -instance Binary FormatVersion where - put_ bh (FormatVersion i) = - case compare i 0 of - EQ -> return () - GT -> put_ bh (-i) - LT -> error ( - "Binary.hs: negative FormatVersion " ++ show i - ++ " is not allowed") - get bh = - do - w8 <- peekWord8 bh - if testBit w8 7 - then - do - i <- get bh - return (FormatVersion (-i)) - else - return nullFormatVersion diff --git a/src/BlockTable.hs b/src/BlockTable.hs deleted file mode 100644 --- a/src/BlockTable.hs +++ /dev/null @@ -1,180 +0,0 @@ ------------------------------------------------------------------------------ --- --- Module : Text.Html.BlockTable --- Copyright : (c) Andy Gill, and the Oregon Graduate Institute of --- Science and Technology, 1999-2001 --- License : BSD-style (see the file libraries/core/LICENSE) --- --- Maintainer : Andy Gill --- Stability : experimental --- Portability : portable --- --- $Id: BlockTable.hs,v 1.2 2002/07/24 09:42:18 simonmar Exp $ --- --- An Html combinator library --- ------------------------------------------------------------------------------ - -module BlockTable ( - --- Datatypes: - - BlockTable, -- abstract - --- Contruction Functions: - - single, - empty, - above, - beside, - --- Investigation Functions: - - getMatrix, - showsTable, - showTable, - - ) where - -import Prelude - -infixr 4 `beside` -infixr 3 `above` - --- These combinators can be used to build formated 2D tables. --- The specific target useage is for HTML table generation. - -{- - Examples of use: - - > table1 :: BlockTable String - > table1 = single "Hello" +-----+ - |Hello| - This is a 1x1 cell +-----+ - Note: single has type - - single :: a -> BlockTable a - - So the cells can contain anything. - - > table2 :: BlockTable String - > table2 = single "World" +-----+ - |World| - +-----+ - - - > table3 :: BlockTable String - > table3 = table1 %-% table2 +-----%-----+ - |Hello%World| - % is used to indicate +-----%-----+ - the join edge between - the two Tables. - - > table4 :: BlockTable String - > table4 = table3 %/% table2 +-----+-----+ - |Hello|World| - Notice the padding on the %%%%%%%%%%%%% - smaller (bottom) cell to |World | - force the table to be a +-----------+ - rectangle. - - > table5 :: BlockTable String - > table5 = table1 %-% table4 +-----%-----+-----+ - |Hello%Hello|World| - Notice the padding on the | %-----+-----+ - leftmost cell, again to | %World | - force the table to be a +-----%-----------+ - rectangle. - - Now the table can be rendered with processTable, for example: - Main> processTable table5 - [[("Hello",(1,2)), - ("Hello",(1,1)), - ("World",(1,1))], - [("World",(2,1))]] :: [[([Char],(Int,Int))]] - Main> --} - --- --------------------------------------------------------------------------- --- Contruction Functions - --- Perhaps one day I'll write the Show instance --- to show boxes aka the above ascii renditions. - -instance (Show a) => Show (BlockTable a) where - showsPrec _ = showsTable - -type TableI a = [[(a,(Int,Int))]] -> [[(a,(Int,Int))]] - -data BlockTable a = Table (Int -> Int -> TableI a) Int Int - - --- You can create a (1x1) table entry - -single :: a -> BlockTable a -single a = Table (\ x y r -> [(a,(x+1,y+1))] : r) 1 1 - -empty :: BlockTable a -empty = Table (\ _ _ r -> r) 0 0 - - --- You can compose tables, horizonally and vertically - -above :: BlockTable a -> BlockTable a -> BlockTable a -beside :: BlockTable a -> BlockTable a -> BlockTable a - -t1 `above` t2 = trans (combine (trans t1) (trans t2) (.)) - -t1 `beside` t2 = combine t1 t2 (\ lst1 lst2 r -> - let - -- Note this depends on the fact that - -- that the result has the same number - -- of lines as the y dimention; one list - -- per line. This is not true in general - -- but is always true for these combinators. - -- I should assert this! - -- I should even prove this. - beside' (x:xs) (y:ys) = (x ++ y) : beside' xs ys - beside' (x:xs) [] = x : xs ++ r - beside' [] (y:ys) = y : ys ++ r - beside' [] [] = r - in - beside' (lst1 []) (lst2 [])) - --- trans flips (transposes) over the x and y axis of --- the table. It is only used internally, and typically --- in pairs, ie. (flip ... munge ... (un)flip). - -trans :: BlockTable a -> BlockTable a -trans (Table f1 x1 y1) = Table (flip f1) y1 x1 - -combine :: BlockTable a - -> BlockTable b - -> (TableI a -> TableI b -> TableI c) - -> BlockTable c -combine (Table f1 x1 y1) (Table f2 x2 y2) comb = Table new_fn (x1+x2) max_y - where - max_y = max y1 y2 - new_fn x y = - case compare y1 y2 of - EQ -> comb (f1 0 y) (f2 x y) - GT -> comb (f1 0 y) (f2 x (y + y1 - y2)) - LT -> comb (f1 0 (y + y2 - y1)) (f2 x y) - --- --------------------------------------------------------------------------- --- Investigation Functions - --- This is the other thing you can do with a Table; --- turn it into a 2D list, tagged with the (x,y) --- sizes of each cell in the table. - -getMatrix :: BlockTable a -> [[(a,(Int,Int))]] -getMatrix (Table r _ _) = r 0 0 [] - --- You can also look at a table - -showsTable :: (Show a) => BlockTable a -> ShowS -showsTable table = shows (getMatrix table) - -showTable :: (Show a) => BlockTable a -> String -showTable table = showsTable table "" diff --git a/src/Digraph.lhs b/src/Digraph.lhs deleted file mode 100644 --- a/src/Digraph.lhs +++ /dev/null @@ -1,419 +0,0 @@ --- --- Taken from ghc/compiler/utils/Digraph.lhs v1.15 --- (c) The University of Glasgow, 2002 --- - -\begin{code} -{-# OPTIONS -cpp #-} -module Digraph( - - -- At present the only one with a "nice" external interface - stronglyConnComp, stronglyConnCompR, SCC(..), flattenSCC, flattenSCCs, - - Graph, Vertex, - graphFromEdges, buildG, transposeG, reverseE, outdegree, indegree, - - Tree(..), Forest, - showTree, showForest, - - dfs, dff, - topSort, - components, - scc, - back, cross, forward, - reachable, path, - bcc - - ) where - ------------------------------------------------------------------------------- --- A version of the graph algorithms described in: --- --- ``Lazy Depth-First Search and Linear Graph Algorithms in Haskell'' --- by David King and John Launchbury --- --- Also included is some additional code for printing tree structures ... ------------------------------------------------------------------------------- - - -#define ARR_ELT (COMMA) - --- Extensions -#if __GLASGOW_HASKELL__ < 503 -import ST -#else -import Control.Monad.ST -import Data.Array.ST -#if __GLASGOW_HASKELL__ <= 604 - hiding (indices,bounds) -#endif -#endif - --- std interfaces -import Maybe -import Array -import List -\end{code} - - -%************************************************************************ -%* * -%* External interface -%* * -%************************************************************************ - -\begin{code} -data SCC vertex = AcyclicSCC vertex - | CyclicSCC [vertex] - -flattenSCCs :: [SCC a] -> [a] -flattenSCCs = concatMap flattenSCC - -flattenSCC :: SCC vertex -> [vertex] -flattenSCC (AcyclicSCC v) = [v] -flattenSCC (CyclicSCC vs) = vs -\end{code} - -\begin{code} -stronglyConnComp - :: Ord key - => [(node, key, [key])] -- The graph; its ok for the - -- out-list to contain keys which arent - -- a vertex key, they are ignored - -> [SCC node] - -stronglyConnComp edges0 - = map get_node (stronglyConnCompR edges0) - where - get_node (AcyclicSCC (n, _, _)) = AcyclicSCC n - get_node (CyclicSCC triples) = CyclicSCC [n | (n,_,_) <- triples] - --- The "R" interface is used when you expect to apply SCC to --- the (some of) the result of SCC, so you dont want to lose the dependency info -stronglyConnCompR - :: Ord key - => [(node, key, [key])] -- The graph; its ok for the - -- out-list to contain keys which arent - -- a vertex key, they are ignored - -> [SCC (node, key, [key])] - -stronglyConnCompR [] = [] -- added to avoid creating empty array in graphFromEdges -- SOF -stronglyConnCompR edges0 - = map decode forest - where - (graph, vertex_fn) = graphFromEdges edges0 - forest = scc graph - decode (Node v []) | mentions_itself v = CyclicSCC [vertex_fn v] - | otherwise = AcyclicSCC (vertex_fn v) - decode other = CyclicSCC (dec other []) - where - dec (Node v ts) vs = vertex_fn v : foldr dec vs ts - mentions_itself v = v `elem` (graph ! v) -\end{code} - -%************************************************************************ -%* * -%* Graphs -%* * -%************************************************************************ - - -\begin{code} -type Vertex = Int -type Table a = Array Vertex a -type Graph = Table [Vertex] -type Bounds = (Vertex, Vertex) -type Edge = (Vertex, Vertex) -\end{code} - -\begin{code} -vertices :: Graph -> [Vertex] -vertices = indices - -edges :: Graph -> [Edge] -edges g = [ (v, w) | v <- vertices g, w <- g!v ] - -mapT :: (Vertex -> a -> b) -> Table a -> Table b -mapT f t = array (bounds t) [ (,) v (f v (t!v)) | v <- indices t ] - -buildG :: Bounds -> [Edge] -> Graph -buildG bounds0 edges0 = accumArray (flip (:)) [] bounds0 edges0 - -transposeG :: Graph -> Graph -transposeG g = buildG (bounds g) (reverseE g) - -reverseE :: Graph -> [Edge] -reverseE g = [ (w, v) | (v, w) <- edges g ] - -outdegree :: Graph -> Table Int -outdegree = mapT numEdges - where numEdges _ ws = length ws - -indegree :: Graph -> Table Int -indegree = outdegree . transposeG -\end{code} - - -\begin{code} -graphFromEdges - :: Ord key - => [(node, key, [key])] - -> (Graph, Vertex -> (node, key, [key])) -graphFromEdges edges0 - = (graph, \v -> vertex_map ! v) - where - max_v = length edges0 - 1 - bounds0 = (0,max_v) :: (Vertex, Vertex) - sorted_edges = sortBy lt edges0 - edges1 = zipWith (,) [0..] sorted_edges - - graph = array bounds0 [(,) v (mapMaybe key_vertex ks) | (,) v (_, _, ks) <- edges1] - key_map = array bounds0 [(,) v k | (,) v (_, k, _ ) <- edges1] - vertex_map = array bounds0 edges1 - - (_,k1,_) `lt` (_,k2,_) = k1 `compare` k2 - - -- key_vertex :: key -> Maybe Vertex - -- returns Nothing for non-interesting vertices - key_vertex k = findVertex 0 max_v - where - findVertex a b | a > b - = Nothing - findVertex a b = case compare k (key_map ! mid) of - LT -> findVertex a (mid-1) - EQ -> Just mid - GT -> findVertex (mid+1) b - where - mid = (a + b) `div` 2 -\end{code} - -%************************************************************************ -%* * -%* Trees and forests -%* * -%************************************************************************ - -\begin{code} -data Tree a = Node a (Forest a) -type Forest a = [Tree a] - -mapTree :: (a -> b) -> (Tree a -> Tree b) -mapTree f (Node x ts) = Node (f x) (map (mapTree f) ts) -\end{code} - -\begin{code} -instance Show a => Show (Tree a) where - showsPrec _ t s = showTree t ++ s - -showTree :: Show a => Tree a -> String -showTree = drawTree . mapTree show - -showForest :: Show a => Forest a -> String -showForest = unlines . map showTree - -drawTree :: Tree String -> String -drawTree = unlines . draw - -draw :: Tree String -> [String] -draw (Node x ts0) = grp this (space (length this)) (stLoop ts0) - where this = s1 ++ x ++ " " - - space n = replicate n ' ' - - stLoop [] = [""] - stLoop [t] = grp s2 " " (draw t) - stLoop (t:ts) = grp s3 s4 (draw t) ++ [s4] ++ rsLoop ts - - rsLoop [] = error "rsLoop:Unexpected empty list." - rsLoop [t] = grp s5 " " (draw t) - rsLoop (t:ts) = grp s6 s4 (draw t) ++ [s4] ++ rsLoop ts - - grp fst0 rst = zipWith (++) (fst0:repeat rst) - - [s1,s2,s3,s4,s5,s6] = ["- ", "--", "-+", " |", " `", " +"] -\end{code} - - -%************************************************************************ -%* * -%* Depth first search -%* * -%************************************************************************ - -\begin{code} -#if __GLASGOW_HASKELL__ >= 504 -newSTArray :: Ix i => (i,i) -> e -> ST s (STArray s i e) -newSTArray = newArray - -readSTArray :: Ix i => STArray s i e -> i -> ST s e -readSTArray = readArray - -writeSTArray :: Ix i => STArray s i e -> i -> e -> ST s () -writeSTArray = writeArray -#endif - -type Set s = STArray s Vertex Bool - -mkEmpty :: Bounds -> ST s (Set s) -mkEmpty bnds = newSTArray bnds False - -contains :: Set s -> Vertex -> ST s Bool -contains m v = readSTArray m v - -include :: Set s -> Vertex -> ST s () -include m v = writeSTArray m v True -\end{code} - -\begin{code} -dff :: Graph -> Forest Vertex -dff g = dfs g (vertices g) - -dfs :: Graph -> [Vertex] -> Forest Vertex -dfs g vs = prune (bounds g) (map (generate g) vs) - -generate :: Graph -> Vertex -> Tree Vertex -generate g v = Node v (map (generate g) (g!v)) - -prune :: Bounds -> Forest Vertex -> Forest Vertex -prune bnds ts = runST (mkEmpty bnds >>= \m -> - chop m ts) - -chop :: Set s -> Forest Vertex -> ST s (Forest Vertex) -chop _ [] = return [] -chop m (Node v ts : us) - = contains m v >>= \visited -> - if visited then - chop m us - else - include m v >>= \_ -> - chop m ts >>= \as -> - chop m us >>= \bs -> - return (Node v as : bs) -\end{code} - - -%************************************************************************ -%* * -%* Algorithms -%* * -%************************************************************************ - ------------------------------------------------------------- --- Algorithm 1: depth first search numbering ------------------------------------------------------------- - -\begin{code} -preorder :: Tree a -> [a] -preorder (Node a ts) = a : preorderF ts - -preorderF :: Forest a -> [a] -preorderF ts = concat (map preorder ts) - -tabulate :: Bounds -> [Vertex] -> Table Int -tabulate bnds vs = array bnds (zipWith (,) vs [1..]) - -preArr :: Bounds -> Forest Vertex -> Table Int -preArr bnds = tabulate bnds . preorderF -\end{code} - - ------------------------------------------------------------- --- Algorithm 2: topological sorting ------------------------------------------------------------- - -\begin{code} -postorder :: Tree a -> [a] -postorder (Node a ts) = postorderF ts ++ [a] - -postorderF :: Forest a -> [a] -postorderF ts = concat (map postorder ts) - -postOrd :: Graph -> [Vertex] -postOrd = postorderF . dff - -topSort :: Graph -> [Vertex] -topSort = reverse . postOrd -\end{code} - - ------------------------------------------------------------- --- Algorithm 3: connected components ------------------------------------------------------------- - -\begin{code} -components :: Graph -> Forest Vertex -components = dff . undirected - -undirected :: Graph -> Graph -undirected g = buildG (bounds g) (edges g ++ reverseE g) -\end{code} - - --- Algorithm 4: strongly connected components - -\begin{code} -scc :: Graph -> Forest Vertex -scc g = dfs g (reverse (postOrd (transposeG g))) -\end{code} - - ------------------------------------------------------------- --- Algorithm 5: Classifying edges ------------------------------------------------------------- - -\begin{code} -back :: Graph -> Table Int -> Graph -back g post = mapT select g - where select v ws = [ w | w <- ws, post!v < post!w ] - -cross :: Graph -> Table Int -> Table Int -> Graph -cross g pre post = mapT select g - where select v ws = [ w | w <- ws, post!v > post!w, pre!v > pre!w ] - -forward :: Graph -> Graph -> Table Int -> Graph -forward g tree pre = mapT select g - where select v ws = [ w | w <- ws, pre!v < pre!w ] \\ tree!v -\end{code} - - ------------------------------------------------------------- --- Algorithm 6: Finding reachable vertices ------------------------------------------------------------- - -\begin{code} -reachable :: Graph -> Vertex -> [Vertex] -reachable g v = preorderF (dfs g [v]) - -path :: Graph -> Vertex -> Vertex -> Bool -path g v w = w `elem` (reachable g v) -\end{code} - - ------------------------------------------------------------- --- Algorithm 7: Biconnected components ------------------------------------------------------------- - -\begin{code} -bcc :: Graph -> Forest [Vertex] -bcc g = (concat . map bicomps . map (do_label g dnum)) forest - where forest = dff g - dnum = preArr (bounds g) forest - -do_label :: Graph -> Table Int -> Tree Vertex -> Tree (Vertex,Int,Int) -do_label g dnum (Node v ts) = Node (v,dnum!v,lv) us - where us = map (do_label g dnum) ts - lv = minimum ([dnum!v] ++ [dnum!w | w <- g!v] - ++ [lu | Node (u,du,lu) xs <- us]) - -bicomps :: Tree (Vertex,Int,Int) -> Forest [Vertex] -bicomps (Node (v,_,_) ts) - = [ Node (v:vs) us | (l,Node vs us) <- map collect ts] - -collect :: Tree (Vertex,Int,Int) -> (Int, Tree [Vertex]) -collect (Node (v,dv,lv) ts) = (lv, Node (v:vs) cs) - where collected = map collect ts - vs = concat [ ws | (lw, Node ws us) <- collected, lw - case newByteArray# size s0 of { (# s, arr #) -> - (# s, FastMutInt arr #) } - where I# size = SIZEOF_HSINT - -readFastMutInt :: FastMutInt -> IO Int -readFastMutInt (FastMutInt arr) = IO $ \s0 -> - case readIntArray# arr 0# s0 of { (# s, i #) -> - (# s, I# i #) } - -writeFastMutInt :: FastMutInt -> Int -> IO () -writeFastMutInt (FastMutInt arr) (I# i) = IO $ \s0 -> - case writeIntArray# arr 0# i s0 of { s -> - (# s, () #) } - -incFastMutInt :: FastMutInt -> IO Int -- Returns original value -incFastMutInt (FastMutInt arr) = IO $ \s0 -> - case readIntArray# arr 0# s0 of { (# s1, i #) -> - case writeIntArray# arr 0# (i +# 1#) s1 of { s -> - (# s, I# i #) } } - -incFastMutIntBy :: FastMutInt -> Int -> IO Int -- Returns original value -incFastMutIntBy (FastMutInt arr) (I# n) = IO $ \s0 -> - case readIntArray# arr 0# s0 of { (# s1, i #) -> - case writeIntArray# arr 0# (i +# n) s1 of { s -> - (# s, I# i #) } } -#endif - diff --git a/src/Haddock/Backends/DevHelp.hs b/src/Haddock/Backends/DevHelp.hs new file mode 100644 --- /dev/null +++ b/src/Haddock/Backends/DevHelp.hs @@ -0,0 +1,81 @@ +-- +-- Haddock - A Haskell Documentation Tool +-- +-- (c) Simon Marlow 2003 +-- + +module Haddock.Backends.DevHelp (ppDevHelpFile) where + +import Haddock.ModuleTree +import Haddock.Types +import Haddock.Utils + +import Module ( moduleName, moduleNameString, Module, mkModule, mkModuleName ) +import PackageConfig ( stringToPackageId ) +import Name ( Name, nameModule, getOccString ) + +import Data.Maybe ( fromMaybe ) +import qualified Data.Map as Map +import Text.PrettyPrint + +ppDevHelpFile :: FilePath -> String -> Maybe String -> [Interface] -> IO () +ppDevHelpFile odir doctitle maybe_package modules = do + let devHelpFile = package++".devhelp" + tree = mkModuleTree True [ (ifaceMod mod, toDescription mod) | mod <- modules ] + doc = + text "" $$ + (text "text doctitle<> + text "\" link=\""<>text contentsHtmlFile<>text"\" author=\"\" name=\""<>text package<>text "\">") $$ + text "" $$ + nest 4 (ppModuleTree [] tree) $+$ + text "" $$ + text "" $$ + nest 4 (ppList index) $+$ + text "" $$ + text "" + writeFile (pathJoin [odir, devHelpFile]) (render doc) + where + package = fromMaybe "pkg" maybe_package + + ppModuleTree :: [String] -> [ModuleTree] -> Doc + ppModuleTree ss [x] = ppNode ss x + ppModuleTree ss (x:xs) = ppNode ss x $$ ppModuleTree ss xs + ppModuleTree _ [] = error "HaddockHH.ppHHContents.fn: no module trees given" + + ppNode :: [String] -> ModuleTree -> Doc + ppNode ss (Node s leaf _ _short ts) = + case ts of + [] -> text "ppAttribs<>text "/>" + ts -> + text "ppAttribs<>text ">" $$ + nest 4 (ppModuleTree (s:ss) ts) $+$ + text "" + where + ppLink | leaf = text (moduleHtmlFile (mkModule (stringToPackageId "") + (mkModuleName mdl))) + | otherwise = empty + + ppAttribs = text "name="<>doubleQuotes (text s)<+>text "link="<>doubleQuotes ppLink + + mdl = foldr (++) "" (s' : map ('.':) ss') + (s':ss') = reverse (s:ss) + -- reconstruct the module name + + index :: [(Name, [Module])] + index = Map.toAscList (foldr getModuleIndex Map.empty modules) + + getModuleIndex iface fm = + Map.unionWith (++) (Map.fromListWith (flip (++)) [(name, [mod]) | name <- ifaceExports iface, nameModule name == mod]) fm + where mod = ifaceMod iface + + ppList :: [(Name, [Module])] -> Doc + ppList [] = empty + ppList ((name,refs):mdls) = + ppReference name refs $$ + ppList mdls + + ppReference :: Name -> [Module] -> Doc + ppReference name [] = empty + ppReference name (mod:refs) = + text "text (escapeStr (getOccString name))<>text"\" link=\""<>text (nameHtmlRef mod name)<>text"\"/>" $$ + ppReference name refs diff --git a/src/Haddock/Backends/HH.hs b/src/Haddock/Backends/HH.hs new file mode 100644 --- /dev/null +++ b/src/Haddock/Backends/HH.hs @@ -0,0 +1,180 @@ +-- +-- Haddock - A Haskell Documentation Tool +-- +-- (c) Simon Marlow 2003 +-- + +module Haddock.Backends.HH (ppHHContents, ppHHIndex, ppHHProject) where + +ppHHContents = error "not yet" +ppHHIndex = error "not yet" +ppHHProject = error "not yet" + +{- +import HaddockModuleTree +import HaddockTypes +import HaddockUtil +import HsSyn2 hiding(Doc) +import qualified Map + +import Data.Char ( toUpper ) +import Data.Maybe ( fromMaybe ) +import Text.PrettyPrint + +ppHHContents :: FilePath -> String -> Maybe String -> [ModuleTree] -> IO () +ppHHContents odir doctitle maybe_package tree = do + let contentsHHFile = package++".hhc" + + html = + text "" $$ + text "" $$ + text "" $$ + text "" $$ + text "" $$ + text "" $$ + ppModuleTree tree $$ + text "" + writeFile (pathJoin [odir, contentsHHFile]) (render html) + where + package = fromMaybe "pkg" maybe_package + + ppModuleTree :: [ModuleTree] -> Doc + ppModuleTree ts = + text "" $$ + text "" $$ + text "" $$ + text "
    " $+$ + nest 4 (text "
  • " <> nest 4 + (text "" $$ + nest 4 (text "text doctitle<>text "\">" $$ + text "") $$ + text "") $+$ + text "
    • " $$ + text "
      " $+$ + nest 4 (fn [] ts) $+$ + text "
    ") $+$ + text "
" + + fn :: [String] -> [ModuleTree] -> Doc + fn ss [x] = ppNode ss x + fn ss (x:xs) = ppNode ss x $$ fn ss xs + fn _ [] = error "HaddockHH.ppHHContents.fn: no module trees given" + + ppNode :: [String] -> ModuleTree -> Doc + ppNode ss (Node s leaf _pkg _ []) = + ppLeaf s ss leaf + ppNode ss (Node s leaf _pkg _ ts) = + ppLeaf s ss leaf $$ + text "
    " $+$ + nest 4 (fn (s:ss) ts) $+$ + text "
" + + ppLeaf s ss isleaf = + text "
  • " <> nest 4 + (text "" $$ + text " text s <> text "\">" $$ + (if isleaf then text " text (moduleHtmlFile mdl) <> text "\">" else empty) $$ + text "") $+$ + text "
    • " + where + mdl = foldr (++) "" (s' : map ('.':) ss') + (s':ss') = reverse (s:ss) + -- reconstruct the module name + +------------------------------- +ppHHIndex :: FilePath -> Maybe String -> [Interface] -> IO () +ppHHIndex odir maybe_package ifaces = do + let indexHHFile = package++".hhk" + + html = + text "" $$ + text "" $$ + text "" $$ + text "" $$ + text "" $$ + text "" $$ + text "
      " $+$ + nest 4 (ppList index) $+$ + text "
    " $$ + text "" + writeFile (pathJoin [odir, indexHHFile]) (render html) + where + package = fromMaybe "pkg" maybe_package + + index :: [(HsName, [Module])] + index = Map.toAscList (foldr getIfaceIndex Map.empty ifaces) + + getIfaceIndex iface fm = + foldl (\m (k,e) -> Map.insertWith (++) k e m) fm [(name, [mdl]) | (name, Qual mdl' _) <- Map.toAscList (iface_env iface), mdl == mdl'] + where mdl = iface_module iface + + ppList [] = empty + ppList ((name,refs):mdls) = + text "
  • " <> nest 4 + (text "" $$ + text " text (show name) <> text "\">" $$ + ppReference name refs $$ + text "") $+$ + text "
    • " $$ + ppList mdls + + ppReference name [] = empty + ppReference name (Module mdl:refs) = + text " text (nameHtmlRef mdl name) <> text "\">" $$ + ppReference name refs + + +ppHHProject :: FilePath -> String -> Maybe String -> [Interface] -> [FilePath] -> IO () +ppHHProject odir doctitle maybe_package ifaces pkg_paths = do + let projectHHFile = package++".hhp" + doc = + text "[OPTIONS]" $$ + text "Compatibility=1.1 or later" $$ + text "Compiled file=" <> text package <> text ".chm" $$ + text "Contents file=" <> text package <> text ".hhc" $$ + text "Default topic=" <> text contentsHtmlFile $$ + text "Display compile progress=No" $$ + text "Index file=" <> text package <> text ".hhk" $$ + text "Title=" <> text doctitle $$ + space $$ + text "[FILES]" $$ + ppMods ifaces $$ + text contentsHtmlFile $$ + text indexHtmlFile $$ + ppIndexFiles chars $$ + ppLibFiles ("":pkg_paths) + writeFile (pathJoin [odir, projectHHFile]) (render doc) + where + package = fromMaybe "pkg" maybe_package + + ppMods [] = empty + ppMods (iface:ifaces) = + let Module mdl = iface_module iface in + text (moduleHtmlFile mdl) $$ + ppMods ifaces + + ppIndexFiles [] = empty + ppIndexFiles (c:cs) = + text (subIndexHtmlFile c) $$ + ppIndexFiles cs + + ppLibFiles [] = empty + ppLibFiles (path:paths) = + ppLibFile cssFile $$ + ppLibFile iconFile $$ + ppLibFile jsFile $$ + ppLibFile plusFile $$ + ppLibFile minusFile $$ + ppLibFiles paths + where + toPath fname | null path = fname + | otherwise = pathJoin [path, fname] + ppLibFile fname = text (toPath fname) + + chars :: [Char] + chars = map fst (Map.toAscList (foldr getIfaceIndex Map.empty ifaces)) + + getIfaceIndex iface fm = + Map.union (Map.fromList [(toUpper (head (show name)),()) | (name, Qual mdl' _) <- Map.toAscList (iface_env iface), mdl == mdl']) fm + where mdl = iface_module iface +-} diff --git a/src/Haddock/Backends/HH2.hs b/src/Haddock/Backends/HH2.hs new file mode 100644 --- /dev/null +++ b/src/Haddock/Backends/HH2.hs @@ -0,0 +1,190 @@ +-- +-- Haddock - A Haskell Documentation Tool +-- +-- (c) Simon Marlow 2003 +-- + + +module Haddock.Backends.HH2 (ppHH2Contents, ppHH2Index, ppHH2Files, ppHH2Collection) where + + +ppHH2Contents = error "not yet" +ppHH2Index = error "not yet" +ppHH2Files = error "not yet" +ppHH2Collection = error "not yet" + +{- +import HaddockModuleTree +import HaddockTypes +import HaddockUtil +import HsSyn2 hiding(Doc) +import qualified Map + +import Data.Char ( toUpper ) +import Data.Maybe ( fromMaybe ) +import Text.PrettyPrint + +ppHH2Contents :: FilePath -> String -> Maybe String -> [ModuleTree] -> IO () +ppHH2Contents odir doctitle maybe_package tree = do + let + contentsHH2File = package++".HxT" + + doc = + text "" $$ + text "" $$ + text "" $$ + nest 4 (text "text doctitle<>text"\" Url=\"index.html\">" $$ + nest 4 (ppModuleTree [] tree) $+$ + text "") $$ + text "" + writeFile (pathJoin [odir, contentsHH2File]) (render doc) + where + package = fromMaybe "pkg" maybe_package + + ppModuleTree :: [String] -> [ModuleTree] -> Doc + ppModuleTree ss [x] = ppNode ss x + ppModuleTree ss (x:xs) = ppNode ss x $$ ppModuleTree ss xs + ppModuleTree _ [] = error "HaddockHH2.ppHH2Contents.ppModuleTree: no module trees given" + + ppNode :: [String] -> ModuleTree -> Doc + ppNode ss (Node s leaf _pkg _short []) = + text " ppAttributes leaf (s:ss) <> text "/>" + ppNode ss (Node s leaf _pkg _short ts) = + text " ppAttributes leaf (s:ss) <> text ">" $$ + nest 4 (ppModuleTree (s:ss) ts) $+$ + text "" + + ppAttributes :: Bool -> [String] -> Doc + ppAttributes isleaf ss = hsep [ppId,ppTitle,ppUrl] + where + mdl = foldr (++) "" (s' : map ('.':) ss') + (s':ss') = reverse ss + -- reconstruct the module name + + ppId = text "Id=" <> doubleQuotes (text mdl) + + ppTitle = text "Title=" <> doubleQuotes (text (head ss)) + + ppUrl | isleaf = text " Url=" <> doubleQuotes (text (moduleHtmlFile mdl)) + | otherwise = empty + +----------------------------------------------------------------------------------- + +ppHH2Index :: FilePath -> Maybe String -> [Interface] -> IO () +ppHH2Index odir maybe_package ifaces = do + let + indexKHH2File = package++"K.HxK" + indexNHH2File = package++"N.HxK" + docK = + text "" $$ + text "" $$ + text "" $$ + nest 4 (ppList index) $+$ + text "" + docN = + text "" $$ + text "" $$ + text "" $$ + text "" $$ + nest 4 (text "text contentsHtmlFile<>text "\"/>") $$ + text "" $$ + text "" + writeFile (pathJoin [odir, indexKHH2File]) (render docK) + writeFile (pathJoin [odir, indexNHH2File]) (render docN) + where + package = fromMaybe "pkg" maybe_package + + index :: [(HsName, [Module])] + index = Map.toAscList (foldr getIfaceIndex Map.empty ifaces) + + getIfaceIndex iface fm = + Map.unionWith (++) (Map.fromListWith (flip (++)) [(name, [mdl]) | (name, Qual mdl' _) <- Map.toAscList (iface_env iface), mdl == mdl']) fm + where mdl = iface_module iface + + ppList [] = empty + ppList ((name,mdls):vs) = + text " text (escapeStr (show name)) <> text "\">" $$ + nest 4 (vcat (map (ppJump name) mdls)) $$ + text "" $$ + ppList vs + + ppJump name (Module mdl) = text " text (nameHtmlRef mdl name) <> text "\"/>" + + +----------------------------------------------------------------------------------- + +ppHH2Files :: FilePath -> Maybe String -> [Interface] -> [FilePath] -> IO () +ppHH2Files odir maybe_package ifaces pkg_paths = do + let filesHH2File = package++".HxF" + doc = + text "" $$ + text "" $$ + text "" $$ + nest 4 (ppMods ifaces $$ + text "text contentsHtmlFile<>text "\"/>" $$ + text "text indexHtmlFile<>text "\"/>" $$ + ppIndexFiles chars $$ + ppLibFiles ("":pkg_paths)) $$ + text "" + writeFile (pathJoin [odir, filesHH2File]) (render doc) + where + package = fromMaybe "pkg" maybe_package + + ppMods [] = empty + ppMods (iface:ifaces) = + text " text (moduleHtmlFile mdl) <> text "\"/>" $$ + ppMods ifaces + where Module mdl = iface_module iface + + ppIndexFiles [] = empty + ppIndexFiles (c:cs) = + text "text (subIndexHtmlFile c)<>text "\"/>" $$ + ppIndexFiles cs + + ppLibFiles [] = empty + ppLibFiles (path:paths) = + ppLibFile cssFile $$ + ppLibFile iconFile $$ + ppLibFile jsFile $$ + ppLibFile plusFile $$ + ppLibFile minusFile $$ + ppLibFiles paths + where + toPath fname | null path = fname + | otherwise = pathJoin [path, fname] + ppLibFile fname = text "text (toPath fname)<>text "\"/>" + + chars :: [Char] + chars = map fst (Map.toAscList (foldr getIfaceIndex Map.empty ifaces)) + + getIfaceIndex iface fm = + Map.union (Map.fromList [(toUpper (head (show name)),()) | (name, Qual mdl' _) <- Map.toAscList (iface_env iface), mdl == mdl']) fm + where mdl = iface_module iface + +----------------------------------------------------------------------------------- + +ppHH2Collection :: FilePath -> String -> Maybe String -> IO () +ppHH2Collection odir doctitle maybe_package = do + let + package = fromMaybe "pkg" maybe_package + collectionHH2File = package++".HxC" + + doc = + text "" $$ + text "" $$ + text " text doctitle <> text "\">" $$ + nest 4 (text "" $$ + nest 4 (text " text package <> text ".HxF\"/>") $$ + text "" $$ + text " text package <> text ".HxT\"/>" $$ + text " text package <> text "K.HxK\"/>" $$ + text " text package <> text "N.HxK\"/>" $$ + text "" $$ + text "" $$ + text "" $$ + text "" $$ + text "" $$ + text "") $$ + text "" + writeFile (pathJoin [odir, collectionHH2File]) (render doc) +-} diff --git a/src/Haddock/Backends/HaddockDB.hs b/src/Haddock/Backends/HaddockDB.hs new file mode 100644 --- /dev/null +++ b/src/Haddock/Backends/HaddockDB.hs @@ -0,0 +1,165 @@ +-- +-- Haddock - A Haskell Documentation Tool +-- +-- (c) Simon Marlow 2003 +-- + +module Haddock.Backends.HaddockDB (ppDocBook) where + +{- +import HaddockTypes +import HaddockUtil +import HsSyn2 + +import Text.PrettyPrint +-} + +----------------------------------------------------------------------------- +-- Printing the results in DocBook format + +ppDocBook = error "not working" +{- +ppDocBook :: FilePath -> [(Module, Interface)] -> String +ppDocBook odir mods = render (ppIfaces mods) + +ppIfaces mods + = text "" + $$ text "" + $$ text "" + $$ text "HaskellDoc version 0.0" + $$ text "" + $$ text "
    " + $$ vcat (map do_mod mods) + $$ text "
    " + where + do_mod (Module mod, iface) + = text " text mod <> text "\">" + $$ text "<literal>" + <> text mod + <> text "</literal>" + $$ text "" + <> text mod + <> text "" + $$ text "" + $$ vcat (map (do_export mod) (eltsFM (iface_decls iface))) + $$ text "" + $$ text "" + + do_export mod decl | (nm:_) <- declBinders decl + = text "" + <> do_decl decl + <> text "" + $$ text "" + $$ text "" + $$ text "" + $$ text "" + $$ text "" + do_export _ _ = empty + + do_decl (HsTypeSig _ [nm] ty _) + = ppHsName nm <> text " :: " <> ppHsType ty + do_decl (HsTypeDecl _ nm args ty _) + = hsep ([text "type", ppHsName nm ] + ++ map ppHsName args + ++ [equals, ppHsType ty]) + do_decl (HsNewTypeDecl loc ctx nm args con drv _) + = hsep ([text "data", ppHsName nm] -- data, not newtype + ++ map ppHsName args + ) <+> equals <+> ppHsConstr con -- ToDo: derivings + do_decl (HsDataDecl loc ctx nm args cons drv _) + = hsep ([text "data", {-ToDo: context-}ppHsName nm] + ++ map ppHsName args) + <+> vcat (zipWith (<+>) (equals : repeat (char '|')) + (map ppHsConstr cons)) + do_decl (HsClassDecl loc ty fds decl _) + = hsep [text "class", ppHsType ty] + do_decl decl + = empty + +ppHsConstr :: HsConDecl -> Doc +ppHsConstr (HsRecDecl pos name tvs ctxt fieldList maybe_doc) = + ppHsName name + <> (braces . hsep . punctuate comma . map ppField $ fieldList) +ppHsConstr (HsConDecl pos name tvs ctxt typeList maybe_doc) = + hsep (ppHsName name : map ppHsBangType typeList) + +ppField (HsFieldDecl ns ty doc) + = hsep (punctuate comma (map ppHsName ns) ++ + [text "::", ppHsBangType ty]) + +ppHsBangType :: HsBangType -> Doc +ppHsBangType (HsBangedTy ty) = char '!' <> ppHsType ty +ppHsBangType (HsUnBangedTy ty) = ppHsType ty + +ppHsContext :: HsContext -> Doc +ppHsContext [] = empty +ppHsContext context = parenList (map (\ (a,b) -> ppHsQName a <+> + hsep (map ppHsAType b)) context) + +ppHsType :: HsType -> Doc +ppHsType (HsForAllType Nothing context htype) = + hsep [ ppHsContext context, text "=>", ppHsType htype] +ppHsType (HsForAllType (Just tvs) [] htype) = + hsep (text "forall" : map ppHsName tvs ++ text "." : [ppHsType htype]) +ppHsType (HsForAllType (Just tvs) context htype) = + hsep (text "forall" : map ppHsName tvs ++ text "." : + ppHsContext context : text "=>" : [ppHsType htype]) +ppHsType (HsTyFun a b) = fsep [ppHsBType a, text "->", ppHsType b] +ppHsType (HsTyIP n t) = fsep [(char '?' <> ppHsName n), text "::", ppHsType t] +ppHsType t = ppHsBType t + +ppHsBType (HsTyApp (HsTyCon (Qual (Module "Prelude") (HsTyClsName (HsSpecial "[]")))) b ) + = brackets $ ppHsType b +ppHsBType (HsTyApp a b) = fsep [ppHsBType a, ppHsAType b] +ppHsBType t = ppHsAType t + +ppHsAType :: HsType -> Doc +ppHsAType (HsTyTuple True l) = parenList . map ppHsType $ l +ppHsAType (HsTyTuple False l) = ubxParenList . map ppHsType $ l +-- special case +ppHsAType (HsTyApp (HsTyCon (Qual (Module "Prelude") (HsTyClsName (HsSpecial "[]")))) b ) + = brackets $ ppHsType b +ppHsAType (HsTyVar name) = ppHsName name +ppHsAType (HsTyCon name) = ppHsQName name +ppHsAType t = parens $ ppHsType t + +ppHsQName :: HsQName -> Doc +ppHsQName (UnQual str) = ppHsName str +ppHsQName n@(Qual (Module mod) str) + | n == unit_con_name = ppHsName str + | isSpecial str = ppHsName str + | otherwise + = text "" + +isSpecial (HsTyClsName id) | HsSpecial _ <- id = True +isSpecial (HsVarName id) | HsSpecial _ <- id = True +isSpecial _ = False + +ppHsName :: HsName -> Doc +ppHsName (HsTyClsName id) = ppHsIdentifier id +ppHsName (HsVarName id) = ppHsIdentifier id + +ppHsIdentifier :: HsIdentifier -> Doc +ppHsIdentifier (HsIdent str) = text str +ppHsIdentifier (HsSymbol str) = text str +ppHsIdentifier (HsSpecial str) = text str + +ppLinkId :: String -> HsName -> Doc +ppLinkId mod str + = hcat [char '\"', text mod, char '.', ppHsName str, char '\"'] + +-- ----------------------------------------------------------------------------- +-- * Misc + +parenList :: [Doc] -> Doc +parenList = parens . fsep . punctuate comma + +ubxParenList :: [Doc] -> Doc +ubxParenList = ubxparens . fsep . punctuate comma + +ubxparens p = text "(#" <> p <> text "#)" +-} diff --git a/src/Haddock/Backends/Hoogle.hs b/src/Haddock/Backends/Hoogle.hs new file mode 100644 --- /dev/null +++ b/src/Haddock/Backends/Hoogle.hs @@ -0,0 +1,184 @@ +-- +-- Haddock - A Haskell Documentation Tool +-- +-- (c) Simon Marlow 2003 +-- +-- This file, (c) Neil Mitchell 2006 +-- Write out Hoogle compatible documentation +-- http://www.haskell.org/hoogle/ + +module Haddock.Backends.Hoogle ( + ppHoogle + ) where + +ppHoogle = undefined + +{- +import HaddockTypes +import HaddockUtil +import HsSyn2 + +import Data.List ( intersperse ) + + + +prefix = ["-- Hoogle documentation, generated by Haddock", + "-- See Hoogle, http://www.haskell.org/hoogle/"] + +ppHoogle :: Maybe String -> [Interface] -> FilePath -> IO () +ppHoogle maybe_package ifaces odir = + do + let + filename = case maybe_package of + Just x -> x ++ ".txt" + Nothing -> "hoogle.txt" + + visible_ifaces = filter visible ifaces + visible i = OptHide `notElem` iface_options i + + contents = prefix : map ppModule visible_ifaces + + writeFile (pathJoin [odir, filename]) (unlines $ concat contents) + + + +-- --------------------------------------------------------------------------- +-- Generate the HTML page for a module + + +ppDecl :: HsDecl -> [String] +ppDecl (HsNewTypeDecl src context name args ctor unknown docs) = + ppData "newtype" context name args [ctor] + +ppDecl (HsDataDecl src context name args ctors unknown docs) = + ppData "data" context name args ctors + +ppDecl (HsTypeSig src names t doc) = map (`ppFunc` t) names + +ppDecl (HsForeignImport src _ _ _ name t doc) = ppDecl $ HsTypeSig src [name] t doc + +ppDecl (HsClassDecl src context name args fundeps members doc) = + ("class " ++ ppContext context ++ ppType typ) : concatMap f members + where + typ = foldl HsTyApp (HsTyCon $ UnQual name) (map HsTyVar args) + newcontext = (UnQual name, map HsTyVar args) + f (HsTypeSig src names t doc) = ppDecl (HsTypeSig src names (addContext newcontext t) doc) + f (HsFunBind{}) = [] + f (HsPatBind{}) = [] + f x = ["-- ERR " ++ show x] + +ppDecl (HsTypeDecl src name args t doc) = + ["type " ++ show name ++ concatMap (\x -> ' ':show x) args ++ " = " ++ ppType t] + +ppDecl x = ["-- ERR " ++ show x] + + + +addContext :: HsAsst -> HsType -> HsType +addContext ctx (HsForAllType Nothing context t) = HsForAllType Nothing (HsAssump ctx : context) t +addContext ctx x = HsForAllType Nothing [HsAssump ctx] x + + + +ppFunc :: HsName -> HsType -> String +ppFunc name typ = show name ++ " :: " ++ ppType typ + + +ppData :: String -> HsContext -> HsName -> [HsName] -> [HsConDecl] -> [String] +ppData mode context name args ctors = (mode ++ " " ++ ppType typ) : concatMap (ppCtor typ) ctors + where + typ = foldl HsTyApp (HsTyCon $ UnQual name) (map HsTyVar args) + + +deBang :: HsBangType -> HsType +deBang (HsBangedTy x) = x +deBang (HsUnBangedTy x) = x + + +ppCtor :: HsType -> HsConDecl -> [String] +ppCtor result (HsConDecl src name types context typ doc) = + [show name ++ " :: " ++ ppContext context ++ ppTypesArr (map deBang typ ++ [result])] + +ppCtor result (HsRecDecl src name types context fields doc) = + ppCtor result (HsConDecl src name types context (map snd fields2) doc) ++ + concatMap f fields2 + where + fields2 = [(name, typ) | HsFieldDecl names typ _ <- fields, name <- names] + f (name, typ) = ppDecl $ HsTypeSig src [name] (HsTyFun result (deBang typ)) doc + + +brack True x = "(" ++ x ++ ")" +brack False x = x + +ppContext :: HsContext -> String +ppContext [] = "" +ppContext xs = brack (length xs > 1) (concat $ intersperse ", " $ map ppContextItem xs) ++ " => " + +ppContextItem :: HsAsst -> String +ppContextItem (name, types) = ppQName name ++ concatMap (\x -> ' ':ppType x) types + +ppContext2 :: HsIPContext -> String +ppContext2 xs = ppContext [x | HsAssump x <- xs] + + +ppType :: HsType -> String +ppType x = f 0 x + where + f _ (HsTyTuple _ xs) = brack True $ concat $ intersperse ", " $ map (f 0) xs + f _ (HsTyCon x) = ppQName x + f _ (HsTyVar x) = show x + + -- ignore ForAll types as Hoogle does not support them + f n (HsForAllType (Just items) context t) = + -- brack (n > 1) $ + -- "forall" ++ concatMap (\x -> ' ':toStr x) items ++ " . " ++ f 0 t + f n t + + f n (HsForAllType Nothing context t) = brack (n > 1) $ + ppContext2 context ++ f 0 t + + f n (HsTyFun a b) = brack g $ f (h 3) a ++ " -> " ++ f (h 2) b + where + g = n > 2 + h x = if g then 0 else x + + f n (HsTyApp a b) | ppType a == "[]" = "[" ++ f 0 b ++ "]" + + f n (HsTyApp a b) = brack g $ f (h 3) a ++ " " ++ f (h 4) b + where + g = n > 3 + h x = if g then 0 else x + + f n (HsTyDoc x _) = f n x + + f n x = brack True $ show x + + +ppQName :: HsQName -> String +ppQName (Qual _ name) = show name +ppQName (UnQual name) = show name + + + +ppTypesArr :: [HsType] -> String +ppTypesArr xs = ppType $ foldr1 HsTyFun xs + + + +ppInst :: InstHead -> String +ppInst (context, item) = "instance " ++ ppContext context ++ ppContextItem item + + + +ppModule :: Interface -> [String] +ppModule iface = "" : ("module " ++ mdl) : concatMap ppExport (iface_exports iface) + where + Module mdl = iface_module iface + + +ppExport :: ExportItem -> [String] +ppExport (ExportDecl name decl insts) = ppDecl decl ++ map ppInst insts +ppExport _ = [] + + +-} diff --git a/src/Haddock/Backends/Html.hs b/src/Haddock/Backends/Html.hs new file mode 100644 --- /dev/null +++ b/src/Haddock/Backends/Html.hs @@ -0,0 +1,1585 @@ +-- +-- Haddock - A Haskell Documentation Tool +-- +-- (c) Simon Marlow 2003 +-- + + +module Haddock.Backends.Html ( + ppHtml, copyHtmlBits, + ppHtmlIndex, ppHtmlContents, + ppHtmlHelpFiles +) where + + +import Prelude hiding (div) + +import Haddock.Backends.DevHelp +import Haddock.Backends.HH +import Haddock.Backends.HH2 +import Haddock.ModuleTree +import Haddock.Types +import Haddock.Version +import Haddock.Utils +import Haddock.Utils.Html +import Haddock.GHC.Utils +import qualified Haddock.Utils.Html as Html + +import Control.Exception ( bracket ) +import Control.Monad ( when, unless ) +import Data.Char ( isUpper, toUpper ) +import Data.List ( sortBy ) +import Data.Maybe ( fromJust, isJust, mapMaybe, fromMaybe ) +import Foreign.Marshal.Alloc ( allocaBytes ) +import System.IO ( IOMode(..), hClose, hGetBuf, hPutBuf, openFile ) +import Data.Map ( Map ) +import qualified Data.Map as Map hiding ( Map ) + +import GHC hiding ( NoLink ) +import Name +import Module +import PackageConfig ( stringToPackageId ) +import RdrName hiding ( Qual ) +import SrcLoc +import FastString ( unpackFS ) +import BasicTypes ( IPName(..), Boxity(..) ) +import Type ( Kind ) +import Outputable ( ppr, defaultUserStyle, showSDoc ) + +-- the base, module and entity URLs for the source code and wiki links. +type SourceURLs = (Maybe String, Maybe String, Maybe String) +type WikiURLs = (Maybe String, Maybe String, Maybe String) + +-- ----------------------------------------------------------------------------- +-- Generating HTML documentation + +ppHtml :: String + -> Maybe String -- package + -> [Interface] + -> FilePath -- destination directory + -> Maybe (GHC.HsDoc GHC.RdrName) -- prologue text, maybe + -> Maybe String -- the Html Help format (--html-help) + -> SourceURLs -- the source URL (--source) + -> WikiURLs -- the wiki URL (--wiki) + -> Maybe String -- the contents URL (--use-contents) + -> Maybe String -- the index URL (--use-index) + -> IO () + +ppHtml doctitle maybe_package ifaces odir prologue maybe_html_help_format + maybe_source_url maybe_wiki_url + maybe_contents_url maybe_index_url = do + let + visible_ifaces = filter visible ifaces + visible i = OptHide `notElem` ifaceOptions i + + when (not (isJust maybe_contents_url)) $ + ppHtmlContents odir doctitle maybe_package + maybe_html_help_format maybe_index_url maybe_source_url maybe_wiki_url + (map toInstalledIface visible_ifaces) + False -- we don't want to display the packages in a single-package contents + prologue + + when (not (isJust maybe_index_url)) $ + ppHtmlIndex odir doctitle maybe_package maybe_html_help_format + maybe_contents_url maybe_source_url maybe_wiki_url + (map toInstalledIface visible_ifaces) + + when (not (isJust maybe_contents_url && isJust maybe_index_url)) $ + ppHtmlHelpFiles doctitle maybe_package ifaces odir maybe_html_help_format [] + + mapM_ (ppHtmlModule odir doctitle + maybe_source_url maybe_wiki_url + maybe_contents_url maybe_index_url) visible_ifaces + +ppHtmlHelpFiles + :: String -- doctitle + -> Maybe String -- package + -> [Interface] + -> FilePath -- destination directory + -> Maybe String -- the Html Help format (--html-help) + -> [FilePath] -- external packages paths + -> IO () +ppHtmlHelpFiles doctitle maybe_package ifaces odir maybe_html_help_format pkg_paths = do + let + visible_ifaces = filter visible ifaces + visible i = OptHide `notElem` ifaceOptions i + + -- Generate index and contents page for Html Help if requested + case maybe_html_help_format of + Nothing -> return () + Just "mshelp" -> ppHHProject odir doctitle maybe_package visible_ifaces pkg_paths + Just "mshelp2" -> do + ppHH2Files odir maybe_package visible_ifaces pkg_paths + ppHH2Collection odir doctitle maybe_package + Just "devhelp" -> ppDevHelpFile odir doctitle maybe_package visible_ifaces + Just format -> fail ("The "++format++" format is not implemented") + +copyFile :: FilePath -> FilePath -> IO () +copyFile fromFPath toFPath = + (bracket (openFile fromFPath ReadMode) hClose $ \hFrom -> + bracket (openFile toFPath WriteMode) hClose $ \hTo -> + allocaBytes bufferSize $ \buffer -> + copyContents hFrom hTo buffer) + where + bufferSize = 1024 + + copyContents hFrom hTo buffer = do + count <- hGetBuf hFrom buffer bufferSize + when (count > 0) $ do + hPutBuf hTo buffer count + copyContents hFrom hTo buffer + + +copyHtmlBits :: FilePath -> FilePath -> Maybe FilePath -> IO () +copyHtmlBits odir libdir maybe_css = do + let + libhtmldir = pathJoin [libdir, "html"] + css_file = case maybe_css of + Nothing -> pathJoin [libhtmldir, cssFile] + Just f -> f + css_destination = pathJoin [odir, cssFile] + copyLibFile f = do + copyFile (pathJoin [libhtmldir, f]) (pathJoin [odir, f]) + copyFile css_file css_destination + mapM_ copyLibFile [ iconFile, plusFile, minusFile, jsFile ] + +footer :: HtmlTable +footer = + tda [theclass "botbar"] << + ( toHtml "Produced by" <+> + (anchor ! [href projectUrl] << toHtml projectName) <+> + toHtml ("version " ++ projectVersion) + ) + +srcButton :: SourceURLs -> Maybe Interface -> HtmlTable +srcButton (Just src_base_url, _, _) Nothing = + topButBox (anchor ! [href src_base_url] << toHtml "Source code") + +srcButton (_, Just src_module_url, _) (Just iface) = + let url = spliceURL (Just $ ifaceOrigFilename iface) + (Just $ ifaceMod iface) Nothing Nothing src_module_url + in topButBox (anchor ! [href url] << toHtml "Source code") + +srcButton _ _ = + Html.emptyTable + +spliceURL :: Maybe FilePath -> Maybe Module -> Maybe GHC.Name -> + Maybe SrcSpan -> String -> String +spliceURL maybe_file maybe_mod maybe_name maybe_loc url = run url + where + file = fromMaybe "" maybe_file + mod = case maybe_mod of + Nothing -> "" + Just mod -> moduleString mod + + (name, kind) = + case maybe_name of + Nothing -> ("","") + Just n | isValOcc (nameOccName n) -> (escapeStr (getOccString n), "v") + | otherwise -> (escapeStr (getOccString n), "t") + + line = case maybe_loc of + Nothing -> "" + Just span -> show $ srcSpanStartLine span + + run "" = "" + run ('%':'M':rest) = mod ++ run rest + run ('%':'F':rest) = file ++ run rest + run ('%':'N':rest) = name ++ run rest + run ('%':'K':rest) = kind ++ run rest + run ('%':'L':rest) = line ++ run rest + run ('%':'%':rest) = "%" ++ run rest + + run ('%':'{':'M':'O':'D':'U':'L':'E':'}':rest) = mod ++ run rest + run ('%':'{':'F':'I':'L':'E':'}':rest) = file ++ run rest + run ('%':'{':'N':'A':'M':'E':'}':rest) = name ++ run rest + run ('%':'{':'K':'I':'N':'D':'}':rest) = kind ++ run rest + + run ('%':'{':'M':'O':'D':'U':'L':'E':'/':'.':'/':c:'}':rest) = + map (\x -> if x == '.' then c else x) mod ++ run rest + + run ('%':'{':'F':'I':'L':'E':'/':'/':'/':c:'}':rest) = + map (\x -> if x == '/' then c else x) file ++ run rest + + run ('%':'{':'L':'I':'N':'E':'}':rest) = line ++ run rest + + run (c:rest) = c : run rest + +wikiButton :: WikiURLs -> Maybe Module -> HtmlTable +wikiButton (Just wiki_base_url, _, _) Nothing = + topButBox (anchor ! [href wiki_base_url] << toHtml "User Comments") + +wikiButton (_, Just wiki_module_url, _) (Just mod) = + let url = spliceURL Nothing (Just mod) Nothing Nothing wiki_module_url + in topButBox (anchor ! [href url] << toHtml "User Comments") + +wikiButton _ _ = + Html.emptyTable + +contentsButton :: Maybe String -> HtmlTable +contentsButton maybe_contents_url + = topButBox (anchor ! [href url] << toHtml "Contents") + where url = case maybe_contents_url of + Nothing -> contentsHtmlFile + Just url -> url + +indexButton :: Maybe String -> HtmlTable +indexButton maybe_index_url + = topButBox (anchor ! [href url] << toHtml "Index") + where url = case maybe_index_url of + Nothing -> indexHtmlFile + Just url -> url + +simpleHeader :: String -> Maybe String -> Maybe String + -> SourceURLs -> WikiURLs -> HtmlTable +simpleHeader doctitle maybe_contents_url maybe_index_url + maybe_source_url maybe_wiki_url = + (tda [theclass "topbar"] << + vanillaTable << ( + (td << + image ! [src "haskell_icon.gif", width "16", height 16, alt " " ] + ) <-> + (tda [theclass "title"] << toHtml doctitle) <-> + srcButton maybe_source_url Nothing <-> + wikiButton maybe_wiki_url Nothing <-> + contentsButton maybe_contents_url <-> indexButton maybe_index_url + )) + +pageHeader :: String -> Interface -> String + -> SourceURLs -> WikiURLs + -> Maybe String -> Maybe String -> HtmlTable +pageHeader mdl iface doctitle + maybe_source_url maybe_wiki_url + maybe_contents_url maybe_index_url = + (tda [theclass "topbar"] << + vanillaTable << ( + (td << + image ! [src "haskell_icon.gif", width "16", height 16, alt " "] + ) <-> + (tda [theclass "title"] << toHtml doctitle) <-> + srcButton maybe_source_url (Just iface) <-> + wikiButton maybe_wiki_url (Just $ ifaceMod iface) <-> + contentsButton maybe_contents_url <-> + indexButton maybe_index_url + ) + ) + tda [theclass "modulebar"] << + (vanillaTable << ( + (td << font ! [size "6"] << toHtml mdl) <-> + moduleInfo iface + ) + ) + +moduleInfo :: Interface -> HtmlTable +moduleInfo iface = + let + info = ifaceInfo iface + + doOneEntry :: (String, (GHC.HaddockModInfo GHC.Name) -> Maybe String) -> Maybe HtmlTable + doOneEntry (fieldName,field) = case field info of + Nothing -> Nothing + Just fieldValue -> + Just ((tda [theclass "infohead"] << toHtml fieldName) + <-> (tda [theclass "infoval"]) << toHtml fieldValue) + + entries :: [HtmlTable] + entries = mapMaybe doOneEntry [ + ("Portability",GHC.hmi_portability), + ("Stability",GHC.hmi_stability), + ("Maintainer",GHC.hmi_maintainer) + ] + in + case entries of + [] -> Html.emptyTable + _ -> tda [align "right"] << narrowTable << (foldl1 () entries) + +-- --------------------------------------------------------------------------- +-- Generate the module contents + +ppHtmlContents + :: FilePath + -> String + -> Maybe String + -> Maybe String + -> Maybe String + -> SourceURLs + -> WikiURLs + -> [InstalledInterface] -> Bool -> Maybe (GHC.HsDoc GHC.RdrName) + -> IO () +ppHtmlContents odir doctitle + maybe_package maybe_html_help_format maybe_index_url + maybe_source_url maybe_wiki_url ifaces showPkgs prologue = do + let tree = mkModuleTree showPkgs + [(instMod mod, toInstalledDescription mod) | mod <- ifaces] + html = + header + (documentCharacterEncoding +++ + thetitle (toHtml doctitle) +++ + styleSheet +++ + (script ! [src jsFile, thetype "text/javascript"] $ noHtml)) +++ + body << vanillaTable << ( + simpleHeader doctitle Nothing maybe_index_url + maybe_source_url maybe_wiki_url + ppPrologue doctitle prologue + ppModuleTree doctitle tree + s15 + footer + ) + writeFile (pathJoin [odir, contentsHtmlFile]) (renderHtml html) + + -- Generate contents page for Html Help if requested + case maybe_html_help_format of + Nothing -> return () + Just "mshelp" -> ppHHContents odir doctitle maybe_package tree + Just "mshelp2" -> ppHH2Contents odir doctitle maybe_package tree + Just "devhelp" -> return () + Just format -> fail ("The "++format++" format is not implemented") + +ppPrologue :: String -> Maybe (GHC.HsDoc GHC.RdrName) -> HtmlTable +ppPrologue title Nothing = Html.emptyTable +ppPrologue title (Just doc) = + (tda [theclass "section1"] << toHtml title) + docBox (rdrDocToHtml doc) + +ppModuleTree :: String -> [ModuleTree] -> HtmlTable +ppModuleTree _ ts = + tda [theclass "section1"] << toHtml "Modules" + td << vanillaTable2 << htmlTable + where + genTable htmlTable id [] = (htmlTable,id) + genTable htmlTable id (x:xs) = genTable (htmlTable u) id' xs + where + (u,id') = mkNode [] x 0 id + + (htmlTable,_) = genTable emptyTable 0 ts + +mkNode :: [String] -> ModuleTree -> Int -> Int -> (HtmlTable,Int) +mkNode ss (Node s leaf pkg short ts) depth id = htmlNode + where + htmlNode = case ts of + [] -> (td_pad_w 1.25 depth << htmlModule <-> shortDescr <-> htmlPkg,id) + _ -> (td_w depth << (collapsebutton id_s +++ htmlModule) <-> shortDescr <-> htmlPkg + (td_subtree << sub_tree), id') + + mod_width = 50::Int {-em-} + + td_pad_w pad depth = + tda [thestyle ("padding-left: " ++ show pad ++ "em;" ++ + "width: " ++ show (mod_width - depth*2) ++ "em")] + + td_w depth = + tda [thestyle ("width: " ++ show (mod_width - depth*2) ++ "em")] + + td_subtree = + tda [thestyle ("padding: 0; padding-left: 2em")] + + shortDescr :: HtmlTable + shortDescr = case short of + Nothing -> td empty + Just doc -> tda [theclass "rdoc"] (origDocToHtml doc) + + htmlModule + | leaf = ppModule (mkModule (stringToPackageId pkgName) + (mkModuleName mdl)) "" + | otherwise = toHtml s + + -- ehm.. TODO: change the ModuleTree type + (htmlPkg, pkgName) = case pkg of + Nothing -> (td << empty, "") + Just p -> (td << toHtml p, p) + + mdl = foldr (++) "" (s' : map ('.':) ss') + (s':ss') = reverse (s:ss) + -- reconstruct the module name + + id_s = "n:" ++ show id + + (sub_tree,id') = genSubTree emptyTable (id+1) ts + + genSubTree :: HtmlTable -> Int -> [ModuleTree] -> (Html,Int) + genSubTree htmlTable id [] = (sub_tree,id) + where + sub_tree = collapsed vanillaTable2 id_s htmlTable + genSubTree htmlTable id (x:xs) = genSubTree (htmlTable u) id' xs + where + (u,id') = mkNode (s:ss) x (depth+1) id + +-- The URL for source and wiki links, and the current module +type LinksInfo = (SourceURLs, WikiURLs, Interface) + + +-- --------------------------------------------------------------------------- +-- Generate the index + +ppHtmlIndex :: FilePath + -> String + -> Maybe String + -> Maybe String + -> Maybe String + -> SourceURLs + -> WikiURLs + -> [InstalledInterface] + -> IO () +ppHtmlIndex odir doctitle maybe_package maybe_html_help_format + maybe_contents_url maybe_source_url maybe_wiki_url ifaces = do + let html = + header (documentCharacterEncoding +++ + thetitle (toHtml (doctitle ++ " (Index)")) +++ + styleSheet +++ + (script ! [src jsFile, thetype "text/javascript"] $ noHtml)) +++ + body << vanillaTable << ( + simpleHeader doctitle maybe_contents_url Nothing + maybe_source_url maybe_wiki_url + search_box index_html + ) + + writeFile (pathJoin [odir, indexHtmlFile]) (renderHtml html) + + -- Generate index and contents page for Html Help if requested + case maybe_html_help_format of + Nothing -> return () + Just "mshelp" -> ppHHIndex odir maybe_package ifaces + Just "mshelp2" -> ppHH2Index odir maybe_package ifaces + Just "devhelp" -> return () + Just format -> fail ("The "++format++" format is not implemented") + where + -- colspan 2, marginheight 5 + search_box :: HtmlTable + search_box = tda [colspan 2, thestyle "padding-top:5px;"] << search + where + search :: Html + search = form ! [strAttr "onsubmit" "full_search(); return false;", action ""] << ( + "Search: " + +++ input ! [identifier "searchbox", strAttr "onkeyup" "quick_search()"] + +++ " " +++ input ! [value "Search", thetype "submit"] + +++ " " +++ thespan ! [identifier "searchmsg"] << " ") + + index_html = td << setTrClass (table ! [identifier "indexlist", cellpadding 0, cellspacing 5] << + aboves (map indexElt index)) + + setTrClass :: Html -> Html + setTrClass (Html xs) = Html $ map f xs + where + f (HtmlTag name attrs inner) + | map toUpper name == "TR" = HtmlTag name (theclass "indexrow":attrs) inner + | otherwise = HtmlTag name attrs (setTrClass inner) + f x = x + + index :: [(String, Map GHC.Name [(Module,Bool)])] + index = sortBy cmp (Map.toAscList full_index) + where cmp (n1,_) (n2,_) = map toUpper n1 `compare` map toUpper n2 + + -- for each name (a plain string), we have a number of original HsNames that + -- it can refer to, and for each of those we have a list of modules + -- that export that entity. Each of the modules exports the entity + -- in a visible or invisible way (hence the Bool). + full_index :: Map String (Map GHC.Name [(Module,Bool)]) + full_index = Map.fromListWith (flip (Map.unionWith (++))) + (concat (map getIfaceIndex ifaces)) + + getIfaceIndex iface = + [ (getOccString name + , Map.fromList [(name, [(mdl, name `elem` instVisibleExports iface)])]) + | name <- instExports iface ] + where mdl = instMod iface + + indexElt :: (String, Map GHC.Name [(Module,Bool)]) -> HtmlTable + indexElt (str, entities) = + case Map.toAscList entities of + [(nm,entries)] -> + tda [ theclass "indexentry" ] << toHtml str <-> + indexLinks nm entries + many_entities -> + tda [ theclass "indexentry" ] << toHtml str + aboves (map doAnnotatedEntity (zip [1..] many_entities)) + + doAnnotatedEntity (j,(nm,entries)) + = tda [ theclass "indexannot" ] << + toHtml (show j) <+> parens (ppAnnot (nameOccName nm)) <-> + indexLinks nm entries + + ppAnnot n | not (isValOcc n) = toHtml "Type/Class" + | isDataOcc n = toHtml "Data Constructor" + | otherwise = toHtml "Function" + + indexLinks nm entries = + tda [ theclass "indexlinks" ] << + hsep (punctuate comma + [ if visible then + linkId mod (Just nm) << toHtml (moduleString mod) + else + toHtml (moduleString mod) + | (mod, visible) <- entries ]) + +-- --------------------------------------------------------------------------- +-- Generate the HTML page for a module + +ppHtmlModule + :: FilePath -> String + -> SourceURLs -> WikiURLs + -> Maybe String -> Maybe String + -> Interface -> IO () +ppHtmlModule odir doctitle + maybe_source_url maybe_wiki_url + maybe_contents_url maybe_index_url iface = do + let + mod = ifaceMod iface + mdl = moduleString mod + html = + header (documentCharacterEncoding +++ + thetitle (toHtml mdl) +++ + styleSheet +++ + (script ! [src jsFile, thetype "text/javascript"] $ noHtml)) +++ + body << vanillaTable << ( + pageHeader mdl iface doctitle + maybe_source_url maybe_wiki_url + maybe_contents_url maybe_index_url s15 + ifaceToHtml maybe_source_url maybe_wiki_url iface s15 + footer + ) + writeFile (pathJoin [odir, moduleHtmlFile mod]) (renderHtml html) + + +ifaceToHtml :: SourceURLs -> WikiURLs -> Interface -> HtmlTable +ifaceToHtml maybe_source_url maybe_wiki_url iface + = abovesSep s15 (contents ++ description: synopsis: maybe_doc_hdr: bdy) + where + docMap = ifaceRnDocMap iface + + exports = numberSectionHeadings (ifaceRnExportItems iface) + + has_doc (ExportDecl _ _ doc _) = isJust doc + has_doc (ExportNoDecl _ _ _) = False + has_doc (ExportModule _) = False + has_doc _ = True + + no_doc_at_all = not (any has_doc exports) + + contents = case ppModuleContents exports of + Nothing -> [] + Just x -> [td << vanillaTable << x] + + description + = case ifaceRnDoc iface of + Nothing -> Html.emptyTable + Just doc -> (tda [theclass "section1"] << toHtml "Description") + docBox (docToHtml doc) + + -- omit the synopsis if there are no documentation annotations at all + synopsis + | no_doc_at_all = Html.emptyTable + | otherwise + = (tda [theclass "section1"] << toHtml "Synopsis") + s15 + (tda [theclass "body"] << vanillaTable << + abovesSep s8 (map (processExport True linksInfo docMap) + (filter forSummary exports)) + ) + + -- if the documentation doesn't begin with a section header, then + -- add one ("Documentation"). + maybe_doc_hdr + = case exports of + [] -> Html.emptyTable + ExportGroup _ _ _ : _ -> Html.emptyTable + _ -> tda [ theclass "section1" ] << toHtml "Documentation" + + bdy = map (processExport False linksInfo docMap) exports + linksInfo = (maybe_source_url, maybe_wiki_url, iface) + + +ppModuleContents :: [ExportItem DocName] -> Maybe HtmlTable +ppModuleContents exports + | length sections == 0 = Nothing + | otherwise = Just (tda [theclass "section4"] << bold << toHtml "Contents" + td << dlist << concatHtml sections) + where + (sections, _leftovers{-should be []-}) = process 0 exports + + process :: Int -> [ExportItem DocName] -> ([Html],[ExportItem DocName]) + process _ [] = ([], []) + process n items@(ExportGroup lev id0 doc : rest) + | lev <= n = ( [], items ) + | otherwise = ( html:secs, rest2 ) + where + html = (dterm << linkedAnchor id0 << docToHtml doc) + +++ mk_subsections ssecs + (ssecs, rest1) = process lev rest + (secs, rest2) = process n rest1 + process n (_ : rest) = process n rest + + mk_subsections [] = noHtml + mk_subsections ss = ddef << dlist << concatHtml ss + +-- we need to assign a unique id to each section heading so we can hyperlink +-- them from the contents: +numberSectionHeadings :: [ExportItem DocName] -> [ExportItem DocName] +numberSectionHeadings exports = go 1 exports + where go :: Int -> [ExportItem DocName] -> [ExportItem DocName] + go _ [] = [] + go n (ExportGroup lev _ doc : es) + = ExportGroup lev (show n) doc : go (n+1) es + go n (other:es) + = other : go n es + +processExport :: Bool -> LinksInfo -> DocMap -> (ExportItem DocName) -> HtmlTable +processExport _ _ _ (ExportGroup lev id0 doc) + = ppDocGroup lev (namedAnchor id0 << docToHtml doc) +processExport summary links docMap (ExportDecl x decl doc insts) + = doDecl summary links x decl doc insts docMap +processExport summmary _ _ (ExportNoDecl _ y []) + = declBox (ppDocName y) +processExport summmary _ _ (ExportNoDecl _ y subs) + = declBox (ppDocName y <+> parenList (map ppDocName subs)) +processExport _ _ _ (ExportDoc doc) + = docBox (docToHtml doc) +processExport _ _ _ (ExportModule mod) + = declBox (toHtml "module" <+> ppModule mod "") + +forSummary :: (ExportItem DocName) -> Bool +forSummary (ExportGroup _ _ _) = False +forSummary (ExportDoc _) = False +forSummary _ = True + +ppDocGroup :: Int -> Html -> HtmlTable +ppDocGroup lev doc + | lev == 1 = tda [ theclass "section1" ] << doc + | lev == 2 = tda [ theclass "section2" ] << doc + | lev == 3 = tda [ theclass "section3" ] << doc + | otherwise = tda [ theclass "section4" ] << doc + +declWithDoc :: Bool -> LinksInfo -> SrcSpan -> Name -> Maybe (HsDoc DocName) -> Html -> HtmlTable +declWithDoc True _ _ _ _ html_decl = declBox html_decl +declWithDoc False links loc nm Nothing html_decl = topDeclBox links loc nm html_decl +declWithDoc False links loc nm (Just doc) html_decl = + topDeclBox links loc nm html_decl docBox (docToHtml doc) + +doDecl :: Bool -> LinksInfo -> Name -> LHsDecl DocName -> + Maybe (HsDoc DocName) -> [InstHead DocName] -> DocMap -> HtmlTable +doDecl summary links x (L loc d) mbDoc instances docMap = doDecl d + where + doDecl (TyClD d) = doTyClD d + doDecl (SigD (TypeSig (L _ n) (L _ t))) = + ppFunSig summary links loc mbDoc (getName n) t + doDecl (ForD d) = ppFor summary links loc mbDoc d + + doTyClD d0@(TyData {}) = ppDataDecl summary links instances x loc mbDoc d0 + doTyClD d0@(TySynonym {}) = ppTySyn summary links loc mbDoc d0 + doTyClD d0@(ClassDecl {}) = ppClassDecl summary links instances x loc mbDoc docMap d0 + + +ppFunSig :: Bool -> LinksInfo -> SrcSpan -> Maybe (HsDoc DocName) -> + Name -> HsType DocName -> HtmlTable +ppFunSig summary links loc mbDoc name typ = + ppTypeOrFunSig summary links loc name typ mbDoc + (ppTypeSig summary name typ, ppBinder False name, dcolon) + + +ppTypeOrFunSig :: Bool -> LinksInfo -> SrcSpan -> Name -> HsType DocName -> + Maybe (HsDoc DocName) -> (Html, Html, Html) -> HtmlTable +ppTypeOrFunSig summary links loc name typ doc (pref1, pref2, sep) + | summary || noArgDocs typ = declWithDoc summary links loc name doc pref1 + | otherwise = topDeclBox links loc name pref2 + (tda [theclass "body"] << vanillaTable << ( + do_args sep typ + (case doc of + Just doc -> ndocBox (docToHtml doc) + Nothing -> Html.emptyTable) + )) + where + noLArgDocs (L _ t) = noArgDocs t + noArgDocs (HsForAllTy _ _ _ t) = noLArgDocs t + noArgDocs (HsFunTy (L _ (HsDocTy _ _)) _) = False + noArgDocs (HsFunTy _ r) = noLArgDocs r + noArgDocs (HsDocTy _ _) = False + noArgDocs _ = True + + do_largs leader (L _ t) = do_args leader t + do_args :: Html -> (HsType DocName) -> HtmlTable + do_args leader (HsForAllTy Explicit tvs lctxt ltype) + = (argBox ( + leader <+> + hsep (keyword "forall" : ppTyVars tvs ++ [dot]) <+> + ppLContextNoArrow lctxt) + <-> rdocBox noHtml) + do_largs darrow ltype + do_args leader (HsForAllTy Implicit _ lctxt ltype) + = (argBox (leader <+> ppLContextNoArrow lctxt) + <-> rdocBox noHtml) + do_largs darrow ltype + do_args leader (HsFunTy (L _ (HsDocTy lt ldoc)) r) + = (argBox (leader <+> ppLType lt) <-> rdocBox (docToHtml (unLoc ldoc))) + do_largs arrow r + do_args leader (HsFunTy lt r) + = (argBox (leader <+> ppLType lt) <-> rdocBox noHtml) do_largs arrow r + do_args leader (HsDocTy lt ldoc) + = (argBox (leader <+> ppLType lt) <-> rdocBox (docToHtml (unLoc ldoc))) + do_args leader t + = argBox (leader <+> ppType t) <-> rdocBox (noHtml) + + +ppTyVars tvs = ppTyNames (tyvarNames tvs) + +tyvarNames = map f + where f x = let NoLink n = hsTyVarName (unLoc x) in n + +ppFor summary links loc mbDoc (ForeignImport (L _ name) (L _ typ) _) + = ppFunSig summary links loc mbDoc (getName name) typ +ppFor _ _ _ _ _ = error "ppFor" + +-- we skip type patterns for now +ppTySyn summary links loc mbDoc (TySynonym (L _ name) ltyvars _ ltype) + = ppTypeOrFunSig summary links loc n (unLoc ltype) mbDoc + (full, hdr, spaceHtml +++ equals) + where + hdr = hsep ([keyword "type", ppBinder summary n] ++ ppTyVars ltyvars) + full = hdr <+> equals <+> ppLType ltype + NoLink n = name + + +ppTypeSig :: Bool -> Name -> HsType DocName -> Html +ppTypeSig summary nm ty = ppBinder summary nm <+> dcolon <+> ppType ty + + +ppTyName name + | isNameSym name = parens (ppName name) + | otherwise = ppName name + + +ppTyNames = map ppTyName + + +-------------------------------------------------------------------------------- +-- Type applications +-------------------------------------------------------------------------------- + + +-- | Print an application of a DocName and a list of HsTypes +ppAppNameTypes :: DocName -> [HsType DocName] -> Html +ppAppNameTypes n ts = ppTypeApp n ts ppDocName ppParendType + + +-- | Print an application of a DocName and a list of Names +ppDataClassHead :: Bool -> DocName -> [Name] -> Html +ppDataClassHead summ n ns = + ppTypeApp n ns (ppBinder summ . getName) ppTyName + + +-- | General printing of type applications +ppTypeApp :: DocName -> [a] -> (DocName -> Html) -> (a -> Html) -> Html +ppTypeApp n ts@(t1:t2:rest) ppDN ppT + | operator, not . null $ rest = parens opApp <+> hsep (map ppT rest) + | operator = opApp + where + operator = isNameSym . getName $ n + opApp = ppT t1 <+> ppDN n <+> ppT t2 + +ppTypeApp n ts ppDN ppT = ppDN n <+> hsep (map ppT ts) + + +-------------------------------------------------------------------------------- +-- Contexts +-------------------------------------------------------------------------------- + +ppLContext = ppContext . unLoc +ppLContextNoArrow = ppContextNoArrow . unLoc + +ppContextNoArrow :: HsContext DocName -> Html +ppContextNoArrow [] = empty +ppContextNoArrow cxt = pp_hs_context (map unLoc cxt) + +ppContextNoLocs :: [HsPred DocName] -> Html +ppContextNoLocs [] = empty +ppContextNoLocs cxt = pp_hs_context cxt <+> darrow + +ppContext :: HsContext DocName -> Html +ppContext cxt = ppContextNoLocs (map unLoc cxt) + +pp_hs_context [] = empty +pp_hs_context [p] = ppPred p +pp_hs_context cxt = parenList (map ppPred cxt) + +ppLPred = ppPred . unLoc + + +ppPred (HsClassP n ts) = ppAppNameTypes n (map unLoc ts) +-- TODO: find out what happened to the Dupable/Linear distinction +ppPred (HsEqualP t1 t2) = ppLType t1 <+> toHtml "~" <+> ppLType t2 +ppPred (HsIParam (IPName n) t) + = toHtml "?" +++ ppDocName n <+> dcolon <+> ppLType t + + +-- ----------------------------------------------------------------------------- +-- Class declarations + +ppClassHdr summ lctxt n tvs fds = + keyword "class" + <+> (if not . null . unLoc $ lctxt then ppLContext lctxt else empty) + <+> ppDataClassHead summ n (tyvarNames $ tvs) + <+> ppFds fds + +ppFds fds = + if null fds then noHtml else + char '|' <+> hsep (punctuate comma (map (fundep . unLoc) fds)) + where + fundep (vars1,vars2) = hsep (map ppDocName vars1) <+> toHtml "->" <+> + hsep (map ppDocName vars2) + +ppShortClassDecl :: Bool -> LinksInfo -> TyClDecl DocName -> SrcSpan -> DocMap -> HtmlTable +ppShortClassDecl summary links (ClassDecl lctxt lname tvs fds sigs _ ats _) loc docMap = + if null sigs && null ats + then (if summary then declBox else topDeclBox links loc nm) hdr + else (if summary then declBox else topDeclBox links loc nm) (hdr <+> keyword "where") + + (tda [theclass "body"] << + vanillaTable << + aboves ([ ppAT summary at | L _ at <- ats ] ++ + [ ppFunSig summary links loc mbDoc n typ + | L _ (TypeSig (L _ (NoLink n)) (L _ typ)) <- sigs + , let mbDoc = Map.lookup n docMap ]) + ) + where + hdr = ppClassHdr summary lctxt (unLoc lname) tvs fds + NoLink nm = unLoc lname + + ppAT summary at = case at of + TyData {} -> topDeclBox links loc nm (ppDataHeader summary at) + _ -> error "associated type synonyms or type families not supported yet" + +-- we skip ATs for now +ppClassDecl :: Ord key => Bool -> LinksInfo -> [InstHead DocName] -> key -> SrcSpan -> + Maybe (HsDoc DocName) -> DocMap -> TyClDecl DocName -> + HtmlTable +ppClassDecl summary links instances orig_c loc mbDoc docMap + decl@(ClassDecl lctxt lname ltyvars lfds lsigs _ _ _) + | summary = ppShortClassDecl summary links decl loc docMap + | otherwise + = classheader + tda [theclass "body"] << vanillaTable << ( + classdoc methodsBit instancesBit + ) + where + classheader + | null lsigs = topDeclBox links loc nm hdr + | otherwise = topDeclBox links loc nm (hdr <+> keyword "where") + + NoLink nm = unLoc lname + ctxt = unLoc lctxt + + hdr = ppClassHdr summary lctxt (unLoc lname) ltyvars lfds + + classdoc = case mbDoc of + Nothing -> Html.emptyTable + Just d -> ndocBox (docToHtml d) + + methodsBit + | null lsigs = Html.emptyTable + | otherwise = + s8 methHdr + tda [theclass "body"] << vanillaTable << ( + abovesSep s8 [ ppFunSig summary links loc mbDoc (orig n) typ + | L _ (TypeSig n (L _ typ)) <- lsigs + , let mbDoc = Map.lookup (orig n) docMap ] + ) + + instId = collapseId nm + instancesBit + | null instances = Html.emptyTable + | otherwise + = s8 instHdr instId + tda [theclass "body"] << + collapsed thediv instId ( + spacedTable1 << ( + aboves (map (declBox . ppInstHead) instances) + )) + +ppInstHead :: InstHead DocName -> Html +ppInstHead ([], n, ts) = ppAppNameTypes n ts +ppInstHead (ctxt, n, ts) = ppContextNoLocs ctxt <+> ppAppNameTypes n ts + + +-- ----------------------------------------------------------------------------- +-- Data & newtype declarations + +orig (L _ (NoLink name)) = name +orig _ = error "orig" + + +-- TODO: print contexts +ppShortDataDecl :: Bool -> LinksInfo -> SrcSpan -> + Maybe (HsDoc DocName) -> TyClDecl DocName -> Html +ppShortDataDecl summary links loc mbDoc dataDecl + + | [lcon] <- cons, ResTyH98 <- resTy = + ppDataHeader summary dataDecl + <+> equals <+> ppShortConstr summary (unLoc lcon) + + | [] <- cons = ppDataHeader summary dataDecl + + | otherwise = vanillaTable << ( + case resTy of + ResTyH98 -> dataHeader + tda [theclass "body"] << vanillaTable << ( + aboves (zipWith doConstr ('=':repeat '|') cons) + ) + ResTyGADT _ -> dataHeader + tda [theclass "body"] << vanillaTable << ( + aboves (map doGADTConstr cons) + ) + ) + + where + dataHeader = + (if summary then declBox else topDeclBox links loc name) + ((ppDataHeader summary dataDecl) <+> + case resTy of ResTyGADT _ -> keyword "where"; _ -> empty) + + doConstr c con = declBox (toHtml [c] <+> ppShortConstr summary (unLoc con)) + doGADTConstr con = declBox (ppShortConstr summary (unLoc con)) + + name = orig (tcdLName dataDecl) + context = unLoc (tcdCtxt dataDecl) + newOrData = tcdND dataDecl + tyVars = tyvarNames (tcdTyVars dataDecl) + mbKSig = tcdKindSig dataDecl + cons = tcdCons dataDecl + resTy = (con_res . unLoc . head) cons + +ppDataDecl :: Ord key => Bool -> LinksInfo -> [InstHead DocName] -> key -> + SrcSpan -> Maybe (HsDoc DocName) -> TyClDecl DocName -> HtmlTable +ppDataDecl summary links instances x loc mbDoc dataDecl + + | summary = declWithDoc summary links loc name mbDoc + (ppShortDataDecl summary links loc mbDoc dataDecl) + + | otherwise + = (if validTable then () else const) dataHeader $ + tda [theclass "body"] << vanillaTable << ( + datadoc + constrBit + instancesBit + ) + + + where + name = orig (tcdLName dataDecl) + context = unLoc (tcdCtxt dataDecl) + newOrData = tcdND dataDecl + tyVars = tyvarNames (tcdTyVars dataDecl) + mbKSig = tcdKindSig dataDecl + cons = tcdCons dataDecl + resTy = (con_res . unLoc . head) cons + + dataHeader = + (if summary then declBox else topDeclBox links loc name) + ((ppDataHeader summary dataDecl) <+> whereBit) + + whereBit + | null cons = empty + | otherwise = case resTy of + ResTyGADT _ -> keyword "where" + _ -> empty + + constrTable + | any isRecCon cons = spacedTable5 + | otherwise = spacedTable1 + + datadoc = case mbDoc of + Just doc -> ndocBox (docToHtml doc) + Nothing -> Html.emptyTable + + constrBit + | null cons = Html.emptyTable + | otherwise = constrHdr ( + tda [theclass "body"] << constrTable << + aboves (map ppSideBySideConstr cons) + ) + + instId = collapseId name + + instancesBit + | null instances = Html.emptyTable + | otherwise + = instHdr instId + tda [theclass "body"] << + collapsed thediv instId ( + spacedTable1 << ( + aboves (map (declBox . ppInstHead) instances) + ) + ) + + validTable = isJust mbDoc || not (null cons) || not (null instances) + + +isRecCon lcon = case con_details (unLoc lcon) of + RecCon _ -> True + _ -> False + +ppShortConstr :: Bool -> ConDecl DocName -> Html +ppShortConstr summary con = case con_res con of + + ResTyH98 -> case con_details con of + PrefixCon args -> header +++ hsep (ppBinder summary name : map ppLType args) + RecCon fields -> header +++ ppBinder summary name <+> + braces (vanillaTable << aboves (map (ppShortField summary) fields)) + InfixCon arg1 arg2 -> header +++ + hsep [ppLType arg1, ppBinder summary name, ppLType arg2] + + ResTyGADT resTy -> case con_details con of + PrefixCon args -> doGADTCon args resTy + RecCon _ -> error "GADT records not suported" + InfixCon arg1 arg2 -> doGADTCon [arg1, arg2] resTy + + where + doGADTCon args resTy = ppBinder summary name <+> dcolon <+> hsep [ + ppForAll forall ltvs lcontext, + ppLType (foldr mkFunTy resTy args) ] + + header = ppConstrHdr forall tyVars context + name = orig (con_name con) + ltvs = con_qvars con + tyVars = tyvarNames ltvs + lcontext = con_cxt con + context = unLoc (con_cxt con) + forall = con_explicit con + mkFunTy a b = noLoc (HsFunTy a b) + +ppConstrHdr :: HsExplicitForAll -> [Name] -> HsContext DocName -> Html +ppConstrHdr forall tvs ctxt + = (if null tvs then noHtml else ppForall) + +++ + (if null ctxt then noHtml else ppContextNoArrow ctxt <+> toHtml "=> ") + where + ppForall = case forall of + Explicit -> keyword "forall" <+> hsep (map ppName tvs) <+> toHtml ". " + Implicit -> empty + +ppSideBySideConstr :: LConDecl DocName -> HtmlTable +ppSideBySideConstr (L _ con) = case con_res con of + + ResTyH98 -> case con_details con of + + PrefixCon args -> + argBox (hsep ((header +++ ppBinder False name) : map ppLType args)) + <-> maybeRDocBox mbLDoc + + RecCon fields -> + argBox (header +++ ppBinder False name) <-> + maybeRDocBox mbLDoc + (tda [theclass "body"] << spacedTable1 << + aboves (map ppSideBySideField fields)) + + InfixCon arg1 arg2 -> + argBox (hsep [header+++ppLType arg1, ppBinder False name, ppLType arg2]) + <-> maybeRDocBox mbLDoc + + ResTyGADT resTy -> case con_details con of + PrefixCon args -> doGADTCon args resTy + RecCon _ -> error "GADT records not supported" + InfixCon arg1 arg2 -> doGADTCon [arg1, arg2] resTy + + where + doGADTCon args resTy = argBox (ppBinder False name <+> dcolon <+> hsep [ + ppForAll forall ltvs (con_cxt con), + ppLType (foldr mkFunTy resTy args) ] + ) <-> maybeRDocBox mbLDoc + + + header = ppConstrHdr forall tyVars context + name = orig (con_name con) + ltvs = con_qvars con + tyVars = tyvarNames (con_qvars con) + context = unLoc (con_cxt con) + forall = con_explicit con + mbLDoc = con_doc con + mkFunTy a b = noLoc (HsFunTy a b) + +ppSideBySideField :: ConDeclField DocName -> HtmlTable +ppSideBySideField (ConDeclField lname ltype mbLDoc) = + argBox (ppBinder False (orig lname) + <+> dcolon <+> ppLType ltype) <-> + maybeRDocBox mbLDoc + +{- +ppHsFullConstr :: HsConDecl -> Html +ppHsFullConstr (HsConDecl _ nm tvs ctxt typeList doc) = + declWithDoc False doc ( + hsep ((ppHsConstrHdr tvs ctxt +++ + ppHsBinder False nm) : map ppHsBangType typeList) + ) +ppHsFullConstr (HsRecDecl _ nm tvs ctxt fields doc) = + td << vanillaTable << ( + case doc of + Nothing -> aboves [hdr, fields_html] + Just _ -> aboves [hdr, constr_doc, fields_html] + ) + + where hdr = declBox (ppHsConstrHdr tvs ctxt +++ ppHsBinder False nm) + + constr_doc + | isJust doc = docBox (docToHtml (fromJust doc)) + | otherwise = Html.emptyTable + + fields_html = + td << + table ! [width "100%", cellpadding 0, cellspacing 8] << ( + aboves (map ppFullField (concat (map expandField fields))) + ) +-} + +ppShortField :: Bool -> ConDeclField DocName -> HtmlTable +ppShortField summary (ConDeclField lname ltype _) + = tda [theclass "recfield"] << ( + ppBinder summary (orig lname) + <+> dcolon <+> ppLType ltype + ) + +{- +ppFullField :: HsFieldDecl -> Html +ppFullField (HsFieldDecl [n] ty doc) + = declWithDoc False doc ( + ppHsBinder False n <+> dcolon <+> ppHsBangType ty + ) +ppFullField _ = error "ppFullField" + +expandField :: HsFieldDecl -> [HsFieldDecl] +expandField (HsFieldDecl ns ty doc) = [ HsFieldDecl [n] ty doc | n <- ns ] +-} + +-- | Print the LHS of a data\/newtype declaration. +-- Currently doesn't handle 'data instance' decls or kind signatures +ppDataHeader :: Bool -> TyClDecl DocName -> Html +ppDataHeader summary decl + | not (isDataDecl decl) = error "ppDataHeader: illegal argument" + | otherwise = + -- newtype or data + (if tcdND decl == NewType then keyword "newtype" else keyword "data") <+> + -- context + ppLContext (tcdCtxt decl) <+> + -- T a b c ..., or a :+: b + ppDataClassHead summary (unLoc $ tcdLName decl) (tyvarNames $ tcdTyVars decl) + + +-- ---------------------------------------------------------------------------- +-- Types and contexts + +ppKind k = toHtml $ showSDoc (ppr k) + +{- +ppForAll Implicit _ lctxt = ppCtxtPart lctxt +ppForAll Explicit ltvs lctxt = + hsep (keyword "forall" : ppTyVars ltvs ++ [dot]) <+> ppCtxtPart lctxt +-} + +ppBang HsStrict = toHtml "!" +ppBang HsUnbox = toHtml "!!" + +tupleParens Boxed = parenList +tupleParens Unboxed = ubxParenList +{- +ppType :: HsType DocName -> Html +ppType t = case t of + t@(HsForAllTy expl ltvs lcontext ltype) -> ppForAllTy t <+> ppLType ltype + HsTyVar n -> ppDocName n + HsBangTy HsStrict lt -> toHtml "!" <+> ppLType lt + HsBangTy HsUnbox lt -> toHtml "!!" <+> ppLType lt + HsAppTy a b -> ppLType a <+> ppLType b + HsFunTy a b -> hsep [ppLType a, toHtml "->", ppLType b] + HsListTy t -> brackets $ ppLType t + HsPArrTy t -> toHtml "[:" +++ ppLType t +++ toHtml ":]" + HsTupleTy Boxed ts -> parenList $ map ppLType ts + HsTupleTy Unboxed ts -> ubxParenList $ map ppLType ts + HsOpTy a n b -> ppLType a <+> ppLDocName n <+> ppLType b + HsParTy t -> parens $ ppLType t + HsNumTy n -> toHtml (show n) + HsPredTy p -> ppPred p + HsKindSig t k -> hsep [ppLType t, dcolon, ppKind k] + HsSpliceTy _ -> error "ppType" + HsDocTy t _ -> ppLType t +-} +-------------------------------------------------------------------------------- +-- Rendering of HsType +-------------------------------------------------------------------------------- + +pREC_TOP = (0 :: Int) -- type in ParseIface.y in GHC +pREC_FUN = (1 :: Int) -- btype in ParseIface.y in GHC + -- Used for LH arg of (->) +pREC_OP = (2 :: Int) -- Used for arg of any infix operator + -- (we don't keep their fixities around) +pREC_CON = (3 :: Int) -- Used for arg of type applicn: + -- always parenthesise unless atomic + +maybeParen :: Int -- Precedence of context + -> Int -- Precedence of top-level operator + -> Html -> Html -- Wrap in parens if (ctxt >= op) +maybeParen ctxt_prec op_prec p | ctxt_prec >= op_prec = parens p + | otherwise = p + + +ppLTypes = hsep . map ppLType +ppLParendTypes = hsep . map ppLParendType + + +ppParendTypes = hsep . map ppParendType + + +ppLType = ppType . unLoc +ppLParendType = ppParendType . unLoc + + +ppType ty = ppr_mono_ty pREC_TOP (prepare ty) +ppParendType ty = ppr_mono_ty pREC_CON ty + + +-- Before printing a type +-- (a) Remove outermost HsParTy parens +-- (b) Drop top-level for-all type variables in user style +-- since they are implicit in Haskell +prepare (HsParTy ty) = prepare (unLoc ty) +prepare ty = ty + +ppForAll exp tvs cxt + | show_forall = forall_part <+> ppLContext cxt + | otherwise = ppLContext cxt + where + show_forall = not (null tvs) && is_explicit + is_explicit = case exp of {Explicit -> True; Implicit -> False} + forall_part = hsep (keyword "forall" : ppTyVars tvs) +++ dot + +ppr_mono_lty ctxt_prec ty = ppr_mono_ty ctxt_prec (unLoc ty) + +ppr_mono_ty ctxt_prec (HsForAllTy exp tvs ctxt ty) + = maybeParen ctxt_prec pREC_FUN $ + hsep [ppForAll exp tvs ctxt, ppr_mono_lty pREC_TOP ty] + +-- gaw 2004 +ppr_mono_ty ctxt_prec (HsBangTy b ty) = ppBang b +++ ppLType ty +ppr_mono_ty ctxt_prec (HsTyVar name) = ppDocName name +ppr_mono_ty ctxt_prec (HsFunTy ty1 ty2) = ppr_fun_ty ctxt_prec ty1 ty2 +ppr_mono_ty ctxt_prec (HsTupleTy con tys) = tupleParens con (map ppLType tys) +ppr_mono_ty ctxt_prec (HsKindSig ty kind) = parens (ppr_mono_lty pREC_TOP ty <+> dcolon <+> ppKind kind) +ppr_mono_ty ctxt_prec (HsListTy ty) = brackets (ppr_mono_lty pREC_TOP ty) +ppr_mono_ty ctxt_prec (HsPArrTy ty) = pabrackets (ppr_mono_lty pREC_TOP ty) +ppr_mono_ty ctxt_prec (HsPredTy pred) = parens (ppPred pred) +ppr_mono_ty ctxt_prec (HsNumTy n) = toHtml (show n) -- generics only +ppr_mono_ty ctxt_prec (HsSpliceTy s) = error "ppr_mono_ty-haddock" + +ppr_mono_ty ctxt_prec (HsAppTy fun_ty arg_ty) + = maybeParen ctxt_prec pREC_CON $ + hsep [ppr_mono_lty pREC_FUN fun_ty, ppr_mono_lty pREC_CON arg_ty] + +ppr_mono_ty ctxt_prec (HsOpTy ty1 op ty2) + = maybeParen ctxt_prec pREC_OP $ + ppr_mono_lty pREC_OP ty1 <+> ppr_op <+> ppr_mono_lty pREC_OP ty2 + where + ppr_op = if not (isNameSym name) then quote (ppLDocName op) else ppLDocName op + name = getName . unLoc $ op + +ppr_mono_ty ctxt_prec (HsParTy ty) + = parens (ppr_mono_lty pREC_TOP ty) + +ppr_mono_ty ctxt_prec (HsDocTy ty doc) + = ppLType ty + +ppr_fun_ty ctxt_prec ty1 ty2 + = let p1 = ppr_mono_lty pREC_FUN ty1 + p2 = ppr_mono_lty pREC_TOP ty2 + in + maybeParen ctxt_prec pREC_FUN $ + hsep [p1, arrow <+> p2] + +-- ---------------------------------------------------------------------------- +-- Names + +ppOccName :: OccName -> Html +ppOccName name = toHtml $ occNameString name + +ppRdrName :: RdrName -> Html +ppRdrName = ppOccName . rdrNameOcc + +ppLDocName (L _ d) = ppDocName d + +ppDocName :: DocName -> Html +ppDocName (Link name) = linkId (nameModule name) (Just name) << ppName name +ppDocName (NoLink name) = toHtml (getOccString name) + +linkTarget :: Name -> Html +linkTarget name = namedAnchor (anchorNameStr name) << toHtml "" + +ppName :: Name -> Html +ppName name = toHtml (getOccString name) + +ppBinder :: Bool -> Name -> Html +-- The Bool indicates whether we are generating the summary, in which case +-- the binder will be a link to the full definition. +ppBinder True nm = linkedAnchor (anchorNameStr nm) << ppBinder' nm +ppBinder False nm = linkTarget nm +++ bold << ppBinder' nm + +ppBinder' :: Name -> Html +ppBinder' name + | isNameVarSym name = parens $ toHtml (getOccString name) + | otherwise = toHtml (getOccString name) + +linkId :: Module -> Maybe Name -> Html -> Html +linkId mod mbName = anchor ! [href hr] + where + hr = case mbName of + Nothing -> moduleHtmlFile mod + Just name -> nameHtmlRef mod name + +ppModule :: Module -> String -> Html +ppModule mod ref = anchor ! [href ((moduleHtmlFile mod) ++ ref)] + << toHtml (moduleString mod) + +-- ----------------------------------------------------------------------------- +-- * Doc Markup + +parHtmlMarkup :: (a -> Html) -> DocMarkup a Html +parHtmlMarkup ppId = Markup { + markupParagraph = paragraph, + markupEmpty = toHtml "", + markupString = toHtml, + markupAppend = (+++), + markupIdentifier = tt . ppId . head, + markupModule = \m -> ppModule (mkModuleNoPkg m) "", + markupEmphasis = emphasize . toHtml, + markupMonospaced = tt . toHtml, + markupUnorderedList = ulist . concatHtml . map (li <<), + markupOrderedList = olist . concatHtml . map (li <<), + markupDefList = dlist . concatHtml . map markupDef, + markupCodeBlock = pre, + markupURL = \url -> anchor ! [href url] << toHtml url, + markupAName = \aname -> namedAnchor aname << toHtml "" + } + +markupDef (a,b) = dterm << a +++ ddef << b + +htmlMarkup = parHtmlMarkup ppDocName +htmlOrigMarkup = parHtmlMarkup ppName +htmlRdrMarkup = parHtmlMarkup ppRdrName + +-- If the doc is a single paragraph, don't surround it with

    (this causes +-- ugly extra whitespace with some browsers). +docToHtml :: GHC.HsDoc DocName -> Html +docToHtml doc = markup htmlMarkup (unParagraph (markup htmlCleanup doc)) + +origDocToHtml :: GHC.HsDoc GHC.Name -> Html +origDocToHtml doc = markup htmlOrigMarkup (unParagraph (markup htmlCleanup doc)) + +rdrDocToHtml doc = markup htmlRdrMarkup (unParagraph (markup htmlCleanup doc)) + +-- If there is a single paragraph, then surrounding it with

    ..

    +-- can add too much whitespace in some browsers (eg. IE). However if +-- we have multiple paragraphs, then we want the extra whitespace to +-- separate them. So we catch the single paragraph case and transform it +-- here. +unParagraph (GHC.DocParagraph d) = d +--NO: This eliminates line breaks in the code block: (SDM, 6/5/2003) +--unParagraph (DocCodeBlock d) = (DocMonospaced d) +unParagraph doc = doc + +htmlCleanup :: DocMarkup a (GHC.HsDoc a) +htmlCleanup = idMarkup { + markupUnorderedList = GHC.DocUnorderedList . map unParagraph, + markupOrderedList = GHC.DocOrderedList . map unParagraph + } + +-- ----------------------------------------------------------------------------- +-- * Misc + +hsep :: [Html] -> Html +hsep [] = noHtml +hsep htmls = foldr1 (\a b -> a+++" "+++b) htmls + +infixr 8 <+> +(<+>) :: Html -> Html -> Html +a <+> b = Html (getHtmlElements (toHtml a) ++ HtmlString " ": getHtmlElements (toHtml b)) + +keyword :: String -> Html +keyword s = thespan ! [theclass "keyword"] << toHtml s + +equals, comma :: Html +equals = char '=' +comma = char ',' + +char :: Char -> Html +char c = toHtml [c] + +empty :: Html +empty = noHtml + + +quote :: Html -> Html +quote h = char '`' +++ h +++ '`' + + +parens, brackets, braces :: Html -> Html +parens h = char '(' +++ h +++ char ')' +brackets h = char '[' +++ h +++ char ']' +pabrackets h = toHtml "[:" +++ h +++ toHtml ":]" +braces h = char '{' +++ h +++ char '}' + +punctuate :: Html -> [Html] -> [Html] +punctuate _ [] = [] +punctuate h (d0:ds) = go d0 ds + where + go d [] = [d] + go d (e:es) = (d +++ h) : go e es + +abovesSep :: HtmlTable -> [HtmlTable] -> HtmlTable +abovesSep _ [] = Html.emptyTable +abovesSep h (d0:ds) = go d0 ds + where + go d [] = d + go d (e:es) = d h go e es + +parenList :: [Html] -> Html +parenList = parens . hsep . punctuate comma + +ubxParenList :: [Html] -> Html +ubxParenList = ubxparens . hsep . punctuate comma + +ubxparens :: Html -> Html +ubxparens h = toHtml "(#" +++ h +++ toHtml "#)" + +{- +text :: Html +text = strAttr "TEXT" +-} + +-- a box for displaying code +declBox :: Html -> HtmlTable +declBox html = tda [theclass "decl"] << html + +-- a box for top level documented names +-- it adds a source and wiki link at the right hand side of the box +topDeclBox :: LinksInfo -> SrcSpan -> Name -> Html -> HtmlTable +topDeclBox ((_,_,Nothing), (_,_,Nothing), _) _ _ html = declBox html +topDeclBox ((_,_,maybe_source_url), (_,_,maybe_wiki_url), iface) + loc name html = + tda [theclass "topdecl"] << + ( table ! [theclass "declbar"] << + ((tda [theclass "declname"] << html) + <-> srcLink + <-> wikiLink) + ) + where srcLink = + case maybe_source_url of + Nothing -> Html.emptyTable + Just url -> tda [theclass "declbut"] << + let url' = spliceURL (Just fname) (Just origMod) + (Just name) (Just loc) url + in anchor ! [href url'] << toHtml "Source" + + -- for source links, we want to point to the original module, + -- because only that will have the source. + origMod = case Map.lookup (nameOccName name) (ifaceEnv iface) of + Just n -> case nameModule_maybe n of + Just m -> m + Nothing -> mod + _ -> error "This shouldn't happen (topDeclBox)" + + wikiLink = + case maybe_wiki_url of + Nothing -> Html.emptyTable + Just url -> tda [theclass "declbut"] << + let url' = spliceURL (Just fname) (Just mod) + (Just name) (Just loc) url + in anchor ! [href url'] << toHtml "Comments" + + mod = ifaceMod iface + fname = unpackFS (srcSpanFile loc) + + +-- a box for displaying an 'argument' (some code which has text to the +-- right of it). Wrapping is not allowed in these boxes, whereas it is +-- in a declBox. +argBox :: Html -> HtmlTable +argBox html = tda [theclass "arg"] << html + +-- a box for displaying documentation, +-- indented and with a little padding at the top +docBox :: Html -> HtmlTable +docBox html = tda [theclass "doc"] << html + +-- a box for displaying documentation, not indented. +ndocBox :: Html -> HtmlTable +ndocBox html = tda [theclass "ndoc"] << html + +-- a box for displaying documentation, padded on the left a little +rdocBox :: Html -> HtmlTable +rdocBox html = tda [theclass "rdoc"] << html + +maybeRDocBox :: Maybe (GHC.LHsDoc DocName) -> HtmlTable +maybeRDocBox Nothing = rdocBox (noHtml) +maybeRDocBox (Just ldoc) = rdocBox (docToHtml (unLoc ldoc)) + +-- a box for the buttons at the top of the page +topButBox :: Html -> HtmlTable +topButBox html = tda [theclass "topbut"] << html + +-- a vanilla table has width 100%, no border, no padding, no spacing +-- a narrow table is the same but without width 100%. +vanillaTable, narrowTable :: Html -> Html +vanillaTable = table ! [theclass "vanilla", cellspacing 0, cellpadding 0] +vanillaTable2 = table ! [theclass "vanilla2", cellspacing 0, cellpadding 0] +narrowTable = table ! [theclass "narrow", cellspacing 0, cellpadding 0] + +spacedTable1, spacedTable5 :: Html -> Html +spacedTable1 = table ! [theclass "vanilla", cellspacing 1, cellpadding 0] +spacedTable5 = table ! [theclass "vanilla", cellspacing 5, cellpadding 0] + +constrHdr, methHdr :: HtmlTable +constrHdr = tda [ theclass "section4" ] << toHtml "Constructors" +methHdr = tda [ theclass "section4" ] << toHtml "Methods" + +instHdr :: String -> HtmlTable +instHdr id = + tda [ theclass "section4" ] << (collapsebutton id +++ toHtml " Instances") + +dcolon, arrow, darrow :: Html +dcolon = toHtml "::" +arrow = toHtml "->" +darrow = toHtml "=>" +dot = toHtml "." + +s8, s15 :: HtmlTable +s8 = tda [ theclass "s8" ] << noHtml +s15 = tda [ theclass "s15" ] << noHtml + +namedAnchor :: String -> Html -> Html +namedAnchor n = anchor ! [name (escapeStr n)] + +-- +-- A section of HTML which is collapsible via a +/- button. +-- + +-- TODO: Currently the initial state is non-collapsed. Change the 'minusFile' +-- below to a 'plusFile' and the 'display:block;' to a 'display:none;' when we +-- use cookies from JavaScript to have a more persistent state. + +collapsebutton :: String -> Html +collapsebutton id = + image ! [ src minusFile, theclass "coll", onclick ("toggle(this,'" ++ id ++ "')"), alt "show/hide" ] + +collapsed :: (HTML a) => (Html -> Html) -> String -> a -> Html +collapsed fn id html = + fn ! [identifier id, thestyle "display:block;"] << html + +-- A quote is a valid part of a Haskell identifier, but it would interfere with +-- the ECMA script string delimiter used in collapsebutton above. +collapseId :: Name -> String +collapseId nm = "i:" ++ escapeStr (getOccString nm) + +linkedAnchor :: String -> Html -> Html +linkedAnchor frag = anchor ! [href hr] + where hr | null frag = "" + | otherwise = '#': escapeStr frag + +documentCharacterEncoding :: Html +documentCharacterEncoding = + meta ! [httpequiv "Content-Type", content "text/html; charset=UTF-8"] + +styleSheet :: Html +styleSheet = + thelink ! [href cssFile, rel "stylesheet", thetype "text/css"] diff --git a/src/Haddock/Comments.hs b/src/Haddock/Comments.hs new file mode 100644 --- /dev/null +++ b/src/Haddock/Comments.hs @@ -0,0 +1,15 @@ +module Haddock.Comments where + +import Data.Generics +import Data.Typeable +import SrcLoc + +deriving instance Typeable1 Located + +next :: (Data a, Typeable b) => SrcSpan -> a -> [Located b] +next span term = locatedTerms term + +locatedTerms :: (Data a, Typeable b) => a -> [Located b] +locatedTerms terms = listify (\(L _ _) -> True) terms + + diff --git a/src/Haddock/Exception.hs b/src/Haddock/Exception.hs new file mode 100644 --- /dev/null +++ b/src/Haddock/Exception.hs @@ -0,0 +1,23 @@ +-- +-- Haddock - A Haskell Documentation Tool +-- +-- (c) Simon Marlow 2003 +-- + + +module Haddock.Exception ( + HaddockException, + throwE +) where + + +import Data.Typeable +import Control.Exception + + +data HaddockException = HaddockException String deriving Typeable +throwE str = throwDyn (HaddockException str) + + +instance Show HaddockException where + show (HaddockException str) = str diff --git a/src/Haddock/GHC.hs b/src/Haddock/GHC.hs new file mode 100644 --- /dev/null +++ b/src/Haddock/GHC.hs @@ -0,0 +1,96 @@ +-- +-- Haddock - A Haskell Documentation Tool +-- +-- (c) Simon Marlow 2003 +-- + + +module Haddock.GHC ( + startGhc, + loadPackages, + module Haddock.GHC.Typecheck, + module Haddock.GHC.Utils +) where + + +import Haddock.GHC.Typecheck +import Haddock.GHC.Utils +import Haddock.Exception +import Haddock.Options + +import Data.Foldable (foldlM) +import Data.Maybe +import Control.Monad + +import GHC +import DynFlags hiding (Option) +import Packages hiding (package) +import StaticFlags + + +-- | Start a GHC session with the -haddock flag set. Also turn off +-- compilation and linking. +startGhc :: String -> [String] -> IO (Session, DynFlags) +startGhc libDir flags = do + restFlags <- parseStaticFlags flags + session <- newSession (Just libDir) + dynflags <- getSessionDynFlags session + let dynflags' = dopt_set dynflags Opt_Haddock + let dynflags'' = dynflags' { + hscTarget = HscAsm, + ghcMode = CompManager, + ghcLink = NoLink + } + dynflags''' <- parseGhcFlags dynflags'' restFlags flags + setSessionDynFlags session dynflags''' + return (session, dynflags''') + + +-- | Expose the list of packages to GHC. Then initialize GHC's package state +-- and get the name of the actually loaded packages matching the supplied +-- list of packages. The matching packages might be newer versions of the +-- supplied ones. For each matching package, return its InstalledPackageInfo. + +loadPackages :: Session -> [String] -> IO [InstalledPackageInfo] + +-- It would be better to try to get the "in scope" packages from GHC instead. +-- This would make the -use-package flag unnecessary. But currently it +-- seems all you can get from the GHC api is all packages that are linked in +-- (i.e the closure of the "in scope" packages). + +loadPackages session pkgStrs = do + + -- expose the packages + + dfs <- getSessionDynFlags session + let dfs' = dfs { packageFlags = packageFlags dfs ++ map ExposePackage pkgStrs } + setSessionDynFlags session dfs' + + -- try to parse the packages and get their names, without versions + pkgNames <- mapM (handleParse . unpackPackageId . stringToPackageId) pkgStrs + + -- init GHC's package state + (dfs'', depPackages) <- initPackages dfs' + + -- compute the pkgIds of the loaded packages matching the + -- supplied ones + + let depPkgs = map (fromJust . unpackPackageId) depPackages + matchingPackages = [ mkPackageId pkg | pkg <- depPkgs, + pkgName pkg `elem` pkgNames ] + + -- get InstalledPackageInfos for each package + let pkgInfos = map (getPackageDetails (pkgState dfs'')) matchingPackages + + return pkgInfos + where + handleParse (Just pkg) = return (pkgName pkg) + handleParse Nothing = throwE "Could not parse package identifier" + + +-- | Try to parse dynamic GHC flags +parseGhcFlags dynflags flags origFlags = do + (dynflags', rest) <- parseDynamicFlags dynflags flags + if not (null rest) + then throwE ("Couldn't parse GHC options: " ++ (unwords origFlags)) + else return dynflags' diff --git a/src/Haddock/GHC/Typecheck.hs b/src/Haddock/GHC/Typecheck.hs new file mode 100644 --- /dev/null +++ b/src/Haddock/GHC/Typecheck.hs @@ -0,0 +1,84 @@ +-- +-- Haddock - A Haskell Documentation Tool +-- +-- (c) Simon Marlow 2003 +-- + + +module Haddock.GHC.Typecheck ( + typecheckFiles +) where + + +import Haddock.Exception +import Haddock.Types +import Haddock.GHC.Utils + +import Data.Maybe +import Control.Monad +import GHC +import Digraph +import BasicTypes +import SrcLoc + +import Data.List + + +type CheckedMod = (Module, FilePath, FullyCheckedMod) + + +type FullyCheckedMod = (ParsedSource, + RenamedSource, + TypecheckedSource, + ModuleInfo) + + +-- TODO: make it handle cleanup +typecheckFiles :: Session -> [FilePath] -> IO [GhcModule] +typecheckFiles session files = do + + -- load all argument files + + targets <- mapM (\f -> guessTarget f Nothing) files + setTargets session targets + + flag <- load session LoadAllTargets + when (failed flag) $ + throwE "Failed to load all needed modules" + + modgraph <- getModuleGraph session + + let mods = concatMap flattenSCC $ topSortModuleGraph False modgraph Nothing + getModFile = fromJust . ml_hs_file . ms_location + mods'= [ (ms_mod modsum, ms_hspp_opts modsum, getModFile modsum) | + modsum <- mods ] + + -- typecheck the argument modules + + ghcMods <- forM mods' $ \(mod, flags, file) -> do + mbMod <- checkModule session (moduleName mod) False + case mbMod of + Just (CheckedModule a (Just b) (Just c) (Just d) _) + -> return $ mkGhcModule (mod, file, (a,b,c,d)) flags + _ -> throwE ("Failed to check module: " ++ moduleString mod) + + return ghcMods + +-- | Dig out what we want from the typechecker output +mkGhcModule :: CheckedMod -> DynFlags -> GhcModule +mkGhcModule (mod, file, checkedMod) dynflags = GhcModule { + ghcModule = mod, + ghcFilename = file, + ghcMbDocOpts = mbOpts, + ghcHaddockModInfo = info, + ghcMbDoc = mbDoc, + ghcGroup = group, + ghcMbExports = mbExports, + ghcExportedNames = modInfoExports modInfo, + ghcNamesInScope = fromJust $ modInfoTopLevelScope modInfo, + ghcInstances = modInfoInstances modInfo +} + where + HsModule _ _ _ _ _ mbOpts _ _ = unLoc parsed + (group, _, mbExports, mbDoc, info) = renamed + (parsed, renamed, _, modInfo) = checkedMod diff --git a/src/Haddock/GHC/Utils.hs b/src/Haddock/GHC/Utils.hs new file mode 100644 --- /dev/null +++ b/src/Haddock/GHC/Utils.hs @@ -0,0 +1,89 @@ +-- +-- Haddock - A Haskell Documentation Tool +-- +-- (c) Simon Marlow 2003 +-- + + +module Haddock.GHC.Utils where + + +import Debug.Trace +import Data.Char +import qualified Data.Map as Map + +import GHC +import HsSyn +import SrcLoc +import HscTypes +import Outputable +import Packages +import UniqFM +import Name + + +-- names + +nameOccString = occNameString . nameOccName + + +nameSetMod n newMod = + mkExternalName (nameUnique n) newMod (nameOccName n) (nameSrcSpan n) + + +nameSetPkg pkgId n = + mkExternalName (nameUnique n) (mkModule pkgId (moduleName mod)) + (nameOccName n) (nameSrcSpan n) + where mod = nameModule n + + +-- modules + + +moduleString :: Module -> String +moduleString = moduleNameString . moduleName + + +mkModuleNoPkg :: String -> Module +mkModuleNoPkg str = mkModule (stringToPackageId "") (mkModuleName str) + + +modulePkgStr = packageIdString . modulePackageId + + +-- Instances + + +instance (Outputable a, Outputable b) => Outputable (Map.Map a b) where + ppr m = ppr (Map.toList m) + + +-- misc + + +isNameSym n = isNameVarSym n || isNameConSym n +isNameVarSym = isLexVarSym . occNameFS . nameOccName +isNameConSym = isLexConSym . occNameFS . nameOccName + + +getMainDeclBinder :: HsDecl name -> Maybe name +getMainDeclBinder (TyClD d) = Just (tcdName d) +getMainDeclBinder (ValD d) + = case collectAcc d [] of + [] -> Nothing + (name:_) -> Just (unLoc name) +getMainDeclBinder (SigD d) = sigNameNoLoc d +getMainDeclBinder (ForD (ForeignImport name _ _)) = Just (unLoc name) +getMainDeclBinder (ForD (ForeignExport name _ _)) = Nothing +getMainDeclBinder _ = Nothing + + +-- To keep if if minf_iface is re-introduced +--modInfoName = moduleName . mi_module . minf_iface +--modInfoMod = mi_module . minf_iface + +pretty :: Outputable a => a -> String +pretty x = show (ppr x defaultUserStyle) + + +trace_ppr x y = trace (showSDoc (ppr x)) y diff --git a/src/Haddock/Interface.hs b/src/Haddock/Interface.hs new file mode 100644 --- /dev/null +++ b/src/Haddock/Interface.hs @@ -0,0 +1,90 @@ +-- +-- Haddock - A Haskell Documentation Tool +-- +-- (c) Simon Marlow 2003 +-- + +-- Here we build the actual module interfaces. By interface we mean the +-- information that is used to render a Haddock page for a module. Parts of +-- this information is also stored in the interface files. + + +module Haddock.Interface ( + createInterfaces +) where + + +import Haddock.Interface.Create +import Haddock.Interface.AttachInstances +import Haddock.Interface.Rename +import Haddock.Types +import Haddock.Options +import Haddock.GHC.Utils + +import qualified Data.Map as Map +import Data.Map (Map) +import Data.List +import Control.Monad + +import Name + + +-- | Turn a topologically sorted list of GhcModules into interfaces. Also +-- return the home link environment created in the process, and any error +-- messages. +createInterfaces :: [GhcModule] -> LinkEnv -> [Flag] -> ([Interface], LinkEnv, [ErrMsg]) +createInterfaces modules externalLinks flags = (interfaces, homeLinks, messages) + where + ((interfaces, homeLinks), messages) = runWriter $ do + + -- part 1, create the interfaces + interfaces <- createInterfaces' modules flags + + -- part 2, build the link environment + let homeLinks = buildHomeLinks interfaces + let links = homeLinks `Map.union` externalLinks + let allNames = Map.keys links + + -- part 3, attach the instances + let interfaces' = attachInstances interfaces allNames + + -- part 3, rename the interfaces + interfaces'' <- mapM (renameInterface links) interfaces' + + return (interfaces'', homeLinks) + + +createInterfaces' :: [GhcModule] -> [Flag] -> ErrMsgM [Interface] +createInterfaces' modules flags = do + resultMap <- foldM addInterface Map.empty modules + return (Map.elems resultMap) + where + addInterface :: ModuleMap -> GhcModule -> ErrMsgM ModuleMap + addInterface map mod = do + interface <- createInterface mod flags map + return $ Map.insert (ifaceMod interface) interface map + + +-- | Build a mapping which for each original name, points to the "best" +-- place to link to in the documentation. For the definition of +-- "best", we use "the module nearest the bottom of the dependency +-- graph which exports this name", not including hidden modules. When +-- there are multiple choices, we pick a random one. +-- +-- The interfaces are passed in in topologically sorted order, but we start +-- by reversing the list so we can do a foldl. +buildHomeLinks :: [Interface] -> LinkEnv +buildHomeLinks modules = foldl upd Map.empty (reverse modules) + where + upd old_env mod + | OptHide `elem` ifaceOptions mod = old_env + | OptNotHome `elem` ifaceOptions mod = + foldl' keep_old old_env exported_names + | otherwise = foldl' keep_new old_env exported_names + where + exported_names = ifaceVisibleExports mod + modName = ifaceMod mod + + keep_old env n = Map.insertWith (\new old -> old) n + (nameSetMod n modName) env + keep_new env n = Map.insert n (nameSetMod n modName) env diff --git a/src/Haddock/Interface/AttachInstances.hs b/src/Haddock/Interface/AttachInstances.hs new file mode 100644 --- /dev/null +++ b/src/Haddock/Interface/AttachInstances.hs @@ -0,0 +1,149 @@ +-- +-- Haddock - A Haskell Documentation Tool +-- +-- (c) Simon Marlow 2003 +-- + + +module Haddock.Interface.AttachInstances (attachInstances) where + + +import Haddock.Types +import Haddock.GHC.Utils + +import qualified Data.Map as Map +import Data.Map (Map) +import Data.List + +import GHC +import Name +import SrcLoc +import InstEnv +import Class +import TypeRep +import Var hiding (varName) +import TyCon +import PrelNames +import HscTypes +import FastString +#define FSLIT(x) (mkFastString# (x#)) + + +attachInstances :: [Interface] -> [Name] -> [Interface] +attachInstances modules filterNames = map attach modules + where + instMap = + fmap (map toHsInstHead . sortImage instHead) $ + collectInstances modules filterNames + + attach mod = mod { ifaceExportItems = newItems } + where + newItems = map attachExport (ifaceExportItems mod) + + attachExport (ExportDecl n decl doc _) = + ExportDecl n decl doc (case Map.lookup n instMap of + Nothing -> [] + Just instheads -> instheads) + attachExport otherExport = otherExport + + +-------------------------------------------------------------------------------- +-- Collecting and sorting instances +-------------------------------------------------------------------------------- + + +-- | Simplified type for sorting types, ignoring qualification (not visible +-- in Haddock output) and unifying special tycons with normal ones. +data SimpleType = SimpleType Name [SimpleType] deriving (Eq,Ord) + + +collectInstances + :: [Interface] + -> [Name] + -> Map Name [([TyVar], [PredType], Class, [Type])] -- maps class/type names to instances + +collectInstances modules filterNames + = Map.fromListWith (flip (++)) tyInstPairs `Map.union` + Map.fromListWith (flip (++)) classInstPairs + where + allInstances = concat (map ifaceInstances modules) + classInstPairs = [ (is_cls inst, [instanceHead inst]) | + inst <- allInstances, Just n <- nub (is_tcs inst), + n `elem` filterNames ] + tyInstPairs = [ (tycon, [instanceHead inst]) | inst <- allInstances, + Just tycon <- nub (is_tcs inst) ] + + +instHead :: ([TyVar], [PredType], Class, [Type]) -> ([Int], Name, [SimpleType]) +instHead (_, _, cls, args) + = (map argCount args, className cls, map simplify args) + where + argCount (AppTy t _) = argCount t + 1 + argCount (TyConApp _ ts) = length ts + argCount (FunTy _ _ ) = 2 + argCount (ForAllTy _ t) = argCount t + argCount (NoteTy _ t) = argCount t + argCount _ = 0 + + simplify (ForAllTy _ t) = simplify t + simplify (FunTy t1 t2) = + SimpleType funTyConName [simplify t1, simplify t2] + simplify (AppTy t1 t2) = SimpleType s (args ++ [simplify t2]) + where (SimpleType s args) = simplify t1 + simplify (TyVarTy v) = SimpleType (tyVarName v) [] + simplify (TyConApp tc ts) = SimpleType (tyConName tc) (map simplify ts) + simplify (NoteTy _ t) = simplify t + simplify _ = error "simplify" + + +-- sortImage f = sortBy (\x y -> compare (f x) (f y)) +sortImage :: Ord b => (a -> b) -> [a] -> [a] +sortImage f xs = map snd $ sortBy cmp_fst [(f x, x) | x <- xs] + where cmp_fst (x,_) (y,_) = compare x y + + +funTyConName = mkWiredInName gHC_PRIM + (mkOccNameFS tcName FSLIT("(->)")) + funTyConKey + (ATyCon funTyCon) -- Relevant TyCon + BuiltInSyntax + + +toHsInstHead :: ([TyVar], [PredType], Class, [Type]) -> InstHead Name +toHsInstHead (_, preds, cls, ts) = (map toHsPred preds, className cls, map toHsType ts) + + +-------------------------------------------------------------------------------- +-- Type -> HsType conversion +-------------------------------------------------------------------------------- + + +toHsPred :: PredType -> HsPred Name +toHsPred (ClassP cls ts) = HsClassP (className cls) (map toLHsType ts) +toHsPred (IParam n t) = HsIParam n (toLHsType t) + + +toLHsType = noLoc . toHsType + + +toHsType :: Type -> HsType Name +toHsType t = case t of + TyVarTy v -> HsTyVar (tyVarName v) + AppTy a b -> HsAppTy (toLHsType a) (toLHsType b) + + TyConApp tc ts -> case ts of + t1:t2:rest + | isNameConSym . tyConName $ tc -> + app (HsOpTy (toLHsType t1) (noLoc . tyConName $ tc) (toLHsType t2)) rest + _ -> app (tycon tc) ts + + FunTy a b -> HsFunTy (toLHsType a) (toLHsType b) + ForAllTy v t -> cvForAll [v] t + PredTy p -> HsPredTy (toHsPred p) + NoteTy _ t -> toHsType t + where + tycon tc = HsTyVar (tyConName tc) + app tc ts = foldl (\a b -> HsAppTy (noLoc a) (noLoc b)) tc (map toHsType ts) + cvForAll vs (ForAllTy v t) = cvForAll (v:vs) t + cvForAll vs t = mkExplicitHsForAllTy (tyvarbinders vs) (noLoc []) (toLHsType t) + tyvarbinders vs = map (noLoc . UserTyVar . tyVarName) vs diff --git a/src/Haddock/Interface/Create.hs b/src/Haddock/Interface/Create.hs new file mode 100644 --- /dev/null +++ b/src/Haddock/Interface/Create.hs @@ -0,0 +1,569 @@ +-- +-- Haddock - A Haskell Documentation Tool +-- +-- (c) Simon Marlow 2003 +-- + + +module Haddock.Interface.Create (createInterface) where + + +import Haddock.Types +import Haddock.Options +import Haddock.GHC.Utils +import Haddock.Utils + +import qualified Data.Map as Map +import Data.Map (Map) +import Data.List +import Data.Maybe +import Data.Char +import Data.Ord +import Control.Monad + +import GHC +import Outputable +import SrcLoc +import Name +import Module +import InstEnv +import Class +import TypeRep +import Var hiding (varName) +import TyCon +import PrelNames +import Bag +import HscTypes +import Util (handleDyn) +import ErrUtils (printBagOfErrors) +import FastString +#define FSLIT(x) (mkFastString# (x#)) + + +-- | Process the data in the GhcModule to produce an interface. +-- To do this, we need access to already processed modules in the topological +-- sort. That's what's in the module map. +createInterface :: GhcModule -> [Flag] -> ModuleMap -> ErrMsgM Interface +createInterface ghcMod flags modMap = do + + let mod = ghcModule ghcMod + + opts0 <- mkDocOpts (ghcMbDocOpts ghcMod) flags mod + let opts + | Flag_IgnoreAllExports `elem` flags = OptIgnoreExports : opts0 + | otherwise = opts0 + + let group = ghcGroup ghcMod + entities = (nubBy sameName . getTopEntities) group + exports = fmap (reverse . map unLoc) (ghcMbExports ghcMod) + entityNames_ = entityNames entities + subNames = allSubNames group + localNames = entityNames_ ++ subNames + subMap = mkSubMap group + expDeclMap = mkDeclMap (ghcExportedNames ghcMod) group + localDeclMap = mkDeclMap entityNames_ group + docMap = mkDocMap group + ignoreExps = Flag_IgnoreAllExports `elem` flags + exportedNames = ghcExportedNames ghcMod + origEnv = Map.fromList [ (nameOccName n, n) | n <- exportedNames ] + + visibleNames <- mkVisibleNames mod modMap localNames + (ghcNamesInScope ghcMod) + subMap exports opts localDeclMap + + exportItems <- mkExportItems modMap mod (ghcExportedNames ghcMod) + expDeclMap localDeclMap subMap entities + opts exports ignoreExps docMap + + -- prune the export list to just those declarations that have + -- documentation, if the 'prune' option is on. + let + prunedExportItems + | OptPrune `elem` opts = pruneExportItems exportItems + | otherwise = exportItems + + return Interface { + ifaceMod = mod, + ifaceOrigFilename = ghcFilename ghcMod, + ifaceInfo = ghcHaddockModInfo ghcMod, + ifaceDoc = ghcMbDoc ghcMod, + ifaceRnDoc = Nothing, + ifaceOptions = opts, + ifaceLocals = localNames, + ifaceDocMap = docMap, + ifaceRnDocMap = Map.empty, + ifaceSubMap = subMap, + ifaceExportItems = prunedExportItems, + ifaceRnExportItems = [], + ifaceEnv = origEnv, + ifaceExports = exportedNames, + ifaceVisibleExports = visibleNames, + ifaceExportedDeclMap = expDeclMap, + ifaceInstances = ghcInstances ghcMod + } + + +------------------------------------------------------------------------------- +-- Doc options +-- +-- Haddock options that are embedded in the source file +------------------------------------------------------------------------------- + + +mkDocOpts :: Maybe String -> [Flag] -> Module -> ErrMsgM [DocOption] +mkDocOpts mbOpts flags mod = do + opts <- case mbOpts of + Just opts -> case words $ replace ',' ' ' opts of + [] -> tell ["No option supplied to DOC_OPTION/doc_option"] >> return [] + xs -> liftM catMaybes (mapM parseOption xs) + Nothing -> return [] + if Flag_HideModule (moduleString mod) `elem` flags + then return $ OptHide : opts + else return opts + + +parseOption :: String -> ErrMsgM (Maybe DocOption) +parseOption "hide" = return (Just OptHide) +parseOption "prune" = return (Just OptPrune) +parseOption "ignore-exports" = return (Just OptIgnoreExports) +parseOption "not-home" = return (Just OptNotHome) +parseOption other = tell ["Unrecognised option: " ++ other] >> return Nothing + + +-------------------------------------------------------------------------------- +-- Source code entities +-- +-- An entity is a Haskell declaration or a Haddock comment. We need to extract +-- entities out of classes and top levels since we need them in the interface. +-------------------------------------------------------------------------------- + + +data Entity = DocEntity (DocDecl Name) | DeclEntity Name +data LEntity = Located Entity + +sameName (DocEntity _) _ = False +sameName (DeclEntity _) (DocEntity _) = False +sameName (DeclEntity a) (DeclEntity b) = a == b + + +sortByLoc = map unLoc . sortBy (comparing getLoc) + + +-- | Get all the entities in a class. The entities are sorted by their +-- SrcLoc. +getClassEntities tcd = sortByLoc (docs ++ meths ++ sigs) + where + docs = [ L l (DocEntity d) | L l d <- tcdDocs tcd ] + + meths = + let bindings = bagToList (tcdMeths tcd) + bindingName = unLoc . fun_id + in [ L l (DeclEntity (bindingName b)) | L l b <- bindings ] + + -- TODO: fixities + sigs = [ L l $ DeclEntity name | L l (TypeSig (L _ name) _) <- tcdSigs tcd ] + + +-- | Get all the top level entities in a module. The entities are sorted by +-- their SrcLoc. +getTopEntities :: HsGroup Name -> [Entity] +getTopEntities group = sortByLoc (docs ++ declarations) + where + docs = [ L l (DocEntity d) | L l d <- hs_docs group ] + + declarations = [ L l (DeclEntity n) | (l, n) <- valds ++ tyclds ++ fords ] + where + valds = let ValBindsOut _ sigs = hs_valds group + -- we just use the sigs here for now. + -- TODO: collect from the bindings as well + -- (needed for docs to work for inferred entities) + in [ (l, fromJust (sigNameNoLoc s)) | L l s <- sigs, + isVanillaLSig (L l s) ] -- TODO: document fixity decls + tyclds = [ (l, tcdName t) | L l t <- hs_tyclds group ] + fords = [ (l, forName f) | L l f <- hs_fords group ] + where + forName (ForeignImport name _ _) = unLoc name + forName (ForeignExport name _ _) = unLoc name + + +-------------------------------------------------------------------------------- +-- Collect docs +-- +-- To be able to attach the right Haddock comment to the right declaration, +-- we sort the entities by their SrcLoc and "collect" the docs for each +-- declaration. +-------------------------------------------------------------------------------- + + +-- | Collect the docs and attach them to the right name +collectDocs :: [Entity] -> [(Name, HsDoc Name)] +collectDocs entities = collect Nothing DocEmpty entities + + +collect :: Maybe Entity -> HsDoc Name -> [Entity] -> [(Name, HsDoc Name)] +collect d doc_so_far [] = + case d of + Nothing -> [] + Just d0 -> finishedDoc d0 doc_so_far [] + +collect d doc_so_far (e:es) = + case e of + DocEntity (DocCommentNext str) -> + case d of + Nothing -> collect d (docAppend doc_so_far str) es + Just d0 -> finishedDoc d0 doc_so_far (collect Nothing str es) + + DocEntity (DocCommentPrev str) -> collect d (docAppend doc_so_far str) es + + _ -> case d of + Nothing -> collect (Just e) doc_so_far es + Just d0 + | sameName d0 e -> collect d doc_so_far es + | otherwise -> finishedDoc d0 doc_so_far (collect (Just e) DocEmpty es) + + +finishedDoc :: Entity -> HsDoc Name -> [(Name, HsDoc Name)] -> + [(Name, HsDoc Name)] +finishedDoc d DocEmpty rest = rest +finishedDoc (DeclEntity name) doc rest = (name, doc) : rest +finishedDoc _ _ rest = rest + + +------------------------------------------------------------------------------- +-- +------------------------------------------------------------------------------- + + +-- This map includes everything that can be exported separately, +-- that means: top declarations, class methods and record selectors +-- TODO: merge this with mkDeclMap and the extractXXX functions +mkDocMap :: HsGroup Name -> Map Name (HsDoc Name) +mkDocMap group = Map.fromList (topDeclDocs ++ classMethDocs ++ recordFieldDocs) + where + tyclds = map unLoc (hs_tyclds group) + classes = filter isClassDecl tyclds + datadecls = filter isDataDecl tyclds + constrs = [ con | d <- datadecls, L _ con <- tcdCons d ] + fields = concat [ fields | RecCon fields <- map con_details constrs] + + topDeclDocs = collectDocs (getTopEntities group) + classMethDocs = concatMap (collectDocs . getClassEntities) classes + + recordFieldDocs = [ (unLoc lname, doc) | + ConDeclField lname _ (Just (L _ doc)) <- fields ] + + +allSubNames :: HsGroup Name -> [Name] +allSubNames group = + concat [ tail (map unLoc (tyClDeclNames tycld)) | L _ tycld <- hs_tyclds group ] + + +mkSubMap :: HsGroup Name -> Map Name [Name] +mkSubMap group = Map.fromList [ (name, subs) | L _ tycld <- hs_tyclds group, + let name:subs = map unLoc (tyClDeclNames tycld) ] + + +mkDeclMap :: [Name] -> HsGroup Name -> Map Name (LHsDecl Name) +mkDeclMap names group = Map.fromList [ (n,d) | (n,Just d) <- maybeDecls ] + where + maybeDecls = [ (name, getDeclFromGroup group name) | name <- names ] + + +entityNames :: [Entity] -> [Name] +entityNames entities = [ name | DeclEntity name <- entities ] +{- +getValSig :: Name -> HsValBinds Name -> TypeEnv -> Maybe (LSig Name) +getValSig name (ValBindsOut recsAndBinds _) typEnv = case matchingBinds of + [bind] -> -- OK we have found a binding that matches. Now look up the + -- type, even though it may be present in the ValBindsOut + let tything = lookupTypeEnv typeEnv name + _ -> Nothing + where + binds = snd $ unzip recsAndBinds + matchingBinds = Bag.filter matchesName binds + matchesName (L _ bind) = fun_id bind == name +getValSig _ _ _ = error "getValSig" +-} + + +getDeclFromGroup :: HsGroup Name -> Name -> Maybe (LHsDecl Name) +getDeclFromGroup group name = + case catMaybes [ getDeclFromVals (hs_valds group), + getDeclFromTyCls (hs_tyclds group), + getDeclFromFors (hs_fords group) ] of + [decl] -> Just decl + _ -> Nothing + where + getDeclFromVals (ValBindsOut _ lsigs) = case matching of + [lsig] -> Just (L (getLoc lsig) (SigD (unLoc lsig))) + _ -> Nothing + where + matching = [ s | s@(L l (TypeSig (L _ n) _)) <- lsigs, n == name ] + + getDeclFromVals _ = error "getDeclFromVals: illegal input" + +{- getDeclFromVals (ValBindsOut recsAndbinds _) = + let binds = snd $ unzip recsAndBinds + matchingBinds = Bag.filter matchesName binds + matchesName (L _ bind) = fun_id bind == name + in case matchingBinds of + [bind] -> -- OK we have found a binding that matches. Now look up the + -- type, even though it may be present in the ValBindsOut + + _ -> Nothing + where + matching = [ lsig | lsig <- lsigs, let Just n = sigName lsig, n == name ] + getDeclFromVals _ = error "getDeclFromVals: illegal input" + -} + getDeclFromTyCls ltycls = case matching of + [ltycl] -> Just (L (getLoc ltycl) (TyClD (unLoc ltycl))) + _ -> Nothing + where + matching = [ fmap makeVanillaClass ltycl | ltycl <- ltycls, + name `elem` (map unLoc . tyClDeclNames . unLoc $ ltycl)] + where + makeVanillaClass tycl + | isClassDecl tycl = tycl { tcdSigs = filter isVanillaLSig (tcdSigs tycl) } + | otherwise = tycl + + getDeclFromFors lfors = case matching of + [for] -> Just (L (getLoc for) (ForD (unLoc for))) + _ -> Nothing + where + matching = [ for | for <- lfors, forName (unLoc for) == name ] + forName (ForeignExport n _ _) = unLoc n + forName (ForeignImport n _ _) = unLoc n + + +-- | Build the list of items that will become the documentation, from the +-- export list. At this point, the list of ExportItems is in terms of +-- original names. +mkExportItems + :: ModuleMap + -> Module -- this module + -> [Name] -- exported names (orig) + -> Map Name (LHsDecl Name) -- maps exported names to declarations + -> Map Name (LHsDecl Name) -- maps local names to declarations + -> Map Name [Name] -- sub-map for this module + -> [Entity] -- entities in the current module + -> [DocOption] + -> Maybe [IE Name] + -> Bool -- --ignore-all-exports flag + -> Map Name (HsDoc Name) + -> ErrMsgM [ExportItem Name] + +mkExportItems modMap this_mod exported_names exportedDeclMap localDeclMap sub_map entities + opts maybe_exps ignore_all_exports docMap + | isNothing maybe_exps || ignore_all_exports || OptIgnoreExports `elem` opts + = everything_local_exported + | Just specs <- maybe_exps = do + exps <- mapM lookupExport specs + return (concat exps) + where + everything_local_exported = -- everything exported + return (fullContentsOfThisModule this_mod entities localDeclMap docMap) + + packageId = modulePackageId this_mod + + lookupExport (IEVar x) = declWith x + lookupExport (IEThingAbs t) = declWith t + lookupExport (IEThingAll t) = declWith t + lookupExport (IEThingWith t cs) = declWith t + lookupExport (IEModuleContents m) = fullContentsOf (mkModule packageId m) + lookupExport (IEGroup lev doc) = return [ ExportGroup lev "" doc ] + lookupExport (IEDoc doc) = return [ ExportDoc doc ] + lookupExport (IEDocNamed str) + = do r <- findNamedDoc str entities + case r of + Nothing -> return [] + Just found -> return [ ExportDoc found ] + + declWith :: Name -> ErrMsgM [ ExportItem Name ] + declWith t + | (Just decl, maybeDoc) <- findDecl t + = return [ ExportDecl t (restrictTo subs (extractDecl t mdl decl)) maybeDoc [] ] + | otherwise + = return [] + where + mdl = nameModule t + subs = filter (`elem` exported_names) all_subs + all_subs | mdl == this_mod = Map.findWithDefault [] t sub_map + | otherwise = allSubsOfName modMap t + + fullContentsOf m + | m == this_mod = return (fullContentsOfThisModule this_mod entities localDeclMap docMap) + | otherwise = + case Map.lookup m modMap of + Just iface + | OptHide `elem` ifaceOptions iface + -> return (ifaceExportItems iface) + | otherwise -> return [ ExportModule m ] + Nothing -> return [] -- already emitted a warning in visibleNames + + findDecl :: Name -> (Maybe (LHsDecl Name), Maybe (HsDoc Name)) + findDecl n | not (isExternalName n) = error "This shouldn't happen" + findDecl n + | m == this_mod = (Map.lookup n exportedDeclMap, Map.lookup n docMap) + | otherwise = + case Map.lookup m modMap of + Just iface -> (Map.lookup n (ifaceExportedDeclMap iface), + Map.lookup n (ifaceDocMap iface)) + Nothing -> (Nothing, Nothing) + where + m = nameModule n + + +fullContentsOfThisModule :: Module -> [Entity] -> Map Name (LHsDecl Name) -> + Map Name (HsDoc Name) -> [ExportItem Name] +fullContentsOfThisModule module_ entities declMap docMap + = catMaybes (map mkExportItem entities) + where + mkExportItem (DocEntity (DocGroup lev doc)) = Just (ExportGroup lev "" doc) + mkExportItem (DeclEntity name) = fmap mkExport (Map.lookup name declMap) + where mkExport decl = ExportDecl name decl (Map.lookup name docMap) [] + mkExportItem _ = Nothing + + +-- | Sometimes the declaration we want to export is not the "main" declaration: +-- it might be an individual record selector or a class method. In these +-- cases we have to extract the required declaration (and somehow cobble +-- together a type signature for it...) +extractDecl :: Name -> Module -> LHsDecl Name -> LHsDecl Name +extractDecl name mdl decl + | Just n <- getMainDeclBinder (unLoc decl), n == name = decl + | otherwise = + case unLoc decl of + TyClD d | isClassDecl d -> + let matches = [ sig | sig <- tcdSigs d, sigName sig == Just name, + isVanillaLSig sig ] -- TODO: document fixity + in case matches of + [s0] -> let (n, tyvar_names) = name_and_tyvars d + L pos sig = extractClassDecl n mdl tyvar_names s0 + in L pos (SigD sig) + _ -> error "internal: extractDecl" + TyClD d | isDataDecl d -> + let (n, tyvar_names) = name_and_tyvars d + L pos sig = extractRecSel name mdl n tyvar_names (tcdCons d) + in L pos (SigD sig) + _ -> error "internal: extractDecl" + where + name_and_tyvars d = (unLoc (tcdLName d), hsLTyVarLocNames (tcdTyVars d)) + + +toTypeNoLoc :: Located Name -> LHsType Name +toTypeNoLoc lname = noLoc (HsTyVar (unLoc lname)) + + +rmLoc :: Located a -> Located a +rmLoc a = noLoc (unLoc a) + + +extractClassDecl :: Name -> Module -> [Located Name] -> LSig Name -> LSig Name +extractClassDecl c mdl tvs0 (L pos (TypeSig lname ltype)) = case ltype of + L _ (HsForAllTy exp tvs (L _ preds) ty) -> + L pos (TypeSig lname (noLoc (HsForAllTy exp tvs (lctxt preds) ty))) + _ -> L pos (TypeSig lname (noLoc (mkImplicitHsForAllTy (lctxt []) ltype))) + where + lctxt preds = noLoc (ctxt preds) + ctxt preds = [noLoc (HsClassP c (map toTypeNoLoc tvs0))] ++ preds + +extractClassDecl _ _ _ d = error $ "extractClassDecl: unexpected decl" + + +extractRecSel :: Name -> Module -> Name -> [Located Name] -> [LConDecl Name] + -> LSig Name +extractRecSel _ _ _ _ [] = error "extractRecSel: selector not found" + +extractRecSel nm mdl t tvs (L _ con : rest) = + case con_details con of + RecCon fields | (ConDeclField n ty _ : _) <- matching_fields fields -> + L (getLoc n) (TypeSig (noLoc nm) (noLoc (HsFunTy data_ty (getBangType ty)))) + _ -> extractRecSel nm mdl t tvs rest + where + matching_fields flds = [ f | f@(ConDeclField n _ _) <- flds, (unLoc n) == nm ] + data_ty = foldl (\x y -> noLoc (HsAppTy x y)) (noLoc (HsTyVar t)) (map toTypeNoLoc tvs) + + +-- Pruning +pruneExportItems :: [ExportItem Name] -> [ExportItem Name] +pruneExportItems items = filter hasDoc items + where hasDoc (ExportDecl _ _ d _) = isJust d + hasDoc _ = True + + +-- | Gather a list of original names exported from this module +mkVisibleNames :: Module + -> ModuleMap + -> [Name] + -> [Name] + -> Map Name [Name] + -> Maybe [IE Name] + -> [DocOption] + -> Map Name (LHsDecl Name) + -> ErrMsgM [Name] + +mkVisibleNames mdl modMap localNames scope subMap maybeExps opts declMap + -- if no export list, just return all local names + | Nothing <- maybeExps = return (filter hasDecl localNames) + | OptIgnoreExports `elem` opts = return localNames + | Just expspecs <- maybeExps = do + visibleNames <- mapM extract expspecs + return $ filter isNotPackageName (concat visibleNames) + where + hasDecl name = isJust (Map.lookup name declMap) + isNotPackageName name = nameMod == mdl || isJust (Map.lookup nameMod modMap) + where nameMod = nameModule name + + extract e = + case e of + IEVar x -> return [x] + IEThingAbs t -> return [t] + IEThingAll t -> return (t : all_subs) + where + all_subs | nameModule t == mdl = Map.findWithDefault [] t subMap + | otherwise = allSubsOfName modMap t + + IEThingWith t cs -> return (t : cs) + + IEModuleContents m + | mkModule (modulePackageId mdl) m == mdl -> return localNames + | otherwise -> let m' = mkModule (modulePackageId mdl) m in + case Map.lookup m' modMap of + Just mod + | OptHide `elem` ifaceOptions mod -> + return (filter (`elem` scope) (ifaceExports mod)) + | otherwise -> return [] + Nothing + -> tell (exportModuleMissingErr mdl m') >> return [] + + _ -> return [] + + +exportModuleMissingErr this mdl + = ["Warning: in export list of " ++ show (moduleString this) + ++ ": module not found: " ++ show (moduleString mdl)] + + +-- | For a given entity, find all the names it "owns" (ie. all the +-- constructors and field names of a tycon, or all the methods of a +-- class). +allSubsOfName :: ModuleMap -> Name -> [Name] +allSubsOfName modMap name + | isExternalName name = + case Map.lookup (nameModule name) modMap of + Just iface -> Map.findWithDefault [] name (ifaceSubMap iface) + Nothing -> [] + | otherwise = error $ "Main.allSubsOfName: unexpected unqual'd name" + + +-- Named documentation + +findNamedDoc :: String -> [Entity] -> ErrMsgM (Maybe (HsDoc Name)) +findNamedDoc name entities = search entities + where search [] = do + tell ["Cannot find documentation for: $" ++ name] + return Nothing + search ((DocEntity (DocCommentNamed name' doc)):rest) + | name == name' = return (Just doc) + | otherwise = search rest + search (_other_decl : rest) = search rest diff --git a/src/Haddock/Interface/Rename.hs b/src/Haddock/Interface/Rename.hs new file mode 100644 --- /dev/null +++ b/src/Haddock/Interface/Rename.hs @@ -0,0 +1,387 @@ +-- +-- Haddock - A Haskell Documentation Tool +-- +-- (c) Simon Marlow 2003 +-- + + +module Haddock.Interface.Rename (renameInterface) where + + +import Haddock.Types +import Haddock.GHC.Utils + +import GHC hiding (NoLink) +import Name +import BasicTypes +import SrcLoc +import Bag (emptyBag) +import Outputable +import Util (thenCmp) + +import Data.List +import Data.Map (Map) +import qualified Data.Map as Map hiding ( Map ) +import Prelude hiding (mapM) +import Data.Traversable (mapM) +import Control.Arrow +import Control.Monad hiding (mapM) + + +renameInterface :: LinkEnv -> Interface -> ErrMsgM Interface +renameInterface renamingEnv mod = + + -- first create the local env, where every name exported by this module + -- is mapped to itself, and everything else comes from the global renaming + -- env + let localEnv = foldl fn renamingEnv (ifaceVisibleExports mod) + where fn env name = Map.insert name (nameSetMod name (ifaceMod mod)) env + + docs = Map.toList (ifaceDocMap mod) + renameMapElem (k,d) = do d' <- renameDoc d; return (k, d') + + -- rename names in the exported declarations to point to things that + -- are closer to, or maybe even exported by, the current module. + (renamedExportItems, missingNames1) + = runRnFM localEnv (renameExportItems (ifaceExportItems mod)) + + (rnDocMap, missingNames2) + = runRnFM localEnv (liftM Map.fromList (mapM renameMapElem docs)) + + (finalModuleDoc, missingNames3) + = runRnFM localEnv (renameMaybeDoc (ifaceDoc mod)) + + -- combine the missing names and filter out the built-ins, which would + -- otherwise allways be missing. + missingNames = nub $ filter isExternalName + (missingNames1 ++ missingNames2 ++ missingNames3) + + -- filter out certain built in type constructors using their string + -- representation. TODO: use the Name constants from the GHC API. +-- strings = filter (`notElem` ["()", "[]", "(->)"]) +-- (map pretty missingNames) + strings = map pretty . filter (\n -> not (isSystemName n || isBuiltInSyntax n)) $ missingNames + + in do + -- report things that we couldn't link to. Only do this for non-hidden + -- modules. + when (OptHide `notElem` ifaceOptions mod && not (null strings)) $ + tell ["Warning: " ++ show (ppr (ifaceMod mod) defaultUserStyle) ++ + ": could not find link destinations for:\n"++ + " " ++ concat (map (' ':) strings) ] + + return $ mod { ifaceRnDoc = finalModuleDoc, + ifaceRnDocMap = rnDocMap, + ifaceRnExportItems = renamedExportItems } + + +-------------------------------------------------------------------------------- +-- Monad for renaming +-- +-- The monad does two things for us: it passes around the environment for +-- renaming, and it returns a list of names which couldn't be found in +-- the environment. +-------------------------------------------------------------------------------- + + +newtype GenRnM n a = + RnM { unRn :: (n -> (Bool, DocName)) -- name lookup function + -> (a,[n]) + } + +type RnM a = GenRnM Name a + +instance Monad (GenRnM n) where + (>>=) = thenRn + return = returnRn + +returnRn :: a -> GenRnM n a +returnRn a = RnM (\_ -> (a,[])) +thenRn :: GenRnM n a -> (a -> GenRnM n b) -> GenRnM n b +m `thenRn` k = RnM (\lkp -> case unRn m lkp of + (a,out1) -> case unRn (k a) lkp of + (b,out2) -> (b,out1++out2)) + +getLookupRn :: RnM (Name -> (Bool, DocName)) +getLookupRn = RnM (\lkp -> (lkp,[])) +outRn :: Name -> RnM () +outRn name = RnM (\_ -> ((),[name])) + +lookupRn :: (DocName -> a) -> Name -> RnM a +lookupRn and_then name = do + lkp <- getLookupRn + case lkp name of + (False,maps_to) -> do outRn name; return (and_then maps_to) + (True, maps_to) -> return (and_then maps_to) + + +runRnFM :: LinkEnv -> RnM a -> (a,[Name]) +runRnFM env rn = unRn rn lkp + where + lkp n = case Map.lookup n env of + Nothing -> (False, NoLink n) + Just q -> (True, Link q) + + +-------------------------------------------------------------------------------- +-- Renaming +-------------------------------------------------------------------------------- + + +keep n = NoLink n +keepL (L loc n) = L loc (NoLink n) + + +rename = lookupRn id +renameL (L loc name) = return . L loc =<< rename name + + +renameExportItems :: [ExportItem Name] -> RnM [ExportItem DocName] +renameExportItems items = mapM renameExportItem items + + +renameMaybeDoc :: Maybe (HsDoc Name) -> RnM (Maybe (HsDoc DocName)) +renameMaybeDoc mbDoc = mapM renameDoc mbDoc + + +renameLDoc (L loc doc) = return . L loc =<< renameDoc doc + + +renameDoc :: HsDoc Name -> RnM (HsDoc DocName) +renameDoc doc = case doc of + DocEmpty -> return DocEmpty + DocAppend a b -> do + a' <- renameDoc a + b' <- renameDoc b + return (DocAppend a' b') + DocString str -> return (DocString str) + DocParagraph doc -> do + doc' <- renameDoc doc + return (DocParagraph doc') + DocIdentifier ids -> do + lkp <- getLookupRn + case [ n | (True, n) <- map lkp ids ] of + ids'@(_:_) -> return (DocIdentifier ids') + [] -> return (DocIdentifier (map NoLink ids)) + DocModule str -> return (DocModule str) + DocEmphasis doc -> do + doc' <- renameDoc doc + return (DocEmphasis doc') + DocMonospaced doc -> do + doc' <- renameDoc doc + return (DocMonospaced doc') + DocUnorderedList docs -> do + docs' <- mapM renameDoc docs + return (DocUnorderedList docs') + DocOrderedList docs -> do + docs' <- mapM renameDoc docs + return (DocOrderedList docs') + DocDefList docs -> do + docs' <- mapM (\(a,b) -> do + a' <- renameDoc a + b' <- renameDoc b + return (a',b')) docs + return (DocDefList docs') + DocCodeBlock doc -> do + doc' <- renameDoc doc + return (DocCodeBlock doc') + DocURL str -> return (DocURL str) + DocAName str -> return (DocAName str) + + +renameLPred (L loc p) = return . L loc =<< renamePred p + + +renamePred :: HsPred Name -> RnM (HsPred DocName) +renamePred (HsClassP name types) = do + name' <- rename name + types' <- mapM renameLType types + return (HsClassP name' types') +renamePred (HsEqualP type1 type2) = do + type1' <- renameLType type1 + type2' <- renameLType type2 + return (HsEqualP type1' type2') +renamePred (HsIParam (IPName name) t) = do + name' <- rename name + t' <- renameLType t + return (HsIParam (IPName name') t') + + +renameLType (L loc t) = return . L loc =<< renameType t + + +renameType t = case t of + HsForAllTy expl tyvars lcontext ltype -> do + tyvars' <- mapM renameLTyVarBndr tyvars + lcontext' <- renameLContext lcontext + ltype' <- renameLType ltype + return (HsForAllTy expl tyvars' lcontext' ltype') + + HsTyVar n -> return . HsTyVar =<< rename n + HsBangTy b ltype -> return . HsBangTy b =<< renameLType ltype + + HsAppTy a b -> do + a' <- renameLType a + b' <- renameLType b + return (HsAppTy a' b') + + HsFunTy a b -> do + a' <- renameLType a + b' <- renameLType b + return (HsFunTy a' b') + + HsListTy t -> return . HsListTy =<< renameLType t + HsPArrTy t -> return . HsPArrTy =<< renameLType t + + HsTupleTy b ts -> return . HsTupleTy b =<< mapM renameLType ts + + HsOpTy a (L loc op) b -> do + op' <- rename op + a' <- renameLType a + b' <- renameLType b + return (HsOpTy a' (L loc op') b') + + HsParTy t -> return . HsParTy =<< renameLType t + + HsNumTy n -> return (HsNumTy n) + + HsPredTy p -> return . HsPredTy =<< renamePred p + + HsKindSig t k -> do + t' <- renameLType t + return (HsKindSig t' k) + + HsDocTy t doc -> do + t' <- renameLType t + doc' <- renameLDoc doc + return (HsDocTy t' doc') + + _ -> error "renameType" + + +renameLTyVarBndr (L loc tv) = do + name' <- rename (hsTyVarName tv) + return $ L loc (replaceTyVarName tv name') + + +renameLContext (L loc context) = do + context' <- mapM renameLPred context + return (L loc context') + + +renameInstHead :: InstHead Name -> RnM (InstHead DocName) +renameInstHead (preds, className, types) = do + preds' <- mapM renamePred preds + className' <- rename className + types' <- mapM renameType types + return (preds', className', types') + + +renameLDecl (L loc d) = return . L loc =<< renameDecl d + + +renameDecl d = case d of + TyClD d -> do + d' <- renameTyClD d + return (TyClD d') + SigD s -> do + s' <- renameSig s + return (SigD s') + ForD d -> do + d' <- renameForD d + return (ForD d') + _ -> error "renameDecl" + + +renameTyClD d = case d of + ForeignType _ _ _ -> error "renameTyClD" -- I'm guessing these can't be exported + -- ForeignType name a b -> do + -- name' <- renameL name + -- return (ForeignType name' a b) + + TyData x lcontext lname ltyvars _ k cons _ -> do + lcontext' <- renameLContext lcontext + ltyvars' <- mapM renameLTyVarBndr ltyvars + cons' <- mapM renameLCon cons + -- I don't think we need the derivings, so we return Nothing + -- We skip the type patterns too. TODO: find out what they are :-) + return (TyData x lcontext' (keepL lname) ltyvars' Nothing k cons' Nothing) + + TySynonym lname ltyvars typat ltype -> do + ltyvars' <- mapM renameLTyVarBndr ltyvars + ltype' <- renameLType ltype + -- We skip type patterns here as well. + return (TySynonym (keepL lname) ltyvars' Nothing ltype') + + ClassDecl lcontext lname ltyvars lfundeps lsigs _ _ _ -> do + lcontext' <- renameLContext lcontext + ltyvars' <- mapM renameLTyVarBndr ltyvars + lfundeps' <- mapM renameLFunDep lfundeps + lsigs' <- mapM renameLSig lsigs + -- we don't need the default methods or the already collected doc entities + -- we skip the ATs for now. + return (ClassDecl lcontext' (keepL lname) ltyvars' lfundeps' lsigs' emptyBag [] []) + + where + renameLCon (L loc con) = return . L loc =<< renameCon con + renameCon (ConDecl lname expl ltyvars lcontext details restype mbldoc) = do + ltyvars' <- mapM renameLTyVarBndr ltyvars + lcontext' <- renameLContext lcontext + details' <- renameDetails details + restype' <- renameResType restype + mbldoc' <- mapM renameLDoc mbldoc + return (ConDecl (keepL lname) expl ltyvars' lcontext' details' restype' mbldoc') + + renameDetails (RecCon fields) = return . RecCon =<< mapM renameField fields + renameDetails (PrefixCon ps) = return . PrefixCon =<< mapM renameLType ps + renameDetails (InfixCon a b) = do + a' <- renameLType a + b' <- renameLType b + return (InfixCon a' b') + + renameField (ConDeclField name t doc) = do + t' <- renameLType t + doc' <- mapM renameLDoc doc + return (ConDeclField (keepL name) t' doc') + + renameResType (ResTyH98) = return ResTyH98 + renameResType (ResTyGADT t) = return . ResTyGADT =<< renameLType t + + renameLFunDep (L loc (xs, ys)) = return (L loc (map keep xs, map keep ys)) + + renameLSig (L loc sig) = return . L loc =<< renameSig sig + + +renameSig sig = case sig of + TypeSig (L loc name) ltype -> do + ltype' <- renameLType ltype + return (TypeSig (L loc (keep name)) ltype') + -- we have filtered out all other kinds of signatures in Interface.Create + + +renameForD (ForeignImport lname ltype x) = do + ltype' <- renameLType ltype + return (ForeignImport (keepL lname) ltype' x) +renameForD (ForeignExport lname ltype x) = do + ltype' <- renameLType ltype + return (ForeignExport (keepL lname) ltype' x) + + +renameExportItem :: ExportItem Name -> RnM (ExportItem DocName) +renameExportItem item = case item of + ExportModule mod -> return (ExportModule mod) + ExportGroup lev id doc -> do + doc' <- renameDoc doc + return (ExportGroup lev id doc') + ExportDecl x decl doc instances -> do + decl' <- renameLDecl decl + doc' <- mapM renameDoc doc + instances' <- mapM renameInstHead instances + return (ExportDecl x decl' doc' instances') + ExportNoDecl x y subs -> do + y' <- lookupRn id y + subs' <- mapM (lookupRn id) subs + return (ExportNoDecl x y' subs') + ExportDoc doc -> do + doc' <- renameDoc doc + return (ExportDoc doc') diff --git a/src/Haddock/InterfaceFile.hs b/src/Haddock/InterfaceFile.hs new file mode 100644 --- /dev/null +++ b/src/Haddock/InterfaceFile.hs @@ -0,0 +1,394 @@ +-- +-- Haddock - A Haskell Documentation Tool +-- +-- (c) Simon Marlow 2003 +-- + + +module Haddock.InterfaceFile ( + InterfaceFile(..), + readInterfaceFile, + writeInterfaceFile +) where + + +import Haddock.Types +import Haddock.Exception + +import Data.List +import Data.Word +import Data.Array +import Data.IORef +import qualified Data.Map as Map +import System.IO +import Control.Monad + +import GHC hiding (NoLink) +import SrcLoc (noSrcSpan) -- tmp, GHC now exports this +import Binary +import Name +import UniqSupply +import UniqFM +import IfaceEnv +import Module +import Packages +import HscTypes +import FastMutInt +import InstEnv +import HsDoc + + +data InterfaceFile = InterfaceFile { + ifLinkEnv :: LinkEnv, + ifInstalledIfaces :: [InstalledInterface] +} + + +binaryInterfaceMagic = 0xD0Cface :: Word32 +binaryInterfaceVersion = 0 :: Word16 + + +initBinMemSize = (1024*1024) :: Int + + +writeInterfaceFile :: FilePath -> InterfaceFile -> IO () +writeInterfaceFile filename iface = do + bh <- openBinMem initBinMemSize + put_ bh binaryInterfaceMagic + put_ bh binaryInterfaceVersion + + -- remember where the dictionary pointer will go + dict_p_p <- tellBin bh + put_ bh dict_p_p + + -- remember where the symbol table pointer will go + symtab_p_p <- tellBin bh + put_ bh symtab_p_p + + -- Make some intial state + ud <- newWriteState + + -- put the main thing + bh <- return $ setUserData bh ud + put_ bh iface + + -- write the symtab pointer at the fornt of the file + symtab_p <- tellBin bh + putAt bh symtab_p_p symtab_p + seekBin bh symtab_p + + -- write the symbol table itself + symtab_next <- readFastMutInt (ud_symtab_next ud) + symtab_map <- readIORef (ud_symtab_map ud) + putSymbolTable bh symtab_next symtab_map + + -- write the dictionary pointer at the fornt of the file + dict_p <- tellBin bh + putAt bh dict_p_p dict_p + seekBin bh dict_p + + -- write the dictionary itself + dict_next <- readFastMutInt (ud_dict_next ud) + dict_map <- readIORef (ud_dict_map ud) + putDictionary bh dict_next dict_map + + -- snd send the result to the file + writeBinMem bh filename + return () + +-- | Read a Haddock (@.haddock@) interface file. Return either an +-- 'InterfaceFile' or an error message. If given a GHC 'Session', the function +-- registers all read names in the name cache of the session. +-- The aim is to be compatible with interface files produced by any Haddock +-- of version 2.0.0.0 or greater. +readInterfaceFile :: Maybe Session -> FilePath -> IO (Either String InterfaceFile) +readInterfaceFile mbSession filename = do + bh <- readBinMem filename + + magic <- get bh + version <- get bh + + case () of + _ | magic /= binaryInterfaceMagic -> return . Left $ + "Magic number mismatch: couldn't load interface file: " ++ filename + | version /= binaryInterfaceVersion -> return . Left $ + "Interface file is of wrong version: " ++ filename + | otherwise -> do + + -- get the dictionary + dict_p <- get bh + data_p <- tellBin bh + seekBin bh dict_p + dict <- getDictionary bh + seekBin bh data_p + + -- initialise the user-data field of bh + ud <- newReadState dict + bh <- return (setUserData bh ud) + + -- get the name cache from ghc if we have a ghc session, + -- otherwise create a new one + (theNC, mbRef) <- case mbSession of + Just session -> do + ref <- withSession session (return . hsc_NC) + nc <- readIORef ref + return (nc, Just ref) + Nothing -> do + -- construct an empty name cache + u <- mkSplitUniqSupply 'a' -- ?? + return (initNameCache u [], Nothing) + + -- get the symbol table + symtab_p <- get bh + data_p <- tellBin bh + seekBin bh symtab_p + (nc', symtab) <- getSymbolTable bh theNC + seekBin bh data_p + + -- write back the new name cache if we have a ghc session + case mbRef of + Just ref -> writeIORef ref nc' + Nothing -> return () + + -- set the symbol table + let ud = getUserData bh + bh <- return $! setUserData bh ud{ud_symtab = symtab} + + -- load the actual data + iface <- get bh + return (Right iface) + + +------------------------------------------------------------------------------- +-- Symbol table +------------------------------------------------------------------------------- + +putSymbolTable :: BinHandle -> Int -> UniqFM (Int,Name) -> IO () +putSymbolTable bh next_off symtab = do + put_ bh next_off + let names = elems (array (0,next_off-1) (eltsUFM symtab)) + mapM_ (\n -> serialiseName bh n symtab) names + +getSymbolTable :: BinHandle -> NameCache -> IO (NameCache, Array Int Name) +getSymbolTable bh namecache = do + sz <- get bh + od_names <- sequence (replicate sz (get bh)) + let + arr = listArray (0,sz-1) names + (namecache', names) = + mapAccumR (fromOnDiskName arr) namecache od_names + -- + return (namecache', arr) + +type OnDiskName = (PackageId, ModuleName, OccName) + +fromOnDiskName + :: Array Int Name + -> NameCache + -> OnDiskName + -> (NameCache, Name) +fromOnDiskName arr nc (pid, mod_name, occ) = + let + mod = mkModule pid mod_name + cache = nsNames nc + in + case lookupOrigNameCache cache mod occ of + Just name -> (nc, name) + Nothing -> + let + us = nsUniqs nc + uniq = uniqFromSupply us + name = mkExternalName uniq mod occ noSrcSpan + new_cache = extendNameCache cache mod occ name + in + case splitUniqSupply us of { (us',_) -> + ( nc{ nsUniqs = us', nsNames = new_cache }, name ) + } + +serialiseName :: BinHandle -> Name -> UniqFM (Int,Name) -> IO () +serialiseName bh name symtab = do + let mod = nameModule name + put_ bh (modulePackageId mod, moduleName mod, nameOccName name) + + +------------------------------------------------------------------------------- +-- GhcBinary instances +------------------------------------------------------------------------------- + + +instance Binary InterfaceFile where + put_ bh (InterfaceFile env ifaces) = do + put_ bh (Map.toList env) + put_ bh ifaces + + get bh = do + env <- get bh + ifaces <- get bh + return (InterfaceFile (Map.fromList env) ifaces) + + +instance Binary InstalledInterface where + put_ bh (InstalledInterface mod info docMap exps visExps) = do + put_ bh mod + put_ bh info + put_ bh (Map.toList docMap) + put_ bh exps + put_ bh visExps + + get bh = do + mod <- get bh + info <- get bh + docMap <- get bh + exps <- get bh + visExps <- get bh + return (InstalledInterface mod info (Map.fromList docMap) exps visExps) + + +{-* Generated by DrIFT : Look, but Don't Touch. *-} +instance Binary DocName where + put_ bh (Link aa) = do + putByte bh 0 + put_ bh aa + put_ bh (NoLink ab) = do + putByte bh 1 + put_ bh ab + get bh = do + h <- getByte bh + case h of + 0 -> do + aa <- get bh + return (Link aa) + 1 -> do + ab <- get bh + return (NoLink ab) + _ -> fail "invalid binary data found" + + +instance Binary DocOption where + put_ bh OptHide = do + putByte bh 0 + put_ bh OptPrune = do + putByte bh 1 + put_ bh OptIgnoreExports = do + putByte bh 2 + put_ bh OptNotHome = do + putByte bh 3 + get bh = do + h <- getByte bh + case h of + 0 -> do + return OptHide + 1 -> do + return OptPrune + 2 -> do + return OptIgnoreExports + 3 -> do + return OptNotHome + _ -> fail "invalid binary data found" + + +{-* Generated by DrIFT : Look, but Don't Touch. *-} +instance (Binary id) => Binary (HsDoc id) where + put_ bh DocEmpty = do + putByte bh 0 + put_ bh (DocAppend aa ab) = do + putByte bh 1 + put_ bh aa + put_ bh ab + put_ bh (DocString ac) = do + putByte bh 2 + put_ bh ac + put_ bh (DocParagraph ad) = do + putByte bh 3 + put_ bh ad + put_ bh (DocIdentifier ae) = do + putByte bh 4 + put_ bh ae + put_ bh (DocModule af) = do + putByte bh 5 + put_ bh af + put_ bh (DocEmphasis ag) = do + putByte bh 6 + put_ bh ag + put_ bh (DocMonospaced ah) = do + putByte bh 7 + put_ bh ah + put_ bh (DocUnorderedList ai) = do + putByte bh 8 + put_ bh ai + put_ bh (DocOrderedList aj) = do + putByte bh 9 + put_ bh aj + put_ bh (DocDefList ak) = do + putByte bh 10 + put_ bh ak + put_ bh (DocCodeBlock al) = do + putByte bh 11 + put_ bh al + put_ bh (DocURL am) = do + putByte bh 12 + put_ bh am + put_ bh (DocAName an) = do + putByte bh 13 + put_ bh an + get bh = do + h <- getByte bh + case h of + 0 -> do + return DocEmpty + 1 -> do + aa <- get bh + ab <- get bh + return (DocAppend aa ab) + 2 -> do + ac <- get bh + return (DocString ac) + 3 -> do + ad <- get bh + return (DocParagraph ad) + 4 -> do + ae <- get bh + return (DocIdentifier ae) + 5 -> do + af <- get bh + return (DocModule af) + 6 -> do + ag <- get bh + return (DocEmphasis ag) + 7 -> do + ah <- get bh + return (DocMonospaced ah) + 8 -> do + ai <- get bh + return (DocUnorderedList ai) + 9 -> do + aj <- get bh + return (DocOrderedList aj) + 10 -> do + ak <- get bh + return (DocDefList ak) + 11 -> do + al <- get bh + return (DocCodeBlock al) + 12 -> do + am <- get bh + return (DocURL am) + 13 -> do + an <- get bh + return (DocAName an) + _ -> fail "invalid binary data found" + + +instance Binary name => Binary (HaddockModInfo name) where + put_ bh hmi = do + put_ bh (hmi_description hmi) + put_ bh (hmi_portability hmi) + put_ bh (hmi_stability hmi) + put_ bh (hmi_maintainer hmi) + + get bh = do + descr <- get bh + porta <- get bh + stabi <- get bh + maint <- get bh + return (HaddockModInfo descr porta stabi maint) diff --git a/src/Haddock/ModuleTree.hs b/src/Haddock/ModuleTree.hs new file mode 100644 --- /dev/null +++ b/src/Haddock/ModuleTree.hs @@ -0,0 +1,44 @@ +-- +-- Haddock - A Haskell Documentation Tool +-- +-- (c) Simon Marlow 2003 +-- + +module Haddock.ModuleTree ( ModuleTree(..), mkModuleTree ) where + +import Haddock.Types ( DocName ) +import GHC ( HsDoc, Name ) +import Module ( Module, moduleNameString, moduleName, modulePackageId ) +import PackageConfig ( packageIdString ) + +data ModuleTree = Node String Bool (Maybe String) (Maybe (HsDoc Name)) [ModuleTree] + +mkModuleTree :: Bool -> [(Module, Maybe (HsDoc Name))] -> [ModuleTree] +mkModuleTree showPkgs mods = + foldr fn [] [ (splitModule mod, modPkg mod, short) | (mod, short) <- mods ] + where + modPkg mod | showPkgs = Just (packageIdString (modulePackageId mod)) + | otherwise = Nothing + fn (mod,pkg,short) trees = addToTrees mod pkg short trees + +addToTrees :: [String] -> Maybe String -> Maybe (HsDoc Name) -> [ModuleTree] -> [ModuleTree] +addToTrees [] pkg short ts = ts +addToTrees ss pkg short [] = mkSubTree ss pkg short +addToTrees (s1:ss) pkg short (t@(Node s2 leaf node_pkg node_short subs) : ts) + | s1 > s2 = t : addToTrees (s1:ss) pkg short ts + | s1 == s2 = Node s2 (leaf || null ss) this_pkg this_short (addToTrees ss pkg short subs) : ts + | otherwise = mkSubTree (s1:ss) pkg short ++ t : ts + where + this_pkg = if null ss then pkg else node_pkg + this_short = if null ss then short else node_short + +mkSubTree :: [String] -> Maybe String -> Maybe (HsDoc Name) -> [ModuleTree] +mkSubTree [] pkg short = [] +mkSubTree [s] pkg short = [Node s True pkg short []] +mkSubTree (s:ss) pkg short = [Node s (null ss) Nothing Nothing (mkSubTree ss pkg short)] + +splitModule :: Module -> [String] +splitModule mod = split (moduleNameString (moduleName mod)) + where split mod0 = case break (== '.') mod0 of + (s1, '.':s2) -> s1 : split s2 + (s1, _) -> [s1] diff --git a/src/Haddock/Options.hs b/src/Haddock/Options.hs new file mode 100644 --- /dev/null +++ b/src/Haddock/Options.hs @@ -0,0 +1,153 @@ +-- +-- Haddock - A Haskell Documentation Tool +-- +-- (c) Simon Marlow 2003 +-- + + +module Haddock.Options ( + parseHaddockOpts, + Flag(..), + getUsage, + ghcFlags, + ifacePairs +) where + + +import Haddock.Utils +import Haddock.Exception +import System.Console.GetOpt + + +getUsage :: IO String +getUsage = do + prog <- getProgramName + return $ usageInfo (usageHeader prog) (options False) + where + usageHeader :: String -> String + usageHeader prog = "Usage: " ++ prog ++ " [OPTION...] file...\n" + + +parseHaddockOpts :: [String] -> IO ([Flag], [String]) +parseHaddockOpts words = + case getOpt Permute (options True) words of + (flags, args, []) -> return (flags, args) + (_, _, errors) -> do + usage <- getUsage + throwE (concat errors ++ usage) + + +ghcFlags :: [Flag] -> [String] +ghcFlags flags = [ option | Flag_OptGhc option <- flags ] + + +ifacePairs :: [Flag] -> [(FilePath, FilePath)] +ifacePairs flags = [ parseIfaceOption s | Flag_ReadInterface s <- flags ] + + +parseIfaceOption :: String -> (FilePath, FilePath) +parseIfaceOption s = + case break (==',') s of + (fpath,',':file) -> (fpath, file) + (file, _) -> ("", file) + + +data Flag + = Flag_CSS String + | Flag_Debug +-- | Flag_DocBook + | Flag_ReadInterface String + | Flag_DumpInterface String + | Flag_Heading String + | Flag_Html + | Flag_Hoogle + | Flag_HtmlHelp String + | Flag_Lib String + | Flag_OutputDir FilePath + | Flag_Prologue FilePath + | Flag_SourceBaseURL String + | Flag_SourceModuleURL String + | Flag_SourceEntityURL String + | Flag_WikiBaseURL String + | Flag_WikiModuleURL String + | Flag_WikiEntityURL String + | Flag_Help + | Flag_Verbose + | Flag_Version + | Flag_UseContents String + | Flag_GenContents + | Flag_UseIndex String + | Flag_GenIndex + | Flag_IgnoreAllExports + | Flag_HideModule String + | Flag_OptGhc String + | Flag_GhcLibDir String + | Flag_GhcVersion + deriving (Eq) + + +options :: Bool -> [OptDescr Flag] +options backwardsCompat = + [ + Option ['B'] [] (ReqArg Flag_GhcLibDir "DIR") + "path to the GHC lib dir, e.g /usr/lib/ghc", + Option ['o'] ["odir"] (ReqArg Flag_OutputDir "DIR") + "directory in which to put the output files", + Option ['l'] ["lib"] (ReqArg Flag_Lib "DIR") + "location of Haddock's auxiliary files", + Option ['i'] ["read-interface"] (ReqArg Flag_ReadInterface "FILE") + "read an interface from FILE", + Option ['D'] ["dump-interface"] (ReqArg Flag_DumpInterface "FILE") + "interface file name", +-- Option ['S'] ["docbook"] (NoArg Flag_DocBook) +-- "output in DocBook XML", + Option ['h'] ["html"] (NoArg Flag_Html) + "output in HTML", + Option [] ["hoogle"] (NoArg Flag_Hoogle) + "output for Hoogle", + Option [] ["html-help"] (ReqArg Flag_HtmlHelp "format") + "produce index and table of contents in\nmshelp, mshelp2 or devhelp format (with -h)", + Option [] ["source-base"] (ReqArg Flag_SourceBaseURL "URL") + "URL for a source code link on the contents\nand index pages", + Option ['s'] (if backwardsCompat then ["source", "source-module"] else ["source-module"]) + (ReqArg Flag_SourceModuleURL "URL") + "URL for a source code link for each module\n(using the %{FILE} or %{MODULE} vars)", + Option [] ["source-entity"] (ReqArg Flag_SourceEntityURL "URL") + "URL for a source code link for each entity\n(using the %{FILE}, %{MODULE}, %{NAME},\n%{KIND} or %{LINE} vars)", + Option [] ["comments-base"] (ReqArg Flag_WikiBaseURL "URL") + "URL for a comments link on the contents\nand index pages", + Option [] ["comments-module"] (ReqArg Flag_WikiModuleURL "URL") + "URL for a comments link for each module\n(using the %{MODULE} var)", + Option [] ["comments-entity"] (ReqArg Flag_WikiEntityURL "URL") + "URL for a comments link for each entity\n(using the %{FILE}, %{MODULE}, %{NAME},\n%{KIND} or %{LINE} vars)", + Option ['c'] ["css"] (ReqArg Flag_CSS "FILE") + "the CSS file to use for HTML output", + Option ['p'] ["prologue"] (ReqArg Flag_Prologue "FILE") + "file containing prologue text", + Option ['t'] ["title"] (ReqArg Flag_Heading "TITLE") + "page heading", + Option ['d'] ["debug"] (NoArg Flag_Debug) + "extra debugging output", + Option ['?'] ["help"] (NoArg Flag_Help) + "display this help and exit", + Option ['V'] ["version"] (NoArg Flag_Version) + "output version information and exit", + Option ['v'] ["verbose"] (NoArg Flag_Verbose) + "increase verbosity", + Option [] ["use-contents"] (ReqArg Flag_UseContents "URL") + "use a separately-generated HTML contents page", + Option [] ["gen-contents"] (NoArg Flag_GenContents) + "generate an HTML contents from specified\ninterfaces", + Option [] ["use-index"] (ReqArg Flag_UseIndex "URL") + "use a separately-generated HTML index", + Option [] ["gen-index"] (NoArg Flag_GenIndex) + "generate an HTML index from specified\ninterfaces", + Option [] ["ignore-all-exports"] (NoArg Flag_IgnoreAllExports) + "behave as if all modules have the\nignore-exports atribute", + Option [] ["hide"] (ReqArg Flag_HideModule "MODULE") + "behave as if MODULE has the hide attribute", + Option [] ["optghc"] (ReqArg Flag_OptGhc "OPTION") + "Forward option to GHC", + Option [] ["ghc-version"] (NoArg Flag_GhcVersion) + "output GHC version in numeric format" + ] diff --git a/src/Haddock/Types.hs b/src/Haddock/Types.hs new file mode 100644 --- /dev/null +++ b/src/Haddock/Types.hs @@ -0,0 +1,224 @@ +-- +-- Haddock - A Haskell Documentation Tool +-- +-- (c) Simon Marlow 2003 +-- + + +module Haddock.Types where + + +import Data.Map (Map) +import qualified Data.Map as Map + +import GHC hiding (NoLink) +import Outputable +import OccName + +{-! for DocOption derive: Binary !-} +data DocOption + = OptHide -- ^ This module should not appear in the docs + | OptPrune + | OptIgnoreExports -- ^ Pretend everything is exported + | OptNotHome -- ^ Not the best place to get docs for things + -- exported by this module. + deriving (Eq, Show) + + +data ExportItem name + + = ExportDecl { + + -- | The original name + expItemName :: Name, + + -- | A declaration + expItemDecl :: LHsDecl name, + + -- | Maybe a doc comment + expItemMbDoc :: Maybe (HsDoc name), + + -- | Instances relevant to this declaration + expItemInstances :: [InstHead name] + + } -- ^ An exported declaration + + | ExportNoDecl { + -- | The original name + expItemName :: Name, + + -- | Where to link to + expItemLinkTarget :: name, + + -- | Subordinate names + expItemSubs :: [name] + + } -- ^ An exported entity for which we have no + -- documentation (perhaps because it resides in + -- another package) + + | ExportGroup { + + -- | Section level (1, 2, 3, ... ) + expItemSectionLevel :: Int, + + -- | Section id (for hyperlinks) + expItemSectionId :: String, + + -- | Section heading text + expItemSectionText :: HsDoc name + + } -- ^ A section heading + + | ExportDoc (HsDoc name) -- ^ Some documentation + + | ExportModule Module -- ^ A cross-reference to another module + + +type InstHead name = ([HsPred name], name, [HsType name]) +type ModuleMap = Map Module Interface +type DocMap = Map Name (HsDoc DocName) +type LinkEnv = Map Name Name + + +{-! for DocName derive: Binary !-} +data DocName = Link Name | NoLink Name + + +instance Outputable DocName where + ppr (Link n) = ppr n + ppr (NoLink n) = ppr n + + +instance NamedThing DocName where + getName (Link n) = n + getName (NoLink n) = n + + +-- | This structure holds the module information we get from GHC's +-- type checking phase +data GhcModule = GhcModule { + ghcModule :: Module, + ghcFilename :: FilePath, + ghcMbDocOpts :: Maybe String, + ghcHaddockModInfo :: HaddockModInfo Name, + ghcMbDoc :: Maybe (HsDoc Name), + ghcGroup :: HsGroup Name, + ghcMbExports :: Maybe [LIE Name], + ghcExportedNames :: [Name], + ghcNamesInScope :: [Name], + ghcInstances :: [Instance] +} + + +-- | This is the data structure used to render a Haddock page for a module - it +-- is the "interface" of the module. The core of Haddock lies in creating this +-- structure (see Haddock.Interface). The structure also holds intermediate +-- data needed during its creation. +data Interface = Interface { + + -- | The documented module + ifaceMod :: Module, + + -- | The original filename for this module + ifaceOrigFilename :: FilePath, + + -- | Textual information about the module + ifaceInfo :: HaddockModInfo Name, + + -- | The documentation header for this module + ifaceDoc :: Maybe (HsDoc Name), + + -- | The renamed documentation header for this module + ifaceRnDoc :: Maybe (HsDoc DocName), + + -- | The Haddock options for this module (prune, ignore-exports, etc) + ifaceOptions :: [DocOption], + + ifaceExportedDeclMap :: Map Name (LHsDecl Name), + ifaceDocMap :: Map Name (HsDoc Name), + ifaceRnDocMap :: Map Name (HsDoc DocName), + + ifaceExportItems :: [ExportItem Name], + ifaceRnExportItems :: [ExportItem DocName], + + -- | Environment mapping exported names to *original* names + ifaceEnv :: Map OccName Name, + + -- | All the names that are defined in this module + ifaceLocals :: [Name], + + -- | All the names that are exported by this module + ifaceExports :: [Name], + + -- | All the visible names exported by this module + -- For a name to be visible, it has to: + -- - be exported normally, and not via a full module re-exportation. + -- - have a declaration in this module or any of it's imports, with the + -- exception that it can't be from another package. + -- Basically, a visible name is a name that will show up in the documentation + -- for this module. + ifaceVisibleExports :: [Name], + + ifaceSubMap :: Map Name [Name], + + -- | The instances exported by this module + ifaceInstances :: [Instance] +} + + +-- | A smaller version of 'Interface' that we can get from the Haddock +-- interface files. +data InstalledInterface = InstalledInterface { + instMod :: Module, + instInfo :: HaddockModInfo Name, + instDocMap :: Map Name (HsDoc DocName), + instExports :: [Name], + instVisibleExports :: [Name] +} + + +-- | Convert an 'Interface' to an 'InstalledInterface' +toInstalledIface :: Interface -> InstalledInterface +toInstalledIface interface = InstalledInterface { + instMod = ifaceMod interface, + instInfo = ifaceInfo interface, + instDocMap = ifaceRnDocMap interface, + instExports = ifaceExports interface, + instVisibleExports = ifaceVisibleExports interface +} + + +data DocMarkup id a = Markup { + markupEmpty :: a, + markupString :: String -> a, + markupParagraph :: a -> a, + markupAppend :: a -> a -> a, + markupIdentifier :: [id] -> a, + markupModule :: String -> a, + markupEmphasis :: a -> a, + markupMonospaced :: a -> a, + markupUnorderedList :: [a] -> a, + markupOrderedList :: [a] -> a, + markupDefList :: [(a,a)] -> a, + markupCodeBlock :: a -> a, + markupURL :: String -> a, + markupAName :: String -> a +} + + +-- A monad which collects error messages, locally defined to avoid a dep on mtl + +type ErrMsg = String + +newtype ErrMsgM a = Writer { runWriter :: (a, [ErrMsg]) } + +instance Monad ErrMsgM where + return a = Writer (a, []) + m >>= k = Writer $ let + (a, w) = runWriter m + (b, w') = runWriter (k a) + in (b, w ++ w') + +tell :: [ErrMsg] -> ErrMsgM () +tell w = Writer ((), w) diff --git a/src/Haddock/Utils.hs b/src/Haddock/Utils.hs new file mode 100644 --- /dev/null +++ b/src/Haddock/Utils.hs @@ -0,0 +1,370 @@ +-- +-- Haddock - A Haskell Documentation Tool +-- +-- (c) The University of Glasgow 2001-2002 +-- (c) Simon Marlow 2003 +-- + +module Haddock.Utils ( + + -- * Misc utilities + restrictTo, + toDescription, toInstalledDescription, + + -- * Filename utilities + basename, dirname, splitFilename3, + moduleHtmlFile, nameHtmlRef, + contentsHtmlFile, indexHtmlFile, subIndexHtmlFile, pathJoin, + anchorNameStr, + cssFile, iconFile, jsFile, plusFile, minusFile, + + -- * Miscellaneous utilities + getProgramName, bye, die, dieMsg, noDieMsg, mapSnd, mapMaybeM, escapeStr, + + -- * HTML cross reference mapping + html_xrefs_ref, + + -- * HsDoc markup + markup, + idMarkup, + + -- * List utilities + replace, + + -- * Binary extras +-- FormatVersion, mkFormatVersion + ) where + +import Haddock.Types + +import GHC +import SrcLoc +import Name +import OccName +import Binary +import Module +import PackageConfig ( stringToPackageId ) + +import Control.Monad ( liftM, MonadPlus(..) ) +import Data.Char ( isAlpha, isSpace, toUpper, ord, chr ) +import Numeric ( showIntAtBase ) +import Data.Map ( Map ) +import qualified Data.Map as Map hiding ( Map ) +import Data.IORef ( IORef, newIORef, readIORef ) +import Data.List ( intersect, isSuffixOf, intersperse ) +import Data.Maybe ( maybeToList, fromMaybe, isJust, fromJust ) +import Data.Word ( Word8 ) +import Data.Bits ( testBit ) +import System.Environment ( getProgName ) +import System.Exit ( exitWith, ExitCode(..) ) +import System.IO ( hPutStr, stderr ) +import System.IO.Unsafe ( unsafePerformIO ) + +-- ----------------------------------------------------------------------------- +-- Some Utilities + + +-- | extract a module's short description. +toDescription :: Interface -> Maybe (HsDoc Name) +toDescription = hmi_description . ifaceInfo + +-- | extract a module's short description. +toInstalledDescription :: InstalledInterface -> Maybe (HsDoc Name) +toInstalledDescription = hmi_description . instInfo + + +-- --------------------------------------------------------------------------- +-- Making abstract declarations + +restrictTo :: [Name] -> (LHsDecl Name) -> (LHsDecl Name) +restrictTo names (L loc decl) = L loc $ case decl of + TyClD d | isDataDecl d && tcdND d == DataType -> + TyClD (d { tcdCons = restrictCons names (tcdCons d) }) + TyClD d | isDataDecl d && tcdND d == NewType -> + case restrictCons names (tcdCons d) of + [] -> TyClD (d { tcdND = DataType, tcdCons = [] }) + [con] -> TyClD (d { tcdCons = [con] }) + TyClD d | isClassDecl d -> + TyClD (d { tcdSigs = restrictDecls names (tcdSigs d) }) + _ -> decl + +restrictCons :: [Name] -> [LConDecl Name] -> [LConDecl Name] +restrictCons names decls = [ L p d | L p (Just d) <- map (fmap keep) decls ] + where + keep d | unLoc (con_name d) `elem` names = + case con_details d of + PrefixCon _ -> Just d + RecCon fields + | all field_avail fields -> Just d + | otherwise -> Just (d { con_details = PrefixCon (field_types fields) }) + -- if we have *all* the field names available, then + -- keep the record declaration. Otherwise degrade to + -- a constructor declaration. This isn't quite right, but + -- it's the best we can do. + InfixCon _ _ -> Just d + where + field_avail (ConDeclField n _ _) = (unLoc n) `elem` names + field_types flds = [ t | ConDeclField _ t _ <- flds ] + + keep d | otherwise = Nothing + +restrictDecls :: [Name] -> [LSig Name] -> [LSig Name] +restrictDecls names decls = filter keep decls + where keep d = fromJust (sigName d) `elem` names + -- has to have a name, since it's a class method type signature + +-- ----------------------------------------------------------------------------- +-- Filename mangling functions stolen from s main/DriverUtil.lhs. + +type Suffix = String + +splitFilename :: String -> (String,Suffix) +splitFilename f = split_longest_prefix f (=='.') + +basename :: String -> String +basename f = base where (_dir, base, _suff) = splitFilename3 f + +dirname :: String -> String +dirname f = dir where (dir, _base, _suff) = splitFilename3 f + +-- "foo/bar/xyzzy.ext" -> ("foo/bar", "xyzzy", ".ext") +splitFilename3 :: String -> (String,String,Suffix) +splitFilename3 str + = let (dir, rest) = split_longest_prefix str isPathSeparator + (name, ext) = splitFilename rest + real_dir | null dir = "." + | otherwise = dir + in (real_dir, name, ext) + +split_longest_prefix :: String -> (Char -> Bool) -> (String,String) +split_longest_prefix s pred0 + = case pre0 of + [] -> ([], reverse suf) + (_:pre) -> (reverse pre, reverse suf) + where (suf,pre0) = break pred0 (reverse s) + +pathSeparator :: Char +#ifdef __WIN32__ +pathSeparator = '\\' +#else +pathSeparator = '/' +#endif + +isPathSeparator :: Char -> Bool +isPathSeparator ch = +#ifdef mingw32_TARGET_OS + ch == '/' || ch == '\\' +#else + ch == '/' +#endif + +moduleHtmlFile :: Module -> FilePath +moduleHtmlFile mdl = + case Map.lookup mdl html_xrefs of + Nothing -> mdl' ++ ".html" + Just fp0 -> pathJoin [fp0, mdl' ++ ".html"] + where + mdl' = map (\c -> if c == '.' then '-' else c) + (moduleNameString (moduleName mdl)) + +nameHtmlRef :: Module -> Name -> String +nameHtmlRef mdl str = moduleHtmlFile mdl ++ '#':escapeStr (anchorNameStr str) + +contentsHtmlFile, indexHtmlFile :: String +contentsHtmlFile = "index.html" +indexHtmlFile = "doc-index.html" + +subIndexHtmlFile :: Char -> String +subIndexHtmlFile a = "doc-index-" ++ b ++ ".html" + where b | isAlpha a = [a] + | otherwise = show (ord a) + +anchorNameStr :: Name -> String +anchorNameStr name | isValOcc occName = "v:" ++ getOccString name + | otherwise = "t:" ++ getOccString name + where occName = nameOccName name + +pathJoin :: [FilePath] -> FilePath +pathJoin = foldr join [] + where join :: FilePath -> FilePath -> FilePath + join path1 "" = path1 + join "" path2 = path2 + join path1 path2 + | isPathSeparator (last path1) = path1++path2 + | otherwise = path1++pathSeparator:path2 + +-- ----------------------------------------------------------------------------- +-- Files we need to copy from our $libdir + +cssFile, iconFile, jsFile, plusFile,minusFile :: String +cssFile = "haddock.css" +iconFile = "haskell_icon.gif" +jsFile = "haddock-util.js" +plusFile = "plus.gif" +minusFile = "minus.gif" + +----------------------------------------------------------------------------- +-- misc. + +getProgramName :: IO String +getProgramName = liftM (`withoutSuffix` ".bin") getProgName + where str `withoutSuffix` suff + | suff `isSuffixOf` str = take (length str - length suff) str + | otherwise = str + +bye :: String -> IO a +bye s = putStr s >> exitWith ExitSuccess + +die :: String -> IO a +die s = hPutStr stderr s >> exitWith (ExitFailure 1) + +dieMsg :: String -> IO a +dieMsg s = getProgramName >>= \prog -> die (prog ++ ": " ++ s) + +noDieMsg :: String -> IO () +noDieMsg s = getProgramName >>= \prog -> hPutStr stderr (prog ++ ": " ++ s) + +mapSnd :: (b -> c) -> [(a,b)] -> [(a,c)] +mapSnd _ [] = [] +mapSnd f ((x,y):xs) = (x,f y) : mapSnd f xs + +mapMaybeM :: Monad m => (a -> m b) -> Maybe a -> m (Maybe b) +mapMaybeM _ Nothing = return Nothing +mapMaybeM f (Just a) = f a >>= return . Just + +escapeStr :: String -> String +escapeStr = escapeURIString isUnreserved + +-- Following few functions are copy'n'pasted from Network.URI module +-- to avoid depending on the network lib, since doing so gives a +-- circular build dependency between haddock and network +-- (at least if you want to build network with haddock docs) + +escapeURIChar :: (Char -> Bool) -> Char -> String +escapeURIChar p c + | p c = [c] + | otherwise = '%' : myShowHex (ord c) "" + where + myShowHex :: Int -> ShowS + myShowHex n r = case showIntAtBase 16 (toChrHex) n r of + [] -> "00" + [c] -> ['0',c] + cs -> cs + toChrHex d + | d < 10 = chr (ord '0' + fromIntegral d) + | otherwise = chr (ord 'A' + fromIntegral (d - 10)) + +escapeURIString :: (Char -> Bool) -> String -> String +escapeURIString p s = concatMap (escapeURIChar p) s + +isUnreserved :: Char -> Bool +isUnreserved c = isAlphaNumChar c || (c `elem` "-_.~") + +isAlphaChar c = (c >= 'A' && c <= 'Z') || (c >= 'a' && c <= 'z') +isDigitChar c = (c >= '0' && c <= '9') +isAlphaNumChar c = isAlphaChar c || isDigitChar c + + +----------------------------------------------------------------------------- +-- HTML cross references + +-- For each module, we need to know where its HTML documentation lives +-- so that we can point hyperlinks to it. It is extremely +-- inconvenient to plumb this information to all the places that need +-- it (basically every function in HaddockHtml), and furthermore the +-- mapping is constant for any single run of Haddock. So for the time +-- being I'm going to use a write-once global variable. + +{-# NOINLINE html_xrefs_ref #-} +html_xrefs_ref :: IORef (Map Module FilePath) +html_xrefs_ref = unsafePerformIO (newIORef (error "module_map")) + +{-# NOINLINE html_xrefs #-} +html_xrefs :: Map Module FilePath +html_xrefs = unsafePerformIO (readIORef html_xrefs_ref) + + +----------------------------------------------------------------------------- +-- List utils +----------------------------------------------------------------------------- + + +replace a b xs = map (\x -> if x == a then b else x) xs + + +----------------------------------------------------------------------------- +-- put here temporarily + +markup :: DocMarkup id a -> HsDoc id -> a +markup m DocEmpty = markupEmpty m +markup m (DocAppend d1 d2) = markupAppend m (markup m d1) (markup m d2) +markup m (DocString s) = markupString m s +markup m (DocParagraph d) = markupParagraph m (markup m d) +markup m (DocIdentifier ids) = markupIdentifier m ids +markup m (DocModule mod0) = markupModule m mod0 +markup m (DocEmphasis d) = markupEmphasis m (markup m d) +markup m (DocMonospaced d) = markupMonospaced m (markup m d) +markup m (DocUnorderedList ds) = markupUnorderedList m (map (markup m) ds) +markup m (DocOrderedList ds) = markupOrderedList m (map (markup m) ds) +markup m (DocDefList ds) = markupDefList m (map (markupPair m) ds) +markup m (DocCodeBlock d) = markupCodeBlock m (markup m d) +markup m (DocURL url) = markupURL m url +markup m (DocAName ref) = markupAName m ref + +markupPair :: DocMarkup id a -> (HsDoc id, HsDoc id) -> (a, a) +markupPair m (a,b) = (markup m a, markup m b) + +-- | The identity markup +idMarkup :: DocMarkup a (HsDoc a) +idMarkup = Markup { + markupEmpty = DocEmpty, + markupString = DocString, + markupParagraph = DocParagraph, + markupAppend = DocAppend, + markupIdentifier = DocIdentifier, + markupModule = DocModule, + markupEmphasis = DocEmphasis, + markupMonospaced = DocMonospaced, + markupUnorderedList = DocUnorderedList, + markupOrderedList = DocOrderedList, + markupDefList = DocDefList, + markupCodeBlock = DocCodeBlock, + markupURL = DocURL, + markupAName = DocAName + } + +-- | Since marking up is just a matter of mapping 'Doc' into some +-- other type, we can \'rename\' documentation by marking up 'Doc' into +-- the same thing, modifying only the identifiers embedded in it. + +mapIdent f = idMarkup { markupIdentifier = f } + +----------------------------------------------------------------------------- +-- put here temporarily + +newtype FormatVersion = FormatVersion Int deriving (Eq,Ord) + +nullFormatVersion :: FormatVersion +nullFormatVersion = mkFormatVersion 0 + +mkFormatVersion :: Int -> FormatVersion +mkFormatVersion i = FormatVersion i + +instance Binary FormatVersion where + put_ bh (FormatVersion i) = + case compare i 0 of + EQ -> return () + GT -> put_ bh (-i) + LT -> error ( + "Binary.hs: negative FormatVersion " ++ show i + ++ " is not allowed") + get bh = + do + (w8 :: Word8) <- get bh + if testBit w8 7 + then + do + i <- get bh + return (FormatVersion (-i)) + else + return nullFormatVersion diff --git a/src/Haddock/Utils/BlockTable.hs b/src/Haddock/Utils/BlockTable.hs new file mode 100644 --- /dev/null +++ b/src/Haddock/Utils/BlockTable.hs @@ -0,0 +1,180 @@ +{- | + + Module : Text.Html.BlockTable + Copyright : (c) Andy Gill, and the Oregon Graduate Institute of + Science and Technology, 1999-2001 + License : BSD-style (see the file libraries/core/LICENSE) + + Maintainer : Andy Gill + Stability : experimental + Portability : portable + + $Id: BlockTable.hs,v 1.2 2002/07/24 09:42:18 simonmar Exp $ + + An Html combinator library + +-} + +module Haddock.Utils.BlockTable ( + +-- Datatypes: + + BlockTable, -- abstract + +-- Contruction Functions: + + single, + empty, + above, + beside, + +-- Investigation Functions: + + getMatrix, + showsTable, + showTable, + + ) where + +import Prelude + +infixr 4 `beside` +infixr 3 `above` + +-- These combinators can be used to build formated 2D tables. +-- The specific target useage is for HTML table generation. + +{- + Examples of use: + + > table1 :: BlockTable String + > table1 = single "Hello" +-----+ + |Hello| + This is a 1x1 cell +-----+ + Note: single has type + + single :: a -> BlockTable a + + So the cells can contain anything. + + > table2 :: BlockTable String + > table2 = single "World" +-----+ + |World| + +-----+ + + + > table3 :: BlockTable String + > table3 = table1 %-% table2 +-----%-----+ + |Hello%World| + % is used to indicate +-----%-----+ + the join edge between + the two Tables. + + > table4 :: BlockTable String + > table4 = table3 %/% table2 +-----+-----+ + |Hello|World| + Notice the padding on the %%%%%%%%%%%%% + smaller (bottom) cell to |World | + force the table to be a +-----------+ + rectangle. + + > table5 :: BlockTable String + > table5 = table1 %-% table4 +-----%-----+-----+ + |Hello%Hello|World| + Notice the padding on the | %-----+-----+ + leftmost cell, again to | %World | + force the table to be a +-----%-----------+ + rectangle. + + Now the table can be rendered with processTable, for example: + Main> processTable table5 + [[("Hello",(1,2)), + ("Hello",(1,1)), + ("World",(1,1))], + [("World",(2,1))]] :: [[([Char],(Int,Int))]] + Main> +-} + +-- --------------------------------------------------------------------------- +-- Contruction Functions + +-- Perhaps one day I'll write the Show instance +-- to show boxes aka the above ascii renditions. + +instance (Show a) => Show (BlockTable a) where + showsPrec _ = showsTable + +type TableI a = [[(a,(Int,Int))]] -> [[(a,(Int,Int))]] + +data BlockTable a = Table (Int -> Int -> TableI a) Int Int + + +-- You can create a (1x1) table entry + +single :: a -> BlockTable a +single a = Table (\ x y r -> [(a,(x+1,y+1))] : r) 1 1 + +empty :: BlockTable a +empty = Table (\ _ _ r -> r) 0 0 + + +-- You can compose tables, horizonally and vertically + +above :: BlockTable a -> BlockTable a -> BlockTable a +beside :: BlockTable a -> BlockTable a -> BlockTable a + +t1 `above` t2 = trans (combine (trans t1) (trans t2) (.)) + +t1 `beside` t2 = combine t1 t2 (\ lst1 lst2 r -> + let + -- Note this depends on the fact that + -- that the result has the same number + -- of lines as the y dimention; one list + -- per line. This is not true in general + -- but is always true for these combinators. + -- I should assert this! + -- I should even prove this. + beside' (x:xs) (y:ys) = (x ++ y) : beside' xs ys + beside' (x:xs) [] = x : xs ++ r + beside' [] (y:ys) = y : ys ++ r + beside' [] [] = r + in + beside' (lst1 []) (lst2 [])) + +-- trans flips (transposes) over the x and y axis of +-- the table. It is only used internally, and typically +-- in pairs, ie. (flip ... munge ... (un)flip). + +trans :: BlockTable a -> BlockTable a +trans (Table f1 x1 y1) = Table (flip f1) y1 x1 + +combine :: BlockTable a + -> BlockTable b + -> (TableI a -> TableI b -> TableI c) + -> BlockTable c +combine (Table f1 x1 y1) (Table f2 x2 y2) comb = Table new_fn (x1+x2) max_y + where + max_y = max y1 y2 + new_fn x y = + case compare y1 y2 of + EQ -> comb (f1 0 y) (f2 x y) + GT -> comb (f1 0 y) (f2 x (y + y1 - y2)) + LT -> comb (f1 0 (y + y2 - y1)) (f2 x y) + +-- --------------------------------------------------------------------------- +-- Investigation Functions + +-- This is the other thing you can do with a Table; +-- turn it into a 2D list, tagged with the (x,y) +-- sizes of each cell in the table. + +getMatrix :: BlockTable a -> [[(a,(Int,Int))]] +getMatrix (Table r _ _) = r 0 0 [] + +-- You can also look at a table + +showsTable :: (Show a) => BlockTable a -> ShowS +showsTable table = shows (getMatrix table) + +showTable :: (Show a) => BlockTable a -> String +showTable table = showsTable table "" diff --git a/src/Haddock/Utils/FastMutInt2.hs b/src/Haddock/Utils/FastMutInt2.hs new file mode 100644 --- /dev/null +++ b/src/Haddock/Utils/FastMutInt2.hs @@ -0,0 +1,63 @@ +{-# OPTIONS_GHC -cpp -fglasgow-exts #-} +-- +-- (c) The University of Glasgow 2002 +-- +-- Unboxed mutable Ints + +module Haddock.Utils.FastMutInt2( + FastMutInt, newFastMutInt, + readFastMutInt, writeFastMutInt, + incFastMutInt, incFastMutIntBy + ) where + +#include "MachDeps.h" + +#ifndef SIZEOF_HSINT +#define SIZEOF_HSINT INT_SIZE_IN_BYTES +#endif + + +#if __GLASGOW_HASKELL__ < 503 +import GlaExts +import PrelIOBase +#else +import GHC.Base +import GHC.IOBase +#endif + +#if __GLASGOW_HASKELL__ < 411 +newByteArray# = newCharArray# +#endif + +#ifdef __GLASGOW_HASKELL__ +data FastMutInt = FastMutInt (MutableByteArray# RealWorld) + +newFastMutInt :: IO FastMutInt +newFastMutInt = IO $ \s0 -> + case newByteArray# size s0 of { (# s, arr #) -> + (# s, FastMutInt arr #) } + where I# size = SIZEOF_HSINT + +readFastMutInt :: FastMutInt -> IO Int +readFastMutInt (FastMutInt arr) = IO $ \s0 -> + case readIntArray# arr 0# s0 of { (# s, i #) -> + (# s, I# i #) } + +writeFastMutInt :: FastMutInt -> Int -> IO () +writeFastMutInt (FastMutInt arr) (I# i) = IO $ \s0 -> + case writeIntArray# arr 0# i s0 of { s -> + (# s, () #) } + +incFastMutInt :: FastMutInt -> IO Int -- Returns original value +incFastMutInt (FastMutInt arr) = IO $ \s0 -> + case readIntArray# arr 0# s0 of { (# s1, i #) -> + case writeIntArray# arr 0# (i +# 1#) s1 of { s -> + (# s, I# i #) } } + +incFastMutIntBy :: FastMutInt -> Int -> IO Int -- Returns original value +incFastMutIntBy (FastMutInt arr) (I# n) = IO $ \s0 -> + case readIntArray# arr 0# s0 of { (# s1, i #) -> + case writeIntArray# arr 0# (i +# n) s1 of { s -> + (# s, I# i #) } } +#endif + diff --git a/src/Haddock/Utils/Html.hs b/src/Haddock/Utils/Html.hs new file mode 100644 --- /dev/null +++ b/src/Haddock/Utils/Html.hs @@ -0,0 +1,1037 @@ +----------------------------------------------------------------------------- +-- +-- Module : Text.Html +-- Copyright : (c) Andy Gill, and the Oregon Graduate Institute of +-- Science and Technology, 1999-2001 +-- License : BSD-style (see the file libraries/core/LICENSE) +-- +-- Maintainer : Andy Gill +-- Stability : experimental +-- Portability : portable +-- +-- An Html combinator library +-- +----------------------------------------------------------------------------- + +module Haddock.Utils.Html ( + module Haddock.Utils.Html, + ) where + +import qualified Haddock.Utils.BlockTable as BT + +import Data.Char (isAscii, ord) +import Numeric (showHex) + +infixr 2 +++ -- combining Html +infixr 7 << -- nesting Html +infixl 8 ! -- adding optional arguments + + +-- A important property of Html is that all strings inside the +-- structure are already in Html friendly format. +-- For example, use of >,etc. + +data HtmlElement +{- + - ..just..plain..normal..text... but using © and &amb;, etc. + -} + = HtmlString String +{- + - ..content.. + -} + | HtmlTag { -- tag with internal markup + markupTag :: String, + markupAttrs :: [HtmlAttr], + markupContent :: Html + } + +{- These are the index-value pairs. + - The empty string is a synonym for tags with no arguments. + - (not strictly HTML, but anyway). + -} + + +data HtmlAttr = HtmlAttr String String + + +newtype Html = Html { getHtmlElements :: [HtmlElement] } + +-- Read MARKUP as the class of things that can be validly rendered +-- inside MARKUP tag brackets. So this can be one or more Html's, +-- or a String, for example. + +class HTML a where + toHtml :: a -> Html + toHtmlFromList :: [a] -> Html + + toHtmlFromList xs = Html (concat [ x | (Html x) <- map toHtml xs]) + +instance HTML Html where + toHtml a = a + +instance HTML Char where + toHtml a = toHtml [a] + toHtmlFromList [] = Html [] + toHtmlFromList str = Html [HtmlString (stringToHtmlString str)] + +instance (HTML a) => HTML [a] where + toHtml xs = toHtmlFromList xs + +class ADDATTRS a where + (!) :: a -> [HtmlAttr] -> a + +instance (ADDATTRS b) => ADDATTRS (a -> b) where + (!) fn attr = \ arg -> fn arg ! attr + +instance ADDATTRS Html where + (!) (Html htmls) attr = Html (map addAttrs htmls) + where + addAttrs html = + case html of + HtmlTag { markupAttrs = markupAttrs0 + , markupTag = markupTag0 + , markupContent = markupContent0 } -> + HtmlTag { markupAttrs = markupAttrs0 ++ attr + , markupTag = markupTag0 + , markupContent = markupContent0 } + _ -> html + + +(<<) :: (HTML a) => (Html -> b) -> a -> b +fn << arg = fn (toHtml arg) + + +concatHtml :: (HTML a) => [a] -> Html +concatHtml as = Html (concat (map (getHtmlElements.toHtml) as)) + +(+++) :: (HTML a,HTML b) => a -> b -> Html +a +++ b = Html (getHtmlElements (toHtml a) ++ getHtmlElements (toHtml b)) + +noHtml :: Html +noHtml = Html [] + + +isNoHtml :: Html -> Bool +isNoHtml (Html xs) = null xs + + +tag :: String -> Html -> Html +tag str htmls = + Html [ HtmlTag { markupTag = str, + markupAttrs = [], + markupContent = htmls } + ] + +itag :: String -> Html +itag str = tag str noHtml + +emptyAttr :: String -> HtmlAttr +emptyAttr s = HtmlAttr s "" + +intAttr :: String -> Int -> HtmlAttr +intAttr s i = HtmlAttr s (show i) + +strAttr :: String -> String -> HtmlAttr +strAttr s t = HtmlAttr s t + + +{- +foldHtml :: (String -> [HtmlAttr] -> [a] -> a) + -> (String -> a) + -> Html + -> a +foldHtml f g (HtmlTag str attr fmls) + = f str attr (map (foldHtml f g) fmls) +foldHtml f g (HtmlString str) + = g str + +-} +-- Processing Strings into Html friendly things. +-- This converts a String to a Html String. +stringToHtmlString :: String -> String +stringToHtmlString = concatMap fixChar + where + fixChar '<' = "<" + fixChar '>' = ">" + fixChar '&' = "&" + fixChar '"' = """ + fixChar c + | isAscii c = [c] + | otherwise = "&#x" ++ showHex (ord c) ";" + +-- --------------------------------------------------------------------------- +-- Classes + +instance Show Html where + showsPrec _ html = showString (prettyHtml html) + showList htmls = showString (concat (map show htmls)) + +instance Show HtmlAttr where + showsPrec _ (HtmlAttr str val) = + showString str . + showString "=" . + shows val + + +-- --------------------------------------------------------------------------- +-- Data types + +type URL = String + +-- --------------------------------------------------------------------------- +-- Basic primitives + +-- This is not processed for special chars. +-- use stringToHtml or lineToHtml instead, for user strings, +-- because they understand special chars, like '<'. + +primHtml :: String -> Html +primHtml x = Html [HtmlString x] + +-- --------------------------------------------------------------------------- +-- Basic Combinators + +stringToHtml :: String -> Html +stringToHtml = primHtml . stringToHtmlString + +-- This converts a string, but keeps spaces as non-line-breakable + +lineToHtml :: String -> Html +lineToHtml = primHtml . concatMap htmlizeChar2 . stringToHtmlString + where + htmlizeChar2 ' ' = " " + htmlizeChar2 c = [c] + +-- --------------------------------------------------------------------------- +-- Html Constructors + +-- (automatically generated) + +address :: Html -> Html +anchor :: Html -> Html +applet :: Html -> Html +area :: Html +basefont :: Html +big :: Html -> Html +blockquote :: Html -> Html +body :: Html -> Html +bold :: Html -> Html +br :: Html +button :: Html -> Html +caption :: Html -> Html +center :: Html -> Html +cite :: Html -> Html +ddef :: Html -> Html +define :: Html -> Html +dlist :: Html -> Html +dterm :: Html -> Html +emphasize :: Html -> Html +fieldset :: Html -> Html +font :: Html -> Html +form :: Html -> Html +frame :: Html -> Html +frameset :: Html -> Html +h1 :: Html -> Html +h2 :: Html -> Html +h3 :: Html -> Html +h4 :: Html -> Html +h5 :: Html -> Html +h6 :: Html -> Html +header :: Html -> Html +hr :: Html +image :: Html +input :: Html +italics :: Html -> Html +keyboard :: Html -> Html +legend :: Html -> Html +li :: Html -> Html +meta :: Html +noframes :: Html -> Html +olist :: Html -> Html +option :: Html -> Html +paragraph :: Html -> Html +param :: Html +pre :: Html -> Html +sample :: Html -> Html +script :: Html -> Html +select :: Html -> Html +small :: Html -> Html +strong :: Html -> Html +style :: Html -> Html +sub :: Html -> Html +sup :: Html -> Html +table :: Html -> Html +thetd :: Html -> Html +textarea :: Html -> Html +th :: Html -> Html +thebase :: Html +thecode :: Html -> Html +thediv :: Html -> Html +thehtml :: Html -> Html +thelink :: Html +themap :: Html -> Html +thespan :: Html -> Html +thetitle :: Html -> Html +tr :: Html -> Html +tt :: Html -> Html +ulist :: Html -> Html +underline :: Html -> Html +variable :: Html -> Html + +address = tag "ADDRESS" +anchor = tag "A" +applet = tag "APPLET" +area = itag "AREA" +basefont = itag "BASEFONT" +big = tag "BIG" +blockquote = tag "BLOCKQUOTE" +body = tag "BODY" +bold = tag "B" +br = itag "BR" +button = tag "BUTTON" +caption = tag "CAPTION" +center = tag "CENTER" +cite = tag "CITE" +ddef = tag "DD" +define = tag "DFN" +dlist = tag "DL" +dterm = tag "DT" +emphasize = tag "EM" +fieldset = tag "FIELDSET" +font = tag "FONT" +form = tag "FORM" +frame = tag "FRAME" +frameset = tag "FRAMESET" +h1 = tag "H1" +h2 = tag "H2" +h3 = tag "H3" +h4 = tag "H4" +h5 = tag "H5" +h6 = tag "H6" +header = tag "HEAD" +hr = itag "HR" +image = itag "IMG" +input = itag "INPUT" +italics = tag "I" +keyboard = tag "KBD" +legend = tag "LEGEND" +li = tag "LI" +meta = itag "META" +noframes = tag "NOFRAMES" +olist = tag "OL" +option = tag "OPTION" +paragraph = tag "P" +param = itag "PARAM" +pre = tag "PRE" +sample = tag "SAMP" +script = tag "SCRIPT" +select = tag "SELECT" +small = tag "SMALL" +strong = tag "STRONG" +style = tag "STYLE" +sub = tag "SUB" +sup = tag "SUP" +table = tag "TABLE" +thetd = tag "TD" +textarea = tag "TEXTAREA" +th = tag "TH" +thebase = itag "BASE" +thecode = tag "CODE" +thediv = tag "DIV" +thehtml = tag "HTML" +thelink = itag "LINK" +themap = tag "MAP" +thespan = tag "SPAN" +thetitle = tag "TITLE" +tr = tag "TR" +tt = tag "TT" +ulist = tag "UL" +underline = tag "U" +variable = tag "VAR" + +-- --------------------------------------------------------------------------- +-- Html Attributes + +-- (automatically generated) + +action :: String -> HtmlAttr +align :: String -> HtmlAttr +alink :: String -> HtmlAttr +alt :: String -> HtmlAttr +altcode :: String -> HtmlAttr +archive :: String -> HtmlAttr +background :: String -> HtmlAttr +base :: String -> HtmlAttr +bgcolor :: String -> HtmlAttr +border :: Int -> HtmlAttr +bordercolor :: String -> HtmlAttr +cellpadding :: Int -> HtmlAttr +cellspacing :: Int -> HtmlAttr +checked :: HtmlAttr +clear :: String -> HtmlAttr +code :: String -> HtmlAttr +codebase :: String -> HtmlAttr +color :: String -> HtmlAttr +cols :: String -> HtmlAttr +colspan :: Int -> HtmlAttr +compact :: HtmlAttr +content :: String -> HtmlAttr +coords :: String -> HtmlAttr +enctype :: String -> HtmlAttr +face :: String -> HtmlAttr +frameborder :: Int -> HtmlAttr +height :: Int -> HtmlAttr +href :: String -> HtmlAttr +hspace :: Int -> HtmlAttr +httpequiv :: String -> HtmlAttr +identifier :: String -> HtmlAttr +ismap :: HtmlAttr +lang :: String -> HtmlAttr +link :: String -> HtmlAttr +marginheight :: Int -> HtmlAttr +marginwidth :: Int -> HtmlAttr +maxlength :: Int -> HtmlAttr +method :: String -> HtmlAttr +multiple :: HtmlAttr +name :: String -> HtmlAttr +nohref :: HtmlAttr +noresize :: HtmlAttr +noshade :: HtmlAttr +nowrap :: HtmlAttr +onclick :: String -> HtmlAttr +rel :: String -> HtmlAttr +rev :: String -> HtmlAttr +rows :: String -> HtmlAttr +rowspan :: Int -> HtmlAttr +rules :: String -> HtmlAttr +scrolling :: String -> HtmlAttr +selected :: HtmlAttr +shape :: String -> HtmlAttr +size :: String -> HtmlAttr +src :: String -> HtmlAttr +start :: Int -> HtmlAttr +target :: String -> HtmlAttr +text :: String -> HtmlAttr +theclass :: String -> HtmlAttr +thestyle :: String -> HtmlAttr +thetype :: String -> HtmlAttr +title :: String -> HtmlAttr +usemap :: String -> HtmlAttr +valign :: String -> HtmlAttr +value :: String -> HtmlAttr +version :: String -> HtmlAttr +vlink :: String -> HtmlAttr +vspace :: Int -> HtmlAttr +width :: String -> HtmlAttr + +action = strAttr "ACTION" +align = strAttr "ALIGN" +alink = strAttr "ALINK" +alt = strAttr "ALT" +altcode = strAttr "ALTCODE" +archive = strAttr "ARCHIVE" +background = strAttr "BACKGROUND" +base = strAttr "BASE" +bgcolor = strAttr "BGCOLOR" +border = intAttr "BORDER" +bordercolor = strAttr "BORDERCOLOR" +cellpadding = intAttr "CELLPADDING" +cellspacing = intAttr "CELLSPACING" +checked = emptyAttr "CHECKED" +clear = strAttr "CLEAR" +code = strAttr "CODE" +codebase = strAttr "CODEBASE" +color = strAttr "COLOR" +cols = strAttr "COLS" +colspan = intAttr "COLSPAN" +compact = emptyAttr "COMPACT" +content = strAttr "CONTENT" +coords = strAttr "COORDS" +enctype = strAttr "ENCTYPE" +face = strAttr "FACE" +frameborder = intAttr "FRAMEBORDER" +height = intAttr "HEIGHT" +href = strAttr "HREF" +hspace = intAttr "HSPACE" +httpequiv = strAttr "HTTP-EQUIV" +identifier = strAttr "ID" +ismap = emptyAttr "ISMAP" +lang = strAttr "LANG" +link = strAttr "LINK" +marginheight = intAttr "MARGINHEIGHT" +marginwidth = intAttr "MARGINWIDTH" +maxlength = intAttr "MAXLENGTH" +method = strAttr "METHOD" +multiple = emptyAttr "MULTIPLE" +name = strAttr "NAME" +nohref = emptyAttr "NOHREF" +noresize = emptyAttr "NORESIZE" +noshade = emptyAttr "NOSHADE" +nowrap = emptyAttr "NOWRAP" +onclick = strAttr "ONCLICK" +rel = strAttr "REL" +rev = strAttr "REV" +rows = strAttr "ROWS" +rowspan = intAttr "ROWSPAN" +rules = strAttr "RULES" +scrolling = strAttr "SCROLLING" +selected = emptyAttr "SELECTED" +shape = strAttr "SHAPE" +size = strAttr "SIZE" +src = strAttr "SRC" +start = intAttr "START" +target = strAttr "TARGET" +text = strAttr "TEXT" +theclass = strAttr "CLASS" +thestyle = strAttr "STYLE" +thetype = strAttr "TYPE" +title = strAttr "TITLE" +usemap = strAttr "USEMAP" +valign = strAttr "VALIGN" +value = strAttr "VALUE" +version = strAttr "VERSION" +vlink = strAttr "VLINK" +vspace = intAttr "VSPACE" +width = strAttr "WIDTH" + +-- --------------------------------------------------------------------------- +-- Html Constructors + +-- (automatically generated) + +validHtmlTags :: [String] +validHtmlTags = [ + "ADDRESS", + "A", + "APPLET", + "BIG", + "BLOCKQUOTE", + "BODY", + "B", + "CAPTION", + "CENTER", + "CITE", + "DD", + "DFN", + "DL", + "DT", + "EM", + "FIELDSET", + "FONT", + "FORM", + "FRAME", + "FRAMESET", + "H1", + "H2", + "H3", + "H4", + "H5", + "H6", + "HEAD", + "I", + "KBD", + "LEGEND", + "LI", + "NOFRAMES", + "OL", + "OPTION", + "P", + "PRE", + "SAMP", + "SELECT", + "SMALL", + "STRONG", + "STYLE", + "SUB", + "SUP", + "TABLE", + "TD", + "TEXTAREA", + "TH", + "CODE", + "DIV", + "HTML", + "LINK", + "MAP", + "TITLE", + "TR", + "TT", + "UL", + "U", + "VAR"] + +validHtmlITags :: [String] +validHtmlITags = [ + "AREA", + "BASEFONT", + "BR", + "HR", + "IMG", + "INPUT", + "LINK", + "META", + "PARAM", + "BASE"] + +validHtmlAttrs :: [String] +validHtmlAttrs = [ + "ACTION", + "ALIGN", + "ALINK", + "ALT", + "ALTCODE", + "ARCHIVE", + "BACKGROUND", + "BASE", + "BGCOLOR", + "BORDER", + "BORDERCOLOR", + "CELLPADDING", + "CELLSPACING", + "CHECKED", + "CLEAR", + "CODE", + "CODEBASE", + "COLOR", + "COLS", + "COLSPAN", + "COMPACT", + "CONTENT", + "COORDS", + "ENCTYPE", + "FACE", + "FRAMEBORDER", + "HEIGHT", + "HREF", + "HSPACE", + "HTTP-EQUIV", + "ID", + "ISMAP", + "LANG", + "LINK", + "MARGINHEIGHT", + "MARGINWIDTH", + "MAXLENGTH", + "METHOD", + "MULTIPLE", + "NAME", + "NOHREF", + "NORESIZE", + "NOSHADE", + "NOWRAP", + "REL", + "REV", + "ROWS", + "ROWSPAN", + "RULES", + "SCROLLING", + "SELECTED", + "SHAPE", + "SIZE", + "SRC", + "START", + "TARGET", + "TEXT", + "CLASS", + "STYLE", + "TYPE", + "TITLE", + "USEMAP", + "VALIGN", + "VALUE", + "VERSION", + "VLINK", + "VSPACE", + "WIDTH"] + +-- --------------------------------------------------------------------------- +-- Html colors + +aqua :: String +black :: String +blue :: String +fuchsia :: String +gray :: String +green :: String +lime :: String +maroon :: String +navy :: String +olive :: String +purple :: String +red :: String +silver :: String +teal :: String +yellow :: String +white :: String + +aqua = "aqua" +black = "black" +blue = "blue" +fuchsia = "fuchsia" +gray = "gray" +green = "green" +lime = "lime" +maroon = "maroon" +navy = "navy" +olive = "olive" +purple = "purple" +red = "red" +silver = "silver" +teal = "teal" +yellow = "yellow" +white = "white" + +-- --------------------------------------------------------------------------- +-- Basic Combinators + +linesToHtml :: [String] -> Html + +linesToHtml [] = noHtml +linesToHtml (x:[]) = lineToHtml x +linesToHtml (x:xs) = lineToHtml x +++ br +++ linesToHtml xs + + +-- --------------------------------------------------------------------------- +-- Html abbriviations + +primHtmlChar :: String -> Html +copyright :: Html +spaceHtml :: Html +bullet :: Html +p :: Html -> Html + +primHtmlChar = \ x -> primHtml ("&" ++ x ++ ";") +copyright = primHtmlChar "copy" +spaceHtml = primHtmlChar "nbsp" +bullet = primHtmlChar "#149" + +p = paragraph + +-- --------------------------------------------------------------------------- +-- Html tables + +cell :: Html -> HtmlTable +cell h = let + cellFn x y = h ! (add x colspan $ add y rowspan $ []) + add 1 _ rest = rest + add n fn rest = fn n : rest + r = BT.single cellFn + in + mkHtmlTable r + +-- We internally represent the Cell inside a Table with an +-- object of the type +-- \pre{ +-- Int -> Int -> Html +-- } +-- When we render it later, we find out how many columns +-- or rows this cell will span over, and can +-- include the correct colspan/rowspan command. + +newtype HtmlTable + = HtmlTable (BT.BlockTable (Int -> Int -> Html)) + +td :: Html -> HtmlTable +td = cell . thetd + +tda :: [HtmlAttr] -> Html -> HtmlTable +tda as = cell . (thetd ! as) + +above, beside :: HtmlTable -> HtmlTable -> HtmlTable +above a b = combine BT.above a b +beside a b = combine BT.beside a b + +infixr 3 -- combining table cells +infixr 4 <-> -- combining table cells +(), (<->) :: HtmlTable -> HtmlTable -> HtmlTable +() = above +(<->) = beside + +emptyTable :: HtmlTable +emptyTable = HtmlTable BT.empty + +aboves, besides :: [HtmlTable] -> HtmlTable +aboves = foldr above emptyTable +besides = foldr beside emptyTable + +mkHtmlTable :: BT.BlockTable (Int -> Int -> Html) -> HtmlTable +mkHtmlTable r = HtmlTable r + +combine :: (BT.BlockTable (Int -> Int -> Html) + -> BT.BlockTable (Int -> Int -> Html) + -> BT.BlockTable (Int -> Int -> Html)) + -> HtmlTable -> HtmlTable -> HtmlTable +combine fn (HtmlTable a) (HtmlTable b) = mkHtmlTable (a `fn` b) + +-- renderTable takes the HtmlTable, and renders it back into +-- and Html object. + +renderTable :: BT.BlockTable (Int -> Int -> Html) -> Html +renderTable theTable + = concatHtml + [tr << [theCell x y | (theCell,(x,y)) <- theRow ] + | theRow <- BT.getMatrix theTable] + +instance HTML HtmlTable where + toHtml (HtmlTable tab) = renderTable tab + +instance Show HtmlTable where + showsPrec _ (HtmlTable tab) = shows (renderTable tab) + + +-- If you can't be bothered with the above, then you +-- can build simple tables with simpleTable. +-- Just provide the attributes for the whole table, +-- attributes for the cells (same for every cell), +-- and a list of lists of cell contents, +-- and this function will build the table for you. +-- It does presume that all the lists are non-empty, +-- and there is at least one list. +-- +-- Different length lists means that the last cell +-- gets padded. If you want more power, then +-- use the system above, or build tables explicitly. + +simpleTable :: HTML a => [HtmlAttr] -> [HtmlAttr] -> [[a]] -> Html +simpleTable attr cellAttr lst + = table ! attr + << (aboves + . map (besides . map (cell . (thetd ! cellAttr) . toHtml)) + ) lst + + +-- --------------------------------------------------------------------------- +-- Tree Displaying Combinators + +-- The basic idea is you render your structure in the form +-- of this tree, and then use treeHtml to turn it into a Html +-- object with the structure explicit. + +data HtmlTree + = HtmlLeaf Html + | HtmlNode Html [HtmlTree] Html + +treeHtml :: [String] -> HtmlTree -> Html +treeHtml colors h = table ! [ + border 0, + cellpadding 0, + cellspacing 2] << treeHtml' colors h + where + manycolors = scanr (:) [] + + treeHtmls :: [[String]] -> [HtmlTree] -> HtmlTable + treeHtmls c ts = aboves (zipWith treeHtml' c ts) + + treeHtml' :: [String] -> HtmlTree -> HtmlTable + treeHtml' (_:_) (HtmlLeaf leaf) = cell + (thetd ! [width "100%"] + << bold + << leaf) + treeHtml' (c:cs@(c2:_)) (HtmlNode hopen ts hclose) = + if null ts && isNoHtml hclose + then + hd + else if null ts + then + hd bar `beside` (cell . (thetd ! [bgcolor c2]) << spaceHtml) + tl + else + hd (bar `beside` treeHtmls morecolors ts) + tl + where + -- This stops a column of colors being the same + -- color as the immeduately outside nesting bar. + morecolors = filter ((/= c).head) (manycolors cs) + bar = cell (thetd ! [bgcolor c,width "10"] << spaceHtml) + hd = cell (thetd ! [bgcolor c] << hopen) + tl = cell (thetd ! [bgcolor c] << hclose) + treeHtml' _ _ = error "The imposible happens" + +instance HTML HtmlTree where + toHtml x = treeHtml treeColors x + +-- type "length treeColors" to see how many colors are here. +treeColors :: [String] +treeColors = ["#88ccff","#ffffaa","#ffaaff","#ccffff"] ++ treeColors + + +-- --------------------------------------------------------------------------- +-- Html Debugging Combinators + +-- This uses the above tree rendering function, and displays the +-- Html as a tree structure, allowing debugging of what is +-- actually getting produced. + +debugHtml :: (HTML a) => a -> Html +debugHtml obj = table ! [border 0] << ( + cell (th ! [bgcolor "#008888"] + << underline + << "Debugging Output") + td << (toHtml (debug' (toHtml obj))) + ) + where + + debug' :: Html -> [HtmlTree] + debug' (Html markups) = map debug markups + + debug :: HtmlElement -> HtmlTree + debug (HtmlString str) = HtmlLeaf (spaceHtml +++ + linesToHtml (lines str)) + debug (HtmlTag { + markupTag = markupTag0, + markupContent = markupContent0, + markupAttrs = markupAttrs0 + }) = + case markupContent0 of + Html [] -> HtmlNode hd [] noHtml + Html xs -> HtmlNode hd (map debug xs) tl + where + args = if null markupAttrs0 + then "" + else " " ++ unwords (map show markupAttrs0) + hd = font ! [size "1"] << ("<" ++ markupTag0 ++ args ++ ">") + tl = font ! [size "1"] << ("") + +-- --------------------------------------------------------------------------- +-- Hotlink datatype + +data HotLink = HotLink { + hotLinkURL :: URL, + hotLinkContents :: [Html], + hotLinkAttributes :: [HtmlAttr] + } deriving Show + +instance HTML HotLink where + toHtml hl = anchor ! (href (hotLinkURL hl) : hotLinkAttributes hl) + << hotLinkContents hl + +hotlink :: URL -> [Html] -> HotLink +hotlink url h = HotLink { + hotLinkURL = url, + hotLinkContents = h, + hotLinkAttributes = [] } + + +-- --------------------------------------------------------------------------- +-- More Combinators + +-- (Abridged from Erik Meijer's Original Html library) + +ordList :: (HTML a) => [a] -> Html +ordList items = olist << map (li <<) items + +unordList :: (HTML a) => [a] -> Html +unordList items = ulist << map (li <<) items + +defList :: (HTML a,HTML b) => [(a,b)] -> Html +defList items + = dlist << [ [ dterm << bold << dt, ddef << dd ] | (dt,dd) <- items ] + + +widget :: String -> String -> [HtmlAttr] -> Html +widget w n markupAttrs0 = input ! ([thetype w,name n] ++ markupAttrs0) + +checkbox :: String -> String -> Html +hidden :: String -> String -> Html +radio :: String -> String -> Html +reset :: String -> String -> Html +submit :: String -> String -> Html +password :: String -> Html +textfield :: String -> Html +afile :: String -> Html +clickmap :: String -> Html + +checkbox n v = widget "CHECKBOX" n [value v] +hidden n v = widget "HIDDEN" n [value v] +radio n v = widget "RADIO" n [value v] +reset n v = widget "RESET" n [value v] +submit n v = widget "SUBMIT" n [value v] +password n = widget "PASSWORD" n [] +textfield n = widget "TEXT" n [] +afile n = widget "FILE" n [] +clickmap n = widget "IMAGE" n [] + +menu :: String -> [Html] -> Html +menu n choices + = select ! [name n] << [ option << p << choice | choice <- choices ] + +gui :: String -> Html -> Html +gui act = form ! [action act,method "POST"] + +-- --------------------------------------------------------------------------- +-- Html Rendering + +-- Uses the append trick to optimize appending. +-- The output is quite messy, because space matters in +-- HTML, so we must not generate needless spaces. + +renderHtml :: (HTML html) => html -> String +renderHtml theHtml = + renderMessage ++ + foldr (.) id (map unprettyHtml + (getHtmlElements (tag "HTML" << theHtml))) "\n" + +renderMessage :: String +renderMessage = + "\n" ++ + "\n" + +unprettyHtml :: HtmlElement -> ShowS +unprettyHtml (HtmlString str) = (++) str +unprettyHtml (HtmlTag + { markupTag = name0, + markupContent = html, + markupAttrs = markupAttrs0 }) + = if isNoHtml html && elem name0 validHtmlITags + then renderTag True name0 markupAttrs0 0 + else (renderTag True name0 markupAttrs0 0 + . foldr (.) id (map unprettyHtml (getHtmlElements html)) + . renderTag False name0 [] 0) + +-- Local Utilities +prettyHtml :: (HTML html) => html -> String +prettyHtml theHtml = + unlines + $ concat + $ map prettyHtml' + $ getHtmlElements + $ toHtml theHtml + +prettyHtml' :: HtmlElement -> [String] +prettyHtml' (HtmlString str) = [str] +prettyHtml' (HtmlTag + { markupTag = name0, + markupContent = html, + markupAttrs = markupAttrs0 }) + = if isNoHtml html && elem name0 validHtmlITags + then + [rmNL (renderTag True name0 markupAttrs0 0 "")] + else + [rmNL (renderTag True name0 markupAttrs0 0 "")] ++ + shift (concat (map prettyHtml' (getHtmlElements html))) ++ + [rmNL (renderTag False name0 [] 0 "")] + where + shift = map (\x -> " " ++ x) + +rmNL :: [Char] -> [Char] +rmNL = filter (/= '\n') + +-- This prints the Tags The lack of spaces in intentunal, because Html is +-- actually space dependant. + +renderTag :: Bool -> String -> [HtmlAttr] -> Int -> ShowS +renderTag x name0 markupAttrs0 n r + = open ++ name0 ++ rest markupAttrs0 ++ ">" ++ r + where + open = if x then "<" else " String + showPair (HtmlAttr tag0 val) + = tag0 ++ "=\"" ++ val ++ "\"" + diff --git a/src/Haddock/Version.hs b/src/Haddock/Version.hs new file mode 100644 --- /dev/null +++ b/src/Haddock/Version.hs @@ -0,0 +1,18 @@ +-- +-- Haddock - A Haskell Documentation Tool +-- +-- (c) Simon Marlow 2003 +-- + +module Haddock.Version ( + projectName, projectVersion, projectUrl +) where + +import Paths_haddock ( version ) +import Data.Version ( showVersion ) + +projectName, projectUrl :: String +projectName = "Haddock" +projectUrl = "http://www.haskell.org/haddock/" + +projectVersion = showVersion version diff --git a/src/HaddockDB.hs b/src/HaddockDB.hs deleted file mode 100644 --- a/src/HaddockDB.hs +++ /dev/null @@ -1,165 +0,0 @@ --- --- Haddock - A Haskell Documentation Tool --- --- (c) Simon Marlow 2003 --- - -module HaddockDB (ppDocBook) where - -{- -import HaddockTypes -import HaddockUtil -import HsSyn - -import Text.PrettyPrint --} - ------------------------------------------------------------------------------ --- Printing the results in DocBook format - -ppDocBook = error "not working" -{- -ppDocBook :: FilePath -> [(Module, Interface)] -> String -ppDocBook odir mods = render (ppIfaces mods) - -ppIfaces mods - = text "" - $$ text "" - $$ text "" - $$ text "HaskellDoc version 0.0" - $$ text "" - $$ text "
    " - $$ vcat (map do_mod mods) - $$ text "
    " - where - do_mod (Module mod, iface) - = text " text mod <> text "\">" - $$ text "<literal>" - <> text mod - <> text "</literal>" - $$ text "" - <> text mod - <> text "" - $$ text "" - $$ vcat (map (do_export mod) (eltsFM (iface_decls iface))) - $$ text "" - $$ text "" - - do_export mod decl | (nm:_) <- declBinders decl - = text "" - <> do_decl decl - <> text "" - $$ text "" - $$ text "" - $$ text "" - $$ text "" - $$ text "" - do_export _ _ = empty - - do_decl (HsTypeSig _ [nm] ty _) - = ppHsName nm <> text " :: " <> ppHsType ty - do_decl (HsTypeDecl _ nm args ty _) - = hsep ([text "type", ppHsName nm ] - ++ map ppHsName args - ++ [equals, ppHsType ty]) - do_decl (HsNewTypeDecl loc ctx nm args con drv _) - = hsep ([text "data", ppHsName nm] -- data, not newtype - ++ map ppHsName args - ) <+> equals <+> ppHsConstr con -- ToDo: derivings - do_decl (HsDataDecl loc ctx nm args cons drv _) - = hsep ([text "data", {-ToDo: context-}ppHsName nm] - ++ map ppHsName args) - <+> vcat (zipWith (<+>) (equals : repeat (char '|')) - (map ppHsConstr cons)) - do_decl (HsClassDecl loc ty fds decl _) - = hsep [text "class", ppHsType ty] - do_decl decl - = empty - -ppHsConstr :: HsConDecl -> Doc -ppHsConstr (HsRecDecl pos name tvs ctxt fieldList maybe_doc) = - ppHsName name - <> (braces . hsep . punctuate comma . map ppField $ fieldList) -ppHsConstr (HsConDecl pos name tvs ctxt typeList maybe_doc) = - hsep (ppHsName name : map ppHsBangType typeList) - -ppField (HsFieldDecl ns ty doc) - = hsep (punctuate comma (map ppHsName ns) ++ - [text "::", ppHsBangType ty]) - -ppHsBangType :: HsBangType -> Doc -ppHsBangType (HsBangedTy ty) = char '!' <> ppHsType ty -ppHsBangType (HsUnBangedTy ty) = ppHsType ty - -ppHsContext :: HsContext -> Doc -ppHsContext [] = empty -ppHsContext context = parenList (map (\ (a,b) -> ppHsQName a <+> - hsep (map ppHsAType b)) context) - -ppHsType :: HsType -> Doc -ppHsType (HsForAllType Nothing context htype) = - hsep [ ppHsContext context, text "=>", ppHsType htype] -ppHsType (HsForAllType (Just tvs) [] htype) = - hsep (text "forall" : map ppHsName tvs ++ text "." : [ppHsType htype]) -ppHsType (HsForAllType (Just tvs) context htype) = - hsep (text "forall" : map ppHsName tvs ++ text "." : - ppHsContext context : text "=>" : [ppHsType htype]) -ppHsType (HsTyFun a b) = fsep [ppHsBType a, text "->", ppHsType b] -ppHsType (HsTyIP n t) = fsep [(char '?' <> ppHsName n), text "::", ppHsType t] -ppHsType t = ppHsBType t - -ppHsBType (HsTyApp (HsTyCon (Qual (Module "Prelude") (HsTyClsName (HsSpecial "[]")))) b ) - = brackets $ ppHsType b -ppHsBType (HsTyApp a b) = fsep [ppHsBType a, ppHsAType b] -ppHsBType t = ppHsAType t - -ppHsAType :: HsType -> Doc -ppHsAType (HsTyTuple True l) = parenList . map ppHsType $ l -ppHsAType (HsTyTuple False l) = ubxParenList . map ppHsType $ l --- special case -ppHsAType (HsTyApp (HsTyCon (Qual (Module "Prelude") (HsTyClsName (HsSpecial "[]")))) b ) - = brackets $ ppHsType b -ppHsAType (HsTyVar name) = ppHsName name -ppHsAType (HsTyCon name) = ppHsQName name -ppHsAType t = parens $ ppHsType t - -ppHsQName :: HsQName -> Doc -ppHsQName (UnQual str) = ppHsName str -ppHsQName n@(Qual (Module mod) str) - | n == unit_con_name = ppHsName str - | isSpecial str = ppHsName str - | otherwise - = text "" - -isSpecial (HsTyClsName id) | HsSpecial _ <- id = True -isSpecial (HsVarName id) | HsSpecial _ <- id = True -isSpecial _ = False - -ppHsName :: HsName -> Doc -ppHsName (HsTyClsName id) = ppHsIdentifier id -ppHsName (HsVarName id) = ppHsIdentifier id - -ppHsIdentifier :: HsIdentifier -> Doc -ppHsIdentifier (HsIdent str) = text str -ppHsIdentifier (HsSymbol str) = text str -ppHsIdentifier (HsSpecial str) = text str - -ppLinkId :: String -> HsName -> Doc -ppLinkId mod str - = hcat [char '\"', text mod, char '.', ppHsName str, char '\"'] - --- ----------------------------------------------------------------------------- --- * Misc - -parenList :: [Doc] -> Doc -parenList = parens . fsep . punctuate comma - -ubxParenList :: [Doc] -> Doc -ubxParenList = ubxparens . fsep . punctuate comma - -ubxparens p = text "(#" <> p <> text "#)" --} diff --git a/src/HaddockDevHelp.hs b/src/HaddockDevHelp.hs deleted file mode 100644 --- a/src/HaddockDevHelp.hs +++ /dev/null @@ -1,73 +0,0 @@ -module HaddockDevHelp(ppDevHelpFile) where - -import HaddockModuleTree -import HaddockTypes -import HaddockUtil -import HsSyn hiding(Doc) -import qualified Map - -import Data.Maybe ( fromMaybe ) -import Text.PrettyPrint - - -ppDevHelpFile :: FilePath -> String -> Maybe String -> [Interface] -> IO () -ppDevHelpFile odir doctitle maybe_package ifaces = do - let devHelpFile = package++".devhelp" - tree = mkModuleTree [ (iface_module iface, - iface_package iface, - toDescription iface) - | iface <- ifaces ] - doc = - text "" $$ - (text "text doctitle<> - text "\" link=\""<>text contentsHtmlFile<>text"\" author=\"\" name=\""<>text package<>text "\">") $$ - text "" $$ - nest 4 (ppModuleTree [] tree) $+$ - text "" $$ - text "" $$ - nest 4 (ppList index) $+$ - text "" $$ - text "" - writeFile (pathJoin [odir, devHelpFile]) (render doc) - where - package = fromMaybe "pkg" maybe_package - - ppModuleTree :: [String] -> [ModuleTree] -> Doc - ppModuleTree ss [x] = ppNode ss x - ppModuleTree ss (x:xs) = ppNode ss x $$ ppModuleTree ss xs - ppModuleTree _ [] = error "HaddockHH.ppHHContents.fn: no module trees given" - - ppNode :: [String] -> ModuleTree -> Doc - ppNode ss (Node s leaf _pkg _short ts) = - case ts of - [] -> text "ppAttribs<>text "/>" - ts -> - text "ppAttribs<>text ">" $$ - nest 4 (ppModuleTree (s:ss) ts) $+$ - text "" - where - ppLink | leaf = text (moduleHtmlFile mdl) - | otherwise = empty - - ppAttribs = text "name="<>doubleQuotes (text s)<+>text "link="<>doubleQuotes ppLink - - mdl = foldr (++) "" (s' : map ('.':) ss') - (s':ss') = reverse (s:ss) - -- reconstruct the module name - - index :: [(HsName, [Module])] - index = Map.toAscList (foldr getIfaceIndex Map.empty ifaces) - - getIfaceIndex iface fm = - Map.unionWith (++) (Map.fromListWith (flip (++)) [(name, [mdl]) | (name, Qual mdl' _) <- Map.toAscList (iface_env iface), mdl == mdl']) fm - where mdl = iface_module iface - - ppList [] = empty - ppList ((name,refs):mdls) = - ppReference name refs $$ - ppList mdls - - ppReference name [] = empty - ppReference name (Module mdl:refs) = - text "text (escapeStr (show name))<>text"\" link=\""<>text (nameHtmlRef mdl name)<>text"\"/>" $$ - ppReference name refs diff --git a/src/HaddockHH.hs b/src/HaddockHH.hs deleted file mode 100644 --- a/src/HaddockHH.hs +++ /dev/null @@ -1,168 +0,0 @@ -module HaddockHH(ppHHContents, ppHHIndex, ppHHProject) where - -import HaddockModuleTree -import HaddockTypes -import HaddockUtil -import HsSyn hiding(Doc) -import qualified Map - -import Data.Char ( toUpper ) -import Data.Maybe ( fromMaybe ) -import Text.PrettyPrint - -ppHHContents :: FilePath -> String -> Maybe String -> [ModuleTree] -> IO () -ppHHContents odir doctitle maybe_package tree = do - let contentsHHFile = package++".hhc" - - html = - text "" $$ - text "" $$ - text "" $$ - text "" $$ - text "" $$ - text "" $$ - ppModuleTree tree $$ - text "" - writeFile (pathJoin [odir, contentsHHFile]) (render html) - where - package = fromMaybe "pkg" maybe_package - - ppModuleTree :: [ModuleTree] -> Doc - ppModuleTree ts = - text "" $$ - text "" $$ - text "" $$ - text "
      " $+$ - nest 4 (text "
    • " <> nest 4 - (text "" $$ - nest 4 (text "text doctitle<>text "\">" $$ - text "") $$ - text "") $+$ - text "
      • " $$ - text "
        " $+$ - nest 4 (fn [] ts) $+$ - text "
      ") $+$ - text "
    " - - fn :: [String] -> [ModuleTree] -> Doc - fn ss [x] = ppNode ss x - fn ss (x:xs) = ppNode ss x $$ fn ss xs - fn _ [] = error "HaddockHH.ppHHContents.fn: no module trees given" - - ppNode :: [String] -> ModuleTree -> Doc - ppNode ss (Node s leaf _pkg _ []) = - ppLeaf s ss leaf - ppNode ss (Node s leaf _pkg _ ts) = - ppLeaf s ss leaf $$ - text "
      " $+$ - nest 4 (fn (s:ss) ts) $+$ - text "
    " - - ppLeaf s ss isleaf = - text "
  • " <> nest 4 - (text "" $$ - text " text s <> text "\">" $$ - (if isleaf then text " text (moduleHtmlFile mdl) <> text "\">" else empty) $$ - text "") $+$ - text "
    • " - where - mdl = foldr (++) "" (s' : map ('.':) ss') - (s':ss') = reverse (s:ss) - -- reconstruct the module name - -------------------------------- -ppHHIndex :: FilePath -> Maybe String -> [Interface] -> IO () -ppHHIndex odir maybe_package ifaces = do - let indexHHFile = package++".hhk" - - html = - text "" $$ - text "" $$ - text "" $$ - text "" $$ - text "" $$ - text "" $$ - text "
      " $+$ - nest 4 (ppList index) $+$ - text "
    " $$ - text "" - writeFile (pathJoin [odir, indexHHFile]) (render html) - where - package = fromMaybe "pkg" maybe_package - - index :: [(HsName, [Module])] - index = Map.toAscList (foldr getIfaceIndex Map.empty ifaces) - - getIfaceIndex iface fm = - foldl (\m (k,e) -> Map.insertWith (++) k e m) fm [(name, [mdl]) | (name, Qual mdl' _) <- Map.toAscList (iface_env iface), mdl == mdl'] - where mdl = iface_module iface - - ppList [] = empty - ppList ((name,refs):mdls) = - text "
  • " <> nest 4 - (text "" $$ - text " text (show name) <> text "\">" $$ - ppReference name refs $$ - text "") $+$ - text "
    • " $$ - ppList mdls - - ppReference name [] = empty - ppReference name (Module mdl:refs) = - text " text (nameHtmlRef mdl name) <> text "\">" $$ - ppReference name refs - - -ppHHProject :: FilePath -> String -> Maybe String -> [Interface] -> [FilePath] -> IO () -ppHHProject odir doctitle maybe_package ifaces pkg_paths = do - let projectHHFile = package++".hhp" - doc = - text "[OPTIONS]" $$ - text "Compatibility=1.1 or later" $$ - text "Compiled file=" <> text package <> text ".chm" $$ - text "Contents file=" <> text package <> text ".hhc" $$ - text "Default topic=" <> text contentsHtmlFile $$ - text "Display compile progress=No" $$ - text "Index file=" <> text package <> text ".hhk" $$ - text "Title=" <> text doctitle $$ - space $$ - text "[FILES]" $$ - ppMods ifaces $$ - text contentsHtmlFile $$ - text indexHtmlFile $$ - ppIndexFiles chars $$ - ppLibFiles ("":pkg_paths) - writeFile (pathJoin [odir, projectHHFile]) (render doc) - where - package = fromMaybe "pkg" maybe_package - - ppMods [] = empty - ppMods (iface:ifaces) = - let Module mdl = iface_module iface in - text (moduleHtmlFile mdl) $$ - ppMods ifaces - - ppIndexFiles [] = empty - ppIndexFiles (c:cs) = - text (subIndexHtmlFile c) $$ - ppIndexFiles cs - - ppLibFiles [] = empty - ppLibFiles (path:paths) = - ppLibFile cssFile $$ - ppLibFile iconFile $$ - ppLibFile jsFile $$ - ppLibFile plusFile $$ - ppLibFile minusFile $$ - ppLibFiles paths - where - toPath fname | null path = fname - | otherwise = pathJoin [path, fname] - ppLibFile fname = text (toPath fname) - - chars :: [Char] - chars = map fst (Map.toAscList (foldr getIfaceIndex Map.empty ifaces)) - - getIfaceIndex iface fm = - Map.union (Map.fromList [(toUpper (head (show name)),()) | (name, Qual mdl' _) <- Map.toAscList (iface_env iface), mdl == mdl']) fm - where mdl = iface_module iface diff --git a/src/HaddockHH2.hs b/src/HaddockHH2.hs deleted file mode 100644 --- a/src/HaddockHH2.hs +++ /dev/null @@ -1,175 +0,0 @@ -module HaddockHH2(ppHH2Contents, ppHH2Index, ppHH2Files, ppHH2Collection) where - -import HaddockModuleTree -import HaddockTypes -import HaddockUtil -import HsSyn hiding(Doc) -import qualified Map - -import Data.Char ( toUpper ) -import Data.Maybe ( fromMaybe ) -import Text.PrettyPrint - -ppHH2Contents :: FilePath -> String -> Maybe String -> [ModuleTree] -> IO () -ppHH2Contents odir doctitle maybe_package tree = do - let - contentsHH2File = package++".HxT" - - doc = - text "" $$ - text "" $$ - text "" $$ - nest 4 (text "text doctitle<>text"\" Url=\"index.html\">" $$ - nest 4 (ppModuleTree [] tree) $+$ - text "") $$ - text "" - writeFile (pathJoin [odir, contentsHH2File]) (render doc) - where - package = fromMaybe "pkg" maybe_package - - ppModuleTree :: [String] -> [ModuleTree] -> Doc - ppModuleTree ss [x] = ppNode ss x - ppModuleTree ss (x:xs) = ppNode ss x $$ ppModuleTree ss xs - ppModuleTree _ [] = error "HaddockHH2.ppHH2Contents.ppModuleTree: no module trees given" - - ppNode :: [String] -> ModuleTree -> Doc - ppNode ss (Node s leaf _pkg _short []) = - text " ppAttributes leaf (s:ss) <> text "/>" - ppNode ss (Node s leaf _pkg _short ts) = - text " ppAttributes leaf (s:ss) <> text ">" $$ - nest 4 (ppModuleTree (s:ss) ts) $+$ - text "" - - ppAttributes :: Bool -> [String] -> Doc - ppAttributes isleaf ss = hsep [ppId,ppTitle,ppUrl] - where - mdl = foldr (++) "" (s' : map ('.':) ss') - (s':ss') = reverse ss - -- reconstruct the module name - - ppId = text "Id=" <> doubleQuotes (text mdl) - - ppTitle = text "Title=" <> doubleQuotes (text (head ss)) - - ppUrl | isleaf = text " Url=" <> doubleQuotes (text (moduleHtmlFile mdl)) - | otherwise = empty - ------------------------------------------------------------------------------------ - -ppHH2Index :: FilePath -> Maybe String -> [Interface] -> IO () -ppHH2Index odir maybe_package ifaces = do - let - indexKHH2File = package++"K.HxK" - indexNHH2File = package++"N.HxK" - docK = - text "" $$ - text "" $$ - text "" $$ - nest 4 (ppList index) $+$ - text "" - docN = - text "" $$ - text "" $$ - text "" $$ - text "" $$ - nest 4 (text "text contentsHtmlFile<>text "\"/>") $$ - text "" $$ - text "" - writeFile (pathJoin [odir, indexKHH2File]) (render docK) - writeFile (pathJoin [odir, indexNHH2File]) (render docN) - where - package = fromMaybe "pkg" maybe_package - - index :: [(HsName, [Module])] - index = Map.toAscList (foldr getIfaceIndex Map.empty ifaces) - - getIfaceIndex iface fm = - Map.unionWith (++) (Map.fromListWith (flip (++)) [(name, [mdl]) | (name, Qual mdl' _) <- Map.toAscList (iface_env iface), mdl == mdl']) fm - where mdl = iface_module iface - - ppList [] = empty - ppList ((name,mdls):vs) = - text " text (escapeStr (show name)) <> text "\">" $$ - nest 4 (vcat (map (ppJump name) mdls)) $$ - text "" $$ - ppList vs - - ppJump name (Module mdl) = text " text (nameHtmlRef mdl name) <> text "\"/>" - - ------------------------------------------------------------------------------------ - -ppHH2Files :: FilePath -> Maybe String -> [Interface] -> [FilePath] -> IO () -ppHH2Files odir maybe_package ifaces pkg_paths = do - let filesHH2File = package++".HxF" - doc = - text "" $$ - text "" $$ - text "" $$ - nest 4 (ppMods ifaces $$ - text "text contentsHtmlFile<>text "\"/>" $$ - text "text indexHtmlFile<>text "\"/>" $$ - ppIndexFiles chars $$ - ppLibFiles ("":pkg_paths)) $$ - text "" - writeFile (pathJoin [odir, filesHH2File]) (render doc) - where - package = fromMaybe "pkg" maybe_package - - ppMods [] = empty - ppMods (iface:ifaces) = - text " text (moduleHtmlFile mdl) <> text "\"/>" $$ - ppMods ifaces - where Module mdl = iface_module iface - - ppIndexFiles [] = empty - ppIndexFiles (c:cs) = - text "text (subIndexHtmlFile c)<>text "\"/>" $$ - ppIndexFiles cs - - ppLibFiles [] = empty - ppLibFiles (path:paths) = - ppLibFile cssFile $$ - ppLibFile iconFile $$ - ppLibFile jsFile $$ - ppLibFile plusFile $$ - ppLibFile minusFile $$ - ppLibFiles paths - where - toPath fname | null path = fname - | otherwise = pathJoin [path, fname] - ppLibFile fname = text "text (toPath fname)<>text "\"/>" - - chars :: [Char] - chars = map fst (Map.toAscList (foldr getIfaceIndex Map.empty ifaces)) - - getIfaceIndex iface fm = - Map.union (Map.fromList [(toUpper (head (show name)),()) | (name, Qual mdl' _) <- Map.toAscList (iface_env iface), mdl == mdl']) fm - where mdl = iface_module iface - ------------------------------------------------------------------------------------ - -ppHH2Collection :: FilePath -> String -> Maybe String -> IO () -ppHH2Collection odir doctitle maybe_package = do - let - package = fromMaybe "pkg" maybe_package - collectionHH2File = package++".HxC" - - doc = - text "" $$ - text "" $$ - text " text doctitle <> text "\">" $$ - nest 4 (text "" $$ - nest 4 (text " text package <> text ".HxF\"/>") $$ - text "" $$ - text " text package <> text ".HxT\"/>" $$ - text " text package <> text "K.HxK\"/>" $$ - text " text package <> text "N.HxK\"/>" $$ - text "" $$ - text "" $$ - text "" $$ - text "" $$ - text "" $$ - text "") $$ - text "" - writeFile (pathJoin [odir, collectionHH2File]) (render doc) diff --git a/src/HaddockHoogle.hs b/src/HaddockHoogle.hs deleted file mode 100644 --- a/src/HaddockHoogle.hs +++ /dev/null @@ -1,194 +0,0 @@ --- --- Haddock - A Haskell Documentation Tool --- --- (c) Simon Marlow 2003 --- --- This file, (c) Neil Mitchell 2006 --- Write out Hoogle compatible documentation --- http://www.haskell.org/hoogle/ - -module HaddockHoogle ( - ppHoogle - ) where - -import HaddockTypes -import HaddockUtil -import HsSyn - -import Data.List ( intersperse ) -import Data.Char ( isAlpha ) - - - -prefix = ["-- Hoogle documentation, generated by Haddock", - "-- See Hoogle, http://www.haskell.org/hoogle/"] - -ppHoogle :: Maybe String -> [Interface] -> FilePath -> IO () -ppHoogle maybe_package ifaces odir = - do - let - filename = case maybe_package of - Just x -> x ++ ".txt" - Nothing -> "hoogle.txt" - - visible_ifaces = filter visible ifaces - visible i = OptHide `notElem` iface_options i - - contents = prefix : map ppModule visible_ifaces - - writeFile (pathJoin [odir, filename]) (unlines $ concat contents) - - - --- --------------------------------------------------------------------------- --- Generate the HTML page for a module - - -ppDecl :: HsDecl -> [String] -ppDecl (HsNewTypeDecl src context name args ctor unknown docs) = - ppData "newtype" context name args [ctor] - -ppDecl (HsDataDecl src context name args ctors unknown docs) = - ppData "data" context name args ctors - -ppDecl (HsTypeSig src names t doc) = map (`ppFunc` t) names - -ppDecl (HsForeignImport src _ _ _ name t doc) = ppDecl $ HsTypeSig src [name] t doc - -ppDecl (HsClassDecl src context name args fundeps members doc) = - ("class " ++ ppContext context ++ ppType typ) : concatMap f members - where - typ = foldl HsTyApp (HsTyCon $ UnQual name) (map HsTyVar args) - newcontext = (UnQual name, map HsTyVar args) - f (HsTypeSig src names t doc) = ppDecl (HsTypeSig src names (addContext newcontext t) doc) - f (HsFunBind{}) = [] - f (HsPatBind{}) = [] - f x = ["-- ERR " ++ show x] - -ppDecl (HsTypeDecl src name args t doc) = - ["type " ++ show name ++ concatMap (\x -> ' ':show x) args ++ " = " ++ ppType t] - -ppDecl x = ["-- ERR " ++ show x] - - - -addContext :: HsAsst -> HsType -> HsType -addContext ctx (HsForAllType Nothing context t) = HsForAllType Nothing (HsAssump ctx : context) t -addContext ctx x = HsForAllType Nothing [HsAssump ctx] x - - - -ppFunc :: HsName -> HsType -> String -ppFunc name typ = ppOperator (show name) ++ " :: " ++ ppType typ - - -ppOperator :: String -> String -ppOperator xs@(x:_) = brack (not keyword) xs - where keyword = isAlpha x || x == '_' - - -ppData :: String -> HsContext -> HsName -> [HsName] -> [HsConDecl] -> [String] -ppData mode context name args ctors = (mode ++ " " ++ ppType typ) : concatMap (ppCtor typ) ctors - where - typ = foldl HsTyApp (HsTyCon $ UnQual name) (map HsTyVar args) - - -deBang :: HsBangType -> HsType -deBang (HsBangedTy x) = x -deBang (HsUnBangedTy x) = x - - -ppCtor :: HsType -> HsConDecl -> [String] -ppCtor result (HsConDecl src name types context typ doc) = - [ppOperator (show name) ++ " :: " ++ ppContext context ++ ppTypesArr (map deBang typ ++ [result])] - -ppCtor result (HsRecDecl src name types context fields doc) = - ppCtor result (HsConDecl src name types context (map snd fields2) doc) ++ - concatMap f fields2 - where - fields2 = [(name, typ) | HsFieldDecl names typ _ <- fields, name <- names] - f (name, typ) = ppDecl $ HsTypeSig src [name] (HsTyFun result (deBang typ)) doc - - -brack True x = "(" ++ x ++ ")" -brack False x = x - -ppContext :: HsContext -> String -ppContext [] = "" -ppContext xs = brack (length xs > 1) (concat $ intersperse ", " $ map ppContextItem xs) ++ " => " - -ppContextItem :: HsAsst -> String -ppContextItem (name, types) = ppQName name ++ concatMap (\x -> ' ':ppTypeBrack x) types - -ppContext2 :: HsIPContext -> String -ppContext2 xs = ppContext [x | HsAssump x <- xs] - - -ppType :: HsType -> String -ppType x = ppTypePri 0 x - -ppTypeBrack :: HsType -> String -ppTypeBrack x = ppTypePri 100 x - - -ppTypePri :: Int -> HsType -> String -ppTypePri n t = f n t - where - f _ (HsTyTuple _ xs) = brack True $ concat $ intersperse ", " $ map (f 0) xs - f _ (HsTyCon x) = if res == "->" then "(->)" else res - where res = ppQName x - f _ (HsTyVar x) = show x - - -- ignore ForAll types as Hoogle does not support them - f n (HsForAllType (Just items) context t) = - -- brack (n > 1) $ - -- "forall" ++ concatMap (\x -> ' ':toStr x) items ++ " . " ++ f 0 t - f n t - - f n (HsForAllType Nothing context t) = brack (n > 1) $ - ppContext2 context ++ f 0 t - - f n (HsTyFun a b) = brack g $ f (h 3) a ++ " -> " ++ f (h 2) b - where - g = n > 2 - h x = if g then 0 else x - - f n (HsTyApp a b) | ppType a == "[]" = "[" ++ f 0 b ++ "]" - - f n (HsTyApp a b) = brack g $ f (h 3) a ++ " " ++ f (h 4) b - where - g = n > 3 - h x = x -- if g then 0 else x - - f n (HsTyDoc x _) = f n x - - f n x = brack True $ show x - - -ppQName :: HsQName -> String -ppQName (Qual _ name) = show name -ppQName (UnQual name) = show name - - - -ppTypesArr :: [HsType] -> String -ppTypesArr xs = ppType $ foldr1 HsTyFun xs - - - -ppInst :: InstHead -> String -ppInst (context, item) = "instance " ++ ppContext context ++ ppContextItem item - - - -ppModule :: Interface -> [String] -ppModule iface = "" : ("module " ++ mdl) : concatMap ppExport (iface_exports iface) - where - Module mdl = iface_module iface - - -ppExport :: ExportItem -> [String] -ppExport (ExportDecl name decl insts) = ppDecl decl ++ map ppInst insts -ppExport _ = [] - - diff --git a/src/HaddockHtml.hs b/src/HaddockHtml.hs deleted file mode 100644 --- a/src/HaddockHtml.hs +++ /dev/null @@ -1,1343 +0,0 @@ --- --- Haddock - A Haskell Documentation Tool --- --- (c) Simon Marlow 2003 --- - -module HaddockHtml ( - ppHtml, copyHtmlBits, - ppHtmlIndex, ppHtmlContents, - ppHtmlHelpFiles - ) where - -import Prelude hiding (div) - -import Binary ( openBinaryFile ) -import HaddockDevHelp -import HaddockHH -import HaddockHH2 -import HaddockModuleTree -import HaddockTypes -import HaddockUtil -import HaddockVersion -import HsSyn -import Html -import qualified Html -import Map ( Map ) -import qualified Map hiding ( Map ) - -import Control.Exception ( bracket ) -import Control.Monad ( when, unless ) -import Data.Char ( isUpper, toUpper ) -import Data.List ( sortBy ) -import Data.Maybe ( fromJust, isJust, mapMaybe, fromMaybe ) -import Foreign.Marshal.Alloc ( allocaBytes ) -import System.IO ( IOMode(..), hClose, hGetBuf, hPutBuf ) - --- the base, module and entity URLs for the source code and wiki links. -type SourceURLs = (Maybe String, Maybe String, Maybe String) -type WikiURLs = (Maybe String, Maybe String, Maybe String) - --- ----------------------------------------------------------------------------- --- Generating HTML documentation - -ppHtml :: String - -> Maybe String -- package - -> [Interface] - -> FilePath -- destination directory - -> Maybe Doc -- prologue text, maybe - -> Maybe String -- the Html Help format (--html-help) - -> SourceURLs -- the source URL (--source) - -> WikiURLs -- the wiki URL (--wiki) - -> Maybe String -- the contents URL (--use-contents) - -> Maybe String -- the index URL (--use-index) - -> IO () - -ppHtml doctitle maybe_package ifaces odir prologue maybe_html_help_format - maybe_source_url maybe_wiki_url - maybe_contents_url maybe_index_url = do - let - visible_ifaces = filter visible ifaces - visible i = OptHide `notElem` iface_options i - - when (not (isJust maybe_contents_url)) $ - ppHtmlContents odir doctitle maybe_package - maybe_html_help_format maybe_index_url maybe_source_url maybe_wiki_url - [ iface{iface_package=Nothing} | iface <- visible_ifaces ] - -- we don't want to display the packages in a single-package contents - prologue - - when (not (isJust maybe_index_url)) $ - ppHtmlIndex odir doctitle maybe_package maybe_html_help_format - maybe_contents_url maybe_source_url maybe_wiki_url visible_ifaces - - when (not (isJust maybe_contents_url && isJust maybe_index_url)) $ - ppHtmlHelpFiles doctitle maybe_package ifaces odir maybe_html_help_format [] - - mapM_ (ppHtmlModule odir doctitle - maybe_source_url maybe_wiki_url - maybe_contents_url maybe_index_url) visible_ifaces - -ppHtmlHelpFiles - :: String -- doctitle - -> Maybe String -- package - -> [Interface] - -> FilePath -- destination directory - -> Maybe String -- the Html Help format (--html-help) - -> [FilePath] -- external packages paths - -> IO () -ppHtmlHelpFiles doctitle maybe_package ifaces odir maybe_html_help_format pkg_paths = do - let - visible_ifaces = filter visible ifaces - visible i = OptHide `notElem` iface_options i - - -- Generate index and contents page for Html Help if requested - case maybe_html_help_format of - Nothing -> return () - Just "mshelp" -> ppHHProject odir doctitle maybe_package visible_ifaces pkg_paths - Just "mshelp2" -> do - ppHH2Files odir maybe_package visible_ifaces pkg_paths - ppHH2Collection odir doctitle maybe_package - Just "devhelp" -> ppDevHelpFile odir doctitle maybe_package visible_ifaces - Just format -> fail ("The "++format++" format is not implemented") - -copyFile :: FilePath -> FilePath -> IO () -copyFile fromFPath toFPath = - (bracket (openBinaryFile fromFPath ReadMode) hClose $ \hFrom -> - bracket (openBinaryFile toFPath WriteMode) hClose $ \hTo -> - allocaBytes bufferSize $ \buffer -> - copyContents hFrom hTo buffer) - where - bufferSize = 1024 - - copyContents hFrom hTo buffer = do - count <- hGetBuf hFrom buffer bufferSize - when (count > 0) $ do - hPutBuf hTo buffer count - copyContents hFrom hTo buffer - - -copyHtmlBits :: FilePath -> FilePath -> Maybe FilePath -> IO () -copyHtmlBits odir libdir maybe_css = do - let - libhtmldir = pathJoin [libdir, "html"] - css_file = case maybe_css of - Nothing -> pathJoin [libhtmldir, cssFile] - Just f -> f - css_destination = pathJoin [odir, cssFile] - copyLibFile f = do - copyFile (pathJoin [libhtmldir, f]) (pathJoin [odir, f]) - - copyFile css_file css_destination - mapM_ copyLibFile [ iconFile, plusFile, minusFile, jsFile ] - -footer :: HtmlTable -footer = - tda [theclass "botbar"] << - ( toHtml "Produced by" <+> - (anchor ! [href projectUrl] << toHtml projectName) <+> - toHtml ("version " ++ projectVersion) - ) - - -srcButton :: SourceURLs -> Maybe Interface -> HtmlTable -srcButton (Just src_base_url, _, _) Nothing = - topButBox (anchor ! [href src_base_url] << toHtml "Source code") - -srcButton (_, Just src_module_url, _) (Just iface) = - let url = spliceURL (Just $ iface_orig_filename iface) - (Just $ iface_module iface) Nothing Nothing - src_module_url - in topButBox (anchor ! [href url] << toHtml "Source code") - -srcButton _ _ = - Html.emptyTable - -spliceURL :: Maybe FilePath -> Maybe Module -> Maybe HsName -> Maybe SrcLoc - -> String -> String -spliceURL maybe_file maybe_mod maybe_name maybe_loc url = run url - where - file = fromMaybe "" maybe_file - mod = case maybe_mod of - Nothing -> "" - Just (Module mod) -> mod - - (name, kind) = - case maybe_name of - Nothing -> ("","") - Just (n@(HsTyClsName _)) -> (escapeStr (hsNameStr n), "t") - Just (n@(HsVarName _)) -> (escapeStr (hsNameStr n), "v") - - line = case maybe_loc of - Nothing -> "" - Just (SrcLoc l _ _) -> show l - - run "" = "" - run ('%':'M':rest) = mod ++ run rest - run ('%':'F':rest) = file ++ run rest - run ('%':'N':rest) = name ++ run rest - run ('%':'K':rest) = kind ++ run rest - run ('%':'L':rest) = line ++ run rest - run ('%':'%':rest) = "%" ++ run rest - - run ('%':'{':'M':'O':'D':'U':'L':'E':'}':rest) = mod ++ run rest - run ('%':'{':'F':'I':'L':'E':'}':rest) = file ++ run rest - run ('%':'{':'N':'A':'M':'E':'}':rest) = name ++ run rest - run ('%':'{':'K':'I':'N':'D':'}':rest) = kind ++ run rest - run ('%':'{':'L':'I':'N':'E':'}':rest) = line ++ run rest - - run ('%':'{':'M':'O':'D':'U':'L':'E':'/':'.':'/':c:'}':rest) = - map (\x -> if x == '.' then c else x) mod ++ run rest - - run ('%':'{':'F':'I':'L':'E':'/':'/':'/':c:'}':rest) = - map (\x -> if x == '/' then c else x) file ++ run rest - - run (c:rest) = c : run rest - -wikiButton :: WikiURLs -> Maybe Module -> HtmlTable -wikiButton (Just wiki_base_url, _, _) Nothing = - topButBox (anchor ! [href wiki_base_url] << toHtml "User Comments") - -wikiButton (_, Just wiki_module_url, _) (Just mod) = - let url = spliceURL Nothing (Just mod) Nothing Nothing wiki_module_url - in topButBox (anchor ! [href url] << toHtml "User Comments") - -wikiButton _ _ = - Html.emptyTable - - -contentsButton :: Maybe String -> HtmlTable -contentsButton maybe_contents_url - = topButBox (anchor ! [href url] << toHtml "Contents") - where url = case maybe_contents_url of - Nothing -> contentsHtmlFile - Just url -> url - -indexButton :: Maybe String -> HtmlTable -indexButton maybe_index_url - = topButBox (anchor ! [href url] << toHtml "Index") - where url = case maybe_index_url of - Nothing -> indexHtmlFile - Just url -> url - -simpleHeader :: String -> Maybe String -> Maybe String - -> SourceURLs -> WikiURLs -> HtmlTable -simpleHeader doctitle maybe_contents_url maybe_index_url - maybe_source_url maybe_wiki_url = - (tda [theclass "topbar"] << - vanillaTable << ( - (td << - image ! [src "haskell_icon.gif", width "16", height 16, alt " " ] - ) <-> - (tda [theclass "title"] << toHtml doctitle) <-> - srcButton maybe_source_url Nothing <-> - wikiButton maybe_wiki_url Nothing <-> - contentsButton maybe_contents_url <-> indexButton maybe_index_url - )) - -pageHeader :: String -> Interface -> String - -> SourceURLs -> WikiURLs - -> Maybe String -> Maybe String -> HtmlTable -pageHeader mdl iface doctitle - maybe_source_url maybe_wiki_url - maybe_contents_url maybe_index_url = - (tda [theclass "topbar"] << - vanillaTable << ( - (td << - image ! [src "haskell_icon.gif", width "16", height 16, alt " "] - ) <-> - (tda [theclass "title"] << toHtml doctitle) <-> - srcButton maybe_source_url (Just iface) <-> - wikiButton maybe_wiki_url (Just $ iface_module iface) <-> - contentsButton maybe_contents_url <-> - indexButton maybe_index_url - ) - ) - tda [theclass "modulebar"] << - (vanillaTable << ( - (td << font ! [size "6"] << toHtml mdl) <-> - moduleInfo iface - ) - ) - -moduleInfo :: Interface -> HtmlTable -moduleInfo iface = - let - info = iface_info iface - - doOneEntry :: (String,ModuleInfo -> Maybe String) -> Maybe HtmlTable - doOneEntry (fieldName,field) = case field info of - Nothing -> Nothing - Just fieldValue -> - Just ((tda [theclass "infohead"] << toHtml fieldName) - <-> (tda [theclass "infoval"]) << toHtml fieldValue) - - entries :: [HtmlTable] - entries = mapMaybe doOneEntry [ - ("Portability",portability), - ("Stability",stability), - ("Maintainer",maintainer) - ] - in - case entries of - [] -> Html.emptyTable - _ -> tda [align "right"] << narrowTable << (foldl1 () entries) - --- --------------------------------------------------------------------------- --- Generate the module contents - -ppHtmlContents - :: FilePath - -> String - -> Maybe String - -> Maybe String - -> Maybe String - -> SourceURLs - -> WikiURLs - -> [Interface] -> Maybe Doc - -> IO () -ppHtmlContents odir doctitle - maybe_package maybe_html_help_format maybe_index_url - maybe_source_url maybe_wiki_url mdls prologue = do - let tree = mkModuleTree - [(iface_module iface, - iface_package iface, - toDescription iface) | iface <- mdls] - html = - header - (documentCharacterEncoding +++ - thetitle (toHtml doctitle) +++ - styleSheet +++ - (script ! [src jsFile, thetype "text/javascript"] $ noHtml)) +++ - body << vanillaTable << ( - simpleHeader doctitle Nothing maybe_index_url - maybe_source_url maybe_wiki_url - ppPrologue doctitle prologue - ppModuleTree doctitle tree - s15 - footer - ) - writeFile (pathJoin [odir, contentsHtmlFile]) (renderHtml html) - - -- Generate contents page for Html Help if requested - case maybe_html_help_format of - Nothing -> return () - Just "mshelp" -> ppHHContents odir doctitle maybe_package tree - Just "mshelp2" -> ppHH2Contents odir doctitle maybe_package tree - Just "devhelp" -> return () - Just format -> fail ("The "++format++" format is not implemented") - -ppPrologue :: String -> Maybe Doc -> HtmlTable -ppPrologue title Nothing = Html.emptyTable -ppPrologue title (Just doc) = - (tda [theclass "section1"] << toHtml title) - docBox (docToHtml doc) - -ppModuleTree :: String -> [ModuleTree] -> HtmlTable -ppModuleTree _ ts = - tda [theclass "section1"] << toHtml "Modules" - td << vanillaTable2 << htmlTable - where - genTable htmlTable id [] = (htmlTable,id) - genTable htmlTable id (x:xs) = genTable (htmlTable u) id' xs - where - (u,id') = mkNode [] x 0 id - - (htmlTable,_) = genTable emptyTable 0 ts - -mkNode :: [String] -> ModuleTree -> Int -> Int -> (HtmlTable,Int) -mkNode ss (Node s leaf pkg short ts) depth id = htmlNode - where - htmlNode = case ts of - [] -> (td_pad_w 1.25 depth << htmlModule <-> shortDescr <-> htmlPkg,id) - _ -> (td_w depth << (collapsebutton id_s +++ htmlModule) <-> shortDescr <-> htmlPkg - (td_subtree << sub_tree), id') - - mod_width = 50::Int {-em-} - - td_pad_w pad depth = - tda [thestyle ("padding-left: " ++ show pad ++ "em;" ++ - "width: " ++ show (mod_width - depth*2) ++ "em")] - - td_w depth = - tda [thestyle ("width: " ++ show (mod_width - depth*2) ++ "em")] - - td_subtree = - tda [thestyle ("padding: 0; padding-left: 2em")] - - shortDescr :: HtmlTable - shortDescr = case short of - Nothing -> td empty - Just doc -> tda [theclass "rdoc"] (docToHtml doc) - - htmlModule - | leaf = ppHsModule mdl - | otherwise = toHtml s - - htmlPkg = case pkg of - Nothing -> td << empty - Just p -> td << toHtml p - - mdl = foldr (++) "" (s' : map ('.':) ss') - (s':ss') = reverse (s:ss) - -- reconstruct the module name - - id_s = "n:" ++ show id - - (sub_tree,id') = genSubTree emptyTable (id+1) ts - - genSubTree :: HtmlTable -> Int -> [ModuleTree] -> (Html,Int) - genSubTree htmlTable id [] = (sub_tree,id) - where - sub_tree = collapsed vanillaTable2 id_s htmlTable - genSubTree htmlTable id (x:xs) = genSubTree (htmlTable u) id' xs - where - (u,id') = mkNode (s:ss) x (depth+1) id - --- --------------------------------------------------------------------------- --- Generate the index - -ppHtmlIndex :: FilePath - -> String - -> Maybe String - -> Maybe String - -> Maybe String - -> SourceURLs - -> WikiURLs - -> [Interface] - -> IO () -ppHtmlIndex odir doctitle maybe_package maybe_html_help_format - maybe_contents_url maybe_source_url maybe_wiki_url ifaces = do - let html = - header (documentCharacterEncoding +++ - thetitle (toHtml (doctitle ++ " (Index)")) +++ - styleSheet +++ - (script ! [src jsFile, thetype "text/javascript"] $ noHtml)) +++ - body << vanillaTable << ( - simpleHeader doctitle maybe_contents_url Nothing - maybe_source_url maybe_wiki_url - search_box index_html - ) - - writeFile (pathJoin [odir, indexHtmlFile]) (renderHtml html) - - -- Generate index and contents page for Html Help if requested - case maybe_html_help_format of - Nothing -> return () - Just "mshelp" -> ppHHIndex odir maybe_package ifaces - Just "mshelp2" -> ppHH2Index odir maybe_package ifaces - Just "devhelp" -> return () - Just format -> fail ("The "++format++" format is not implemented") - where - -- colspan 2, marginheight 5 - search_box :: HtmlTable - search_box = tda [colspan 2, thestyle "padding-top:5px;"] << search - where - search :: Html - search = form ! [strAttr "onsubmit" "full_search(); return false;", action ""] << ( - "Search: " - +++ input ! [identifier "searchbox", strAttr "onkeyup" "quick_search()"] - +++ " " +++ input ! [value "Search", thetype "submit"] - +++ " " +++ thespan ! [identifier "searchmsg"] << " ") - - index_html = td << setTrClass (table ! [identifier "indexlist", cellpadding 0, cellspacing 5] << - aboves (map indexElt index)) - - setTrClass :: Html -> Html - setTrClass (Html xs) = Html $ map f xs - where - f (HtmlTag name attrs inner) - | map toUpper name == "TR" = HtmlTag name (theclass "indexrow":attrs) inner - | otherwise = HtmlTag name attrs (setTrClass inner) - f x = x - - index :: [(String, Map HsQName [(Module,Bool)])] - index = sortBy cmp (Map.toAscList full_index) - where cmp (n1,_) (n2,_) = map toUpper n1 `compare` map toUpper n2 - - -- for each name (a plain string), we have a number of original HsNames that - -- it can refer to, and for each of those we have a list of modules - -- that export that entity. Each of the modules exports the entity - -- in a visible or invisible way (hence the Bool). - full_index :: Map String (Map HsQName [(Module,Bool)]) - full_index = Map.fromListWith (flip (Map.unionWith (++))) - (concat (map getIfaceIndex ifaces)) - - getIfaceIndex iface = - [ (hsNameStr nm, - Map.fromList [(orig, [(mdl, not (nm `elem` iface_reexported iface))])]) - | (nm, orig) <- Map.toAscList (iface_env iface) ] - where mdl = iface_module iface - - indexElt :: (String, Map HsQName [(Module,Bool)]) -> HtmlTable - indexElt (str, entities) = - case Map.toAscList entities of - [(nm,entries)] -> - tda [ theclass "indexentry" ] << toHtml str <-> - indexLinks (unQual nm) entries - many_entities -> - tda [ theclass "indexentry" ] << toHtml str - aboves (map doAnnotatedEntity (zip [1..] many_entities)) - - unQual (Qual _ nm) = nm - unQual (UnQual nm) = nm - - doAnnotatedEntity (j,(qnm,entries)) - = tda [ theclass "indexannot" ] << - toHtml (show j) <+> parens (ppAnnot nm) <-> - indexLinks nm entries - where nm = unQual qnm - - ppAnnot (HsTyClsName n) - = toHtml "Type/Class" - ppAnnot (HsVarName n) - | isUpper c || c == ':' = toHtml "Data Constructor" - | otherwise = toHtml "Function" - where c = head (hsIdentifierStr n) - - indexLinks nm entries = - tda [ theclass "indexlinks" ] << - hsep (punctuate comma - [ if visible then - linkId (Module mdl) (Just nm) << toHtml mdl - else - toHtml mdl - | (Module mdl, visible) <- entries ]) - --- --------------------------------------------------------------------------- --- Generate the HTML page for a module - -ppHtmlModule - :: FilePath -> String - -> SourceURLs -> WikiURLs - -> Maybe String -> Maybe String - -> Interface -> IO () -ppHtmlModule odir doctitle - maybe_source_url maybe_wiki_url - maybe_contents_url maybe_index_url iface = do - let - Module mdl = iface_module iface - html = - header (documentCharacterEncoding +++ - thetitle (toHtml mdl) +++ - styleSheet +++ - (script ! [src jsFile, thetype "text/javascript"] $ noHtml)) +++ - body << vanillaTable << ( - pageHeader mdl iface doctitle - maybe_source_url maybe_wiki_url - maybe_contents_url maybe_index_url s15 - ifaceToHtml maybe_source_url maybe_wiki_url iface s15 - footer - ) - writeFile (pathJoin [odir, moduleHtmlFile mdl]) (renderHtml html) - -ifaceToHtml :: SourceURLs -> WikiURLs -> Interface -> HtmlTable -ifaceToHtml maybe_source_url maybe_wiki_url iface - = abovesSep s15 (contents ++ description: synopsis: maybe_doc_hdr: bdy) - where - exports = numberSectionHeadings (iface_exports iface) - - has_doc (ExportDecl _ d _) = isJust (declDoc d) - has_doc (ExportNoDecl _ _ _) = False - has_doc (ExportModule _) = False - has_doc _ = True - - no_doc_at_all = not (any has_doc exports) - - contents = case ppModuleContents exports of - Nothing -> [] - Just x -> [td << vanillaTable << x] - - description - = case iface_doc iface of - Nothing -> Html.emptyTable - Just doc -> (tda [theclass "section1"] << toHtml "Description") - docBox (docToHtml doc) - - -- omit the synopsis if there are no documentation annotations at all - synopsis - | no_doc_at_all = Html.emptyTable - | otherwise - = (tda [theclass "section1"] << toHtml "Synopsis") - s15 - (tda [theclass "body"] << vanillaTable << - abovesSep s8 (map (processExport True linksInfo) - (filter forSummary exports)) - ) - - -- if the documentation doesn't begin with a section header, then - -- add one ("Documentation"). - maybe_doc_hdr - = case exports of - [] -> Html.emptyTable - ExportGroup _ _ _ : _ -> Html.emptyTable - _ -> tda [ theclass "section1" ] << toHtml "Documentation" - - bdy = map (processExport False linksInfo) exports - linksInfo = (maybe_source_url, maybe_wiki_url, iface) - -ppModuleContents :: [ExportItem] -> Maybe HtmlTable -ppModuleContents exports - | length sections == 0 = Nothing - | otherwise = Just (tda [theclass "section4"] << bold << toHtml "Contents" - td << dlist << concatHtml sections) - where - (sections, _leftovers{-should be []-}) = process 0 exports - - process :: Int -> [ExportItem] -> ([Html],[ExportItem]) - process _ [] = ([], []) - process n items@(ExportGroup lev id0 doc : rest) - | lev <= n = ( [], items ) - | otherwise = ( html:secs, rest2 ) - where - html = (dterm << linkedAnchor id0 << docToHtml doc) - +++ mk_subsections ssecs - (ssecs, rest1) = process lev rest - (secs, rest2) = process n rest1 - process n (_ : rest) = process n rest - - mk_subsections [] = noHtml - mk_subsections ss = ddef << dlist << concatHtml ss - --- we need to assign a unique id to each section heading so we can hyperlink --- them from the contents: -numberSectionHeadings :: [ExportItem] -> [ExportItem] -numberSectionHeadings exports = go 1 exports - where go :: Int -> [ExportItem] -> [ExportItem] - go _ [] = [] - go n (ExportGroup lev _ doc : es) - = ExportGroup lev (show n) doc : go (n+1) es - go n (other:es) - = other : go n es - --- The URL for source and wiki links, and the current module -type LinksInfo = (SourceURLs, WikiURLs, Interface) - -processExport :: Bool -> LinksInfo -> ExportItem -> HtmlTable -processExport _ _ (ExportGroup lev id0 doc) - = ppDocGroup lev (namedAnchor id0 << docToHtml doc) -processExport summary links (ExportDecl x decl insts) - = doDecl summary links x decl insts -processExport summmary _ (ExportNoDecl _ y []) - = declBox (ppHsQName y) -processExport summmary _ (ExportNoDecl _ y subs) - = declBox (ppHsQName y <+> parenList (map ppHsQName subs)) -processExport _ _ (ExportDoc doc) - = docBox (docToHtml doc) -processExport _ _ (ExportModule (Module mdl)) - = declBox (toHtml "module" <+> ppHsModule mdl) - -forSummary :: ExportItem -> Bool -forSummary (ExportGroup _ _ _) = False -forSummary (ExportDoc _) = False -forSummary _ = True - -ppDocGroup :: Int -> Html -> HtmlTable -ppDocGroup lev doc - | lev == 1 = tda [ theclass "section1" ] << doc - | lev == 2 = tda [ theclass "section2" ] << doc - | lev == 3 = tda [ theclass "section3" ] << doc - | otherwise = tda [ theclass "section4" ] << doc - --- ----------------------------------------------------------------------------- --- Converting declarations to HTML - -declWithDoc :: Bool -> LinksInfo -> SrcLoc -> HsName -> Maybe Doc -> Html -> HtmlTable -declWithDoc True _ _ _ _ html_decl = declBox html_decl -declWithDoc False links loc nm Nothing html_decl = topDeclBox links loc nm html_decl -declWithDoc False links loc nm (Just doc) html_decl = - topDeclBox links loc nm html_decl docBox (docToHtml doc) - -doDecl :: Bool -> LinksInfo -> HsQName -> HsDecl -> [InstHead] -> HtmlTable -doDecl summary links x d instances = do_decl d - where - do_decl (HsTypeSig loc [nm] ty doc) - = ppFunSig summary links loc nm ty doc - - do_decl (HsForeignImport loc _ _ _ n ty doc) - = ppFunSig summary links loc n ty doc - - do_decl (HsTypeDecl loc nm args ty doc) - = ppTypeOrFunSig summary links loc nm ty doc (full, hdr, spaceHtml +++ equals) - where hdr = hsep ([keyword "type", ppHsBinder summary nm] - ++ map ppHsNameAsVar args) - full = hdr <+> equals <+> ppHsType ty - - do_decl (HsNewTypeDecl loc ctx nm args con drv doc) - = ppHsDataDecl summary links instances True{-is newtype-} x - (HsDataDecl loc ctx nm args [con] drv doc) - -- print it as a single-constructor datatype - - do_decl d0@(HsDataDecl{}) - = ppHsDataDecl summary links instances False{-not newtype-} x d0 - - do_decl d0@(HsClassDecl{}) - = ppHsClassDecl summary links instances x d0 - - do_decl (HsDocGroup _ lev str) - = if summary then Html.emptyTable - else ppDocGroup lev (docToHtml str) - - do_decl _ = error ("do_decl: " ++ show d) - - -ppTypeSig :: Bool -> HsName -> HsType -> Html -ppTypeSig summary nm ty = ppHsBinder summary nm <+> dcolon <+> ppHsType ty - --- ----------------------------------------------------------------------------- --- Data & newtype declarations - -ppShortDataDecl :: Bool -> LinksInfo -> Bool -> HsDecl -> Html -ppShortDataDecl summary _ is_newty - (HsDataDecl _ _ nm args [con] _ _doc) = - ppHsDataHeader summary is_newty nm args - <+> equals <+> ppShortConstr summary con -ppShortDataDecl summary _ is_newty - (HsDataDecl _ _ nm args [] _ _doc) = - ppHsDataHeader summary is_newty nm args -ppShortDataDecl summary links is_newty - (HsDataDecl loc _ nm args cons _ _doc) = - vanillaTable << ( - (if summary then declBox else topDeclBox links loc nm) - (ppHsDataHeader summary is_newty nm args) - tda [theclass "body"] << vanillaTable << ( - aboves (zipWith do_constr ('=':repeat '|') cons) - ) - ) - where do_constr c con = declBox (toHtml [c] <+> ppShortConstr summary con) -ppShortDataDecl _ _ _ d = - error $ "HaddockHtml.ppShortDataDecl: unexpected decl " ++ show d - --- The rest of the cases: -ppHsDataDecl :: Ord key => Bool -> LinksInfo -> [InstHead] -> Bool -> key -> HsDecl -> HtmlTable -ppHsDataDecl summary links instances is_newty - x decl@(HsDataDecl loc _ nm args cons _ doc) - | summary = declWithDoc summary links loc nm doc (ppShortDataDecl summary links is_newty decl) - - | otherwise - = (if validTable then () else const) dataheader $ - tda [theclass "body"] << vanillaTable << ( - datadoc - constr_bit - instances_bit - ) - where - dataheader = topDeclBox links loc nm (ppHsDataHeader False is_newty nm args) - - validTable = isJust doc || not (null cons) || not (null instances) - - constr_table - | any isRecDecl cons = spacedTable5 - | otherwise = spacedTable1 - - datadoc | isJust doc = ndocBox (docToHtml (fromJust doc)) - | otherwise = Html.emptyTable - - constr_bit - | null cons = Html.emptyTable - | otherwise = - constr_hdr - (tda [theclass "body"] << constr_table << - aboves (map ppSideBySideConstr cons) - ) - - inst_id = collapseId nm - - instances_bit - | null instances = Html.emptyTable - | otherwise - = inst_hdr inst_id - tda [theclass "body"] << - collapsed thediv inst_id ( - spacedTable1 << ( - aboves (map (declBox.ppInstHead) instances) - ) - ) - -ppHsDataDecl _ _ _ _ _ d = - error $ "HaddockHtml.ppHsDataDecl: unexpected decl " ++ show d - -isRecDecl :: HsConDecl -> Bool -isRecDecl (HsRecDecl{}) = True -isRecDecl _ = False - -ppShortConstr :: Bool -> HsConDecl -> Html -ppShortConstr summary (HsConDecl _ nm tvs ctxt typeList _maybe_doc) = - ppHsConstrHdr tvs ctxt +++ - hsep (ppHsBinder summary nm : map ppHsBangType typeList) -ppShortConstr summary (HsRecDecl _ nm tvs ctxt fields _) = - ppHsConstrHdr tvs ctxt +++ - ppHsBinder summary nm <+> - braces (vanillaTable << aboves (map (ppShortField summary) fields)) - -ppHsConstrHdr :: [HsName] -> HsContext -> Html -ppHsConstrHdr tvs ctxt - = (if null tvs then noHtml else keyword "forall" <+> - hsep (map ppHsNameAsVar tvs) <+> - toHtml ". ") - +++ - (if null ctxt then noHtml else ppHsContext ctxt <+> toHtml "=> ") - -ppSideBySideConstr :: HsConDecl -> HtmlTable -ppSideBySideConstr (HsConDecl _ nm tvs ctxt typeList doc) = - argBox (hsep ((ppHsConstrHdr tvs ctxt +++ - ppHsBinder False nm) : map ppHsBangType typeList)) <-> - maybeRDocBox doc -ppSideBySideConstr (HsRecDecl _ nm tvs ctxt fields doc) = - argBox (ppHsConstrHdr tvs ctxt +++ ppHsBinder False nm) <-> - maybeRDocBox doc - (tda [theclass "body"] << spacedTable1 << - aboves (map ppSideBySideField fields)) - -ppSideBySideField :: HsFieldDecl -> HtmlTable -ppSideBySideField (HsFieldDecl ns ty doc) = - argBox (hsep (punctuate comma (map (ppHsBinder False) ns)) - <+> dcolon <+> ppHsBangType ty) <-> - maybeRDocBox doc - -{- -ppHsFullConstr :: HsConDecl -> Html -ppHsFullConstr (HsConDecl _ nm tvs ctxt typeList doc) = - declWithDoc False doc ( - hsep ((ppHsConstrHdr tvs ctxt +++ - ppHsBinder False nm) : map ppHsBangType typeList) - ) -ppHsFullConstr (HsRecDecl _ nm tvs ctxt fields doc) = - td << vanillaTable << ( - case doc of - Nothing -> aboves [hdr, fields_html] - Just _ -> aboves [hdr, constr_doc, fields_html] - ) - - where hdr = declBox (ppHsConstrHdr tvs ctxt +++ ppHsBinder False nm) - - constr_doc - | isJust doc = docBox (docToHtml (fromJust doc)) - | otherwise = Html.emptyTable - - fields_html = - td << - table ! [width "100%", cellpadding 0, cellspacing 8] << ( - aboves (map ppFullField (concat (map expandField fields))) - ) --} - -ppShortField :: Bool -> HsFieldDecl -> HtmlTable -ppShortField summary (HsFieldDecl ns ty _doc) - = tda [theclass "recfield"] << ( - hsep (punctuate comma (map (ppHsBinder summary) ns)) - <+> dcolon <+> ppHsBangType ty - ) - -{- -ppFullField :: HsFieldDecl -> Html -ppFullField (HsFieldDecl [n] ty doc) - = declWithDoc False doc ( - ppHsBinder False n <+> dcolon <+> ppHsBangType ty - ) -ppFullField _ = error "ppFullField" - -expandField :: HsFieldDecl -> [HsFieldDecl] -expandField (HsFieldDecl ns ty doc) = [ HsFieldDecl [n] ty doc | n <- ns ] --} - -ppHsDataHeader :: Bool -> Bool -> HsName -> [HsName] -> Html -ppHsDataHeader summary is_newty nm args = - (if is_newty then keyword "newtype" else keyword "data") <+> - ppHsBinder summary nm <+> hsep (map ppHsNameAsVar args) - -ppHsBangType :: HsBangType -> Html -ppHsBangType (HsBangedTy ty) = char '!' +++ ppHsAType ty -ppHsBangType (HsUnBangedTy ty) = ppHsAType ty - --- ----------------------------------------------------------------------------- --- Class declarations - -ppClassHdr :: Bool -> HsContext -> HsName -> [HsName] -> [HsFunDep] -> Html -ppClassHdr summ [] n tvs fds = - keyword "class" - <+> ppHsBinder summ n <+> hsep (map ppHsNameAsVar tvs) - <+> ppFds fds -ppClassHdr summ ctxt n tvs fds = - keyword "class" <+> ppHsContext ctxt <+> darrow - <+> ppHsBinder summ n <+> hsep (map ppHsNameAsVar tvs) - <+> ppFds fds - -ppFds :: [HsFunDep] -> Html -ppFds fds = - if null fds then noHtml else - char '|' <+> hsep (punctuate comma (map fundep fds)) - where - fundep (vars1,vars2) = hsep (map ppHsNameAsVar vars1) <+> arrow <+> - hsep (map ppHsNameAsVar vars2) - -ppShortClassDecl :: Bool -> LinksInfo -> HsDecl -> HtmlTable -ppShortClassDecl summary links (HsClassDecl loc ctxt nm tvs fds decls _) = - if null decls - then (if summary then declBox else topDeclBox links loc nm) hdr - else (if summary then declBox else topDeclBox links loc nm) (hdr <+> keyword "where") - - (tda [theclass "body"] << - vanillaTable << - aboves [ ppFunSig summary links loc n ty doc - | HsTypeSig _ [n] ty doc <- decls - ] - ) - - where - hdr = ppClassHdr summary ctxt nm tvs fds -ppShortClassDecl _ _ d = - error $ "HaddockHtml.ppShortClassDecl: unexpected decl: " ++ show d - -ppHsClassDecl :: Ord key => Bool -> LinksInfo -> [InstHead] -> key -> HsDecl -> HtmlTable -ppHsClassDecl summary links instances orig_c - decl@(HsClassDecl loc ctxt nm tvs fds decls doc) - | summary = ppShortClassDecl summary links decl - - | otherwise - = classheader - tda [theclass "body"] << vanillaTable << ( - classdoc methods_bit instances_bit - ) - - where - classheader - | null decls = topDeclBox links loc nm hdr - | otherwise = topDeclBox links loc nm (hdr <+> keyword "where") - - hdr = ppClassHdr summary ctxt nm tvs fds - - classdoc = case doc of - Nothing -> Html.emptyTable - Just d -> ndocBox (docToHtml d) - - methods_bit - | null decls = Html.emptyTable - | otherwise = - s8 meth_hdr - tda [theclass "body"] << vanillaTable << ( - abovesSep s8 [ ppFunSig summary links loc n ty doc0 - | HsTypeSig _ [n] ty doc0 <- decls - ] - ) - - inst_id = collapseId nm - instances_bit - | null instances = Html.emptyTable - | otherwise - = s8 inst_hdr inst_id - tda [theclass "body"] << - collapsed thediv inst_id ( - spacedTable1 << ( - aboves (map (declBox.ppInstHead) instances) - )) - -ppHsClassDecl _ _ _ _ d = - error $ "HaddockHtml.ppHsClassDecl: unexpected decl: " ++ show d - - -ppInstHead :: InstHead -> Html -ppInstHead ([],asst) = ppHsAsst asst -ppInstHead (ctxt,asst) = ppHsContext ctxt <+> darrow <+> ppHsAsst asst - --- ---------------------------------------------------------------------------- --- Type signatures - -ppFunSig :: Bool -> LinksInfo -> SrcLoc -> HsName -> HsType -> Maybe Doc -> HtmlTable -ppFunSig summary links loc nm ty0 doc = ppTypeOrFunSig summary links loc nm ty0 doc (ppTypeSig summary nm ty0, ppHsBinder False nm, dcolon) - -ppTypeOrFunSig :: Bool -> LinksInfo -> SrcLoc -> HsName -> HsType -> Maybe Doc -> (Html, Html, Html) -> HtmlTable -ppTypeOrFunSig summary links loc nm ty0 doc (pref1, pref2, sep) - | summary || no_arg_docs ty0 = - declWithDoc summary links loc nm doc pref1 - - | otherwise = - topDeclBox links loc nm pref2 - (tda [theclass "body"] << vanillaTable << ( - do_args sep ty0 - (if (isJust doc) - then ndocBox (docToHtml (fromJust doc)) - else Html.emptyTable) - )) - where - no_arg_docs (HsForAllType _ _ ty) = no_arg_docs ty - no_arg_docs (HsTyFun (HsTyDoc _ _) _) = False - no_arg_docs (HsTyFun _ r) = no_arg_docs r - no_arg_docs (HsTyDoc _ _) = False - no_arg_docs _ = True - - do_args :: Html -> HsType -> HtmlTable - do_args leader (HsForAllType (Just tvs) ctxt ty) - = (argBox ( - leader <+> - hsep (keyword "forall" : map ppHsNameAsVar tvs ++ [toHtml "."]) <+> - ppHsIPContext ctxt) - <-> rdocBox noHtml) - do_args darrow ty - do_args leader (HsForAllType Nothing ctxt ty) - = (argBox (leader <+> ppHsIPContext ctxt) - <-> rdocBox noHtml) - do_args darrow ty - do_args leader (HsTyFun (HsTyDoc ty doc0) r) - = (argBox (leader <+> ppHsBType ty) <-> rdocBox (docToHtml doc0)) - do_args arrow r - do_args leader (HsTyFun ty r) - = (argBox (leader <+> ppHsBType ty) <-> rdocBox noHtml) - do_args arrow r - do_args leader (HsTyDoc ty doc0) - = (argBox (leader <+> ppHsBType ty) <-> rdocBox (docToHtml doc0)) - do_args leader ty - = argBox (leader <+> ppHsBType ty) <-> rdocBox (noHtml) - --- ---------------------------------------------------------------------------- --- Types and contexts - -ppHsAsst :: HsAsst -> Html -ppHsAsst (c,args) = ppHsQName c <+> hsep (map ppHsAType args) - -ppHsContext :: HsContext -> Html -ppHsContext [] = empty -ppHsContext [ctxt] = ppHsAsst ctxt -ppHsContext context = parenList (map ppHsAsst context) - -ppHsCtxt :: HsCtxt -> Html -ppHsCtxt (HsAssump asst) = ppHsAsst asst -ppHsCtxt (HsIP n t) = toHtml "?" +++ ppHsNameAsVar n <+> dcolon <+> ppHsType t - -ppHsIPContext :: HsIPContext -> Html -ppHsIPContext [] = empty -ppHsIPContext [ctxt] = ppHsCtxt ctxt -ppHsIPContext context = parenList (map ppHsCtxt context) - -ppHsForAll :: Maybe [HsName] -> HsIPContext -> Html -ppHsForAll Nothing context = - hsep [ ppHsIPContext context, darrow ] -ppHsForAll (Just tvs) [] = - hsep (keyword "forall" : map ppHsNameAsVar tvs ++ [toHtml "."]) -ppHsForAll (Just tvs) context = - hsep (keyword "forall" : map ppHsNameAsVar tvs ++ - [toHtml ".", ppHsIPContext context, darrow]) - -ppHsType :: HsType -> Html -ppHsType (HsForAllType maybe_tvs context htype) = - ppHsForAll maybe_tvs context <+> ppHsType htype -ppHsType (HsTyFun a b) = hsep [ppHsBType a, arrow, ppHsType b] -ppHsType (HsTyIP n t) = toHtml "?" +++ ppHsNameAsVar n <+> dcolon <+> ppHsType t -ppHsType t = ppHsBType t - -ppHsBType :: HsType -> Html -ppHsBType (HsTyDoc ty _) = ppHsBType ty -ppHsBType (HsTyApp (HsTyApp (HsTyVar (HsVarName (HsSymbol sym))) a) b) = - hsep [ppHsBType a, toHtml sym, ppHsBType b] -ppHsBType (HsTyApp (HsTyCon (Qual _ (HsTyClsName (HsSpecial "[]")))) b ) - = brackets $ ppHsType b -ppHsBType (HsTyApp a b) = ppHsBType a <+> ppHsAType b -ppHsBType t = ppHsAType t - -ppHsAType :: HsType -> Html -ppHsAType (HsTyTuple True l) = parenList . map ppHsType $ l -ppHsAType (HsTyTuple False l) = ubxParenList . map ppHsType $ l -ppHsAType (HsTyVar nm) = ppHsNameAsVar nm -ppHsAType (HsTyCon nm) - | nm == fun_tycon_qname = parens $ ppHsQName nm - | otherwise = ppHsQName nm -ppHsAType (HsTyApp (HsTyCon (Qual _ (HsTyClsName (HsSpecial "[]")))) b ) - = brackets $ ppHsType b -ppHsAType t = parens $ ppHsType t - --- ---------------------------------------------------------------------------- --- Names - -linkTarget :: HsName -> Html -linkTarget nm = namedAnchor (hsAnchorNameStr nm) << toHtml "" - -ppHsQName :: HsQName -> Html -ppHsQName (UnQual str) = ppHsName str -ppHsQName n@(Qual mdl str) - | n == unit_con_name = ppHsName str - | isSpecial str = ppHsName str - | otherwise = linkId mdl (Just str) << ppHsName str - -isSpecial :: HsName -> Bool -isSpecial (HsTyClsName (HsSpecial _)) = True -isSpecial (HsVarName (HsSpecial _)) = True -isSpecial _ = False - -ppHsName :: HsName -> Html -ppHsName nm = toHtml (hsNameStr nm) - --- For use as a variable, so that symbols must be parenthesized -ppHsNameAsVar :: HsName -> Html -ppHsNameAsVar nm = mbParens nm (toHtml (hsNameStr nm)) - where - mbParens (HsVarName (HsSymbol _)) = parens - mbParens _ = id - - -ppHsBinder :: Bool -> HsName -> Html --- The Bool indicates whether we are generating the summary, in which case --- the binder will be a link to the full definition. -ppHsBinder True nm = linkedAnchor (hsAnchorNameStr nm) << ppHsBinder' nm -ppHsBinder False nm = linkTarget nm +++ bold << ppHsBinder' nm - -ppHsBinder' :: HsName -> Html -ppHsBinder' (HsTyClsName id0) = ppHsBindIdent id0 -ppHsBinder' (HsVarName id0) = ppHsBindIdent id0 - -ppHsBindIdent :: HsIdentifier -> Html -ppHsBindIdent (HsIdent str) = toHtml str -ppHsBindIdent (HsSymbol str) = parens (toHtml str) -ppHsBindIdent (HsSpecial str) = toHtml str - -linkId :: Module -> Maybe HsName -> Html -> Html -linkId (Module mdl) mbName = anchor ! [href hr] - where hr = case mbName of - Nothing -> moduleHtmlFile mdl - Just name -> nameHtmlRef mdl name - -ppHsModule :: String -> Html -ppHsModule mdl = anchor ! [href ((moduleHtmlFile modname) ++ ref)] << toHtml mdl - where - (modname,ref) = break (== '#') mdl - --- ----------------------------------------------------------------------------- --- * Doc Markup - -htmlMarkup :: DocMarkup [HsQName] Html -htmlMarkup = Markup { - markupParagraph = paragraph, - markupEmpty = toHtml "", - markupString = toHtml, - markupAppend = (+++), - markupIdentifier = tt . ppHsQName . head, - markupModule = ppHsModule, - markupEmphasis = emphasize . toHtml, - markupMonospaced = tt . toHtml, - markupUnorderedList = ulist . concatHtml . map (li <<), - markupOrderedList = olist . concatHtml . map (li <<), - markupDefList = dlist . concatHtml . map markupDef, - markupCodeBlock = pre, - markupURL = \url -> anchor ! [href url] << toHtml url, - markupPic = \url -> image ! [src url], - markupAName = \aname -> namedAnchor aname << toHtml "" - } - -markupDef (a,b) = dterm << a +++ ddef << b - --- If the doc is a single paragraph, don't surround it with

    (this causes --- ugly extra whitespace with some browsers). -docToHtml :: Doc -> Html -docToHtml doc = markup htmlMarkup (unParagraph (markup htmlCleanup doc)) - --- If there is a single paragraph, then surrounding it with

    ..

    --- can add too much whitespace in some browsers (eg. IE). However if --- we have multiple paragraphs, then we want the extra whitespace to --- separate them. So we catch the single paragraph case and transform it --- here. -unParagraph (DocParagraph d) = d ---NO: This eliminates line breaks in the code block: (SDM, 6/5/2003) ---unParagraph (DocCodeBlock d) = (DocMonospaced d) -unParagraph doc = doc - -htmlCleanup :: DocMarkup [HsQName] Doc -htmlCleanup = idMarkup { - markupUnorderedList = DocUnorderedList . map unParagraph, - markupOrderedList = DocOrderedList . map unParagraph - } - --- ----------------------------------------------------------------------------- --- * Misc - -hsep :: [Html] -> Html -hsep [] = noHtml -hsep htmls = foldr1 (\a b -> a+++" "+++b) htmls - -infixr 8 <+> -(<+>) :: Html -> Html -> Html -a <+> b = Html (getHtmlElements (toHtml a) ++ HtmlString " ": getHtmlElements (toHtml b)) - -keyword :: String -> Html -keyword s = thespan ! [theclass "keyword"] << toHtml s - -equals, comma :: Html -equals = char '=' -comma = char ',' - -char :: Char -> Html -char c = toHtml [c] - -empty :: Html -empty = noHtml - -parens, brackets, braces :: Html -> Html -parens h = char '(' +++ h +++ char ')' -brackets h = char '[' +++ h +++ char ']' -braces h = char '{' +++ h +++ char '}' - -punctuate :: Html -> [Html] -> [Html] -punctuate _ [] = [] -punctuate h (d0:ds) = go d0 ds - where - go d [] = [d] - go d (e:es) = (d +++ h) : go e es - -abovesSep :: HtmlTable -> [HtmlTable] -> HtmlTable -abovesSep _ [] = Html.emptyTable -abovesSep h (d0:ds) = go d0 ds - where - go d [] = d - go d (e:es) = d h go e es - -parenList :: [Html] -> Html -parenList = parens . hsep . punctuate comma - -ubxParenList :: [Html] -> Html -ubxParenList = ubxparens . hsep . punctuate comma - -ubxparens :: Html -> Html -ubxparens h = toHtml "(#" +++ h +++ toHtml "#)" - -{- -text :: Html -text = strAttr "TEXT" --} - --- a box for displaying code -declBox :: Html -> HtmlTable -declBox html = tda [theclass "decl"] << html - --- a box for top level documented names --- it adds a source and wiki link at the right hand side of the box -topDeclBox :: LinksInfo -> SrcLoc -> HsName -> Html -> HtmlTable -topDeclBox ((_,_,Nothing), (_,_,Nothing), _) _ _ html = declBox html -topDeclBox ((_,_,maybe_source_url), (_,_,maybe_wiki_url), iface) - loc@(SrcLoc _ _ fname) name html = - tda [theclass "topdecl"] << - ( table ! [theclass "declbar"] << - ((tda [theclass "declname"] << html) - <-> srcLink - <-> wikiLink) - ) - where srcLink = - case maybe_source_url of - Nothing -> Html.emptyTable - Just url -> tda [theclass "declbut"] << - let url' = spliceURL (Just fname) (Just orig_mod) - (Just name) (Just loc) url - in anchor ! [href url'] << toHtml "Source" - - mod = iface_module iface - - -- for source links, we want to point to the original module - -- for the name, because only that will have the source. - orig_mod = case Map.lookup name (iface_env iface) of - Just (Qual m _) -> m - _ -> mod - - wikiLink = - case maybe_wiki_url of - Nothing -> Html.emptyTable - Just url -> tda [theclass "declbut"] << - let url' = spliceURL (Just fname) (Just mod) - (Just name) (Just loc) url - in anchor ! [href url'] << toHtml "Comments" - - --- a box for displaying an 'argument' (some code which has text to the --- right of it). Wrapping is not allowed in these boxes, whereas it is --- in a declBox. -argBox :: Html -> HtmlTable -argBox html = tda [theclass "arg"] << html - --- a box for displaying documentation, --- indented and with a little padding at the top -docBox :: Html -> HtmlTable -docBox html = tda [theclass "doc"] << html - --- a box for displaying documentation, not indented. -ndocBox :: Html -> HtmlTable -ndocBox html = tda [theclass "ndoc"] << html - --- a box for displaying documentation, padded on the left a little -rdocBox :: Html -> HtmlTable -rdocBox html = tda [theclass "rdoc"] << html - -maybeRDocBox :: Maybe Doc -> HtmlTable -maybeRDocBox Nothing = rdocBox (noHtml) -maybeRDocBox (Just doc) = rdocBox (docToHtml doc) - --- a box for the buttons at the top of the page -topButBox :: Html -> HtmlTable -topButBox html = tda [theclass "topbut"] << html - --- a vanilla table has width 100%, no border, no padding, no spacing --- a narrow table is the same but without width 100%. -vanillaTable, narrowTable :: Html -> Html -vanillaTable = table ! [theclass "vanilla", cellspacing 0, cellpadding 0] -vanillaTable2 = table ! [theclass "vanilla2", cellspacing 0, cellpadding 0] -narrowTable = table ! [theclass "narrow", cellspacing 0, cellpadding 0] - -spacedTable1, spacedTable5 :: Html -> Html -spacedTable1 = table ! [theclass "vanilla", cellspacing 1, cellpadding 0] -spacedTable5 = table ! [theclass "vanilla", cellspacing 5, cellpadding 0] - -constr_hdr, meth_hdr :: HtmlTable -constr_hdr = tda [ theclass "section4" ] << toHtml "Constructors" -meth_hdr = tda [ theclass "section4" ] << toHtml "Methods" - -inst_hdr :: String -> HtmlTable -inst_hdr id = - tda [ theclass "section4" ] << (collapsebutton id +++ toHtml " Instances") - --- Whether to use html entities when available. Could make this choice a flag. -useEntities = False - -stringOrEntity string entity - | useEntities = Html [ HtmlString entity ] - | otherwise = toHtml string - -dcolon, arrow, darrow :: Html -dcolon = toHtml "::" -arrow = stringOrEntity "->" "→" -darrow = stringOrEntity "=>" "⇒" - -s8, s15 :: HtmlTable -s8 = tda [ theclass "s8" ] << noHtml -s15 = tda [ theclass "s15" ] << noHtml - -namedAnchor :: String -> Html -> Html -namedAnchor n = anchor ! [name (escapeStr n)] - --- --- A section of HTML which is collapsible via a +/- button. --- - --- TODO: Currently the initial state is non-collapsed. Change the 'minusFile' --- below to a 'plusFile' and the 'display:block;' to a 'display:none;' when we --- use cookies from JavaScript to have a more persistent state. - -collapsebutton :: String -> Html -collapsebutton id = - image ! [ src minusFile, theclass "coll", onclick ("toggle(this,'" ++ id ++ "')"), alt "show/hide" ] - -collapsed :: (HTML a) => (Html -> Html) -> String -> a -> Html -collapsed fn id html = - fn ! [identifier id, thestyle "display:block;"] << html - --- A quote is a valid part of a Haskell identifier, but it would interfere with --- the ECMA script string delimiter used in collapsebutton above. -collapseId :: HsName -> String -collapseId nm = "i:" ++ escapeStr (hsNameStr nm) - -linkedAnchor :: String -> Html -> Html -linkedAnchor frag = anchor ! [href hr] - where hr | null frag = "" - | otherwise = '#': escapeStr frag - -documentCharacterEncoding :: Html -documentCharacterEncoding = - meta ! [httpequiv "Content-Type", content "text/html; charset=UTF-8"] - -styleSheet :: Html -styleSheet = - thelink ! [href cssFile, rel "stylesheet", thetype "text/css"] diff --git a/src/HaddockLex.x b/src/HaddockLex.x deleted file mode 100644 --- a/src/HaddockLex.x +++ /dev/null @@ -1,172 +0,0 @@ --- --- Haddock - A Haskell Documentation Tool --- --- (c) Simon Marlow 2002 --- - -{ -module HaddockLex ( - Token(..), - tokenise - ) where - -import Char -import Numeric -import HsSyn -import HsLexer hiding (Token) -import HsParseMonad ---import Debug.Trace -} - -$ws = $white # \n -$digit = [0-9] -$hexdigit = [0-9a-fA-F] -$special = [\"\@] -$alphanum = [A-Za-z0-9] -$ident = [$alphanum \'\_\.\!\#\$\%\&\*\+\/\<\=\>\?\@\\\\\^\|\-\~] - -:- - --- beginning of a paragraph -<0,para> { - $ws* \n ; - $ws* \> { begin birdtrack } - $ws* [\*\-] { token TokBullet `andBegin` string } - $ws* \[ { token TokDefStart `andBegin` def } - $ws* \( $digit+ \) { token TokNumber `andBegin` string } - $ws* { begin string } -} - --- beginning of a line - { - $ws* \> { begin birdtrack } - $ws* \n { token TokPara `andBegin` para } - -- Here, we really want to be able to say - -- $ws* (\n | ) { token TokPara `andBegin` para} - -- because otherwise a trailing line of whitespace will result in - -- a spurious TokString at the end of a docstring. We don't have , - -- though (NOW I realise what it was for :-). To get around this, we always - -- append \n to the end of a docstring. - () { begin string } -} - - .* \n? { strtoken TokBirdTrack `andBegin` line } - - { - $special { strtoken $ \s -> TokSpecial (head s) } - \<\<.*\>\> { strtoken $ \s -> TokPic (init $ init $ tail $ tail s) } - \<.*\> { strtoken $ \s -> TokURL (init (tail s)) } - \#.*\# { strtoken $ \s -> TokAName (init (tail s)) } - \/ [^\/]* \/ { strtoken $ \s -> TokEmphasis (init (tail s)) } - [\'\`] $ident+ [\'\`] { ident } - \\ . { strtoken (TokString . tail) } - "&#" $digit+ \; { strtoken $ \s -> TokString [chr (read (init (drop 2 s)))] } - "&#" [xX] $hexdigit+ \; { strtoken $ \s -> case readHex (init (drop 3 s)) of [(n,_)] -> TokString [chr n] } - -- allow special characters through if they don't fit one of the previous - -- patterns. - [\/\'\`\<\#\&\\] { strtoken TokString } - [^ $special \/ \< \# \n \'\` \& \\ \]]* \n { strtoken TokString `andBegin` line } - [^ $special \/ \< \# \n \'\` \& \\ \]]+ { strtoken TokString } -} - - { - \] { token TokDefEnd `andBegin` string } -} - --- ']' doesn't have any special meaning outside of the [...] at the beginning --- of a definition paragraph. - { - \] { strtoken TokString } -} - -{ -data Token - = TokPara - | TokNumber - | TokBullet - | TokDefStart - | TokDefEnd - | TokSpecial Char - | TokIdent [HsQName] - | TokString String - | TokURL String - | TokPic String - | TokEmphasis String - | TokAName String - | TokBirdTrack String - deriving Show - --- ----------------------------------------------------------------------------- --- Alex support stuff - -type StartCode = Int -type Action = String -> StartCode -> (StartCode -> [Token]) -> [Token] - -type AlexInput = (Char,String) - -alexGetChar (_, []) = Nothing -alexGetChar (_, c:cs) = Just (c, (c,cs)) - -alexInputPrevChar (c,_) = c - -tokenise :: String -> [Token] -tokenise str = let toks = go ('\n', eofHack str) para in {-trace (show toks)-} toks - where go inp@(_,str) sc = - case alexScan inp sc of - AlexEOF -> [] - AlexError _ -> error "lexical error" - AlexSkip inp' len -> go inp' sc - AlexToken inp' len act -> act (take len str) sc (\sc -> go inp' sc) - --- NB. we add a final \n to the string, (see comment in the beginning of line --- production above). -eofHack str = str++"\n" - -andBegin :: Action -> StartCode -> Action -andBegin act new_sc = \str sc cont -> act str new_sc cont - -token :: Token -> Action -token t = \str sc cont -> t : cont sc - -strtoken :: (String -> Token) -> Action -strtoken t = \str sc cont -> t str : cont sc - -begin :: StartCode -> Action -begin sc = \str _ cont -> cont sc - --- ----------------------------------------------------------------------------- --- Lex a string as a Haskell identifier - -ident :: Action -ident str sc cont = - case strToHsQNames id of - Just names -> TokIdent names : cont sc - Nothing -> TokString str : cont sc - where id = init (tail str) - -strToHsQNames :: String -> Maybe [HsQName] -strToHsQNames str0 - = case lexer (\t -> returnP t) str0 (SrcLoc 1 1 "") 1 1 "" [] of - Ok _ (VarId str) - -> Just [ UnQual (HsVarName (HsIdent str)) ] - Ok _ (QVarId (mod0,str)) - -> Just [ Qual (Module mod0) (HsVarName (HsIdent str)) ] - Ok _ (ConId str) - -> Just [ UnQual (HsTyClsName (HsIdent str)), - UnQual (HsVarName (HsIdent str)) ] - Ok _ (QConId (mod0,str)) - -> Just [ Qual (Module mod0) (HsTyClsName (HsIdent str)), - Qual (Module mod0) (HsVarName (HsIdent str)) ] - Ok _ (VarSym str) - -> Just [ UnQual (HsVarName (HsSymbol str)) ] - Ok _ (ConSym str) - -> Just [ UnQual (HsTyClsName (HsSymbol str)), - UnQual (HsVarName (HsSymbol str)) ] - Ok _ (QVarSym (mod0,str)) - -> Just [ Qual (Module mod0) (HsVarName (HsSymbol str)) ] - Ok _ (QConSym (mod0,str)) - -> Just [ Qual (Module mod0) (HsTyClsName (HsSymbol str)), - Qual (Module mod0) (HsVarName (HsSymbol str)) ] - _other - -> Nothing -} diff --git a/src/HaddockModuleTree.hs b/src/HaddockModuleTree.hs deleted file mode 100644 --- a/src/HaddockModuleTree.hs +++ /dev/null @@ -1,33 +0,0 @@ -module HaddockModuleTree(ModuleTree(..), mkModuleTree) where - -import HsSyn - -data ModuleTree = Node String Bool (Maybe String) (Maybe Doc) [ModuleTree] - -mkModuleTree :: [(Module,Maybe String,Maybe Doc)] -> [ModuleTree] -mkModuleTree mods = - foldr fn [] [ (splitModule mod, pkg,short) | (mod,pkg,short) <- mods ] - where - fn (mod,pkg,short) trees = addToTrees mod pkg short trees - -addToTrees :: [String] -> Maybe String -> Maybe Doc -> [ModuleTree] -> [ModuleTree] -addToTrees [] pkg short ts = ts -addToTrees ss pkg short [] = mkSubTree ss pkg short -addToTrees (s1:ss) pkg short (t@(Node s2 leaf node_pkg node_short subs) : ts) - | s1 > s2 = t : addToTrees (s1:ss) pkg short ts - | s1 == s2 = Node s2 (leaf || null ss) this_pkg this_short (addToTrees ss pkg short subs) : ts - | otherwise = mkSubTree (s1:ss) pkg short ++ t : ts - where - this_pkg = if null ss then pkg else node_pkg - this_short = if null ss then short else node_short - -mkSubTree :: [String] -> Maybe String -> Maybe Doc -> [ModuleTree] -mkSubTree [] pkg short = [] -mkSubTree [s] pkg short = [Node s True pkg short []] -mkSubTree (s:ss) pkg short = [Node s (null ss) Nothing Nothing (mkSubTree ss pkg short)] - -splitModule :: Module -> [String] -splitModule (Module mdl) = split mdl - where split mdl0 = case break (== '.') mdl0 of - (s1, '.':s2) -> s1 : split s2 - (s1, _) -> [s1] diff --git a/src/HaddockParse.y b/src/HaddockParse.y deleted file mode 100644 --- a/src/HaddockParse.y +++ /dev/null @@ -1,100 +0,0 @@ -{ -module HaddockParse (parseParas, parseString) where - -import HaddockLex -import HsSyn -} - -%tokentype { Token } - -%token '/' { TokSpecial '/' } - '@' { TokSpecial '@' } - '[' { TokDefStart } - ']' { TokDefEnd } - DQUO { TokSpecial '\"' } - URL { TokURL $$ } - PIC { TokPic $$ } - ANAME { TokAName $$ } - '/../' { TokEmphasis $$ } - '-' { TokBullet } - '(n)' { TokNumber } - '>..' { TokBirdTrack $$ } - IDENT { TokIdent $$ } - PARA { TokPara } - STRING { TokString $$ } - -%monad { Either String } - -%name parseParas doc -%name parseString seq - -%% - -doc :: { Doc } - : apara PARA doc { docAppend $1 $3 } - | PARA doc { $2 } - | apara { $1 } - | {- empty -} { DocEmpty } - -apara :: { Doc } - : ulpara { DocUnorderedList [$1] } - | olpara { DocOrderedList [$1] } - | defpara { DocDefList [$1] } - | para { $1 } - -ulpara :: { Doc } - : '-' para { $2 } - -olpara :: { Doc } - : '(n)' para { $2 } - -defpara :: { (Doc,Doc) } - : '[' seq ']' seq { ($2, $4) } - -para :: { Doc } - : seq { docParagraph $1 } - | codepara { DocCodeBlock $1 } - -codepara :: { Doc } - : '>..' codepara { docAppend (DocString $1) $2 } - | '>..' { DocString $1 } - -seq :: { Doc } - : elem seq { docAppend $1 $2 } - | elem { $1 } - -elem :: { Doc } - : elem1 { $1 } - | '@' seq1 '@' { DocMonospaced $2 } - -seq1 :: { Doc } - : PARA seq1 { docAppend (DocString "\n") $2 } - | elem1 seq1 { docAppend $1 $2 } - | elem1 { $1 } - -elem1 :: { Doc } - : STRING { DocString $1 } - | '/../' { DocEmphasis (DocString $1) } - | URL { DocURL $1 } - | PIC { DocPic $1 } - | ANAME { DocAName $1 } - | IDENT { DocIdentifier $1 } - | DQUO strings DQUO { DocModule $2 } - -strings :: { String } - : STRING { $1 } - | STRING strings { $1 ++ $2 } - -{ -happyError :: [Token] -> Either String a -happyError toks = - Left ("parse error in doc string: " ++ show (take 3 toks)) - --- Either monad (we can't use MonadError because GHC < 5.00 has --- an older incompatible version). -instance Monad (Either String) where - return = Right - Left l >>= _ = Left l - Right r >>= k = k r - fail msg = Left msg -} diff --git a/src/HaddockRename.hs b/src/HaddockRename.hs deleted file mode 100644 --- a/src/HaddockRename.hs +++ /dev/null @@ -1,287 +0,0 @@ --- --- Haddock - A Haskell Documentation Tool --- --- (c) Simon Marlow 2003 --- - -module HaddockRename ( - RnM, runRn, runRnFM, runRnUnqualFM, -- the monad (instance of Monad) - - renameExportList, - renameDecl, - renameExportItems, renameInstHead, - renameDoc, renameMaybeDoc, - ) where - -import HaddockTypes -import HaddockUtil ( unQual ) -import HsSyn -import Map ( Map ) -import qualified Map hiding ( Map ) - -import Monad - --- ----------------------------------------------------------------------------- --- Monad for renaming - --- The monad does two things for us: it passes around the environment for --- renaming, and it returns a list of names which couldn't be found in --- the environment. - -newtype GenRnM n a = - RnM { unRn :: (n -> (Bool,HsQName)) -- name lookup function - -> (a,[n]) - } - -type RnM a = GenRnM HsQName a - -instance Monad (GenRnM n) where - (>>=) = thenRn - return = returnRn - -returnRn :: a -> GenRnM n a -returnRn a = RnM (\_ -> (a,[])) -thenRn :: GenRnM n a -> (a -> GenRnM n b) -> GenRnM n b -m `thenRn` k = RnM (\lkp -> case unRn m lkp of - (a,out1) -> case unRn (k a) lkp of - (b,out2) -> (b,out1++out2)) - -getLookupRn :: RnM (HsQName -> (Bool,HsQName)) -getLookupRn = RnM (\lkp -> (lkp,[])) -outRn :: HsQName -> RnM () -outRn name = RnM (\_ -> ((),[name])) - -lookupRn :: (HsQName -> a) -> HsQName -> RnM a -lookupRn and_then name = do - lkp <- getLookupRn - case lkp name of - (False,maps_to) -> do outRn name; return (and_then maps_to) - (True, maps_to) -> return (and_then maps_to) - -runRnFM :: Map HsQName HsQName -> RnM a -> (a,[HsQName]) -runRnFM env rn = unRn rn lkp - where lkp n = case Map.lookup n env of - Nothing -> (False, n) -- leave the qualified name - Just q -> (True, q) - --- like runRnFM, but if it can't find a mapping for a name, --- it leaves an unqualified name in place instead. -runRnUnqualFM :: Map HsQName HsQName -> RnM a -> (a,[HsQName]) -runRnUnqualFM env rn = unRn rn lkp - where lkp n = case Map.lookup n env of - Nothing -> (False, unQual n) -- remove the qualifier - Just q -> (True, q) - -runRn :: (n -> (Bool,HsQName)) -> GenRnM n a -> (a,[n]) -runRn lkp rn = unRn rn lkp - --- ----------------------------------------------------------------------------- --- Renaming source code & documentation - -renameExportList :: [HsExportSpec] -> RnM [HsExportSpec] -renameExportList spec = mapM renameExport spec - where - renameExport (HsEVar x) = lookupRn HsEVar x - renameExport (HsEAbs x) = lookupRn HsEAbs x - renameExport (HsEThingAll x) = lookupRn HsEThingAll x - renameExport (HsEThingWith x cs) = do - cs' <- mapM (lookupRn id) cs - lookupRn (\x' -> HsEThingWith x' cs') x - renameExport (HsEModuleContents m) = return (HsEModuleContents m) - renameExport (HsEGroup lev doc0) = do - doc <- renameDoc doc0 - return (HsEGroup lev doc) - renameExport (HsEDoc doc0) = do - doc <- renameDoc doc0 - return (HsEDoc doc) - renameExport (HsEDocNamed str) = return (HsEDocNamed str) - - -renameDecl :: HsDecl -> RnM HsDecl -renameDecl decl - = case decl of - HsTypeDecl loc t args ty0 doc0 -> do - ty <- renameType ty0 - doc <- renameMaybeDoc doc0 - return (HsTypeDecl loc t args ty doc) - HsDataDecl loc ctx0 t args cons0 drv0 doc0 -> do - ctx <- renameContext ctx0 - cons <- mapM renameConDecl cons0 - drv <- mapM (lookupRn id) drv0 - doc <- renameMaybeDoc doc0 - return (HsDataDecl loc ctx t args cons drv doc) - HsNewTypeDecl loc ctx0 t args con0 drv0 doc0 -> do - ctx <- renameContext ctx0 - con <- renameConDecl con0 - drv <- mapM (lookupRn id) drv0 - doc <- renameMaybeDoc doc0 - return (HsNewTypeDecl loc ctx t args con drv doc) - HsClassDecl loc ctxt0 nm tvs fds decls0 doc0 -> do - ctxt <- renameContext ctxt0 - decls <- mapM renameDecl decls0 - doc <- renameMaybeDoc doc0 - return (HsClassDecl loc ctxt nm tvs fds decls doc) - HsTypeSig loc fs qt0 doc0 -> do - qt <- renameType qt0 - doc <- renameMaybeDoc doc0 - return (HsTypeSig loc fs qt doc) - HsForeignImport loc cc safe ent n ty0 doc0 -> do - ty <- renameType ty0 - doc <- renameMaybeDoc doc0 - return (HsForeignImport loc cc safe ent n ty doc) - HsInstDecl loc ctxt0 asst0 decls -> do - ctxt <- renameContext ctxt0 - asst <- renamePred asst0 - return (HsInstDecl loc ctxt asst decls) - HsDocCommentNamed loc name doc0 -> do - doc <- renameDoc doc0 - return (HsDocCommentNamed loc name doc) - _ -> - return decl - -renameConDecl :: HsConDecl -> RnM HsConDecl -renameConDecl (HsConDecl loc nm tvs ctxt tys0 doc0) = do - tys <- mapM renameBangTy tys0 - doc <- renameMaybeDoc doc0 - return (HsConDecl loc nm tvs ctxt tys doc) -renameConDecl (HsRecDecl loc nm tvs ctxt fields0 doc0) = do - fields <- mapM renameField fields0 - doc <- renameMaybeDoc doc0 - return (HsRecDecl loc nm tvs ctxt fields doc) - -renameField :: HsFieldDecl -> RnM HsFieldDecl -renameField (HsFieldDecl ns ty0 doc0) = do - ty <- renameBangTy ty0 - doc <- renameMaybeDoc doc0 - return (HsFieldDecl ns ty doc) - -renameBangTy :: HsBangType -> RnM HsBangType -renameBangTy (HsBangedTy ty) = HsBangedTy `liftM` renameType ty -renameBangTy (HsUnBangedTy ty) = HsUnBangedTy `liftM` renameType ty - -renameContext :: HsContext -> RnM HsContext -renameContext = mapM renamePred - -renameIPContext :: HsIPContext -> RnM HsIPContext -renameIPContext cs = mapM renameCtxt cs - where - renameCtxt (HsIP n t) = liftM (HsIP n) (renameType t) - renameCtxt (HsAssump c) = liftM HsAssump (renamePred c) - -renamePred :: (HsQName,[HsType]) -> RnM (HsQName,[HsType]) -renamePred (c,tys0) = do - tys <- mapM renameType tys0 - lookupRn (\c' -> (c',tys)) c - -renameType :: HsType -> RnM HsType -renameType (HsForAllType tvs ctx0 ty0) = do - ctx <- renameIPContext ctx0 - ty <- renameType ty0 - return (HsForAllType tvs ctx ty) -renameType (HsTyFun arg0 res0) = do - arg <- renameType arg0 - res <- renameType res0 - return (HsTyFun arg res) -renameType (HsTyIP n ty0) = do - ty <- renameType ty0 - return (HsTyIP n ty0) -renameType (HsTyTuple b tys0) = do - tys <- mapM renameType tys0 - return (HsTyTuple b tys) -renameType (HsTyApp ty0 arg0) = do - ty <- renameType ty0 - arg <- renameType arg0 - return (HsTyApp ty arg) -renameType (HsTyVar nm) = - return (HsTyVar nm) -renameType (HsTyCon nm) = - lookupRn HsTyCon nm -renameType (HsTyDoc ty0 doc0) = do - ty <- renameType ty0 - doc <- renameDoc doc0 - return (HsTyDoc ty doc) - -renameInstHead :: InstHead -> RnM InstHead -renameInstHead (ctx,asst) = do - ctx <- renameContext ctx - asst <- renamePred asst - return (ctx,asst) - --- ----------------------------------------------------------------------------- --- Renaming documentation - --- Renaming documentation is done by "marking it up" from ordinary Doc --- into (Rn Doc), which can then be renamed with runRn. -markupRename :: DocMarkup [HsQName] (RnM Doc) -markupRename = Markup { - markupEmpty = return DocEmpty, - markupString = return . DocString, - markupParagraph = liftM DocParagraph, - markupAppend = liftM2 DocAppend, - markupIdentifier = lookupForDoc, - markupModule = return . DocModule, - markupEmphasis = liftM DocEmphasis, - markupMonospaced = liftM DocMonospaced, - markupUnorderedList = liftM DocUnorderedList . sequence, - markupOrderedList = liftM DocOrderedList . sequence, - markupDefList = liftM DocDefList . mapM markupDef, - markupCodeBlock = liftM DocCodeBlock, - markupURL = return . DocURL, - markupPic = return . DocPic, - markupAName = return . DocAName - } - -markupDef (ma,mb) = do a <- ma; b <- mb; return (a,b) - -renameDoc :: Doc -> RnM Doc -renameDoc = markup markupRename - -renameMaybeDoc :: Maybe Doc -> RnM (Maybe Doc) -renameMaybeDoc Nothing = return Nothing -renameMaybeDoc (Just doc) = Just `liftM` renameDoc doc - --- --------------------------------------------------------------------------- --- Looking up names in documentation - -lookupForDoc :: [HsQName] -> RnM Doc -lookupForDoc qns = do - lkp <- getLookupRn - case [ n | (True,n) <- map lkp qns ] of - ns@(_:_) -> return (DocIdentifier ns) - [] -> -- if we were given a qualified name, but there's nothing - -- matching that name in scope, then just assume its existence - -- (this means you can use qualified names in doc strings wihout - -- worrying about whether the entity is in scope). - let quals = filter isQualified qns in - if (not (null quals)) then - return (DocIdentifier quals) - else do - outRn (head qns) - -- no qualified names: just replace this name with its - -- string representation. - return (DocString (show (head qns))) - where - isQualified (Qual _ _) = True - isQualified _ = False - --- ----------------------------------------------------------------------------- - -renameExportItems :: [ExportItem] -> RnM [ExportItem] -renameExportItems items = mapM rn items - where - rn (ExportModule mod0) - = return (ExportModule mod0) - rn (ExportGroup lev id0 doc0) - = do doc <- renameDoc doc0 - return (ExportGroup lev id0 doc) - rn (ExportDecl x decl0 insts) -- x is an original name, don't rename it - = do decl <- renameDecl decl0 - insts <- mapM renameInstHead insts - return (ExportDecl x decl insts) - rn (ExportNoDecl x y subs) - = do y' <- lookupRn id y - subs' <- mapM (lookupRn id) subs - return (ExportNoDecl x y' subs') - rn (ExportDoc doc0) - = do doc <- renameDoc doc0 - return (ExportDoc doc) diff --git a/src/HaddockTypes.hs b/src/HaddockTypes.hs deleted file mode 100644 --- a/src/HaddockTypes.hs +++ /dev/null @@ -1,110 +0,0 @@ --- --- Haddock - A Haskell Documentation Tool --- --- (c) Simon Marlow 2003 --- - -module HaddockTypes ( - -- * Module interfaces - NameEnv, Interface(..), ExportItem(..), ModuleMap, - - -- * Misc types - DocOption(..), InstHead, - ) where - -import HsSyn -import Map - --- --------------------------------------------------------------------------- --- Describing a module interface - -type NameEnv = Map HsName HsQName - -data Interface - = Interface { - iface_filename :: FilePath, - -- ^ the filename that contains the source code for this module - - iface_orig_filename :: FilePath, - -- ^ the original filename for this module, which may be - -- different to the 'iface_filename' (for example the original - -- file may have had a .lhs or .hs.pp extension). - - iface_module :: Module, - - iface_package :: Maybe String, - - iface_env :: NameEnv, - -- ^ environment mapping exported names to *original* names - - iface_reexported :: [HsName], - -- ^ For names exported by this module, but not - -- actually documented in this module's documentation - -- (perhaps because they are reexported via 'module M' - -- in the export list), this mapping gives the - -- location of documentation for the name in another - -- module. - - iface_sub :: Map HsName [HsName], - -- ^ maps names to "subordinate" names - -- (eg. tycon to constrs & fields, class to methods) - - iface_exports :: [ExportItem], - -- ^ the exports used to construct the documentation - - iface_orig_exports :: [ExportItem], - -- ^ the exports used to construct the documentation - -- (with orig names, not import names) - - iface_decls :: Map HsName HsDecl, - -- ^ decls from this module (only) - -- restricted to only those bits exported. - -- the map key is the "main name" of the decl. - - iface_insts :: [HsDecl], - -- ^ instances from this module - - iface_info :: ModuleInfo, - -- ^ information from the module header - - iface_doc :: Maybe Doc, - -- ^ documentation from the module header - - iface_options :: [DocOption] - -- ^ module-wide doc options - } - -data DocOption - = OptHide -- this module should not appear in the docs - | OptPrune - | OptIgnoreExports -- pretend everything is exported - | OptNotHome -- not the best place to get docs for things - -- exported by this module. - deriving (Eq) - -data ExportItem - = ExportDecl - HsQName -- the original name - HsDecl -- a declaration (with doc annotations) - [InstHead] -- instances relevant to this declaration - - | ExportNoDecl -- an exported entity for which we have no documentation - -- (perhaps becuase it resides in another package) - HsQName -- the original name - HsQName -- where to link to - [HsQName] -- subordinate names - - | ExportGroup -- a section heading - Int -- section level (1, 2, 3, ... ) - String -- section "id" (for hyperlinks) - Doc -- section heading text - - | ExportDoc -- some documentation - Doc - - | ExportModule -- a cross-reference to another module - Module - -type ModuleMap = Map Module Interface - -type InstHead = (HsContext,HsAsst) diff --git a/src/HaddockUtil.hs b/src/HaddockUtil.hs deleted file mode 100644 --- a/src/HaddockUtil.hs +++ /dev/null @@ -1,572 +0,0 @@ --- --- Haddock - A Haskell Documentation Tool --- --- (c) The University of Glasgow 2001-2002 --- (c) Simon Marlow 2003 --- - -module HaddockUtil ( - - -- * Misc utilities - nameOfQName, collectNames, declBinders, declMainBinder, declSubBinders, - splitTyConApp, restrictTo, declDoc, parseModuleHeader, freeTyCons, unbang, - addFieldDoc, addFieldDocs, addConDoc, addConDocs,toDescription, unQual, - - -- * Filename utilities - basename, dirname, splitFilename3, - moduleHtmlFile, nameHtmlRef, - contentsHtmlFile, indexHtmlFile, subIndexHtmlFile, pathJoin, - cssFile, iconFile, jsFile, plusFile, minusFile, - - -- * Miscellaneous utilities - getProgramName, bye, die, dieMsg, noDieMsg, mapSnd, mapMaybeM, escapeStr, - - -- * HTML cross reference mapping - html_xrefs_ref, - ) where - -import Binary -import HaddockLex -import HaddockParse -import HaddockTypes -import HsSyn -import Map ( Map ) -import qualified Map hiding ( Map ) - -import Control.Monad ( liftM, MonadPlus(..) ) -import Data.Char ( isAlpha, isSpace, toUpper, ord, chr ) -import Numeric ( showIntAtBase ) -import Data.IORef ( IORef, newIORef, readIORef ) -import Data.List ( intersect, isSuffixOf, intersperse ) -import Data.Maybe ( maybeToList, fromMaybe ) -import System.Environment ( getProgName ) -import System.Exit ( exitWith, ExitCode(..) ) -import System.IO ( hPutStr, stderr ) -import System.IO.Unsafe ( unsafePerformIO ) - --- ----------------------------------------------------------------------------- --- Some Utilities - -nameOfQName :: HsQName -> HsName -nameOfQName (Qual _ n) = n -nameOfQName (UnQual n) = n - -unQual :: HsQName -> HsQName -unQual (Qual _ n) = UnQual n -unQual n = n - -collectNames :: [HsDecl] -> [HsName] -collectNames ds = concat (map declBinders ds) - -unbang :: HsBangType -> HsType -unbang (HsUnBangedTy ty) = ty -unbang (HsBangedTy ty) = ty - -declBinders :: HsDecl -> [HsName] -declBinders d = maybeToList (declMainBinder d) ++ declSubBinders d - -declMainBinder :: HsDecl -> Maybe HsName -declMainBinder d = - case d of - HsTypeDecl _ n _ _ _ -> Just n - HsDataDecl _ _ n _ _ _ _ -> Just n - HsNewTypeDecl _ _ n _ _ _ _ -> Just n - HsClassDecl _ _ n _ _ _ _ -> Just n - HsTypeSig _ [n] _ _ -> Just n - HsTypeSig _ _ _ _ -> error "declMainBinder" - HsForeignImport _ _ _ _ n _ _ -> Just n - _ -> Nothing - -declSubBinders :: HsDecl -> [HsName] -declSubBinders d = - case d of - HsTypeDecl _ _ _ _ _ -> [] - HsDataDecl _ _ _ _ cons _ _ -> concat (map conDeclBinders cons) - HsNewTypeDecl _ _ _ _ con _ _ -> conDeclBinders con - HsClassDecl _ _ _ _ _ decls _ -> collectNames decls - HsTypeSig _ _ _ _ -> [] - HsForeignImport _ _ _ _ _ _ _ -> [] - _ -> [] - -conDeclBinders :: HsConDecl -> [HsName] -conDeclBinders (HsConDecl _ n _ _ _ _) = [n] -conDeclBinders (HsRecDecl _ n _ _ fields _) = - n : concat (map fieldDeclBinders fields) - -fieldDeclBinders :: HsFieldDecl -> [HsName] -fieldDeclBinders (HsFieldDecl ns _ _) = ns - -splitTyConApp :: HsType -> (HsQName, [HsType]) -splitTyConApp t0 = split t0 [] - where - split :: HsType -> [HsType] -> (HsQName,[HsType]) - split (HsTyApp t u) ts = split t (u:ts) - split (HsTyCon t) ts = (t,ts) - split _ _ = error "splitTyConApp" - -freeTyCons :: HsType -> [HsQName] -freeTyCons ty = go ty [] - where go (HsForAllType _ _ t) r = go t r - go (HsTyApp t u) r = go t (go u r) - go (HsTyCon c) r = c : r - go (HsTyFun f a) r = go f (go a r) - go (HsTyTuple _ ts) r = foldr go r ts - go (HsTyVar _) r = r - go (HsTyDoc t _) r = go t r - --- | extract a module's short description. -toDescription :: Interface -> Maybe Doc -toDescription = description. iface_info - --- ----------------------------------------------------------------------------- --- Adding documentation to record fields (used in parsing). - -addFieldDoc :: HsFieldDecl -> Maybe Doc -> HsFieldDecl -addFieldDoc (HsFieldDecl ns ty doc1) doc2 = - HsFieldDecl ns ty (doc1 `mplus` doc2) - -addFieldDocs :: [HsFieldDecl] -> Maybe Doc -> [HsFieldDecl] -addFieldDocs [] _ = [] -addFieldDocs (x:xs) doc = addFieldDoc x doc : xs - -addConDoc :: HsConDecl -> Maybe Doc -> HsConDecl -addConDoc (HsConDecl pos nm tvs ctxt typeList doc1) doc2 = - HsConDecl pos nm tvs ctxt typeList (doc1 `mplus` doc2) -addConDoc (HsRecDecl pos nm tvs ctxt fields doc1) doc2= - HsRecDecl pos nm tvs ctxt fields (doc1 `mplus` doc2) - -addConDocs :: [HsConDecl] -> Maybe Doc -> [HsConDecl] -addConDocs [] _ = [] -addConDocs (x:xs) doc = addConDoc x doc : xs - --- --------------------------------------------------------------------------- --- Making abstract declarations - -restrictTo :: [HsName] -> HsDecl -> HsDecl -restrictTo names decl = case decl of - HsDataDecl loc ctxt n xs cons drv doc -> - HsDataDecl loc ctxt n xs (restrictCons names cons) drv doc - decl@(HsNewTypeDecl loc ctxt n xs con drv doc) -> - case restrictCons names [con] of - [] -> HsDataDecl loc ctxt n xs [] drv doc - [con'] -> HsNewTypeDecl loc ctxt n xs con' drv doc - -- an abstract newtype decl appears as a data decl. - HsClassDecl loc ctxt n tys fds decls doc -> - HsClassDecl loc ctxt n tys fds (restrictDecls names decls) doc - _ -> decl - -restrictCons :: [HsName] -> [HsConDecl] -> [HsConDecl] -restrictCons names decls = [ d | Just d <- map keep decls ] - where keep d@(HsConDecl _ n _ _ _ _) - | n `elem` names = Just d - keep d@(HsRecDecl loc n tvs ctx fields doc) - | n `elem` names - = if all field_avail fields - then Just d - else Just (HsConDecl loc n tvs ctx confields doc) - -- if we have *all* the field names available, then - -- keep the record declaration. Otherwise degrade to - -- a constructor declaration. This isn't quite right, but - -- it's the best we can do. - where - field_avail (HsFieldDecl ns _ _) = all (`elem` names) ns - confields = [ ty | HsFieldDecl ns ty doc <- fields, n <- ns ] - keep d = Nothing - -restrictDecls :: [HsName] -> [HsDecl] -> [HsDecl] -restrictDecls names decls = filter keep decls - where keep d = not (null (declBinders d `intersect` names)) - -- ToDo: not really correct - --- ----------------------------------------------------------------------------- --- Extract documentation from a declaration - -declDoc :: HsDecl -> Maybe Doc -declDoc (HsTypeDecl _ _ _ _ d) = d -declDoc (HsDataDecl _ _ _ _ _ _ d) = d -declDoc (HsNewTypeDecl _ _ _ _ _ _ d) = d -declDoc (HsClassDecl _ _ _ _ _ _ d) = d -declDoc (HsTypeSig _ _ _ d) = d -declDoc (HsForeignImport _ _ _ _ _ _ d) = d -declDoc _ = Nothing - --- ----------------------------------------------------------------------------- --- Parsing module headers - --- NB. The headers must be given in the order Module, Description, --- Copyright, License, Maintainer, Stability, Portability, except that --- any or all may be omitted. -parseModuleHeader :: String -> Either String (String,ModuleInfo) -parseModuleHeader str0 = - let - getKey :: String -> String -> (Maybe String,String) - getKey key str = case parseKey key str of - Nothing -> (Nothing,str) - Just (value,rest) -> (Just value,rest) - - (moduleOpt,str1) = getKey "Module" str0 - (descriptionOpt,str2) = getKey "Description" str1 - (copyrightOpt,str3) = getKey "Copyright" str2 - (licenseOpt,str4) = getKey "License" str3 - (licenceOpt,str5) = getKey "Licence" str4 - (maintainerOpt,str6) = getKey "Maintainer" str5 - (stabilityOpt,str7) = getKey "Stability" str6 - (portabilityOpt,str8) = getKey "Portability" str7 - - description1 :: Either String (Maybe Doc) - description1 = case descriptionOpt of - Nothing -> Right Nothing - Just description -> case parseString . tokenise $ description of - Left mess -> Left ("Cannot parse Description: " ++ mess) - Right doc -> Right (Just doc) - in - case description1 of - Left mess -> Left mess - Right docOpt -> Right (str8,ModuleInfo { - description = docOpt, - portability = portabilityOpt, - stability = stabilityOpt, - maintainer = maintainerOpt - }) - - --- | This function is how we read keys. --- --- all fields in the header are optional and have the form --- --- [spaces1][field name][spaces] ":" --- [text]"\n" ([spaces2][space][text]"\n" | [spaces]"\n")* --- where each [spaces2] should have [spaces1] as a prefix. --- --- Thus for the key "Description", --- --- > Description : this is a --- > rather long --- > --- > description --- > --- > The module comment starts here --- --- the value will be "this is a .. description" and the rest will begin --- at "The module comment". -parseKey :: String -> String -> Maybe (String,String) -parseKey key toParse0 = - do - let - (spaces0,toParse1) = extractLeadingSpaces toParse0 - - indentation = spaces0 - afterKey0 <- extractPrefix key toParse1 - let - afterKey1 = extractLeadingSpaces afterKey0 - afterColon0 <- case snd afterKey1 of - ':':afterColon -> return afterColon - _ -> Nothing - let - (_,afterColon1) = extractLeadingSpaces afterColon0 - - return (scanKey True indentation afterColon1) - where - scanKey :: Bool -> String -> String -> (String,String) - scanKey isFirst indentation [] = ([],[]) - scanKey isFirst indentation str = - let - (nextLine,rest1) = extractNextLine str - - accept = isFirst || sufficientIndentation || allSpaces - - sufficientIndentation = case extractPrefix indentation nextLine of - Just (c:_) | isSpace c -> True - _ -> False - - allSpaces = case extractLeadingSpaces nextLine of - (_,[]) -> True - _ -> False - in - if accept - then - let - (scanned1,rest2) = scanKey False indentation rest1 - - scanned2 = case scanned1 of - "" -> if allSpaces then "" else nextLine - _ -> nextLine ++ "\n" ++ scanned1 - in - (scanned2,rest2) - else - ([],str) - - extractLeadingSpaces :: String -> (String,String) - extractLeadingSpaces [] = ([],[]) - extractLeadingSpaces (s@(c:cs)) - | isSpace c = - let - (spaces1,cs1) = extractLeadingSpaces cs - in - (c:spaces1,cs1) - | True = ([],s) - - extractNextLine :: String -> (String,String) - extractNextLine [] = ([],[]) - extractNextLine (c:cs) - | c == '\n' = - ([],cs) - | True = - let - (line,rest) = extractNextLine cs - in - (c:line,rest) - - - -- indentation returns characters after last newline. - indentation :: String -> String - indentation s = fromMaybe s (indentation0 s) - where - indentation0 :: String -> Maybe String - indentation0 [] = Nothing - indentation0 (c:cs) = - case indentation0 cs of - Nothing -> if c == '\n' then Just cs else Nothing - in0 -> in0 - - -- comparison is case-insensitive. - extractPrefix :: String -> String -> Maybe String - extractPrefix [] s = Just s - extractPrefix s [] = Nothing - extractPrefix (c1:cs1) (c2:cs2) - | toUpper c1 == toUpper c2 = extractPrefix cs1 cs2 - | True = Nothing - --- ----------------------------------------------------------------------------- --- Filename mangling functions stolen from GHC's main/DriverUtil.lhs. - -type Suffix = String - -splitFilename :: String -> (String,Suffix) -splitFilename f = split_longest_prefix f (=='.') - -basename :: String -> String -basename f = base where (_dir, base, _suff) = splitFilename3 f - -dirname :: String -> String -dirname f = dir where (dir, _base, _suff) = splitFilename3 f - --- "foo/bar/xyzzy.ext" -> ("foo/bar", "xyzzy", ".ext") -splitFilename3 :: String -> (String,String,Suffix) -splitFilename3 str - = let (dir, rest) = split_longest_prefix str isPathSeparator - (name, ext) = splitFilename rest - real_dir | null dir = "." - | otherwise = dir - in (real_dir, name, ext) - -split_longest_prefix :: String -> (Char -> Bool) -> (String,String) -split_longest_prefix s pred0 - = case pre0 of - [] -> ([], reverse suf) - (_:pre) -> (reverse pre, reverse suf) - where (suf,pre0) = break pred0 (reverse s) - -pathSeparator :: Char -#ifdef __WIN32__ -pathSeparator = '\\' -#else -pathSeparator = '/' -#endif - -isPathSeparator :: Char -> Bool -isPathSeparator ch = -#ifdef mingw32_TARGET_OS - ch == '/' || ch == '\\' -#else - ch == '/' -#endif - -moduleHtmlFile :: String -> FilePath -moduleHtmlFile mdl = - case Map.lookup (Module mdl) html_xrefs of - Nothing -> mdl' ++ ".html" - Just fp0 -> pathJoin [fp0, mdl' ++ ".html"] - where - mdl' = map (\c -> if c == '.' then '-' else c) mdl - -nameHtmlRef :: String -> HsName -> String -nameHtmlRef mdl str = moduleHtmlFile mdl ++ '#':escapeStr (hsAnchorNameStr str) - -contentsHtmlFile, indexHtmlFile :: String -contentsHtmlFile = "index.html" -indexHtmlFile = "doc-index.html" - -subIndexHtmlFile :: Char -> String -subIndexHtmlFile a = "doc-index-" ++ b ++ ".html" - where b | isAlpha a = [a] - | otherwise = show (ord a) - -pathJoin :: [FilePath] -> FilePath -pathJoin = foldr join [] - where join :: FilePath -> FilePath -> FilePath - join path1 "" = path1 - join "" path2 = path2 - join path1 path2 - | isPathSeparator (last path1) = path1++path2 - | otherwise = path1++pathSeparator:path2 - --- ----------------------------------------------------------------------------- --- Files we need to copy from our $libdir - -cssFile, iconFile, jsFile, plusFile,minusFile :: String -cssFile = "haddock.css" -iconFile = "haskell_icon.gif" -jsFile = "haddock-util.js" -plusFile = "plus.gif" -minusFile = "minus.gif" - ------------------------------------------------------------------------------ --- misc. - -getProgramName :: IO String -getProgramName = liftM (`withoutSuffix` ".bin") getProgName - where str `withoutSuffix` suff - | suff `isSuffixOf` str = take (length str - length suff) str - | otherwise = str - -bye :: String -> IO a -bye s = putStr s >> exitWith ExitSuccess - -die :: String -> IO a -die s = hPutStr stderr s >> exitWith (ExitFailure 1) - -dieMsg :: String -> IO a -dieMsg s = getProgramName >>= \prog -> die (prog ++ ": " ++ s) - -noDieMsg :: String -> IO () -noDieMsg s = getProgramName >>= \prog -> hPutStr stderr (prog ++ ": " ++ s) - -mapSnd :: (b -> c) -> [(a,b)] -> [(a,c)] -mapSnd _ [] = [] -mapSnd f ((x,y):xs) = (x,f y) : mapSnd f xs - -mapMaybeM :: Monad m => (a -> m b) -> Maybe a -> m (Maybe b) -mapMaybeM _ Nothing = return Nothing -mapMaybeM f (Just a) = f a >>= return . Just - -escapeStr :: String -> String -escapeStr = escapeURIString isUnreserved - --- Following few functions are copy'n'pasted from Network.URI module --- to avoid depending on the network lib, since doing so gives a --- circular build dependency between haddock and network --- (at least if you want to build network with haddock docs) - -escapeURIChar :: (Char -> Bool) -> Char -> String -escapeURIChar p c - | p c = [c] - | otherwise = '%' : myShowHex (ord c) "" - where - myShowHex :: Int -> ShowS - myShowHex n r = case showIntAtBase 16 (toChrHex) n r of - [] -> "00" - [c] -> ['0',c] - cs -> cs - toChrHex d - | d < 10 = chr (ord '0' + fromIntegral d) - | otherwise = chr (ord 'A' + fromIntegral (d - 10)) - -escapeURIString :: (Char -> Bool) -> String -> String -escapeURIString p s = concatMap (escapeURIChar p) s - -isUnreserved :: Char -> Bool -isUnreserved c = isAlphaNumChar c || (c `elem` "-_.~") - -isAlphaChar c = (c >= 'A' && c <= 'Z') || (c >= 'a' && c <= 'z') -isDigitChar c = (c >= '0' && c <= '9') -isAlphaNumChar c = isAlphaChar c || isDigitChar c - ------------------------------------------------------------------------------ --- HTML cross references - --- For each module, we need to know where its HTML documentation lives --- so that we can point hyperlinks to it. It is extremely --- inconvenient to plumb this information to all the places that need --- it (basically every function in HaddockHtml), and furthermore the --- mapping is constant for any single run of Haddock. So for the time --- being I'm going to use a write-once global variable. - -{-# NOINLINE html_xrefs_ref #-} -html_xrefs_ref :: IORef (Map Module FilePath) -html_xrefs_ref = unsafePerformIO (newIORef (error "module_map")) - -{-# NOINLINE html_xrefs #-} -html_xrefs :: Map Module FilePath -html_xrefs = unsafePerformIO (readIORef html_xrefs_ref) - ------------------------------------------------------------------------------ --- Binary instances for stuff - -instance Binary Module where - put_ bh (Module m) = putString bh m - get bh = do m <- getString bh; return $! (Module m) - -instance Binary HsQName where - put_ bh (Qual m s) = do putByte bh 0; put_ bh m; put_ bh s - put_ bh (UnQual s) = do putByte bh 1; put_ bh s - get bh = do b <- getByte bh - case b of - 0 -> do m <- get bh; s <- get bh; return (Qual m s) - _ -> do s <- get bh; return (UnQual s) - -instance Binary HsName where - put_ bh (HsTyClsName s) = do putByte bh 0; put_ bh s - put_ bh (HsVarName s) = do putByte bh 1; put_ bh s - get bh = do b <- getByte bh - case b of - 0 -> do s <- get bh; return (HsTyClsName s) - _ -> do s <- get bh; return (HsVarName s) - -instance Binary HsIdentifier where - put_ bh (HsIdent s) = do putByte bh 0; putString bh s - put_ bh (HsSymbol s) = do putByte bh 1; putString bh s - put_ bh (HsSpecial s) = do putByte bh 2; putString bh s - get bh = do b <- getByte bh - case b of - 0 -> do s <- getString bh; return (HsIdent s) - 1 -> do s <- getString bh; return (HsSymbol s) - _ -> do s <- getString bh; return (HsSpecial s) - -instance Binary id => Binary (GenDoc id) where - put_ bh DocEmpty = putByte bh 0 - put_ bh (DocAppend gd1 gd2) = do putByte bh 1;put_ bh gd1;put_ bh gd2 - put_ bh (DocString s) = do putByte bh 2;putString bh s - put_ bh (DocParagraph gd) = do putByte bh 3;put_ bh gd - put_ bh (DocIdentifier id) = do putByte bh 4;put_ bh id - put_ bh (DocModule s) = do putByte bh 5;putString bh s - put_ bh (DocEmphasis gd) = do putByte bh 6;put_ bh gd - put_ bh (DocMonospaced gd) = do putByte bh 7;put_ bh gd - put_ bh (DocUnorderedList gd) = do putByte bh 8;put_ bh gd - put_ bh (DocOrderedList gd) = do putByte bh 9;put_ bh gd - put_ bh (DocDefList gd) = do putByte bh 10;put_ bh gd - put_ bh (DocCodeBlock gd) = do putByte bh 11;put_ bh gd - put_ bh (DocURL s) = do putByte bh 12;putString bh s - put_ bh (DocAName s) = do putByte bh 13;putString bh s - put_ bh (DocPic s) = do putByte bh 14;putString bh s - get bh = do b <- getByte bh - case b of - 0 -> return DocEmpty - 1 -> do gd1 <- get bh;gd2 <- get bh;return (DocAppend gd1 gd2) - 2 -> do s <- getString bh;return (DocString s) - 3 -> do gd <- get bh;return (DocParagraph gd) - 4 -> do id <- get bh;return (DocIdentifier id) - 5 -> do s <- getString bh;return (DocModule s) - 6 -> do gd <- get bh;return (DocEmphasis gd) - 7 -> do gd <- get bh;return (DocMonospaced gd) - 8 -> do gd <- get bh;return (DocUnorderedList gd) - 9 -> do gd <- get bh;return (DocOrderedList gd) - 10 -> do gd <- get bh;return (DocDefList gd) - 11 -> do gd <- get bh;return (DocCodeBlock gd) - 12 -> do s <- getString bh;return (DocURL s) - 13 -> do s <- getString bh;return (DocAName s) - 14 -> do s <- getString bh;return (DocPic s) - _ -> error ("Mysterious byte in document in interface" - ++ show b) - - diff --git a/src/HaddockVersion.hs b/src/HaddockVersion.hs deleted file mode 100644 --- a/src/HaddockVersion.hs +++ /dev/null @@ -1,18 +0,0 @@ --- --- Haddock - A Haskell Documentation Tool --- --- (c) Simon Marlow 2003 --- - -module HaddockVersion ( - projectName, projectVersion, projectUrl - ) where - -import Paths_haddock ( version ) -import Data.Version ( showVersion ) - -projectName, projectUrl :: String -projectName = "Haddock" -projectUrl = "http://www.haskell.org/haddock/" - -projectVersion = showVersion version diff --git a/src/HsLexer.lhs b/src/HsLexer.lhs deleted file mode 100644 --- a/src/HsLexer.lhs +++ /dev/null @@ -1,713 +0,0 @@ ------------------------------------------------------------------------------ --- $Id: HsLexer.lhs,v 1.18 2005/03/09 08:28:39 wolfgang Exp $ --- --- (c) The GHC Team, 1997-2000 --- --- Lexer for Haskell. --- ------------------------------------------------------------------------------ - -ToDo: Parsing floats is a *real* hack... -ToDo: Introduce different tokens for decimal, octal and hexadecimal (?) -ToDo: FloatTok should have three parts (integer part, fraction, exponent) -ToDo: Use a lexical analyser generator (lx?) - -\begin{code} -module HsLexer (Token(..), lexer, parseError,isSymbol) where - -import HsParseMonad -import HsParseUtils -import HsSyn - -import Numeric ( readHex, readOct ) -import Char -import List ( isPrefixOf ) -\end{code} - -\begin{code} -data Token - = VarId String - | IPVarId String - | QVarId (String,String) - | ConId String - | QConId (String,String) - | VarSym String - | ConSym String - | QVarSym (String,String) - | QConSym (String,String) - --- Literals - - | IntTok Integer - | FloatTok String - | Character Char - | StringTok String - | PrimChar Char -- GHC extension - | PrimInt Integer -- GHC extension - | PrimString String -- GHC extension - | PrimFloat String -- GHC extension - | PrimDouble String -- GHC extension - --- Symbols - - | LeftParen - | RightParen - | SemiColon - | LeftCurly - | RightCurly - | VRightCurly -- a virtual close brace - | LeftSquare - | RightSquare - | Comma - | Underscore - | BackQuote - | LeftUT -- GHC Extension: (# - | RightUT -- GHC Extension: #) - --- Documentation annotations - - | DocCommentNext String -- something beginning '-- |' - | DocCommentPrev String -- something beginning '-- ^' - | DocCommentNamed String -- something beginning '-- $' - | DocSection Int String -- a section heading - | DocOptions String -- attributes '-- #' - --- Reserved operators - - | Dot -- GHC extension - | DotDot - | DoubleColon - | Equals - | Backslash - | Bar - | LeftArrow - | RightArrow - | At - | Tilde - | DoubleArrow - | Minus - | Exclamation - --- Reserved Ids - - | KW_As - | KW_Case - | KW_CCall - | KW_Class - | KW_Data - | KW_Default - | KW_Deriving - | KW_Do - | KW_DotNet - | KW_Else - | KW_Export - | KW_Forall - | KW_Foreign - | KW_Hiding - | KW_If - | KW_Import - | KW_In - | KW_Infix - | KW_InfixL - | KW_InfixR - | KW_Instance - | KW_Let - | KW_Module - | KW_NewType - | KW_Of - | KW_Safe - | KW_StdCall - | KW_Then - | KW_ThreadSafe - | KW_Type - | KW_Unsafe - | KW_Where - | KW_Qualified - - | EOF - deriving (Eq,Show) - -reserved_ops :: [(String,Token)] -reserved_ops = [ - ( ".", Dot ), -- GHC extension - ( "..", DotDot ), - ( "::", DoubleColon ), - ( "=", Equals ), - ( "\\", Backslash ), - ( "|", Bar ), - ( "<-", LeftArrow ), - ( "->", RightArrow ), - ( "@", At ), - ( "~", Tilde ), - ( "=>", DoubleArrow ), - ( "-", Minus ), --ToDo: shouldn't be here - ( "!", Exclamation ) --ditto - ] - -reserved_ids :: [(String,Token)] -reserved_ids = [ - ( "_", Underscore ), - ( "case", KW_Case ), - ( "ccall", KW_CCall ), - ( "class", KW_Class ), - ( "data", KW_Data ), - ( "default", KW_Default ), - ( "deriving", KW_Deriving ), - ( "do", KW_Do ), - ( "dotnet", KW_DotNet ), - ( "else", KW_Else ), - ( "export", KW_Export ), - ( "forall", KW_Forall ), - ( "foreign", KW_Foreign ), - ( "if", KW_If ), - ( "import", KW_Import ), - ( "in", KW_In ), - ( "infix", KW_Infix ), - ( "infixl", KW_InfixL ), - ( "infixr", KW_InfixR ), - ( "instance", KW_Instance ), - ( "let", KW_Let ), - ( "mdo", KW_Do ), -- pretend mdo is do, for now. - ( "module", KW_Module ), - ( "newtype", KW_NewType ), - ( "of", KW_Of ), - ( "safe", KW_Safe ), - ( "then", KW_Then ), - ( "threadsafe",KW_ThreadSafe ), - ( "type", KW_Type ), - ( "unsafe", KW_Unsafe ), - ( "where", KW_Where ), - ( "as", KW_As ), - ( "qualified", KW_Qualified ), - ( "hiding", KW_Hiding ), - ( "stdcall", KW_StdCall ) - ] - -specialIds = [ - KW_As, - KW_Unsafe, - KW_Safe, - KW_ThreadSafe, - KW_Qualified, - KW_Hiding, - KW_Export, - KW_StdCall, - KW_CCall, - KW_DotNet - ] - -isIdent, isSymbol, isWhite :: Char -> Bool -isIdent c = isAlpha c || isDigit c || c == '\'' || c == '_' -isSymbol c = elem c ":!#$%&*+./<=>?@\\^|-~" -isWhite c = elem c " \n\r\t\v\f" - -isIdentInitial :: Char -> Bool -isIdentInitial ch = isLower ch || ch == '_' - -tAB_LENGTH :: Int -tAB_LENGTH = 8 - --- The source location, (y,x), is the coordinates of the previous token. --- col is the current column in the source file. If col is 0, we are --- somewhere at the beginning of the line before the first token. - --- Setting col to 0 is used in two places: just after emitting a virtual --- close brace due to layout, so that next time through we check whether --- we also need to emit a semi-colon, and at the beginning of the file, --- to kick off the lexer. - - -lexer :: (Token -> P a) -> P a -lexer cont input (SrcLoc _ x0 _) y0 col f = - if col == 0 - then tab y0 x0 f True input - else tab y0 col f False input -- throw away old x - where - -- move past whitespace and comments - tab y x f _ [] = - cont EOF [] (SrcLoc y x f) y col f - tab y x f bol ('\t':s) = - tab y (nextTab x) f bol s - tab y _ f _ ('\n':s) = - newLine cont s y f - - tab y _ f True ('#':s) - | "pragma GCC set_debug_pwd" `isPrefixOf` s - = newLine cont (tail $ dropWhile (/= '\n') s) y f - - tab y x f True ('#':' ':s@(d:_)) - | isDigit d = parseLinePragma tab y f s - - -- single-line comments - tab y x f bol s@('-':'-':' ':c:_) | doc c = - is_a_token bol s y x f - tab y _ f _ ('-':'-':s) | null s || not (isSymbol (head (dropWhile (== '-') s))) = - newLine cont (drop 1 (dropWhile (/= '\n') s)) y f - - -- multi-line nested comments and pragmas - tab y x f bol ('{':'-':'#':s) = pragma tab y (x+3) f bol s - tab y x f bol s@('{':'-':c:_) | doc c = - is_a_token bol s y x f - tab y x f bol s@('{':'-':' ':c:_) | doc c = - is_a_token bol s y x f - tab y x f bol ('{':'-':s) = nestedComment (\y x -> tab y x f) y (x+2) bol s - - tab y x f bol (c:s) - | isWhite c = tab y (x+1) f bol s - | otherwise = is_a_token bol (c:s) y x f - - is_a_token bol s y x f - | bol = lexBOL cont s (SrcLoc y x f) y x f - | otherwise = lexToken cont s (SrcLoc y x f) y x f - - newLine _ s y f = tab (y+1) 1 f True s - - doc '|' = True - doc '/' = True - doc '^' = True - doc '*' = True - doc '$' = True - doc '#' = True - doc _ = False - -nextTab :: Int -> Int -nextTab x = x + (tAB_LENGTH - (x-1) `mod` tAB_LENGTH) - --- When we are lexing the first token of a line, check whether we need to --- insert virtual semicolons or close braces due to layout. - -lexBOL :: (Token -> P a) -> P a -lexBOL cont s loc y x f context = - if need_close_curly then - -- trace "layout: inserting '}'\n" $ - -- Set col to 0, indicating that we're still at the - -- beginning of the line, in case we need a semi-colon too. - -- Also pop the context here, so that we don't insert - -- another close brace before the parser can pop it. - cont VRightCurly s loc y 0 f (tail context) - else if need_semi_colon then - --trace "layout: inserting ';'\n" $ - cont SemiColon s loc y x f context - else - lexToken cont s loc y x f context - where - need_close_curly = - case context of - [] -> False - (i:_) -> case i of - NoLayout -> False - Layout n -> x < n - need_semi_colon = - case context of - [] -> False - (i:_) -> case i of - NoLayout -> False - Layout n -> x == n - -lexToken :: (Token -> P a) -> P a ---lexToken _ [] loc _ _ = --- error $ "Internal error: empty input in lexToken at " ++ show loc -lexToken cont s0 loc y x f = - -- trace ("lexer: y="++show y++" x="++show x++"\n") $ - case s0 of - [] -> error $ "Internal error: empty input in lexToken at " - ++ show loc - -- First the doc comments - '-':'-':' ':s -> do_doc s False - '{':'-':' ':s -> do_doc s True - '{':'-':s -> do_doc s True - - -- Next the special symbols - '(':'#':s -> forward 2 LeftUT s - '(':s -> forward 1 LeftParen s - '#':')':s -> forward 2 RightUT s - ')':s -> forward 1 RightParen s - ',':s -> forward 1 Comma s - ';':s -> forward 1 SemiColon s - '[':s -> forward 1 LeftSquare s - ']':s -> forward 1 RightSquare s - '`':s -> forward 1 BackQuote s - '{':s -> \ctxt -> forward 1 LeftCurly s (NoLayout : ctxt) - '}':s -> \ctxt0 -> case ctxt0 of - (_:ctxt) -> forward 1 RightCurly s ctxt - -- pop context on '}' - [] -> error "Internal error: empty context in lexToken" - - '?':s:ss - | isIdentInitial s -> lexToken ( \ (VarId x) -> cont (IPVarId x)) (s:ss) loc y x f - '\'':s -> lexChar cont s loc y (x+1) f - '\"':s{-"-} -> lexString cont s loc y (x+1) f - - '0':'x':c:s | isHexDigit c -> - let (num, rest) = span isHexDigit (c:s) - [(i,_)] = readHex num - in - afterNum cont i rest loc y (x+length num) f - '0':'o':c:s | isOctDigit c -> - let (num, rest) = span isOctDigit (c:s) - [(i,_)] = readOct num - in - afterNum cont i rest loc y (x+length num) f - - c:s | isIdentInitial c -> - let - (idtail, rest) = slurpIdent s - id0 = c:idtail - l_id = 1 + length idtail - in - case lookup id0 reserved_ids of - Just keyword -> forward l_id keyword rest - Nothing -> forward l_id (VarId id0) rest - - | isUpper c -> lexCon "" cont (c:s) loc y x f - | isSymbol c -> - let - (symtail, rest) = span isSymbol s - sym = c : symtail - l_sym = 1 + length symtail - in - case lookup sym reserved_ops of - Just t -> forward l_sym t rest - Nothing -> case c of - ':' -> forward l_sym (ConSym sym) rest - _ -> forward l_sym (VarSym sym) rest - - | isDigit c -> lexNum cont c s loc y x f - - | otherwise -> - parseError ("illegal character \'" ++ show c ++ "\'\n") - s loc y x f - - where forward n t str = cont t str loc y (x+n) f - - -- this is all terribly ugly, sorry :( - do_doc ('|':s) nested = multi nested DocCommentNext cont s loc y x f - do_doc ('/':s) nested = multi nested DocCommentNext cont s loc y x f - do_doc ('^':s) nested = multi nested DocCommentPrev cont s loc y x f - do_doc ('$':s) nested = multi nested DocCommentNamed cont s loc y x f - do_doc ('#':s) nested = multi nested DocOptions cont s loc y x f - do_doc ('*':s) nested = section 1 s - where section n ('*':s1) = section (n+1) s1 - section n s1 - | nested = nestedDocComment (DocSection n) cont s1 loc y x f - | otherwise = oneLineDocComment (DocSection n) cont s1 loc y x f - do_doc _ _ = error "Internal error: HsLexer.do_doc" - - -multi :: Bool -> ([Char] -> b) - -> (b -> [Char] -> c -> Int -> Int -> d) - -> [Char] -> c -> Int -> Int -> d -multi True = nestedDocComment -multi False = multiLineDocComment - -afterNum :: Num a => (Token -> [Char] -> b -> c -> a -> d -> e) - -> Integer -> [Char] -> b -> c -> a -> d -> e -afterNum cont i ('#':s) loc y x f = cont (PrimInt i) s loc y (x+1) f -afterNum cont i s loc y x f = cont (IntTok i) s loc y x f - -lexNum :: (Token -> [Char] -> a -> b -> Int -> c -> d) - -> Char -> [Char] -> a -> b -> Int -> c -> d -lexNum cont c0 s0 loc y x fname = - let (num, after_num) = span isDigit (c0:s0) - in - case after_num of - '.':c1:s1 | isDigit c1 -> - let (frac,after_frac) = span isDigit s1 - in - let float = num ++ '.':frac - (f, after_exp) - = case after_frac of - 'E':s -> do_exponent s - 'e':s -> do_exponent s - _ -> (float, after_frac) - - do_exponent s2 = - case s2 of - '-':c:s | isDigit c -> - let (exp0,rest) = span isDigit (c:s) in - (float ++ 'e':'-':exp0, rest) - '+':c:s | isDigit c -> - let (exp0,rest) = span isDigit (c:s) in - (float ++ 'e':'+':exp0, rest) - c:s | isDigit c -> - let (exp0,rest) = span isDigit (c:s) in - (float ++ 'e':exp0, rest) - _ -> (float, after_frac) - - x' = x + length f - - in case after_exp of -- glasgow exts only - '#':'#':s -> cont (PrimDouble f) s loc y x' fname - '#':s -> cont (PrimFloat f) s loc y x' fname - s -> cont (FloatTok f) s loc y x' fname - - _ -> afterNum cont (parseInteger 10 num) after_num loc y (x + length num) fname - - --- GHC extension: allow trailing '#'s in an identifier. -slurpIdent :: String -> (String, String) -slurpIdent s = slurp' s [] - where - slurp' [] i = (reverse i, []) - slurp' (c:cs) i - | isIdent c = slurp' cs (c:i) - | c == '#' = slurphashes cs (c:i) - slurp' cs i = (reverse i, cs) - -slurphashes :: String -> String -> (String, String) -slurphashes [] i = (reverse i, []) -slurphashes ('#':cs) i = slurphashes cs ('#':i) -slurphashes s i = (reverse i, s) - -lexCon :: [Char] -> (Token -> String -> a -> b -> Int -> c -> d) - -> String -> a -> b -> Int -> c -> d -lexCon qual cont s0 loc y x f = - let - forward n t s = cont t s loc y (x+n) f - - (con, rest) = slurpIdent s0 - l_con = length con - - just_a_conid - | null qual = forward l_con (ConId con) rest - | otherwise = forward l_con (QConId (qual,con)) rest - - qual' | null qual = con - | otherwise = qual ++ '.':con - in - case rest of - '.':c1:s1 - | isIdentInitial c1 -> -- qualified varid? - let - (idtail, rest1) = slurpIdent s1 - id0 = c1:idtail - l_id = 1 + length idtail - in - case lookup id0 reserved_ids of - -- cannot qualify a reserved word - Just id | id `notElem` specialIds -> just_a_conid - _ -> forward (l_con+1+l_id) (QVarId (qual', id0)) rest1 - - | isUpper c1 -> -- qualified conid? - lexCon qual' cont (c1:s1) loc y (x+l_con+1) f - - | isSymbol c1 -> -- qualified symbol? - let - (symtail, rest1) = span isSymbol s1 - sym = c1 : symtail - l_sym = 1 + length symtail - in - case lookup sym reserved_ops of - -- cannot qualify a reserved operator - Just _ -> just_a_conid - Nothing -> - case c1 of - ':' -> forward (l_con+1+l_sym) (QConSym (qual', sym)) rest1 - _ -> forward (l_con+1+l_sym) (QVarSym (qual', sym)) rest1 - - _ -> just_a_conid -- not a qualified thing - - -lexChar :: (Token -> P a) -> P a -lexChar cont s0 loc0 y x f = case s0 of - '\\':s1 -> (escapeChar s1 `thenP` \(e,s,i) _ _ _ _ _ -> - charEnd e s loc0 y (x+i) f) s1 loc0 y x f - c:s -> charEnd c s loc0 y (x+1) f - [] -> char_err [] loc0 y x f - - where charEnd c ('\'':'#':s) = \loc y0 x0 f0 -> cont (PrimChar c) s loc y0 (x0+2) f0 - charEnd c ('\'':s) = \loc y0 x0 f0 -> cont (Character c) s loc y0 (x0+1) f0 - charEnd c s = char_err s - - char_err s = parseError "Improperly terminated character constant" s - -lexString :: (Token -> P a) -> P a -lexString cont s0 loc y0 x0 f0 = loop "" s0 x0 y0 f0 - where - loop e s1 x y f = case s1 of - '\\':'&':s -> loop e s (x+2) y f - '\\':c:s | isSpace c -> stringGap e s (x+2) y f - | otherwise -> (escapeChar (c:s) `thenP` \(e',s2,i) _ _ _ _ -> - loop (e':e) s2 (x+i) y) s loc y x f - '\"':'#':s -> cont (PrimString (reverse e)) s loc y (x+2) f - '\"':s{-"-} -> cont (StringTok (reverse e)) s loc y (x+1) f - c:s -> loop (c:e) s (x+1) y f - [] -> parseError "Improperly terminated string" s1 loc y x f - - stringGap e s1 x y = case s1 of - '\n':s -> stringGap e s 1 (y+1) - '\\':s -> loop e s (x+1) y - c:s | isSpace c -> stringGap e s (x+1) y - | otherwise -> - parseError "Illegal character in string gap" s1 loc y x - [] -> error "Internal error: stringGap" - --- ToDo: \o, \x, \ things. - -escapeChar :: String -> P (Char,String,Int) -escapeChar s0 = case s0 of - - 'x':c:s | isHexDigit c -> - let (num,rest) = span isHexDigit (c:s) in - returnP (chr (fromIntegral (parseInteger 16 num)), rest, length num) - - 'o':c:s | isOctDigit c -> - let (num,rest) = span isOctDigit (c:s) in - returnP (chr (fromIntegral (parseInteger 8 num)), rest, length num) - - c:s | isDigit c -> let (num,rest) = span isDigit (c:s) in - returnP (chr (read num), rest, length num) - --- Production charesc from section B.2 (Note: \& is handled by caller) - - 'a':s -> returnP ('\a',s,2) - 'b':s -> returnP ('\b',s,2) - 'f':s -> returnP ('\f',s,2) - 'n':s -> returnP ('\n',s,2) - 'r':s -> returnP ('\r',s,2) - 't':s -> returnP ('\t',s,2) - 'v':s -> returnP ('\v',s,2) - '\\':s -> returnP ('\\',s,2) - '"':s -> returnP ('\"',s,2) - '\'':s -> returnP ('\'',s,2) - --- Production ascii from section B.2 - - '^':x@(_:_) -> cntrl x - 'N':'U':'L':s -> returnP ('\NUL',s,4) - 'S':'O':'H':s -> returnP ('\SOH',s,4) - 'S':'T':'X':s -> returnP ('\STX',s,4) - 'E':'T':'X':s -> returnP ('\ETX',s,4) - 'E':'O':'T':s -> returnP ('\EOT',s,4) - 'E':'N':'Q':s -> returnP ('\ENQ',s,4) - 'A':'C':'K':s -> returnP ('\ACK',s,4) - 'B':'E':'L':s -> returnP ('\BEL',s,4) - 'B':'S':s -> returnP ('\BS', s,3) - 'H':'T':s -> returnP ('\HT', s,3) - 'L':'F':s -> returnP ('\LF', s,3) - 'V':'T':s -> returnP ('\VT', s,3) - 'F':'F':s -> returnP ('\FF', s,3) - 'C':'R':s -> returnP ('\CR', s,3) - 'S':'O':s -> returnP ('\SO', s,3) - 'S':'I':s -> returnP ('\SI', s,3) - 'D':'L':'E':s -> returnP ('\DLE',s,4) - 'D':'C':'1':s -> returnP ('\DC1',s,4) - 'D':'C':'2':s -> returnP ('\DC2',s,4) - 'D':'C':'3':s -> returnP ('\DC3',s,4) - 'D':'C':'4':s -> returnP ('\DC4',s,4) - 'N':'A':'K':s -> returnP ('\NAK',s,4) - 'S':'Y':'N':s -> returnP ('\SYN',s,4) - 'E':'T':'B':s -> returnP ('\ETB',s,4) - 'C':'A':'N':s -> returnP ('\CAN',s,4) - 'E':'M':s -> returnP ('\EM', s,3) - 'S':'U':'B':s -> returnP ('\SUB',s,4) - 'E':'S':'C':s -> returnP ('\ESC',s,4) - 'F':'S':s -> returnP ('\FS', s,3) - 'G':'S':s -> returnP ('\GS', s,3) - 'R':'S':s -> returnP ('\RS', s,3) - 'U':'S':s -> returnP ('\US', s,3) - 'S':'P':s -> returnP ('\SP', s,3) - 'D':'E':'L':s -> returnP ('\DEL',s,4) - - _ -> parseError "Illegal escape sequence" - - --- Stolen from Hugs's Prelude -parseInteger :: Integer -> String -> Integer -parseInteger radix ds = - foldl1 (\n d -> n * radix + d) (map (toInteger . digitToInt) ds) - --- Production cntrl from section B.2 - -cntrl :: String -> P (Char,String,Int) -cntrl (c:s) | c >= '@' && c <= '_' = returnP (chr (ord c - ord '@'), s,2) -cntrl _ = parseError "Illegal control character" - - -pragma :: (Int -> Int -> FilePath -> Bool -> [Char] -> b) - -> Int -> Int -> FilePath -> Bool -> [Char] -> b -pragma cont y x f bol s0 = - case span (==' ') s0 of - (_, 'L':'I':'N':'E':' ':s) -> parseLinePragma cont y f s - (_, 'l':'i':'n':'e':' ':s) -> parseLinePragma cont y f s - (sp,s) -> nestedComment (\y x -> cont y x f) y (x+length sp) bol s - -parseLinePragma :: (Int -> Int -> FilePath -> Bool -> [Char] -> b) - -> Int -> FilePath -> [Char] -> b -parseLinePragma cont y fname s0 = - cont y' 1 fname' True (drop 1 (dropWhile (/= '\n') s0)) - - where s1 = dropWhite s0 - (lineStr, s2) = span isDigit s1 - y' = case reads lineStr of - ((y',_):_) -> y' - _ -> y - s3 = dropWhite s2 - fnameStr = takeWhile (\c -> c /= '"' && c/='\n') (tail s3) - fname' | null s3 || head s3 /= '"' = fname - -- try and get more sharing of file name strings - | fnameStr == fname = fname - | otherwise = fnameStr - dropWhite = dropWhile (\c -> c == ' ' || c == '\t') - -nestedComment :: (Int -> Int -> Bool -> [Char] -> b) - -> Int -> Int -> Bool -> [Char] -> b -nestedComment cont y x bol s0 = - case s0 of - '-':'}':s -> cont y (x+2) bol s - '{':'-':s -> nestedComment (nestedComment cont) y (x+2) bol s - '\t':s -> nestedComment cont y (nextTab x) bol s - '\n':s -> nestedComment cont (y+1) 1 True s - _:s -> nestedComment cont y (x+1) bol s - [] -> error "Internal error: nestedComment" - -nestedDocComment :: ([Char] -> b) - -> (b -> [Char] -> c -> Int -> Int -> d) - -> [Char] -> c -> Int -> Int -> d -nestedDocComment f0 cont0 s0 loc y0 x0 = go f0 cont0 "" y0 x0 s0 - where - go f cont acc y1 x1 s1 = - case s1 of - '-':'}':s -> cont (f (reverse acc)) s loc y1 (x1+2) - '{':'-':s -> nestedComment (\y x _ s2 -> go f cont acc y x s2) - y1 (x1+2) False s - '\t':s -> go f cont ('\t':acc) y1 (nextTab x1) s - '\n':s -> go f cont ('\n':acc) (y1+1) 1 s - c:s -> go f cont (c:acc) y1 (x1+1) s - [] -> error "Internal error: nestedComment" - -oneLineDocComment :: ([Char] -> a) - -> (a -> [Char] -> b -> c -> d -> e) - -> [Char] -> b -> c -> d -> e -oneLineDocComment f cont s loc y x - = cont (f line) rest loc y x -- continue with the newline char - where (line, rest) = break (== '\n') s - -multiLineDocComment :: Num a => ([Char] -> b) - -> (b -> [Char] -> c -> a -> d -> e) - -> [Char] -> c -> a -> d -> e -multiLineDocComment f cont s loc y x - = cont (f comment) s' loc y' x -- continue with the newline char - where (s', comment, y') = slurpExtraCommentLines s [] y - -slurpExtraCommentLines :: Num a => [Char] -> [[Char]] -> a - -> ([Char], [Char], a) -slurpExtraCommentLines s0 lines0 y - = case rest of - '\n':nextline -> - case dropWhile nonNewlineSpace nextline of - -- stop slurping if we see a string of more than two '-'; - -- strings of dashes are useful as separators but we don't - -- want them in the doc. - '-':'-':c:s | c /= '-' - -> slurpExtraCommentLines (c:s) - ((line++"\n"):lines0) (y+1) - _ -> (rest, finished, y) - _ -> (rest, finished, y) - where - (line, rest) = break (== '\n') s0 - finished = concat (reverse (line:lines0)) - -nonNewlineSpace :: Char -> Bool -nonNewlineSpace c = isSpace c && c /= '\n' -\end{code} diff --git a/src/HsParseMonad.lhs b/src/HsParseMonad.lhs deleted file mode 100644 --- a/src/HsParseMonad.lhs +++ /dev/null @@ -1,73 +0,0 @@ ------------------------------------------------------------------------------ --- $Id: HsParseMonad.lhs,v 1.2 2002/07/24 09:42:18 simonmar Exp $ --- --- (c) The GHC Team 1997-2000 --- --- Monad for the Haskell parser. --- ------------------------------------------------------------------------------ - -\begin{code} -module HsParseMonad where - -import HsSyn -\end{code} - -\begin{code} -data ParseResult a = Ok ParseState a | Failed SrcLoc String - deriving Show - -data LexContext = NoLayout | Layout Int - deriving (Eq,Ord,Show) - -type ParseState = [LexContext] - -type P a - = String -- input string - -> SrcLoc -- location of last token read - -> Int -- current line - -> Int -- current column - -> FilePath -- current original filename - -> ParseState -- layout info. - -> ParseResult a - -thenP :: P a -> (a -> P b) -> P b -m `thenP` k = \i l n c f s0 -> - case m i l n c f s0 of - Failed l s -> Failed l s - Ok s' a -> case k a of k' -> k' i l n c f s' - -thenP_ :: P a -> P b -> P b -m `thenP_` k = m `thenP` \_ -> k - -mapP :: (a -> P b) -> [a] -> P [b] -mapP _ [] = returnP [] -mapP f (a:as) = - f a `thenP` \b -> - mapP f as `thenP` \bs -> - returnP (b:bs) - -returnP :: a -> P a -returnP a = \_ _ _ _ _ s -> Ok s a - -failP :: String -> P a -failP err = \_ l _ _ _ _ -> Failed l err - -getSrcLoc :: P SrcLoc -getSrcLoc = \_ l _ _ _ s -> Ok s l - -getContext :: P [LexContext] -getContext = \_ _ _ _ _ s -> Ok s s - -pushContext :: LexContext -> P () -pushContext ctxt = ---trace ("pushing lexical scope: " ++ show ctxt ++"\n") $ - \_ _ _ _ _ s -> Ok (ctxt:s) () - -popContext :: P () -popContext = \_ _ _ _ _ stk -> - case stk of - (_:s) -> --trace ("popping lexical scope, context now "++show s ++ "\n") $ - Ok s () - [] -> error "Internal error: empty context in popContext" -\end{code} diff --git a/src/HsParseUtils.lhs b/src/HsParseUtils.lhs deleted file mode 100644 --- a/src/HsParseUtils.lhs +++ /dev/null @@ -1,325 +0,0 @@ ------------------------------------------------------------------------------ --- $Id: HsParseUtils.lhs,v 1.6 2003/10/20 17:19:23 sof Exp $ --- --- (c) The GHC Team 1997-2000 --- --- Utilities for the Haskell parser. --- ------------------------------------------------------------------------------ - -ToDo: Polish readInteger, readRational - -\begin{code} -module HsParseUtils ( - parseError -- String -> Pa - , splitTyConApp -- HsType -> P (HsName,[HsType]) - , mkRecConstrOrUpdate -- HsExp -> [HsFieldUpdate] -> P HsExp - , checkPrec -- String -> P String - , checkContext -- HsType -> P HsIPContext - , checkIPContext -- HsIPContext -> P HsContext - , checkAssertion -- HsType -> P HsAsst - , checkInstHeader -- HsType -> P (HsContext, HsAsst) - , checkClassHeader -- HsType -> P (HsContext, HsName, [HsType]) - , checkDataHeader -- HsType -> P (HsContext,HsName,[HsName]) - , checkPattern -- HsExp -> P HsPat - , checkPatterns -- [HsExp] -> P [HsPat] - , checkExpr -- HsExp -> P HsExp - , checkValDef -- (SrcLoc, HsExp, HsRhs, [HsDecl]) -> P HsDecl - , checkUnQual -- HsQName -> P HsName - , readInteger -- String -> Integer - , readRational -- String -> Rational - - , toVarHsName -- HsName -> HsName - , toTyClsHsName -- HsName -> HsName - ) where - -import HsSyn -import HsParseMonad - -import Char(isDigit,isOctDigit,isHexDigit,digitToInt) -import List(partition) -import Ratio -\end{code} - -\begin{code} -parseError :: String -> P a -parseError = failP - -splitTyConApp :: HsType -> P (HsName,[HsType]) -splitTyConApp t0 = split t0 [] - where - split :: HsType -> [HsType] -> P (HsName,[HsType]) - split (HsTyApp t u) ts = split t (u:ts) - split (HsTyCon (UnQual t)) ts = returnP (t,ts) - -- to cope with data [] = [] | a:[a] - split (HsTyCon (Qual _ t)) ts = returnP (t,ts) - split _ _ = parseError "Illegal data/newtype declaration" - ------------------------------------------------------------------------------ --- Various Syntactic Checks - -checkContext :: HsType -> P HsIPContext -checkContext (HsTyTuple True ts) = mapP checkCtxt ts - where - checkCtxt (HsTyIP n ty) = returnP (HsIP n ty) - checkCtxt t0 = - checkAssertion t0 `thenP` \ c -> - returnP (HsAssump c) -checkContext (HsTyIP n t) = returnP [HsIP n t] -checkContext t = - checkAssertion t `thenP` \c -> - returnP [HsAssump c] - -checkIPContext :: HsIPContext -> P HsContext -checkIPContext ls = - case partition isIP ls of - ([],cs) -> returnP (map (\ (HsAssump c) -> c) cs) - (_,_) -> parseError "Unexpected implicit parameter in context" - where - isIP HsIP{} = True - isIP _ = False - --- Changed for multi-parameter type classes - -checkAssertion :: HsType -> P HsAsst -checkAssertion = checkAssertion' [] - where checkAssertion' ts (HsTyCon c) = returnP (c,ts) - checkAssertion' ts (HsTyApp a t) = checkAssertion' (t:ts) a - checkAssertion' _ _ = parseError "Illegal class assertion" - -checkInstHeader :: HsType -> P (HsContext, HsAsst) -checkInstHeader (HsForAllType Nothing ctxt ty) = - checkAssertion ty `thenP` \asst -> - checkIPContext ctxt `thenP` \ctxt' -> - returnP (ctxt', asst) -checkInstHeader ty = - checkAssertion ty `thenP` \asst -> - returnP ([], asst) - -checkDataHeader :: HsType -> P (HsContext,HsName,[HsName]) -checkDataHeader (HsForAllType Nothing cs t) = - checkSimple "data/newtype" t [] `thenP` \(c,ts) -> - checkIPContext cs `thenP` \cs' -> - returnP (cs',c,ts) -checkDataHeader ty = - checkSimple "data/newtype" ty [] `thenP` \(c,ts) -> - returnP ([],c,ts) - -checkClassHeader :: HsType -> P (HsContext,HsName,[HsName]) -checkClassHeader (HsForAllType Nothing cs t) = - checkSimple "class" t [] `thenP` \(c,ts) -> - checkIPContext cs `thenP` \cs' -> - returnP (cs',c,ts) -checkClassHeader ty = - checkSimple "class" ty [] `thenP` \(c,ts) -> - returnP ([],c,ts) - -checkSimple :: String -> HsType -> [HsName] -> P ((HsName,[HsName])) -checkSimple kw (HsTyApp l (HsTyVar a)) xs = checkSimple kw l (a:xs) -checkSimple _kw (HsTyCon (UnQual t)) xs = returnP (t,xs) -checkSimple _ (HsTyCon (Qual m t)) xs - | m == prelude_mod = returnP (t,xs) -- for "special" declarations -checkSimple kw _ _ = failP ("Illegal " ++ kw ++ " declaration") - ------------------------------------------------------------------------------ --- Checking Patterns. - --- We parse patterns as expressions and check for valid patterns below, --- converting the expression into a pattern at the same time. - -checkPattern :: HsExp -> P HsPat -checkPattern e = checkPat e [] - -checkPatterns :: [HsExp] -> P [HsPat] -checkPatterns es = mapP checkPattern es - -checkPat :: HsExp -> [HsPat] -> P HsPat -checkPat (HsCon c) args = returnP (HsPApp c args) -checkPat (HsApp f x0) args = checkPat x0 [] `thenP` \x -> checkPat f (x:args) -checkPat e0 [] = case e0 of - HsVar (UnQual x) -> returnP (HsPVar x) - HsLit l -> returnP (HsPLit l) - HsInfixApp l0 op r0 -> checkPat l0 [] `thenP` \l -> - checkPat r0 [] `thenP` \r -> - case op of - HsCon c -> returnP (HsPInfixApp l c r) - _ -> patFail - HsTuple b es -> mapP (\e -> checkPat e []) es `thenP` \ps -> - returnP (HsPTuple b ps) - HsList es -> mapP (\e -> checkPat e []) es `thenP` \ps -> - returnP (HsPList ps) - HsParen e -> checkPat e [] `thenP` (returnP . HsPParen) - HsAsPat n e -> checkPat e [] `thenP` (returnP . HsPAsPat n) - HsWildCard -> returnP HsPWildCard - HsIrrPat e -> checkPat e [] `thenP` (returnP . HsPIrrPat) - HsRecConstr c fs0 -> mapP checkPatField fs0 `thenP` \fs -> - returnP (HsPRec c fs) - HsNegApp (HsLit l) -> returnP (HsPNeg (HsPLit l)) - HsExpTypeSig _ e1 ty -> checkPat e1 [] `thenP` \e -> - returnP (HsPTypeSig e ty) - _ -> patFail - -checkPat _ _ = patFail - -checkPatField :: HsFieldUpdate -> P HsPatField -checkPatField (HsFieldUpdate n e) = - checkPat e [] `thenP` \p ->returnP (HsPFieldPat n p) - -patFail :: P a -patFail = parseError "Parse error in pattern" - ------------------------------------------------------------------------------ --- Check Expression Syntax - -checkExpr :: HsExp -> P HsExp -checkExpr e0 = case e0 of - HsVar _ -> returnP e0 - HsIPVar _ -> returnP e0 - HsCon _ -> returnP e0 - HsLit _ -> returnP e0 - HsInfixApp e1 e2 e3 -> check3Exprs e1 e2 e3 HsInfixApp - HsApp e1 e2 -> check2Exprs e1 e2 HsApp - HsNegApp e -> check1Expr e HsNegApp - HsLambda ps e -> check1Expr e (HsLambda ps) - HsLet bs e -> check1Expr e (HsLet bs) - HsIf e1 e2 e3 -> check3Exprs e1 e2 e3 HsIf - HsCase e1 alts0 -> mapP checkAlt alts0 `thenP` \alts -> - checkExpr e1 `thenP` \e -> - returnP (HsCase e alts) - HsDo stmts -> mapP checkStmt stmts `thenP` (returnP . HsDo) - HsTuple b es -> checkManyExprs es (HsTuple b) - HsList es -> checkManyExprs es HsList - HsParen e -> check1Expr e HsParen - HsLeftSection e1 e2 -> check2Exprs e1 e2 HsLeftSection - HsRightSection e1 e2 -> check2Exprs e1 e2 HsRightSection - HsRecConstr c fields0 -> mapP checkField fields0 `thenP` \fields -> - returnP (HsRecConstr c fields) - HsRecUpdate e1 fields0 -> mapP checkField fields0 `thenP` \fields -> - checkExpr e1 `thenP` \e -> - returnP (HsRecUpdate e fields) - HsEnumFrom e -> check1Expr e HsEnumFrom - HsEnumFromTo e1 e2 -> check2Exprs e1 e2 HsEnumFromTo - HsEnumFromThen e1 e2 -> check2Exprs e1 e2 HsEnumFromThen - HsEnumFromThenTo e1 e2 e3 -> check3Exprs e1 e2 e3 HsEnumFromThenTo - HsListComp e1 stmts0 -> mapP checkStmt stmts0 `thenP` \stmts -> - checkExpr e1 `thenP` \e -> - returnP (HsListComp e stmts) - HsExpTypeSig loc e1 ty -> checkExpr e1 `thenP` \e -> - returnP (HsExpTypeSig loc e ty) - _ -> parseError "parse error in expression" - --- type signature for polymorphic recursion!! -check1Expr :: HsExp -> (HsExp -> a) -> P a -check1Expr e f = checkExpr e `thenP` (returnP . f) - -check2Exprs :: HsExp -> HsExp -> (HsExp -> HsExp -> a) -> P a -check2Exprs e1 e2 f = - checkExpr e1 `thenP` \e1' -> - checkExpr e2 `thenP` \e2' -> - returnP (f e1' e2') - -check3Exprs :: HsExp -> HsExp -> HsExp -> (HsExp -> HsExp -> HsExp -> a) -> P a -check3Exprs e1 e2 e3 f = - checkExpr e1 `thenP` \e1' -> - checkExpr e2 `thenP` \e2' -> - checkExpr e3 `thenP` \e3' -> - returnP (f e1' e2' e3') - -checkManyExprs :: [HsExp] -> ([HsExp] -> HsExp) -> P HsExp -checkManyExprs es0 f = - mapP checkExpr es0 `thenP` \es -> - returnP (f es) - -checkAlt :: HsAlt -> P HsAlt -checkAlt (HsAlt loc p galts0 bs) - = checkGAlts galts0 `thenP` \galts -> returnP (HsAlt loc p galts bs) - -checkGAlts :: HsGuardedAlts -> P HsGuardedAlts -checkGAlts (HsUnGuardedAlt e) = check1Expr e HsUnGuardedAlt -checkGAlts (HsGuardedAlts galts) - = mapP checkGAlt galts `thenP` (returnP . HsGuardedAlts) - -checkGAlt :: HsGuardedAlt -> P HsGuardedAlt -checkGAlt (HsGuardedAlt loc stmts0 e0) = - mapP checkStmt stmts0 `thenP` \stmts -> - checkExpr e0 `thenP` \e -> - returnP (HsGuardedAlt loc stmts e) - -checkStmt :: HsStmt -> P HsStmt -checkStmt (HsGenerator p e) = check1Expr e (HsGenerator p) -checkStmt (HsParStmt ss) = mapP checkStmt ss `thenP` \ ss1 -> returnP (HsParStmt ss1) -checkStmt (HsQualifier e) = check1Expr e HsQualifier -checkStmt s@(HsLetStmt _) = returnP s - -checkField :: HsFieldUpdate -> P HsFieldUpdate -checkField (HsFieldUpdate n e) = check1Expr e (HsFieldUpdate n) - ------------------------------------------------------------------------------ --- Check Equation Syntax - -checkValDef :: (SrcLoc, HsExp, HsRhs, [HsDecl]) -> P HsDecl -checkValDef (srcloc, lhs0, rhs, whereBinds) = - case isFunLhs lhs0 [] of - Just (f,es) -> checkPatterns es `thenP` \ps -> - returnP (HsFunBind [HsMatch srcloc f ps rhs whereBinds]) - Nothing -> checkPattern lhs0 `thenP` \lhs -> - returnP (HsPatBind srcloc lhs rhs whereBinds) - --- A variable binding is parsed as an HsPatBind. - -isFunLhs :: HsExp -> [HsExp] -> Maybe (HsQName, [HsExp]) -isFunLhs (HsInfixApp l (HsVar op) r) es = Just (op, l:r:es) -isFunLhs (HsApp (HsVar f) e) es = Just (f,e:es) -isFunLhs (HsApp (HsParen f) e) es = isFunLhs f (e:es) -isFunLhs (HsApp f e) es = isFunLhs f (e:es) -isFunLhs _ _ = Nothing - ------------------------------------------------------------------------------ --- Check that an identifier or symbol is unqualified. --- For occasions when doing this in the grammar would cause conflicts. - -checkUnQual :: HsQName -> P HsName -checkUnQual (Qual _ _) = parseError "Illegal qualified name" -checkUnQual (UnQual n) = returnP n - ------------------------------------------------------------------------------ --- Miscellaneous utilities - -toVarHsName :: HsName -> HsName -toVarHsName (HsTyClsName n) = HsVarName n -toVarHsName n = n - -toTyClsHsName :: HsName -> HsName -toTyClsHsName (HsVarName n) = HsTyClsName n -toTyClsHsName n = n - -checkPrec :: Integer -> P () -checkPrec i | i >= 0 && i <= 9 = returnP () -checkPrec i = parseError ("Illegal precedence: " ++ show i) - --- Stolen from Hugs' Prelude - -readInteger :: String -> Integer -readInteger ('0':'o':ds) = readInteger2 8 isOctDigit ds -readInteger ('0':'x':ds) = readInteger2 16 isHexDigit ds -readInteger ds = readInteger2 10 isDigit ds - -readInteger2 :: Integer -> (Char -> Bool) -> String -> Integer -readInteger2 radix isDig ds - | and $ map isDig ds - = foldl1 (\n d -> n * radix + d) (map (fromIntegral . digitToInt) ds) - | otherwise = error $ "readInteger2:expected all digits, got " ++ show ds - --- Hack... - -readRational :: String -> Rational -readRational xs = (readInteger (i++m))%1 * 10^^(case e of {[] -> 0; ('+':e2) -> read e2; _ -> read e} - length m) - where (i,r1) = span isDigit xs - (m,r2) = span isDigit (dropWhile (=='.') r1) - e = dropWhile (=='e') r2 - -mkRecConstrOrUpdate :: HsExp -> [HsFieldUpdate] -> P HsExp -mkRecConstrOrUpdate (HsCon c) fs = returnP (HsRecConstr c fs) -mkRecConstrOrUpdate exp0 fs@(_:_) = returnP (HsRecUpdate exp0 fs) -mkRecConstrOrUpdate _ _ = parseError "Empty record update" -\end{code} diff --git a/src/HsParser.ly b/src/HsParser.ly deleted file mode 100644 --- a/src/HsParser.ly +++ /dev/null @@ -1,1031 +0,0 @@ ------------------------------------------------------------------------------ -$Id: HsParser.ly,v 1.21 2004/08/09 11:55:07 simonmar Exp $ - -(c) Simon Marlow, Sven Panne 1997-2002 - -Haskell grammar. ------------------------------------------------------------------------------ - -ToDo: Is (,) valid as exports? We don't allow it. -ToDo: Check exactly which names must be qualified with Prelude (commas and friends) -ToDo: Inst (MPCs?) -ToDo: Polish constr a bit -ToDo: Ugly: exp0b is used for lhs, pat, exp0, ... -ToDo: Differentiate between record updates and labeled construction. - -> { -> module HsParser (parse) where -> -> import Monad -> import HsSyn -> import HsParseMonad -> import HsLexer -> import HsParseUtils -> import HaddockLex hiding (Token) -> import HaddockParse -> import HaddockUtil hiding (splitTyConApp) -> import Char ( isSpace ) -> } - ------------------------------------------------------------------------------ -Conflicts: 3 shift/reduce - -2 for ambiguity in 'case x of y | let z = y in z :: a -> b' - (don't know whether to reduce 'True' as a btype or shift the '->'. - Similarly lambda and if. This is a rather arcane special case: - the default resolution in favour of the shift does what the Report - specifies, but the result will always fail to type-check.) - -1 for ambiguity in 'x @ Rec{..}'. - Only sensible parse is 'x @ (Rec{..})', which is what resolving - to shift gives us. - ------------------------------------------------------------------------------ - -> %token -> VARID { VarId $$ } -> IPVARID { IPVarId $$ } -> QVARID { QVarId $$ } -> CONID { ConId $$ } -> QCONID { QConId $$ } -> VARSYM { VarSym $$ } -> CONSYM { ConSym $$ } -> QVARSYM { QVarSym $$ } -> QCONSYM { QConSym $$ } -> INT { IntTok $$ } -> RATIONAL { FloatTok $$ } -> CHAR { Character $$ } -> STRING { StringTok $$ } - -> PRIMINT { PrimInt $$ } -> PRIMSTRING { PrimString $$ } -> PRIMFLOAT { PrimFloat $$ } -> PRIMDOUBLE { PrimDouble $$ } -> PRIMCHAR { PrimChar $$ } - -Docs - -> DOCNEXT { DocCommentNext $$ } -> DOCPREV { DocCommentPrev $$ } -> DOCNAMED { DocCommentNamed $$ } -> DOCSECTION { DocSection _ _ } -> DOCOPTIONS { DocOptions $$ } - -Symbols - -> '(' { LeftParen } -> ')' { RightParen } -> '(#' { LeftUT } -> '#)' { RightUT } -> ';' { SemiColon } -> '{' { LeftCurly } -> '}' { RightCurly } -> vccurly { VRightCurly } -- a virtual close brace -> '[' { LeftSquare } -> ']' { RightSquare } -> ',' { Comma } -> '_' { Underscore } -> '`' { BackQuote } - -Reserved operators - -> '.' { Dot } -> '..' { DotDot } -> '::' { DoubleColon } -> '=' { Equals } -> '\\' { Backslash } -> '|' { Bar } -> '<-' { LeftArrow } -> '->' { RightArrow } -> '@' { At } -> '~' { Tilde } -> '=>' { DoubleArrow } -> '-' { Minus } -> '!' { Exclamation } - -Reserved Ids - -> 'as' { KW_As } -> 'case' { KW_Case } -> 'ccall' { KW_CCall } -> 'class' { KW_Class } -> 'data' { KW_Data } -> 'default' { KW_Default } -> 'deriving' { KW_Deriving } -> 'do' { KW_Do } -> 'dotnet' { KW_DotNet } -> 'else' { KW_Else } -> 'export' { KW_Export } -> 'forall' { KW_Forall } -> 'foreign' { KW_Foreign } -> 'hiding' { KW_Hiding } -> 'if' { KW_If } -> 'import' { KW_Import } -> 'in' { KW_In } -> 'infix' { KW_Infix } -> 'infixl' { KW_InfixL } -> 'infixr' { KW_InfixR } -> 'instance' { KW_Instance } -> 'let' { KW_Let } -> 'module' { KW_Module } -> 'newtype' { KW_NewType } -> 'of' { KW_Of } -> 'safe' { KW_Safe } -> 'stdcall' { KW_StdCall } -> 'then' { KW_Then } -> 'threadsafe' { KW_ThreadSafe } -> 'type' { KW_Type } -> 'unsafe' { KW_Unsafe } -> 'where' { KW_Where } -> 'qualified' { KW_Qualified } - -> %monad { P } { thenP } { returnP } -> %lexer { lexer } { EOF } -> %name parse -> %tokentype { Token } -> %% - ------------------------------------------------------------------------------ -Module Header - -> module :: { HsModule } -> : optdoc 'module' srcloc modid maybeexports 'where' body -> { case $1 of { (opts,info,doc) -> -> HsModule $3 $4 $5 (reverse (fst $7)) (snd $7) -> opts info doc } } -> | body srcloc -> { HsModule $2 main_mod Nothing (reverse (fst $1)) (snd $1) -> Nothing emptyModuleInfo Nothing } - -> optdoc :: { (Maybe String,ModuleInfo,Maybe Doc) } -> : moduleheader { (Nothing, fst $1, snd $1) } -> | DOCOPTIONS { (Just $1, emptyModuleInfo,Nothing) } -> | DOCOPTIONS moduleheader { (Just $1, fst $2, snd $2) } -> | moduleheader DOCOPTIONS { (Just $2, fst $1, snd $1) } -> | {- empty -} { (Nothing, emptyModuleInfo,Nothing) } - -> body :: { ([HsImportDecl],[HsDecl]) } -> : '{' bodyaux '}' { $2 } -> | layout_on bodyaux close { $2 } - -> bodyaux :: { ([HsImportDecl],[HsDecl]) } -> : impdecls ';' topdecls { ($1, $3) } -> | topdecls { ([], $1) } -> | impdecls { ($1, []) } - -> optsemi :: { () } -> : ';' { () } -> | {- empty -} { () } - ------------------------------------------------------------------------------ -The Export List - -> maybeexports :: { Maybe [HsExportSpec] } -> : exports { Just $1 } -> | {- empty -} { Nothing } - -> exports :: { [HsExportSpec] } -> : '(' exportlist ')' { $2 } - -> exportlist :: { [HsExportSpec] } -> : export exportlist1 { $1 : $2 } -> | exp_doc exportlist { $1 : $2 } -> | {- empty -} { [] } - -> exportlist1 :: { [HsExportSpec] } -> : exp_doc exportlist1 { $1 : $2 } -> | ',' exportlist { $2 } -> | {- empty -} { [] } - -> exp_doc :: { HsExportSpec } -> : docsection { case $1 of { (i,s) -> HsEGroup i s } } -> | docnamed { HsEDocNamed (fst $1) } -> | docnext { HsEDoc $1 } - -> export :: { HsExportSpec } -> : qvar { HsEVar $1 } -> | qgtycon { HsEAbs $1 } -> | qgtycon '(' '..' ')' { HsEThingAll $1 } -> | qgtycon '(' ')' { HsEThingWith $1 [] } -> | qgtycon '(' qcnames ')' { HsEThingWith $1 (reverse $3) } -> | 'module' modid { HsEModuleContents $2 } - -> qcnames :: { [HsQName] } -> : qcnames ',' qcname { $3 : $1 } -> | qcname { [$1] } - -> qcname :: { HsQName } -> : qvar { $1 } -> | gcon { $1 } - ------------------------------------------------------------------------------ -Import Declarations - -> impdecls :: { [HsImportDecl] } -> : impdecls ';' impdecl { $3 : $1 } -> | impdecl { [$1] } - -> impdecl :: { HsImportDecl } -> : 'import' srcloc optqualified modid maybeas maybeimpspec -> { HsImportDecl $2 $4 $3 $5 $6 } - -> optqualified :: { Bool } -> : 'qualified' { True } -> | {- empty -} { False } - -> maybeas :: { Maybe Module } -> : 'as' modid { Just $2 } -> | {- empty -} { Nothing } - - -> maybeimpspec :: { Maybe (Bool, [HsImportSpec]) } -> : impspec { Just $1 } -> | {- empty -} { Nothing } - -> impspec :: { (Bool, [HsImportSpec]) } -> : '(' importlist ')' { (False, reverse $2) } -> | 'hiding' '(' importlist ')' { (True, reverse $3) } - -> importlist :: { [HsImportSpec] } -> : importlist ',' import { $3 : $1 } -> | importlist ',' { $1 } -> | import { [$1] } -> | {- empty -} { [] } - -> import :: { HsImportSpec } -> : var { HsIVar $1 } -> | gtycon { HsIAbs $1 } -> | gtycon '(' '..' ')' { HsIThingAll $1 } -> | gtycon '(' ')' { HsIThingWith $1 [] } -> | gtycon '(' cnames ')' { HsIThingWith $1 (reverse $3) } - -> gtycon :: { HsName } -> : tyconorcls { $1 } -> | '(' ')' { unit_tycon_name } -> | '(' '->' ')' { fun_tycon_name } -> | '[' ']' { list_tycon_name } -> | '(' commas ')' { tuple_tycon_name $2 } - -> cnames :: { [HsName] } -> : cnames ',' cname { $3 : $1 } -> | cname { [$1] } - -> cname :: { HsName } -> : var { $1 } -> | con { $1 } - ------------------------------------------------------------------------------ -Fixity Declarations - -> fixdecl :: { HsDecl } -> : srcloc infix prec ops { HsInfixDecl $1 $2 $3 (reverse $4) } - -> prec :: { Int } -> : {- empty -} { 9 } -> | INT {% checkPrec $1 `thenP` \p -> -> returnP (fromIntegral $1) } - -> infix :: { HsAssoc } -> : 'infix' { HsAssocNone } -> | 'infixl' { HsAssocLeft } -> | 'infixr' { HsAssocRight } - -> ops :: { [HsName] } -> : ops ',' op { $3 : $1 } -> | op { [$1] } - ------------------------------------------------------------------------------ -Top-Level Declarations - -> topdecls :: { [HsDecl] } -> : topdecl ';' topdecls { $1 : $3 } -> | ';' topdecls { $2 } -> | docdecl topdecls { $1 : $2 } -> | topdecl { [$1] } -> | {- empty -} { [] } - -> topdecl :: { HsDecl } -> : 'type' simpletype srcloc '=' ctypedoc -> { HsTypeDecl $3 (fst $2) (snd $2) $5 Nothing } -> | 'data' ctype srcloc constrs deriving -> {% checkDataHeader $2 `thenP` \(cs,c,t) -> -> returnP (HsDataDecl $3 cs c t $4 $5 Nothing) } -> | 'newtype' ctype srcloc '=' constr deriving -> {% checkDataHeader $2 `thenP` \(cs,c,t) -> -> returnP (HsNewTypeDecl $3 cs c t $5 $6 Nothing) } -> | 'class' srcloc ctype fds optcbody -> {% checkClassHeader $3 `thenP` \(ctxt,n,tys) -> -> returnP (HsClassDecl $2 ctxt n tys $4 $5 Nothing) } -> | 'instance' srcloc ctype optvaldefs -> {% checkInstHeader $3 `thenP` \(ctxt,asst) -> -> returnP (HsInstDecl $2 ctxt asst $4) } -> | 'default' srcloc '(' typelist ')' -> { HsDefaultDecl $2 $4 } -> | 'foreign' fdecl { $2 } -> | decl { $1 } - -> typelist :: { [HsType] } -> : types { $1 } -> | type { [$1] } -> | {- empty -} { [] } - -> decls :: { [HsDecl] } -> : decl ';' decls { $1 : $3 } -> | docdecl decls { $1 : $2 } -> | ';' decls { $2 } -> | decl { [$1] } -> | {- empty -} { [] } - -> decl :: { HsDecl } -> : signdecl { $1 } -> | fixdecl { $1 } -> | valdef { $1 } - -> docdecl :: { HsDecl } -> : srcloc docnext { HsDocCommentNext $1 $2 } -> | srcloc docprev { HsDocCommentPrev $1 $2 } -> | srcloc docnamed { case $2 of { (n,s) -> -> HsDocCommentNamed $1 n s } } -> | srcloc docsection { case $2 of { (i,s) -> HsDocGroup $1 i s } } - -> decllist :: { [HsDecl] } -> : '{' decls '}' { $2 } -> | layout_on decls close { $2 } - -> signdecl :: { HsDecl } -> : vars srcloc '::' ctypedoc { HsTypeSig $2 (reverse $1) $4 Nothing } - -ATTENTION: Dirty Hackery Ahead! If the second alternative of vars is var -instead of qvar, we get another shift/reduce-conflict. Consider the -following programs: - - { (+) :: ... } only var - { (+) x y = ... } could (incorrectly) be qvar - -We re-use expressions for patterns, so a qvar would be allowed in patterns -instead of a var only (which would be correct). But deciding what the + is, -would require more lookahead. So let's check for ourselves... - -> vars :: { [HsName] } -> : vars ',' var { $3 : $1 } -> | qvar {% checkUnQual $1 `thenP` \n -> -> returnP [n] } - ------------------------------------------------------------------------------ -Foreign Declarations - -> fdecl :: { HsDecl } -> fdecl : srcloc 'import' callconv safety fspec -> { case $5 of (spec,nm,ty) -> HsForeignImport $1 $3 $4 spec nm ty Nothing } -> | srcloc 'import' callconv fspec -> { case $4 of (spec,nm,ty) -> HsForeignImport $1 $3 HsFISafe spec nm ty Nothing } -> | srcloc 'export' callconv fspec -> { case $4 of (spec,nm,ty) -> HsForeignExport $1 $3 spec nm ty } - -> callconv :: { HsCallConv } -> : 'stdcall' { HsStdCall } -> | 'ccall' { HsCCall } -> | 'dotnet' { HsDotNetCall } - -> safety :: { HsFISafety } -> : 'unsafe' { HsFIUnsafe } -> | 'safe' { HsFISafe } -> | 'threadsafe' { HsFIThreadSafe } - -> fspec :: { (String, HsName, HsType) } -> : STRING varid '::' ctypedoc { ($1, $2, $4) } -> | varid '::' ctypedoc { ("", $1, $3) } - ------------------------------------------------------------------------------ -Types - -> doctype :: { HsType } -> : tydoc '->' doctype { HsTyFun $1 $3 } -> | tydoc { $1 } - -> tydoc :: { HsType } -> : btype { $1 } -> | btype docprev { HsTyDoc $1 $2 } -> | btype tyvarop btype { HsTyApp (HsTyApp $2 $1) $3 } - -> type :: { HsType } -> : ipvar '::' type1 { HsTyIP $1 $3 } -> | type1 { $1 } - -> type1 :: { HsType } -> : btype { $1 } -> | btype tyvarop btype { HsTyApp (HsTyApp $2 $1) $3 } -> | btype '->' type1 { HsTyFun $1 $3 } - -> btype :: { HsType } -> : btype atype { HsTyApp $1 $2 } -> | atype { $1 } - -> atype :: { HsType } -> : qgtycon { HsTyCon $1 } -> | tyvar { HsTyVar $1 } -> | '(' types ')' { HsTyTuple True $2 } -> | '(#' type '#)' { HsTyTuple False [$2] } -> | '(#' types '#)' { HsTyTuple False $2 } -> | '[' type ']' { HsTyApp list_tycon $2 } -> | '(' ctype ')' { $2 } - -> qgtycon :: { HsQName } -> : qtycls { $1 } -> | '(' ')' { unit_tycon_qname } -> | '(' '->' ')' { fun_tycon_qname } -> | '[' ']' { list_tycon_qname } -> | '(' commas ')' { tuple_tycon_qname $2 } - -(Slightly edited) Comment from GHC's hsparser.y: -"context => type" vs "type" is a problem, because you can't distinguish between - - foo :: (Baz a, Baz a) - bar :: (Baz a, Baz a) => [a] -> [a] -> [a] - -with one token of lookahead. The HACK is to parse the context as a btype -(more specifically as a tuple type), then check that it has the right form -C a, or (C1 a, C2 b, ... Cn z) and convert it into a context. Blaach! - -> ctype :: { HsType } -> : 'forall' tyvars '.' ctype { mkHsForAllType (Just $2) [] $4 } -> | context '=>' type { mkHsForAllType Nothing $1 $3 } -> | type { $1 } - -> ctypedoc :: { HsType } -> : 'forall' tyvars '.' ctypedoc { mkHsForAllType (Just $2) [] $4 } -> | context '=>' doctype { mkHsForAllType Nothing $1 $3 } -> | doctype { $1 } - -> context :: { HsIPContext } -> : btype {% checkContext $1 } - -> types :: { [HsType] } -> : type ',' types { $1 : $3 } -> | type ',' type { [$1,$3] } - -> simpletype :: { (HsName, [HsName]) } -> : tycon tyvars { ($1,$2) } - -> tyvars :: { [HsName] } -> : tyvar tyvars { $1 : $2 } -> | {- empty -} { [] } - ------------------------------------------------------------------------------ -Datatype declarations - -> constrs :: { [HsConDecl] } -> : {- empty; a GHC extension -} { [] } -> | maybe_docnext '=' constrs1 { addConDocs $3 $1 } - -> constrs1 :: { [HsConDecl] } -> : constr maybe_docnext '|' maybe_docprev constrs1 -> { addConDoc $1 $4 : addConDocs $5 $2 } -> | constr { [$1] } - -> constr :: { HsConDecl } -> : srcloc maybe_docnext forall_stuff constr_stuff maybe_docprev -> { HsConDecl $1 (fst $4) $3 [] (snd $4) ($2 `mplus` $5) } -> | srcloc maybe_docnext forall_stuff context '=>' constr_stuff maybe_docprev -> {% checkIPContext $4 `thenP` \ ctxt -> returnP (HsConDecl $1 (fst $6) $3 ctxt (snd $6) ($2 `mplus` $7)) } -> | srcloc maybe_docnext forall_stuff con '{' fielddecls '}' maybe_docprev -> { HsRecDecl $1 $4 $3 [] $6 ($2 `mplus` $8) } -> | srcloc maybe_docnext forall_stuff context '=>' con '{' fielddecls '}' maybe_docprev -> {% checkIPContext $4 `thenP` \ ctxt -> returnP (HsRecDecl $1 $6 $3 ctxt $8 ($2 `mplus` $10)) } - -> forall_stuff :: { [HsName] } -> : 'forall' tyvars '.' { $2 } -> | {- empty -} { [] } - -> constr_stuff :: { (HsName, [HsBangType]) } -> : scontype { $1 } -> | sbtype conop sbtype { ($2, [$1,$3]) } - -> scontype :: { (HsName, [HsBangType]) } -> : btype {% splitTyConApp $1 `thenP` \(c,ts) -> -> returnP (toVarHsName c, -> map HsUnBangedTy ts) } -> | scontype1 { $1 } - -> scontype1 :: { (HsName, [HsBangType]) } -> : btype '!' atype {% splitTyConApp $1 `thenP` \(c,ts) -> -> returnP (toVarHsName c, -> map HsUnBangedTy ts++ -> [HsBangedTy $3]) } -> | scontype1 satype { (fst $1, snd $1 ++ [$2] ) } - -> satype :: { HsBangType } -> : atype { HsUnBangedTy $1 } -> | '!' atype { HsBangedTy $2 } - -> sbtype :: { HsBangType } -> : btype { HsUnBangedTy $1 } -> | '!' atype { HsBangedTy $2 } - -> fielddecls :: { [HsFieldDecl] } -> : fielddecl maybe_docnext ',' maybe_docprev fielddecls -> { addFieldDoc $1 $4 : addFieldDocs $5 $2 } -> | ',' fielddecls { $2 } -> | fielddecl { [$1] } -> | {- empty -} { [] } - -> fielddecl :: { HsFieldDecl } -> : maybe_docnext vars '::' stype maybe_docprev -> { HsFieldDecl (reverse $2) $4 ($1 `mplus` $5) } - -> stype :: { HsBangType } -> : ctype { HsUnBangedTy $1 } -> | '!' atype { HsBangedTy $2 } - -> deriving :: { [HsQName] } -> : {- empty -} { [] } -> | 'deriving' qtycls { [$2] } -> | 'deriving' '(' ')' { [] } -> | 'deriving' '(' dclasses ')' { reverse $3 } - -> dclasses :: { [HsQName] } -> : dclasses ',' qtycls { $3 : $1 } -> | qtycls { [$1] } - ------------------------------------------------------------------------------ -Class declarations - -> fds :: { [HsFunDep] } -> : {- empty -} { [] } -> | '|' fds1 { reverse $2 } - -> fds1 :: { [HsFunDep] } -> : fds1 ',' fd { $3 : $1 } -> | fd { [$1] } - -> fd :: { HsFunDep } -> : varids0 '->' varids0 { (reverse $1, reverse $3) } - -> varids0 :: { [HsName] } -> : {- empty -} { [] } -> | varids0 tyvar { $2 : $1 } - -> optcbody :: { [HsDecl] } -> : 'where' decllist { $2 } -> | {- empty -} { [] } - -> dbinds :: { [HsDecl] } -> : dbinds ';' dbind { $3 : $1 } -> | dbinds ';' { $1 } -> | dbind { [$1] } -> -> dbind :: { HsDecl } -> dbind : ipvar '=' srcloc exp {% checkValDef ($3, HsVar (UnQual $1), HsUnGuardedRhs $4, []) } - -> binds :: { [HsDecl] } -> : decllist { $1 } -> | '{' dbinds '}' { $2 } -> | layout_on dbinds close { $2 } - - -> wherebinds :: { [HsDecl] } -> : 'where' binds { $2 } -> | {- empty -} { [] } - ------------------------------------------------------------------------------ -Instance declarations - -> optvaldefs :: { [HsDecl] } -> : 'where' '{' valdefs '}' { $3 } -> | 'where' layout_on valdefs close { $3 } -> | {- empty -} { [] } - -> valdefs :: { [HsDecl] } -> : valdefs ';' valdef { $3 : $1 } -> | valdefs ';' { $1 } -> | valdef { [$1] } -> | {- empty -} { [] } - ------------------------------------------------------------------------------ -Value definitions - -> valdef :: { HsDecl } -> : exp0b srcloc rhs -> {% checkValDef ($2, $1, $3, [])} - -> rhs :: { HsRhs } -> : '=' exp wherebinds {% checkExpr $2 `thenP` \e -> -> returnP (HsUnGuardedRhs e) } -> | gdrhs wherebinds { HsGuardedRhss (reverse $1) } - -> gdrhs :: { [HsGuardedRhs] } -> : gdrhs gdrh { $2 : $1 } -> | gdrh { [$1] } - -> gdrh :: { HsGuardedRhs } -> : '|' srcloc quals '=' exp {% checkExpr $5 `thenP` \e -> -> returnP (HsGuardedRhs $2 $3 e) } - ------------------------------------------------------------------------------ -Expressions - -Note: The Report specifies a meta-rule for lambda, let and if expressions -(the exp's that end with a subordinate exp): they extend as far to -the right as possible. That means they cannot be followed by a type -signature or infix application. To implement this without shift/reduce -conflicts, we split exp10 into these expressions (exp10a) and the others -(exp10b). That also means that only an exp0 ending in an exp10b (an exp0b) -can followed by a type signature or infix application. So we duplicate -the exp0 productions to distinguish these from the others (exp0a). - -> exp :: { HsExp } -> : exp0b '::' srcloc ctype { HsExpTypeSig $3 $1 $4 } -> | exp0 { $1 } - -> exp0 :: { HsExp } -> : exp0a { $1 } -> | exp0b { $1 } - -> exp0a :: { HsExp } -> : exp0b qop exp10a { HsInfixApp $1 $2 $3 } -> | exp10a { $1 } - -> exp0b :: { HsExp } -> : exp0b qop exp10b { HsInfixApp $1 $2 $3 } -> | exp10b { $1 } - -> exp10a :: { HsExp } -> : '\\' aexps '->' exp {% checkPatterns (reverse $2) `thenP` \ps -> -> returnP (HsLambda ps $4) } -> | 'let' binds 'in' exp { HsLet $2 $4 } -> | 'if' exp 'then' exp 'else' exp { HsIf $2 $4 $6 } - -> exp10b :: { HsExp } -> : 'case' exp 'of' altslist { HsCase $2 $4 } -> | '-' fexp { HsNegApp $2 } -> | 'do' stmtlist { HsDo $2 } -> | fexp { $1 } - -> fexp :: { HsExp } -> : fexp aexp { HsApp $1 $2 } -> | aexp { $1 } - -> aexps :: { [HsExp] } -> : aexps aexp { $2 : $1 } -> | aexp { [$1] } - -UGLY: Because patterns and expressions are mixed, aexp has to be split into -two rules: One left-recursive and one right-recursive. Otherwise we get two -reduce/reduce-errors (for as-patterns and irrefutable patters). - -Note: The first alternative of aexp is not neccessarily a record update, it -could be a labeled construction, too. - -> aexp :: { HsExp } -> : aexp '{' '}' {% mkRecConstrOrUpdate $1 [] } -> | aexp '{' fbinds '}' {% mkRecConstrOrUpdate $1 (reverse $3) } -> | aexp1 { $1 } - -Even though the variable in an as-pattern cannot be qualified, we use -qvar here to avoid a shift/reduce conflict, and then check it ourselves -(as for vars above). - -Bug: according to the Report, left sections should be (exp0 qop), but -that would cause a shift/reduce conflict in which shifting would be no -different from specifying (exp0b qop). The only consolation is that -other implementations don't manage this either. - -> aexp1 :: { HsExp } -> : ipvar { HsIPVar (UnQual $1) } -> | qvar { HsVar $1 } -> | gcon { HsCon $1 } -> | literal { $1 } -> | '(' exp ')' { HsParen $2 } -> | '(' texps ')' { HsTuple True $2 } -> | '(#' exp '#)' { HsTuple False [$2] } -> | '(#' texps '#)' { HsTuple False $2 } -> | '[' list ']' { $2 } -> | '(' exp0b qop ')' { HsLeftSection $3 $2 } -> | '(' qopm exp0 ')' { HsRightSection $3 $2 } -> | qvar '@' aexp {% checkUnQual $1 `thenP` \n -> -> returnP (HsAsPat n $3) } -> | '_' { HsWildCard } -> | '~' aexp1 { HsIrrPat $2 } - -> commas :: { Int } -> : commas ',' { $1 + 1 } -> | ',' { 1 } - -> texps :: { [HsExp] } -> : exp ',' texps { $1 : $3 } -> | exp ',' exp { [$1,$3] } - ------------------------------------------------------------------------------ -List expressions - -The rules below are little bit contorted to keep lexps left-recursive while -avoiding another shift/reduce-conflict. - -> list :: { HsExp } -> : exp { HsList [$1] } -> | lexps { HsList (reverse $1) } -> | exp '..' { HsEnumFrom $1 } -> | exp ',' exp '..' { HsEnumFromThen $1 $3 } -> | exp '..' exp { HsEnumFromTo $1 $3 } -> | exp ',' exp '..' exp { HsEnumFromThenTo $1 $3 $5 } -> | exp pquals { HsListComp $1 (reverse $2) } - -> lexps :: { [HsExp] } -> : lexps ',' exp { $3 : $1 } -> | exp ',' exp { [$3,$1] } - ------------------------------------------------------------------------------ -List comprehensions - -> pquals :: { [HsStmt] } -> : pquals1 { case $1 of -> [qs] -> qs -> qss -> [HsParStmt (concat qss)] -> } - -> pquals1 :: { [[HsStmt]] } -> : pquals1 '|' quals { $3 : $1 } -> | '|' quals { [$2] } - -> quals :: { [HsStmt] } -> : quals ',' qual { $3 : $1 } -> | qual { [$1] } - -> qual :: { HsStmt } -> : pat '<-' exp { HsGenerator $1 $3 } -> | exp { HsQualifier $1 } -> | 'let' binds { HsLetStmt $2 } - ------------------------------------------------------------------------------ -Case alternatives - -> altslist :: { [HsAlt] } -> : '{' alts optsemi '}' { reverse $2 } -> | layout_on alts optsemi close { reverse $2 } - - -> alts :: { [HsAlt] } -> : alts ';' alt { $3 : $1 } -> | alt { [$1] } - -> alt :: { HsAlt } -> : pat srcloc ralt wherebinds -> { HsAlt $2 $1 $3 $4 } - -> ralt :: { HsGuardedAlts } -> : '->' exp { HsUnGuardedAlt $2 } -> | gdpats { HsGuardedAlts (reverse $1) } - -> gdpats :: { [HsGuardedAlt] } -> : gdpats gdpat { $2 : $1 } -> | gdpat { [$1] } - -> gdpat :: { HsGuardedAlt } -> : '|' srcloc quals '->' exp { HsGuardedAlt $2 $3 $5 } - -> pat :: { HsPat } -> : exp0b {% checkPattern $1 } - ------------------------------------------------------------------------------ -Statement sequences - -> stmtlist :: { [HsStmt] } -> : '{' stmts '}' { $2 } -> | layout_on stmts close { $2 } - -The last Stmt should be a HsQualifier, but that's hard to enforce here, -because we need too much lookahead if we see do { e ; }, so it has to -be checked for later. - -> stmts :: { [HsStmt] } -> : qual stmts1 { $1 : $2 } -> | ';' stmts { $2 } -> | {- empty -} { [] } - -> stmts1 :: { [HsStmt] } -> : ';' stmts { $2 } -> | {- empty -} { [] } - ------------------------------------------------------------------------------ -Record Field Update/Construction - -> fbinds :: { [HsFieldUpdate] } -> : fbinds ',' fbind { $3 : $1 } -> | fbind { [$1] } - -> fbind :: { HsFieldUpdate } -> : qvar '=' exp { HsFieldUpdate $1 $3 } - ------------------------------------------------------------------------------ -Variables, Constructors and Operators. - -> gcon :: { HsQName } -> : '(' ')' { unit_con_name } -> | '[' ']' { nil_con_name } -> | '(' commas ')' { tuple_con_name $2 } -> | qcon { $1 } - -> var :: { HsName } -> : varid { $1 } -> | '(' varsym ')' { $2 } - -> qvar :: { HsQName } -> : qvarid { $1 } -> | '(' qvarsym ')' { $2 } - -> con :: { HsName } -> : conid { $1 } -> | '(' consym ')' { $2 } - -> ipvar :: { HsName } -> : IPVARID { HsVarName (HsIdent $1) } - -> qcon :: { HsQName } -> : qconid { $1 } -> | '(' qconsym ')' { $2 } - -> varop :: { HsName } -> : varsym { $1 } -> | '`' varid '`' { $2 } - -> qvarop :: { HsQName } -> : qvarsym { $1 } -> | '`' qvarid '`' { $2 } - -> qvaropm :: { HsQName } -> : qvarsymm { $1 } -> | '`' qvarid '`' { $2 } - -> conop :: { HsName } -> : consym { $1 } -> | '`' conid '`' { $2 } - -> qconop :: { HsQName } -> : qconsym { $1 } -> | '`' qconid '`' { $2 } - -> op :: { HsName } -> : varop { $1 } -> | conop { $1 } - -> qop :: { HsExp } -> : qvarop { HsVar $1 } -> | qconop { HsCon $1 } - -> qopm :: { HsExp } -> : qvaropm { HsVar $1 } -> | qconop { HsCon $1 } - -> qvarid :: { HsQName } -> : varid { UnQual $1 } -> | QVARID { Qual (Module (fst $1)) (HsVarName (HsIdent (snd $1))) } - -> varid :: { HsName } -> : 'forall' { forall_name } -> | varid_no_forall { $1 } - -> varid_no_forall :: { HsName } -> : VARID { HsVarName (HsIdent $1) } -> | 'as' { as_name } -> | 'unsafe' { unsafe_name } -> | 'safe' { safe_name } -> | 'threadsafe' { threadsafe_name } -> | 'qualified' { qualified_name } -> | 'hiding' { hiding_name } -> | 'export' { export_name } -> | 'stdcall' { stdcall_name } -> | 'ccall' { ccall_name } -> | 'dotnet' { dotnet_name } - -> qconid :: { HsQName } -> : conid { UnQual $1 } -> | QCONID { Qual (Module (fst $1)) (HsVarName (HsIdent (snd $1))) } - -> conid :: { HsName } -> : CONID { HsVarName (HsIdent $1) } - -> qconsym :: { HsQName } -> : consym { UnQual $1 } -> | QCONSYM { Qual (Module (fst $1)) (HsVarName (HsSymbol (snd $1))) } - -> consym :: { HsName } -> : CONSYM { HsVarName (HsSymbol $1) } - -> qvarsym :: { HsQName } -> : varsym { UnQual $1 } -> | qvarsym1 { $1 } - -> qvarsymm :: { HsQName } -> : varsymm { UnQual $1 } -> | qvarsym1 { $1 } - -> varsym :: { HsName } -> : VARSYM { HsVarName (HsSymbol $1) } -> | '.' { dot_name } -> | '-' { minus_name } -> | '!' { pling_name } - -> varsymm :: { HsName } -- varsym not including '-' -> : VARSYM { HsVarName (HsSymbol $1) } -> | '.' { dot_name } -> | '!' { pling_name } - -> qvarsym1 :: { HsQName } -> : QVARSYM { Qual (Module (fst $1)) (HsVarName (HsSymbol (snd $1))) } - -> literal :: { HsExp } -> : INT { HsLit (HsInt $1) } -> | CHAR { HsLit (HsChar $1) } -> | RATIONAL { HsLit (HsFrac (readRational $1)) } -> | STRING { HsLit (HsString $1) } -> | PRIMINT { HsLit (HsIntPrim $1) } -> | PRIMCHAR { HsLit (HsCharPrim $1) } -> | PRIMFLOAT { HsLit (HsFloatPrim (readRational $1)) } -> | PRIMDOUBLE { HsLit (HsDoublePrim (readRational $1)) } -> | PRIMSTRING { HsLit (HsStringPrim $1) } - -> srcloc :: { SrcLoc } : {% getSrcLoc } - ------------------------------------------------------------------------------ -Layout - -> close :: { () } -> : vccurly { () } -- context popped in lexer. -> | error {% popContext } - -> layout_on :: { () } : {% getSrcLoc `thenP` \(SrcLoc r c f) -> -> pushContext (Layout c) } - ------------------------------------------------------------------------------ -Miscellaneous (mostly renamings) - -> modid :: { Module } -> : CONID { Module $1 } -> | QCONID { Module (fst $1 ++ '.':snd $1) } - -> tyconorcls :: { HsName } -> : CONID { HsTyClsName (HsIdent $1) } - -> tycon :: { HsName } -> : CONID { HsTyClsName (HsIdent $1) } - -> qtycls :: { HsQName } -> : CONID { UnQual (HsTyClsName (HsIdent $1)) } -> | QCONID { Qual (Module (fst $1)) (HsTyClsName (HsIdent (snd $1))) } - -> tyvar :: { HsName } -> : varid_no_forall { $1 } -> | '(' varsym ')' { $2 } - -> tyvarop :: { HsType } -> tyvarop : '`' tyvar '`' { HsTyVar $2 } -> | varsym { HsTyVar $1 } - ------------------------------------------------------------------------------ -Documentation comments - -> docnext :: { Doc } -> : DOCNEXT {% case parseParas (tokenise $1) of { -> Left err -> parseError err; -> Right doc -> returnP doc } } - -> docprev :: { Doc } -> : DOCPREV {% case parseParas (tokenise $1) of { -> Left err -> parseError err; -> Right doc -> returnP doc } } - -> docnamed :: { (String,Doc) } -> : DOCNAMED {% let (name,rest) = break isSpace $1 in -> case parseParas (tokenise rest) of { -> Left err -> parseError err; -> Right doc -> returnP (name,doc) } } - -> docsection :: { (Int,Doc) } -> : DOCSECTION {% case $1 of { DocSection n s -> -> case parseString (tokenise s) of { -> Left err -> parseError err; -> Right doc -> returnP (n, doc) } } } - -> maybe_docprev :: { Maybe Doc } -> : docprev { Just $1 } -> | {- empty -} { Nothing } - -> maybe_docnext :: { Maybe Doc } -> : docnext { Just $1 } -> | {- empty -} { Nothing } - -> moduleheader :: { (ModuleInfo,Maybe Doc) } -> : DOCNEXT {% case parseModuleHeader $1 of { -> Right (str,info) -> -> case parseParas (tokenise str) of { -> Left err -> parseError err; -> Right doc -> returnP (info,Just doc); -> }; -> Left err -> parseError err -> } } - ------------------------------------------------------------------------------ - -> { -> happyError = parseError "Parse error" -> } diff --git a/src/HsSyn.lhs b/src/HsSyn.lhs deleted file mode 100644 --- a/src/HsSyn.lhs +++ /dev/null @@ -1,563 +0,0 @@ -% ----------------------------------------------------------------------------- -% $Id: HsSyn.lhs,v 1.22 2004/08/09 11:55:07 simonmar Exp $ -% -% (c) The GHC Team, 1997-2002 -% -% A suite of datatypes describing the abstract syntax of Haskell 98. -% -% ----------------------------------------------------------------------------- - -\begin{code} -module HsSyn ( - SrcLoc(..), Module(..), HsQName(..), HsName(..), HsIdentifier(..), - HsModule(..), HsExportSpec(..), ModuleInfo(..), - HsImportDecl(..), HsImportSpec(..), HsAssoc(..), - HsDecl(..), HsMatch(..), HsConDecl(..), HsFieldDecl(..), - HsBangType(..), HsRhs(..), - HsGuardedRhs(..), HsType(..), HsContext, HsAsst, HsIPContext, HsCtxt(..), - HsLiteral(..), HsExp(..), HsPat(..), HsPatField(..), HsStmt(..), - HsFieldUpdate(..), HsAlt(..), HsGuardedAlts(..), HsGuardedAlt(..), - HsCallConv(..), HsFISafety(..), HsFunDep, - - mkHsForAllType, - - prelude_mod, main_mod, - unit_con_name, tuple_con_name, nil_con_name, - as_name, qualified_name, hiding_name, minus_name, pling_name, dot_name, - forall_name, unsafe_name, safe_name, threadsafe_name, export_name, - stdcall_name, ccall_name, dotnet_name, - unit_tycon_name, fun_tycon_name, list_tycon_name, tuple_tycon_name, - unit_tycon_qname, fun_tycon_qname, list_tycon_qname, tuple_tycon_qname, - unit_tycon, fun_tycon, list_tycon, tuple_tycon, - - emptyModuleInfo, - - hsIdentifierStr, hsAnchorNameStr, hsNameStr, - - GenDoc(..), Doc, DocMarkup(..), - markup, mapIdent, idMarkup, - docAppend, docParagraph, - ) where - -import Char (isSpace) - -data SrcLoc = SrcLoc !Int !Int FilePath -- (Line, Indentation, FileName) - deriving (Eq,Ord,Show) - -newtype Module = Module String - deriving (Eq,Ord) - -instance Show Module where - showsPrec _ (Module m) = showString m - -data HsQName - = Qual Module HsName - | UnQual HsName - deriving (Eq,Ord) - -instance Show HsQName where - showsPrec _ (Qual (Module m) s) = - showString m . showString "." . shows s - showsPrec _ (UnQual s) = shows s - -data HsName - = HsTyClsName HsIdentifier - | HsVarName HsIdentifier - deriving (Eq,Ord) - -instance Show HsName where - showsPrec p (HsTyClsName i) = showsPrec p i - showsPrec p (HsVarName i) = showsPrec p i - -data HsIdentifier - = HsIdent String - | HsSymbol String - | HsSpecial String - deriving (Eq,Ord) - -instance Show HsIdentifier where - showsPrec _ (HsIdent s) = showString s - showsPrec _ (HsSymbol s) = showString s - showsPrec _ (HsSpecial s) = showString s - -data HsModule = HsModule SrcLoc Module (Maybe [HsExportSpec]) - [HsImportDecl] [HsDecl] - (Maybe String) -- the doc options - ModuleInfo -- the info (portability etc.) - (Maybe Doc) -- the module doc. - deriving Show - -data ModuleInfo = ModuleInfo - { description :: Maybe Doc, - portability :: Maybe String, - stability :: Maybe String, - maintainer :: Maybe String - } - deriving Show - -emptyModuleInfo :: ModuleInfo -emptyModuleInfo = ModuleInfo { - description = Nothing, - portability = Nothing, - stability = Nothing, - maintainer = Nothing - } - --- Export/Import Specifications - -data HsExportSpec - = HsEVar HsQName -- variable - | HsEAbs HsQName -- T - | HsEThingAll HsQName -- T(..) - | HsEThingWith HsQName [HsQName] -- T(C_1,...,C_n) - | HsEModuleContents Module -- module M (not for imports) - | HsEGroup Int Doc -- a doc section heading - | HsEDoc Doc -- some documentation - | HsEDocNamed String -- a reference to named doc - deriving (Eq,Show) - -data HsImportDecl - = HsImportDecl SrcLoc Module Bool (Maybe Module) - (Maybe (Bool,[HsImportSpec])) - deriving (Eq,Show) - -data HsImportSpec - = HsIVar HsName -- variable - | HsIAbs HsName -- T - | HsIThingAll HsName -- T(..) - | HsIThingWith HsName [HsName] -- T(C_1,...,C_n) - deriving (Eq,Show) - -data HsAssoc - = HsAssocNone - | HsAssocLeft - | HsAssocRight - deriving (Eq,Show) - -data HsFISafety - = HsFIUnsafe - | HsFISafe - | HsFIThreadSafe - deriving (Eq,Show) - -data HsCallConv - = HsCCall - | HsStdCall - | HsDotNetCall - deriving (Eq,Show) - -data HsDecl - = HsTypeDecl SrcLoc HsName [HsName] HsType (Maybe Doc) - - | HsDataDecl SrcLoc HsContext HsName [HsName] [HsConDecl] [HsQName] - (Maybe Doc) - - | HsInfixDecl SrcLoc HsAssoc Int [HsName] - - | HsNewTypeDecl SrcLoc HsContext HsName [HsName] HsConDecl [HsQName] - (Maybe Doc) - - | HsClassDecl SrcLoc HsContext HsName [HsName] [HsFunDep] [HsDecl] (Maybe Doc) - - | HsInstDecl SrcLoc HsContext HsAsst [HsDecl] - - | HsDefaultDecl SrcLoc [HsType] - - | HsTypeSig SrcLoc [HsName] HsType (Maybe Doc) - - | HsFunBind [HsMatch] - - | HsPatBind SrcLoc HsPat HsRhs {-where-} [HsDecl] - - | HsForeignImport SrcLoc HsCallConv HsFISafety String HsName HsType - (Maybe Doc) - - | HsForeignExport SrcLoc HsCallConv String HsName HsType - - | HsDocCommentNext SrcLoc Doc -- a documentation annotation - | HsDocCommentPrev SrcLoc Doc -- a documentation annotation - | HsDocCommentNamed SrcLoc String Doc -- a documentation annotation - | HsDocGroup SrcLoc Int Doc -- a documentation group - deriving (Eq,Show) - -data HsMatch - = HsMatch SrcLoc HsQName [HsPat] HsRhs {-where-} [HsDecl] - deriving (Eq,Show) - -data HsConDecl - = HsConDecl SrcLoc HsName [HsName] HsContext [HsBangType] (Maybe Doc) - | HsRecDecl SrcLoc HsName [HsName] HsContext [HsFieldDecl] (Maybe Doc) - deriving (Eq,Show) - -data HsFieldDecl - = HsFieldDecl [HsName] HsBangType (Maybe Doc) - deriving (Eq,Show) - -data HsBangType - = HsBangedTy HsType - | HsUnBangedTy HsType - deriving (Eq,Show) - -data HsRhs - = HsUnGuardedRhs HsExp - | HsGuardedRhss [HsGuardedRhs] - deriving (Eq,Show) - -data HsGuardedRhs - = HsGuardedRhs SrcLoc [HsStmt] HsExp - deriving (Eq,Show) - -data HsType - = HsForAllType (Maybe [HsName]) HsIPContext HsType - | HsTyFun HsType HsType - | HsTyTuple Bool{-boxed-} [HsType] - | HsTyApp HsType HsType - | HsTyVar HsName - | HsTyCon HsQName - | HsTyDoc HsType Doc - | HsTyIP HsName HsType - deriving (Eq,Show) - -type HsFunDep = ([HsName], [HsName]) -type HsContext = [HsAsst] -type HsIPContext = [HsCtxt] - -data HsCtxt - = HsAssump HsAsst -- for multi-parameter type classes - | HsIP HsName HsType - deriving (Eq,Show) - -type HsAsst = (HsQName,[HsType]) - -data HsLiteral - = HsInt Integer - | HsChar Char - | HsString String - | HsFrac Rational - -- GHC unboxed literals: - | HsCharPrim Char - | HsStringPrim String - | HsIntPrim Integer - | HsFloatPrim Rational - | HsDoublePrim Rational - deriving (Eq, Show) - -data HsExp - = HsIPVar HsQName - | HsVar HsQName - | HsCon HsQName - | HsLit HsLiteral - | HsInfixApp HsExp HsExp HsExp - | HsApp HsExp HsExp - | HsNegApp HsExp - | HsLambda [HsPat] HsExp - | HsLet [HsDecl] HsExp - | HsIf HsExp HsExp HsExp - | HsCase HsExp [HsAlt] - | HsDo [HsStmt] - | HsTuple Bool{-boxed-} [HsExp] - | HsList [HsExp] - | HsParen HsExp - | HsLeftSection HsExp HsExp - | HsRightSection HsExp HsExp - | HsRecConstr HsQName [HsFieldUpdate] - | HsRecUpdate HsExp [HsFieldUpdate] - | HsEnumFrom HsExp - | HsEnumFromTo HsExp HsExp - | HsEnumFromThen HsExp HsExp - | HsEnumFromThenTo HsExp HsExp HsExp - | HsListComp HsExp [HsStmt] - | HsExpTypeSig SrcLoc HsExp HsType - | HsAsPat HsName HsExp -- pattern only - | HsWildCard -- ditto - | HsIrrPat HsExp -- ditto - -- HsCCall (ghc extension) - -- HsSCC (ghc extension) - deriving (Eq,Show) - -data HsPat - = HsPVar HsName - | HsPLit HsLiteral - | HsPNeg HsPat - | HsPInfixApp HsPat HsQName HsPat - | HsPApp HsQName [HsPat] - | HsPTuple Bool{-boxed-} [HsPat] - | HsPList [HsPat] - | HsPParen HsPat - | HsPRec HsQName [HsPatField] - | HsPAsPat HsName HsPat - | HsPWildCard - | HsPIrrPat HsPat - | HsPTypeSig HsPat HsType - deriving (Eq,Show) - -data HsPatField - = HsPFieldPat HsQName HsPat - deriving (Eq,Show) - -data HsStmt - = HsGenerator HsPat HsExp - | HsParStmt [HsStmt] - | HsQualifier HsExp - | HsLetStmt [HsDecl] - deriving (Eq,Show) - -data HsFieldUpdate - = HsFieldUpdate HsQName HsExp - deriving (Eq,Show) - -data HsAlt - = HsAlt SrcLoc HsPat HsGuardedAlts [HsDecl] - deriving (Eq,Show) - -data HsGuardedAlts - = HsUnGuardedAlt HsExp - | HsGuardedAlts [HsGuardedAlt] - deriving (Eq,Show) - -data HsGuardedAlt - = HsGuardedAlt SrcLoc [HsStmt] HsExp - deriving (Eq,Show) - ------------------------------------------------------------------------------ --- Smart constructors - --- pinched from GHC -mkHsForAllType :: Maybe [HsName] -> HsIPContext -> HsType -> HsType -mkHsForAllType (Just []) [] ty = ty -- Explicit for-all with no tyvars -mkHsForAllType mtvs1 [] (HsForAllType mtvs2 ctxt ty) - = mkHsForAllType (mtvs1 `plus` mtvs2) ctxt ty - where - mtvs `plus` Nothing = mtvs - Nothing `plus` mtvs = mtvs - (Just tvs1) `plus` (Just tvs2) = Just (tvs1 ++ tvs2) -mkHsForAllType tvs ctxt ty = HsForAllType tvs ctxt ty - ------------------------------------------------------------------------------ --- Builtin names. - -prelude_mod, main_mod :: Module -prelude_mod = Module "Prelude" -main_mod = Module "Main" - -unit_ident, nil_ident :: HsIdentifier -unit_ident = HsSpecial "()" -nil_ident = HsSpecial "[]" - -tuple_ident :: Int -> HsIdentifier -tuple_ident i = HsSpecial ("("++replicate i ','++")") - -unit_con_name, nil_con_name :: HsQName -unit_con_name = Qual prelude_mod (HsVarName unit_ident) -nil_con_name = Qual prelude_mod (HsVarName nil_ident) - -tuple_con_name :: Int -> HsQName -tuple_con_name i = Qual prelude_mod (HsVarName (tuple_ident i)) - -as_name, qualified_name, hiding_name, unsafe_name, safe_name - , forall_name, threadsafe_name, export_name, ccall_name, stdcall_name - , dotnet_name, minus_name, pling_name, dot_name :: HsName - -as_name = HsVarName (HsIdent "as") -qualified_name = HsVarName (HsIdent "qualified") -hiding_name = HsVarName (HsIdent "hiding") -unsafe_name = HsVarName (HsIdent "unsafe") -safe_name = HsVarName (HsIdent "safe") -forall_name = HsVarName (HsIdent "forall") -threadsafe_name = HsVarName (HsIdent "threadsafe") -export_name = HsVarName (HsIdent "export") -ccall_name = HsVarName (HsIdent "ccall") -stdcall_name = HsVarName (HsIdent "stdcall") -dotnet_name = HsVarName (HsIdent "dotnet") -minus_name = HsVarName (HsSymbol "-") -pling_name = HsVarName (HsSymbol "!") -dot_name = HsVarName (HsSymbol ".") - -unit_tycon_name, fun_tycon_name, list_tycon_name :: HsName - -unit_tycon_name = HsTyClsName unit_ident -fun_tycon_name = HsTyClsName (HsSpecial "->") -list_tycon_name = HsTyClsName (HsSpecial "[]") - -tuple_tycon_name :: Int -> HsName -tuple_tycon_name i = HsTyClsName (tuple_ident i) - -unit_tycon_qname, fun_tycon_qname, list_tycon_qname :: HsQName - -unit_tycon_qname = Qual prelude_mod unit_tycon_name -fun_tycon_qname = Qual prelude_mod fun_tycon_name -list_tycon_qname = Qual prelude_mod list_tycon_name - -tuple_tycon_qname :: Int -> HsQName -tuple_tycon_qname i = Qual prelude_mod (tuple_tycon_name i) - -unit_tycon, fun_tycon, list_tycon :: HsType - -unit_tycon = HsTyCon unit_tycon_qname -fun_tycon = HsTyCon fun_tycon_qname -list_tycon = HsTyCon list_tycon_qname - -tuple_tycon :: Int -> HsType -tuple_tycon i = HsTyCon (tuple_tycon_qname i) - -hsIdentifierStr :: HsIdentifier -> String -hsIdentifierStr (HsIdent str) = str -hsIdentifierStr (HsSymbol str) = str -hsIdentifierStr (HsSpecial str) = str - -hsAnchorNameStr :: HsName -> String -hsAnchorNameStr (HsTyClsName id0) = "t:" ++ hsIdentifierStr id0 -hsAnchorNameStr (HsVarName id0) = "v:" ++ hsIdentifierStr id0 - -hsNameStr :: HsName -> String -hsNameStr (HsTyClsName id0) = hsIdentifierStr id0 -hsNameStr (HsVarName id0) = hsIdentifierStr id0 - --- ----------------------------------------------------------------------------- --- Doc strings and formatting - -data GenDoc id - = DocEmpty - | DocAppend (GenDoc id) (GenDoc id) - | DocString String - | DocParagraph (GenDoc id) - | DocIdentifier id - | DocModule String - | DocEmphasis (GenDoc id) - | DocMonospaced (GenDoc id) - | DocUnorderedList [GenDoc id] - | DocOrderedList [GenDoc id] - | DocDefList [(GenDoc id, GenDoc id)] - | DocCodeBlock (GenDoc id) - | DocURL String - | DocPic String - | DocAName String - deriving (Eq, Show) - -type Doc = GenDoc [HsQName] - --- | DocMarkup is a set of instructions for marking up documentation. --- In fact, it's really just a mapping from 'GenDoc' to some other --- type [a], where [a] is usually the type of the output (HTML, say). - -data DocMarkup id a = Markup { - markupEmpty :: a, - markupString :: String -> a, - markupParagraph :: a -> a, - markupAppend :: a -> a -> a, - markupIdentifier :: id -> a, - markupModule :: String -> a, - markupEmphasis :: a -> a, - markupMonospaced :: a -> a, - markupUnorderedList :: [a] -> a, - markupOrderedList :: [a] -> a, - markupDefList :: [(a,a)] -> a, - markupCodeBlock :: a -> a, - markupURL :: String -> a, - markupPic :: String -> a, - markupAName :: String -> a - } - -markup :: DocMarkup id a -> GenDoc id -> a -markup m DocEmpty = markupEmpty m -markup m (DocAppend d1 d2) = markupAppend m (markup m d1) (markup m d2) -markup m (DocString s) = markupString m s -markup m (DocParagraph d) = markupParagraph m (markup m d) -markup m (DocIdentifier i) = markupIdentifier m i -markup m (DocModule mod0) = markupModule m mod0 -markup m (DocEmphasis d) = markupEmphasis m (markup m d) -markup m (DocMonospaced d) = markupMonospaced m (markup m d) -markup m (DocUnorderedList ds) = markupUnorderedList m (map (markup m) ds) -markup m (DocOrderedList ds) = markupOrderedList m (map (markup m) ds) -markup m (DocDefList ds) = markupDefList m (map (markupPair m) ds) -markup m (DocCodeBlock d) = markupCodeBlock m (markup m d) -markup m (DocURL url) = markupURL m url -markup m (DocPic url) = markupPic m url -markup m (DocAName ref) = markupAName m ref - -markupPair :: DocMarkup id a -> (GenDoc id, GenDoc id) -> (a, a) -markupPair m (a,b) = (markup m a, markup m b) - --- | The identity markup -idMarkup :: DocMarkup a (GenDoc a) -idMarkup = Markup { - markupEmpty = DocEmpty, - markupString = DocString, - markupParagraph = DocParagraph, - markupAppend = DocAppend, - markupIdentifier = DocIdentifier, - markupModule = DocModule, - markupEmphasis = DocEmphasis, - markupMonospaced = DocMonospaced, - markupUnorderedList = DocUnorderedList, - markupOrderedList = DocOrderedList, - markupDefList = DocDefList, - markupCodeBlock = DocCodeBlock, - markupURL = DocURL, - markupPic = DocPic, - markupAName = DocAName - } - --- | Since marking up is just a matter of mapping 'Doc' into some --- other type, we can \'rename\' documentation by marking up 'Doc' into --- the same thing, modifying only the identifiers embedded in it. -mapIdent :: (a -> GenDoc b) -> DocMarkup a (GenDoc b) -mapIdent f = idMarkup{ markupIdentifier = f } - --- ----------------------------------------------------------------------------- --- ** Smart constructors - --- used to make parsing easier; we group the list items later -docAppend :: Doc -> Doc -> Doc -docAppend (DocUnorderedList ds1) (DocUnorderedList ds2) - = DocUnorderedList (ds1++ds2) -docAppend (DocUnorderedList ds1) (DocAppend (DocUnorderedList ds2) d) - = DocAppend (DocUnorderedList (ds1++ds2)) d -docAppend (DocOrderedList ds1) (DocOrderedList ds2) - = DocOrderedList (ds1++ds2) -docAppend (DocOrderedList ds1) (DocAppend (DocOrderedList ds2) d) - = DocAppend (DocOrderedList (ds1++ds2)) d -docAppend (DocDefList ds1) (DocDefList ds2) - = DocDefList (ds1++ds2) -docAppend (DocDefList ds1) (DocAppend (DocDefList ds2) d) - = DocAppend (DocDefList (ds1++ds2)) d -docAppend DocEmpty d = d -docAppend d DocEmpty = d -docAppend d1 d2 - = DocAppend d1 d2 - --- again to make parsing easier - we spot a paragraph whose only item --- is a DocMonospaced and make it into a DocCodeBlock -docParagraph :: Doc -> Doc -docParagraph (DocMonospaced p) - = DocCodeBlock (docCodeBlock p) -docParagraph (DocAppend (DocString s1) (DocMonospaced p)) - | all isSpace s1 - = DocCodeBlock (docCodeBlock p) -docParagraph (DocAppend (DocString s1) - (DocAppend (DocMonospaced p) (DocString s2))) - | all isSpace s1 && all isSpace s2 - = DocCodeBlock (docCodeBlock p) -docParagraph (DocAppend (DocMonospaced p) (DocString s2)) - | all isSpace s2 - = DocCodeBlock (docCodeBlock p) -docParagraph p - = DocParagraph p - --- Drop trailing whitespace from @..@ code blocks. Otherwise this: --- --- -- @ --- -- foo --- -- @ --- --- turns into (DocCodeBlock "\nfoo\n ") which when rendered in HTML --- gives an extra vertical space after the code block. The single space --- on the final line seems to trigger the extra vertical space. --- -docCodeBlock :: Doc -> Doc -docCodeBlock (DocString s) - = DocString (reverse $ dropWhile (`elem` " \t") $ reverse s) -docCodeBlock (DocAppend l r) - = DocAppend l (docCodeBlock r) -docCodeBlock d = d -\end{code} diff --git a/src/Html.hs b/src/Html.hs deleted file mode 100644 --- a/src/Html.hs +++ /dev/null @@ -1,1037 +0,0 @@ ------------------------------------------------------------------------------ --- --- Module : Text.Html --- Copyright : (c) Andy Gill, and the Oregon Graduate Institute of --- Science and Technology, 1999-2001 --- License : BSD-style (see the file libraries/core/LICENSE) --- --- Maintainer : Andy Gill --- Stability : experimental --- Portability : portable --- --- An Html combinator library --- ------------------------------------------------------------------------------ - -module Html ( - module Html, - ) where - -import qualified BlockTable as BT - -import Data.Char (isAscii, ord) -import Numeric (showHex) - -infixr 2 +++ -- combining Html -infixr 7 << -- nesting Html -infixl 8 ! -- adding optional arguments - - --- A important property of Html is that all strings inside the --- structure are already in Html friendly format. --- For example, use of >,etc. - -data HtmlElement -{- - - ..just..plain..normal..text... but using © and &amb;, etc. - -} - = HtmlString String -{- - - ..content.. - -} - | HtmlTag { -- tag with internal markup - markupTag :: String, - markupAttrs :: [HtmlAttr], - markupContent :: Html - } - -{- These are the index-value pairs. - - The empty string is a synonym for tags with no arguments. - - (not strictly HTML, but anyway). - -} - - -data HtmlAttr = HtmlAttr String String - - -newtype Html = Html { getHtmlElements :: [HtmlElement] } - --- Read MARKUP as the class of things that can be validly rendered --- inside MARKUP tag brackets. So this can be one or more Html's, --- or a String, for example. - -class HTML a where - toHtml :: a -> Html - toHtmlFromList :: [a] -> Html - - toHtmlFromList xs = Html (concat [ x | (Html x) <- map toHtml xs]) - -instance HTML Html where - toHtml a = a - -instance HTML Char where - toHtml a = toHtml [a] - toHtmlFromList [] = Html [] - toHtmlFromList str = Html [HtmlString (stringToHtmlString str)] - -instance (HTML a) => HTML [a] where - toHtml xs = toHtmlFromList xs - -class ADDATTRS a where - (!) :: a -> [HtmlAttr] -> a - -instance (ADDATTRS b) => ADDATTRS (a -> b) where - fn ! attr = \ arg -> fn arg ! attr - -instance ADDATTRS Html where - (Html htmls) ! attr = Html (map addAttrs htmls) - where - addAttrs html = - case html of - HtmlTag { markupAttrs = markupAttrs0 - , markupTag = markupTag0 - , markupContent = markupContent0 } -> - HtmlTag { markupAttrs = markupAttrs0 ++ attr - , markupTag = markupTag0 - , markupContent = markupContent0 } - _ -> html - - -(<<) :: (HTML a) => (Html -> b) -> a -> b -fn << arg = fn (toHtml arg) - - -concatHtml :: (HTML a) => [a] -> Html -concatHtml as = Html (concat (map (getHtmlElements.toHtml) as)) - -(+++) :: (HTML a,HTML b) => a -> b -> Html -a +++ b = Html (getHtmlElements (toHtml a) ++ getHtmlElements (toHtml b)) - -noHtml :: Html -noHtml = Html [] - - -isNoHtml :: Html -> Bool -isNoHtml (Html xs) = null xs - - -tag :: String -> Html -> Html -tag str htmls = - Html [ HtmlTag { markupTag = str, - markupAttrs = [], - markupContent = htmls } - ] - -itag :: String -> Html -itag str = tag str noHtml - -emptyAttr :: String -> HtmlAttr -emptyAttr s = HtmlAttr s "" - -intAttr :: String -> Int -> HtmlAttr -intAttr s i = HtmlAttr s (show i) - -strAttr :: String -> String -> HtmlAttr -strAttr s t = HtmlAttr s t - - -{- -foldHtml :: (String -> [HtmlAttr] -> [a] -> a) - -> (String -> a) - -> Html - -> a -foldHtml f g (HtmlTag str attr fmls) - = f str attr (map (foldHtml f g) fmls) -foldHtml f g (HtmlString str) - = g str - --} --- Processing Strings into Html friendly things. --- This converts a String to a Html String. -stringToHtmlString :: String -> String -stringToHtmlString = concatMap fixChar - where - fixChar '<' = "<" - fixChar '>' = ">" - fixChar '&' = "&" - fixChar '"' = """ - fixChar c - | isAscii c = [c] - | otherwise = "&#x" ++ showHex (ord c) ";" - --- --------------------------------------------------------------------------- --- Classes - -instance Show Html where - showsPrec _ html = showString (prettyHtml html) - showList htmls = showString (concat (map show htmls)) - -instance Show HtmlAttr where - showsPrec _ (HtmlAttr str val) = - showString str . - showString "=" . - shows val - - --- --------------------------------------------------------------------------- --- Data types - -type URL = String - --- --------------------------------------------------------------------------- --- Basic primitives - --- This is not processed for special chars. --- use stringToHtml or lineToHtml instead, for user strings, --- because they understand special chars, like '<'. - -primHtml :: String -> Html -primHtml x = Html [HtmlString x] - --- --------------------------------------------------------------------------- --- Basic Combinators - -stringToHtml :: String -> Html -stringToHtml = primHtml . stringToHtmlString - --- This converts a string, but keeps spaces as non-line-breakable - -lineToHtml :: String -> Html -lineToHtml = primHtml . concatMap htmlizeChar2 . stringToHtmlString - where - htmlizeChar2 ' ' = " " - htmlizeChar2 c = [c] - --- --------------------------------------------------------------------------- --- Html Constructors - --- (automatically generated) - -address :: Html -> Html -anchor :: Html -> Html -applet :: Html -> Html -area :: Html -basefont :: Html -big :: Html -> Html -blockquote :: Html -> Html -body :: Html -> Html -bold :: Html -> Html -br :: Html -button :: Html -> Html -caption :: Html -> Html -center :: Html -> Html -cite :: Html -> Html -ddef :: Html -> Html -define :: Html -> Html -dlist :: Html -> Html -dterm :: Html -> Html -emphasize :: Html -> Html -fieldset :: Html -> Html -font :: Html -> Html -form :: Html -> Html -frame :: Html -> Html -frameset :: Html -> Html -h1 :: Html -> Html -h2 :: Html -> Html -h3 :: Html -> Html -h4 :: Html -> Html -h5 :: Html -> Html -h6 :: Html -> Html -header :: Html -> Html -hr :: Html -image :: Html -input :: Html -italics :: Html -> Html -keyboard :: Html -> Html -legend :: Html -> Html -li :: Html -> Html -meta :: Html -noframes :: Html -> Html -olist :: Html -> Html -option :: Html -> Html -paragraph :: Html -> Html -param :: Html -pre :: Html -> Html -sample :: Html -> Html -script :: Html -> Html -select :: Html -> Html -small :: Html -> Html -strong :: Html -> Html -style :: Html -> Html -sub :: Html -> Html -sup :: Html -> Html -table :: Html -> Html -thetd :: Html -> Html -textarea :: Html -> Html -th :: Html -> Html -thebase :: Html -thecode :: Html -> Html -thediv :: Html -> Html -thehtml :: Html -> Html -thelink :: Html -themap :: Html -> Html -thespan :: Html -> Html -thetitle :: Html -> Html -tr :: Html -> Html -tt :: Html -> Html -ulist :: Html -> Html -underline :: Html -> Html -variable :: Html -> Html - -address = tag "ADDRESS" -anchor = tag "A" -applet = tag "APPLET" -area = itag "AREA" -basefont = itag "BASEFONT" -big = tag "BIG" -blockquote = tag "BLOCKQUOTE" -body = tag "BODY" -bold = tag "B" -br = itag "BR" -button = tag "BUTTON" -caption = tag "CAPTION" -center = tag "CENTER" -cite = tag "CITE" -ddef = tag "DD" -define = tag "DFN" -dlist = tag "DL" -dterm = tag "DT" -emphasize = tag "EM" -fieldset = tag "FIELDSET" -font = tag "FONT" -form = tag "FORM" -frame = tag "FRAME" -frameset = tag "FRAMESET" -h1 = tag "H1" -h2 = tag "H2" -h3 = tag "H3" -h4 = tag "H4" -h5 = tag "H5" -h6 = tag "H6" -header = tag "HEAD" -hr = itag "HR" -image = itag "IMG" -input = itag "INPUT" -italics = tag "I" -keyboard = tag "KBD" -legend = tag "LEGEND" -li = tag "LI" -meta = itag "META" -noframes = tag "NOFRAMES" -olist = tag "OL" -option = tag "OPTION" -paragraph = tag "P" -param = itag "PARAM" -pre = tag "PRE" -sample = tag "SAMP" -script = tag "SCRIPT" -select = tag "SELECT" -small = tag "SMALL" -strong = tag "STRONG" -style = tag "STYLE" -sub = tag "SUB" -sup = tag "SUP" -table = tag "TABLE" -thetd = tag "TD" -textarea = tag "TEXTAREA" -th = tag "TH" -thebase = itag "BASE" -thecode = tag "CODE" -thediv = tag "DIV" -thehtml = tag "HTML" -thelink = itag "LINK" -themap = tag "MAP" -thespan = tag "SPAN" -thetitle = tag "TITLE" -tr = tag "TR" -tt = tag "TT" -ulist = tag "UL" -underline = tag "U" -variable = tag "VAR" - --- --------------------------------------------------------------------------- --- Html Attributes - --- (automatically generated) - -action :: String -> HtmlAttr -align :: String -> HtmlAttr -alink :: String -> HtmlAttr -alt :: String -> HtmlAttr -altcode :: String -> HtmlAttr -archive :: String -> HtmlAttr -background :: String -> HtmlAttr -base :: String -> HtmlAttr -bgcolor :: String -> HtmlAttr -border :: Int -> HtmlAttr -bordercolor :: String -> HtmlAttr -cellpadding :: Int -> HtmlAttr -cellspacing :: Int -> HtmlAttr -checked :: HtmlAttr -clear :: String -> HtmlAttr -code :: String -> HtmlAttr -codebase :: String -> HtmlAttr -color :: String -> HtmlAttr -cols :: String -> HtmlAttr -colspan :: Int -> HtmlAttr -compact :: HtmlAttr -content :: String -> HtmlAttr -coords :: String -> HtmlAttr -enctype :: String -> HtmlAttr -face :: String -> HtmlAttr -frameborder :: Int -> HtmlAttr -height :: Int -> HtmlAttr -href :: String -> HtmlAttr -hspace :: Int -> HtmlAttr -httpequiv :: String -> HtmlAttr -identifier :: String -> HtmlAttr -ismap :: HtmlAttr -lang :: String -> HtmlAttr -link :: String -> HtmlAttr -marginheight :: Int -> HtmlAttr -marginwidth :: Int -> HtmlAttr -maxlength :: Int -> HtmlAttr -method :: String -> HtmlAttr -multiple :: HtmlAttr -name :: String -> HtmlAttr -nohref :: HtmlAttr -noresize :: HtmlAttr -noshade :: HtmlAttr -nowrap :: HtmlAttr -onclick :: String -> HtmlAttr -rel :: String -> HtmlAttr -rev :: String -> HtmlAttr -rows :: String -> HtmlAttr -rowspan :: Int -> HtmlAttr -rules :: String -> HtmlAttr -scrolling :: String -> HtmlAttr -selected :: HtmlAttr -shape :: String -> HtmlAttr -size :: String -> HtmlAttr -src :: String -> HtmlAttr -start :: Int -> HtmlAttr -target :: String -> HtmlAttr -text :: String -> HtmlAttr -theclass :: String -> HtmlAttr -thestyle :: String -> HtmlAttr -thetype :: String -> HtmlAttr -title :: String -> HtmlAttr -usemap :: String -> HtmlAttr -valign :: String -> HtmlAttr -value :: String -> HtmlAttr -version :: String -> HtmlAttr -vlink :: String -> HtmlAttr -vspace :: Int -> HtmlAttr -width :: String -> HtmlAttr - -action = strAttr "ACTION" -align = strAttr "ALIGN" -alink = strAttr "ALINK" -alt = strAttr "ALT" -altcode = strAttr "ALTCODE" -archive = strAttr "ARCHIVE" -background = strAttr "BACKGROUND" -base = strAttr "BASE" -bgcolor = strAttr "BGCOLOR" -border = intAttr "BORDER" -bordercolor = strAttr "BORDERCOLOR" -cellpadding = intAttr "CELLPADDING" -cellspacing = intAttr "CELLSPACING" -checked = emptyAttr "CHECKED" -clear = strAttr "CLEAR" -code = strAttr "CODE" -codebase = strAttr "CODEBASE" -color = strAttr "COLOR" -cols = strAttr "COLS" -colspan = intAttr "COLSPAN" -compact = emptyAttr "COMPACT" -content = strAttr "CONTENT" -coords = strAttr "COORDS" -enctype = strAttr "ENCTYPE" -face = strAttr "FACE" -frameborder = intAttr "FRAMEBORDER" -height = intAttr "HEIGHT" -href = strAttr "HREF" -hspace = intAttr "HSPACE" -httpequiv = strAttr "HTTP-EQUIV" -identifier = strAttr "ID" -ismap = emptyAttr "ISMAP" -lang = strAttr "LANG" -link = strAttr "LINK" -marginheight = intAttr "MARGINHEIGHT" -marginwidth = intAttr "MARGINWIDTH" -maxlength = intAttr "MAXLENGTH" -method = strAttr "METHOD" -multiple = emptyAttr "MULTIPLE" -name = strAttr "NAME" -nohref = emptyAttr "NOHREF" -noresize = emptyAttr "NORESIZE" -noshade = emptyAttr "NOSHADE" -nowrap = emptyAttr "NOWRAP" -onclick = strAttr "ONCLICK" -rel = strAttr "REL" -rev = strAttr "REV" -rows = strAttr "ROWS" -rowspan = intAttr "ROWSPAN" -rules = strAttr "RULES" -scrolling = strAttr "SCROLLING" -selected = emptyAttr "SELECTED" -shape = strAttr "SHAPE" -size = strAttr "SIZE" -src = strAttr "SRC" -start = intAttr "START" -target = strAttr "TARGET" -text = strAttr "TEXT" -theclass = strAttr "CLASS" -thestyle = strAttr "STYLE" -thetype = strAttr "TYPE" -title = strAttr "TITLE" -usemap = strAttr "USEMAP" -valign = strAttr "VALIGN" -value = strAttr "VALUE" -version = strAttr "VERSION" -vlink = strAttr "VLINK" -vspace = intAttr "VSPACE" -width = strAttr "WIDTH" - --- --------------------------------------------------------------------------- --- Html Constructors - --- (automatically generated) - -validHtmlTags :: [String] -validHtmlTags = [ - "ADDRESS", - "A", - "APPLET", - "BIG", - "BLOCKQUOTE", - "BODY", - "B", - "CAPTION", - "CENTER", - "CITE", - "DD", - "DFN", - "DL", - "DT", - "EM", - "FIELDSET", - "FONT", - "FORM", - "FRAME", - "FRAMESET", - "H1", - "H2", - "H3", - "H4", - "H5", - "H6", - "HEAD", - "I", - "KBD", - "LEGEND", - "LI", - "NOFRAMES", - "OL", - "OPTION", - "P", - "PRE", - "SAMP", - "SELECT", - "SMALL", - "STRONG", - "STYLE", - "SUB", - "SUP", - "TABLE", - "TD", - "TEXTAREA", - "TH", - "CODE", - "DIV", - "HTML", - "LINK", - "MAP", - "TITLE", - "TR", - "TT", - "UL", - "U", - "VAR"] - -validHtmlITags :: [String] -validHtmlITags = [ - "AREA", - "BASEFONT", - "BR", - "HR", - "IMG", - "INPUT", - "LINK", - "META", - "PARAM", - "BASE"] - -validHtmlAttrs :: [String] -validHtmlAttrs = [ - "ACTION", - "ALIGN", - "ALINK", - "ALT", - "ALTCODE", - "ARCHIVE", - "BACKGROUND", - "BASE", - "BGCOLOR", - "BORDER", - "BORDERCOLOR", - "CELLPADDING", - "CELLSPACING", - "CHECKED", - "CLEAR", - "CODE", - "CODEBASE", - "COLOR", - "COLS", - "COLSPAN", - "COMPACT", - "CONTENT", - "COORDS", - "ENCTYPE", - "FACE", - "FRAMEBORDER", - "HEIGHT", - "HREF", - "HSPACE", - "HTTP-EQUIV", - "ID", - "ISMAP", - "LANG", - "LINK", - "MARGINHEIGHT", - "MARGINWIDTH", - "MAXLENGTH", - "METHOD", - "MULTIPLE", - "NAME", - "NOHREF", - "NORESIZE", - "NOSHADE", - "NOWRAP", - "REL", - "REV", - "ROWS", - "ROWSPAN", - "RULES", - "SCROLLING", - "SELECTED", - "SHAPE", - "SIZE", - "SRC", - "START", - "TARGET", - "TEXT", - "CLASS", - "STYLE", - "TYPE", - "TITLE", - "USEMAP", - "VALIGN", - "VALUE", - "VERSION", - "VLINK", - "VSPACE", - "WIDTH"] - --- --------------------------------------------------------------------------- --- Html colors - -aqua :: String -black :: String -blue :: String -fuchsia :: String -gray :: String -green :: String -lime :: String -maroon :: String -navy :: String -olive :: String -purple :: String -red :: String -silver :: String -teal :: String -yellow :: String -white :: String - -aqua = "aqua" -black = "black" -blue = "blue" -fuchsia = "fuchsia" -gray = "gray" -green = "green" -lime = "lime" -maroon = "maroon" -navy = "navy" -olive = "olive" -purple = "purple" -red = "red" -silver = "silver" -teal = "teal" -yellow = "yellow" -white = "white" - --- --------------------------------------------------------------------------- --- Basic Combinators - -linesToHtml :: [String] -> Html - -linesToHtml [] = noHtml -linesToHtml (x:[]) = lineToHtml x -linesToHtml (x:xs) = lineToHtml x +++ br +++ linesToHtml xs - - --- --------------------------------------------------------------------------- --- Html abbriviations - -primHtmlChar :: String -> Html -copyright :: Html -spaceHtml :: Html -bullet :: Html -p :: Html -> Html - -primHtmlChar = \ x -> primHtml ("&" ++ x ++ ";") -copyright = primHtmlChar "copy" -spaceHtml = primHtmlChar "nbsp" -bullet = primHtmlChar "#149" - -p = paragraph - --- --------------------------------------------------------------------------- --- Html tables - -cell :: Html -> HtmlTable -cell h = let - cellFn x y = h ! (add x colspan $ add y rowspan $ []) - add 1 _ rest = rest - add n fn rest = fn n : rest - r = BT.single cellFn - in - mkHtmlTable r - --- We internally represent the Cell inside a Table with an --- object of the type --- \pre{ --- Int -> Int -> Html --- } --- When we render it later, we find out how many columns --- or rows this cell will span over, and can --- include the correct colspan/rowspan command. - -newtype HtmlTable - = HtmlTable (BT.BlockTable (Int -> Int -> Html)) - -td :: Html -> HtmlTable -td = cell . thetd - -tda :: [HtmlAttr] -> Html -> HtmlTable -tda as = cell . (thetd ! as) - -above, beside :: HtmlTable -> HtmlTable -> HtmlTable -above a b = combine BT.above a b -beside a b = combine BT.beside a b - -infixr 3 -- combining table cells -infixr 4 <-> -- combining table cells -(), (<->) :: HtmlTable -> HtmlTable -> HtmlTable -() = above -(<->) = beside - -emptyTable :: HtmlTable -emptyTable = HtmlTable BT.empty - -aboves, besides :: [HtmlTable] -> HtmlTable -aboves = foldr above emptyTable -besides = foldr beside emptyTable - -mkHtmlTable :: BT.BlockTable (Int -> Int -> Html) -> HtmlTable -mkHtmlTable r = HtmlTable r - -combine :: (BT.BlockTable (Int -> Int -> Html) - -> BT.BlockTable (Int -> Int -> Html) - -> BT.BlockTable (Int -> Int -> Html)) - -> HtmlTable -> HtmlTable -> HtmlTable -combine fn (HtmlTable a) (HtmlTable b) = mkHtmlTable (a `fn` b) - --- renderTable takes the HtmlTable, and renders it back into --- and Html object. - -renderTable :: BT.BlockTable (Int -> Int -> Html) -> Html -renderTable theTable - = concatHtml - [tr << [theCell x y | (theCell,(x,y)) <- theRow ] - | theRow <- BT.getMatrix theTable] - -instance HTML HtmlTable where - toHtml (HtmlTable tab) = renderTable tab - -instance Show HtmlTable where - showsPrec _ (HtmlTable tab) = shows (renderTable tab) - - --- If you can't be bothered with the above, then you --- can build simple tables with simpleTable. --- Just provide the attributes for the whole table, --- attributes for the cells (same for every cell), --- and a list of lists of cell contents, --- and this function will build the table for you. --- It does presume that all the lists are non-empty, --- and there is at least one list. --- --- Different length lists means that the last cell --- gets padded. If you want more power, then --- use the system above, or build tables explicitly. - -simpleTable :: HTML a => [HtmlAttr] -> [HtmlAttr] -> [[a]] -> Html -simpleTable attr cellAttr lst - = table ! attr - << (aboves - . map (besides . map (cell . (thetd ! cellAttr) . toHtml)) - ) lst - - --- --------------------------------------------------------------------------- --- Tree Displaying Combinators - --- The basic idea is you render your structure in the form --- of this tree, and then use treeHtml to turn it into a Html --- object with the structure explicit. - -data HtmlTree - = HtmlLeaf Html - | HtmlNode Html [HtmlTree] Html - -treeHtml :: [String] -> HtmlTree -> Html -treeHtml colors h = table ! [ - border 0, - cellpadding 0, - cellspacing 2] << treeHtml' colors h - where - manycolors = scanr (:) [] - - treeHtmls :: [[String]] -> [HtmlTree] -> HtmlTable - treeHtmls c ts = aboves (zipWith treeHtml' c ts) - - treeHtml' :: [String] -> HtmlTree -> HtmlTable - treeHtml' (_:_) (HtmlLeaf leaf) = cell - (thetd ! [width "100%"] - << bold - << leaf) - treeHtml' (c:cs@(c2:_)) (HtmlNode hopen ts hclose) = - if null ts && isNoHtml hclose - then - hd - else if null ts - then - hd bar `beside` (cell . (thetd ! [bgcolor c2]) << spaceHtml) - tl - else - hd (bar `beside` treeHtmls morecolors ts) - tl - where - -- This stops a column of colors being the same - -- color as the immeduately outside nesting bar. - morecolors = filter ((/= c).head) (manycolors cs) - bar = cell (thetd ! [bgcolor c,width "10"] << spaceHtml) - hd = cell (thetd ! [bgcolor c] << hopen) - tl = cell (thetd ! [bgcolor c] << hclose) - treeHtml' _ _ = error "The imposible happens" - -instance HTML HtmlTree where - toHtml x = treeHtml treeColors x - --- type "length treeColors" to see how many colors are here. -treeColors :: [String] -treeColors = ["#88ccff","#ffffaa","#ffaaff","#ccffff"] ++ treeColors - - --- --------------------------------------------------------------------------- --- Html Debugging Combinators - --- This uses the above tree rendering function, and displays the --- Html as a tree structure, allowing debugging of what is --- actually getting produced. - -debugHtml :: (HTML a) => a -> Html -debugHtml obj = table ! [border 0] << ( - cell (th ! [bgcolor "#008888"] - << underline - << "Debugging Output") - td << (toHtml (debug' (toHtml obj))) - ) - where - - debug' :: Html -> [HtmlTree] - debug' (Html markups) = map debug markups - - debug :: HtmlElement -> HtmlTree - debug (HtmlString str) = HtmlLeaf (spaceHtml +++ - linesToHtml (lines str)) - debug (HtmlTag { - markupTag = markupTag0, - markupContent = markupContent0, - markupAttrs = markupAttrs0 - }) = - case markupContent0 of - Html [] -> HtmlNode hd [] noHtml - Html xs -> HtmlNode hd (map debug xs) tl - where - args = if null markupAttrs0 - then "" - else " " ++ unwords (map show markupAttrs0) - hd = font ! [size "1"] << ("<" ++ markupTag0 ++ args ++ ">") - tl = font ! [size "1"] << ("") - --- --------------------------------------------------------------------------- --- Hotlink datatype - -data HotLink = HotLink { - hotLinkURL :: URL, - hotLinkContents :: [Html], - hotLinkAttributes :: [HtmlAttr] - } deriving Show - -instance HTML HotLink where - toHtml hl = anchor ! (href (hotLinkURL hl) : hotLinkAttributes hl) - << hotLinkContents hl - -hotlink :: URL -> [Html] -> HotLink -hotlink url h = HotLink { - hotLinkURL = url, - hotLinkContents = h, - hotLinkAttributes = [] } - - --- --------------------------------------------------------------------------- --- More Combinators - --- (Abridged from Erik Meijer's Original Html library) - -ordList :: (HTML a) => [a] -> Html -ordList items = olist << map (li <<) items - -unordList :: (HTML a) => [a] -> Html -unordList items = ulist << map (li <<) items - -defList :: (HTML a,HTML b) => [(a,b)] -> Html -defList items - = dlist << [ [ dterm << bold << dt, ddef << dd ] | (dt,dd) <- items ] - - -widget :: String -> String -> [HtmlAttr] -> Html -widget w n markupAttrs0 = input ! ([thetype w,name n] ++ markupAttrs0) - -checkbox :: String -> String -> Html -hidden :: String -> String -> Html -radio :: String -> String -> Html -reset :: String -> String -> Html -submit :: String -> String -> Html -password :: String -> Html -textfield :: String -> Html -afile :: String -> Html -clickmap :: String -> Html - -checkbox n v = widget "CHECKBOX" n [value v] -hidden n v = widget "HIDDEN" n [value v] -radio n v = widget "RADIO" n [value v] -reset n v = widget "RESET" n [value v] -submit n v = widget "SUBMIT" n [value v] -password n = widget "PASSWORD" n [] -textfield n = widget "TEXT" n [] -afile n = widget "FILE" n [] -clickmap n = widget "IMAGE" n [] - -menu :: String -> [Html] -> Html -menu n choices - = select ! [name n] << [ option << p << choice | choice <- choices ] - -gui :: String -> Html -> Html -gui act = form ! [action act,method "POST"] - --- --------------------------------------------------------------------------- --- Html Rendering - --- Uses the append trick to optimize appending. --- The output is quite messy, because space matters in --- HTML, so we must not generate needless spaces. - -renderHtml :: (HTML html) => html -> String -renderHtml theHtml = - renderMessage ++ - foldr (.) id (map unprettyHtml - (getHtmlElements (tag "HTML" << theHtml))) "\n" - -renderMessage :: String -renderMessage = - "\n" ++ - "\n" - -unprettyHtml :: HtmlElement -> ShowS -unprettyHtml (HtmlString str) = (++) str -unprettyHtml (HtmlTag - { markupTag = name0, - markupContent = html, - markupAttrs = markupAttrs0 }) - = if isNoHtml html && elem name0 validHtmlITags - then renderTag True name0 markupAttrs0 0 - else (renderTag True name0 markupAttrs0 0 - . foldr (.) id (map unprettyHtml (getHtmlElements html)) - . renderTag False name0 [] 0) - --- Local Utilities -prettyHtml :: (HTML html) => html -> String -prettyHtml theHtml = - unlines - $ concat - $ map prettyHtml' - $ getHtmlElements - $ toHtml theHtml - -prettyHtml' :: HtmlElement -> [String] -prettyHtml' (HtmlString str) = [str] -prettyHtml' (HtmlTag - { markupTag = name0, - markupContent = html, - markupAttrs = markupAttrs0 }) - = if isNoHtml html && elem name0 validHtmlITags - then - [rmNL (renderTag True name0 markupAttrs0 0 "")] - else - [rmNL (renderTag True name0 markupAttrs0 0 "")] ++ - shift (concat (map prettyHtml' (getHtmlElements html))) ++ - [rmNL (renderTag False name0 [] 0 "")] - where - shift = map (\x -> " " ++ x) - -rmNL :: [Char] -> [Char] -rmNL = filter (/= '\n') - --- This prints the Tags The lack of spaces in intentunal, because Html is --- actually space dependant. - -renderTag :: Bool -> String -> [HtmlAttr] -> Int -> ShowS -renderTag x name0 markupAttrs0 n r - = open ++ name0 ++ rest markupAttrs0 ++ ">" ++ r - where - open = if x then "<" else " String - showPair (HtmlAttr tag0 val) - = tag0 ++ "=\"" ++ val ++ "\"" - diff --git a/src/Main.hs b/src/Main.hs --- a/src/Main.hs +++ b/src/Main.hs @@ -1,1467 +1,314 @@ -{-# OPTIONS_GHC -fglasgow-exts #-} --- --- Haddock - A Haskell Documentation Tool --- --- (c) Simon Marlow 2003 --- - -module Main (main) where - -import Binary -import Digraph ---import HaddockDB -- not compiling -import HaddockHtml -import HaddockHoogle -import HaddockLex -import HaddockParse -import HaddockRename -import HaddockTypes -import HaddockUtil -import HaddockVersion -import HsParseMonad -import HsParser -import HsSyn -import Map ( Map ) -import qualified Map hiding ( Map ) -import Set -import Paths_haddock ( getDataDir ) - -import Control.Exception ( bracket ) -import Control.Monad ( when, unless ) -import Data.Char ( isSpace ) -import Data.IORef ( writeIORef ) -import Data.List ( nub, (\\), foldl', sortBy ) -import Data.Maybe ( isJust, isNothing, maybeToList, listToMaybe ) ---import Debug.Trace -import System.Console.GetOpt ( getOpt, usageInfo, ArgOrder(..), OptDescr(..), ArgDescr(..) ) -import System.Environment ( getArgs ) -import System.IO ( stderr, IOMode(..), openFile, hClose, hGetContents, hPutStrLn ) -#if defined(mingw32_HOST_OS) -import Foreign -import Foreign.C -#endif - -#if __GLASGOW_HASKELL__ >= 603 -import System.Process -import System.Exit -import Control.Exception ( Exception(..), throwIO, catch ) -import Prelude hiding (catch) -import System.Directory ( doesDirectoryExist, doesFileExist ) -import Control.Concurrent -#endif - ------------------------------------------------------------------------------ --- Top-level stuff -main :: IO () -main = do - cmdline <- getArgs - case getOpt Permute (options True) cmdline of - (flags, args, [] ) -> run flags args - (_, _, errors) -> do prog <- getProgramName - die (concat errors ++ - usageInfo (usageHeader prog) (options False)) - -usageHeader :: String -> String -usageHeader prog = "Usage: " ++ prog ++ " [OPTION...] file...\n" - -data Flag - = Flag_CSS String - | Flag_Debug --- | Flag_DocBook - | Flag_DumpInterface FilePath - | Flag_Heading String - | Flag_Package String - | Flag_Html - | Flag_Hoogle - | Flag_HtmlHelp String - | Flag_Lib String - | Flag_NoImplicitPrelude - | Flag_OutputDir FilePath - | Flag_Prologue FilePath - | Flag_ReadInterface FilePath - | Flag_SourceBaseURL String - | Flag_SourceModuleURL String - | Flag_SourceEntityURL String - | Flag_WikiBaseURL String - | Flag_WikiModuleURL String - | Flag_WikiEntityURL String - | Flag_Help - | Flag_Verbose - | Flag_Version - | Flag_UseContents String - | Flag_GenContents - | Flag_UseIndex String - | Flag_GenIndex - | Flag_IgnoreAllExports - | Flag_GhcPkg FilePath - | Flag_HideModule String - | Flag_UsePackage String - | Flag_AllowMissingHtml - deriving (Eq) - -options :: Bool -> [OptDescr Flag] -options backwardsCompat = - [ - Option ['o'] ["odir"] (ReqArg Flag_OutputDir "DIR") - "directory in which to put the output files", - Option ['i'] ["read-interface"] (ReqArg Flag_ReadInterface "FILE") - "read an interface from FILE", - Option ['D'] ["dump-interface"] (ReqArg Flag_DumpInterface "FILE") - "dump an interface for these modules in FILE", - Option ['l'] ["lib"] (ReqArg Flag_Lib "DIR") - "location of Haddock's auxiliary files", --- Option ['S'] ["docbook"] (NoArg Flag_DocBook) --- "output in DocBook XML", - Option ['h'] ["html"] (NoArg Flag_Html) - "output in HTML", - Option [] ["hoogle"] (NoArg Flag_Hoogle) - "output for Hoogle", - Option [] ["html-help"] (ReqArg Flag_HtmlHelp "format") - "produce index and table of contents in\nmshelp, mshelp2 or devhelp format (with -h)", - Option [] ["source-base"] (ReqArg Flag_SourceBaseURL "URL") - "URL for a source code link on the contents\nand index pages", - Option ['s'] (if backwardsCompat then ["source", "source-module"] else ["source-module"]) - (ReqArg Flag_SourceModuleURL "URL") - "URL for a source code link for each module\n(using the %{FILE} or %{MODULE} vars)", - Option [] ["source-entity"] (ReqArg Flag_SourceEntityURL "URL") - "URL for a source code link for each entity\n(using the %{FILE}, %{MODULE}, %{NAME},\n%{KIND} or %{LINE} vars)", - Option [] ["comments-base"] (ReqArg Flag_WikiBaseURL "URL") - "URL for a comments link on the contents\nand index pages", - Option [] ["comments-module"] (ReqArg Flag_WikiModuleURL "URL") - "URL for a comments link for each module\n(using the %{MODULE} var)", - Option [] ["comments-entity"] (ReqArg Flag_WikiEntityURL "URL") - "URL for a comments link for each entity\n(using the %{FILE}, %{MODULE}, %{NAME},\n%{KIND} or %{LINE} vars)", - Option ['c'] ["css"] (ReqArg Flag_CSS "FILE") - "the CSS file to use for HTML output", - Option ['p'] ["prologue"] (ReqArg Flag_Prologue "FILE") - "file containing prologue text", - Option ['t'] ["title"] (ReqArg Flag_Heading "TITLE") - "page heading", - Option ['k'] ["package"] (ReqArg Flag_Package "NAME") - "package name (optional)", - Option ['n'] ["no-implicit-prelude"] (NoArg Flag_NoImplicitPrelude) - "do not assume Prelude is imported", - Option ['d'] ["debug"] (NoArg Flag_Debug) - "extra debugging output", - Option ['?'] ["help"] (NoArg Flag_Help) - "display this help and exit", - Option ['V'] ["version"] (NoArg Flag_Version) - "output version information and exit", - Option ['v'] ["verbose"] (NoArg Flag_Verbose) - "increase verbosity", - Option [] ["use-contents"] (ReqArg Flag_UseContents "URL") - "use a separately-generated HTML contents page", - Option [] ["gen-contents"] (NoArg Flag_GenContents) - "generate an HTML contents from specified\ninterfaces", - Option [] ["use-index"] (ReqArg Flag_UseIndex "URL") - "use a separately-generated HTML index", - Option [] ["gen-index"] (NoArg Flag_GenIndex) - "generate an HTML index from specified\ninterfaces", - Option [] ["ignore-all-exports"] (NoArg Flag_IgnoreAllExports) - "behave as if all modules have the\nignore-exports atribute", - Option [] ["ghc-pkg"] (ReqArg Flag_GhcPkg "FILE") - "ghc-pkg is FILE", - Option [] ["hide"] (ReqArg Flag_HideModule "MODULE") - "behave as if MODULE has the hide attribute", - Option [] ["use-package"] (ReqArg Flag_UsePackage "PACKAGE") - "the modules being processed depend on PACKAGE", - Option [] ["allow-missing-html"] (NoArg Flag_AllowMissingHtml) - "use a package even if its HTML is missing" - ] - -run :: [Flag] -> [FilePath] -> IO () -run flags files = do - when (Flag_Help `elem` flags) $ do - prog <- getProgramName - bye (usageInfo (usageHeader prog) (options False)) - - when (Flag_Version `elem` flags) $ - bye ("Haddock version " ++ projectVersion ++ ", (c) Simon Marlow 2006\n") - - let title = case [str | Flag_Heading str <- flags] of - [] -> "" - (t:_) -> t - - package = listToMaybe [str | Flag_Package str <- flags] - - maybe_source_urls = (listToMaybe [str | Flag_SourceBaseURL str <- flags] - ,listToMaybe [str | Flag_SourceModuleURL str <- flags] - ,listToMaybe [str | Flag_SourceEntityURL str <- flags]) - - maybe_wiki_urls = (listToMaybe [str | Flag_WikiBaseURL str <- flags] - ,listToMaybe [str | Flag_WikiModuleURL str <- flags] - ,listToMaybe [str | Flag_WikiEntityURL str <- flags]) - - verbose = Flag_Verbose `elem` flags - - libdir <- case [str | Flag_Lib str <- flags] of - [] -> getDataDir -- provided by Cabal - fs -> return (last fs) - - let css_file = case [str | Flag_CSS str <- flags] of - [] -> Nothing - fs -> Just (last fs) - - odir <- case [str | Flag_OutputDir str <- flags] of - [] -> return "." - fs -> return (last fs) - - let dump_iface = case [str | Flag_DumpInterface str <- flags] of - [] -> Nothing - fs -> Just (last fs) - - read_iface_flags = [ parseIfaceOption str - | Flag_ReadInterface str <- flags ] - - maybe_contents_url = - case [url | Flag_UseContents url <- flags] of - [] -> Nothing - us -> Just (last us) - - maybe_index_url = - case [url | Flag_UseIndex url <- flags] of - [] -> Nothing - us -> Just (last us) - - maybe_html_help_format = - case [hhformat | Flag_HtmlHelp hhformat <- flags] of - [] -> Nothing - formats -> Just (last formats) - - prologue <- getPrologue flags - - -- grok the --use-package flags - pkg_ifaces_to_read <- getPackageIfaces flags verbose - - let ifaces_to_read = read_iface_flags ++ pkg_ifaces_to_read - - read_iface_stuff <- mapM readIface (map snd ifaces_to_read) - - let - (read_ifacess, doc_envs) = unzip read_iface_stuff - read_ifaces = concat read_ifacess - - ext_doc_env = Map.unions doc_envs - - visible_read_ifaces = filter ((OptHide `notElem`) . iface_options) - read_ifaces - external_mods = map iface_module read_ifaces - pkg_paths = map fst ifaces_to_read - - updateHTMLXRefs pkg_paths read_ifacess - - when ((Flag_GenIndex `elem` flags || Flag_GenContents `elem` flags) - && Flag_Html `elem` flags) $ - die ("-h cannot be used with --gen-index or --gen-contents") - - when (Flag_GenContents `elem` flags) $ do - ppHtmlContents odir title package maybe_html_help_format - maybe_index_url maybe_source_urls maybe_wiki_urls - visible_read_ifaces prologue - copyHtmlBits odir libdir css_file - - when (Flag_GenIndex `elem` flags) $ do - ppHtmlIndex odir title package maybe_html_help_format - maybe_contents_url maybe_source_urls maybe_wiki_urls - visible_read_ifaces - copyHtmlBits odir libdir css_file - - when (Flag_GenContents `elem` flags && Flag_GenIndex `elem` flags) $ do - ppHtmlHelpFiles title package visible_read_ifaces odir maybe_html_help_format pkg_paths - - parsed_mods <- mapM parse_file files - - sorted_mod_files <- sortModules (zip parsed_mods files) - -- emits an error message if there are recursive modules - - -- process the modules in sorted order, building up a mapping from - -- modules to interfaces. - let - loop mod_env ifaces [] = return (reverse ifaces) - loop mod_env ifaces ((hsmod,file):mdls) = do - let (iface,msgs) = runWriter $ - mkInterfacePhase1 flags verbose mod_env file package hsmod - new_mod_env = Map.insert (iface_module iface) iface mod_env - mapM_ (hPutStrLn stderr) msgs - loop new_mod_env (iface:ifaces) mdls - - let - mod_map = Map.fromList [ (iface_module iface,iface) - | iface <- read_ifaces ] - - ifaces <- loop mod_map read_ifaces sorted_mod_files - let - these_ifaces0 = [ iface | iface <- ifaces, - iface_module iface `notElem` external_mods ] - - let these_ifaces1 = attachInstances these_ifaces0 - this_doc_env = buildGlobalDocEnv these_ifaces1 - global_doc_env = this_doc_env `Map.union` - ext_doc_env `Map.union` - builtinDocEnv - - --- Now do phase 2 - let - loop2 ifaces [] = return (reverse ifaces) - loop2 ifaces (iface:rest) = do - let (iface',msgs) = runWriter $ - mkInterfacePhase2 verbose iface global_doc_env - mapM_ (hPutStrLn stderr) msgs - loop2 (iface':ifaces) rest - - these_ifaces <- loop2 [] these_ifaces1 - --- when (Flag_DocBook `elem` flags) $ --- putStr (ppDocBook odir mod_ifaces) - - - when (Flag_Debug `elem` flags) $ do - mapM_ putStrLn (map show [ (iface_module i, - Map.toAscList (iface_env i), - Map.toAscList (iface_sub i)) - | i <- these_ifaces ]) - - when (Flag_Html `elem` flags) $ do - ppHtml title package these_ifaces odir - prologue maybe_html_help_format - maybe_source_urls maybe_wiki_urls - maybe_contents_url maybe_index_url - copyHtmlBits odir libdir css_file - - when (Flag_Hoogle `elem` flags) $ do - ppHoogle package these_ifaces odir - - -- dump an interface if requested - case dump_iface of - Nothing -> return () - Just fn -> dumpInterfaces these_ifaces this_doc_env fn - -parseIfaceOption :: String -> (FilePath,FilePath) -parseIfaceOption s = - case break (==',') s of - (fpath,',':file) -> (fpath,file) - (file, _) -> ("", file) - - -updateHTMLXRefs :: [FilePath] -> [[Interface]] -> IO () -updateHTMLXRefs paths ifaces_s = - writeIORef html_xrefs_ref (Map.fromList mapping) - where - mapping = [ (iface_module iface, fpath) - | (fpath, ifaces) <- zip paths ifaces_s, - iface <- ifaces - ] - -parse_file :: FilePath -> IO HsModule -parse_file file = do - bracket - (openFile file ReadMode) - (\h -> hClose h) - (\h -> do stuff <- hGetContents h - case parse stuff (SrcLoc 1 1 file) 1 0 file [] of - Ok _ e -> return e - Failed (SrcLoc line column file) err -> die $ - file ++ ": " ++ show line ++ ":" ++ show column ++ ": " - ++ err ++ "\n" - ) - -getPrologue :: [Flag] -> IO (Maybe Doc) -getPrologue flags - = case [filename | Flag_Prologue filename <- flags ] of - [] -> return Nothing - [filename] -> do - str <- readFile filename - case parseParas (tokenise str) of - Left err -> dieMsg err - Right doc -> return (Just doc) - _otherwise -> dieMsg "multiple -p/--prologue options" - --- --------------------------------------------------------------------------- --- External packages - -getPackageIfaces :: [Flag] -> Bool -> IO [(String,String)] -getPackageIfaces flags verbose = - let - pkgs = [pkg | Flag_UsePackage pkg <- flags] - in -#if __GLASGOW_HASKELL__ < 603 - if (not (null pkgs)) - then die ("-use-package not supported; recompile Haddock with GHC 6.4 or later") - else return [] -#else - do - mb_iface_details <- mapM getPkgIface pkgs - return [ ok | Just ok <- mb_iface_details ] - where - getPkgIface pkg = do - when verbose $ - putStrLn ("querying ghc-pkg for " ++ pkg ++ "...") - getPkgIface' pkg - `catch` (\e -> do - putStrLn ("Warning: cannot use package " ++ pkg ++ ":") - putStrLn (" " ++ show e) - return Nothing) - - getPkgIface' pkg = do - html <- getPkgField pkg "haddock-html" - unless (Flag_AllowMissingHtml `elem` flags) $ do - html_exists <- doesDirectoryExist html - when (not html_exists) $ do - throwIO (ErrorCall ("HTML directory " ++ html ++ " does not exist.")) - - iface <- getPkgField pkg "haddock-interfaces" - iface_exists <- doesFileExist iface - when (not iface_exists) $ do - throwIO (ErrorCall ("interface " ++ iface ++ " does not exist.")) - - return (Just (html, iface)) - - getPkgField pkg field = do - hc_pkg <- case [ path | Flag_GhcPkg path <- flags] of - [] -> return "ghc-pkg" - [p] -> return p - _ -> die "Multiple ghc-pkg's given" - (hin,hout,herr,p) <- runInteractiveProcess hc_pkg - ["field", pkg, field] - Nothing Nothing - hClose hin - out <- hGetContents hout - forkIO (hGetContents herr >> return ()) -- just sink the stderr - r <- waitForProcess p - when (r /= ExitSuccess) $ - throwIO (ErrorCall ("ghc-pkg failed")) - let value = stripWhitespace $ tail $ dropWhile (/=':') out - when verbose $ - putStrLn (" " ++ field ++ ": " ++ value) - return value -#endif - -stripWhitespace = dropWhile isSpace . reverse . dropWhile isSpace . reverse - ------------------------------------------------------------------------------ --- Figuring out the definitions that are exported from a module - --- We're going to make interfaces in two passes: --- --- 1. Rename the code. This basically involves resolving all --- the names to "original names". --- --- 2. Convert all the entity references to "doc names". These are --- the names we want to link to in the documentation. - -mkInterfacePhase1 - :: [Flag] - -> Bool -- verbose - -> ModuleMap -> FilePath -> Maybe String -> HsModule - -> ErrMsgM Interface -- the "interface" of the module - -mkInterfacePhase1 flags verbose mod_map filename package - (HsModule (SrcLoc _ _ orig_filename) mdl exps imps decls - maybe_opts maybe_info maybe_doc) = do - - let - no_implicit_prelude = Flag_NoImplicitPrelude `elem` flags - ignore_all_exports = Flag_IgnoreAllExports `elem` flags - - -- Process the options, if available - opts0 <- case maybe_opts of - Just opt_str -> processOptions opt_str - Nothing -> return [] - let - -- check for a --hide option - Module mod_str = mdl - opts1 - | Flag_HideModule mod_str `elem` flags = OptHide : opts0 - | otherwise = opts0 - opts - | Flag_IgnoreAllExports `elem` flags = OptIgnoreExports : opts1 - | otherwise = opts1 - - let - -- expand type signatures with multiple variables into multiple - -- type signatures - expanded_decls = concat (map expandDecl decls) - - sub_map = mkSubNames expanded_decls - - -- first, attach documentation to declarations - annotated_decls = collectDoc expanded_decls - - -- now find the defined names - locally_defined_names = collectNames annotated_decls - - qual_local_names = map (Qual mdl) locally_defined_names - unqual_local_names = map UnQual locally_defined_names - - local_orig_env = Map.fromList (zip unqual_local_names qual_local_names ++ - zip qual_local_names qual_local_names) - -- both qualified and unqualifed names are in scope for local things - - implicit_imps - | no_implicit_prelude || any is_prel_import imps = imps - | otherwise = HsImportDecl loc prelude_mod False Nothing Nothing : imps - where - loc = SrcLoc 0 0 "" - is_prel_import (HsImportDecl _ mdl0 _ _ _ ) = mdl0 == prelude_mod - -- in - - -- build the orig_env, which maps names to *original* names (so we can - -- find the original declarations & docs for things). - imported_orig_env <- buildOrigEnv mdl verbose mod_map implicit_imps - - let - orig_env = local_orig_env `Map.union` imported_orig_env - - -- convert names in source code to original, fully qualified, names - (orig_exports, missing_names1) - = runRnFM orig_env (mapMaybeM renameExportList exps) - - (orig_decls, missing_names2) - = runRnFM orig_env (mapM renameDecl annotated_decls) - - (orig_module_doc, missing_names3) - = runRnFM orig_env (renameMaybeDoc maybe_doc) - - decl_map :: Map HsName HsDecl - decl_map = Map.fromList [ (n,d) | d <- orig_decls, n <- declBinders d ] - - instances = [ d | d@HsInstDecl{} <- orig_decls ] ++ - [ d | decl <- orig_decls, d <- derivedInstances mdl decl] - - -- trace (show (Map.toAscList orig_env)) $ do - - -- gather up a list of entities that are exported (original names) - (exported_names, exported_visible_names) - <- exportedNames mdl mod_map - locally_defined_names orig_env sub_map - orig_exports opts - - let - -- maps exported HsNames to orig HsQNames - name_env = Map.fromList [ (nameOfQName n, n) | n <- exported_names ] - - -- find the names exported by this module that other modules should *not* - -- link to. - reexports = [ nm | n@(Qual _ nm) <- exported_names, - n `notElem` exported_visible_names ] - - -- in - - -- make the "export items", which will be converted into docs later - orig_export_items <- mkExportItems mod_map mdl exported_names decl_map sub_map - orig_decls opts orig_exports - ignore_all_exports - let - -- prune the export list to just those declarations that have - -- documentation, if the 'prune' option is on. - pruned_export_list - | OptPrune `elem` opts = pruneExportItems orig_export_items - | otherwise = orig_export_items - -- in - - -- report any names we couldn't find/resolve - let - missing_names = missing_names1 ++ missing_names2 ++ missing_names3 - --ignore missing_names3 & missing_names5 for now - filtered_missing_names = filter (`notElem` builtinNames) missing_names - - name_strings = nub (map show filtered_missing_names) - -- in - - when (OptHide `notElem` opts && - not (null name_strings)) $ - tell ["Warning: " ++ show mdl ++ - ": the following names could not be resolved:\n"++ - " " ++ concat (map (' ':) name_strings) - ] - - return (Interface { - iface_filename = filename, - iface_orig_filename= orig_filename, - iface_module = mdl, - iface_package = package, - iface_env = name_env, - iface_reexported = reexports, - iface_sub = sub_map, - iface_orig_exports = pruned_export_list, - iface_decls = decl_map, - iface_info = maybe_info, - iface_doc = orig_module_doc, - iface_options = opts, - iface_exports = error "iface_exports", - iface_insts = instances - } - ) - --- ----------------------------------------------------------------------------- --- Phase 2 - -mkInterfacePhase2 - :: Bool -- verbose - -> Interface - -> Map HsQName HsQName -- global doc-name mapping - -> ErrMsgM Interface - -mkInterfacePhase2 verbose iface gbl_doc_env = - case iface of { - Interface { - iface_module = this_mdl, - iface_env = env, - iface_reexported = reexports, - iface_orig_exports = orig_export_items, - iface_doc = orig_module_doc } -> - - let - exported_visible_names = - [orig | (nm,orig) <- Map.toAscList env, nm `notElem` reexports ] - - -- build the import_env. - import_env = foldl fn gbl_doc_env exported_visible_names - where fn env qnm@(Qual _ nm) = Map.insert qnm (Qual this_mdl nm) env - fn env (UnQual nm) = env - - -- rename names in the exported declarations to point to things that - -- are closer, or maybe even exported by, the current module. - (renamed_export_list, missing_names1) - = runRnUnqualFM import_env (renameExportItems orig_export_items) - - (final_module_doc, missing_names2) - = runRnUnqualFM import_env (renameMaybeDoc orig_module_doc) - - -- we're only interested in reporting missing *qualfied* - -- names, the unqualified ones are the ones that couldn't - -- be resolved in phase 1 and have already been reported. - filtered_missing_names = - filter isQual (missing_names1 ++ missing_names2) - where isQual (Qual _ _) = True - isQual _ = False - - missing_names = map show (nub filtered_missing_names) - in do - - -- report things that we couldn't link to. Only do this - -- for non-hidden modules. - when (OptHide `notElem` iface_options iface && - not (null missing_names)) $ - tell ["Warning: " ++ show this_mdl ++ - ": could not find link destinations for:\n"++ - " " ++ concat (map (' ':) missing_names) - ] - - -- trace (show (Map.toAscList import_env)) $ do - - return iface{ iface_exports = renamed_export_list, - iface_doc = final_module_doc } - } - --- ----------------------------------------------------------------------------- - --- Try to generate instance declarations for derived instances. --- We can't do this properly without instance inference, but if a type --- variable occurs as a constructor argument, then we can just --- propagate the derived class to the variable. But we know nothing of --- the constraints on any type variables that occur elsewhere. --- Note that a type variable may be in both categories: then we know a --- constraint, but there may be more, or a stronger constraint. -derivedInstances :: Module -> HsDecl -> [HsDecl] -derivedInstances mdl decl = case decl of - HsDataDecl srcloc ctxt n tvs cons drv@(_:_) _ -> - derived srcloc ctxt n tvs cons drv - HsNewTypeDecl srcloc ctxt n tvs con drv@(_:_) _ -> - derived srcloc ctxt n tvs [con] drv - _ -> [] - where - derived srcloc ctxt n tvs cons drv = - [HsInstDecl srcloc - (ctxt ++ [(cls,[t]) | t <- simple_args] ++ extra_constraint) - (cls,[lhs]) [] | - cls <- drv] - where - targs = map stripDocs (targsConstrs cons) - -- an argument of a data constructor is simple if it has a variable head - simple_args = nub $ filter varHead targs - -- a type variable is complex if it occurs inside a data constructor - -- argument, except where the argument is identical to the lhs. - complex_tvars = map HsTyVar $ Set.elems $ Set.unions $ map tvarsType $ - filter (/= lhs) $ filter (not . varHead) targs - varHead (HsTyVar _) = True - varHead (HsTyApp t _) = varHead t - varHead (HsTyDoc t _) = varHead t - varHead _ = False - extra_constraint - | null complex_tvars = [] - | otherwise = [(unknownConstraint,complex_tvars)] - lhs - | n == tuple_tycon_name (length tvs - 1) = - HsTyTuple True (map HsTyVar tvs) - | otherwise = foldl HsTyApp (HsTyCon (Qual mdl n)) (map HsTyVar tvs) - - -- collect type arguments of constructors - targsConstrs :: [HsConDecl] -> [HsType] - targsConstrs = foldr targsConstr [] - - targsConstr :: HsConDecl -> [HsType] -> [HsType] - targsConstr (HsConDecl _ _ _ _ bts _) ts = foldr targsBangType ts bts - targsConstr (HsRecDecl _ _ _ _ fs _) ts = foldr targsField ts fs - - targsField (HsFieldDecl _ bt _) = targsBangType bt - - targsBangType (HsBangedTy t) ts = t : ts - targsBangType (HsUnBangedTy t) ts = t : ts - - -- remove documentation comments from a type - stripDocs :: HsType -> HsType - stripDocs (HsForAllType n ctxt t) = HsForAllType n ctxt (stripDocs t) - stripDocs (HsTyFun t1 t2) = HsTyFun (stripDocs t1) (stripDocs t2) - stripDocs (HsTyTuple boxed ts) = HsTyTuple boxed (map stripDocs ts) - stripDocs (HsTyApp t1 t2) = HsTyApp (stripDocs t1) (stripDocs t2) - stripDocs (HsTyDoc t _) = stripDocs t - stripDocs (HsTyIP n t) = HsTyIP n (stripDocs t) - stripDocs t = t - - -- collect the type variables occurring free in a type - tvarsType (HsForAllType (Just tvs) _ t) = foldl (flip Set.delete) (tvarsType t) tvs - tvarsType (HsForAllType Nothing _ t) = tvarsType t - tvarsType (HsTyFun t1 t2) = tvarsType t1 `Set.union` tvarsType t2 - tvarsType (HsTyTuple _ ts) = Set.unions (map tvarsType ts) - tvarsType (HsTyApp t1 t2) = tvarsType t1 `Set.union` tvarsType t2 - tvarsType (HsTyVar tv) = Set.singleton tv - tvarsType (HsTyCon _) = Set.empty - tvarsType (HsTyDoc t _) = tvarsType t - tvarsType (HsTyIP _ t) = tvarsType t - -unknownConstraint :: HsQName -unknownConstraint = UnQual (HsTyClsName (HsIdent "???")) - --- ----------------------------------------------------------------------------- --- Build the list of items that will become the documentation, from the --- export list. At this point, the list of ExportItems is in terms of --- original names. - -mkExportItems - :: ModuleMap - -> Module -- this module - -> [HsQName] -- exported names (orig) - -> Map HsName HsDecl -- maps local names to declarations - -> Map HsName [HsName] -- sub-map for this module - -> [HsDecl] -- decls in the current module - -> [DocOption] - -> Maybe [HsExportSpec] - -> Bool -- --ignore-all-exports flag - -> ErrMsgM [ExportItem] - -mkExportItems mod_map this_mod exported_names decl_map sub_map decls - opts maybe_exps ignore_all_exports - | isNothing maybe_exps - || ignore_all_exports - || OptIgnoreExports `elem` opts - = everything_local_exported - | Just specs <- maybe_exps - = do - exps <- mapM lookupExport specs - return (concat exps) - where - everything_local_exported = -- everything exported - return (fullContentsOfThisModule this_mod decls) - - lookupExport (HsEVar x) = declWith x - lookupExport (HsEAbs t) = declWith t - lookupExport (HsEThingAll t) = declWith t - lookupExport (HsEThingWith t cs) = declWith t - lookupExport (HsEModuleContents m) = fullContentsOf m - lookupExport (HsEGroup lev doc) = return [ ExportGroup lev "" doc ] - lookupExport (HsEDoc doc) = return [ ExportDoc doc ] - lookupExport (HsEDocNamed str) - = do r <- findNamedDoc str decls - case r of - Nothing -> return [] - Just found -> return [ ExportDoc found ] - - declWith :: HsQName -> ErrMsgM [ ExportItem ] - declWith (UnQual _) = return [] - declWith t@(Qual mdl x) - | Just decl <- findDecl t - = return [ ExportDecl t (restrictTo subs (extractDecl x mdl decl)) [] ] - | otherwise - = return [ ExportNoDecl t t (map (Qual mdl) subs) ] - -- can't find the decl (it might be from another package), but let's - -- list the entity anyway. Later on, the renamer will change the - -- orig name into the import name, so we get a proper link to - -- the doc for this entity. - where - subs = map nameOfQName subs_qnames - subs_qnames = filter (`elem` exported_names) all_subs_qnames - - all_subs_qnames = map (Qual mdl) all_subs - - all_subs | mdl == this_mod = Map.findWithDefault [] x sub_map - | otherwise = all_subs_of_qname mod_map t - - fullContentsOf m - | m == this_mod = return (fullContentsOfThisModule this_mod decls) - | otherwise = - case Map.lookup m mod_map of - Just iface - | OptHide `elem` iface_options iface - -> return (iface_orig_exports iface) - | otherwise -> return [ ExportModule m ] - Nothing -> return [] -- already emitted a warning in exportedNames - - findDecl :: HsQName -> Maybe HsDecl - findDecl (UnQual _) - = Nothing -- must be a name we couldn't resolve - findDecl (Qual m n) - | m == this_mod = Map.lookup n decl_map - | otherwise = - case Map.lookup m mod_map of - Just iface -> Map.lookup n (iface_decls iface) - Nothing -> Nothing - -fullContentsOfThisModule :: Module -> [HsDecl] -> [ExportItem] -fullContentsOfThisModule mdl decls = - map mkExportItem (filter keepDecl decls) - where mkExportItem (HsDocGroup _ lev doc) = ExportGroup lev "" doc - mkExportItem decl = ExportDecl (Qual mdl x) decl [] - where Just x = declMainBinder decl - -keepDecl :: HsDecl -> Bool -keepDecl HsTypeSig{} = True -keepDecl HsTypeDecl{} = True -keepDecl HsNewTypeDecl{} = True -keepDecl HsDataDecl{} = True -keepDecl HsClassDecl{} = True -keepDecl HsDocGroup{} = True -keepDecl HsForeignImport{} = True -keepDecl _ = False - --- Sometimes the declaration we want to export is not the "main" declaration: --- it might be an individual record selector or a class method. In these --- cases we have to extract the required declaration (and somehow cobble --- together a type signature for it...) - -extractDecl :: HsName -> Module -> HsDecl -> HsDecl -extractDecl name mdl decl - | Just n <- declMainBinder decl, n == name = decl - | otherwise = - case decl of - HsClassDecl _ _ n tvs _ decls _ -> - case [ d | d@HsTypeSig{} <- decls, - declMainBinder d == Just name ] of - [d0] -> extractClassDecl n mdl tvs d0 - _ -> error "internal: extractDecl" - - HsDataDecl _ _ t tvs cons _ _ -> - extractRecSel name mdl t tvs cons - - HsNewTypeDecl _ _ t tvs con _ _ -> - extractRecSel name mdl t tvs [con] - - _ -> error ("extractDecl: " ++ show decl) - -extractClassDecl :: HsName -> Module -> [HsName] -> HsDecl -> HsDecl -extractClassDecl c mdl tvs0 (HsTypeSig loc [n] ty doc) - = case ty of - HsForAllType tvs ctxt' ty' -> - HsTypeSig loc [n] (HsForAllType tvs (ctxt ++ ctxt') ty') doc - _ -> - HsTypeSig loc [n] (HsForAllType Nothing ctxt ty) doc - where - ctxt = [HsAssump (Qual mdl c, map HsTyVar tvs0)] -extractClassDecl _ _ _ d = - error $ "Main.extractClassDecl: unexpected decl: " ++ show d - -extractRecSel :: HsName -> Module -> HsName -> [HsName] -> [HsConDecl] - -> HsDecl -extractRecSel _ _ _ _ [] = error "extractRecSel: selector not found" -extractRecSel nm mdl t tvs (d@(HsConDecl{}):rest) = - extractRecSel nm mdl t tvs rest -extractRecSel nm mdl t tvs (HsRecDecl loc _ _tvs _ fields _mb_doc : rest) - | (HsFieldDecl ns ty mb_doc : _) <- matching_fields - = HsTypeSig loc [nm] (HsTyFun data_ty (unbang ty)) mb_doc - | otherwise = extractRecSel nm mdl t tvs rest - where - matching_fields = [ f | f@(HsFieldDecl ns ty mb_doc) <- fields, - nm `elem` ns ] - - data_ty = foldl HsTyApp (HsTyCon (Qual mdl t)) (map HsTyVar tvs) - --- ----------------------------------------------------------------------------- --- Pruning - -pruneExportItems :: [ExportItem] -> [ExportItem] -pruneExportItems items = filter has_doc items - where has_doc (ExportDecl _ d _) = isJust (declDoc d) - has_doc _ = True - --- ----------------------------------------------------------------------------- --- Make a sub-name map for this module - -mkSubNames :: [HsDecl] -> Map HsName [HsName] -mkSubNames decls = - Map.fromList [ (n, subs) | d <- decls, - Just n <- [declMainBinder d], - subs@(_:_) <- [declSubBinders d] ] - --- ----------------------------------------------------------------------------- --- Gather a list of original names exported from this module - -exportedNames :: Module -> ModuleMap -> [HsName] - -> Map HsQName HsQName - -> Map HsName [HsName] - -> Maybe [HsExportSpec] - -> [DocOption] - -> ErrMsgM ([HsQName], [HsQName]) - -exportedNames mdl mod_map local_names orig_env sub_map maybe_exps opts - | Nothing <- maybe_exps - = return all_local_names_pr - | OptIgnoreExports `elem` opts - = return all_local_names_pr - | Just expspecs <- maybe_exps - = do all_names <- mapM extract expspecs - all_vis_names <- mapM extract_vis expspecs - return (concat all_names, concat all_vis_names) - where - all_local_names = map (Qual mdl) local_names - all_local_names_pr = (all_local_names,all_local_names) - - in_scope = Set.fromList (Map.elems orig_env) - - extract e = - case e of - HsEVar x -> return [x] - HsEAbs t -> return [t] - HsEThingAll t@(Qual m x) -> - return (t : filter (`Set.member` in_scope) (map (Qual m) all_subs)) - where - all_subs | m == mdl = Map.findWithDefault [] x sub_map - | otherwise = all_subs_of_qname mod_map t - - HsEThingWith t cs -> return (t : cs) - HsEModuleContents m - | m == mdl -> return (map (Qual mdl) local_names) - | otherwise -> - case Map.lookup m mod_map of - Just iface -> - return (filter (`Set.member` in_scope) (Map.elems (iface_env iface))) - Nothing -> - do tell (exportModuleMissingErr mdl m) - return [] - _ -> return [] - - -- Just the names that will be visible in the documentation - -- (ie. omit names exported via a 'module M' export, if we are just - -- going to cross-reference the module). - extract_vis e = - case e of - HsEModuleContents m - | m == mdl -> return (map (Qual mdl) local_names) - | otherwise -> - case Map.lookup m mod_map of - Just iface - | OptHide `elem` iface_options iface -> - return (filter (`Set.member` in_scope) (Map.elems (iface_env iface))) - | otherwise -> return [] - Nothing - -> return [] -- we already emitted a warning above - - -- remaining cases: we have to catch names which are reexported from - -- here, but for which we have no documentation, perhaps because they - -- are from another package. We have to do this by looking for - -- the declaration in the other module. - _ -> do xs <- extract e - return (filter is_documented_here xs) - - is_documented_here (UnQual _) = False - is_documented_here (Qual m n) - | m == mdl = True -- well, it's not documented anywhere else! - | otherwise = - case Map.lookup m mod_map of - Nothing -> False - Just iface -> isJust (Map.lookup n (iface_decls iface)) - -exportModuleMissingErr this mdl - = ["Warning: in export list of " ++ show this - ++ ": module not found: " ++ show mdl] - --- for a given entity, find all the names it "owns" (ie. all the --- constructors and field names of a tycon, or all the methods of a --- class). -all_subs_of_qname :: ModuleMap -> HsQName -> [HsName] -all_subs_of_qname mod_map (Qual mdl nm) = - case Map.lookup mdl mod_map of - Just iface -> Map.findWithDefault [] nm (iface_sub iface) - Nothing -> [] -all_subs_of_qname _ n@(UnQual _) = - error $ "Main.all_subs_of_qname: unexpected unqual'd name:" ++ show n - --- ---------------------------------------------------------------------------- --- Building name environments - --- The orig env maps names in the current source file to --- fully-qualified "original" names. - -buildOrigEnv :: Module -> Bool -> ModuleMap -> [HsImportDecl] - -> ErrMsgM (Map HsQName HsQName) -buildOrigEnv this_mdl verbose mod_map imp_decls - = do maps <- mapM build imp_decls - return (Map.unions (reverse maps)) - where - build imp_decl@(HsImportDecl _ mdl qual maybe_as _) - = case Map.lookup mdl mod_map of - Nothing -> do - when verbose $ - -- only emit missing module messages when -v is on. Otherwise - -- we get a ton of spurious messages about missing "Prelude". - tell ["Warning: " ++ show this_mdl - ++ ": imported module not found: " ++ show mdl] - return Map.empty - Just iface -> - return (Map.fromList (concat (map orig_map - (processImportDecl mod_map imp_decl)))) - where - - -- bring both qualified and unqualified names into scope, unless - -- the import was 'qualified'. - orig_map (nm,qnm) - | qual = [ (Qual qual_module nm, qnm) ] - | otherwise = [ (Qual qual_module nm, qnm), (UnQual nm, qnm) ] - - qual_module - | Just m <- maybe_as = m - | otherwise = mdl - - -processImportDecl :: ModuleMap -> HsImportDecl -> [(HsName,HsQName)] -processImportDecl mod_map (HsImportDecl _ mdl is_qualified maybe_as imp_specs) - = case Map.lookup mdl mod_map of - Nothing -> [] - Just iface -> imported_names - where - env = iface_env iface - sub = iface_sub iface - - all_names = Map.toAscList env - - imported_names :: [(HsName,HsQName)] - imported_names - = case imp_specs of - Nothing -> all_names - Just (False,specs) -> [ (n,qnm) | (n,qnm) <- all_names, - n `elem` names specs False ] - Just (True, specs) -> [ (n,qnm) | (n,qnm) <- all_names, - n `notElem` names specs True ] - where - names specs is_hiding - = concat (map (spec_names is_hiding) specs) - - -- when hiding, a conid refers to both the constructor and - -- the type/class constructor. - spec_names _hid (HsIVar v) = [v] - spec_names True (HsIAbs (HsTyClsName i)) - = [HsTyClsName i, HsVarName i] - spec_names False (HsIAbs v) = [v] - spec_names _hid (HsIThingAll v) = v : sub_names v - spec_names _hid (HsIThingWith v xs) = v : xs - - sub_names :: HsName -> [HsName] - sub_names nm = - case Map.lookup nm env of - Just qnm -> filter (`Map.member` env) (all_subs_of_qname mod_map qnm) - _ -> [] - --- ----------------------------------------------------------------------------- - --- | Build a mapping which for each original name, points to the "best" --- place to link to in the documentation. For the definition of --- "best", we use "the module nearest the bottom of the dependency --- graph which exports this name", not including hidden modules. When --- there are multiple choices, we pick a random one. --- --- The interfaces are passed in in topologically sorted order, but we start --- by reversing the list so we can do a foldl. --- -buildGlobalDocEnv :: [Interface] -> Map HsQName HsQName -buildGlobalDocEnv ifaces - = foldl upd Map.empty (reverse ifaces) - where - upd old_env iface - | OptHide `elem` iface_options iface - = old_env - | OptNotHome `elem` iface_options iface - = foldl' keep_old old_env exported_names - | otherwise - = foldl' keep_new old_env exported_names - where - mdl = iface_module iface - exported_names = filter not_reexported (Map.elems (iface_env iface)) - - not_reexported (Qual _ n) = n `notElem` iface_reexported iface - not_reexported (UnQual n) = n `notElem` iface_reexported iface - -- UnQual probably shouldn't happen - - keep_old env qnm = Map.insertWith (\new old -> old) - qnm (Qual mdl nm) env - where nm = nameOfQName qnm - keep_new env qnm = Map.insert qnm (Qual mdl nm) env - where nm = nameOfQName qnm - -builtinDocEnv = Map.fromList (map (\a -> (a,a)) builtinNames) - --- These names cannot be explicitly exported, so we need to treat --- them specially. -builtinNames = - [unit_tycon_qname, fun_tycon_qname, list_tycon_qname, - unit_con_name, nil_con_name] - --- ----------------------------------------------------------------------------- --- Expand multiple type signatures - -expandDecl :: HsDecl -> [HsDecl] -expandDecl (HsTypeSig loc fs qt doc) = [ HsTypeSig loc [f] qt doc | f <- fs ] -expandDecl (HsClassDecl loc ctxt n tvs fds decls doc) - = [ HsClassDecl loc ctxt n tvs fds (concat (map expandDecl decls)) doc ] -expandDecl d = [ d ] - ------------------------------------------------------------------------------ --- Collecting documentation and attach it to the right declarations - -collectDoc :: [HsDecl] -> [HsDecl] -collectDoc decls = collect Nothing DocEmpty decls - -collect :: Maybe HsDecl -> GenDoc [HsQName] -> [HsDecl] -> [HsDecl] -collect d doc_so_far [] = - case d of - Nothing -> [] - Just d0 -> finishedDoc d0 doc_so_far [] - -collect d doc_so_far (decl:ds) = - case decl of - HsDocCommentNext _ str -> - case d of - Nothing -> collect d (docAppend doc_so_far str) ds - Just d0 -> finishedDoc d0 doc_so_far (collect Nothing str ds) - - HsDocCommentPrev _ str -> collect d (docAppend doc_so_far str) ds - - _other -> - let decl' = collectInDecl decl in - case d of - Nothing -> collect (Just decl') doc_so_far ds - Just d0 -> finishedDoc d0 doc_so_far - (collect (Just decl') DocEmpty ds) - -finishedDoc :: HsDecl -> GenDoc [HsQName] -> [HsDecl] -> [HsDecl] -finishedDoc d DocEmpty rest = d : rest -finishedDoc d doc rest = d' : rest - where d' = - case d of - HsTypeDecl loc n ns ty _ -> - HsTypeDecl loc n ns ty (Just doc) - HsDataDecl loc ctxt n ns cons drv _ -> - HsDataDecl loc ctxt n ns cons drv (Just doc) - HsNewTypeDecl loc ctxt n ns con drv _ -> - HsNewTypeDecl loc ctxt n ns con drv (Just doc) - HsClassDecl loc ctxt n tvs fds meths _ -> - HsClassDecl loc ctxt n tvs fds meths (Just doc) - HsTypeSig loc ns ty _ -> - HsTypeSig loc ns ty (Just doc) - HsForeignImport loc cc sf str n ty _ -> - HsForeignImport loc cc sf str n ty (Just doc) - _other -> d - -collectInDecl :: HsDecl -> HsDecl -collectInDecl (HsClassDecl loc ctxt n tvs fds meths doc) - = HsClassDecl loc ctxt n tvs fds (collect Nothing DocEmpty meths) doc -collectInDecl decl - = decl - --- ----------------------------------------------------------------------------- --- Named documentation - -findNamedDoc :: String -> [HsDecl] -> ErrMsgM (Maybe Doc) -findNamedDoc name decls = search decls - where search [] = do - tell ["Cannot find documentation for: $" ++ name] - return Nothing - search (HsDocCommentNamed _ name' doc : rest) - | name == name' = return (Just doc) - | otherwise = search rest - search (_other_decl : rest) = search rest - --- ----------------------------------------------------------------------------- --- Haddock options embedded in the source file - -processOptions :: String -> ErrMsgM [DocOption] -processOptions str = do - case break (== ',') str of - (this, ',':rest) -> do - opt <- parseOption this - opts <- processOptions rest - return (maybeToList opt ++ opts) - (this, _) - | all isSpace this -> return [] - | otherwise -> do opt <- parseOption this; return (maybeToList opt) - -parseOption :: String -> ErrMsgM (Maybe DocOption) -parseOption "hide" = return (Just OptHide) -parseOption "prune" = return (Just OptPrune) -parseOption "ignore-exports" = return (Just OptIgnoreExports) -parseOption "not-home" = return (Just OptNotHome) -parseOption other = do tell ["Unrecognised option: " ++ other]; return Nothing - --- ----------------------------------------------------------------------------- --- Topologically sort the modules - -sortModules :: [(HsModule,FilePath)] -> IO [(HsModule,FilePath)] -sortModules mdls = fmap concat $ mapM for_each_scc sccs - where - sccs = stronglyConnComp edges - - edges :: [((HsModule,FilePath), Module, [Module])] - edges = [ ((hsmod,file), mdl, get_imps impdecls) - | (hsmod@(HsModule _ mdl _ impdecls _ _ _ _), file) <- mdls - ] - - get_imps impdecls = [ imp | HsImportDecl _ imp _ _ _ <- impdecls ] - - get_mods hsmodules = [ mdl | HsModule _ mdl _ _ _ _ _ _ <- hsmodules ] - - for_each_scc (AcyclicSCC hsmodule) = return [hsmodule] - for_each_scc (CyclicSCC hsmodules) = do - noDieMsg ("modules are recursive: " ++ - unwords (map show (get_mods (map fst hsmodules)))) - return hsmodules - --- ----------------------------------------------------------------------------- --- Collect instances and attach them to declarations - -attachInstances :: [Interface] -> [Interface] -attachInstances mod_ifaces - = map attach mod_ifaces - where - inst_map = fmap (sortImage instHead) $ collectInstances mod_ifaces - - attach iface = iface{ iface_orig_exports = new_exports } - where - new_exports = map attach_export (iface_orig_exports iface) - - attach_export (ExportDecl nm decl _) = - ExportDecl nm decl (case Map.lookup nm inst_map of - Nothing -> [] - Just instheads -> instheads) - attach_export other_export = - other_export - -collectInstances - :: [Interface] - -> Map HsQName [InstHead] -- maps class/type names to instances - -collectInstances ifaces - = Map.fromListWith (flip (++)) ty_inst_pairs `Map.union` - Map.fromListWith (flip (++)) class_inst_pairs - where - all_instances = concat (map iface_insts ifaces) - - class_inst_pairs = [ (cls, [(ctxt,(cls,args))]) - | HsInstDecl _ ctxt (cls,args) _ <- all_instances ] - - ty_inst_pairs = [ (nm, [(ctxt,(cls,args))]) - | HsInstDecl _ ctxt (cls,args) _ <- all_instances, - nm <- nub (concat (map freeTyCons args)) - ] - --- simplified type for sorting types, ignoring qualification (not visible --- in Haddock output) and unifying special tycons with normal ones. -data SimpleType = SimpleType HsName [SimpleType] deriving (Eq,Ord) - --- Sort key for instances: --- arities of arguments, to place higher-kind instances --- name of class --- type arguments -instHead :: (HsContext,(HsQName,[HsType])) -> ([Int],HsName,[SimpleType]) -instHead (ctxt,(cls,args)) - = (map argCount args, nameOfQName cls, map simplify args) - where - argCount (HsTyApp t _) = argCount t + 1 - argCount _ = 0 - - simplify (HsForAllType tvs ctxt t) = simplify t - simplify (HsTyFun t1 t2) = - SimpleType fun_tycon_name [simplify t1, simplify t2] - simplify (HsTyTuple b ts) = - SimpleType (tuple_tycon_name (length ts - 1)) (map simplify ts) - simplify (HsTyApp t1 t2) = SimpleType s (args ++ [simplify t2]) - where (SimpleType s args) = simplify t1 - simplify (HsTyVar v) = SimpleType v [] - simplify (HsTyCon n) = SimpleType (nameOfQName n) [] - simplify (HsTyDoc t _) = simplify t - simplify (HsTyIP n t) = simplify t - --- sortImage f = sortBy (\x y -> compare (f x) (f y)) -sortImage :: Ord b => (a -> b) -> [a] -> [a] -sortImage f xs = map snd $ sortBy cmp_fst [(f x, x) | x <- xs] - where cmp_fst (x,_) (y,_) = compare x y - --- ----------------------------------------------------------------------------- --- The interface file format. --- This has to read interfaces up to Haddock 0.6 (without the short --- document annotations), and interfaces afterwards, so we use the --- FormatVersion hack to work out which one the interface file contains. - -thisFormatVersion :: FormatVersion -thisFormatVersion = mkFormatVersion 2 - --- | How we store interfaces. Not everything is stored. -type StoredInterface2 = - (Module,Maybe Doc,Maybe String,Bool,[(HsName,Module)], [(HsName,[HsName])]) - --- | How we store interfaces. Not everything is stored. -type StoredInterface1 = - (Module,Maybe Doc,Maybe String,Bool,[(HsName,HsQName)],[(HsName,HsQName)], - [(HsName,[HsName])]) - --- | How we used to store interfaces. -type NullVersionStoredInterface = - (Module,Maybe String,Bool,[(HsName,HsQName)],[(HsName,HsQName)], - [(HsName,[HsName])]) - -dumpInterfaces :: [Interface] -> Map HsQName HsQName -> FilePath -> IO () -dumpInterfaces interfaces global_doc_env fileName = - do - let - preparedInterfaces :: [StoredInterface2] - preparedInterfaces = map from_interface interfaces - - bh <- openBinMem 100000 - put_ bh thisFormatVersion - put_ bh preparedInterfaces - putDocEnv bh global_doc_env - writeBinMem bh fileName - - -readIface :: FilePath -> IO ([Interface], Map HsQName HsQName) -readIface fileName = do - bh <- readBinMem fileName - formatVersion <- get bh - case formatVersion of - v | v == thisFormatVersion -> do - (stuff :: [StoredInterface2]) <- get bh - doc_env <- getDocEnv bh - return (map to_interface2 stuff, doc_env) - v | v == mkFormatVersion 1 -> do - (stuff :: [StoredInterface1]) <- get bh - return (map to_interface1 stuff, Map.empty) - v | v == nullFormatVersion -> do - (stuff :: [NullVersionStoredInterface]) <- get bh - return (map nullVersion_to_interface stuff, Map.empty) - otherwise -> do - noDieMsg ( - "Warning: The interface file " ++ show fileName - ++ " could not be read.\n" - ++ "Maybe it's from a later version of Haddock?\n") - return ([], Map.empty) - -from_interface :: Interface -> StoredInterface2 -from_interface iface = - ( iface_module iface, - toDescription iface,iface_package iface, - OptHide `elem` iface_options iface, - [(n,mdl) | (n,Qual mdl n') <- Map.toAscList (iface_env iface), - if n /= n' then error "help!" else True], - Map.toAscList (iface_sub iface) - ) - -getDocEnv :: BinHandle -> IO (Map HsQName HsQName) -getDocEnv bh = do - doc_env_list <- get bh - return (Map.fromList [(Qual mdl1 nm,Qual mdl2 nm) | - (mdl1,nm,mdl2) <- doc_env_list]) - -putDocEnv :: BinHandle -> Map HsQName HsQName -> IO () -putDocEnv bh env = do - let doc_env_list = - [(mdl1,nm,mdl2) | (Qual mdl1 nm, Qual mdl2 _) <- Map.toAscList env] - put_ bh doc_env_list - - -to_interface1 :: StoredInterface1 -> Interface -to_interface1 (mdl,descriptionOpt,package, hide, env, _, sub) = - Interface { - iface_module = mdl, - iface_filename = "", - iface_orig_filename= "", - iface_package = package, - iface_env = Map.fromList env, - iface_sub = Map.fromList sub, - iface_reexported = [], - iface_exports = [], - iface_orig_exports = [], - iface_insts = [], - iface_decls = Map.empty, - iface_info = toModuleInfo descriptionOpt, - iface_doc = Nothing, - iface_options = if hide then [OptHide] else [] - } - -to_interface2 :: StoredInterface2 -> Interface -to_interface2 (mdl,descriptionOpt,package, hide, env, sub) = - Interface { - iface_module = mdl, - iface_filename = "", - iface_orig_filename= "", - iface_package = package, - iface_env = - Map.fromList [(n,Qual mdl n) | (n,mdl) <- env], - iface_sub = Map.fromList sub, - iface_reexported = [], - iface_exports = [], - iface_orig_exports = [], - iface_insts = [], - iface_decls = Map.empty, - iface_info = toModuleInfo descriptionOpt, - iface_doc = Nothing, - iface_options = if hide then [OptHide] else [] - } - -nullVersion_to_interface :: NullVersionStoredInterface -> Interface -nullVersion_to_interface (mdl, package, hide, env, reexported, sub) = - Interface { - iface_module = mdl, - iface_filename = "", - iface_orig_filename= "", - iface_package = package, - iface_env = Map.fromList env, - iface_sub = Map.fromList sub, - iface_reexported = [], - iface_exports = [], - iface_orig_exports = [], - iface_insts = [], - iface_decls = Map.empty, - iface_info = emptyModuleInfo, - iface_doc = Nothing, - iface_options = if hide then [OptHide] else [] - } - -toModuleInfo :: Maybe Doc -> ModuleInfo -toModuleInfo descriptionOpt = - emptyModuleInfo {description = descriptionOpt} - - - --- ----------------------------------------------------------------------------- --- A monad which collects error messages - -type ErrMsg = String -newtype ErrMsgM a = Writer { runWriter :: (a, [ErrMsg]) } - -instance Monad ErrMsgM where - return a = Writer (a, []) - m >>= k = Writer $ let - (a, w) = runWriter m - (b, w') = runWriter (k a) - in (b, w ++ w') - -tell :: [ErrMsg] -> ErrMsgM () -tell w = Writer ((), w) +-- +-- Haddock - A Haskell Documentation Tool +-- +-- (c) Simon Marlow 2003 +-- +-- Ported to use the GHC API by David Waern during "Summer of Code" 2006 +-- + + +module Main (main) where + + +import Haddock.Comments +import Haddock.Backends.Html +import Haddock.Backends.Hoogle +import Haddock.Interface +import Haddock.Types hiding (NoLink) +import Haddock.Version +import Haddock.InterfaceFile +import Haddock.Exception +import Haddock.Options +import Haddock.GHC +import Haddock.Utils +import Paths_haddock + +import Control.Monad +import Control.Exception +import Control.Exception +import Data.Dynamic +import Data.Maybe +import Data.IORef +import qualified Data.Map as Map +import System.IO +import System.Exit +import System.Environment + +import GHC +import DynFlags +import Bag +import Util (handleDyn) +import ErrUtils + + +-------------------------------------------------------------------------------- +-- Exception handling +-------------------------------------------------------------------------------- + + +handleTopExceptions = + handleNormalExceptions . handleHaddockExceptions . handleGhcExceptions + + +handleNormalExceptions inner = + handle (\exception -> do + hFlush stdout + case exception of + AsyncException StackOverflow -> do + putStrLn "stack overflow: use -g +RTS -K to increase it" + exitFailure + ExitException code -> exitWith code + _other -> do + putStrLn ("haddock: internal Haddock or GHC error: " ++ show exception) + exitFailure + ) inner + + +handleHaddockExceptions inner = + handleDyn (\(e::HaddockException) -> do + putStrLn $ "haddock: " ++ (show e) + exitFailure + ) inner + + +handleGhcExceptions inner = + -- compilation errors: messages with locations attached + handleDyn (\dyn -> do + putStrLn "haddock: Compilation error(s):" + printBagOfErrors defaultDynFlags (unitBag dyn) + exitFailure + ) $ + + -- error messages propagated as exceptions + handleDyn (\dyn -> do + hFlush stdout + case dyn of + PhaseFailed _ code -> exitWith code + Interrupted -> exitFailure + _ -> do + print (dyn :: GhcException) + exitFailure + ) inner + + +------------------------------------------------------------------------------- +-- Top level +------------------------------------------------------------------------------- + + +main :: IO () +main = handleTopExceptions $ do + + -- parse command-line flags and handle some of them initially + args <- getArgs + (flags, fileArgs) <- parseHaddockOpts args + handleEasyFlags flags fileArgs + + let renderStep packages interfaces = do + updateHTMLXRefs packages + let ifaceFiles = map fst packages + installedIfaces = concatMap ifInstalledIfaces ifaceFiles + render flags interfaces installedIfaces + + if not (null fileArgs) + then do + -- initialize GHC + libDir <- getGhcLibDir flags + (session, dynflags) <- startGhc libDir (ghcFlags flags) + + -- get packages supplied with --read-interface + packages <- readInterfaceFiles (Just session) (ifacePairs flags) + + -- typecheck argument modules using GHC + modules <- typecheckFiles session fileArgs + + -- combine the link envs of the external packages into one + let extLinks = Map.unions (map (ifLinkEnv . fst) packages) + + -- create the interfaces -- this is the core part of Haddock + let (interfaces, homeLinks, messages) = createInterfaces modules extLinks flags + mapM_ putStrLn messages + + -- render the interfaces + renderStep packages interfaces + + -- last but not least, dump the interface file + dumpInterfaceFile (map toInstalledIface interfaces) homeLinks flags + + else do + -- get packages supplied with --read-interface + packages <- readInterfaceFiles Nothing (ifacePairs flags) + + -- render even though there are no input files (usually contents/index) + renderStep packages [] + + +------------------------------------------------------------------------------- +-- Rendering +------------------------------------------------------------------------------- + + +-- | Render the interfaces with whatever backend is specified in the flags +render :: [Flag] -> [Interface] -> [InstalledInterface] -> IO () +render flags interfaces installedIfaces = do + let + title = case [str | Flag_Heading str <- flags] of + [] -> "" + (t:_) -> t + + maybe_source_urls = (listToMaybe [str | Flag_SourceBaseURL str <- flags] + ,listToMaybe [str | Flag_SourceModuleURL str <- flags] + ,listToMaybe [str | Flag_SourceEntityURL str <- flags]) + + maybe_wiki_urls = (listToMaybe [str | Flag_WikiBaseURL str <- flags] + ,listToMaybe [str | Flag_WikiModuleURL str <- flags] + ,listToMaybe [str | Flag_WikiEntityURL str <- flags]) + + verbose = Flag_Verbose `elem` flags + + libdir <- case [str | Flag_Lib str <- flags] of + [] -> getDataDir -- provided by Cabal + fs -> return (last fs) + + let css_file = case [str | Flag_CSS str <- flags] of + [] -> Nothing + fs -> Just (last fs) + + odir <- case [str | Flag_OutputDir str <- flags] of + [] -> return "." + fs -> return (last fs) + + let + maybe_contents_url = + case [url | Flag_UseContents url <- flags] of + [] -> Nothing + us -> Just (last us) + + maybe_index_url = + case [url | Flag_UseIndex url <- flags] of + [] -> Nothing + us -> Just (last us) + + maybe_html_help_format = + case [hhformat | Flag_HtmlHelp hhformat <- flags] of + [] -> Nothing + formats -> Just (last formats) + + prologue <- getPrologue flags + + let + -- visible home-module interfaces + visibleIfaces = [ m | m <- interfaces, OptHide `notElem` (ifaceOptions m) ] + + -- *all* visible interfaces including external package modules + allVisibleIfaces = map toInstalledIface visibleIfaces + ++ installedIfaces + + packageName = (Just . modulePkgStr . ifaceMod . head) visibleIfaces + + when (Flag_GenIndex `elem` flags) $ do + ppHtmlIndex odir title packageName maybe_html_help_format + maybe_contents_url maybe_source_urls maybe_wiki_urls + allVisibleIfaces + copyHtmlBits odir libdir css_file + + when (Flag_GenContents `elem` flags && Flag_GenIndex `elem` flags) $ do + ppHtmlHelpFiles title packageName visibleIfaces odir maybe_html_help_format [] + + when (Flag_GenContents `elem` flags) $ do + ppHtmlContents odir title packageName maybe_html_help_format + maybe_index_url maybe_source_urls maybe_wiki_urls + allVisibleIfaces True prologue + copyHtmlBits odir libdir css_file + + when (Flag_Html `elem` flags) $ do + ppHtml title packageName visibleIfaces odir + prologue maybe_html_help_format + maybe_source_urls maybe_wiki_urls + maybe_contents_url maybe_index_url + copyHtmlBits odir libdir css_file + + +------------------------------------------------------------------------------- +-- Reading and dumping interface files +------------------------------------------------------------------------------- + + +readInterfaceFiles :: Maybe Session -> [(FilePath, FilePath)] -> + IO [(InterfaceFile, FilePath)] +readInterfaceFiles session pairs = do + mbPackages <- mapM tryReadIface pairs + return (catMaybes mbPackages) + where + -- try to read an interface, warn if we can't + tryReadIface (html, iface) = do + eIface <- readInterfaceFile session iface + case eIface of + Left err -> do + putStrLn ("Warning: Cannot read " ++ iface ++ ":") + putStrLn (" " ++ show err) + putStrLn "Skipping this interface." + return Nothing + Right iface -> return $ Just (iface, html) + + +dumpInterfaceFile :: [InstalledInterface] -> LinkEnv -> [Flag] -> IO () +dumpInterfaceFile ifaces homeLinks flags = + case [str | Flag_DumpInterface str <- flags] of + [] -> return () + fs -> let filename = last fs in writeInterfaceFile filename ifaceFile + where + ifaceFile = InterfaceFile { + ifInstalledIfaces = ifaces, + ifLinkEnv = homeLinks + } + + +------------------------------------------------------------------------------- +-- Misc +------------------------------------------------------------------------------- + + +getGhcLibDir flags = + case [ dir | Flag_GhcLibDir dir <- flags ] of + [] -> throwE "no GHC lib dir specified" + xs -> return $ last xs + + +handleEasyFlags flags fileArgs = do + usage <- getUsage + + when (Flag_Help `elem` flags) (bye usage) + when (Flag_Version `elem` flags) byeVersion + when (Flag_GhcVersion `elem` flags) byeGhcVersion + + when ((Flag_GenIndex `elem` flags || Flag_GenContents `elem` flags) + && Flag_Html `elem` flags) $ + throwE ("-h cannot be used with --gen-index or --gen-contents") + where + byeVersion = bye $ + "Haddock version " ++ projectVersion ++ + ", (c) Simon Marlow 2006; ported to the GHC-API by David Waern 2006-2007\n" + + byeGhcVersion = bye $ + (fromJust $ lookup "Project version" $ compilerInfo) ++ "\n" + + +updateHTMLXRefs :: [(InterfaceFile, FilePath)] -> IO () +updateHTMLXRefs packages = do + writeIORef html_xrefs_ref (Map.fromList mapping) + where + mapping = [ (instMod iface, html) | (ifaces, html) <- packages, + iface <- ifInstalledIfaces ifaces ] + + +getPrologue :: [Flag] -> IO (Maybe (HsDoc RdrName)) +getPrologue flags + = case [filename | Flag_Prologue filename <- flags ] of + [] -> return Nothing + [filename] -> do + str <- readFile filename + case parseHaddockComment str of + Left err -> throwE err + Right doc -> return (Just doc) + _otherwise -> throwE "multiple -p/--prologue options" diff --git a/src/Map.hs b/src/Map.hs deleted file mode 100644 --- a/src/Map.hs +++ /dev/null @@ -1,62 +0,0 @@ -module Map ( - Map, - member, lookup, findWithDefault, - empty, - insert, insertWith, - union, unionWith, unions, - elems, - fromList, fromListWith, - toAscList -) where - -import Prelude hiding ( lookup ) - -#if __GLASGOW_HASKELL__ >= 603 -import Data.Map -#else -import Data.FiniteMap - -type Map k a = FiniteMap k a - -instance Functor (FiniteMap k) where - fmap f = mapFM (const f) - -member :: Ord k => k -> Map k a -> Bool -member = elemFM - -lookup :: Ord k => k -> Map k a -> Maybe a -lookup = flip lookupFM - -findWithDefault :: Ord k => a -> k -> Map k a -> a -findWithDefault a k m = lookupWithDefaultFM m a k - -empty :: Map k a -empty = emptyFM - -insert :: Ord k => k -> a -> Map k a -> Map k a -insert k a m = addToFM m k a - -insertWith :: Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a -insertWith c k a m = addToFM_C (flip c) m k a - -union :: Ord k => Map k a -> Map k a -> Map k a -union = flip plusFM - -unionWith :: Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a -unionWith c l r = plusFM_C (flip c) r l - -unions :: Ord k => [Map k a] -> Map k a -unions = foldl (flip plusFM) emptyFM - -elems :: Map k a -> [a] -elems = eltsFM - -fromList :: Ord k => [(k,a)] -> Map k a -fromList = listToFM - -fromListWith :: Ord k => (a -> a -> a) -> [(k,a)] -> Map k a -fromListWith c = addListToFM_C (flip c) emptyFM - -toAscList :: Map k a -> [(k,a)] -toAscList = fmToList -#endif diff --git a/src/Set.hs b/src/Set.hs deleted file mode 100644 --- a/src/Set.hs +++ /dev/null @@ -1,32 +0,0 @@ -module Set ( - Set, - member, - empty, singleton, delete, - union, unions, - elems, fromList -) where - -import Data.Set - -#if __GLASGOW_HASKELL__ < 603 -member :: Ord a => a -> Set a -> Bool -member = elementOf - -empty :: Set a -empty = emptySet - -singleton :: a -> Set a -singleton = unitSet - -delete :: Ord a => a -> Set a -> Set a -delete = flip delFromSet - -unions :: Ord a => [Set a] -> Set a -unions = unionManySets - -elems :: Set a -> [a] -elems = setToList - -fromList :: Ord a => [a] -> Set a -fromList = mkSet -#endif