haddock 0.9 → 2.0.0.0
raw patch · 66 files changed
+6934/−16431 lines, 66 filesdep +filepathdep +ghcdep −processdep ~basedep ~haskell98setup-changednew-uploader
Dependencies added: filepath, ghc
Dependencies removed: process
Dependency ranges changed: base, haskell98
Files
- CHANGES +33/−0
- Setup.lhs +1/−2
- TODO +11/−0
- dist/build/haddock/haddock-tmp/HaddockLex.hs +0/−359
- dist/build/haddock/haddock-tmp/HaddockParse.hs +0/−715
- dist/build/haddock/haddock-tmp/HsParser.hs +0/−5021
- doc/haddock.xml +46/−166
- examples/Hidden.hs +1/−0
- examples/Test.hs +56/−58
- examples/Visible.hs +1/−0
- examples/hide-bug/B.hs +5/−1
- examples/hide-bug/C.hs +6/−1
- examples/hide-bug/D.hs +5/−1
- haddock.cabal +67/−61
- haddock.spec +1/−1
- src/Binary.hs +0/−670
- src/BlockTable.hs +0/−180
- src/Digraph.lhs +0/−419
- src/Distribution/Haddock.hs +17/−0
- src/FastMutInt.hs +0/−63
- src/Haddock/Backends/DevHelp.hs +81/−0
- src/Haddock/Backends/HH.hs +180/−0
- src/Haddock/Backends/HH2.hs +190/−0
- src/Haddock/Backends/HaddockDB.hs +165/−0
- src/Haddock/Backends/Hoogle.hs +184/−0
- src/Haddock/Backends/Html.hs +1585/−0
- src/Haddock/Comments.hs +15/−0
- src/Haddock/Exception.hs +23/−0
- src/Haddock/GHC.hs +96/−0
- src/Haddock/GHC/Typecheck.hs +84/−0
- src/Haddock/GHC/Utils.hs +89/−0
- src/Haddock/Interface.hs +90/−0
- src/Haddock/Interface/AttachInstances.hs +149/−0
- src/Haddock/Interface/Create.hs +569/−0
- src/Haddock/Interface/Rename.hs +387/−0
- src/Haddock/InterfaceFile.hs +394/−0
- src/Haddock/ModuleTree.hs +44/−0
- src/Haddock/Options.hs +153/−0
- src/Haddock/Types.hs +224/−0
- src/Haddock/Utils.hs +370/−0
- src/Haddock/Utils/BlockTable.hs +180/−0
- src/Haddock/Utils/FastMutInt2.hs +63/−0
- src/Haddock/Utils/Html.hs +1037/−0
- src/Haddock/Version.hs +18/−0
- src/HaddockDB.hs +0/−165
- src/HaddockDevHelp.hs +0/−73
- src/HaddockHH.hs +0/−168
- src/HaddockHH2.hs +0/−175
- src/HaddockHoogle.hs +0/−194
- src/HaddockHtml.hs +0/−1343
- src/HaddockLex.x +0/−172
- src/HaddockModuleTree.hs +0/−33
- src/HaddockParse.y +0/−100
- src/HaddockRename.hs +0/−287
- src/HaddockTypes.hs +0/−110
- src/HaddockUtil.hs +0/−572
- src/HaddockVersion.hs +0/−18
- src/HsLexer.lhs +0/−713
- src/HsParseMonad.lhs +0/−73
- src/HsParseUtils.lhs +0/−325
- src/HsParser.ly +0/−1031
- src/HsSyn.lhs +0/−563
- src/Html.hs +0/−1037
- src/Main.hs +314/−1467
- src/Map.hs +0/−62
- src/Set.hs +0/−32
CHANGES view
@@ -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)
Setup.lhs view
@@ -1,5 +1,4 @@-#!/usr/bin/runhaskell-+#! /usr/bin/runhaskell \begin{code} import Distribution.Simple main = defaultMain
TODO view
@@ -1,3 +1,14 @@+-----------------------------------------------------------------------------+-- Small improvements++* When no GHC can be found, give an error message that tells you to use+ --with-ghc=<path>++* 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
− dist/build/haddock/haddock-tmp/HaddockLex.hs
@@ -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 "<built-in>" #-}-{-# LINE 1 "<command line>" #-}-{-# 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
− dist/build/haddock/haddock-tmp/HaddockParse.hs
@@ -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 "<built-in>" #-}-{-# LINE 1 "<command line>" #-}-{-# 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.
− dist/build/haddock/haddock-tmp/HsParser.hs
@@ -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 "<built-in>" #-}-{-# LINE 1 "<command line>" #-}-{-# 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.
doc/haddock.xml view
@@ -16,7 +16,7 @@ <holder>Simon Marlow</holder> </copyright> <abstract>- <para>This document describes Haddock version 0.9, a Haskell+ <para>This document describes Haddock version 2.0.0.0, a Haskell documentation tool.</para> </abstract> </bookinfo>@@ -108,9 +108,7 @@ <para>Up-to-date sources can also be obtained from our public darcs repository. The Haddock sources are at- <literal>http://darcs.haskell.org/haddock</literal>. The same- server also has separate repositories for GHC, Happy, and many- other projects. See+ <literal>http://code.haskell.org/haddock</literal>. See <ulink url="http://www.darcs.net/">darcs.net</ulink> for more information on the darcs version control utility.</para> </section>@@ -205,9 +203,8 @@ </cmdsynopsis> <para>Where each <replaceable>file</replaceable> is a filename- containing a Haskell source module. Only plain Haskell source- files are accepted (but see <xref linkend="cpp"/> for instructions- on how to pre-process source files for feeding to Haddock).</para>+ containing a Haskell source module (.hs) or a Literate Haskell source+ module (.lhs) or just a module name.</para> <para>All the modules specified on the command line will be processed together. When one module refers to an entity in@@ -226,8 +223,31 @@ <para>The following options are available:</para> <variablelist>+ <varlistentry> <term>+ <indexterm><primary><option>-B</option></primary></indexterm>+ <option>-B</option> <replaceable>dir</replaceable>+ </term>+ <listitem>+ <para>Tell GHC that that its lib directory is+ <replaceable>dir</replaceable>. Needed to do any processing. </para>+ </listitem>+ </varlistentry>++ <varlistentry>+ <term>+ <indexterm><primary><option>--optghc</option></primary></indexterm>+ <option>--optghc</option>=<replaceable>option</replaceable>+ </term>+ <listitem>+ <para>Pass <replaceable>option</replaceable> to GHC.</para>+ </listitem>+ </varlistentry>+++ <varlistentry>+ <term> <indexterm><primary><option>-o</option></primary></indexterm> <option>-o</option> <replaceable>dir</replaceable> </term>@@ -276,22 +296,6 @@ <varlistentry> <term>- <indexterm><primary><option>--use-package</option></primary></indexterm>- <option>--use-package</option>=<replaceable>package</replaceable>- </term>- <listitem>- <para>Like <option>--read-interface</option>, but use- <command>ghc-pkg</command> to locate the interface file and- HTML documentation for <replaceable>package</replaceable>,- to reference when generating the documentation.</para>-- <para>Multiple <option>--use-package</option> options may- be given.</para>- </listitem>- </varlistentry>-- <varlistentry>- <term> <indexterm><primary><option>-D</option></primary></indexterm> <option>-D</option> <replaceable>file</replaceable> </term>@@ -515,13 +519,14 @@ <listitem> <para>The string <literal>%L</literal> or <literal>%{LINE}</literal> is replaced by the number of the line where the exported value or- type is defined. This is only valid for the- <option>--source-entity</option> option.</para>+ type is defined. This is only valid for the+ <option>--source-entity</option> option.</para> </listitem>- <listitem>+ <listitem> <para>The string <literal>%%</literal> is replaced by- <literal>%</literal>.</para>- </listitem>+ <literal>%</literal>.</para>+ </listitem>+ </itemizedlist> <para>For example, if your sources are online under some directory,@@ -675,22 +680,6 @@ <varlistentry> <term>- <indexterm><primary><option>-n</option></primary></indexterm>- <option>-n</option>- </term>- <term>- <indexterm><primary><option>--no-implicit-prelude</option></primary></indexterm>- <option>--no-implicit-prelude</option>- </term>- <listitem>- <para>Don't automatically import <literal>Prelude</literal>- in every module. Used when producing documentation for the- <literal>Prelude</literal> itself.</para>- </listitem>- </varlistentry>-- <varlistentry>- <term> <indexterm><primary><option>-d</option></primary></indexterm> <option>-d</option> </term>@@ -779,23 +768,6 @@ </varlistentry> <varlistentry>- <term>- <indexterm><primary><option>-k</option></primary></indexterm>- <option>-k</option> <replaceable>P</replaceable>- </term>- <term>- <indexterm><primary><option>--package</option></primary></indexterm>- <option>--package=</option><replaceable>P</replaceable>- </term>- <listitem>- <para>Set the package name for these modules to- <replaceable>P</replaceable>. In a combined index generated- with <option>--gen-index</option>, the package name for each- module is shown in the right-hand column.</para>- </listitem>- </varlistentry>-- <varlistentry> <term> <indexterm><primary><option>--ignore-all-exports</option></primary> </indexterm>@@ -822,56 +794,17 @@ atribute. (<xref linkend="module-attributes" />).</para> </listitem> </varlistentry>-- <varlistentry>- <term>- <indexterm><primary><option>--ghc-pkg</option></primary>- </indexterm>- <option>--ghc-pkg</option> <replaceable>filename</replaceable></term>- <listitem>- <para>Specifies the <literal>ghc-pkg</literal> program to run.</para>- </listitem>- </varlistentry>-- <varlistentry>- <term>- <indexterm><primary><option>--allow-missing-html</option></primary>- </indexterm>- <option>--allow-missing-html</option></term>- <listitem>- <para>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.</para>- </listitem>- </varlistentry> </variablelist> <section id="cpp"> <title>Using literate or pre-processed source</title> - <para>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 <filename>Foo.lhs</filename>, on- which we also need to run the C pre-processor:</para>--<screen>-$ ghc -cpp -E -optP-P -D__HADDOCK__ Foo.lhs -o Foo.hs-$ haddock -h Foo.hs ...-</screen>-- <para>The <option>-E</option> option to GHC says "stop after- pre-processing", the <option>-cpp</option> option turns on the C- pre-processor, the <option>-optP-P</option> option tells the C- pre-processor not to leave any extra dropping behind (see the- description of the <option>-P</option> option in the gcc manual- for details), and the <option>-D__HADDOCK__</option> option- defines the symbol <literal>__HADDOCK__</literal> 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).</para>+ <para>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>-cpp</option> option to GHC + using <option>--optghc</option>.+ </para> </section> </chapter>@@ -1347,63 +1280,25 @@ point locally to <literal>C.T</literal>.</para> </section> - <section id="deriving">- <title>Derived instances</title>-- <para>The <literal>deriving</literal> 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.</para>-- <para>One workaround for this is to use CPP (<xref linkend="cpp"- />) to give Haddock explicit instance headers. Here is an- example from the OpenGL library:</para> --<programlisting>-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-</programlisting>-- <para>As a rule of thumb, try <literal>deriving</literal> first,- and if that doesn't work then use the above workaround.</para>- </section>- <section id="module-attributes"> <title>Module Attributes</title> <para>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- <literal>-- #</literal> (or- <literal>{- # ... -}</literal>) comment at the+ module. Attributes are specified in a comma-separated list in an+ <literal>{-# OPTIONS_HADDOCK ... #-}</literal> pragma at the top of the module, either before or after the module description. For example:</para> <programlisting>--- #hide, prune, ignore-exports+{-# OPTIONS_HADDOCK hide, prune, ignore-exports #-} -- |Module description module A where ... </programlisting> - <para>The options and module description can be in either order, but- remember to separate them using a blank line if you are using the- <literal>--</literal> 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.</para>+ <para>The options and module description can be in either order.</para> <para>The following attributes are currently understood by Haddock:</para>@@ -1599,19 +1494,14 @@ <section> <title>Emphasis and Monospaced text</title> + <para>Emphasis may be added by surrounding text with+ <literal>/.../</literal>.</para>+ <para>Monospaced (or typewriter) text is indicated by surrounding it with <literal>@...@</literal>. Other markup is valid inside a monospaced span: for example <literal>@'f' a b@</literal> will hyperlink the identifier <literal>f</literal> inside the code fragment.</para>-- <para>Emphasis may be added by surrounding text with- <literal>/.../</literal>. Emphasis is limited to a single- line only; an unmatched <literal>/</literal> character on a- line is not treated as beginning emphasis (this is to reduce- accidental parse errors due to stray <literal>/</literal>- characters). Inside <literal>/.../</literal>, all characters- except <literal>/</literal> are interpreted literally.</para> </section> <section>@@ -1708,16 +1598,6 @@ <literal><...></literal>. If the output format supports it, the URL will be turned into a hyperlink when rendered.</para>- </section>-- <section>- <title>Images</title>-- <para>An image can be included in a documentation comment by- putting its URL in double angle brackets:- <literal><<...>></literal>. If the output format supports- it, the image specified by the URL will be included in the- rendered documentation at this point.</para> </section> <section>
examples/Hidden.hs view
@@ -1,3 +1,4 @@ -- #hide module Hidden where hidden :: Int -> Int+hidden a = a
examples/Test.hs view
@@ -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: <http://www.haskell.org/>. -} -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
examples/Visible.hs view
@@ -1,2 +1,3 @@ module Visible where visible :: Int -> Int+visible a = a
examples/hide-bug/B.hs view
@@ -1,1 +1,5 @@-module B(f, T) where import A+module B(Test, vis) where ++vis = id++data Test = Test
examples/hide-bug/C.hs view
@@ -1,1 +1,6 @@-module C(module B) where import B+module C(C.bla) where ++import D++bla :: Test+bla = undefined
examples/hide-bug/D.hs view
@@ -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
haddock.cabal view
@@ -1,22 +1,41 @@-name: haddock-version: 0.9-license: BSD3-license-file: LICENSE-copyright: (c) Simon Marlow-author: Simon Marlow-maintainer: Simon Marlow <simonmar@microsoft.com>-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 <david.waern@gmail.com>+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
haddock.spec view
@@ -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}
− src/Binary.hs
@@ -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
− src/BlockTable.hs
@@ -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 <andy@galconn.com>--- 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 ""
− src/Digraph.lhs
@@ -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<dv]- cs = concat [ if lw<dv then us else [Node (v:ws) us]- | (lw, Node ws us) <- collected ]-\end{code}-
+ src/Distribution/Haddock.hs view
@@ -0,0 +1,17 @@+--+-- Haddock - A Haskell Documentation Tool+--+-- (c) Simon Marlow 2003+--+++module Distribution.Haddock (+ readInterfaceFile,+ InterfaceFile(..),+ LinkEnv,+ InstalledInterface(..)+) where+++import Haddock.InterfaceFile+import Haddock.Types
− src/FastMutInt.hs
@@ -1,63 +0,0 @@-{-# OPTIONS_GHC -cpp -fglasgow-exts #-}------ (c) The University of Glasgow 2002------ Unboxed mutable Ints--module FastMutInt(- 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-
+ src/Haddock/Backends/DevHelp.hs view
@@ -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 "<?xml version=\"1.0\" encoding=\"utf-8\" standalone=\"no\"?>" $$+ (text "<book xmlns=\"http://www.devhelp.net/book\" title=\""<>text doctitle<>+ text "\" link=\""<>text contentsHtmlFile<>text"\" author=\"\" name=\""<>text package<>text "\">") $$+ text "<chapters>" $$+ nest 4 (ppModuleTree [] tree) $+$+ text "</chapters>" $$+ text "<functions>" $$+ nest 4 (ppList index) $+$+ text "</functions>" $$+ text "</book>"+ 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 "<sub"<+>ppAttribs<>text "/>"+ ts -> + text "<sub"<+>ppAttribs<>text ">" $$+ nest 4 (ppModuleTree (s:ss) ts) $+$+ text "</sub>"+ 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 "<function name=\""<>text (escapeStr (getOccString name))<>text"\" link=\""<>text (nameHtmlRef mod name)<>text"\"/>" $$+ ppReference name refs
+ src/Haddock/Backends/HH.hs view
@@ -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 "<!DOCTYPE HTML PUBLIC \"-//IETF//DTD HTML//EN\">" $$+ text "<HTML>" $$+ text "<HEAD>" $$+ text "<META name=\"GENERATOR\" content=\"Haddock\">" $$+ text "<!-- Sitemap 1.0 -->" $$+ text "</HEAD><BODY>" $$+ ppModuleTree tree $$+ text "</BODY><HTML>"+ writeFile (pathJoin [odir, contentsHHFile]) (render html)+ where+ package = fromMaybe "pkg" maybe_package+ + ppModuleTree :: [ModuleTree] -> Doc+ ppModuleTree ts =+ text "<OBJECT type=\"text/site properties\">" $$+ text "<PARAM name=\"FrameName\" value=\"main\">" $$+ text "</OBJECT>" $$+ text "<UL>" $+$+ nest 4 (text "<LI>" <> nest 4+ (text "<OBJECT type=\"text/sitemap\">" $$+ nest 4 (text "<PARAM name=\"Name\" value=\""<>text doctitle<>text "\">" $$+ text "<PARAM name=\"Local\" value=\"index.html\">") $$+ text "</OBJECT>") $+$+ text "</LI>" $$+ text "<UL>" $+$+ nest 4 (fn [] ts) $+$+ text "</UL>") $+$+ text "</UL>"++ 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 "<UL>" $+$+ nest 4 (fn (s:ss) ts) $+$+ text "</UL>"++ ppLeaf s ss isleaf =+ text "<LI>" <> nest 4+ (text "<OBJECT type=\"text/sitemap\">" $$+ text "<PARAM name=\"Name\" value=\"" <> text s <> text "\">" $$+ (if isleaf then text "<PARAM name=\"Local\" value=\"" <> text (moduleHtmlFile mdl) <> text "\">" else empty) $$+ text "</OBJECT>") $+$+ text "</LI>"+ 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 "<!DOCTYPE HTML PUBLIC \"-//IETF//DTD HTML//EN\">" $$+ text "<HTML>" $$+ text "<HEAD>" $$+ text "<META name=\"GENERATOR\" content=\"Haddock\">" $$+ text "<!-- Sitemap 1.0 -->" $$+ text "</HEAD><BODY>" $$+ text "<UL>" $+$+ nest 4 (ppList index) $+$+ text "</UL>" $$+ text "</BODY><HTML>"+ 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 "<LI>" <> nest 4+ (text "<OBJECT type=\"text/sitemap\">" $$+ text "<PARAM name=\"Name\" value=\"" <> text (show name) <> text "\">" $$+ ppReference name refs $$+ text "</OBJECT>") $+$+ text "</LI>" $$+ ppList mdls++ ppReference name [] = empty+ ppReference name (Module mdl:refs) =+ text "<PARAM name=\"Local\" value=\"" <> 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+-}
+ src/Haddock/Backends/HH2.hs view
@@ -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 "<?xml version=\"1.0\"?>" $$+ text "<!DOCTYPE HelpTOC SYSTEM \"ms-help://hx/resources/HelpTOC.DTD\">" $$+ text "<HelpTOC DTDVersion=\"1.0\">" $$+ nest 4 (text "<HelpTOCNode Title=\""<>text doctitle<>text"\" Url=\"index.html\">" $$+ nest 4 (ppModuleTree [] tree) $+$+ text "</HelpTOCNode>") $$+ text "</HelpTOC>"+ 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 "<HelpTOCNode" <+> ppAttributes leaf (s:ss) <> text "/>"+ ppNode ss (Node s leaf _pkg _short ts) =+ text "<HelpTOCNode" <+> ppAttributes leaf (s:ss) <> text ">" $$+ nest 4 (ppModuleTree (s:ss) ts) $+$+ text "</HelpTOCNode>"+ + 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 "<?xml version=\"1.0\"?>" $$+ text "<!DOCTYPE HelpIndex SYSTEM \"ms-help://hx/resources/HelpIndex.DTD\">" $$+ text "<HelpIndex DTDVersion=\"1.0\" Name=\"K\">" $$+ nest 4 (ppList index) $+$+ text "</HelpIndex>" + docN = + text "<?xml version=\"1.0\"?>" $$+ text "<!DOCTYPE HelpIndex SYSTEM \"ms-help://hx/resources/HelpIndex.DTD\">" $$+ text "<HelpIndex DTDVersion=\"1.0\" Name=\"NamedURLIndex\">" $$+ text "<Keyword Term=\"HomePage\">" $$+ nest 4 (text "<Jump Url=\""<>text contentsHtmlFile<>text "\"/>") $$+ text "</Keyword>" $$+ text "</HelpIndex>"+ 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 "<Keyword Term=\"" <> text (escapeStr (show name)) <> text "\">" $$+ nest 4 (vcat (map (ppJump name) mdls)) $$+ text "</Keyword>" $$+ ppList vs++ ppJump name (Module mdl) = text "<Jump Url=\"" <> 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 "<?xml version=\"1.0\"?>" $$+ text "<!DOCTYPE HelpFileList SYSTEM \"ms-help://hx/resources/HelpFileList.DTD\">" $$+ text "<HelpFileList DTDVersion=\"1.0\">" $$+ nest 4 (ppMods ifaces $$+ text "<File Url=\""<>text contentsHtmlFile<>text "\"/>" $$+ text "<File Url=\""<>text indexHtmlFile<>text "\"/>" $$+ ppIndexFiles chars $$+ ppLibFiles ("":pkg_paths)) $$+ text "</HelpFileList>"+ writeFile (pathJoin [odir, filesHH2File]) (render doc)+ where+ package = fromMaybe "pkg" maybe_package+ + ppMods [] = empty+ ppMods (iface:ifaces) =+ text "<File Url=\"" <> text (moduleHtmlFile mdl) <> text "\"/>" $$+ ppMods ifaces+ where Module mdl = iface_module iface+ + ppIndexFiles [] = empty+ ppIndexFiles (c:cs) =+ text "<File Url=\""<>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 "<File Url=\""<>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 "<?xml version=\"1.0\"?>" $$+ text "<!DOCTYPE HelpCollection SYSTEM \"ms-help://hx/resources/HelpCollection.DTD\">" $$+ text "<HelpCollection DTDVersion=\"1.0\" LangId=\"1033\" Title=\"" <> text doctitle <> text "\">" $$+ nest 4 (text "<CompilerOptions CreateFullTextIndex=\"Yes\">" $$+ nest 4 (text "<IncludeFile File=\"" <> text package <> text ".HxF\"/>") $$+ text "</CompilerOptions>" $$+ text "<TOCDef File=\"" <> text package <> text ".HxT\"/>" $$+ text "<KeywordIndexDef File=\"" <> text package <> text "K.HxK\"/>" $$+ text "<KeywordIndexDef File=\"" <> text package <> text "N.HxK\"/>" $$+ text "<ItemMoniker Name=\"!DefaultToc\" ProgId=\"HxDs.HxHierarchy\" InitData=\"\"/>" $$+ text "<ItemMoniker Name=\"!DefaultFullTextSearch\" ProgId=\"HxDs.HxFullTextSearch\" InitData=\"\"/>" $$+ text "<ItemMoniker Name=\"!DefaultAssociativeIndex\" ProgId=\"HxDs.HxIndex\" InitData=\"A\"/>" $$+ text "<ItemMoniker Name=\"!DefaultKeywordIndex\" ProgId=\"HxDs.HxIndex\" InitData=\"K\"/>" $$+ text "<ItemMoniker Name=\"!DefaultNamedUrlIndex\" ProgId=\"HxDs.HxIndex\" InitData=\"NamedURLIndex\"/>" $$+ text "<ItemMoniker Name=\"!SampleInfo\" ProgId=\"HxDs.HxSampleCollection\" InitData=\"\"/>") $$+ text "</HelpCollection>"+ writeFile (pathJoin [odir, collectionHH2File]) (render doc)+-}
+ src/Haddock/Backends/HaddockDB.hs view
@@ -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 "<!DOCTYPE BOOK PUBLIC \"-//OASIS//DTD DocBook V3.1//EN\" ["+ $$ text "]>"+ $$ text "<book>"+ $$ text "<bookinfo>"+ $$ text "<author><othername>HaskellDoc version 0.0</othername></author>"+ $$ text "</bookinfo>"+ $$ text "<article>"+ $$ vcat (map do_mod mods)+ $$ text "</article></book>"+ where+ do_mod (Module mod, iface)+ = text "<sect1 id=\"sec-" <> text mod <> text "\">"+ $$ text "<title><literal>" + <> text mod+ <> text "</literal></title>"+ $$ text "<indexterm><primary><literal>"+ <> text mod+ <> text "</literal></primary></indexterm>"+ $$ text "<variablelist>"+ $$ vcat (map (do_export mod) (eltsFM (iface_decls iface)))+ $$ text "</variablelist>"+ $$ text "</sect1>"+ + do_export mod decl | (nm:_) <- declBinders decl+ = text "<varlistentry id=" <> ppLinkId mod nm <> char '>'+ $$ text "<term><literal>" + <> do_decl decl+ <> text "</literal></term>"+ $$ text "<listitem>"+ $$ text "<para>"+ $$ text "</para>"+ $$ text "</listitem>"+ $$ text "</varlistentry>"+ 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 "<link linkend=" <> ppLinkId mod str <> char '>'+ <> ppHsName str+ <> text "</link>"++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 "#)"+-}
+ src/Haddock/Backends/Hoogle.hs view
@@ -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 _ = []+++-}
+ src/Haddock/Backends/Html.hs view
@@ -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 <P> (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 <P>..</P>+-- 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"]
+ src/Haddock/Comments.hs view
@@ -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++
+ src/Haddock/Exception.hs view
@@ -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
+ src/Haddock/GHC.hs view
@@ -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'
+ src/Haddock/GHC/Typecheck.hs view
@@ -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
+ src/Haddock/GHC/Utils.hs view
@@ -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
+ src/Haddock/Interface.hs view
@@ -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
+ src/Haddock/Interface/AttachInstances.hs view
@@ -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
+ src/Haddock/Interface/Create.hs view
@@ -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
+ src/Haddock/Interface/Rename.hs view
@@ -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')
+ src/Haddock/InterfaceFile.hs view
@@ -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)
+ src/Haddock/ModuleTree.hs view
@@ -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]
+ src/Haddock/Options.hs view
@@ -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"+ ]
+ src/Haddock/Types.hs view
@@ -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)
+ src/Haddock/Utils.hs view
@@ -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
+ src/Haddock/Utils/BlockTable.hs view
@@ -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 <andy@galconn.com>+ 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 ""
+ src/Haddock/Utils/FastMutInt2.hs view
@@ -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+
+ src/Haddock/Utils/Html.hs view
@@ -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 <andy@galconn.com>+-- 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+{-+ - <thetag {..attrs..}> ..content.. </thetag>+ -}+ | 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"] << ("</" ++ markupTag0 ++ ">")++-- ---------------------------------------------------------------------------+-- 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 =+ "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01 Transitional//EN\" \"http://www.w3.org/TR/html4/loose.dtd\">\n" +++ "<!--Rendered using the Haskell Html Library v0.2-->\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 "</"+ + nl = "\n" ++ replicate (n `div` 8) '\t' + ++ replicate (n `mod` 8) ' '++ rest [] = nl+ rest attr = " " ++ unwords (map showPair attr) ++ nl++ showPair :: HtmlAttr -> String+ showPair (HtmlAttr tag0 val)+ = tag0 ++ "=\"" ++ val ++ "\""+
+ src/Haddock/Version.hs view
@@ -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
− src/HaddockDB.hs
@@ -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 "<!DOCTYPE BOOK PUBLIC \"-//OASIS//DTD DocBook V3.1//EN\" ["- $$ text "]>"- $$ text "<book>"- $$ text "<bookinfo>"- $$ text "<author><othername>HaskellDoc version 0.0</othername></author>"- $$ text "</bookinfo>"- $$ text "<article>"- $$ vcat (map do_mod mods)- $$ text "</article></book>"- where- do_mod (Module mod, iface)- = text "<sect1 id=\"sec-" <> text mod <> text "\">"- $$ text "<title><literal>" - <> text mod- <> text "</literal></title>"- $$ text "<indexterm><primary><literal>"- <> text mod- <> text "</literal></primary></indexterm>"- $$ text "<variablelist>"- $$ vcat (map (do_export mod) (eltsFM (iface_decls iface)))- $$ text "</variablelist>"- $$ text "</sect1>"- - do_export mod decl | (nm:_) <- declBinders decl- = text "<varlistentry id=" <> ppLinkId mod nm <> char '>'- $$ text "<term><literal>" - <> do_decl decl- <> text "</literal></term>"- $$ text "<listitem>"- $$ text "<para>"- $$ text "</para>"- $$ text "</listitem>"- $$ text "</varlistentry>"- 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 "<link linkend=" <> ppLinkId mod str <> char '>'- <> ppHsName str- <> text "</link>"--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 "#)"--}
− src/HaddockDevHelp.hs
@@ -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 "<?xml version=\"1.0\" encoding=\"utf-8\" standalone=\"no\"?>" $$- (text "<book xmlns=\"http://www.devhelp.net/book\" title=\""<>text doctitle<>- text "\" link=\""<>text contentsHtmlFile<>text"\" author=\"\" name=\""<>text package<>text "\">") $$- text "<chapters>" $$- nest 4 (ppModuleTree [] tree) $+$- text "</chapters>" $$- text "<functions>" $$- nest 4 (ppList index) $+$- text "</functions>" $$- text "</book>"- 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 "<sub"<+>ppAttribs<>text "/>"- ts -> - text "<sub"<+>ppAttribs<>text ">" $$- nest 4 (ppModuleTree (s:ss) ts) $+$- text "</sub>"- 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 "<function name=\""<>text (escapeStr (show name))<>text"\" link=\""<>text (nameHtmlRef mdl name)<>text"\"/>" $$- ppReference name refs
− src/HaddockHH.hs
@@ -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 "<!DOCTYPE HTML PUBLIC \"-//IETF//DTD HTML//EN\">" $$- text "<HTML>" $$- text "<HEAD>" $$- text "<META name=\"GENERATOR\" content=\"Haddock\">" $$- text "<!-- Sitemap 1.0 -->" $$- text "</HEAD><BODY>" $$- ppModuleTree tree $$- text "</BODY><HTML>"- writeFile (pathJoin [odir, contentsHHFile]) (render html)- where- package = fromMaybe "pkg" maybe_package- - ppModuleTree :: [ModuleTree] -> Doc- ppModuleTree ts =- text "<OBJECT type=\"text/site properties\">" $$- text "<PARAM name=\"FrameName\" value=\"main\">" $$- text "</OBJECT>" $$- text "<UL>" $+$- nest 4 (text "<LI>" <> nest 4- (text "<OBJECT type=\"text/sitemap\">" $$- nest 4 (text "<PARAM name=\"Name\" value=\""<>text doctitle<>text "\">" $$- text "<PARAM name=\"Local\" value=\"index.html\">") $$- text "</OBJECT>") $+$- text "</LI>" $$- text "<UL>" $+$- nest 4 (fn [] ts) $+$- text "</UL>") $+$- text "</UL>"-- 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 "<UL>" $+$- nest 4 (fn (s:ss) ts) $+$- text "</UL>"-- ppLeaf s ss isleaf =- text "<LI>" <> nest 4- (text "<OBJECT type=\"text/sitemap\">" $$- text "<PARAM name=\"Name\" value=\"" <> text s <> text "\">" $$- (if isleaf then text "<PARAM name=\"Local\" value=\"" <> text (moduleHtmlFile mdl) <> text "\">" else empty) $$- text "</OBJECT>") $+$- text "</LI>"- 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 "<!DOCTYPE HTML PUBLIC \"-//IETF//DTD HTML//EN\">" $$- text "<HTML>" $$- text "<HEAD>" $$- text "<META name=\"GENERATOR\" content=\"Haddock\">" $$- text "<!-- Sitemap 1.0 -->" $$- text "</HEAD><BODY>" $$- text "<UL>" $+$- nest 4 (ppList index) $+$- text "</UL>" $$- text "</BODY><HTML>"- 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 "<LI>" <> nest 4- (text "<OBJECT type=\"text/sitemap\">" $$- text "<PARAM name=\"Name\" value=\"" <> text (show name) <> text "\">" $$- ppReference name refs $$- text "</OBJECT>") $+$- text "</LI>" $$- ppList mdls-- ppReference name [] = empty- ppReference name (Module mdl:refs) =- text "<PARAM name=\"Local\" value=\"" <> 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
− src/HaddockHH2.hs
@@ -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 "<?xml version=\"1.0\"?>" $$- text "<!DOCTYPE HelpTOC SYSTEM \"ms-help://hx/resources/HelpTOC.DTD\">" $$- text "<HelpTOC DTDVersion=\"1.0\">" $$- nest 4 (text "<HelpTOCNode Title=\""<>text doctitle<>text"\" Url=\"index.html\">" $$- nest 4 (ppModuleTree [] tree) $+$- text "</HelpTOCNode>") $$- text "</HelpTOC>"- 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 "<HelpTOCNode" <+> ppAttributes leaf (s:ss) <> text "/>"- ppNode ss (Node s leaf _pkg _short ts) =- text "<HelpTOCNode" <+> ppAttributes leaf (s:ss) <> text ">" $$- nest 4 (ppModuleTree (s:ss) ts) $+$- text "</HelpTOCNode>"- - 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 "<?xml version=\"1.0\"?>" $$- text "<!DOCTYPE HelpIndex SYSTEM \"ms-help://hx/resources/HelpIndex.DTD\">" $$- text "<HelpIndex DTDVersion=\"1.0\" Name=\"K\">" $$- nest 4 (ppList index) $+$- text "</HelpIndex>" - docN = - text "<?xml version=\"1.0\"?>" $$- text "<!DOCTYPE HelpIndex SYSTEM \"ms-help://hx/resources/HelpIndex.DTD\">" $$- text "<HelpIndex DTDVersion=\"1.0\" Name=\"NamedURLIndex\">" $$- text "<Keyword Term=\"HomePage\">" $$- nest 4 (text "<Jump Url=\""<>text contentsHtmlFile<>text "\"/>") $$- text "</Keyword>" $$- text "</HelpIndex>"- 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 "<Keyword Term=\"" <> text (escapeStr (show name)) <> text "\">" $$- nest 4 (vcat (map (ppJump name) mdls)) $$- text "</Keyword>" $$- ppList vs-- ppJump name (Module mdl) = text "<Jump Url=\"" <> 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 "<?xml version=\"1.0\"?>" $$- text "<!DOCTYPE HelpFileList SYSTEM \"ms-help://hx/resources/HelpFileList.DTD\">" $$- text "<HelpFileList DTDVersion=\"1.0\">" $$- nest 4 (ppMods ifaces $$- text "<File Url=\""<>text contentsHtmlFile<>text "\"/>" $$- text "<File Url=\""<>text indexHtmlFile<>text "\"/>" $$- ppIndexFiles chars $$- ppLibFiles ("":pkg_paths)) $$- text "</HelpFileList>"- writeFile (pathJoin [odir, filesHH2File]) (render doc)- where- package = fromMaybe "pkg" maybe_package- - ppMods [] = empty- ppMods (iface:ifaces) =- text "<File Url=\"" <> text (moduleHtmlFile mdl) <> text "\"/>" $$- ppMods ifaces- where Module mdl = iface_module iface- - ppIndexFiles [] = empty- ppIndexFiles (c:cs) =- text "<File Url=\""<>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 "<File Url=\""<>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 "<?xml version=\"1.0\"?>" $$- text "<!DOCTYPE HelpCollection SYSTEM \"ms-help://hx/resources/HelpCollection.DTD\">" $$- text "<HelpCollection DTDVersion=\"1.0\" LangId=\"1033\" Title=\"" <> text doctitle <> text "\">" $$- nest 4 (text "<CompilerOptions CreateFullTextIndex=\"Yes\">" $$- nest 4 (text "<IncludeFile File=\"" <> text package <> text ".HxF\"/>") $$- text "</CompilerOptions>" $$- text "<TOCDef File=\"" <> text package <> text ".HxT\"/>" $$- text "<KeywordIndexDef File=\"" <> text package <> text "K.HxK\"/>" $$- text "<KeywordIndexDef File=\"" <> text package <> text "N.HxK\"/>" $$- text "<ItemMoniker Name=\"!DefaultToc\" ProgId=\"HxDs.HxHierarchy\" InitData=\"\"/>" $$- text "<ItemMoniker Name=\"!DefaultFullTextSearch\" ProgId=\"HxDs.HxFullTextSearch\" InitData=\"\"/>" $$- text "<ItemMoniker Name=\"!DefaultAssociativeIndex\" ProgId=\"HxDs.HxIndex\" InitData=\"A\"/>" $$- text "<ItemMoniker Name=\"!DefaultKeywordIndex\" ProgId=\"HxDs.HxIndex\" InitData=\"K\"/>" $$- text "<ItemMoniker Name=\"!DefaultNamedUrlIndex\" ProgId=\"HxDs.HxIndex\" InitData=\"NamedURLIndex\"/>" $$- text "<ItemMoniker Name=\"!SampleInfo\" ProgId=\"HxDs.HxSampleCollection\" InitData=\"\"/>") $$- text "</HelpCollection>"- writeFile (pathJoin [odir, collectionHH2File]) (render doc)
− src/HaddockHoogle.hs
@@ -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 _ = []--
− src/HaddockHtml.hs
@@ -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 <P> (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 <P>..</P>--- 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"]
− src/HaddockLex.x
@@ -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-<line> {- $ws* \> { begin birdtrack }- $ws* \n { token TokPara `andBegin` para }- -- Here, we really want to be able to say- -- $ws* (\n | <eof>) { 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 <eof>,- -- though (NOW I realise what it was for :-). To get around this, we always- -- append \n to the end of a docstring.- () { begin string }-}--<birdtrack> .* \n? { strtoken TokBirdTrack `andBegin` line }--<string,def> {- $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 }-}--<def> {- \] { token TokDefEnd `andBegin` string }-}---- ']' doesn't have any special meaning outside of the [...] at the beginning--- of a definition paragraph.-<string> {- \] { 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-}
− src/HaddockModuleTree.hs
@@ -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]
− src/HaddockParse.y
@@ -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-}
− src/HaddockRename.hs
@@ -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)
− src/HaddockTypes.hs
@@ -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)
− src/HaddockUtil.hs
@@ -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)--
− src/HaddockVersion.hs
@@ -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
− src/HsLexer.lhs
@@ -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, \<octal> 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}
− src/HsParseMonad.lhs
@@ -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}
− src/HsParseUtils.lhs
@@ -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}
− src/HsParser.ly
@@ -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"-> }
− src/HsSyn.lhs
@@ -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}
− src/Html.hs
@@ -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 <andy@galconn.com>--- 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-{-- - <thetag {..attrs..}> ..content.. </thetag>- -}- | 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"] << ("</" ++ markupTag0 ++ ">")---- ------------------------------------------------------------------------------ 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 =- "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01 Transitional//EN\" \"http://www.w3.org/TR/html4/loose.dtd\">\n" ++- "<!--Rendered using the Haskell Html Library v0.2-->\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 "</"- - nl = "\n" ++ replicate (n `div` 8) '\t' - ++ replicate (n `mod` 8) ' '-- rest [] = nl- rest attr = " " ++ unwords (map showPair attr) ++ nl-- showPair :: HtmlAttr -> String- showPair (HtmlAttr tag0 val)- = tag0 ++ "=\"" ++ val ++ "\""-
src/Main.hs view
@@ -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<size> 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"
− src/Map.hs
@@ -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
− src/Set.hs
@@ -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