Move sources under haddock-api/src

7 files changed, 0 insertions, 1898 deletions

diff --git a/src/Haddock/Backends/Xhtml/Decl.hs b/src/Haddock/Backends/Xhtml/Decl.hs
deleted file mode 100644
index 8884f69f..00000000
--- a/src/Haddock/Backends/Xhtml/Decl.hs
+++ /dev/null
@@ -1,885 +0,0 @@
-{-# LANGUAGE TransformListComp #-}
------------------------------------------------------------------------------
--- |
--- Module      :  Haddock.Backends.Html.Decl
--- Copyright   :  (c) Simon Marlow   2003-2006,
---                    David Waern    2006-2009,
---                    Mark Lentczner 2010
--- License     :  BSD-like
---
--- Maintainer  :  haddock@projects.haskell.org
--- Stability   :  experimental
--- Portability :  portable
------------------------------------------------------------------------------
-module Haddock.Backends.Xhtml.Decl (
-  ppDecl,
-
-  ppTyName, ppTyFamHeader, ppTypeApp,
-  tyvarNames
-) where
-
-
-import Haddock.Backends.Xhtml.DocMarkup
-import Haddock.Backends.Xhtml.Layout
-import Haddock.Backends.Xhtml.Names
-import Haddock.Backends.Xhtml.Types
-import Haddock.Backends.Xhtml.Utils
-import Haddock.GhcUtils
-import Haddock.Types
-import Haddock.Doc (combineDocumentation)
-
-import           Data.List             ( intersperse, sort )
-import qualified Data.Map as Map
-import           Data.Maybe
-import           Data.Monoid           ( mempty )
-import           Text.XHtml hiding     ( name, title, p, quote )
-
-import GHC
-import GHC.Exts
-import Name
-import BooleanFormula
-
-ppDecl :: Bool -> LinksInfo -> LHsDecl DocName
-       -> DocForDecl DocName -> [DocInstance DocName] -> [(DocName, Fixity)]
-       -> [(DocName, DocForDecl DocName)] -> Splice -> Unicode -> Qualification -> Html
-ppDecl summ links (L loc decl) (mbDoc, fnArgsDoc) instances fixities subdocs splice unicode qual = case decl of
-  TyClD (FamDecl d)         -> ppTyFam summ False links instances fixities loc mbDoc d splice unicode qual
-  TyClD d@(DataDecl {})     -> ppDataDecl summ links instances fixities subdocs loc mbDoc d splice unicode qual
-  TyClD d@(SynDecl {})      -> ppTySyn summ links fixities loc (mbDoc, fnArgsDoc) d splice unicode qual
-  TyClD d@(ClassDecl {})    -> ppClassDecl summ links instances fixities loc mbDoc subdocs d splice unicode qual
-  SigD (TypeSig lnames lty) -> ppLFunSig summ links loc (mbDoc, fnArgsDoc) lnames lty fixities splice unicode qual
-  SigD (PatSynSig lname args ty prov req) ->
-      ppLPatSig summ links loc (mbDoc, fnArgsDoc) lname args ty prov req fixities splice unicode qual
-  ForD d                         -> ppFor summ links loc (mbDoc, fnArgsDoc) d fixities splice unicode qual
-  InstD _                        -> noHtml
-  _                              -> error "declaration not supported by ppDecl"
-
-
-ppLFunSig :: Bool -> LinksInfo -> SrcSpan -> DocForDecl DocName ->
-             [Located DocName] -> LHsType DocName -> [(DocName, Fixity)] ->
-             Splice -> Unicode -> Qualification -> Html
-ppLFunSig summary links loc doc lnames lty fixities splice unicode qual =
-  ppFunSig summary links loc doc (map unLoc lnames) (unLoc lty) fixities
-           splice unicode qual
-
-ppFunSig :: Bool -> LinksInfo -> SrcSpan -> DocForDecl DocName ->
-            [DocName] -> HsType DocName -> [(DocName, Fixity)] ->
-            Splice -> Unicode -> Qualification -> Html
-ppFunSig summary links loc doc docnames typ fixities splice unicode qual =
-  ppSigLike summary links loc mempty doc docnames fixities (typ, pp_typ)
-            splice unicode qual
-  where
-    pp_typ = ppType unicode qual typ
-
-ppLPatSig :: Bool -> LinksInfo -> SrcSpan -> DocForDecl DocName ->
-             Located DocName ->
-             HsPatSynDetails (LHsType DocName) -> LHsType DocName ->
-             LHsContext DocName -> LHsContext DocName -> [(DocName, Fixity)] ->
-             Splice -> Unicode -> Qualification -> Html
-ppLPatSig summary links loc doc lname args typ prov req fixities splice unicode qual =
-    ppPatSig summary links loc doc (unLoc lname) (fmap unLoc args) (unLoc typ)
-             (unLoc prov) (unLoc req) fixities splice unicode qual
-
-ppPatSig :: Bool -> LinksInfo -> SrcSpan -> DocForDecl DocName ->
-            DocName ->
-            HsPatSynDetails (HsType DocName) -> HsType DocName ->
-            HsContext DocName -> HsContext DocName -> [(DocName, Fixity)] ->
-            Splice -> Unicode -> Qualification -> Html
-ppPatSig summary links loc (doc, _argDocs) docname args typ prov req fixities
-         splice unicode qual
-  | summary = pref1
-  | otherwise = topDeclElem links loc splice [docname] (pref1 <+> ppFixities fixities qual)
-                +++ docSection qual doc
-  where
-    pref1 = hsep [ toHtml "pattern"
-                 , pp_cxt prov
-                 , pp_head
-                 , dcolon unicode
-                 , pp_cxt req
-                 , ppType unicode qual typ
-                 ]
-    pp_head = case args of
-        PrefixPatSyn typs -> hsep $ ppBinder summary occname : map pp_type typs
-        InfixPatSyn left right -> hsep [pp_type left, ppBinderInfix summary occname, pp_type right]
-
-    pp_cxt cxt = ppContext cxt unicode qual
-    pp_type = ppParendType unicode qual
-
-    occname = nameOccName . getName $ docname
-
-ppSigLike :: Bool -> LinksInfo -> SrcSpan -> Html -> DocForDecl DocName ->
-             [DocName] -> [(DocName, Fixity)] -> (HsType DocName, Html) ->
-             Splice -> Unicode -> Qualification -> Html
-ppSigLike summary links loc leader doc docnames fixities (typ, pp_typ)
-          splice unicode qual =
-  ppTypeOrFunSig summary links loc docnames typ doc
-    ( addFixities $ leader <+> ppTypeSig summary occnames pp_typ unicode
-    , addFixities . concatHtml . punctuate comma $ map (ppBinder False) occnames
-    , dcolon unicode
-    )
-    splice unicode qual
-  where
-    occnames = map (nameOccName . getName) docnames
-    addFixities html
-      | summary   = html
-      | otherwise = html <+> ppFixities fixities qual
-
-
-ppTypeOrFunSig :: Bool -> LinksInfo -> SrcSpan -> [DocName] -> HsType DocName
-               -> DocForDecl DocName -> (Html, Html, Html)
-               -> Splice -> Unicode -> Qualification -> Html
-ppTypeOrFunSig summary links loc docnames typ (doc, argDocs) (pref1, pref2, sep) splice unicode qual
-  | summary = pref1
-  | Map.null argDocs = topDeclElem links loc splice docnames pref1 +++ docSection qual doc
-  | otherwise = topDeclElem links loc splice docnames pref2 +++
-      subArguments qual (do_args 0 sep typ) +++ docSection qual doc
-  where
-    argDoc n = Map.lookup n argDocs
-
-    do_largs n leader (L _ t) = do_args n leader t
-    do_args :: Int -> Html -> HsType DocName -> [SubDecl]
-    do_args n leader (HsForAllTy Explicit tvs lctxt ltype)
-      = (leader <+>
-          hsep (forallSymbol unicode : ppTyVars tvs ++ [dot]) <+>
-          ppLContextNoArrow lctxt unicode qual,
-          Nothing, [])
-        : do_largs n (darrow unicode) ltype
-    do_args n leader (HsForAllTy Implicit _ lctxt ltype)
-      | not (null (unLoc lctxt))
-      = (leader <+> ppLContextNoArrow lctxt unicode qual,
-          Nothing, [])
-        : do_largs n (darrow unicode) ltype
-      -- if we're not showing any 'forall' or class constraints or
-      -- anything, skip having an empty line for the context.
-      | otherwise
-      = do_largs n leader ltype
-    do_args n leader (HsFunTy lt r)
-      = (leader <+> ppLFunLhType unicode qual lt, argDoc n, [])
-        : do_largs (n+1) (arrow unicode) r
-    do_args n leader t
-      = [(leader <+> ppType unicode qual t, argDoc n, [])]
-
-ppFixities :: [(DocName, Fixity)] -> Qualification -> Html
-ppFixities [] _ = noHtml
-ppFixities fs qual = foldr1 (+++) (map ppFix uniq_fs) +++ rightEdge
-  where
-    ppFix (ns, p, d) = thespan ! [theclass "fixity"] <<
-                         (toHtml d <+> toHtml (show p) <+> ppNames ns)
-
-    ppDir InfixR = "infixr"
-    ppDir InfixL = "infixl"
-    ppDir InfixN = "infix"
-
-    ppNames = case fs of
-      _:[] -> const noHtml -- Don't display names for fixities on single names
-      _    -> concatHtml . intersperse (stringToHtml ", ") . map (ppDocName qual Infix False)
-
-    uniq_fs = [ (n, the p, the d') | (n, Fixity p d) <- fs
-                                   , let d' = ppDir d
-                                   , then group by Down (p,d') using groupWith ]
-
-    rightEdge = thespan ! [theclass "rightedge"] << noHtml
-
-
-ppTyVars :: LHsTyVarBndrs DocName -> [Html]
-ppTyVars tvs = map ppTyName (tyvarNames tvs)
-
-
-tyvarNames :: LHsTyVarBndrs DocName -> [Name]
-tyvarNames = map getName . hsLTyVarNames
-
-
-ppFor :: Bool -> LinksInfo -> SrcSpan -> DocForDecl DocName
-      -> ForeignDecl DocName -> [(DocName, Fixity)]
-      -> Splice -> Unicode -> Qualification -> Html
-ppFor summary links loc doc (ForeignImport (L _ name) (L _ typ) _ _) fixities
-      splice unicode qual
-  = ppFunSig summary links loc doc [name] typ fixities splice unicode qual
-ppFor _ _ _ _ _ _ _ _ _ = error "ppFor"
-
-
--- we skip type patterns for now
-ppTySyn :: Bool -> LinksInfo -> [(DocName, Fixity)] -> SrcSpan
-        -> DocForDecl DocName -> TyClDecl DocName
-        -> Splice -> Unicode -> Qualification -> Html
-ppTySyn summary links fixities loc doc (SynDecl { tcdLName = L _ name, tcdTyVars = ltyvars
-                                                , tcdRhs = ltype })
-        splice unicode qual
-  = ppTypeOrFunSig summary links loc [name] (unLoc ltype) doc
-                   (full <+> fixs, hdr <+> fixs, spaceHtml +++ equals)
-                   splice unicode qual
-  where
-    hdr  = hsep ([keyword "type", ppBinder summary occ] ++ ppTyVars ltyvars)
-    full = hdr <+> equals <+> ppLType unicode qual ltype
-    occ  = nameOccName . getName $ name
-    fixs
-      | summary   = noHtml
-      | otherwise = ppFixities fixities qual
-ppTySyn _ _ _ _ _ _ _ _ _ = error "declaration not supported by ppTySyn"
-
-
-ppTypeSig :: Bool -> [OccName] -> Html  -> Bool -> Html
-ppTypeSig summary nms pp_ty unicode =
-  concatHtml htmlNames <+> dcolon unicode <+> pp_ty
-  where
-    htmlNames = intersperse (stringToHtml ", ") $ map (ppBinder summary) nms
-
-
-ppTyName :: Name -> Html
-ppTyName = ppName Prefix
-
-
---------------------------------------------------------------------------------
--- * Type families
---------------------------------------------------------------------------------
-
-
-ppTyFamHeader :: Bool -> Bool -> FamilyDecl DocName
-              -> Unicode -> Qualification -> Html
-ppTyFamHeader summary associated d@(FamilyDecl { fdInfo = info
-                                               , fdKindSig = mkind })
-              unicode qual =
-  (case info of
-     OpenTypeFamily
-       | associated -> keyword "type"
-       | otherwise  -> keyword "type family"
-     DataFamily
-       | associated -> keyword "data"
-       | otherwise  -> keyword "data family"
-     ClosedTypeFamily _
-                    -> keyword "type family"
-  ) <+>
-
-  ppFamDeclBinderWithVars summary d <+>
-
-  (case mkind of
-    Just kind -> dcolon unicode  <+> ppLKind unicode qual kind
-    Nothing   -> noHtml
-  )
-
-ppTyFam :: Bool -> Bool -> LinksInfo -> [DocInstance DocName] ->
-           [(DocName, Fixity)] -> SrcSpan -> Documentation DocName ->
-           FamilyDecl DocName -> Splice -> Unicode -> Qualification -> Html
-ppTyFam summary associated links instances fixities loc doc decl splice unicode qual
-
-  | summary   = ppTyFamHeader True associated decl unicode qual
-  | otherwise = header_ +++ docSection qual doc +++ instancesBit
-
-  where
-    docname = unLoc $ fdLName decl
-
-    header_ = topDeclElem links loc splice [docname] $
-       ppTyFamHeader summary associated decl unicode qual <+> ppFixities fixities qual
-
-    instancesBit
-      | FamilyDecl { fdInfo = ClosedTypeFamily eqns } <- decl
-      , not summary
-      = subEquations qual $ map (ppTyFamEqn . unLoc) eqns
-
-      | otherwise
-      = ppInstances instances docname unicode qual
-
-    -- Individual equation of a closed type family
-    ppTyFamEqn TyFamInstEqn { tfie_tycon = n, tfie_rhs = rhs
-                            , tfie_pats = HsWB { hswb_cts = ts }}
-      = ( ppAppNameTypes (unLoc n) [] (map unLoc ts) unicode qual
-          <+> equals <+> ppType unicode qual (unLoc rhs)
-        , Nothing, [] )
-
---------------------------------------------------------------------------------
--- * Associated Types
---------------------------------------------------------------------------------
-
-
-ppAssocType :: Bool -> LinksInfo -> DocForDecl DocName -> LFamilyDecl DocName
-            -> [(DocName, Fixity)] -> Splice -> Unicode -> Qualification -> Html
-ppAssocType summ links doc (L loc decl) fixities splice unicode qual =
-   ppTyFam summ True links [] fixities loc (fst doc) decl splice unicode qual
-
-
---------------------------------------------------------------------------------
--- * TyClDecl helpers
---------------------------------------------------------------------------------
-
--- | Print a type family and its variables
-ppFamDeclBinderWithVars :: Bool -> FamilyDecl DocName -> Html
-ppFamDeclBinderWithVars summ (FamilyDecl { fdLName = lname, fdTyVars = tvs }) =
-  ppAppDocNameNames summ (unLoc lname) (tyvarNames tvs)
-
--- | Print a newtype / data binder and its variables
-ppDataBinderWithVars :: Bool -> TyClDecl DocName -> Html
-ppDataBinderWithVars summ decl =
-  ppAppDocNameNames summ (tcdName decl) (tyvarNames $ tcdTyVars decl)
-
---------------------------------------------------------------------------------
--- * Type applications
---------------------------------------------------------------------------------
-
-
--- | Print an application of a DocName and two lists of HsTypes (kinds, types)
-ppAppNameTypes :: DocName -> [HsType DocName] -> [HsType DocName]
-               -> Unicode -> Qualification -> Html
-ppAppNameTypes n ks ts unicode qual =
-    ppTypeApp n ks ts (\p -> ppDocName qual p True) (ppParendType unicode qual)
-
-
--- | Print an application of a DocName and a list of Names
-ppAppDocNameNames :: Bool -> DocName -> [Name] -> Html
-ppAppDocNameNames summ n ns =
-    ppTypeApp n [] ns ppDN ppTyName
-  where
-    ppDN notation = ppBinderFixity notation summ . nameOccName . getName
-    ppBinderFixity Infix = ppBinderInfix
-    ppBinderFixity _ = ppBinder
-
--- | General printing of type applications
-ppTypeApp :: DocName -> [a] -> [a] -> (Notation -> DocName -> Html) -> (a -> Html) -> Html
-ppTypeApp n [] (t1:t2:rest) ppDN ppT
-  | operator, not . null $ rest = parens opApp <+> hsep (map ppT rest)
-  | operator                    = opApp
-  where
-    operator = isNameSym . getName $ n
-    opApp = ppT t1 <+> ppDN Infix n <+> ppT t2
-
-ppTypeApp n ks ts ppDN ppT = ppDN Prefix n <+> hsep (map ppT $ ks ++ ts)
-
-
--------------------------------------------------------------------------------
--- * Contexts
--------------------------------------------------------------------------------
-
-
-ppLContext, ppLContextNoArrow :: Located (HsContext DocName) -> Unicode
-                              -> Qualification -> Html
-ppLContext        = ppContext        . unLoc
-ppLContextNoArrow = ppContextNoArrow . unLoc
-
-
-ppContextNoArrow :: HsContext DocName -> Unicode -> Qualification -> Html
-ppContextNoArrow []  _       _     = noHtml
-ppContextNoArrow cxt unicode qual = ppHsContext (map unLoc cxt) unicode qual
-
-
-ppContextNoLocs :: [HsType DocName] -> Unicode -> Qualification -> Html
-ppContextNoLocs []  _       _     = noHtml
-ppContextNoLocs cxt unicode qual = ppHsContext cxt unicode qual
-    <+> darrow unicode
-
-
-ppContext :: HsContext DocName -> Unicode -> Qualification -> Html
-ppContext cxt unicode qual = ppContextNoLocs (map unLoc cxt) unicode qual
-
-
-ppHsContext :: [HsType DocName] -> Unicode -> Qualification-> Html
-ppHsContext []  _       _     = noHtml
-ppHsContext [p] unicode qual = ppCtxType unicode qual p
-ppHsContext cxt unicode qual = parenList (map (ppType unicode qual) cxt)
-
-
--------------------------------------------------------------------------------
--- * Class declarations
--------------------------------------------------------------------------------
-
-
-ppClassHdr :: Bool -> Located [LHsType DocName] -> DocName
-           -> LHsTyVarBndrs DocName -> [Located ([DocName], [DocName])]
-           -> Unicode -> Qualification -> Html
-ppClassHdr summ lctxt n tvs fds unicode qual =
-  keyword "class"
-  <+> (if not . null . unLoc $ lctxt then ppLContext lctxt unicode qual else noHtml)
-  <+> ppAppDocNameNames summ n (tyvarNames tvs)
-  <+> ppFds fds unicode qual
-
-
-ppFds :: [Located ([DocName], [DocName])] -> Unicode -> Qualification -> Html
-ppFds fds unicode qual =
-  if null fds then noHtml else
-        char '|' <+> hsep (punctuate comma (map (fundep . unLoc) fds))
-  where
-        fundep (vars1,vars2) = ppVars vars1 <+> arrow unicode <+> ppVars vars2
-        ppVars = hsep . map (ppDocName qual Prefix True)
-
-ppShortClassDecl :: Bool -> LinksInfo -> TyClDecl DocName -> SrcSpan
-                 -> [(DocName, DocForDecl DocName)]
-                 -> Splice -> Unicode -> Qualification -> Html
-ppShortClassDecl summary links (ClassDecl { tcdCtxt = lctxt, tcdLName = lname, tcdTyVars = tvs
-                                          , tcdFDs = fds, tcdSigs = sigs, tcdATs = ats }) loc
-    subdocs splice unicode qual =
-  if not (any isVanillaLSig sigs) && null ats
-    then (if summary then id else topDeclElem links loc splice [nm]) hdr
-    else (if summary then id else topDeclElem links loc splice [nm]) (hdr <+> keyword "where")
-      +++ shortSubDecls False
-          (
-            [ ppAssocType summary links doc at [] splice unicode qual | at <- ats
-              , let doc = lookupAnySubdoc (unL $ fdLName $ unL at) subdocs ]  ++
-
-                -- ToDo: add associated type defaults
-
-            [ ppFunSig summary links loc doc names typ [] splice unicode qual
-              | L _ (TypeSig lnames (L _ typ)) <- sigs
-              , let doc = lookupAnySubdoc (head names) subdocs
-                    names = map unLoc lnames ]
-              -- FIXME: is taking just the first name ok? Is it possible that
-              -- there are different subdocs for different names in a single
-              -- type signature?
-          )
-  where
-    hdr = ppClassHdr summary lctxt (unLoc lname) tvs fds unicode qual
-    nm  = unLoc lname
-ppShortClassDecl _ _ _ _ _ _ _ _ = error "declaration type not supported by ppShortClassDecl"
-
-
-
-ppClassDecl :: Bool -> LinksInfo -> [DocInstance DocName] -> [(DocName, Fixity)]
-            -> SrcSpan -> Documentation DocName
-            -> [(DocName, DocForDecl DocName)] -> TyClDecl DocName
-            -> Splice -> Unicode -> Qualification -> Html
-ppClassDecl summary links instances fixities loc d subdocs
-        decl@(ClassDecl { tcdCtxt = lctxt, tcdLName = lname, tcdTyVars = ltyvars
-                        , tcdFDs = lfds, tcdSigs = lsigs, tcdATs = ats })
-            splice unicode qual
-  | summary = ppShortClassDecl summary links decl loc subdocs splice unicode qual
-  | otherwise = classheader +++ docSection qual d
-                  +++ minimalBit +++ atBit +++ methodBit +++ instancesBit
-  where
-    classheader
-      | any isVanillaLSig lsigs = topDeclElem links loc splice [nm] (hdr unicode qual <+> keyword "where" <+> fixs)
-      | otherwise = topDeclElem links loc splice [nm] (hdr unicode qual <+> fixs)
-
-    -- Only the fixity relevant to the class header
-    fixs = ppFixities [ f | f@(n,_) <- fixities, n == unLoc lname ] qual
-
-    nm   = tcdName decl
-
-    hdr = ppClassHdr summary lctxt (unLoc lname) ltyvars lfds
-
-    -- ToDo: add assocatied typ defaults
-    atBit = subAssociatedTypes [ ppAssocType summary links doc at subfixs splice unicode qual
-                      | at <- ats
-                      , let n = unL . fdLName $ unL at
-                            doc = lookupAnySubdoc (unL $ fdLName $ unL at) subdocs
-                            subfixs = [ f | f@(n',_) <- fixities, n == n' ] ]
-
-    methodBit = subMethods [ ppFunSig summary links loc doc names typ subfixs splice unicode qual
-                           | L _ (TypeSig lnames (L _ typ)) <- lsigs
-                           , let doc = lookupAnySubdoc (head names) subdocs
-                                 subfixs = [ f | n <- names
-                                               , f@(n',_) <- fixities
-                                               , n == n' ]
-                                 names = map unLoc lnames ]
-                           -- FIXME: is taking just the first name ok? Is it possible that
-                           -- there are different subdocs for different names in a single
-                           -- type signature?
-
-    minimalBit = case [ s | L _ (MinimalSig s) <- lsigs ] of
-      -- Miminal complete definition = every shown method
-      And xs : _ | sort [getName n | Var (L _ n) <- xs] ==
-                   sort [getName n | L _ (TypeSig ns _) <- lsigs, L _ n <- ns]
-        -> noHtml
-
-      -- Minimal complete definition = the only shown method
-      Var (L _ n) : _ | [getName n] ==
-                        [getName n' | L _ (TypeSig ns _) <- lsigs, L _ n' <- ns]
-        -> noHtml
-
-      -- Minimal complete definition = nothing
-      And [] : _ -> subMinimal $ toHtml "Nothing"
-
-      m : _  -> subMinimal $ ppMinimal False m
-      _ -> noHtml
-
-    ppMinimal _ (Var (L _ n)) = ppDocName qual Prefix True n
-    ppMinimal _ (And fs) = foldr1 (\a b -> a+++", "+++b) $ map (ppMinimal True) fs
-    ppMinimal p (Or fs) = wrap $ foldr1 (\a b -> a+++" | "+++b) $ map (ppMinimal False) fs
-      where wrap | p = parens | otherwise = id
-
-    instancesBit = ppInstances instances nm unicode qual
-
-ppClassDecl _ _ _ _ _ _ _ _ _ _ _ = error "declaration type not supported by ppShortClassDecl"
-
-
-ppInstances :: [DocInstance DocName] -> DocName -> Unicode -> Qualification -> Html
-ppInstances instances baseName unicode qual
-  = subInstances qual instName (map instDecl instances)
-  where
-    instName = getOccString $ getName baseName
-    instDecl :: DocInstance DocName -> SubDecl
-    instDecl (inst, maybeDoc) = (instHead inst, maybeDoc, [])
-    instHead (n, ks, ts, ClassInst cs) = ppContextNoLocs cs unicode qual
-        <+> ppAppNameTypes n ks ts unicode qual
-    instHead (n, ks, ts, TypeInst rhs) = keyword "type"
-        <+> ppAppNameTypes n ks ts unicode qual
-        <+> maybe noHtml (\t -> equals <+> ppType unicode qual t) rhs
-    instHead (n, ks, ts, DataInst dd) = keyword "data"
-        <+> ppAppNameTypes n ks ts unicode qual
-        <+> ppShortDataDecl False True dd unicode qual
-
-lookupAnySubdoc :: Eq id1 => id1 -> [(id1, DocForDecl id2)] -> DocForDecl id2
-lookupAnySubdoc n = fromMaybe noDocForDecl . lookup n
-
-
--------------------------------------------------------------------------------
--- * Data & newtype declarations
--------------------------------------------------------------------------------
-
-
--- TODO: print contexts
-ppShortDataDecl :: Bool -> Bool -> TyClDecl DocName -> Unicode -> Qualification -> Html
-ppShortDataDecl summary dataInst dataDecl unicode qual
-
-  | [] <- cons = dataHeader
-
-  | [lcon] <- cons, ResTyH98 <- resTy,
-    (cHead,cBody,cFoot) <- ppShortConstrParts summary dataInst (unLoc lcon) unicode qual
-       = (dataHeader <+> equals <+> cHead) +++ cBody +++ cFoot
-
-  | ResTyH98 <- resTy = dataHeader
-      +++ shortSubDecls dataInst (zipWith doConstr ('=':repeat '|') cons)
-
-  | otherwise = (dataHeader <+> keyword "where")
-      +++ shortSubDecls dataInst (map doGADTConstr cons)
-
-  where
-    dataHeader
-      | dataInst  = noHtml
-      | otherwise = ppDataHeader summary dataDecl unicode qual
-    doConstr c con = toHtml [c] <+> ppShortConstr summary (unLoc con) unicode qual
-    doGADTConstr con = ppShortConstr summary (unLoc con) unicode qual
-
-    cons      = dd_cons (tcdDataDefn dataDecl)
-    resTy     = (con_res . unLoc . head) cons
-
-
-ppDataDecl :: Bool -> LinksInfo -> [DocInstance DocName] -> [(DocName, Fixity)] ->
-              [(DocName, DocForDecl DocName)] ->
-              SrcSpan -> Documentation DocName -> TyClDecl DocName ->
-              Splice -> Unicode -> Qualification -> Html
-ppDataDecl summary links instances fixities subdocs loc doc dataDecl
-           splice unicode qual
-
-  | summary   = ppShortDataDecl summary False dataDecl unicode qual
-  | otherwise = header_ +++ docSection qual doc +++ constrBit +++ instancesBit
-
-  where
-    docname   = tcdName dataDecl
-    cons      = dd_cons (tcdDataDefn dataDecl)
-    resTy     = (con_res . unLoc . head) cons
-
-    header_ = topDeclElem links loc splice [docname] $
-             ppDataHeader summary dataDecl unicode qual <+> whereBit <+> fix
-
-    fix = ppFixities (filter (\(n,_) -> n == docname) fixities) qual
-
-    whereBit
-      | null cons = noHtml
-      | otherwise = case resTy of
-        ResTyGADT _ -> keyword "where"
-        _ -> noHtml
-
-    constrBit = subConstructors qual
-      [ ppSideBySideConstr subdocs subfixs unicode qual c
-      | c <- cons
-      , let subfixs = filter (\(n,_) -> n == unLoc (con_name (unLoc c))) fixities
-      ]
-
-    instancesBit = ppInstances instances docname unicode qual
-
-
-
-ppShortConstr :: Bool -> ConDecl DocName -> Unicode -> Qualification -> Html
-ppShortConstr summary con unicode qual = cHead <+> cBody <+> cFoot
-  where
-    (cHead,cBody,cFoot) = ppShortConstrParts summary False con unicode qual
-
-
--- returns three pieces: header, body, footer so that header & footer can be
--- incorporated into the declaration
-ppShortConstrParts :: Bool -> Bool -> ConDecl DocName -> Unicode -> Qualification -> (Html, Html, Html)
-ppShortConstrParts summary dataInst con unicode qual = case con_res con of
-  ResTyH98 -> case con_details con of
-    PrefixCon args ->
-      (header_ unicode qual +++ hsep (ppBinder summary occ
-            : map (ppLParendType unicode qual) args), noHtml, noHtml)
-    RecCon fields ->
-      (header_ unicode qual +++ ppBinder summary occ <+> char '{',
-       doRecordFields fields,
-       char '}')
-    InfixCon arg1 arg2 ->
-      (header_ unicode qual +++ hsep [ppLParendType unicode qual arg1,
-            ppBinderInfix summary occ, ppLParendType unicode qual arg2],
-       noHtml, noHtml)
-
-  ResTyGADT resTy -> case con_details con of
-    -- prefix & infix could use hsConDeclArgTys if it seemed to
-    -- simplify the code.
-    PrefixCon args -> (doGADTCon args resTy, noHtml, noHtml)
-    -- display GADT records with the new syntax,
-    -- Constr :: (Context) => { field :: a, field2 :: b } -> Ty (a, b)
-    -- (except each field gets its own line in docs, to match
-    -- non-GADT records)
-    RecCon fields -> (ppBinder summary occ <+> dcolon unicode <+>
-                            ppForAll forall_ ltvs lcontext unicode qual <+> char '{',
-                            doRecordFields fields,
-                            char '}' <+> arrow unicode <+> ppLType unicode qual resTy)
-    InfixCon arg1 arg2 -> (doGADTCon [arg1, arg2] resTy, noHtml, noHtml)
-
-  where
-    doRecordFields fields = shortSubDecls dataInst (map (ppShortField summary unicode qual) fields)
-    doGADTCon args resTy = ppBinder summary occ <+> dcolon unicode <+> hsep [
-                             ppForAll forall_ ltvs lcontext unicode qual,
-                             ppLType unicode qual (foldr mkFunTy resTy args) ]
-
-    header_  = ppConstrHdr forall_ tyVars context
-    occ      = nameOccName . getName . unLoc . con_name $ con
-    ltvs     = con_qvars con
-    tyVars   = tyvarNames ltvs
-    lcontext = con_cxt con
-    context  = unLoc (con_cxt con)
-    forall_  = con_explicit con
-    mkFunTy a b = noLoc (HsFunTy a b)
-
-
--- ppConstrHdr is for (non-GADT) existentials constructors' syntax
-ppConstrHdr :: HsExplicitFlag -> [Name] -> HsContext DocName -> Unicode
-            -> Qualification -> Html
-ppConstrHdr forall_ tvs ctxt unicode qual
- = (if null tvs then noHtml else ppForall)
-   +++
-   (if null ctxt then noHtml else ppContextNoArrow ctxt unicode qual
-        <+> darrow unicode +++ toHtml " ")
-  where
-    ppForall = case forall_ of
-      Explicit -> forallSymbol unicode <+> hsep (map (ppName Prefix) tvs) <+> toHtml ". "
-      Implicit -> noHtml
-
-
-ppSideBySideConstr :: [(DocName, DocForDecl DocName)] -> [(DocName, Fixity)]
-                   -> Unicode -> Qualification -> LConDecl DocName -> SubDecl
-ppSideBySideConstr subdocs fixities unicode qual (L _ con) = (decl, mbDoc, fieldPart)
- where
-    decl = case con_res con of
-      ResTyH98 -> case con_details con of
-        PrefixCon args ->
-          hsep ((header_ +++ ppBinder False occ)
-            : map (ppLParendType unicode qual) args)
-          <+> fixity
-
-        RecCon _ -> header_ +++ ppBinder False occ <+> fixity
-
-        InfixCon arg1 arg2 ->
-          hsep [header_ +++ ppLParendType unicode qual arg1,
-            ppBinderInfix False occ,
-            ppLParendType unicode qual arg2]
-          <+> fixity
-
-      ResTyGADT resTy -> case con_details con of
-        -- prefix & infix could also use hsConDeclArgTys if it seemed to
-        -- simplify the code.
-        PrefixCon args -> doGADTCon args resTy
-        cd@(RecCon _) -> doGADTCon (hsConDeclArgTys cd) resTy
-        InfixCon arg1 arg2 -> doGADTCon [arg1, arg2] resTy
-
-    fieldPart = case con_details con of
-        RecCon fields -> [doRecordFields fields]
-        _ -> []
-
-    doRecordFields fields = subFields qual
-      (map (ppSideBySideField subdocs unicode qual) fields)
-    doGADTCon :: [LHsType DocName] -> Located (HsType DocName) -> Html
-    doGADTCon args resTy = ppBinder False occ <+> dcolon unicode
-        <+> hsep [ppForAll forall_ ltvs (con_cxt con) unicode qual,
-                  ppLType unicode qual (foldr mkFunTy resTy args) ]
-        <+> fixity
-
-    fixity  = ppFixities fixities qual
-    header_ = ppConstrHdr forall_ tyVars context unicode qual
-    occ     = nameOccName . getName . unLoc . con_name $ con
-    ltvs    = con_qvars con
-    tyVars  = tyvarNames (con_qvars con)
-    context = unLoc (con_cxt con)
-    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.
-    mbDoc = lookup (unLoc $ con_name con) subdocs >>= combineDocumentation . fst
-    mkFunTy a b = noLoc (HsFunTy a b)
-
-
-ppSideBySideField :: [(DocName, DocForDecl DocName)] -> Unicode -> Qualification
-                  -> ConDeclField DocName -> SubDecl
-ppSideBySideField subdocs unicode qual (ConDeclField (L _ name) ltype _) =
-  (ppBinder False (nameOccName . getName $ name) <+> dcolon unicode <+> ppLType unicode qual ltype,
-    mbDoc,
-    [])
-  where
-    -- don't use cd_fld_doc for same reason we don't use con_doc above
-    mbDoc = lookup name subdocs >>= combineDocumentation . fst
-
-
-ppShortField :: Bool -> Unicode -> Qualification -> ConDeclField DocName -> Html
-ppShortField summary unicode qual (ConDeclField (L _ name) ltype _)
-  = ppBinder summary (nameOccName . getName $ name)
-    <+> dcolon unicode <+> ppLType unicode qual ltype
-
-
--- | Print the LHS of a data\/newtype declaration.
--- Currently doesn't handle 'data instance' decls or kind signatures
-ppDataHeader :: Bool -> TyClDecl DocName -> Unicode -> Qualification -> Html
-ppDataHeader summary decl@(DataDecl { tcdDataDefn =
-                                         HsDataDefn { dd_ND = nd
-                                                    , dd_ctxt = ctxt
-                                                    , dd_kindSig = ks } })
-             unicode qual
-  = -- newtype or data
-    (case nd of { NewType -> keyword "newtype"; DataType -> keyword "data" })
-    <+>
-    -- context
-    ppLContext ctxt unicode qual <+>
-    -- T a b c ..., or a :+: b
-    ppDataBinderWithVars summary decl
-    <+> case ks of
-      Nothing -> mempty
-      Just (L _ x) -> dcolon unicode <+> ppKind unicode qual x
-
-ppDataHeader _ _ _ _ = error "ppDataHeader: illegal argument"
-
---------------------------------------------------------------------------------
--- * Types and contexts
---------------------------------------------------------------------------------
-
-
-ppBang :: HsBang -> Html
-ppBang HsNoBang = noHtml
-ppBang _        = toHtml "!" -- Unpacked args is an implementation detail,
-                             -- so we just show the strictness annotation
-
-
-tupleParens :: HsTupleSort -> [Html] -> Html
-tupleParens HsUnboxedTuple = ubxParenList
-tupleParens _              = parenList
-
-
---------------------------------------------------------------------------------
--- * Rendering of HsType
---------------------------------------------------------------------------------
-
-
-pREC_TOP, pREC_CTX, pREC_FUN, pREC_OP, pREC_CON :: Int
-
-pREC_TOP = 0 :: Int   -- type in ParseIface.y in GHC
-pREC_CTX = 1 :: Int   -- Used for single contexts, eg. ctx => type
-                      -- (as opposed to (ctx1, ctx2) => type)
-pREC_FUN = 2 :: Int   -- btype in ParseIface.y in GHC
-                      -- Used for LH arg of (->)
-pREC_OP  = 3 :: Int   -- Used for arg of any infix operator
-                      -- (we don't keep their fixities around)
-pREC_CON = 4 :: Int   -- Used for arg of type applicn:
-                      -- always parenthesise unless atomic
-
-maybeParen :: Int           -- Precedence of context
-           -> Int           -- Precedence of top-level operator
-           -> Html -> Html  -- Wrap in parens if (ctxt >= op)
-maybeParen ctxt_prec op_prec p | ctxt_prec >= op_prec = parens p
-                               | otherwise            = p
-
-
-ppLType, ppLParendType, ppLFunLhType :: Unicode -> Qualification
-                                     -> Located (HsType DocName) -> Html
-ppLType       unicode qual y = ppType unicode qual (unLoc y)
-ppLParendType unicode qual y = ppParendType unicode qual (unLoc y)
-ppLFunLhType  unicode qual y = ppFunLhType unicode qual (unLoc y)
-
-
-ppType, ppCtxType, ppParendType, ppFunLhType :: Unicode -> Qualification
-                                             -> HsType DocName -> Html
-ppType       unicode qual ty = ppr_mono_ty pREC_TOP ty unicode qual
-ppCtxType    unicode qual ty = ppr_mono_ty pREC_CTX ty unicode qual
-ppParendType unicode qual ty = ppr_mono_ty pREC_CON ty unicode qual
-ppFunLhType  unicode qual ty = ppr_mono_ty pREC_FUN ty unicode qual
-
-ppLKind :: Unicode -> Qualification -> LHsKind DocName -> Html
-ppLKind unicode qual y = ppKind unicode qual (unLoc y)
-
-ppKind :: Unicode -> Qualification -> HsKind DocName -> Html
-ppKind unicode qual ki = ppr_mono_ty pREC_TOP ki unicode qual
-
--- Drop top-level for-all type variables in user style
--- since they are implicit in Haskell
-
-ppForAll :: HsExplicitFlag -> LHsTyVarBndrs DocName
-         -> Located (HsContext DocName) -> Unicode -> Qualification -> Html
-ppForAll expl tvs cxt unicode qual
-  | show_forall = forall_part <+> ppLContext cxt unicode qual
-  | otherwise   = ppLContext cxt unicode qual
-  where
-    show_forall = not (null (hsQTvBndrs tvs)) && is_explicit
-    is_explicit = case expl of {Explicit -> True; Implicit -> False}
-    forall_part = hsep (forallSymbol unicode : ppTyVars tvs) +++ dot
-
-
-ppr_mono_lty :: Int -> LHsType DocName -> Unicode -> Qualification -> Html
-ppr_mono_lty ctxt_prec ty = ppr_mono_ty ctxt_prec (unLoc ty)
-
-
-ppr_mono_ty :: Int -> HsType DocName -> Unicode -> Qualification -> Html
-ppr_mono_ty ctxt_prec (HsForAllTy expl tvs ctxt ty) unicode qual
-  = maybeParen ctxt_prec pREC_FUN $
-    hsep [ppForAll expl tvs ctxt unicode qual, ppr_mono_lty pREC_TOP ty unicode qual]
-
--- UnicodeSyntax alternatives
-ppr_mono_ty _ (HsTyVar name) True _
-  | getOccString (getName name) == "*"    = toHtml "★"
-  | getOccString (getName name) == "(->)" = toHtml "(→)"
-
-ppr_mono_ty _         (HsBangTy b ty)     u q = ppBang b +++ ppLParendType u q ty
-ppr_mono_ty _         (HsTyVar name)      _ q = ppDocName q Prefix True name
-ppr_mono_ty ctxt_prec (HsFunTy ty1 ty2)   u q = ppr_fun_ty ctxt_prec ty1 ty2 u q
-ppr_mono_ty _         (HsTupleTy con tys) u q = tupleParens con (map (ppLType u q) tys)
-ppr_mono_ty _         (HsKindSig ty kind) u q =
-    parens (ppr_mono_lty pREC_TOP ty u q <+> dcolon u <+> ppLKind u q kind)
-ppr_mono_ty _         (HsListTy ty)       u q = brackets (ppr_mono_lty pREC_TOP ty u q)
-ppr_mono_ty _         (HsPArrTy ty)       u q = pabrackets (ppr_mono_lty pREC_TOP ty u q)
-ppr_mono_ty ctxt_prec (HsIParamTy n ty)   u q =
-    maybeParen ctxt_prec pREC_CTX $ ppIPName n <+> dcolon u <+> ppr_mono_lty pREC_TOP ty u q
-ppr_mono_ty _         (HsSpliceTy {})     _ _ = error "ppr_mono_ty HsSpliceTy"
-ppr_mono_ty _         (HsQuasiQuoteTy {}) _ _ = error "ppr_mono_ty HsQuasiQuoteTy"
-ppr_mono_ty _         (HsRecTy {})        _ _ = error "ppr_mono_ty HsRecTy"
-ppr_mono_ty _         (HsCoreTy {})       _ _ = error "ppr_mono_ty HsCoreTy"
-ppr_mono_ty _         (HsExplicitListTy _ tys) u q = quote $ brackets $ hsep $ punctuate comma $ map (ppLType u q) tys
-ppr_mono_ty _         (HsExplicitTupleTy _ tys) u q = quote $ parenList $ map (ppLType u q) tys
-ppr_mono_ty _         (HsWrapTy {})       _ _ = error "ppr_mono_ty HsWrapTy"
-
-ppr_mono_ty ctxt_prec (HsEqTy ty1 ty2) unicode qual
-  = maybeParen ctxt_prec pREC_CTX $
-    ppr_mono_lty pREC_OP ty1 unicode qual <+> char '~' <+> ppr_mono_lty pREC_OP ty2 unicode qual
-
-ppr_mono_ty ctxt_prec (HsAppTy fun_ty arg_ty) unicode qual
-  = maybeParen ctxt_prec pREC_CON $
-    hsep [ppr_mono_lty pREC_FUN fun_ty unicode qual, ppr_mono_lty pREC_CON arg_ty unicode qual]
-
-ppr_mono_ty ctxt_prec (HsOpTy ty1 (_, op) ty2) unicode qual
-  = maybeParen ctxt_prec pREC_FUN $
-    ppr_mono_lty pREC_OP ty1 unicode qual <+> ppr_op <+> ppr_mono_lty pREC_OP ty2 unicode qual
-  where
-    ppr_op = ppLDocName qual Infix op
-
-ppr_mono_ty ctxt_prec (HsParTy ty) unicode qual
---  = parens (ppr_mono_lty pREC_TOP ty)
-  = ppr_mono_lty ctxt_prec ty unicode qual
-
-ppr_mono_ty ctxt_prec (HsDocTy ty _) unicode qual
-  = ppr_mono_lty ctxt_prec ty unicode qual
-
-ppr_mono_ty _ (HsTyLit n) _ _ = ppr_tylit n
-
-ppr_tylit :: HsTyLit -> Html
-ppr_tylit (HsNumTy n) = toHtml (show n)
-ppr_tylit (HsStrTy s) = toHtml (show s)
-
-
-ppr_fun_ty :: Int -> LHsType DocName -> LHsType DocName -> Unicode -> Qualification -> Html
-ppr_fun_ty ctxt_prec ty1 ty2 unicode qual
-  = let p1 = ppr_mono_lty pREC_FUN ty1 unicode qual
-        p2 = ppr_mono_lty pREC_TOP ty2 unicode qual
-    in
-    maybeParen ctxt_prec pREC_FUN $
-    hsep [p1, arrow unicode <+> p2]
diff --git a/src/Haddock/Backends/Xhtml/DocMarkup.hs b/src/Haddock/Backends/Xhtml/DocMarkup.hs
deleted file mode 100644
index 5e27d9b0..00000000
--- a/src/Haddock/Backends/Xhtml/DocMarkup.hs
+++ /dev/null
@@ -1,143 +0,0 @@
------------------------------------------------------------------------------
--- |
--- Module      :  Haddock.Backends.Html.DocMarkup
--- Copyright   :  (c) Simon Marlow   2003-2006,
---                    David Waern    2006-2009,
---                    Mark Lentczner 2010
--- License     :  BSD-like
---
--- Maintainer  :  haddock@projects.haskell.org
--- Stability   :  experimental
--- Portability :  portable
------------------------------------------------------------------------------
-module Haddock.Backends.Xhtml.DocMarkup (
-  docToHtml,
-  rdrDocToHtml,
-  origDocToHtml,
-  docToHtmlNoAnchors,
-
-  docElement, docSection, docSection_,
-) where
-
-import Control.Applicative ((<$>))
-
-import Haddock.Backends.Xhtml.Names
-import Haddock.Backends.Xhtml.Utils
-import Haddock.Types
-import Haddock.Utils
-import Haddock.Doc (combineDocumentation)
-
-import Text.XHtml hiding ( name, p, quote )
-import Data.Maybe (fromMaybe)
-
-import GHC
-
-parHtmlMarkup :: Qualification -> Bool
-              -> (Bool -> a -> Html) -> DocMarkup a Html
-parHtmlMarkup qual insertAnchors ppId = Markup {
-  markupEmpty                = noHtml,
-  markupString               = toHtml,
-  markupParagraph            = paragraph,
-  markupAppend               = (+++),
-  markupIdentifier           = thecode . ppId insertAnchors,
-  markupIdentifierUnchecked  = thecode . ppUncheckedLink qual,
-  markupModule               = \m -> let (mdl,ref) = break (=='#') m
-                                         -- Accomodate for old style
-                                         -- foo\#bar anchors
-                                         mdl' = case reverse mdl of
-                                           '\\':_ -> init mdl
-                                           _ -> mdl
-                                     in ppModuleRef (mkModuleName mdl') ref,
-  markupWarning              = thediv ! [theclass "warning"],
-  markupEmphasis             = emphasize,
-  markupBold                 = strong,
-  markupMonospaced           = thecode,
-  markupUnorderedList        = unordList,
-  markupOrderedList          = ordList,
-  markupDefList              = defList,
-  markupCodeBlock            = pre,
-  markupHyperlink            = \(Hyperlink url mLabel)
-                               -> if insertAnchors
-                                  then anchor ! [href url]
-                                       << fromMaybe url mLabel
-                                  else toHtml $ fromMaybe url mLabel,
-  markupAName                = \aname -> namedAnchor aname << "",
-  markupPic                  = \(Picture uri t) -> image ! ([src uri] ++ fromMaybe [] (return . title <$> t)),
-  markupProperty             = pre . toHtml,
-  markupExample              = examplesToHtml,
-  markupHeader               = \(Header l t) -> makeHeader l t
-  }
-  where
-    makeHeader :: Int -> Html -> Html
-    makeHeader 1 mkup = h1 mkup
-    makeHeader 2 mkup = h2 mkup
-    makeHeader 3 mkup = h3 mkup
-    makeHeader 4 mkup = h4 mkup
-    makeHeader 5 mkup = h5 mkup
-    makeHeader 6 mkup = h6 mkup
-    makeHeader l _ = error $ "Somehow got a header level `" ++ show l ++ "' in DocMarkup!"
-
-
-    examplesToHtml l = pre (concatHtml $ map exampleToHtml l) ! [theclass "screen"]
-
-    exampleToHtml (Example expression result) = htmlExample
-      where
-        htmlExample = htmlPrompt +++ htmlExpression +++ toHtml (unlines result)
-        htmlPrompt = (thecode . toHtml $ ">>> ") ! [theclass "prompt"]
-        htmlExpression = (strong . thecode . toHtml $ expression ++ "\n") ! [theclass "userinput"]
-
-
--- If the doc is a single paragraph, don't surround it with <P> (this causes
--- ugly extra whitespace with some browsers).  FIXME: Does this still apply?
-docToHtml :: Qualification -> Doc DocName -> Html
-docToHtml qual = markup fmt . cleanup
-  where fmt = parHtmlMarkup qual True (ppDocName qual Raw)
-
--- | Same as 'docToHtml' but it doesn't insert the 'anchor' element
--- in links. This is used to generate the Contents box elements.
-docToHtmlNoAnchors :: Qualification -> Doc DocName -> Html
-docToHtmlNoAnchors qual = markup fmt . cleanup
-  where fmt = parHtmlMarkup qual False (ppDocName qual Raw)
-
-origDocToHtml :: Qualification -> Doc Name -> Html
-origDocToHtml qual = markup fmt . cleanup
-  where fmt = parHtmlMarkup qual True (const $ ppName Raw)
-
-
-rdrDocToHtml :: Qualification -> Doc RdrName -> Html
-rdrDocToHtml qual = markup fmt . cleanup
-  where fmt = parHtmlMarkup qual True (const ppRdrName)
-
-
-docElement :: (Html -> Html) -> Html -> Html
-docElement el content_ =
-  if isNoHtml content_
-    then el ! [theclass "doc empty"] << spaceHtml
-    else el ! [theclass "doc"] << content_
-
-
-docSection :: Qualification -> Documentation DocName -> Html
-docSection qual = maybe noHtml (docSection_ qual) . combineDocumentation
-
-
-docSection_ :: Qualification -> Doc DocName -> Html
-docSection_ qual = (docElement thediv <<) . docToHtml qual
-
-
-cleanup :: Doc a -> Doc a
-cleanup = markup fmtUnParagraphLists
-  where
-    -- If there is a single paragraph, then surrounding it with <P>..</P>
-    -- can add too much whitespace in some browsers (eg. IE).  However if
-    -- we have multiple paragraphs, then we want the extra whitespace to
-    -- separate them.  So we catch the single paragraph case and transform it
-    -- here. We don't do this in code blocks as it eliminates line breaks.
-    unParagraph :: Doc a -> Doc a
-    unParagraph (DocParagraph d) = d
-    unParagraph doc              = doc
-
-    fmtUnParagraphLists :: DocMarkup a (Doc a)
-    fmtUnParagraphLists = idMarkup {
-      markupUnorderedList = DocUnorderedList . map unParagraph,
-      markupOrderedList   = DocOrderedList   . map unParagraph
-      }
diff --git a/src/Haddock/Backends/Xhtml/Layout.hs b/src/Haddock/Backends/Xhtml/Layout.hs
deleted file mode 100644
index e84a57b3..00000000
--- a/src/Haddock/Backends/Xhtml/Layout.hs
+++ /dev/null
@@ -1,235 +0,0 @@
------------------------------------------------------------------------------
--- |
--- Module      :  Haddock.Backends.Html.Layout
--- Copyright   :  (c) Simon Marlow   2003-2006,
---                    David Waern    2006-2009,
---                    Mark Lentczner 2010
--- License     :  BSD-like
---
--- Maintainer  :  haddock@projects.haskell.org
--- Stability   :  experimental
--- Portability :  portable
------------------------------------------------------------------------------
-module Haddock.Backends.Xhtml.Layout (
-  miniBody,
-
-  divPackageHeader, divContent, divModuleHeader, divFooter,
-  divTableOfContents, divDescription, divSynposis, divInterface,
-  divIndex, divAlphabet, divModuleList,
-
-  sectionName,
-  nonEmptySectionName,
-
-  shortDeclList,
-  shortSubDecls,
-
-  divTopDecl,
-
-  SubDecl,
-  subArguments,
-  subAssociatedTypes,
-  subConstructors,
-  subEquations,
-  subFields,
-  subInstances,
-  subMethods,
-  subMinimal,
-
-  topDeclElem, declElem,
-) where
-
-
-import Haddock.Backends.Xhtml.DocMarkup
-import Haddock.Backends.Xhtml.Types
-import Haddock.Backends.Xhtml.Utils
-import Haddock.Types
-import Haddock.Utils (makeAnchorId)
-
-import qualified Data.Map as Map
-import Text.XHtml hiding ( name, title, p, quote )
-
-import FastString            ( unpackFS )
-import GHC
-
-
---------------------------------------------------------------------------------
--- * Sections of the document
---------------------------------------------------------------------------------
-
-
-miniBody :: Html -> Html
-miniBody = body ! [identifier "mini"]
-
-
-sectionDiv :: String -> Html -> Html
-sectionDiv i = thediv ! [identifier i]
-
-
-sectionName :: Html -> Html
-sectionName = paragraph ! [theclass "caption"]
-
-
--- | Make an element that always has at least something (a non-breaking space).
--- If it would have otherwise been empty, then give it the class ".empty".
-nonEmptySectionName :: Html -> Html
-nonEmptySectionName c
-  | isNoHtml c = paragraph ! [theclass "caption empty"] $ spaceHtml
-  | otherwise  = paragraph ! [theclass "caption"]       $ c
-
-
-divPackageHeader, divContent, divModuleHeader, divFooter,
-  divTableOfContents, divDescription, divSynposis, divInterface,
-  divIndex, divAlphabet, divModuleList
-    :: Html -> Html
-
-divPackageHeader    = sectionDiv "package-header"
-divContent          = sectionDiv "content"
-divModuleHeader     = sectionDiv "module-header"
-divFooter           = sectionDiv "footer"
-divTableOfContents  = sectionDiv "table-of-contents"
-divDescription      = sectionDiv "description"
-divSynposis         = sectionDiv "synopsis"
-divInterface        = sectionDiv "interface"
-divIndex            = sectionDiv "index"
-divAlphabet         = sectionDiv "alphabet"
-divModuleList       = sectionDiv "module-list"
-
-
---------------------------------------------------------------------------------
--- * Declaration containers
---------------------------------------------------------------------------------
-
-
-shortDeclList :: [Html] -> Html
-shortDeclList items = ulist << map (li ! [theclass "src short"] <<) items
-
-
-shortSubDecls :: Bool -> [Html] -> Html
-shortSubDecls inst items = ulist ! [theclass c] << map (i <<) items
-  where i | inst      = li ! [theclass "inst"]
-          | otherwise = li
-        c | inst      = "inst"
-          | otherwise = "subs"
-
-
-divTopDecl :: Html -> Html
-divTopDecl = thediv ! [theclass "top"]
-
-
-type SubDecl = (Html, Maybe (Doc DocName), [Html])
-
-
-divSubDecls :: (HTML a) => String -> a -> Maybe Html -> Html
-divSubDecls cssClass captionName = maybe noHtml wrap
-  where
-    wrap = (subSection <<) . (subCaption +++)
-    subSection = thediv ! [theclass $ unwords ["subs", cssClass]]
-    subCaption = paragraph ! [theclass "caption"] << captionName
-
-
-subDlist :: Qualification -> [SubDecl] -> Maybe Html
-subDlist _ [] = Nothing
-subDlist qual decls = Just $ dlist << map subEntry decls +++ clearDiv
-  where
-    subEntry (decl, mdoc, subs) =
-      dterm ! [theclass "src"] << decl
-      +++
-      docElement ddef << (fmap (docToHtml qual) mdoc +++ subs)
-
-    clearDiv = thediv ! [ theclass "clear" ] << noHtml
-
-
-subTable :: Qualification -> [SubDecl] -> Maybe Html
-subTable _ [] = Nothing
-subTable qual decls = Just $ table << aboves (concatMap subRow decls)
-  where
-    subRow (decl, mdoc, subs) =
-      (td ! [theclass "src"] << decl
-       <->
-       docElement td << fmap (docToHtml qual) mdoc)
-      : map (cell . (td <<)) subs
-
-
-subBlock :: [Html] -> Maybe Html
-subBlock [] = Nothing
-subBlock hs = Just $ toHtml hs
-
-
-subArguments :: Qualification -> [SubDecl] -> Html
-subArguments qual = divSubDecls "arguments" "Arguments" . subTable qual
-
-
-subAssociatedTypes :: [Html] -> Html
-subAssociatedTypes = divSubDecls "associated-types" "Associated Types" . subBlock
-
-
-subConstructors :: Qualification -> [SubDecl] -> Html
-subConstructors qual = divSubDecls "constructors" "Constructors" . subTable qual
-
-
-subFields :: Qualification -> [SubDecl] -> Html
-subFields qual = divSubDecls "fields" "Fields" . subDlist qual
-
-
-subEquations :: Qualification -> [SubDecl] -> Html
-subEquations qual = divSubDecls "equations" "Equations" . subTable qual
-
-
-subInstances :: Qualification -> String -> [SubDecl] -> Html
-subInstances qual nm = maybe noHtml wrap . instTable
-  where
-    wrap = (subSection <<) . (subCaption +++)
-    instTable = fmap (thediv ! collapseSection id_ True [] <<) . subTable qual
-    subSection = thediv ! [theclass "subs instances"]
-    subCaption = paragraph ! collapseControl id_ True "caption" << "Instances"
-    id_ = makeAnchorId $ "i:" ++ nm
-
-subMethods :: [Html] -> Html
-subMethods = divSubDecls "methods" "Methods" . subBlock
-
-subMinimal :: Html -> Html
-subMinimal = divSubDecls "minimal" "Minimal complete definition" . Just . declElem
-
-
--- a box for displaying code
-declElem :: Html -> Html
-declElem = paragraph ! [theclass "src"]
-
-
--- a box for top level documented names
--- it adds a source and wiki link at the right hand side of the box
-topDeclElem :: LinksInfo -> SrcSpan -> Bool -> [DocName] -> Html -> Html
-topDeclElem ((_,_,sourceMap,lineMap), (_,_,maybe_wiki_url)) loc splice names html =
-    declElem << (html <+> srcLink <+> wikiLink)
-  where srcLink = let nameUrl = Map.lookup origPkg sourceMap
-                      lineUrl = Map.lookup origPkg lineMap
-                      mUrl | splice    = lineUrl
-                                         -- Use the lineUrl as a backup
-                           | otherwise = maybe lineUrl Just nameUrl in
-          case mUrl of
-            Nothing  -> noHtml
-            Just url -> let url' = spliceURL (Just fname) (Just origMod)
-                                               (Just n) (Just loc) url
-                          in anchor ! [href url', theclass "link"] << "Source"
-
-        wikiLink =
-          case maybe_wiki_url of
-            Nothing  -> noHtml
-            Just url -> let url' = spliceURL (Just fname) (Just mdl)
-                                               (Just n) (Just loc) url
-                          in anchor ! [href url', theclass "link"] << "Comments"
-
-        -- For source links, we want to point to the original module,
-        -- because only that will have the source.
-        -- TODO: do something about type instances. They will point to
-        -- the module defining the type family, which is wrong.
-        origMod = nameModule n
-        origPkg = modulePackageId origMod
-
-        -- Name must be documented, otherwise we wouldn't get here
-        Documented n mdl = head names
-        -- FIXME: is it ok to simply take the first name?
-
-        fname = case loc of
-                RealSrcSpan l -> unpackFS (srcSpanFile l)
-                UnhelpfulSpan _ -> error "topDeclElem UnhelpfulSpan"
diff --git a/src/Haddock/Backends/Xhtml/Names.hs b/src/Haddock/Backends/Xhtml/Names.hs
deleted file mode 100644
index cf12da40..00000000
--- a/src/Haddock/Backends/Xhtml/Names.hs
+++ /dev/null
@@ -1,171 +0,0 @@
------------------------------------------------------------------------------
--- |
--- Module      :  Haddock.Backends.Html.Names
--- Copyright   :  (c) Simon Marlow   2003-2006,
---                    David Waern    2006-2009,
---                    Mark Lentczner 2010
--- License     :  BSD-like
---
--- Maintainer  :  haddock@projects.haskell.org
--- Stability   :  experimental
--- Portability :  portable
------------------------------------------------------------------------------
-module Haddock.Backends.Xhtml.Names (
-  ppName, ppDocName, ppLDocName, ppRdrName, ppUncheckedLink,
-  ppBinder, ppBinderInfix, ppBinder',
-  ppModule, ppModuleRef, ppIPName, linkId, Notation(..)
-) where
-
-
-import Haddock.Backends.Xhtml.Utils
-import Haddock.GhcUtils
-import Haddock.Types
-import Haddock.Utils
-
-import Text.XHtml hiding ( name, title, p, quote )
-import qualified Data.Map as M
-import qualified Data.List as List
-
-import GHC
-import Name
-import RdrName
-import FastString (unpackFS)
-
-
--- | Indicator of how to render a 'DocName' into 'Html'
-data Notation = Raw -- ^ Render as-is.
-              | Infix -- ^ Render using infix notation.
-              | Prefix -- ^ Render using prefix notation.
-                deriving (Eq, Show)
-
-ppOccName :: OccName -> Html
-ppOccName = toHtml . occNameString
-
-
-ppRdrName :: RdrName -> Html
-ppRdrName = ppOccName . rdrNameOcc
-
-ppIPName :: HsIPName -> Html
-ppIPName = toHtml . ('?':) . unpackFS . hsIPNameFS
-
-
-ppUncheckedLink :: Qualification -> (ModuleName, OccName) -> Html
-ppUncheckedLink _ (mdl, occ) = linkIdOcc' mdl (Just occ) << ppOccName occ -- TODO: apply ppQualifyName
-
-
--- The Bool indicates if it is to be rendered in infix notation
-ppLDocName :: Qualification -> Notation -> Located DocName -> Html
-ppLDocName qual notation (L _ d) = ppDocName qual notation True d
-
-ppDocName :: Qualification -> Notation -> Bool -> DocName -> Html
-ppDocName qual notation insertAnchors docName =
-  case docName of
-    Documented name mdl ->
-      linkIdOcc mdl (Just (nameOccName name)) insertAnchors
-      << ppQualifyName qual notation name mdl
-    Undocumented name
-      | isExternalName name || isWiredInName name ->
-          ppQualifyName qual notation name (nameModule name)
-      | otherwise -> ppName notation name
-
--- | Render a name depending on the selected qualification mode
-ppQualifyName :: Qualification -> Notation -> Name -> Module -> Html
-ppQualifyName qual notation name mdl =
-  case qual of
-    NoQual   -> ppName notation name
-    FullQual -> ppFullQualName notation mdl name
-    LocalQual localmdl ->
-      if moduleString mdl == moduleString localmdl
-        then ppName notation name
-        else ppFullQualName notation mdl name
-    RelativeQual localmdl ->
-      case List.stripPrefix (moduleString localmdl) (moduleString mdl) of
-        -- local, A.x -> x
-        Just []      -> ppName notation name
-        -- sub-module, A.B.x -> B.x
-        Just ('.':m) -> toHtml $ m ++ '.' : getOccString name
-        -- some module with same prefix, ABC.x -> ABC.x
-        Just _       -> ppFullQualName notation mdl name
-        -- some other module, D.x -> D.x
-        Nothing      -> ppFullQualName notation mdl name
-    AliasedQual aliases localmdl ->
-      case (moduleString mdl == moduleString localmdl,
-            M.lookup mdl aliases) of
-        (False, Just alias) -> ppQualName notation alias name
-        _ -> ppName notation name
-
-
-ppFullQualName :: Notation -> Module -> Name -> Html
-ppFullQualName notation mdl name = wrapInfix notation (getOccName name) qname
-  where
-    qname = toHtml $ moduleString mdl ++ '.' : getOccString name
-
-ppQualName :: Notation -> ModuleName -> Name -> Html
-ppQualName notation mdlName name = wrapInfix notation (getOccName name) qname
-  where
-    qname = toHtml $ moduleNameString mdlName ++ '.' : getOccString name
-
-ppName :: Notation -> Name -> Html
-ppName notation name = wrapInfix notation (getOccName name) $ toHtml (getOccString name)
-
-
-ppBinder :: Bool -> OccName -> Html
--- The Bool indicates whether we are generating the summary, in which case
--- the binder will be a link to the full definition.
-ppBinder True n = linkedAnchor (nameAnchorId n) << ppBinder' Prefix n
-ppBinder False n = namedAnchor (nameAnchorId n) ! [theclass "def"]
-                        << ppBinder' Prefix n
-
-ppBinderInfix :: Bool -> OccName -> Html
-ppBinderInfix True n = linkedAnchor (nameAnchorId n) << ppBinder' Infix n
-ppBinderInfix False n = namedAnchor (nameAnchorId n) ! [theclass "def"]
-                             << ppBinder' Infix n
-
-ppBinder' :: Notation -> OccName -> Html
-ppBinder' notation n = wrapInfix notation n $ ppOccName n
-
-wrapInfix :: Notation -> OccName -> Html -> Html
-wrapInfix notation n = case notation of
-  Infix | is_star_kind -> id
-        | not is_sym -> quote
-  Prefix | is_star_kind -> id
-         | is_sym -> parens
-  _ -> id
-  where
-    is_sym = isSymOcc n
-    is_star_kind = isTcOcc n && occNameString n == "*"
-
-linkId :: Module -> Maybe Name -> Html -> Html
-linkId mdl mbName = linkIdOcc mdl (fmap nameOccName mbName) True
-
-
-linkIdOcc :: Module -> Maybe OccName -> Bool -> Html -> Html
-linkIdOcc mdl mbName insertAnchors =
-  if insertAnchors
-  then anchor ! [href url]
-  else id
-  where
-    url = case mbName of
-      Nothing   -> moduleUrl mdl
-      Just name -> moduleNameUrl mdl name
-
-
-linkIdOcc' :: ModuleName -> Maybe OccName -> Html -> Html
-linkIdOcc' mdl mbName = anchor ! [href url]
-  where
-    url = case mbName of
-      Nothing   -> moduleHtmlFile' mdl
-      Just name -> moduleNameUrl' mdl name
-
-
-ppModule :: Module -> Html
-ppModule mdl = anchor ! [href (moduleUrl mdl)]
-               << toHtml (moduleString mdl)
-
-
-ppModuleRef :: ModuleName -> String -> Html
-ppModuleRef mdl ref = anchor ! [href (moduleHtmlFile' mdl ++ ref)]
-                      << toHtml (moduleNameString mdl)
-    -- NB: The ref parameter already includes the '#'.
-    -- This function is only called from markupModule expanding a
-    -- DocModule, which doesn't seem to be ever be used.
diff --git a/src/Haddock/Backends/Xhtml/Themes.hs b/src/Haddock/Backends/Xhtml/Themes.hs
deleted file mode 100644
index 79b093ec..00000000
--- a/src/Haddock/Backends/Xhtml/Themes.hs
+++ /dev/null
@@ -1,209 +0,0 @@
------------------------------------------------------------------------------
--- |
--- Module      :  Haddock.Backends.Html.Themes
--- Copyright   :  (c) Mark Lentczner 2010
--- License     :  BSD-like
---
--- Maintainer  :  haddock@projects.haskell.org
--- Stability   :  experimental
--- Portability :  portable
------------------------------------------------------------------------------
-module Haddock.Backends.Xhtml.Themes (
-    Themes,
-    getThemes,
-
-    cssFiles, styleSheet
-    )
-    where
-
-import Haddock.Options
-
-import Control.Applicative
-import Control.Monad (liftM)
-import Data.Char (toLower)
-import Data.Either (lefts, rights)
-import Data.List (nub)
-import Data.Maybe (isJust, listToMaybe)
-
-import System.Directory
-import System.FilePath
-import Text.XHtml hiding ( name, title, p, quote, (</>) )
-import qualified Text.XHtml as XHtml
-
-
---------------------------------------------------------------------------------
--- * CSS Themes
---------------------------------------------------------------------------------
-
-data Theme = Theme {
-  themeName :: String,
-  themeHref :: String,
-  themeFiles :: [FilePath]
-  }
-
-type Themes = [Theme]
-
-type PossibleTheme = Either String Theme
-type PossibleThemes = Either String Themes
-
-
--- | Find a theme by name (case insensitive match)
-findTheme :: String -> Themes -> Maybe Theme
-findTheme s = listToMaybe . filter ((== ls).lower.themeName)
-  where lower = map toLower
-        ls = lower s
-
-
--- | Standard theme used by default
-standardTheme :: FilePath -> IO PossibleThemes
-standardTheme libDir = liftM (liftEither (take 1)) (defaultThemes libDir)
-
-
--- | Default themes that are part of Haddock; added with --default-themes
--- The first theme in this list is considered the standard theme.
--- Themes are "discovered" by scanning the html sub-dir of the libDir,
--- and looking for directories with the extension .theme or .std-theme.
--- The later is, obviously, the standard theme.
-defaultThemes :: FilePath -> IO PossibleThemes
-defaultThemes libDir = do
-  themeDirs <- getDirectoryItems (libDir </> "html")
-  themes <- mapM directoryTheme $ discoverThemes themeDirs
-  return $ sequenceEither themes
-  where
-    discoverThemes paths =
-      filterExt ".std-theme" paths ++ filterExt ".theme" paths
-    filterExt ext = filter ((== ext).takeExtension)
-
-
--- | Build a theme from a single .css file
-singleFileTheme :: FilePath -> IO PossibleTheme
-singleFileTheme path =
-  if isCssFilePath path
-      then retRight $ Theme name file [path]
-      else errMessage "File extension isn't .css" path
-  where
-    name = takeBaseName path
-    file = takeFileName path
-
-
--- | Build a theme from a directory
-directoryTheme :: FilePath -> IO PossibleTheme
-directoryTheme path = do
-  items <- getDirectoryItems path
-  case filter isCssFilePath items of
-    [cf] -> retRight $ Theme (takeBaseName path) (takeFileName cf) items
-    [] -> errMessage "No .css file in theme directory" path
-    _ -> errMessage "More than one .css file in theme directory" path
-
-
--- | Check if we have a built in theme
-doesBuiltInExist :: IO PossibleThemes -> String -> IO Bool
-doesBuiltInExist pts s = fmap (either (const False) test) pts
-  where test = isJust . findTheme s
-
-
--- | Find a built in theme
-builtInTheme :: IO PossibleThemes -> String -> IO PossibleTheme
-builtInTheme pts s = either Left fetch <$> pts
-  where fetch = maybe (Left ("Unknown theme: " ++ s)) Right . findTheme s
-
-
---------------------------------------------------------------------------------
--- * CSS Theme Arguments
---------------------------------------------------------------------------------
-
--- | Process input flags for CSS Theme arguments
-getThemes :: FilePath -> [Flag] -> IO PossibleThemes
-getThemes libDir flags =
-  liftM concatEither (mapM themeFlag flags) >>= someTheme
-  where
-    themeFlag :: Flag -> IO (Either String Themes)
-    themeFlag (Flag_CSS path) = (liftM . liftEither) (:[]) (theme path)
-    themeFlag (Flag_BuiltInThemes) = builtIns
-    themeFlag _ = retRight []
-
-    theme :: FilePath -> IO PossibleTheme
-    theme path = pick path
-      [(doesFileExist,              singleFileTheme),
-       (doesDirectoryExist,         directoryTheme),
-       (doesBuiltInExist builtIns,  builtInTheme builtIns)]
-      "Theme not found"
-
-    pick :: FilePath
-      -> [(FilePath -> IO Bool, FilePath -> IO PossibleTheme)] -> String
-      -> IO PossibleTheme
-    pick path [] msg = errMessage msg path
-    pick path ((test,build):opts) msg = do
-      pass <- test path
-      if pass then build path else pick path opts msg
-
-
-    someTheme :: Either String Themes -> IO (Either String Themes)
-    someTheme (Right []) = standardTheme libDir
-    someTheme est = return est
-
-    builtIns = defaultThemes libDir
-
-
-errMessage :: String -> FilePath -> IO (Either String a)
-errMessage msg path = return (Left msg')
-  where msg' = "Error: " ++ msg ++ ": \"" ++ path ++ "\"\n"
-
-
-retRight :: a -> IO (Either String a)
-retRight = return . Right
-
-
---------------------------------------------------------------------------------
--- * File Utilities
---------------------------------------------------------------------------------
-
-
-getDirectoryItems :: FilePath -> IO [FilePath]
-getDirectoryItems path =
-  map (combine path) . filter notDot <$> getDirectoryContents path
-  where notDot s = s /= "." && s /= ".."
-
-
-isCssFilePath :: FilePath -> Bool
-isCssFilePath path = takeExtension path == ".css"
-
-
---------------------------------------------------------------------------------
--- * Style Sheet Utilities
---------------------------------------------------------------------------------
-
-cssFiles :: Themes -> [String]
-cssFiles ts = nub $ concatMap themeFiles ts
-
-
-styleSheet :: Themes -> Html
-styleSheet ts = toHtml $ zipWith mkLink rels ts
-  where
-    rels = "stylesheet" : repeat "alternate stylesheet"
-    mkLink aRel t =
-      thelink
-        ! [ href (themeHref t),  rel aRel, thetype "text/css",
-            XHtml.title (themeName t)
-          ]
-        << noHtml
-
---------------------------------------------------------------------------------
--- * Either Utilities
---------------------------------------------------------------------------------
-
--- These three routines are here because Haddock does not have access to the
--- Control.Monad.Error module which supplies the Functor and Monad instances
--- for Either String.
-
-sequenceEither :: [Either a b] -> Either a [b]
-sequenceEither es = maybe (Right $ rights es) Left (listToMaybe (lefts es))
-
-
-liftEither :: (b -> c) -> Either a b -> Either a c
-liftEither f = either Left (Right . f)
-
-
-concatEither :: [Either a [b]] -> Either a [b]
-concatEither = liftEither concat . sequenceEither
-
diff --git a/src/Haddock/Backends/Xhtml/Types.hs b/src/Haddock/Backends/Xhtml/Types.hs
deleted file mode 100644
index 122861c3..00000000
--- a/src/Haddock/Backends/Xhtml/Types.hs
+++ /dev/null
@@ -1,37 +0,0 @@
------------------------------------------------------------------------------
--- |
--- Module      :  Haddock.Backends.Html.Types
--- Copyright   :  (c) Simon Marlow   2003-2006,
---                    David Waern    2006-2009,
---                    Mark Lentczner 2010
--- License     :  BSD-like
---
--- Maintainer  :  haddock@projects.haskell.org
--- Stability   :  experimental
--- Portability :  portable
------------------------------------------------------------------------------
-module Haddock.Backends.Xhtml.Types (
-  SourceURLs, WikiURLs,
-  LinksInfo,
-  Splice,
-  Unicode,
-) where
-
-
-import Data.Map
-import GHC
-
-
--- the base, module and entity URLs for the source code and wiki links.
-type SourceURLs = (Maybe FilePath, Maybe FilePath, Map PackageId FilePath, Map PackageId FilePath)
-type WikiURLs = (Maybe FilePath, Maybe FilePath, Maybe FilePath)
-
-
--- The URL for source and wiki links
-type LinksInfo = (SourceURLs, WikiURLs)
-
--- Whether something is a splice or not
-type Splice = Bool
-
--- Whether unicode syntax is to be used
-type Unicode = Bool
diff --git a/src/Haddock/Backends/Xhtml/Utils.hs b/src/Haddock/Backends/Xhtml/Utils.hs
deleted file mode 100644
index cbcbbd6d..00000000
--- a/src/Haddock/Backends/Xhtml/Utils.hs
+++ /dev/null
@@ -1,218 +0,0 @@
------------------------------------------------------------------------------
--- |
--- Module      :  Haddock.Backends.Html.Util
--- Copyright   :  (c) Simon Marlow   2003-2006,
---                    David Waern    2006-2009,
---                    Mark Lentczner 2010
--- License     :  BSD-like
---
--- Maintainer  :  haddock@projects.haskell.org
--- Stability   :  experimental
--- Portability :  portable
------------------------------------------------------------------------------
-module Haddock.Backends.Xhtml.Utils (
-  renderToString,
-
-  namedAnchor, linkedAnchor,
-  spliceURL,
-  groupId,
-
-  (<+>), (<=>), char,
-  keyword, punctuate,
-
-  braces, brackets, pabrackets, parens, parenList, ubxParenList,
-  arrow, comma, dcolon, dot, darrow, equals, forallSymbol, quote,
-
-  hsep, vcat,
-
-  collapseSection, collapseToggle, collapseControl,
-) where
-
-
-import Haddock.GhcUtils
-import Haddock.Utils
-
-import Data.Maybe
-
-import Text.XHtml hiding ( name, title, p, quote )
-import qualified Text.XHtml as XHtml
-
-import GHC      ( SrcSpan(..), srcSpanStartLine, Name )
-import Module   ( Module )
-import Name     ( getOccString, nameOccName, isValOcc )
-
-
-spliceURL :: Maybe FilePath -> Maybe Module -> Maybe GHC.Name ->
-             Maybe SrcSpan -> String -> String
-spliceURL maybe_file maybe_mod maybe_name maybe_loc = run
- where
-  file = fromMaybe "" maybe_file
-  mdl = case maybe_mod of
-          Nothing           -> ""
-          Just m -> moduleString m
-
-  (name, kind) =
-    case maybe_name of
-      Nothing             -> ("","")
-      Just n | isValOcc (nameOccName n) -> (escapeStr (getOccString n), "v")
-             | otherwise -> (escapeStr (getOccString n), "t")
-
-  line = case maybe_loc of
-    Nothing -> ""
-    Just span_ ->
-      case span_ of
-      RealSrcSpan span__ ->
-        show $ srcSpanStartLine span__
-      UnhelpfulSpan _ ->
-        error "spliceURL UnhelpfulSpan"
-
-  run "" = ""
-  run ('%':'M':rest) = mdl  ++ run rest
-  run ('%':'F':rest) = file ++ run rest
-  run ('%':'N':rest) = name ++ run rest
-  run ('%':'K':rest) = kind ++ run rest
-  run ('%':'L':rest) = line ++ run rest
-  run ('%':'%':rest) = '%'   : run rest
-
-  run ('%':'{':'M':'O':'D':'U':'L':'E':'}':rest) = mdl  ++ run rest
-  run ('%':'{':'F':'I':'L':'E':'}':rest)         = file ++ run rest
-  run ('%':'{':'N':'A':'M':'E':'}':rest)         = name ++ run rest
-  run ('%':'{':'K':'I':'N':'D':'}':rest)         = kind ++ run rest
-
-  run ('%':'{':'M':'O':'D':'U':'L':'E':'/':'.':'/':c:'}':rest) =
-    map (\x -> if x == '.' then c else x) mdl ++ run rest
-
-  run ('%':'{':'F':'I':'L':'E':'/':'/':'/':c:'}':rest) =
-    map (\x -> if x == '/' then c else x) file ++ run rest
-
-  run ('%':'{':'L':'I':'N':'E':'}':rest)         = line ++ run rest
-
-  run (c:rest) = c : run rest
-
-
-renderToString :: Bool -> Html -> String
-renderToString debug html
-  | debug = renderHtml html
-  | otherwise = showHtml html
-
-
-hsep :: [Html] -> Html
-hsep [] = noHtml
-hsep htmls = foldr1 (\a b -> a+++" "+++b) htmls
-
--- | Concatenate a series of 'Html' values vertically, with linebreaks in between.
-vcat :: [Html] -> Html
-vcat [] = noHtml
-vcat htmls = foldr1 (\a b -> a+++br+++b) htmls
-
-
-infixr 8 <+>
-(<+>) :: Html -> Html -> Html
-a <+> b = a +++ sep +++ b
-  where
-    sep = if isNoHtml a || isNoHtml b then noHtml else toHtml " "
-
--- | Join two 'Html' values together with a linebreak in between.
---   Has 'noHtml' as left identity.
-infixr 8 <=>
-(<=>) :: Html -> Html -> Html
-a <=> b = a +++ sep +++ b
-  where
-    sep = if isNoHtml a then noHtml else br
-
-
-keyword :: String -> Html
-keyword s = thespan ! [theclass "keyword"] << toHtml s
-
-
-equals, comma :: Html
-equals = char '='
-comma  = char ','
-
-
-char :: Char -> Html
-char c = toHtml [c]
-
-
-quote :: Html -> Html
-quote h = char '`' +++ h +++ '`'
-
-
-parens, brackets, pabrackets, braces :: Html -> Html
-parens h        = char '(' +++ h +++ char ')'
-brackets h      = char '[' +++ h +++ char ']'
-pabrackets h    = toHtml "[:" +++ h +++ toHtml ":]"
-braces h        = char '{' +++ h +++ char '}'
-
-
-punctuate :: Html -> [Html] -> [Html]
-punctuate _ []     = []
-punctuate h (d0:ds) = go d0 ds
-                   where
-                     go d [] = [d]
-                     go d (e:es) = (d +++ h) : go e es
-
-
-parenList :: [Html] -> Html
-parenList = parens . hsep . punctuate comma
-
-
-ubxParenList :: [Html] -> Html
-ubxParenList = ubxparens . hsep . punctuate comma
-
-
-ubxparens :: Html -> Html
-ubxparens h = toHtml "(#" +++ h +++ toHtml "#)"
-
-
-dcolon, arrow, darrow, forallSymbol :: Bool -> Html
-dcolon unicode = toHtml (if unicode then "∷" else "::")
-arrow  unicode = toHtml (if unicode then "→" else "->")
-darrow unicode = toHtml (if unicode then "⇒" else "=>")
-forallSymbol unicode = if unicode then toHtml "∀" else keyword "forall"
-
-
-dot :: Html
-dot = toHtml "."
-
-
--- | Generate a named anchor
-namedAnchor :: String -> Html -> Html
-namedAnchor n = anchor ! [XHtml.name n]
-
-
-linkedAnchor :: String -> Html -> Html
-linkedAnchor n = anchor ! [href ('#':n)]
-
-
--- | generate an anchor identifier for a group
-groupId :: String -> String
-groupId g = makeAnchorId ("g:" ++ g)
-
---
--- A section of HTML which is collapsible.
---
-
--- | Attributes for an area that can be collapsed
-collapseSection :: String -> Bool -> String -> [HtmlAttr]
-collapseSection id_ state classes = [ identifier sid, theclass cs ]
-  where cs = unwords (words classes ++ [pick state "show" "hide"])
-        sid = "section." ++ id_
-
--- | Attributes for an area that toggles a collapsed area
-collapseToggle :: String -> [HtmlAttr]
-collapseToggle id_ = [ strAttr "onclick" js ]
-  where js = "toggleSection('" ++ id_ ++ "')";
-  
--- | Attributes for an area that toggles a collapsed area,
--- and displays a control.
-collapseControl :: String -> Bool -> String -> [HtmlAttr]
-collapseControl id_ state classes =
-  [ identifier cid, theclass cs ] ++ collapseToggle id_
-  where cs = unwords (words classes ++ [pick state "collapser" "expander"])
-        cid = "control." ++ id_
-
-
-pick :: Bool -> a -> a -> a
-pick True  t _ = t
-pick False _ f = f