haddock 2.6.1 → 2.7.0

raw patch · 35 files changed

+1979/−2026 lines, 35 filesdep +QuickCheckPVP ok

version bump matches the API change (PVP)

Dependencies added: QuickCheck

API changes (from Hackage documentation)

- Distribution.Haddock: Documented :: Name -> Module -> DocName

- Distribution.Haddock: InstalledInterface :: Module -> HaddockModInfo Name -> Map Name (DocForDecl Name) -> [Name] -> [Name] -> [DocOption] -> Map Name [Name] -> InstalledInterface

- Distribution.Haddock: InterfaceFile :: LinkEnv -> [InstalledInterface] -> InterfaceFile

- Distribution.Haddock: Undocumented :: Name -> DocName

- Distribution.Haddock: data DocName

- Distribution.Haddock: data InstalledInterface

- Distribution.Haddock: data InterfaceFile

- Distribution.Haddock: docNameOcc :: DocName -> OccName

- Distribution.Haddock: freshNameCache :: NameCacheAccessor IO

- Distribution.Haddock: ifInstalledIfaces :: InterfaceFile -> [InstalledInterface]

- Distribution.Haddock: ifLinkEnv :: InterfaceFile -> LinkEnv

- Distribution.Haddock: instDocMap :: InstalledInterface -> Map Name (DocForDecl Name)

- Distribution.Haddock: instExports :: InstalledInterface -> [Name]

- Distribution.Haddock: instInfo :: InstalledInterface -> HaddockModInfo Name

- Distribution.Haddock: instMod :: InstalledInterface -> Module

- Distribution.Haddock: instOptions :: InstalledInterface -> [DocOption]

- Distribution.Haddock: instSubMap :: InstalledInterface -> Map Name [Name]

- Distribution.Haddock: instVisibleExports :: InstalledInterface -> [Name]

- Distribution.Haddock: nameCacheFromGhc :: NameCacheAccessor Ghc

- Distribution.Haddock: readInterfaceFile :: (MonadIO m) => NameCacheAccessor m -> FilePath -> m (Either String InterfaceFile)

- Distribution.Haddock: type LinkEnv = Map Name Module

- Distribution.Haddock: type NameCacheAccessor m = (m NameCache, NameCache -> m ())

+ Documentation.Haddock: DocAName :: String -> Doc id

+ Documentation.Haddock: DocAppend :: (Doc id) -> (Doc id) -> Doc id

+ Documentation.Haddock: DocCodeBlock :: (Doc id) -> Doc id

+ Documentation.Haddock: DocDefList :: [(Doc id, Doc id)] -> Doc id

+ Documentation.Haddock: DocEmphasis :: (Doc id) -> Doc id

+ Documentation.Haddock: DocEmpty :: Doc id

+ Documentation.Haddock: DocIdentifier :: [id] -> Doc id

+ Documentation.Haddock: DocModule :: String -> Doc id

+ Documentation.Haddock: DocMonospaced :: (Doc id) -> Doc id

+ Documentation.Haddock: DocOrderedList :: [Doc id] -> Doc id

+ Documentation.Haddock: DocParagraph :: (Doc id) -> Doc id

+ Documentation.Haddock: DocPic :: String -> Doc id

+ Documentation.Haddock: DocString :: String -> Doc id

+ Documentation.Haddock: DocURL :: String -> Doc id

+ Documentation.Haddock: DocUnorderedList :: [Doc id] -> Doc id

+ Documentation.Haddock: Documented :: Name -> Module -> DocName

+ Documentation.Haddock: ExportDecl :: LHsDecl name -> DocForDecl name -> [(name, DocForDecl name)] -> [DocInstance name] -> ExportItem name

+ Documentation.Haddock: ExportDoc :: (Doc name) -> ExportItem name

+ Documentation.Haddock: ExportGroup :: Int -> String -> Doc name -> ExportItem name

+ Documentation.Haddock: ExportModule :: Module -> ExportItem name

+ Documentation.Haddock: ExportNoDecl :: name -> [name] -> ExportItem name

+ Documentation.Haddock: Flag_CSS :: String -> Flag

+ Documentation.Haddock: Flag_Debug :: Flag

+ Documentation.Haddock: Flag_DumpInterface :: String -> Flag

+ Documentation.Haddock: Flag_GenContents :: Flag

+ Documentation.Haddock: Flag_GenIndex :: Flag

+ Documentation.Haddock: Flag_GhcLibDir :: String -> Flag

+ Documentation.Haddock: Flag_GhcVersion :: Flag

+ Documentation.Haddock: Flag_Heading :: String -> Flag

+ Documentation.Haddock: Flag_Help :: Flag

+ Documentation.Haddock: Flag_HideModule :: String -> Flag

+ Documentation.Haddock: Flag_Hoogle :: Flag

+ Documentation.Haddock: Flag_Html :: Flag

+ Documentation.Haddock: Flag_HtmlHelp :: String -> Flag

+ Documentation.Haddock: Flag_IgnoreAllExports :: Flag

+ Documentation.Haddock: Flag_Lib :: String -> Flag

+ Documentation.Haddock: Flag_NoWarnings :: Flag

+ Documentation.Haddock: Flag_OptGhc :: String -> Flag

+ Documentation.Haddock: Flag_OutputDir :: FilePath -> Flag

+ Documentation.Haddock: Flag_PrintGhcLibDir :: Flag

+ Documentation.Haddock: Flag_Prologue :: FilePath -> Flag

+ Documentation.Haddock: Flag_ReadInterface :: String -> Flag

+ Documentation.Haddock: Flag_SourceBaseURL :: String -> Flag

+ Documentation.Haddock: Flag_SourceEntityURL :: String -> Flag

+ Documentation.Haddock: Flag_SourceModuleURL :: String -> Flag

+ Documentation.Haddock: Flag_UseContents :: String -> Flag

+ Documentation.Haddock: Flag_UseIndex :: String -> Flag

+ Documentation.Haddock: Flag_UseUnicode :: Flag

+ Documentation.Haddock: Flag_Verbosity :: String -> Flag

+ Documentation.Haddock: Flag_Version :: Flag

+ Documentation.Haddock: Flag_WikiBaseURL :: String -> Flag

+ Documentation.Haddock: Flag_WikiEntityURL :: String -> Flag

+ Documentation.Haddock: Flag_WikiModuleURL :: String -> Flag

+ Documentation.Haddock: HaddockModInfo :: Maybe (Doc name) -> Maybe String -> Maybe String -> Maybe String -> HaddockModInfo name

+ Documentation.Haddock: InstalledInterface :: Module -> HaddockModInfo Name -> Map Name (DocForDecl Name) -> [Name] -> [Name] -> [DocOption] -> Map Name [Name] -> InstalledInterface

+ Documentation.Haddock: Interface :: Module -> FilePath -> !HaddockModInfo Name -> !Maybe (Doc Name) -> Maybe (Doc DocName) -> ![DocOption] -> Map Name DeclInfo -> Map Name (DocForDecl DocName) -> Map Name [Name] -> ![ExportItem Name] -> [ExportItem DocName] -> ![Name] -> ![Name] -> ![Instance] -> Map Name (Doc Name) -> Interface

+ Documentation.Haddock: InterfaceFile :: LinkEnv -> [InstalledInterface] -> InterfaceFile

+ Documentation.Haddock: Markup :: a -> (String -> a) -> (a -> a) -> (a -> a -> a) -> ([id] -> a) -> (String -> a) -> (a -> a) -> (a -> a) -> ([a] -> a) -> ([a] -> a) -> ([(a, a)] -> a) -> (a -> a) -> (String -> a) -> (String -> a) -> (String -> a) -> DocMarkup id a

+ Documentation.Haddock: OptHide :: DocOption

+ Documentation.Haddock: OptIgnoreExports :: DocOption

+ Documentation.Haddock: OptNotHome :: DocOption

+ Documentation.Haddock: OptPrune :: DocOption

+ Documentation.Haddock: Undocumented :: Name -> DocName

+ Documentation.Haddock: createInterfaces :: Verbosity -> [String] -> [Flag] -> [InterfaceFile] -> Ghc ([Interface], LinkEnv)

+ Documentation.Haddock: data Doc id

+ Documentation.Haddock: data DocMarkup id a

+ Documentation.Haddock: data DocName

+ Documentation.Haddock: data DocOption

+ Documentation.Haddock: data ExportItem name

+ Documentation.Haddock: data Flag

+ Documentation.Haddock: data HaddockModInfo name

+ Documentation.Haddock: data InstalledInterface

+ Documentation.Haddock: data Interface

+ Documentation.Haddock: data InterfaceFile

+ Documentation.Haddock: docNameOcc :: DocName -> OccName

+ Documentation.Haddock: expItemDecl :: ExportItem name -> LHsDecl name

+ Documentation.Haddock: expItemInstances :: ExportItem name -> [DocInstance name]

+ Documentation.Haddock: expItemMbDoc :: ExportItem name -> DocForDecl name

+ Documentation.Haddock: expItemName :: ExportItem name -> name

+ Documentation.Haddock: expItemSectionId :: ExportItem name -> String

+ Documentation.Haddock: expItemSectionLevel :: ExportItem name -> Int

+ Documentation.Haddock: expItemSectionText :: ExportItem name -> Doc name

+ Documentation.Haddock: expItemSubDocs :: ExportItem name -> [(name, DocForDecl name)]

+ Documentation.Haddock: expItemSubs :: ExportItem name -> [name]

+ Documentation.Haddock: freshNameCache :: NameCacheAccessor IO

+ Documentation.Haddock: hmi_description :: HaddockModInfo name -> Maybe (Doc name)

+ Documentation.Haddock: hmi_maintainer :: HaddockModInfo name -> Maybe String

+ Documentation.Haddock: hmi_portability :: HaddockModInfo name -> Maybe String

+ Documentation.Haddock: hmi_stability :: HaddockModInfo name -> Maybe String

+ Documentation.Haddock: ifInstalledIfaces :: InterfaceFile -> [InstalledInterface]

+ Documentation.Haddock: ifLinkEnv :: InterfaceFile -> LinkEnv

+ Documentation.Haddock: ifaceDeclMap :: Interface -> Map Name DeclInfo

+ Documentation.Haddock: ifaceDoc :: Interface -> !Maybe (Doc Name)

+ Documentation.Haddock: ifaceExportItems :: Interface -> ![ExportItem Name]

+ Documentation.Haddock: ifaceExports :: Interface -> ![Name]

+ Documentation.Haddock: ifaceInfo :: Interface -> !HaddockModInfo Name

+ Documentation.Haddock: ifaceInstanceDocMap :: Interface -> Map Name (Doc Name)

+ Documentation.Haddock: ifaceInstances :: Interface -> ![Instance]

+ Documentation.Haddock: ifaceMod :: Interface -> Module

+ Documentation.Haddock: ifaceOptions :: Interface -> ![DocOption]

+ Documentation.Haddock: ifaceOrigFilename :: Interface -> FilePath

+ Documentation.Haddock: ifaceRnDoc :: Interface -> Maybe (Doc DocName)

+ Documentation.Haddock: ifaceRnDocMap :: Interface -> Map Name (DocForDecl DocName)

+ Documentation.Haddock: ifaceRnExportItems :: Interface -> [ExportItem DocName]

+ Documentation.Haddock: ifaceSubMap :: Interface -> Map Name [Name]

+ Documentation.Haddock: ifaceVisibleExports :: Interface -> ![Name]

+ Documentation.Haddock: instDocMap :: InstalledInterface -> Map Name (DocForDecl Name)

+ Documentation.Haddock: instExports :: InstalledInterface -> [Name]

+ Documentation.Haddock: instInfo :: InstalledInterface -> HaddockModInfo Name

+ Documentation.Haddock: instMod :: InstalledInterface -> Module

+ Documentation.Haddock: instOptions :: InstalledInterface -> [DocOption]

+ Documentation.Haddock: instSubMap :: InstalledInterface -> Map Name [Name]

+ Documentation.Haddock: instVisibleExports :: InstalledInterface -> [Name]

+ Documentation.Haddock: markupAName :: DocMarkup id a -> String -> a

+ Documentation.Haddock: markupAppend :: DocMarkup id a -> a -> a -> a

+ Documentation.Haddock: markupCodeBlock :: DocMarkup id a -> a -> a

+ Documentation.Haddock: markupDefList :: DocMarkup id a -> [(a, a)] -> a

+ Documentation.Haddock: markupEmphasis :: DocMarkup id a -> a -> a

+ Documentation.Haddock: markupEmpty :: DocMarkup id a -> a

+ Documentation.Haddock: markupIdentifier :: DocMarkup id a -> [id] -> a

+ Documentation.Haddock: markupModule :: DocMarkup id a -> String -> a

+ Documentation.Haddock: markupMonospaced :: DocMarkup id a -> a -> a

+ Documentation.Haddock: markupOrderedList :: DocMarkup id a -> [a] -> a

+ Documentation.Haddock: markupParagraph :: DocMarkup id a -> a -> a

+ Documentation.Haddock: markupPic :: DocMarkup id a -> String -> a

+ Documentation.Haddock: markupString :: DocMarkup id a -> String -> a

+ Documentation.Haddock: markupURL :: DocMarkup id a -> String -> a

+ Documentation.Haddock: markupUnorderedList :: DocMarkup id a -> [a] -> a

+ Documentation.Haddock: nameCacheFromGhc :: NameCacheAccessor Ghc

+ Documentation.Haddock: readInterfaceFile :: (MonadIO m) => NameCacheAccessor m -> FilePath -> m (Either String InterfaceFile)

+ Documentation.Haddock: type DeclInfo = (Decl, DocForDecl Name, [(Name, DocForDecl Name)])

+ Documentation.Haddock: type DocForDecl name = (Maybe (Doc name), FnArgsDoc name)

+ Documentation.Haddock: type DocInstance name = (InstHead name, Maybe (Doc name))

+ Documentation.Haddock: type FnArgsDoc name = Map Int (Doc name)

+ Documentation.Haddock: type InstHead name = ([HsPred name], name, [HsType name])

+ Documentation.Haddock: type LinkEnv = Map Name Module

+ Documentation.Haddock: type NameCacheAccessor m = (m NameCache, NameCache -> m ())

+ Haddock.Convert: DeleteTopLevelQuantification :: SynifyTypeState

+ Haddock.Convert: ImplicitizeForAll :: SynifyTypeState

+ Haddock.Convert: WithinType :: SynifyTypeState

+ Haddock.Convert: data SynifyTypeState

+ Haddock.Convert: synifyClassAT :: TyCon -> LTyClDecl Name

+ Haddock.Convert: synifyCtx :: [PredType] -> LHsContext Name

+ Haddock.Convert: synifyDataCon :: Bool -> DataCon -> LConDecl Name

+ Haddock.Convert: synifyIdSig :: SynifyTypeState -> Id -> Sig Name

+ Haddock.Convert: synifyInstHead :: ([TyVar], [PredType], Class, [Type]) -> ([HsPred Name], Name, [HsType Name])

+ Haddock.Convert: synifyName :: (NamedThing n) => n -> Located Name

+ Haddock.Convert: synifyPred :: PredType -> LHsPred Name

+ Haddock.Convert: synifyTyCon :: TyCon -> TyClDecl Name

+ Haddock.Convert: synifyTyVars :: [TyVar] -> [LHsTyVarBndr Name]

+ Haddock.Convert: synifyType :: SynifyTypeState -> Type -> LHsType Name

+ Haddock.Convert: tyThingToLHsDecl :: TyThing -> LHsDecl Name

+ Haddock.Doc: docAppend :: Doc id -> Doc id -> Doc id

+ Haddock.Doc: docParagraph :: Doc id -> Doc id

+ Haddock.Interface: createInterfaces :: Verbosity -> [String] -> [Flag] -> [InterfaceFile] -> Ghc ([Interface], LinkEnv)

+ Haddock.Interface.AttachInstances: attachInstances :: [Interface] -> InstIfaceMap -> Ghc [Interface]

+ Haddock.Interface.AttachInstances: instance Eq SimpleType

+ Haddock.Interface.AttachInstances: instance Ord SimpleType

+ Haddock.Interface.Create: createInterface :: GhcModule -> [Flag] -> ModuleMap -> InstIfaceMap -> ErrMsgGhc Interface

+ Haddock.Interface.ExtractFnArgDocs: getDeclFnArgDocs :: HsDecl Name -> Map Int HsDocString

+ Haddock.Interface.ExtractFnArgDocs: getSigFnArgDocs :: Sig Name -> Map Int HsDocString

+ Haddock.Interface.ExtractFnArgDocs: getTypeFnArgDocs :: LHsType Name -> Map Int HsDocString

+ Haddock.Interface.LexParseRn: DocSectionComment :: HaddockCommentType

+ Haddock.Interface.LexParseRn: NormalHaddockComment :: HaddockCommentType

+ Haddock.Interface.LexParseRn: data HaddockCommentType

+ Haddock.Interface.LexParseRn: lexParseRnHaddockComment :: HaddockCommentType -> GlobalRdrEnv -> HsDocString -> ErrMsgM (Maybe (Doc Name))

+ Haddock.Interface.LexParseRn: lexParseRnHaddockCommentList :: HaddockCommentType -> GlobalRdrEnv -> [HsDocString] -> ErrMsgM (Maybe (Doc Name))

+ Haddock.Interface.LexParseRn: lexParseRnHaddockModHeader :: GlobalRdrEnv -> GhcDocHdr -> ErrMsgM (HaddockModInfo Name, Maybe (Doc Name))

+ Haddock.Interface.LexParseRn: lexParseRnMbHaddockComment :: HaddockCommentType -> GlobalRdrEnv -> Maybe HsDocString -> ErrMsgM (Maybe (Doc Name))

+ Haddock.Interface.ParseModuleHeader: parseModuleHeader :: String -> Either String (HaddockModInfo RdrName, Doc RdrName)

+ Haddock.Interface.Rename: instance Monad (GenRnM n)

+ Haddock.Interface.Rename: renameInterface :: LinkEnv -> Bool -> Interface -> ErrMsgM Interface

+ Haddock.Interface.Rn: instance Monad Id

+ Haddock.Interface.Rn: rnDoc :: GlobalRdrEnv -> Doc RdrName -> Doc Name

+ Haddock.Interface.Rn: rnHaddockModInfo :: GlobalRdrEnv -> HaddockModInfo RdrName -> HaddockModInfo Name

+ Haddock.Options: Flag_CSS :: String -> Flag

+ Haddock.Options: Flag_Debug :: Flag

+ Haddock.Options: Flag_DumpInterface :: String -> Flag

+ Haddock.Options: Flag_GenContents :: Flag

+ Haddock.Options: Flag_GenIndex :: Flag

+ Haddock.Options: Flag_GhcLibDir :: String -> Flag

+ Haddock.Options: Flag_GhcVersion :: Flag

+ Haddock.Options: Flag_Heading :: String -> Flag

+ Haddock.Options: Flag_Help :: Flag

+ Haddock.Options: Flag_HideModule :: String -> Flag

+ Haddock.Options: Flag_Hoogle :: Flag

+ Haddock.Options: Flag_Html :: Flag

+ Haddock.Options: Flag_HtmlHelp :: String -> Flag

+ Haddock.Options: Flag_IgnoreAllExports :: Flag

+ Haddock.Options: Flag_Lib :: String -> Flag

+ Haddock.Options: Flag_NoWarnings :: Flag

+ Haddock.Options: Flag_OptGhc :: String -> Flag

+ Haddock.Options: Flag_OutputDir :: FilePath -> Flag

+ Haddock.Options: Flag_PrintGhcLibDir :: Flag

+ Haddock.Options: Flag_Prologue :: FilePath -> Flag

+ Haddock.Options: Flag_ReadInterface :: String -> Flag

+ Haddock.Options: Flag_SourceBaseURL :: String -> Flag

+ Haddock.Options: Flag_SourceEntityURL :: String -> Flag

+ Haddock.Options: Flag_SourceModuleURL :: String -> Flag

+ Haddock.Options: Flag_UseContents :: String -> Flag

+ Haddock.Options: Flag_UseIndex :: String -> Flag

+ Haddock.Options: Flag_UseUnicode :: Flag

+ Haddock.Options: Flag_Verbosity :: String -> Flag

+ Haddock.Options: Flag_Version :: Flag

+ Haddock.Options: Flag_WikiBaseURL :: String -> Flag

+ Haddock.Options: Flag_WikiEntityURL :: String -> Flag

+ Haddock.Options: Flag_WikiModuleURL :: String -> Flag

+ Haddock.Options: data Flag

+ Haddock.Options: getUsage :: IO String

+ Haddock.Options: ghcFlags :: [Flag] -> [String]

+ Haddock.Options: ifacePairs :: [Flag] -> [(FilePath, FilePath)]

+ Haddock.Options: instance Eq Flag

+ Haddock.Options: parseHaddockOpts :: [String] -> IO ([Flag], [String])

Files

CHANGES +10/−0
dist/build/haddock/haddock-tmp/Haddock/Interface/Lex.hs +0/−359
dist/build/haddock/haddock-tmp/Haddock/Interface/Parse.hs +0/−719
dist/build/haddock/haddock-tmp/Haddock/Lex.hs +359/−0
dist/build/haddock/haddock-tmp/Haddock/Parse.hs +716/−0
doc/haddock.xml +1/−1
haddock.cabal +17/−27
haddock.spec +1/−1
haskell.vim +68/−68
src/Distribution/Haddock.hs +0/−23
src/Documentation/Haddock.hs +61/−0
src/Haddock/Backends/Hoogle.hs +4/−4
src/Haddock/Backends/Html.hs +46/−40
src/Haddock/Convert.hs +17/−9
src/Haddock/Doc.hs +64/−0
src/Haddock/GhcUtils.hs +2/−4
src/Haddock/HsDoc.hs +0/−73
src/Haddock/Interface.hs +18/−25
src/Haddock/Interface/AttachInstances.hs +30/−17
src/Haddock/Interface/Create.hs +99/−91
src/Haddock/Interface/ExtractFnArgDocs.hs +0/−1
src/Haddock/Interface/Lex.x +0/−171
src/Haddock/Interface/LexParseRn.hs +12/−27
src/Haddock/Interface/Parse.y +0/−106
src/Haddock/Interface/ParseModuleHeader.hs +6/−6
src/Haddock/Interface/Rename.hs +15/−21
src/Haddock/Interface/Rn.hs +4/−4
src/Haddock/InterfaceFile.hs +2/−6
src/Haddock/Lex.x +172/−0
src/Haddock/ModuleTree.hs +8/−8
src/Haddock/Parse.y +103/−0
src/Haddock/Types.hs +122/−129
src/Haddock/Utils.hs +6/−6
src/Haddock/Utils/FastMutInt2.hs +0/−62
src/Main.hs +16/−18

CHANGES view

@@ -1,3 +1,13 @@+Changes in version 2.7.0:++  * Instances can be commented++  * The Haddock API now exposes more of the internals of Haddock++  * Bug fixes (most importantly #128)++-----------------------------------------------------------------------------+ Changes in version 2.6.0:    * Drop support for GHC 6.10.*

− dist/build/haddock/haddock-tmp/Haddock/Interface/Lex.hs

@@ -1,359 +0,0 @@-{-# OPTIONS -fglasgow-exts -cpp #-}-{-# LINE 9 "src/Haddock/Interface/Lex.x" #-}--{-# OPTIONS -Wwarn -w #-}--- The above warning supression flag is a temporary kludge.--- While working on this module you are encouraged to remove it and fix--- any warnings in the module. See---     http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings--- for details--module Haddock.Interface.Lex (-	Token(..),-	tokenise- ) where--import Lexer hiding (Token)-import Parser ( parseIdentifier )-import StringBuffer-import RdrName-import SrcLoc-import DynFlags--import Data.Char-import Numeric-import System.IO.Unsafe--#if __GLASGOW_HASKELL__ >= 603-#include "ghcconfig.h"-#elif defined(__GLASGOW_HASKELL__)-#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 95 "src/Haddock/Interface/Lex.x" #-}--data Token-  = TokPara-  | TokNumber-  | TokBullet-  | TokDefStart-  | TokDefEnd-  | TokSpecial Char-  | TokIdent [RdrName]-  | 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' _       -> 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 _ cont -> act str new_sc cont--token :: Token -> Action-token t = \_ sc cont -> t : cont sc--strtoken, strtokenNL :: (String -> Token) -> Action-strtoken t = \str sc cont -> t str : cont sc-strtokenNL t = \str sc cont -> t (filter (/= '\r') str) : cont sc--- ^ We only want LF line endings in our internal doc string format, so we--- filter out all CRs.--begin :: StartCode -> Action-begin sc = \_ _ 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 [RdrName]-strToHsQNames str0 = -  let buffer = unsafePerformIO (stringToStringBuffer str0)-      pstate = mkPState buffer noSrcLoc defaultDynFlags-      result = unP parseIdentifier pstate -  in case result of -       POk _ name -> Just [unLoc name] -       _ -> 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 =  strtokenNL 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 =  strtokenNL TokString `andBegin` line -alex_action_21 =  strtoken TokString -alex_action_22 =  token TokDefEnd `andBegin` string -alex_action_23 =  strtoken TokString -{-# LINE 1 "templates/GenericTemplate.hs" #-}-{-# LINE 1 "templates/GenericTemplate.hs" #-}-{-# LINE 1 "<built-in>" #-}-{-# LINE 1 "<command-line>" #-}-{-# LINE 1 "templates/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 "templates/GenericTemplate.hs" #-}--{-# LINE 45 "templates/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/Haddock/Interface/Parse.hs

@@ -1,719 +0,0 @@-{-# OPTIONS -fglasgow-exts -cpp #-}-{-# OPTIONS -Wwarn -w #-}--- The above warning supression flag is a temporary kludge.--- While working on this module you are encouraged to remove it and fix--- any warnings in the module. See---     http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings--- for details--module Haddock.Interface.Parse (-  parseHaddockParagraphs, -  parseHaddockString -) where--import Haddock.Interface.Lex-import Haddock.Types (HsDoc(..))-import Haddock.HsDoc-import HsSyn-import RdrName-#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.17--newtype HappyAbsSyn  = HappyAbsSyn HappyAny-#if __GLASGOW_HASKELL__ >= 607-type HappyAny = GHC.Exts.Any-#else-type HappyAny = forall a . a-#endif-happyIn5 :: (HsDoc RdrName) -> (HappyAbsSyn )-happyIn5 x = unsafeCoerce# x-{-# INLINE happyIn5 #-}-happyOut5 :: (HappyAbsSyn ) -> (HsDoc RdrName)-happyOut5 x = unsafeCoerce# x-{-# INLINE happyOut5 #-}-happyIn6 :: (HsDoc RdrName) -> (HappyAbsSyn )-happyIn6 x = unsafeCoerce# x-{-# INLINE happyIn6 #-}-happyOut6 :: (HappyAbsSyn ) -> (HsDoc RdrName)-happyOut6 x = unsafeCoerce# x-{-# INLINE happyOut6 #-}-happyIn7 :: (HsDoc RdrName) -> (HappyAbsSyn )-happyIn7 x = unsafeCoerce# x-{-# INLINE happyIn7 #-}-happyOut7 :: (HappyAbsSyn ) -> (HsDoc RdrName)-happyOut7 x = unsafeCoerce# x-{-# INLINE happyOut7 #-}-happyIn8 :: (HsDoc RdrName) -> (HappyAbsSyn )-happyIn8 x = unsafeCoerce# x-{-# INLINE happyIn8 #-}-happyOut8 :: (HappyAbsSyn ) -> (HsDoc RdrName)-happyOut8 x = unsafeCoerce# x-{-# INLINE happyOut8 #-}-happyIn9 :: ((HsDoc RdrName, HsDoc RdrName)) -> (HappyAbsSyn )-happyIn9 x = unsafeCoerce# x-{-# INLINE happyIn9 #-}-happyOut9 :: (HappyAbsSyn ) -> ((HsDoc RdrName, HsDoc RdrName))-happyOut9 x = unsafeCoerce# x-{-# INLINE happyOut9 #-}-happyIn10 :: (HsDoc RdrName) -> (HappyAbsSyn )-happyIn10 x = unsafeCoerce# x-{-# INLINE happyIn10 #-}-happyOut10 :: (HappyAbsSyn ) -> (HsDoc RdrName)-happyOut10 x = unsafeCoerce# x-{-# INLINE happyOut10 #-}-happyIn11 :: (HsDoc RdrName) -> (HappyAbsSyn )-happyIn11 x = unsafeCoerce# x-{-# INLINE happyIn11 #-}-happyOut11 :: (HappyAbsSyn ) -> (HsDoc RdrName)-happyOut11 x = unsafeCoerce# x-{-# INLINE happyOut11 #-}-happyIn12 :: (HsDoc RdrName) -> (HappyAbsSyn )-happyIn12 x = unsafeCoerce# x-{-# INLINE happyIn12 #-}-happyOut12 :: (HappyAbsSyn ) -> (HsDoc RdrName)-happyOut12 x = unsafeCoerce# x-{-# INLINE happyOut12 #-}-happyIn13 :: (HsDoc RdrName) -> (HappyAbsSyn )-happyIn13 x = unsafeCoerce# x-{-# INLINE happyIn13 #-}-happyOut13 :: (HappyAbsSyn ) -> (HsDoc RdrName)-happyOut13 x = unsafeCoerce# x-{-# INLINE happyOut13 #-}-happyIn14 :: (HsDoc RdrName) -> (HappyAbsSyn )-happyIn14 x = unsafeCoerce# x-{-# INLINE happyIn14 #-}-happyOut14 :: (HappyAbsSyn ) -> (HsDoc RdrName)-happyOut14 x = unsafeCoerce# x-{-# INLINE happyOut14 #-}-happyIn15 :: (HsDoc RdrName) -> (HappyAbsSyn )-happyIn15 x = unsafeCoerce# x-{-# INLINE happyIn15 #-}-happyOut15 :: (HappyAbsSyn ) -> (HsDoc RdrName)-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 :: () => Maybe a -> (a -> Maybe b) -> Maybe b-happyThen = (>>=)-happyReturn :: () => a -> Maybe a-happyReturn = (return)-happyThen1 m k tks = (>>=) m (\a -> k a tks)-happyReturn1 :: () => a -> b -> Maybe a-happyReturn1 = \a tks -> (return) a-happyError' :: () => [Token] -> Maybe a-happyError' = happyError--parseHaddockParagraphs tks = happySomeParser where-  happySomeParser = happyThen (happyParse 0# tks) (\x -> happyReturn (happyOut5 x))--parseHaddockString tks = happySomeParser where-  happySomeParser = happyThen (happyParse 1# tks) (\x -> happyReturn (happyOut12 x))--happySeq = happyDontSeq---happyError :: [Token] -> Maybe a-happyError toks = Nothing-{-# LINE 1 "templates/GenericTemplate.hs" #-}-{-# LINE 1 "templates/GenericTemplate.hs" #-}-{-# LINE 1 "<built-in>" #-}-{-# LINE 1 "<command-line>" #-}-{-# LINE 1 "templates/GenericTemplate.hs" #-}--- Id: GenericTemplate.hs,v 1.26 2005/01/14 14:47:22 simonmar Exp --{-# LINE 28 "templates/GenericTemplate.hs" #-}---data Happy_IntList = HappyCons Int# Happy_IntList------{-# LINE 49 "templates/GenericTemplate.hs" #-}--{-# LINE 59 "templates/GenericTemplate.hs" #-}--{-# LINE 68 "templates/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 "templates/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 "templates/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/Haddock/Lex.hs view

@@ -0,0 +1,359 @@+{-# OPTIONS -fglasgow-exts -cpp #-}+{-# LINE 10 "src/Haddock/Lex.x" #-}++{-# OPTIONS -Wwarn -w #-}+-- The above warning supression flag is a temporary kludge.+-- While working on this module you are encouraged to remove it and fix+-- any warnings in the module. See+--     http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings+-- for details++module Haddock.Lex (+	Token(..),+	tokenise+ ) where++import Lexer hiding (Token)+import Parser ( parseIdentifier )+import StringBuffer+import RdrName+import SrcLoc+import DynFlags++import Data.Char+import Numeric+import System.IO.Unsafe++#if __GLASGOW_HASKELL__ >= 603+#include "ghcconfig.h"+#elif defined(__GLASGOW_HASKELL__)+#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 96 "src/Haddock/Lex.x" #-}++data Token+  = TokPara+  | TokNumber+  | TokBullet+  | TokDefStart+  | TokDefEnd+  | TokSpecial Char+  | TokIdent [RdrName]+  | 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' _       -> 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 _ cont -> act str new_sc cont++token :: Token -> Action+token t = \_ sc cont -> t : cont sc++strtoken, strtokenNL :: (String -> Token) -> Action+strtoken t = \str sc cont -> t str : cont sc+strtokenNL t = \str sc cont -> t (filter (/= '\r') str) : cont sc+-- ^ We only want LF line endings in our internal doc string format, so we+-- filter out all CRs.++begin :: StartCode -> Action+begin sc = \_ _ 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 [RdrName]+strToHsQNames str0 = +  let buffer = unsafePerformIO (stringToStringBuffer str0)+      pstate = mkPState buffer noSrcLoc defaultDynFlags+      result = unP parseIdentifier pstate +  in case result of +       POk _ name -> Just [unLoc name] +       _ -> 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 =  strtokenNL 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 =  strtokenNL TokString `andBegin` line +alex_action_21 =  strtoken TokString +alex_action_22 =  token TokDefEnd `andBegin` string +alex_action_23 =  strtoken TokString +{-# LINE 1 "templates/GenericTemplate.hs" #-}+{-# LINE 1 "templates/GenericTemplate.hs" #-}+{-# LINE 1 "<built-in>" #-}+{-# LINE 1 "<command-line>" #-}+{-# LINE 1 "templates/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 "templates/GenericTemplate.hs" #-}++{-# LINE 45 "templates/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/Haddock/Parse.hs view

@@ -0,0 +1,716 @@+{-# OPTIONS -fglasgow-exts -cpp #-}+{-# OPTIONS -Wwarn -w #-}+-- The above warning supression flag is a temporary kludge.+-- While working on this module you are encouraged to remove it and fix+-- any warnings in the module. See+--     http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings+-- for details++module Haddock.Parse where++import Haddock.Lex+import Haddock.Types (Doc(..))+import Haddock.Doc+import HsSyn+import RdrName+#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.17++newtype HappyAbsSyn  = HappyAbsSyn HappyAny+#if __GLASGOW_HASKELL__ >= 607+type HappyAny = GHC.Exts.Any+#else+type HappyAny = forall a . a+#endif+happyIn5 :: (Doc RdrName) -> (HappyAbsSyn )+happyIn5 x = unsafeCoerce# x+{-# INLINE happyIn5 #-}+happyOut5 :: (HappyAbsSyn ) -> (Doc RdrName)+happyOut5 x = unsafeCoerce# x+{-# INLINE happyOut5 #-}+happyIn6 :: (Doc RdrName) -> (HappyAbsSyn )+happyIn6 x = unsafeCoerce# x+{-# INLINE happyIn6 #-}+happyOut6 :: (HappyAbsSyn ) -> (Doc RdrName)+happyOut6 x = unsafeCoerce# x+{-# INLINE happyOut6 #-}+happyIn7 :: (Doc RdrName) -> (HappyAbsSyn )+happyIn7 x = unsafeCoerce# x+{-# INLINE happyIn7 #-}+happyOut7 :: (HappyAbsSyn ) -> (Doc RdrName)+happyOut7 x = unsafeCoerce# x+{-# INLINE happyOut7 #-}+happyIn8 :: (Doc RdrName) -> (HappyAbsSyn )+happyIn8 x = unsafeCoerce# x+{-# INLINE happyIn8 #-}+happyOut8 :: (HappyAbsSyn ) -> (Doc RdrName)+happyOut8 x = unsafeCoerce# x+{-# INLINE happyOut8 #-}+happyIn9 :: ((Doc RdrName, Doc RdrName)) -> (HappyAbsSyn )+happyIn9 x = unsafeCoerce# x+{-# INLINE happyIn9 #-}+happyOut9 :: (HappyAbsSyn ) -> ((Doc RdrName, Doc RdrName))+happyOut9 x = unsafeCoerce# x+{-# INLINE happyOut9 #-}+happyIn10 :: (Doc RdrName) -> (HappyAbsSyn )+happyIn10 x = unsafeCoerce# x+{-# INLINE happyIn10 #-}+happyOut10 :: (HappyAbsSyn ) -> (Doc RdrName)+happyOut10 x = unsafeCoerce# x+{-# INLINE happyOut10 #-}+happyIn11 :: (Doc RdrName) -> (HappyAbsSyn )+happyIn11 x = unsafeCoerce# x+{-# INLINE happyIn11 #-}+happyOut11 :: (HappyAbsSyn ) -> (Doc RdrName)+happyOut11 x = unsafeCoerce# x+{-# INLINE happyOut11 #-}+happyIn12 :: (Doc RdrName) -> (HappyAbsSyn )+happyIn12 x = unsafeCoerce# x+{-# INLINE happyIn12 #-}+happyOut12 :: (HappyAbsSyn ) -> (Doc RdrName)+happyOut12 x = unsafeCoerce# x+{-# INLINE happyOut12 #-}+happyIn13 :: (Doc RdrName) -> (HappyAbsSyn )+happyIn13 x = unsafeCoerce# x+{-# INLINE happyIn13 #-}+happyOut13 :: (HappyAbsSyn ) -> (Doc RdrName)+happyOut13 x = unsafeCoerce# x+{-# INLINE happyOut13 #-}+happyIn14 :: (Doc RdrName) -> (HappyAbsSyn )+happyIn14 x = unsafeCoerce# x+{-# INLINE happyIn14 #-}+happyOut14 :: (HappyAbsSyn ) -> (Doc RdrName)+happyOut14 x = unsafeCoerce# x+{-# INLINE happyOut14 #-}+happyIn15 :: (Doc RdrName) -> (HappyAbsSyn )+happyIn15 x = unsafeCoerce# x+{-# INLINE happyIn15 #-}+happyOut15 :: (HappyAbsSyn ) -> (Doc RdrName)+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 :: () => Maybe a -> (a -> Maybe b) -> Maybe b+happyThen = (>>=)+happyReturn :: () => a -> Maybe a+happyReturn = (return)+happyThen1 m k tks = (>>=) m (\a -> k a tks)+happyReturn1 :: () => a -> b -> Maybe a+happyReturn1 = \a tks -> (return) a+happyError' :: () => [Token] -> Maybe 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] -> Maybe a+happyError toks = Nothing+{-# LINE 1 "templates/GenericTemplate.hs" #-}+{-# LINE 1 "templates/GenericTemplate.hs" #-}+{-# LINE 1 "<built-in>" #-}+{-# LINE 1 "<command-line>" #-}+{-# LINE 1 "templates/GenericTemplate.hs" #-}+-- Id: GenericTemplate.hs,v 1.26 2005/01/14 14:47:22 simonmar Exp ++{-# LINE 28 "templates/GenericTemplate.hs" #-}+++data Happy_IntList = HappyCons Int# Happy_IntList++++++{-# LINE 49 "templates/GenericTemplate.hs" #-}++{-# LINE 59 "templates/GenericTemplate.hs" #-}++{-# LINE 68 "templates/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 "templates/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 "templates/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 2.6.1, a Haskell+      <para>This document describes Haddock version 2.7.0, a Haskell       documentation tool.</para>     </abstract>   </bookinfo>

haddock.cabal view

@@ -1,5 +1,5 @@ name:                 haddock-version:              2.6.1+version:              2.7.0 cabal-version:        >= 1.6 license:              BSD3 build-type:           Simple@@ -63,6 +63,10 @@   default: False   manual: True +flag test+  default: False+  manual: True+ executable haddock   build-depends:     base >= 4.0.0.0 && < 4.3.0.0,@@ -80,6 +84,10 @@   else     build-depends: ghc-paths +  if flag(test)+    cpp-options: -DTEST+    build-depends: QuickCheck >= 2.1 && < 3+   main-is:              Main.hs   hs-source-dirs:       src   extensions:           CPP, PatternGuards, DeriveDataTypeable,@@ -92,12 +100,11 @@     Haddock.Interface.Create     Haddock.Interface.ExtractFnArgDocs     Haddock.Interface.AttachInstances-    Haddock.Interface.Lex-    Haddock.Interface.Parse     Haddock.Interface.Rn     Haddock.Interface.LexParseRn     Haddock.Interface.ParseModuleHeader-    Haddock.Utils.FastMutInt2+    Haddock.Lex+    Haddock.Parse     Haddock.Utils.BlockTable     Haddock.Utils.Html     Haddock.Utils@@ -109,44 +116,27 @@     Haddock.Backends.Hoogle     Haddock.ModuleTree     Haddock.Types-    Haddock.HsDoc+    Haddock.Doc     Haddock.Version     Haddock.InterfaceFile             Haddock.Options     Haddock.GhcUtils     Haddock.Convert    -  -- Cabal doesn't define __GHC_PATCHLEVEL__-  if impl(ghc == 6.10.1)-    cpp-options: -D__GHC_PATCHLEVEL__=1-  if impl(ghc == 6.10.2)-    cpp-options: -D__GHC_PATCHLEVEL__=2-  if impl(ghc == 6.10.3)-    cpp-options: -D__GHC_PATCHLEVEL__=3-  if impl(ghc == 6.10.4)-    cpp-options: -D__GHC_PATCHLEVEL__=4- library   hs-source-dirs:       src   extensions:           CPP, PatternGuards, DeriveDataTypeable,                         ScopedTypeVariables, MagicHash-  exposed-modules:      Distribution.Haddock+  exposed-modules:+    Documentation.Haddock+   other-modules:+    Haddock.Lex+    Haddock.Parse     Haddock.Types     Haddock.InterfaceFile     Haddock.Utils     Haddock.GhcUtils   -  -- Cabal doesn't define __GHC_PATCHLEVEL__-  if impl(ghc == 6.10.1)-    cpp-options: -D__GHC_PATCHLEVEL__=1-  if impl(ghc == 6.10.2)-    cpp-options: -D__GHC_PATCHLEVEL__=2-  if impl(ghc == 6.10.3)-    cpp-options: -D__GHC_PATCHLEVEL__=3-  if impl(ghc == 6.10.4)-    cpp-options: -D__GHC_PATCHLEVEL__=4-   if flag(in-ghc-tree)     buildable: False-

haddock.spec view

@@ -17,7 +17,7 @@ # version label of your release tarball.  %define name    haddock-%define version 2.6.1+%define version 2.7.0 %define release 1  Name:           %{name}

haskell.vim view

@@ -1,68 +1,68 @@-" Attempt to add haddock highlighting for haskell comments
-" It should be placed in ~/.vim/after/syntax/haskell.vim
-" Brad Bowman <haddock.vim@bereft.net>
-
-syn match   hsHdocChunk "$\i\+" contained
-syn match   hsHdocMod /"\(\i\|[.]\)\+"/ contained
-syn match   hsHdocLink "'\(\i\|[.#]\)\+'" contained
-syn region  hsHdocAnchor start="\\\@<!#" skip="\\#" end="\\\@<!#" contained oneline
-" I think emphasis can span multiple lines
-syn region  hsHdocEm start="\\\@<!/" skip="\\/" end="\\\@!/" contained oneline
-syn region  hsHdocURL start="\\\@<!<" end="\\\@<!>" contained oneline
-syn region  hsHdocCode start="\\\@<!@" skip="\\@" end="\\\@<!@" contained oneline
-syn region  hsHdocBCodeBlock start="^@\(\s\|$\)" end="^@\s*$" contained
-syn region  hsHdocLCodeBlock start="\(^\s*--\s*\)\@<=@\s*$" end="\(^\s*--\s*\)\@<=@\s*$" contained
-syn match   hsHdocBHeading "^\s*\*\+" contained
-syn match   hsHdocLHeading "\(^\s*--\s*\)\@<=\*\+" contained
-syn match   hsHdocBTracks "^\s*>" contained
-" match only the > using a look-behind
-syn match   hsHdocLTracks "\(^\s*--\s*\)\@<=>" contained
-
-" todo: numbered lists, mark haddock start separately
-"syn match   hsHdocStart "\([$^|]\|\*\+\)" contained
-
-syn cluster hsHdocSpecial 
-  \ contains=hsHdocMod,hsHdocLink,hsHdocEm,hsHdocCode,hsHdocURL,
-  \ hsHdocAnchor,hsHdocChunk
-
-syn region  hsHdocDef start="^\s*\(--\)\?\s*\[" end="\]" contained contains=hsHdocSpecial
-
-syn region  hsHdocLines start="--\s*\([$\^|]\|\*\+\)" 
-                      \ skip="^\s*\(--.*\)$" 
-                      \ end="^\s*\(\$\|--\)\@!" 
-                      \ contains=@hsHdocSpecial,hsHdocLTracks,hsHdocLHeading,hsHdocLCodeBlock,hsHdocDef
-syn region  hsHdocBlock start="{-\s*\([$\^|]\|\*\+\)" end="-}" 
-                      \ contains=@hsHdocSpecial,hsHdocBTracks,hsHdocBHeading,hsHdocBCodeBlock,hsHdocDef
-
-syn sync minlines=20
-
-if version >= 508 || !exists("did_haddock_syntax_inits")
-  if version < 508
-    let did_haddock_syntax_inits = 1
-    command -nargs=+ HiLink hi link <args>
-  else
-    command -nargs=+ HiLink hi def link <args>
-  endif
-
-  HiLink hsHdocLines            hsHdoc
-  HiLink hsHdocBlock            hsHdoc
-  HiLink hsHdoc                 PreProc
-  HiLink hsHdocAnchor           Special
-  HiLink hsHdocChunk            Special
-  HiLink hsHdocMod              Special
-  HiLink hsHdocLink             Special
-  HiLink hsHdocEm               Special
-  HiLink hsHdocURL              Special
-  HiLink hsHdocCode             Special
-  HiLink hsHdocLHeading         Special
-  HiLink hsHdocBHeading         Special
-  HiLink hsHdocLTracks          Special
-  HiLink hsHdocBTracks          Special
-  HiLink hsHdocBCodeBlock       Special
-  HiLink hsHdocLCodeBlock       Special
-  HiLink hsHdocSpecial          Special
-
-  delcommand HiLink                       
-endif
-
-" Options for vi: sw=2 sts=2 nowrap ft=vim
+" Attempt to add haddock highlighting for haskell comments+" It should be placed in ~/.vim/after/syntax/haskell.vim+" Brad Bowman <haddock.vim@bereft.net>++syn match   hsHdocChunk "$\i\+" contained+syn match   hsHdocMod /"\(\i\|[.]\)\+"/ contained+syn match   hsHdocLink "'\(\i\|[.#]\)\+'" contained+syn region  hsHdocAnchor start="\\\@<!#" skip="\\#" end="\\\@<!#" contained oneline+" I think emphasis can span multiple lines+syn region  hsHdocEm start="\\\@<!/" skip="\\/" end="\\\@!/" contained oneline+syn region  hsHdocURL start="\\\@<!<" end="\\\@<!>" contained oneline+syn region  hsHdocCode start="\\\@<!@" skip="\\@" end="\\\@<!@" contained oneline+syn region  hsHdocBCodeBlock start="^@\(\s\|$\)" end="^@\s*$" contained+syn region  hsHdocLCodeBlock start="\(^\s*--\s*\)\@<=@\s*$" end="\(^\s*--\s*\)\@<=@\s*$" contained+syn match   hsHdocBHeading "^\s*\*\+" contained+syn match   hsHdocLHeading "\(^\s*--\s*\)\@<=\*\+" contained+syn match   hsHdocBTracks "^\s*>" contained+" match only the > using a look-behind+syn match   hsHdocLTracks "\(^\s*--\s*\)\@<=>" contained++" todo: numbered lists, mark haddock start separately+"syn match   hsHdocStart "\([$^|]\|\*\+\)" contained++syn cluster hsHdocSpecial +  \ contains=hsHdocMod,hsHdocLink,hsHdocEm,hsHdocCode,hsHdocURL,+  \ hsHdocAnchor,hsHdocChunk++syn region  hsHdocDef start="^\s*\(--\)\?\s*\[" end="\]" contained contains=hsHdocSpecial++syn region  hsHdocLines start="--\s*\([$\^|]\|\*\+\)" +                      \ skip="^\s*\(--.*\)$" +                      \ end="^\s*\(\$\|--\)\@!" +                      \ contains=@hsHdocSpecial,hsHdocLTracks,hsHdocLHeading,hsHdocLCodeBlock,hsHdocDef+syn region  hsHdocBlock start="{-\s*\([$\^|]\|\*\+\)" end="-}" +                      \ contains=@hsHdocSpecial,hsHdocBTracks,hsHdocBHeading,hsHdocBCodeBlock,hsHdocDef++syn sync minlines=20++if version >= 508 || !exists("did_haddock_syntax_inits")+  if version < 508+    let did_haddock_syntax_inits = 1+    command -nargs=+ HiLink hi link <args>+  else+    command -nargs=+ HiLink hi def link <args>+  endif++  HiLink hsHdocLines            hsHdoc+  HiLink hsHdocBlock            hsHdoc+  HiLink hsHdoc                 PreProc+  HiLink hsHdocAnchor           Special+  HiLink hsHdocChunk            Special+  HiLink hsHdocMod              Special+  HiLink hsHdocLink             Special+  HiLink hsHdocEm               Special+  HiLink hsHdocURL              Special+  HiLink hsHdocCode             Special+  HiLink hsHdocLHeading         Special+  HiLink hsHdocBHeading         Special+  HiLink hsHdocLTracks          Special+  HiLink hsHdocBTracks          Special+  HiLink hsHdocBCodeBlock       Special+  HiLink hsHdocLCodeBlock       Special+  HiLink hsHdocSpecial          Special++  delcommand HiLink                       +endif++" Options for vi: sw=2 sts=2 nowrap ft=vim

− src/Distribution/Haddock.hs

@@ -1,23 +0,0 @@------ Haddock - A Haskell Documentation Tool------ (c) Simon Marlow 2003------module Distribution.Haddock (-  readInterfaceFile,-  nameCacheFromGhc,-  freshNameCache,-  NameCacheAccessor,-  InterfaceFile(..),-  LinkEnv,-  InstalledInterface(..),-  DocName(..),-  docNameOcc-) where---import Haddock.InterfaceFile-import Haddock.Types-

+ src/Documentation/Haddock.hs view

@@ -0,0 +1,61 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Documentation.Haddock+-- Copyright   :  (c) David Waern 2010+-- License     :  BSD-like+--+-- Maintainer  :  haddock@projects.haskellorg+-- Stability   :  experimental+-- Portability :  portable+--+-- The Haddock API: A rudimentory, highly experimental API exposing some of+-- the internals of Haddock. Don't expect it to be stable.+-----------------------------------------------------------------------------+++module Documentation.Haddock (++  -- * Interface+  Interface(..),+  InstalledInterface(..),+  createInterfaces,++  -- * Export items & declarations+  ExportItem(..),+  DeclInfo,+  DocForDecl,+  FnArgsDoc, + +  -- * Hyperlinking+  LinkEnv,+  DocName(..),+  docNameOcc,++  -- * Instances+  DocInstance,+  InstHead(..),++  -- * Documentation comments+  Doc(..),+  DocMarkup(..),+  HaddockModInfo(..),++  -- * Interface files+  -- | (.haddock files)+  InterfaceFile(..),+  readInterfaceFile,+  nameCacheFromGhc,+  freshNameCache,+  NameCacheAccessor,+  +  -- * Flags and options+  Flag(..),+  DocOption(..)++) where+++import Haddock.InterfaceFile+import Haddock.Interface+import Haddock.Types+import Haddock.Options

src/Haddock/Backends/Hoogle.hs view

@@ -35,7 +35,7 @@          ,""]  -ppHoogle :: String -> String -> String -> Maybe (HsDoc RdrName) -> [Interface] -> FilePath -> IO ()+ppHoogle :: String -> String -> String -> Maybe (Doc RdrName) -> [Interface] -> FilePath -> IO () ppHoogle package version synopsis prologue ifaces odir = do     let filename = package ++ ".txt"         contents = prefix ++@@ -168,7 +168,7 @@                 f w = if w == nam then operator nam else w  -- | for constructors, and named-fields...-lookupCon :: [(Name, DocForDecl Name)] -> Located Name -> Maybe (HsDoc Name)+lookupCon :: [(Name, DocForDecl Name)] -> Located Name -> Maybe (Doc Name) lookupCon subdocs (L _ name) = case lookup name subdocs of   Just (d, _) -> d   _ -> Nothing@@ -198,11 +198,11 @@ --------------------------------------------------------------------- -- DOCUMENTATION -doc :: Outputable o => Maybe (HsDoc o) -> [String]+doc :: Outputable o => Maybe (Doc o) -> [String] doc = docWith ""  -docWith :: Outputable o => String -> Maybe (HsDoc o) -> [String]+docWith :: Outputable o => String -> Maybe (Doc o) -> [String] docWith [] Nothing = [] docWith header d = ("":) $ zipWith (++) ("-- | " : repeat "--   ") $     [header | header /= ""] ++ ["" | header /= "" && isJust d] ++

src/Haddock/Backends/Html.hs view

@@ -63,7 +63,7 @@ 	-> Maybe String				-- package 	-> [Interface] 	-> FilePath			-- destination directory-	-> Maybe (HsDoc GHC.RdrName)    -- prologue text, maybe+	-> Maybe (Doc GHC.RdrName)    -- prologue text, maybe 	-> Maybe String		        -- the Html Help format (--html-help) 	-> SourceURLs			-- the source URL (--source) 	-> WikiURLs			-- the wiki URL (--wiki)@@ -306,7 +306,7 @@    -> Maybe String    -> SourceURLs    -> WikiURLs-   -> [InstalledInterface] -> Bool -> Maybe (HsDoc GHC.RdrName)+   -> [InstalledInterface] -> Bool -> Maybe (Doc GHC.RdrName)    -> IO () ppHtmlContents odir doctitle   maybe_package maybe_html_help_format maybe_index_url@@ -341,7 +341,7 @@     Just "devhelp" -> return ()     Just format    -> fail ("The "++format++" format is not implemented") -ppPrologue :: String -> Maybe (HsDoc GHC.RdrName) -> HtmlTable+ppPrologue :: String -> Maybe (Doc GHC.RdrName) -> HtmlTable ppPrologue _ Nothing = Html.emptyTable ppPrologue title (Just doc) =    (tda [theclass "section1"] << toHtml title) </>@@ -399,7 +399,7 @@     (s':ss') = reverse (s:ss) 	 -- reconstruct the module name     -    id_s = "n:" ++ show id_+    id_s = "n." ++ show id_          (sub_tree,id') = genSubTree emptyTable (id_+1) ts     @@ -800,7 +800,7 @@   | lev == 3  = tda [ theclass "section3" ] << doc   | otherwise = tda [ theclass "section4" ] << doc -declWithDoc :: Bool -> LinksInfo -> SrcSpan -> DocName -> Maybe (HsDoc DocName) -> Html -> HtmlTable+declWithDoc :: Bool -> LinksInfo -> SrcSpan -> DocName -> Maybe (Doc 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 = @@ -809,7 +809,7 @@  -- TODO: use DeclInfo DocName or something ppDecl :: Bool -> LinksInfo -> LHsDecl DocName -> -          DocForDecl DocName -> [InstHead DocName] -> [(DocName, DocForDecl DocName)] -> Bool -> HtmlTable+          DocForDecl DocName -> [DocInstance DocName] -> [(DocName, DocForDecl DocName)] -> Bool -> HtmlTable ppDecl summ links (L loc decl) (mbDoc, fnArgsDoc) instances subdocs unicode = case decl of   TyClD d@(TyFamily {})          -> ppTyFam summ False links loc mbDoc d unicode   TyClD d@(TyData {})@@ -867,7 +867,7 @@       | otherwise       = do_largs n leader ltype     do_args n leader (HsFunTy lt r)-      = (argBox (leader <+> ppLType unicode lt) <-> rdocBox (argDocHtml n))+      = (argBox (leader <+> ppLFunLhType unicode lt) <-> rdocBox (argDocHtml n))           </> do_largs (n+1) (arrow unicode) r     do_args n leader t       = argBox (leader <+> ppType unicode t) <-> rdocBox (argDocHtml n)@@ -933,7 +933,7 @@     Nothing -> empty  -ppTyFam :: Bool -> Bool -> LinksInfo -> SrcSpan -> Maybe (HsDoc DocName) ->+ppTyFam :: Bool -> Bool -> LinksInfo -> SrcSpan -> Maybe (Doc DocName) ->               TyClDecl DocName -> Bool -> HtmlTable ppTyFam summary associated links loc mbDoc decl unicode   @@ -960,7 +960,7 @@   	  tda [theclass "body"] <<              collapsed thediv instId (               spacedTable1 << (-                aboves (map (declBox . ppInstHead unicode) instances)+                aboves (map (ppDocInstance unicode) instances)               )             ) @@ -990,7 +990,7 @@ --------------------------------------------------------------------------------   -ppTyInst :: Bool -> Bool -> LinksInfo -> SrcSpan -> Maybe (HsDoc DocName) ->+ppTyInst :: Bool -> Bool -> LinksInfo -> SrcSpan -> Maybe (Doc DocName) ->             TyClDecl DocName -> Bool -> HtmlTable ppTyInst summary associated links loc mbDoc decl unicode   @@ -1155,8 +1155,8 @@       -ppClassDecl :: Bool -> LinksInfo -> [InstHead DocName] -> SrcSpan-            -> Maybe (HsDoc DocName) -> [(DocName, DocForDecl DocName)]+ppClassDecl :: Bool -> LinksInfo -> [DocInstance DocName] -> SrcSpan+            -> Maybe (Doc DocName) -> [(DocName, DocForDecl DocName)]             -> TyClDecl DocName -> Bool -> HtmlTable ppClassDecl summary links instances loc mbDoc subdocs 	decl@(ClassDecl lctxt lname ltyvars lfds lsigs _ ats _) unicode@@ -1196,12 +1196,19 @@         =  s8 </> instHdr instId </>            tda [theclass "body"] <<               collapsed thediv instId (-             spacedTable1 << (-               aboves (map (declBox . ppInstHead unicode) instances)-             ))+               spacedTable1 << aboves (map (ppDocInstance unicode) instances)+             ) ppClassDecl _ _ _ _ _ _ _ _ = error "declaration type not supported by ppShortClassDecl"  +-- | Print a possibly commented instance. The instance header is printed inside+-- an 'argBox'. The comment is printed to the right of the box in normal comment+-- style.+ppDocInstance :: Bool -> DocInstance DocName -> HtmlTable+ppDocInstance unicode (instHead, maybeDoc) =+  argBox (ppInstHead unicode instHead) <-> maybeRDocBox maybeDoc++ ppInstHead :: Bool -> InstHead DocName -> Html ppInstHead unicode ([],   n, ts) = ppAppNameTypes n ts unicode ppInstHead unicode (ctxt, n, ts) = ppContextNoLocs ctxt unicode <+> ppAppNameTypes n ts unicode@@ -1254,9 +1261,9 @@     cons      = tcdCons dataDecl     resTy     = (con_res . unLoc . head) cons  -ppDataDecl :: Bool -> LinksInfo -> [InstHead DocName] ->+ppDataDecl :: Bool -> LinksInfo -> [DocInstance DocName] ->               [(DocName, DocForDecl DocName)] ->-              SrcSpan -> Maybe (HsDoc DocName) -> TyClDecl DocName -> Bool -> HtmlTable+              SrcSpan -> Maybe (Doc DocName) -> TyClDecl DocName -> Bool -> HtmlTable ppDataDecl summary links instances subdocs loc mbDoc dataDecl unicode      | summary = declWithDoc summary links loc docname mbDoc @@ -1308,8 +1315,7 @@         = instHdr instId </> 	  tda [theclass "body"] <<            collapsed thediv instId (-            spacedTable1 << (-              aboves (map (declBox . ppInstHead unicode) instances)+            spacedTable1 << aboves (map (ppDocInstance unicode) instances             )           ) @@ -1379,17 +1385,17 @@      PrefixCon args ->        argBox (hsep ((header_ unicode +++ ppBinder False occ) : map (ppLParendType unicode) args)) -      <-> maybeRDocBox mbLDoc  +      <-> maybeRDocBox mbDoc        RecCon fields ->        argBox (header_ unicode +++ ppBinder False occ) <->-      maybeRDocBox mbLDoc+      maybeRDocBox mbDoc       </>       doRecordFields fields      InfixCon arg1 arg2 ->        argBox (hsep [header_ unicode+++ppLParendType unicode arg1, ppBinder False occ, ppLParendType unicode arg2])-      <-> maybeRDocBox mbLDoc+      <-> maybeRDocBox mbDoc     ResTyGADT resTy -> case con_details con of     -- prefix & infix could also use hsConDeclArgTys if it seemed to@@ -1406,7 +1412,7 @@     doGADTCon args resTy = argBox (ppBinder False occ <+> dcolon unicode <+> hsep [                                ppForAll forall ltvs (con_cxt con) unicode,                                ppLType unicode (foldr mkFunTy resTy args) ]-                            ) <-> maybeRDocBox mbLDoc+                            ) <-> maybeRDocBox mbDoc       header_ = ppConstrHdr forall tyVars context@@ -1417,19 +1423,17 @@     forall  = con_explicit con     -- don't use "con_doc con", in case it's reconstructed from a .hi file,     -- or also because we want Haddock to do the doc-parsing, not GHC.-    -- The 'fmap' and 'join' are in Maybe-    mbLDoc  = fmap noLoc $ join $ fmap fst $-                lookup (unLoc $ con_name con) subdocs+    -- 'join' is in Maybe.+    mbDoc = join $ fmap fst $ lookup (unLoc $ con_name con) subdocs     mkFunTy a b = noLoc (HsFunTy a b)  ppSideBySideField :: [(DocName, DocForDecl DocName)] -> Bool -> ConDeclField DocName ->  HtmlTable ppSideBySideField subdocs unicode (ConDeclField (L _ name) ltype _) =   argBox (ppBinder False (docNameOcc name)-    <+> dcolon unicode <+> ppLType unicode ltype) <->-  maybeRDocBox mbLDoc+    <+> dcolon unicode <+> ppLType unicode ltype) <-> maybeRDocBox mbDoc   where     -- don't use cd_fld_doc for same reason we don't use con_doc above-    mbLDoc = fmap noLoc $ join $ fmap fst $ lookup name subdocs+    mbDoc = join $ fmap fst $ lookup name subdocs  {- ppHsFullConstr :: HsConDecl -> Html@@ -1561,14 +1565,16 @@                                | otherwise            = p  -ppLType, ppLParendType :: Bool -> Located (HsType DocName) -> Html+ppLType, ppLParendType, ppLFunLhType :: Bool -> Located (HsType DocName) -> Html ppLType       unicode y = ppType unicode (unLoc y) ppLParendType unicode y = ppParendType unicode (unLoc y) +ppLFunLhType  unicode y = ppFunLhType unicode (unLoc y)  -ppType, ppParendType :: Bool -> HsType DocName -> Html+ppType, ppParendType, ppFunLhType :: Bool -> HsType DocName -> Html ppType       unicode ty = ppr_mono_ty pREC_TOP ty unicode  ppParendType unicode ty = ppr_mono_ty pREC_CON ty unicode +ppFunLhType  unicode ty = ppr_mono_ty pREC_FUN ty unicode   -- Drop top-level for-all type variables in user style@@ -1606,10 +1612,9 @@ ppr_mono_ty _         (HsNumTy n)         _ = toHtml (show n) -- generics only ppr_mono_ty _         (HsSpliceTy _)      _ = error "ppr_mono_ty HsSpliceTy" ppr_mono_ty _         (HsSpliceTyOut _)   _ = error "ppr_mono_ty HsSpliceTyOut"-#if __GLASGOW_HASKELL__ >= 611 ppr_mono_ty _         (HsRecTy _)         _ = error "ppr_mono_ty HsRecTy"-#endif + ppr_mono_ty ctxt_prec (HsAppTy fun_ty arg_ty) unicode    = maybeParen ctxt_prec pREC_CON $     hsep [ppr_mono_lty pREC_FUN fun_ty unicode, ppr_mono_lty pREC_CON arg_ty unicode]@@ -1740,13 +1745,13 @@  -- If the doc is a single paragraph, don't surround it with <P> (this causes -- ugly extra whitespace with some browsers).-docToHtml :: HsDoc DocName -> Html+docToHtml :: Doc DocName -> Html docToHtml doc = markup htmlMarkup (unParagraph (markup htmlCleanup doc)) -origDocToHtml :: HsDoc Name -> Html+origDocToHtml :: Doc Name -> Html origDocToHtml doc = markup htmlOrigMarkup (unParagraph (markup htmlCleanup doc)) -rdrDocToHtml :: HsDoc RdrName -> Html+rdrDocToHtml :: Doc RdrName -> Html rdrDocToHtml doc = markup htmlRdrMarkup (unParagraph (markup htmlCleanup doc))  -- If there is a single paragraph, then surrounding it with <P>..</P>@@ -1754,13 +1759,13 @@ -- 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 :: HsDoc a -> HsDoc a+unParagraph :: Doc a -> Doc a 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 a (HsDoc a)+htmlCleanup :: DocMarkup a (Doc a) htmlCleanup = idMarkup {    markupUnorderedList = DocUnorderedList . map unParagraph,   markupOrderedList   = DocOrderedList   . map unParagraph@@ -1769,6 +1774,7 @@ -- ----------------------------------------------------------------------------- -- * Misc + hsep :: [Html] -> Html hsep [] = noHtml hsep htmls = foldr1 (\a b -> a+++" "+++b) htmls@@ -1895,9 +1901,9 @@ rdocBox :: Html -> HtmlTable rdocBox html = tda [theclass "rdoc"] << html -maybeRDocBox :: Maybe (LHsDoc DocName) -> HtmlTable+maybeRDocBox :: Maybe (Doc DocName) -> HtmlTable maybeRDocBox Nothing = rdocBox (noHtml)-maybeRDocBox (Just ldoc) = rdocBox (docToHtml (unLoc ldoc))+maybeRDocBox (Just doc) = rdocBox (docToHtml doc)  -- a box for the buttons at the top of the page topButBox :: Html -> HtmlTable

src/Haddock/Convert.hs view

@@ -1,7 +1,17 @@ {-# LANGUAGE PatternGuards #-}---- This functionality may be moved into GHC at some point, and then--- we can use the GHC version (#if GHC version is new enough).+-----------------------------------------------------------------------------+-- |+-- Module      :  Haddock.Convert+-- Copyright   :  (c) Isaac Dupree 2009,+-- License     :  BSD-like+--+-- Maintainer  :  haddock@projects.haskell.org+-- Stability   :  experimental+-- Portability :  portable+--+-- Conversion between TyThing and HsDecl. This functionality may be moved into+-- GHC at some point.+-----------------------------------------------------------------------------  -- Some other functions turned out to be useful for converting -- instance heads, which aren't TyThings, so just export everything.@@ -49,7 +59,7 @@       (map (\ (l,r) -> noLoc                  (map getName l, map getName r) ) $          snd $ classTvsFds cl)-      (map (\i -> noLoc $ synifyIdSig DeleteTopLevelQuantification i)+      (map (noLoc . synifyIdSig DeleteTopLevelQuantification)            (classMethods cl))       emptyBag --ignore default method definitions, they don't affect signature       (map synifyClassAT (classATs cl))@@ -58,7 +68,7 @@ -- class associated-types are a subset of TyCon -- (mainly only type/data-families) synifyClassAT :: TyCon -> LTyClDecl Name-synifyClassAT tc = noLoc $ synifyTyCon tc+synifyClassAT = noLoc . synifyTyCon  synifyTyCon :: TyCon -> TyClDecl Name synifyTyCon tc@@ -180,19 +190,17 @@  -- finally we get synifyDataCon's result!  in ConDecl name Implicit{-we don't know nor care-}       qvars ctx tys res_ty Nothing-#if __GLASGOW_HASKELL__ >= 611       False --we don't want any "deprecated GADT syntax" warnings!-#endif  synifyName :: NamedThing n => n -> Located Name-synifyName n = noLoc (getName n)+synifyName = noLoc . getName  synifyIdSig :: SynifyTypeState -> Id -> Sig Name synifyIdSig s i = TypeSig (synifyName i) (synifyType s (varType i))   synifyCtx :: [PredType] -> LHsContext Name-synifyCtx ps = noLoc (map synifyPred ps)+synifyCtx = noLoc . map synifyPred  synifyPred :: PredType -> LHsPred Name synifyPred (ClassP cls tys) =

+ src/Haddock/Doc.hs view

@@ -0,0 +1,64 @@+module Haddock.Doc (+  docAppend,+  docParagraph+  ) where+++import Haddock.Types+import Data.Char (isSpace)+++-- used to make parsing easier; we group the list items later+docAppend :: Doc id -> Doc id -> Doc id+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 id -> Doc id+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 id -> Doc id+docCodeBlock (DocString s)+  = DocString (reverse $ dropWhile (`elem` " \t") $ reverse s)+docCodeBlock (DocAppend l r)+  = DocAppend l (docCodeBlock r)+docCodeBlock d = d

src/Haddock/GhcUtils.hs view

@@ -22,10 +22,8 @@ import Control.Arrow import Data.Foldable hiding (concatMap) import Data.Traversable-#if __GLASGOW_HASKELL__ >= 611 import Distribution.Compat.ReadP import Distribution.Text-#endif  import Outputable import Name@@ -53,7 +51,7 @@                           Just x -> (display $ pkgName x, showVersion (pkgVersion x))   where pkg = modulePackageId modu -#if __GLASGOW_HASKELL__ >= 611+ -- This was removed from GHC 6.11 -- XXX we shouldn't be using it, probably @@ -65,7 +63,7 @@         []      -> Nothing         (pid:_) -> Just pid   where str = packageIdString p-#endif+  mkModuleNoPackage :: String -> Module mkModuleNoPackage str = mkModule (stringToPackageId "") (mkModuleName str)

− src/Haddock/HsDoc.hs

@@ -1,73 +0,0 @@-module Haddock.HsDoc (-  docAppend,-  docParagraph-  ) where--#if __GLASGOW_HASKELL__ <= 610--import HsDoc -- just re-export--#else--import Haddock.Types--import Data.Char (isSpace)----- used to make parsing easier; we group the list items later-docAppend :: HsDoc id -> HsDoc id -> HsDoc id-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 :: HsDoc id -> HsDoc id-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 :: HsDoc id -> HsDoc id-docCodeBlock (DocString s)-  = DocString (reverse $ dropWhile (`elem` " \t") $ reverse s)-docCodeBlock (DocAppend l r)-  = DocAppend l (docCodeBlock r)-docCodeBlock d = d--#endif-

src/Haddock/Interface.hs view

@@ -40,10 +40,15 @@ import HscTypes  --- | Turn a topologically sorted list of module names/filenames into interfaces. Also--- return the home link environment created in the process.-createInterfaces :: Verbosity -> [String] -> [Flag] -> [InterfaceFile]-                 -> Ghc ([Interface], LinkEnv)+-- | Create 'Interface' structures by typechecking the list of modules+-- using the GHC API and processing the resulting syntax trees.+createInterfaces+  :: Verbosity -- ^ Verbosity of logging to 'stdout'+  -> [String] -- ^ A list of file or module names sorted by module topology+  -> [Flag] -- ^ Command-line flags+  -> [InterfaceFile] -- ^ Interface files of package dependencies+  -> Ghc ([Interface], LinkEnv)+  -- ^ Resulting list of interfaces and renaming environment createInterfaces verbosity modules flags extIfaces = do   -- part 1, create interfaces   let instIfaceMap =  Map.fromList [ (instMod iface, iface) | ext <- extIfaces@@ -61,16 +66,16 @@    -- part 3, attach instances   out verbosity verbose "Attaching instances..."-  interfaces' <- attachInstances interfaces+  interfaces' <- attachInstances interfaces instIfaceMap    -- part 4, rename interfaces   out verbosity verbose "Renaming interfaces..."   let warnings = Flag_NoWarnings `notElem` flags-  let (interfaces'', msgs) = +  let (interfaces'', msgs) =          runWriter $ mapM (renameInterface links warnings) interfaces'   liftIO $ mapM_ putStrLn msgs -  return (interfaces'', homeLinks)  +  return (interfaces'', homeLinks)   createInterfaces' :: Verbosity -> [String] -> [Flag] -> InstIfaceMap -> Ghc [Interface]@@ -79,13 +84,9 @@   setTargets targets   modgraph <- depanal [] False -#if (__GLASGOW_HASKELL__ == 610 && __GHC_PATCHLEVEL__ >= 2) || __GLASGOW_HASKELL__ >= 611   -- If template haskell is used by the package, we can not use   -- HscNothing as target since we might need to run code generated from   -- one or more of the modules during typechecking.-#if __GLASGOW_HASKELL__ < 611-  let needsTemplateHaskell = any (dopt Opt_TemplateHaskell . ms_hspp_opts)-#endif   modgraph' <- if needsTemplateHaskell modgraph        then do          dflags <- getSessionDynFlags@@ -94,9 +95,6 @@          let addHscAsm m = m { ms_hspp_opts = (ms_hspp_opts m) { hscTarget = defaultObjectTarget } }          return (map addHscAsm modgraph)        else return modgraph-#else-  let modgraph' = modgraph-#endif    let orderedMods = flattenSCCs $ topSortModuleGraph False modgraph' Nothing   (ifaces, _) <- foldM (\(ifaces, modMap) modsum -> do@@ -137,14 +135,14 @@ type CheckedMod = (Module, FilePath, FullyCheckedMod)  -type FullyCheckedMod = (ParsedSource, -                        RenamedSource, -                        TypecheckedSource, +type FullyCheckedMod = (ParsedSource,+                        RenamedSource,+                        TypecheckedSource,                         ModuleInfo)   -- | Dig out what we want from the typechecker output-mkGhcModule :: CheckedMod -> DynFlags -> GhcModule +mkGhcModule :: CheckedMod -> DynFlags -> GhcModule mkGhcModule (mdl, file, checkedMod) dynflags = GhcModule {   ghcModule         = mdl,   ghcFilename       = file,@@ -154,17 +152,12 @@   ghcMbExports      = mbExports,   ghcExportedNames  = modInfoExports modInfo,   ghcDefinedNames   = map getName $ modInfoTyThings modInfo,-  ghcNamesInScope   = fromJust $ modInfoTopLevelScope modInfo, +  ghcNamesInScope   = fromJust $ modInfoTopLevelScope modInfo,   ghcInstances      = modInfoInstances modInfo }   where     mbOpts = haddockOptions dynflags-#if __GLASGOW_HASKELL__ >= 611     (group_, _, mbExports, mbDocHdr) = renamed-#else-    (group_, _, mbExports, mbDoc, info) = renamed-    mbDocHdr = (info, mbDoc)-#endif     (_, renamed, _, modInfo) = checkedMod  @@ -173,7 +166,7 @@ -- "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

src/Haddock/Interface/AttachInstances.hs view

@@ -18,7 +18,9 @@ import Haddock.Types import Haddock.Convert +import Control.Arrow import Data.List+import qualified Data.Map as Map  import GHC import Name@@ -26,13 +28,7 @@ import Class import HscTypes (withSession, ioMsg) import TcRnDriver (tcRnGetInfo)--#if __GLASGOW_HASKELL__ > 610 || (__GLASGOW_HASKELL__ == 610 && __GHC_PATCHLEVEL__ >= 2) import TypeRep hiding (funTyConName)-#else-import TypeRep-#endif- import Var hiding (varName) import TyCon import PrelNames@@ -40,28 +36,45 @@ #define FSLIT(x) (mkFastString# (x#))  -attachInstances :: [Interface] -> Ghc [Interface]-attachInstances = mapM attach+attachInstances :: [Interface] -> InstIfaceMap -> Ghc [Interface]+attachInstances ifaces instIfaceMap = mapM attach ifaces   where     attach iface = do       newItems <- mapM attachExport $ ifaceExportItems iface       return $ iface { ifaceExportItems = newItems }+      where+        attachExport export@ExportDecl{expItemDecl = L _ (TyClD d)} = do+           mb_info <- getAllInfo (unLoc (tcdLName d))+           return $ export { expItemInstances = case mb_info of+             Just (_, _, instances) ->+               let insts = map (first synifyInstHead) $ sortImage (first instHead)+                             [ (instanceHead i, getName i) | i <- instances ]+               in [ (inst, lookupInstDoc name iface instIfaceMap)+                  | (inst, name) <- insts ]+             Nothing -> []+            }+        attachExport export = return export -    attachExport export@ExportDecl{expItemDecl = L _ (TyClD d)} = do-       mb_info <- getAllInfo (unLoc (tcdLName d))-       return $ export { expItemInstances = case mb_info of-         Just (_, _, instances) ->-           map synifyInstHead . sortImage instHead . map instanceHead $ instances-         Nothing ->-           []-        }-    attachExport export = return export +lookupInstDoc :: Name -> Interface -> InstIfaceMap -> Maybe (Doc Name)+-- TODO: capture this pattern in a function (when we have streamlined the+-- handling of instances)+lookupInstDoc name iface ifaceMap =+  case Map.lookup name (ifaceInstanceDocMap iface) of+    Just doc -> Just doc+    Nothing -> do -- in Maybe+      instIface <- Map.lookup modName ifaceMap+      (Just doc, _) <- Map.lookup name (instDocMap instIface)+      return doc+  where+    modName = nameModule name + -- | Like GHC's getInfo but doesn't cut things out depending on the -- interative context, which we don't set sufficiently anyway. getAllInfo :: GhcMonad m => Name -> m (Maybe (TyThing,Fixity,[Instance])) getAllInfo name = withSession $ \hsc_env -> ioMsg $ tcRnGetInfo hsc_env name+  -------------------------------------------------------------------------------- -- Collecting and sorting instances

src/Haddock/Interface/Create.hs view

@@ -56,13 +56,17 @@   (info, mbDoc)    <- liftErrMsg $ lexParseRnHaddockModHeader                                        gre (ghcMbDocHdr ghcMod)   decls0           <- liftErrMsg $ declInfos gre (topDecls (ghcGroup ghcMod))-  let decls         = filterOutInstances decls0++  let instances      = ghcInstances ghcMod+      localInsts     = filter (nameIsLocalOrFrom mdl . getName) instances+      declDocs       = [ (decl, doc) | (L _ decl, (Just doc, _), _) <- decls0 ]+      instanceDocMap = mkInstanceDocMap localInsts declDocs++      decls         = filterOutInstances decls0       declMap       = mkDeclMap decls       exports       = fmap (reverse . map unLoc) (ghcMbExports ghcMod)-      localNames    = ghcDefinedNames ghcMod       ignoreExps    = Flag_IgnoreAllExports `elem` flags       exportedNames = ghcExportedNames ghcMod-      instances     = ghcInstances ghcMod    liftErrMsg $ warnAboutFilteredDecls mdl decls0 @@ -70,14 +74,14 @@                                opts exports ignoreExps instances instIfaceMap    let visibleNames = mkVisibleNames exportItems opts-  +   -- prune the export list to just those declarations that have   -- documentation, if the 'prune' option is on.-  let +  let     prunedExportItems       | OptPrune `elem` opts = pruneExportItems exportItems       | otherwise = exportItems- +   return Interface {     ifaceMod             = mdl,     ifaceOrigFilename    = ghcFilename ghcMod,@@ -85,15 +89,15 @@     ifaceDoc             = mbDoc,     ifaceRnDoc           = Nothing,     ifaceOptions         = opts,-    ifaceLocals          = localNames,     ifaceRnDocMap        = Map.empty,     ifaceExportItems     = prunedExportItems,     ifaceRnExportItems   = [],     ifaceExports         = exportedNames,-    ifaceVisibleExports  = visibleNames, +    ifaceVisibleExports  = visibleNames,     ifaceDeclMap         = declMap,     ifaceSubMap          = mkSubMap declMap exportedNames,-    ifaceInstances       = ghcInstances ghcMod+    ifaceInstances       = instances,+    ifaceInstanceDocMap  = instanceDocMap   }  @@ -106,12 +110,12 @@  mkDocOpts :: Maybe String -> [Flag] -> Module -> ErrMsgM [DocOption] mkDocOpts mbOpts flags mdl = do-  opts <- case mbOpts of +  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 mdl) `elem` flags +  if Flag_HideModule (moduleString mdl) `elem` flags     then return $ OptHide : opts     else return opts @@ -128,6 +132,22 @@ -- Declarations -------------------------------------------------------------------------------- ++mkInstanceDocMap :: [Instance] -> [(HsDecl name, doc)] -> Map Name doc+mkInstanceDocMap instances decls =+  -- We relate Instances to InstDecls using the SrcSpans buried inside them.+  -- That should work for normal user-written instances (from looking at GHC+  -- sources). We can assume that commented instances are user-written.+  -- This lets us relate Names (from Instances) to comments (associated+  -- with InstDecls).+  let docMap = Map.fromList [ (loc, doc)+                            | (InstD (InstDecl (L loc _) _ _ _), doc) <- decls ]++  in Map.fromList [ (name, doc) | inst <- instances+                  , let name = getName inst+                  , Just doc <- [ Map.lookup (getSrcSpan name) docMap ] ]++ -- | Make a sub map from a declaration map. Make sure we only include exported -- names. mkSubMap :: Map Name DeclInfo -> [Name] -> Map Name [Name]@@ -137,13 +157,13 @@     filterSubs (_, _, subs) = [ sub  | (sub, _) <- subs, sub `elem` exports ]  --- Make a map from names to 'DeclInfo's. Exclude declarations that don't--- have names (instances and stand-alone documentation comments). Include--- subordinate names, but map them to their parent declarations. +-- Make a map from names to 'DeclInfo's. Exclude declarations that don't have+-- names (e.g. instances and stand-alone documentation comments). Include+-- subordinate names, but map them to their parent declarations. mkDeclMap :: [DeclInfo] -> Map Name DeclInfo mkDeclMap decls = Map.fromList . concat $   [ (declName d, (parent, doc, subs)) : subDecls-  | (parent@(L _ d), doc, subs) <- decls +  | (parent@(L _ d), doc, subs) <- decls   , let subDecls = [ (n, (parent, doc', [])) | (n, doc') <- subs ]   , not (isDocD d), not (isInstD d) ] @@ -196,7 +216,7 @@     classSubs = [ (declName d, doc, fnArgsDoc)                 | (L _ d, doc) <- classDecls decl                 , let fnArgsDoc = getDeclFnArgDocs d ]-    dataSubs  = constrs ++ fields   +    dataSubs  = constrs ++ fields       where         cons    = map unL $ tcdCons decl         -- should we use the type-signature of the constructor@@ -211,14 +231,14 @@   -- All the sub declarations of a class (that we handle), ordered by--- source location, with documentation attached if it exists. +-- source location, with documentation attached if it exists. classDecls :: TyClDecl Name -> [(Decl, MaybeDocStrings)] classDecls = filterDecls . collectDocs . sortByLoc . declsFromClass   declsFromClass :: TyClDecl a -> [Located (HsDecl a)] declsFromClass class_ = docs ++ defs ++ sigs ++ ats-  where +  where     docs = mkDecls tcdDocs DocD class_     defs = mkDecls (bagToList . tcdMeths) ValD class_     sigs = mkDecls tcdSigs SigD class_@@ -233,9 +253,9 @@ declName _ = error "unexpected argument to declName"  --- | The top-level declarations of a module that we care about, +-- | The top-level declarations of a module that we care about, -- ordered by source location, with documentation attached if it exists.-topDecls :: HsGroup Name -> [(Decl, MaybeDocStrings)] +topDecls :: HsGroup Name -> [(Decl, MaybeDocStrings)] topDecls = filterClasses . filterDecls . collectDocs . sortByLoc . declsFromGroup  @@ -246,7 +266,7 @@ -- | Take all declarations except pragmas, infix decls, rules and value -- bindings from an 'HsGroup'. declsFromGroup :: HsGroup Name -> [Decl]-declsFromGroup group_ = +declsFromGroup group_ =   mkDecls hs_tyclds  TyClD    group_ ++   mkDecls hs_derivds DerivD   group_ ++   mkDecls hs_defds   DefD     group_ ++@@ -277,19 +297,19 @@         nub [ tcdName d | (L _ (TyClD d), _, _) <- decls, isFamInstDecl d ]    unless (null typeInstances) $-    tell $ nub [+    tell [       "Warning: " ++ modStr ++ ": Instances of type and data "       ++ "families are not yet supported. Instances of the following families "-      ++ "will be filtered out:\n  " ++ (concat $ intersperse ", "+      ++ "will be filtered out:\n  " ++ concat (intersperse ", "       $ map (occNameString . nameOccName) typeInstances) ]    let instances = nub [ pretty i | (L _ (InstD (InstDecl i _ _ ats)), _, _) <- decls                                  , not (null ats) ]    unless (null instances) $-    tell $ nub [+    tell [       "Warning: " ++ modStr ++ ": We do not support associated types in instances yet. "-      ++ "These instances are affected:\n" ++ (concat $ intersperse ", " instances) ]+      ++ "These instances are affected:\n" ++ concat (intersperse ", " instances) ]   --------------------------------------------------------------------------------@@ -314,11 +334,11 @@  -- | Go through all class declarations and filter their sub-declarations filterClasses :: [(Decl, doc)] -> [(Decl, doc)]-filterClasses decls = [ if isClassD d then (L loc (filterClass d), doc) else x +filterClasses decls = [ if isClassD d then (L loc (filterClass d), doc) else x                       | x@(L loc d, doc) <- decls ]   where     filterClass (TyClD c) =-      TyClD $ c { tcdSigs = filter isVanillaLSig $ tcdSigs c }  +      TyClD $ c { tcdSigs = filter isVanillaLSig $ tcdSigs c }     filterClass _ = error "expected TyClD"  @@ -326,7 +346,7 @@ -- Collect docs -- -- To be able to attach the right Haddock comment to the right declaration,--- we sort the declarations by their SrcLoc and "collect" the docs for each +-- we sort the declarations by their SrcLoc and "collect" the docs for each -- declaration. -------------------------------------------------------------------------------- @@ -393,14 +413,6 @@ finishedDoc d doc rest = (d, docStringToList doc) : rest  -{--attachATs :: [IE Name] -> ([IE Name], [Name])-attachATs exports = -  where-    ats =   <- export ]--}-- -- | 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.@@ -409,14 +421,14 @@ -- might be useful when creating the export items for other modules. mkExportItems   :: ModuleMap-  -> Module			-- this module+  -> Module             -- this module   -> GlobalRdrEnv-  -> [Name]			-- exported names (orig)+  -> [Name]             -- exported names (orig)   -> [DeclInfo]-  -> Map Name DeclInfo             -- maps local names to declarations+  -> Map Name DeclInfo  -- maps local names to declarations   -> [DocOption]   -> Maybe [IE Name]-  -> Bool				-- --ignore-all-exports flag+  -> Bool               -- --ignore-all-exports flag   -> [Instance]   -> InstIfaceMap   -> ErrMsgGhc [ExportItem Name]@@ -428,41 +440,35 @@   | otherwise = liftM concat $ mapM lookupExport (fromJust maybe_exps)   where --- creating export items for intsances (unfinished experiment)---    instances = [ d | d@(L _ decl, _, _) <- decls, isInstD decl ]      everything_local_exported =  -- everything exported       liftErrMsg $ fullContentsOfThisModule gre decls-    +     lookupExport (IEVar x) = declWith x     lookupExport (IEThingAbs t) = declWith t-  --    | Just fam <- Map.lookup t famMap = absFam fam-  --    | otherwise = declWith t- --     where-   --     absFam (Just (famDecl, doc), instances) = return $ [ ExportDecl famDecl doc [] ] ++ matchingInsts t-     --   absFam (Nothing, instances) =-     lookupExport (IEThingAll t)        = declWith t     lookupExport (IEThingWith t _)     = declWith t     lookupExport (IEModuleContents m)  = fullContentsOf m-    lookupExport (IEGroup lev docStr)  = liftErrMsg $ do+    lookupExport (IEGroup lev docStr)  = liftErrMsg $       ifDoc (lexParseRnHaddockComment DocSectionComment gre docStr)             (\doc -> return [ ExportGroup lev "" doc ])-    lookupExport (IEDoc docStr)        = liftErrMsg $ do+    lookupExport (IEDoc docStr)        = liftErrMsg $       ifDoc (lexParseRnHaddockComment NormalHaddockComment gre docStr)             (\doc -> return [ ExportDoc doc ])-    lookupExport (IEDocNamed str) = liftErrMsg $ do+    lookupExport (IEDocNamed str) = liftErrMsg $       ifDoc (findNamedDoc str [ unL d | (d,_,_) <- decls ])             (\docStr ->             ifDoc (lexParseRnHaddockComment NormalHaddockComment gre docStr)                   (\doc -> return [ ExportDoc doc ])) +     ifDoc :: (Monad m) => m (Maybe a) -> (a -> m [b]) -> m [b]     ifDoc parse finish = do       mbDoc <- parse       case mbDoc of Nothing -> return []; Just doc -> finish doc +     declWith :: Name -> ErrMsgGhc [ ExportItem Name ]     declWith t =       case findDecl t of@@ -550,7 +556,7 @@               -- for example).               --               -- But I might be missing something obvious.  What's important-              -- *here* is that we behave reasonably when we run into one of+              -- /here/ is that we behave reasonably when we run into one of               -- those exported type-inferenced values.               isLocalAndTypeInferenced <- liftGhcToErrMsgGhc $                     isLoaded (moduleName (nameModule t))@@ -598,6 +604,7 @@                            ) subs                      )] +     mkExportDecl :: Name -> DeclInfo -> ExportItem Name     mkExportDecl n (decl, doc, subs) = decl'       where@@ -606,36 +613,37 @@         subs' = filter ((`elem` exported_names) . fst) subs         sub_names = map fst subs' -    isExported n = n `elem` exported_names +    isExported = (`elem` exported_names)++     fullContentsOf modname-	| m == this_mod = liftErrMsg $ fullContentsOfThisModule gre decls-	| otherwise = -	   case Map.lookup m modMap of-	     Just iface-		| OptHide `elem` ifaceOptions iface-			-> return (ifaceExportItems iface)-		| otherwise -> return [ ExportModule m ]-               -	     Nothing -> -- we have to try to find it in the installed interfaces-                        -- (external packages)-               case Map.lookup modname (Map.mapKeys moduleName instIfaceMap) of-                 Just iface -> return [ ExportModule (instMod iface) ]-                 Nothing -> do-                   liftErrMsg $-                     tell ["Warning: " ++ pretty this_mod ++ ": Could not find " ++-                         "documentation for exported module: " ++ pretty modname]-                   return []+      | m == this_mod = liftErrMsg $ fullContentsOfThisModule gre decls+      | otherwise =+          case Map.lookup m modMap of+            Just iface+              | OptHide `elem` ifaceOptions iface -> return (ifaceExportItems iface)+              | otherwise -> return [ ExportModule m ]++            Nothing -> -- we have to try to find it in the installed interfaces+                       -- (external packages)+              case Map.lookup modname (Map.mapKeys moduleName instIfaceMap) of+                Just iface -> return [ ExportModule (instMod iface) ]+                Nothing -> do+                  liftErrMsg $+                    tell ["Warning: " ++ pretty this_mod ++ ": Could not find " +++                          "documentation for exported module: " ++ pretty modname]+                  return []       where         m = mkModule packageId modname         packageId = modulePackageId this_mod -    +     findDecl :: Name -> Maybe DeclInfo-    findDecl n +    findDecl n       | m == this_mod = Map.lookup n declMap       | otherwise = case Map.lookup m modMap of-                      Just iface -> Map.lookup n (ifaceDeclMap iface) +                      Just iface -> Map.lookup n (ifaceDeclMap iface)                       Nothing -> Nothing       where         m = nameModule n@@ -663,7 +671,7 @@   where     mkExportItem (L _ (DocD (DocGroup lev docStr)), _, _) = do         mbDoc <- lexParseRnHaddockComment DocSectionComment gre docStr-        return $ fmap (\doc -> ExportGroup lev "" doc) mbDoc+        return $ fmap (ExportGroup lev "") mbDoc     mkExportItem (L _ (DocD (DocCommentNamed _ docStr)), _, _) = do         mbDoc <- lexParseRnHaddockComment NormalHaddockComment gre docStr         return $ fmap ExportDoc mbDoc@@ -672,23 +680,22 @@  -- | 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 +-- cases we have to extract the required declaration (and somehow cobble -- together a type signature for it...) extractDecl :: Name -> Module -> Decl -> Decl extractDecl name mdl decl   | Just n <- getMainDeclBinder (unLoc decl), n == name = decl-  | otherwise  =  +  | otherwise  =     case unLoc decl of-      TyClD d | isClassDecl d -> +      TyClD d | isClassDecl d ->         let matches = [ sig | sig <- tcdSigs d, sigName sig == Just name,                         isVanillaLSig sig ] -- TODO: document fixity---        let assocMathes = [ tyDecl | at <- tcdATs d,  ] -        in case matches of +        in case matches of           [s0] -> let (n, tyvar_names) = name_and_tyvars d                       L pos sig = extractClassDecl n tyvar_names s0                   in L pos (SigD sig)-          _ -> error "internal: extractDecl" -      TyClD d | isDataDecl d -> +          _ -> 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)@@ -703,12 +710,12 @@  extractClassDecl :: Name -> [Located Name] -> LSig Name -> LSig Name extractClassDecl c tvs0 (L pos (TypeSig lname ltype)) = case ltype of-  L _ (HsForAllTy expl tvs (L _ preds) ty) -> +  L _ (HsForAllTy expl tvs (L _ preds) ty) ->     L pos (TypeSig lname (noLoc (HsForAllTy expl tvs (lctxt preds) ty)))   _ -> L pos (TypeSig lname (noLoc (mkImplicitHsForAllTy (lctxt []) ltype)))   where     lctxt = noLoc . ctxt-    ctxt preds = noLoc (HsClassP c (map toTypeNoLoc tvs0)) : preds  +    ctxt preds = noLoc (HsClassP c (map toTypeNoLoc tvs0)) : preds extractClassDecl _ _ _ = error "extractClassDecl: unexpected decl"  @@ -718,19 +725,20 @@  extractRecSel nm mdl t tvs (L _ con : rest) =   case con_details con of-    RecCon fields | (ConDeclField n ty _ : _) <- matching_fields fields -> +    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 ]   + 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{expItemMbDoc = (d, _)}) = isJust d-	hasDoc _ = True+  where+    hasDoc (ExportDecl{expItemMbDoc = (d, _)}) = isJust d+    hasDoc _ = True   mkVisibleNames :: [ExportItem Name] -> [DocOption] -> [Name]@@ -742,7 +750,7 @@       case getMainDeclBinder $ unL $ expItemDecl e of         Just n -> n : subs         Nothing -> subs-      where subs = map fst (expItemSubDocs e) +      where subs = map fst (expItemSubDocs e)     exportName ExportNoDecl {} = [] -- we don't count these as visible, since                                     -- we don't want links to go to them.     exportName _ = []@@ -755,7 +763,7 @@     search [] = do       tell ["Cannot find documentation for: $" ++ name]       return Nothing-    search ((DocD (DocCommentNamed name' doc)):rest) +    search ((DocD (DocCommentNamed name' doc)):rest)       | name == name' = return (Just doc)       | otherwise = search rest     search (_other_decl : rest) = search rest

src/Haddock/Interface/ExtractFnArgDocs.hs view

@@ -1,4 +1,3 @@-{-# LANGUAGE PatternGuards #-} ----------------------------------------------------------------------------- -- | -- Module      :  Haddock.Interface.ExtractFnArgDocs

− src/Haddock/Interface/Lex.x

@@ -1,171 +0,0 @@------ Haddock - A Haskell Documentation Tool------ (c) Simon Marlow 2002------ This file was modified and integrated into GHC by David Waern 2006-----{-{-# OPTIONS -Wwarn -w #-}--- The above warning supression flag is a temporary kludge.--- While working on this module you are encouraged to remove it and fix--- any warnings in the module. See---     http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings--- for details--module Haddock.Interface.Lex (-	Token(..),-	tokenise- ) where--import Lexer hiding (Token)-import Parser ( parseIdentifier )-import StringBuffer-import RdrName-import SrcLoc-import DynFlags--import Data.Char-import Numeric-import System.IO.Unsafe-}--$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?	{ strtokenNL 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 { strtokenNL 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 [RdrName]-  | 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' _       -> 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 _ cont -> act str new_sc cont--token :: Token -> Action-token t = \_ sc cont -> t : cont sc--strtoken, strtokenNL :: (String -> Token) -> Action-strtoken t = \str sc cont -> t str : cont sc-strtokenNL t = \str sc cont -> t (filter (/= '\r') str) : cont sc--- ^ We only want LF line endings in our internal doc string format, so we--- filter out all CRs.--begin :: StartCode -> Action-begin sc = \_ _ 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 [RdrName]-strToHsQNames str0 = -  let buffer = unsafePerformIO (stringToStringBuffer str0)-      pstate = mkPState buffer noSrcLoc defaultDynFlags-      result = unP parseIdentifier pstate -  in case result of -       POk _ name -> Just [unLoc name] -       _ -> Nothing-}

src/Haddock/Interface/LexParseRn.hs view

@@ -19,24 +19,19 @@   ) where  import Haddock.Types--import Data.Maybe--#if __GLASGOW_HASKELL__ >= 611-import Haddock.Interface.Lex-import Haddock.Interface.Parse+import Haddock.Lex+import Haddock.Parse import Haddock.Interface.Rn import Haddock.Interface.ParseModuleHeader-import Haddock.HsDoc+import Haddock.Doc+import Data.Maybe import FastString-#endif- import GHC import RdrName  data HaddockCommentType = NormalHaddockComment | DocSectionComment -lexParseRnHaddockCommentList :: HaddockCommentType -> GlobalRdrEnv -> [HsDocString] -> ErrMsgM (Maybe (HsDoc Name))+lexParseRnHaddockCommentList :: HaddockCommentType -> GlobalRdrEnv -> [HsDocString] -> ErrMsgM (Maybe (Doc Name)) lexParseRnHaddockCommentList hty gre docStrs = do   docMbs <- mapM (lexParseRnHaddockComment hty gre) docStrs   let docs = catMaybes docMbs@@ -46,31 +41,25 @@     _ -> return (Just doc)  lexParseRnHaddockComment :: HaddockCommentType ->-    GlobalRdrEnv -> HsDocString -> ErrMsgM (Maybe (HsDoc Name))-#if __GLASGOW_HASKELL__ >= 611+    GlobalRdrEnv -> HsDocString -> ErrMsgM (Maybe (Doc Name)) lexParseRnHaddockComment hty gre (HsDocString fs) = do    let str = unpackFS fs    let toks = tokenise str    let parse = case hty of-         NormalHaddockComment -> parseHaddockParagraphs-         DocSectionComment -> parseHaddockString+         NormalHaddockComment -> parseParas+         DocSectionComment -> parseString    case parse toks of      Nothing -> do        tell ["doc comment parse failed: "++str]        return Nothing-     Just doc -> do-       return (Just (rnHsDoc gre doc))-#else-lexParseRnHaddockComment _ _ doc = return (Just doc)-#endif+     Just doc -> return (Just (rnDoc gre doc)) -lexParseRnMbHaddockComment :: HaddockCommentType -> GlobalRdrEnv -> Maybe HsDocString -> ErrMsgM (Maybe (HsDoc Name))+lexParseRnMbHaddockComment :: HaddockCommentType -> GlobalRdrEnv -> Maybe HsDocString -> ErrMsgM (Maybe (Doc Name)) lexParseRnMbHaddockComment _ _ Nothing = return Nothing lexParseRnMbHaddockComment hty gre (Just d) = lexParseRnHaddockComment hty gre d  -- yes, you always get a HaddockModInfo though it might be empty-lexParseRnHaddockModHeader :: GlobalRdrEnv -> GhcDocHdr -> ErrMsgM (HaddockModInfo Name, Maybe (HsDoc Name))-#if __GLASGOW_HASKELL__ >= 611+lexParseRnHaddockModHeader :: GlobalRdrEnv -> GhcDocHdr -> ErrMsgM (HaddockModInfo Name, Maybe (Doc Name)) lexParseRnHaddockModHeader gre mbStr = do   let failure = (emptyHaddockModInfo, Nothing)   case mbStr of@@ -82,8 +71,4 @@           tell ["haddock module header parse failed: " ++ mess]           return failure         Right (info, doc) ->-          return (rnHaddockModInfo gre info, Just (rnHsDoc gre doc))-#else-lexParseRnHaddockModHeader _ hdr = return hdr-#endif-+          return (rnHaddockModInfo gre info, Just (rnDoc gre doc))

− src/Haddock/Interface/Parse.y

@@ -1,106 +0,0 @@-{-{-# OPTIONS -Wwarn -w #-}--- The above warning supression flag is a temporary kludge.--- While working on this module you are encouraged to remove it and fix--- any warnings in the module. See---     http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings--- for details--module Haddock.Interface.Parse (-  parseHaddockParagraphs, -  parseHaddockString -) where--import Haddock.Interface.Lex-import Haddock.Types (HsDoc(..))-import Haddock.HsDoc-import HsSyn-import RdrName-}--%expect 0--%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 { Maybe }--%name parseHaddockParagraphs  doc-%name parseHaddockString seq--%%--doc	:: { HsDoc RdrName }-	: apara PARA doc	{ docAppend $1 $3 }-	| PARA doc 		{ $2 }-	| apara			{ $1 }-	| {- empty -}		{ DocEmpty }--apara	:: { HsDoc RdrName }-	: ulpara		{ DocUnorderedList [$1] }-	| olpara		{ DocOrderedList [$1] }-        | defpara               { DocDefList [$1] }-	| para			{ $1 }--ulpara  :: { HsDoc RdrName }-	: '-' para		{ $2 }--olpara  :: { HsDoc RdrName } -	: '(n)' para		{ $2 }--defpara :: { (HsDoc RdrName, HsDoc RdrName) }-	: '[' seq ']' seq	{ ($2, $4) }--para    :: { HsDoc RdrName }-	: seq			{ docParagraph $1 }-	| codepara		{ DocCodeBlock $1 }--codepara :: { HsDoc RdrName }-	: '>..' codepara	{ docAppend (DocString $1) $2 }-	| '>..'			{ DocString $1 }--seq	:: { HsDoc RdrName }-	: elem seq		{ docAppend $1 $2 }-	| elem			{ $1 }--elem	:: { HsDoc RdrName }-	: elem1			{ $1 }-	| '@' seq1 '@'		{ DocMonospaced $2 }--seq1	:: { HsDoc RdrName }-	: PARA seq1             { docAppend (DocString "\n") $2 }-	| elem1 seq1            { docAppend $1 $2 }-	| elem1			{ $1 }--elem1	:: { HsDoc RdrName }-	: 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] -> Maybe a-happyError toks = Nothing-}

src/Haddock/Interface/ParseModuleHeader.hs view

@@ -13,8 +13,8 @@ module Haddock.Interface.ParseModuleHeader (parseModuleHeader) where  import Haddock.Types-import Haddock.Interface.Lex-import Haddock.Interface.Parse+import Haddock.Lex+import Haddock.Parse  import RdrName @@ -26,7 +26,7 @@ -- 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 (HaddockModInfo RdrName, HsDoc RdrName)+parseModuleHeader :: String -> Either String (HaddockModInfo RdrName, Doc RdrName) parseModuleHeader str0 =    let       getKey :: String -> String -> (Maybe String,String)@@ -43,16 +43,16 @@       (stabilityOpt,str7) = getKey "Stability" str6       (portabilityOpt,str8) = getKey "Portability" str7 -      description1 :: Either String (Maybe (HsDoc RdrName))+      description1 :: Either String (Maybe (Doc RdrName))       description1 = case descriptionOpt of          Nothing -> Right Nothing-         Just description -> case parseHaddockString . tokenise $ description of+         Just description -> case parseString . tokenise $ description of             Nothing -> Left ("Cannot parse Description: " ++ description)             Just doc -> Right (Just doc)    in       case description1 of          Left mess -> Left mess-         Right docOpt -> case parseHaddockParagraphs . tokenise $ str8 of+         Right docOpt -> case parseParas . tokenise $ str8 of            Nothing -> Left "Cannot parse header documentation paragraphs"            Just doc -> Right (HaddockModInfo {             hmi_description = docOpt,

src/Haddock/Interface/Rename.hs view

@@ -37,8 +37,13 @@   let localEnv = foldl fn renamingEnv (ifaceVisibleExports iface)         where fn env name = Map.insert name (ifaceMod iface) env -      docMap = Map.map (\(_,x,_) -> x) (ifaceDeclMap iface)-      docs   = Map.toList docMap+      docMap   = Map.map (\(_,x,_) -> x) (ifaceDeclMap iface)++      -- make instance docs into 'docForDecls'+      instDocs = [ (name, (Just doc, Map.empty))+                 | (name, doc) <- Map.toList (ifaceInstanceDocMap iface) ]++      docs     = Map.toList docMap ++ instDocs       renameMapElem (k,d) = do d' <- renameDocForDecl d; return (k, d')        -- rename names in the exported declarations to point to things that@@ -141,30 +146,22 @@ renameExportItems = mapM renameExportItem  -renameDocForDecl :: (Maybe (HsDoc Name), FnArgsDoc Name) -> RnM (Maybe (HsDoc DocName), FnArgsDoc DocName)+renameDocForDecl :: (Maybe (Doc Name), FnArgsDoc Name) -> RnM (Maybe (Doc DocName), FnArgsDoc DocName) renameDocForDecl (mbDoc, fnArgsDoc) = do   mbDoc' <- renameMaybeDoc mbDoc   fnArgsDoc' <- renameFnArgsDoc fnArgsDoc   return (mbDoc', fnArgsDoc')  -renameMaybeDoc :: Maybe (HsDoc Name) -> RnM (Maybe (HsDoc DocName))+renameMaybeDoc :: Maybe (Doc Name) -> RnM (Maybe (Doc DocName)) renameMaybeDoc = mapM renameDoc -#if __GLASGOW_HASKELL__ >= 611+ renameLDocHsSyn :: LHsDocString -> RnM LHsDocString renameLDocHsSyn = return-#else-renameLDocHsSyn :: LHsDoc Name -> RnM (LHsDoc DocName)-renameLDocHsSyn = renameLDoc --- This is inside the #if to avoid a defined-but-not-used warning.-renameLDoc :: LHsDoc Name -> RnM (LHsDoc DocName)-renameLDoc = mapM renameDoc-#endif --renameDoc :: HsDoc Name -> RnM (HsDoc DocName)+renameDoc :: Doc Name -> RnM (Doc DocName) renameDoc d = case d of   DocEmpty -> return DocEmpty   DocAppend a b -> do@@ -331,15 +328,9 @@  renameTyClD :: TyClDecl Name -> RnM (TyClDecl DocName) renameTyClD d = case d of-#if __GLASGOW_HASKELL__ >= 611   ForeignType lname b -> do     lname' <- renameL lname     return (ForeignType lname' b)-#else-  ForeignType lname a b -> do-    lname' <- renameL lname-    return (ForeignType lname' a b)-#endif    TyFamily flav lname ltyvars kind -> do     lname'   <- renameL lname@@ -448,7 +439,10 @@     decl' <- renameLDecl decl     doc'  <- renameDocForDecl doc     subs' <- mapM renameSub subs-    instances' <- mapM renameInstHead instances+    instances' <- forM instances $ \(inst, idoc) -> do+      inst' <- renameInstHead inst+      idoc' <- mapM renameDoc idoc+      return (inst', idoc')     return (ExportDecl decl' doc' subs' instances')   ExportNoDecl x subs -> do     x'    <- lookupRn id x

src/Haddock/Interface/Rn.hs view

@@ -1,5 +1,5 @@ -module Haddock.Interface.Rn ( rnHsDoc, rnHaddockModInfo ) where+module Haddock.Interface.Rn ( rnDoc, rnHaddockModInfo ) where  import Haddock.Types @@ -11,7 +11,7 @@  rnHaddockModInfo :: GlobalRdrEnv -> HaddockModInfo RdrName -> HaddockModInfo Name rnHaddockModInfo gre (HaddockModInfo desc port stab maint) =-  HaddockModInfo (fmap (rnHsDoc gre) desc) port stab maint+  HaddockModInfo (fmap (rnDoc gre) desc) port stab maint  ids2string :: [RdrName] -> String ids2string []    = []@@ -20,8 +20,8 @@ data Id x = Id {unId::x} instance Monad Id where (Id v)>>=f = f v; return = Id -rnHsDoc :: GlobalRdrEnv -> HsDoc RdrName -> HsDoc Name-rnHsDoc gre = unId . do_rn+rnDoc :: GlobalRdrEnv -> Doc RdrName -> Doc Name+rnDoc gre = unId . do_rn   where  do_rn doc_to_rn = case doc_to_rn of

src/Haddock/InterfaceFile.hs view

@@ -54,11 +54,7 @@ -- because we store GHC datatypes in our interface files, we need to make sure -- we version our interface files accordingly. binaryInterfaceVersion :: Word16-#if __GLASGOW_HASKELL__ == 610-binaryInterfaceVersion = 14-#elif __GLASGOW_HASKELL__ == 611-binaryInterfaceVersion = 15-#elif __GLASGOW_HASKELL__ == 612+#if __GLASGOW_HASKELL__ == 612 binaryInterfaceVersion = 15 #elif __GLASGOW_HASKELL__ == 613 binaryInterfaceVersion = 15@@ -376,7 +372,7 @@   {-* Generated by DrIFT : Look, but Don't Touch. *-}-instance (Binary id) => Binary (HsDoc id) where+instance (Binary id) => Binary (Doc id) where     put_ bh DocEmpty = do             putByte bh 0     put_ bh (DocAppend aa ab) = do

+ src/Haddock/Lex.x view

@@ -0,0 +1,172 @@+--+-- Haddock - A Haskell Documentation Tool+--+-- (c) Simon Marlow 2002+--+-- This file was modified and integrated into GHC by David Waern 2006.+-- Then moved back into Haddock by Isaac Dupree in 2009 :-)+--++{+{-# OPTIONS -Wwarn -w #-}+-- The above warning supression flag is a temporary kludge.+-- While working on this module you are encouraged to remove it and fix+-- any warnings in the module. See+--     http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings+-- for details++module Haddock.Lex (+	Token(..),+	tokenise+ ) where++import Lexer hiding (Token)+import Parser ( parseIdentifier )+import StringBuffer+import RdrName+import SrcLoc+import DynFlags++import Data.Char+import Numeric+import System.IO.Unsafe+}++$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?	{ strtokenNL 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 { strtokenNL 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 [RdrName]+  | 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' _       -> 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 _ cont -> act str new_sc cont++token :: Token -> Action+token t = \_ sc cont -> t : cont sc++strtoken, strtokenNL :: (String -> Token) -> Action+strtoken t = \str sc cont -> t str : cont sc+strtokenNL t = \str sc cont -> t (filter (/= '\r') str) : cont sc+-- ^ We only want LF line endings in our internal doc string format, so we+-- filter out all CRs.++begin :: StartCode -> Action+begin sc = \_ _ 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 [RdrName]+strToHsQNames str0 = +  let buffer = unsafePerformIO (stringToStringBuffer str0)+      pstate = mkPState buffer noSrcLoc defaultDynFlags+      result = unP parseIdentifier pstate +  in case result of +       POk _ name -> Just [unLoc name] +       _ -> Nothing+}

src/Haddock/ModuleTree.hs view

@@ -12,23 +12,23 @@  module Haddock.ModuleTree ( ModuleTree(..), mkModuleTree ) where -import Haddock.Types ( HsDoc )+import Haddock.Types ( Doc )  import GHC           ( Name )-import Module        ( Module, moduleNameString, moduleName, modulePackageId )-import Module (packageIdString)+import Module        ( Module, moduleNameString, moduleName, modulePackageId,+                       packageIdString ) -data ModuleTree = Node String Bool (Maybe String) (Maybe (HsDoc Name)) [ModuleTree]+data ModuleTree = Node String Bool (Maybe String) (Maybe (Doc Name)) [ModuleTree] -mkModuleTree :: Bool -> [(Module, Maybe (HsDoc Name))] -> [ModuleTree]+mkModuleTree :: Bool -> [(Module, Maybe (Doc Name))] -> [ModuleTree] mkModuleTree showPkgs mods =    foldr fn [] [ (splitModule mdl, modPkg mdl, short) | (mdl, short) <- mods ]   where     modPkg mod_ | showPkgs = Just (packageIdString (modulePackageId mod_))                 | otherwise = Nothing-    fn (mod_,pkg,short) trees = addToTrees mod_ pkg short trees+    fn (mod_,pkg,short) = addToTrees mod_ pkg short -addToTrees :: [String] -> Maybe String -> Maybe (HsDoc Name) -> [ModuleTree] -> [ModuleTree]+addToTrees :: [String] -> Maybe String -> Maybe (Doc Name) -> [ModuleTree] -> [ModuleTree] addToTrees [] _ _ 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)@@ -39,7 +39,7 @@   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 :: [String] -> Maybe String -> Maybe (Doc Name) -> [ModuleTree] mkSubTree []     _   _     = [] mkSubTree [s]    pkg short = [Node s True pkg short []] mkSubTree (s:ss) pkg short = [Node s (null ss) Nothing Nothing (mkSubTree ss pkg short)]

+ src/Haddock/Parse.y view

@@ -0,0 +1,103 @@+{+{-# OPTIONS -Wwarn -w #-}+-- The above warning supression flag is a temporary kludge.+-- While working on this module you are encouraged to remove it and fix+-- any warnings in the module. See+--     http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings+-- for details++module Haddock.Parse where++import Haddock.Lex+import Haddock.Types (Doc(..))+import Haddock.Doc+import HsSyn+import RdrName+}++%expect 0++%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 { Maybe }++%name parseParas doc+%name parseString seq++%%++doc	:: { Doc RdrName }+	: apara PARA doc	{ docAppend $1 $3 }+	| PARA doc 		{ $2 }+	| apara			{ $1 }+	| {- empty -}		{ DocEmpty }++apara	:: { Doc RdrName }+	: ulpara		{ DocUnorderedList [$1] }+	| olpara		{ DocOrderedList [$1] }+        | defpara               { DocDefList [$1] }+	| para			{ $1 }++ulpara  :: { Doc RdrName }+	: '-' para		{ $2 }++olpara  :: { Doc RdrName } +	: '(n)' para		{ $2 }++defpara :: { (Doc RdrName, Doc RdrName) }+	: '[' seq ']' seq	{ ($2, $4) }++para    :: { Doc RdrName }+	: seq			{ docParagraph $1 }+	| codepara		{ DocCodeBlock $1 }++codepara :: { Doc RdrName }+	: '>..' codepara	{ docAppend (DocString $1) $2 }+	| '>..'			{ DocString $1 }++seq	:: { Doc RdrName }+	: elem seq		{ docAppend $1 $2 }+	| elem			{ $1 }++elem	:: { Doc RdrName }+	: elem1			{ $1 }+	| '@' seq1 '@'		{ DocMonospaced $2 }++seq1	:: { Doc RdrName }+	: PARA seq1             { docAppend (DocString "\n") $2 }+	| elem1 seq1            { docAppend $1 $2 }+	| elem1			{ $1 }++elem1	:: { Doc RdrName }+	: 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] -> Maybe a+happyError toks = Nothing+}

src/Haddock/Types.hs view

@@ -1,5 +1,5 @@ {-# OPTIONS_HADDOCK hide #-}-{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveDataTypeable, DeriveFunctor #-} ----------------------------------------------------------------------------- -- | -- Module      :  Haddock.Types@@ -17,37 +17,34 @@  module Haddock.Types (   module Haddock.Types--- avoid duplicate-export warnings, use the conditional to only--- mention things not defined in this module:-#if __GLASGOW_HASKELL__ >= 611   , HsDocString, LHsDocString-#else-  , HsDoc(..), LHsDoc, HaddockModInfo(..), emptyHaddockModInfo-#endif  ) where   import Control.Exception+import Control.Arrow import Data.Typeable import Data.Map (Map) import qualified Data.Map as Map import GHC hiding (NoLink) import Name +#ifdef TEST+import Test.QuickCheck+#endif  -- convenient short-hands type Decl = LHsDecl Name-type Doc  = HsDoc Name -#if __GLASGOW_HASKELL__ <= 610-type HsDocString = HsDoc Name-type LHsDocString = Located HsDocString-#endif +-- | An instance head that may have documentation.+type DocInstance name = (InstHead name, Maybe (Doc name))++ -- | Arguments and result are indexed by Int, zero-based from the left, -- because that's the easiest to use when recursing over types.-type FnArgsDoc name = Map Int (HsDoc name)-type DocForDecl name = (Maybe (HsDoc name), FnArgsDoc name)+type FnArgsDoc name = Map Int (Doc name)+type DocForDecl name = (Maybe (Doc name), FnArgsDoc name)  noDocForDecl :: DocForDecl name noDocForDecl = (Nothing, Map.empty)@@ -57,13 +54,13 @@ type DeclInfo = (Decl, DocForDecl Name, [(Name, DocForDecl Name)])  --- | A 'DocName' is an identifier that may be documented. The 'Module'--- component specifies the place which we want to link to in the documentation.-data DocName = Documented Name Module | Undocumented Name-  deriving Eq+-- | An extension of 'Name' that may contain the preferred place to link to in+-- the documentation.+data DocName = Documented Name Module | Undocumented Name deriving Eq+-- TODO: simplify to data DocName = DocName Name (Maybe Module)  --- | The 'OccName' belonging to this name+-- | The 'OccName' of this name. docNameOcc :: DocName -> OccName docNameOcc = nameOccName . getName @@ -74,6 +71,7 @@   {-! for DocOption derive: Binary !-}+-- | Source-level options for controlling the documentation. data DocOption   = OptHide           -- ^ This module should not appear in the docs   | OptPrune@@ -85,11 +83,11 @@  data ExportItem name -  = ExportDecl {		  		-	+  = ExportDecl {+       -- | A declaration-      expItemDecl :: LHsDecl name, -			       +      expItemDecl :: LHsDecl name,+       -- | Maybe a doc comment, and possibly docs for arguments (if this       -- decl is a function or type-synonym)       expItemMbDoc :: DocForDecl name,@@ -97,52 +95,56 @@       -- | Subordinate names, possibly with documentation       expItemSubDocs :: [(name, DocForDecl name)], -      -- | Instances relevant to this declaration-      expItemInstances :: [InstHead name]-	-	  }	-- ^ An exported declaration -		    +      -- | Instances relevant to this declaration, possibly with documentation+      expItemInstances :: [DocInstance name]++    } -- ^ An exported declaration+   | ExportNoDecl {       expItemName :: name,        -- | Subordinate names       expItemSubs :: [name] -		} -- ^ An exported entity for which we have no -          -- documentation (perhaps because it resides in-          -- another package)+    } -- ^ An exported entity for which we have no+      -- documentation (perhaps because it resides in+      -- another package) -  | ExportGroup { +  | ExportGroup {        -- | Section level (1, 2, 3, ... )       expItemSectionLevel :: Int,        -- | Section id (for hyperlinks)-      expItemSectionId :: String,     -			+      expItemSectionId :: String,+       -- | Section heading text-      expItemSectionText :: HsDoc name+      expItemSectionText :: Doc name      } -- ^ A section heading -  | ExportDoc (HsDoc name) -- ^ Some documentation+  | ExportDoc (Doc name) -- ^ Some documentation    | ExportModule Module    -- ^ A cross-reference to another module  +-- | The head of an instance. Consists of a context, a class name and a list of+-- instance types. type InstHead name = ([HsPred name], name, [HsType name])++ type ModuleMap     = Map Module Interface type InstIfaceMap  = Map Module InstalledInterface-type DocMap        = Map Name (HsDoc DocName)+type DocMap        = Map Name (Doc DocName)++-- | An environment used to create hyper-linked syntax. type LinkEnv       = Map Name Module -#if __GLASGOW_HASKELL__ >= 611+ type GhcDocHdr = Maybe LHsDocString-#else-type GhcDocHdr = (HaddockModInfo Name, Maybe (HsDoc Name))-#endif --- | This structure holds the module information we get from GHC's ++-- | This structure holds the module information we get from GHC's -- type checking phase data GhcModule = GhcModule {    ghcModule         :: Module,@@ -158,36 +160,37 @@ }  --- | 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 +-- | 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 module represented by this interface+  -- | The module represented by this interface.   ifaceMod             :: Module, -  -- | The original filename for this module+  -- | Original file name of the module.   ifaceOrigFilename    :: FilePath, -  -- | Textual information about the module +  -- | Textual information about the module.   ifaceInfo            :: !(HaddockModInfo Name), -  -- | The documentation header for this module-  ifaceDoc             :: !(Maybe (HsDoc Name)),+  -- | Documentation header.+  ifaceDoc             :: !(Maybe (Doc Name)), -  -- | The renamed documentation header for this module-  ifaceRnDoc           :: Maybe (HsDoc DocName),+  -- | Documentation header with link information.+  ifaceRnDoc           :: Maybe (Doc DocName), -  -- | The Haddock options for this module (prune, ignore-exports, etc)+  -- | Haddock options for this module (prune, ignore-exports, etc).   ifaceOptions         :: ![DocOption], -  -- | The declarations of the module.  Excludes declarations that don't-  -- have names (instances and stand-alone documentation comments). Includes-  -- subordinate names, but they are mapped to their parent declarations.+  -- | Declarations originating from the module. Excludes declarations without+  -- names (instances and stand-alone documentation comments). Includes+  -- names of subordinate declarations mapped to their parent declarations.   ifaceDeclMap         :: Map Name DeclInfo, -  -- | Everything declared in the module (including subordinates) that has docs+  -- | Documentation of declarations originating from the module (including+  -- subordinates).   ifaceRnDocMap        :: Map Name (DocForDecl DocName),    ifaceSubMap          :: Map Name [Name],@@ -195,58 +198,45 @@   ifaceExportItems     :: ![ExportItem Name],   ifaceRnExportItems   :: [ExportItem DocName], -  -- | All names defined in this module-  ifaceLocals          :: ![Name],--  -- | All names exported by this module+  -- | All names exported by the 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.+  -- | All \"visible\" names exported by the module.+  -- A visible name is a name that will show up in the documentation of the+  -- module.   ifaceVisibleExports  :: ![Name], -  -- | The instances exported by this module-  ifaceInstances       :: ![Instance]+  -- | Instances exported by the module.+  ifaceInstances       :: ![Instance],++  -- | Documentation of instances defined in the module.+  ifaceInstanceDocMap  :: Map Name (Doc Name) }  --- | A smaller version of 'Interface' that we can get from the Haddock--- interface files.+-- | A smaller version of 'Interface' that can be created from Haddock's+-- interface files ('InterfaceFile'). data InstalledInterface = InstalledInterface { -  -- | The module represented by this interface+  -- | The module represented by this interface.   instMod            :: Module, -  -- | Textual information about the module +  -- | Textual information about the module.   instInfo           :: HaddockModInfo Name, -  -- | Everything declared in the module (including subordinates) that has docs+  -- | Documentation of declarations originating from the module (including+  -- subordinates).   instDocMap         :: Map Name (DocForDecl Name), -  -- | All names exported by this module+  -- | All names exported by this module.   instExports        :: [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.+  -- | All \"visible\" names exported by the module.+  -- A visible name is a name that will show up in the documentation of the+  -- module.   instVisibleExports :: [Name], -  -- | The Haddock options for this module (prune, ignore-exports, etc)+  -- | Haddock options for this module (prune, ignore-exports, etc).   instOptions        :: [DocOption],    instSubMap         :: Map Name [Name]@@ -265,34 +255,57 @@   instSubMap         = ifaceSubMap         interface } -unrenameHsDoc :: HsDoc DocName -> HsDoc Name-unrenameHsDoc = fmapHsDoc getName+unrenameDoc :: Doc DocName -> Doc Name+unrenameDoc = fmap getName unrenameDocForDecl :: DocForDecl DocName -> DocForDecl Name unrenameDocForDecl (mbDoc, fnArgsDoc) =-    (fmap unrenameHsDoc mbDoc, fmap unrenameHsDoc fnArgsDoc)+    (fmap unrenameDoc mbDoc, fmap unrenameDoc fnArgsDoc) -#if __GLASGOW_HASKELL__ >= 611-data HsDoc id++data Doc id   = DocEmpty-  | DocAppend (HsDoc id) (HsDoc id)+  | DocAppend (Doc id) (Doc id)   | DocString String-  | DocParagraph (HsDoc id)+  | DocParagraph (Doc id)   | DocIdentifier [id]   | DocModule String-  | DocEmphasis (HsDoc id)-  | DocMonospaced (HsDoc id)-  | DocUnorderedList [HsDoc id]-  | DocOrderedList [HsDoc id]-  | DocDefList [(HsDoc id, HsDoc id)]-  | DocCodeBlock (HsDoc id)+  | DocEmphasis (Doc id)+  | DocMonospaced (Doc id)+  | DocUnorderedList [Doc id]+  | DocOrderedList [Doc id]+  | DocDefList [(Doc id, Doc id)]+  | DocCodeBlock (Doc id)   | DocURL String   | DocPic String   | DocAName String-  deriving (Eq, Show)+  deriving (Eq, Show, Functor) -type LHsDoc id = Located (HsDoc id)++#ifdef TEST+-- TODO: use derive+instance Arbitrary a => Arbitrary (Doc a) where+  arbitrary =+    oneof [ return DocEmpty+          , do { a <- arbitrary; b <- arbitrary; return (DocAppend a b) }+          , fmap DocString arbitrary+          , fmap DocParagraph arbitrary+          , fmap DocIdentifier arbitrary+          , fmap DocModule arbitrary+          , fmap DocEmphasis arbitrary+          , fmap DocMonospaced arbitrary+          , fmap DocUnorderedList arbitrary+          , fmap DocOrderedList arbitrary+          , fmap DocDefList arbitrary+          , fmap DocCodeBlock arbitrary+          , fmap DocURL arbitrary+          , fmap DocPic arbitrary+          , fmap DocAName arbitrary ] #endif ++type LDoc id = Located (Doc id)++ data DocMarkup id a = Markup {   markupEmpty         :: a,   markupString        :: String -> a,@@ -311,14 +324,15 @@   markupPic           :: String -> a } -#if __GLASGOW_HASKELL__ >= 611+ data HaddockModInfo name = HaddockModInfo {-        hmi_description :: Maybe (HsDoc name),+        hmi_description :: Maybe (Doc name),         hmi_portability :: Maybe String,         hmi_stability   :: Maybe String,         hmi_maintainer  :: Maybe String } + emptyHaddockModInfo :: HaddockModInfo a emptyHaddockModInfo = HaddockModInfo {         hmi_description = Nothing,@@ -326,7 +340,6 @@         hmi_stability   = Nothing,         hmi_maintainer  = Nothing }-#endif   -- A monad which collects error messages, locally defined to avoid a dep on mtl@@ -380,28 +393,8 @@ --tell :: [ErrMsg] -> ErrMsgGhc () --tell msgs = WriterGhc $ return ( (), msgs ) instance Functor ErrMsgGhc where-  fmap f (WriterGhc x) = WriterGhc (fmap (\(a,msgs)->(f a,msgs)) x)+  fmap f (WriterGhc x) = WriterGhc (fmap (first f) x) instance Monad ErrMsgGhc where   return a = WriterGhc (return (a, []))   m >>= k = WriterGhc $ runWriterGhc m >>= \ (a, msgs1) ->-               fmap (\ (b, msgs2) -> (b, msgs1 ++ msgs2)) (runWriterGhc (k a))---- When HsDoc syntax is part of the Haddock codebase, we'll just--- declare a Functor instance.-fmapHsDoc :: (a->b) -> HsDoc a -> HsDoc b-fmapHsDoc _ DocEmpty = DocEmpty-fmapHsDoc f (DocAppend a b) = DocAppend (fmapHsDoc f a) (fmapHsDoc f b)-fmapHsDoc _ (DocString s) = DocString s-fmapHsDoc _ (DocModule s) = DocModule s-fmapHsDoc _ (DocURL s) = DocURL s-fmapHsDoc _ (DocPic s) = DocPic s-fmapHsDoc _ (DocAName s) = DocAName s-fmapHsDoc f (DocParagraph a) = DocParagraph (fmapHsDoc f a)-fmapHsDoc f (DocEmphasis a) = DocEmphasis (fmapHsDoc f a)-fmapHsDoc f (DocMonospaced a) = DocMonospaced (fmapHsDoc f a)-fmapHsDoc f (DocCodeBlock a) = DocMonospaced (fmapHsDoc f a)-fmapHsDoc f (DocIdentifier a) = DocIdentifier (map f a)-fmapHsDoc f (DocOrderedList a) = DocOrderedList (map (fmapHsDoc f) a)-fmapHsDoc f (DocUnorderedList a) = DocUnorderedList (map (fmapHsDoc f) a)-fmapHsDoc f (DocDefList a) = DocDefList (map (\(b,c)->(fmapHsDoc f b, fmapHsDoc f c)) a)-+               fmap (second (msgs1 ++)) (runWriterGhc (k a))

src/Haddock/Utils.hs view

@@ -33,7 +33,7 @@   -- * HTML cross reference mapping   html_xrefs_ref, -  -- * HsDoc markup +  -- * Doc markup    markup,    idMarkup, @@ -102,11 +102,11 @@   -- | extract a module's short description.-toDescription :: Interface -> Maybe (HsDoc Name)+toDescription :: Interface -> Maybe (Doc Name) toDescription = hmi_description . ifaceInfo  -- | extract a module's short description.-toInstalledDescription :: InstalledInterface -> Maybe (HsDoc Name)+toInstalledDescription :: InstalledInterface -> Maybe (Doc Name) toInstalledDescription = hmi_description . instInfo  @@ -311,7 +311,7 @@ ----------------------------------------------------------------------------- -- put here temporarily -markup :: DocMarkup id a -> HsDoc id -> a+markup :: DocMarkup id a -> Doc 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@@ -328,11 +328,11 @@ markup m (DocAName ref)        = markupAName m ref markup m (DocPic img)          = markupPic m img -markupPair :: DocMarkup id a -> (HsDoc id, HsDoc id) -> (a, a)+markupPair :: DocMarkup id a -> (Doc id, Doc id) -> (a, a) markupPair m (a,b) = (markup m a, markup m b)  -- | The identity markup-idMarkup :: DocMarkup a (HsDoc a)+idMarkup :: DocMarkup a (Doc a) idMarkup = Markup {   markupEmpty         = DocEmpty,   markupString        = DocString,

− src/Haddock/Utils/FastMutInt2.hs

@@ -1,62 +0,0 @@-{-# 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-#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/Main.hs view

@@ -22,8 +22,8 @@ import Haddock.Backends.Html import Haddock.Backends.Hoogle import Haddock.Interface-import Haddock.Interface.Lex-import Haddock.Interface.Parse+import Haddock.Lex+import Haddock.Parse import Haddock.Types import Haddock.Version import Haddock.InterfaceFile@@ -90,14 +90,14 @@   catches inner [Handler handler]   where     handler (e::HaddockException) = do-      putStrLn $ "haddock: " ++ (show e)+      putStrLn $ "haddock: " ++ show e       exitFailure   handleGhcExceptions :: IO a -> IO a-handleGhcExceptions inner =+handleGhcExceptions =   -- error messages propagated as exceptions-  handleGhcException (\e -> do+  handleGhcException $ \e -> do     hFlush stdout     case e of       PhaseFailed _ code -> exitWith code@@ -105,7 +105,6 @@       _ -> do         print (e :: GhcException)         exitFailure-  ) inner   -------------------------------------------------------------------------------@@ -232,7 +231,7 @@                 allVisibleIfaces     copyHtmlBits odir libDir css_file -  when (Flag_GenContents `elem` flags && Flag_GenIndex `elem` flags) $ do+  when (Flag_GenContents `elem` flags && Flag_GenIndex `elem` flags) $     ppHtmlHelpFiles title packageStr visibleIfaces odir maybe_html_help_format []    when (Flag_GenContents `elem` flags) $ do@@ -272,7 +271,7 @@       case eIface of         Left err -> liftIO $ do           putStrLn ("Warning: Cannot read " ++ iface ++ ":")-          putStrLn ("   " ++ show err)+          putStrLn ("   " ++ err)           putStrLn "Skipping this interface."           return Nothing         Right f -> return $ Just (f, html)@@ -322,7 +321,7 @@       -- TODO: handle warnings?       (dynflags', rest, _) <- parseDynamicFlags dynflags flags_       if not (null rest)-        then throwE ("Couldn't parse GHC options: " ++ (unwords origFlags))+        then throwE ("Couldn't parse GHC options: " ++ unwords origFlags)         else return dynflags'  @@ -331,7 +330,7 @@ -------------------------------------------------------------------------------  getHaddockLibDir :: [Flag] -> IO String-getHaddockLibDir flags = do+getHaddockLibDir flags =   case [str | Flag_Lib str <- flags] of     [] -> #ifdef IN_GHC_TREE@@ -342,7 +341,7 @@     fs -> return (last fs)  getGhcLibDir :: [Flag] -> IO String-getGhcLibDir flags = do+getGhcLibDir flags =   case [ dir | Flag_GhcLibDir dir <- flags ] of     [] -> #ifdef IN_GHC_TREE@@ -374,12 +373,12 @@     dir <- getGhcLibDir flags     bye $ dir ++ "\n" -  when (Flag_UseUnicode `elem` flags && not (Flag_Html `elem` flags)) $-  	throwE ("Unicode can only be enabled for HTML output.")+  when (Flag_UseUnicode `elem` flags && Flag_Html `notElem` flags) $+    throwE "Unicode can only be enabled for HTML output."    when ((Flag_GenIndex `elem` flags || Flag_GenContents `elem` flags)         && Flag_Html `elem` flags) $-    throwE ("-h cannot be used with --gen-index or --gen-contents")+    throwE "-h cannot be used with --gen-index or --gen-contents"   where     byeVersion = bye $       "Haddock version " ++ projectVersion ++ ", (c) Simon Marlow 2006\n"@@ -389,20 +388,19 @@   updateHTMLXRefs :: [(InterfaceFile, FilePath)] -> IO ()-updateHTMLXRefs packages = do-  writeIORef html_xrefs_ref (Map.fromList mapping)+updateHTMLXRefs packages = 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 :: [Flag] -> IO (Maybe (Doc RdrName)) getPrologue flags =   case [filename | Flag_Prologue filename <- flags ] of     [] -> return Nothing     [filename] -> do       str <- readFile filename-      case parseHaddockParagraphs (tokenise str) of+      case parseParas (tokenise str) of         Nothing -> throwE "parsing haddock prologue failed"         Just doc -> return (Just doc)     _otherwise -> throwE "multiple -p/--prologue options"