Remove cruft due to compatibility with older GHCs

11 files changed, 16 insertions, 132 deletions

diff --git a/haddock.cabal b/haddock.cabal
index a382eddc..e6fc6e02 100644
--- a/haddock.cabal
+++ b/haddock.cabal
@@ -116,16 +116,6 @@ executable haddock
     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,
@@ -137,16 +127,5 @@ library
     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
-
diff --git a/src/Haddock/Backends/Html.hs b/src/Haddock/Backends/Html.hs
index 073dd66a..c29f2483 100644
--- a/src/Haddock/Backends/Html.hs
+++ b/src/Haddock/Backends/Html.hs
@@ -1604,10 +1604,9 @@ ppr_mono_ty _         (HsPArrTy ty)       u = pabrackets (ppr_mono_lty pREC_TOP
 ppr_mono_ty _         (HsPredTy p)        u = parens (ppPred u p)
 ppr_mono_ty _         (HsNumTy n)         _ = toHtml (show n) -- generics only
 ppr_mono_ty _         (HsSpliceTy _)      _ = error "ppr_mono_ty HsSpliceTy"
-#if __GLASGOW_HASKELL__ >= 611
 ppr_mono_ty _         (HsSpliceTyOut _)   _ = error "ppr_mono_ty HsSpliceTyOut"
 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 $
diff --git a/src/Haddock/Convert.hs b/src/Haddock/Convert.hs
index 6e564b76..93b69844 100644
--- a/src/Haddock/Convert.hs
+++ b/src/Haddock/Convert.hs
@@ -180,9 +180,7 @@ synifyDataCon use_gadt_syntax dc = noLoc $
  -- 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 = noLoc . getName
diff --git a/src/Haddock/GhcUtils.hs b/src/Haddock/GhcUtils.hs
index b720aa8c..31724864 100644
--- a/src/Haddock/GhcUtils.hs
+++ b/src/Haddock/GhcUtils.hs
@@ -22,10 +22,8 @@ import qualified Data.Map as Map
 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 @@ modulePackageInfo modu = case unpackPackageId pkg of
                           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 @@ unpackPackageId p
         []      -> Nothing
         (pid:_) -> Just pid
   where str = packageIdString p
-#endif
+
 
 mkModuleNoPackage :: String -> Module
 mkModuleNoPackage str = mkModule (stringToPackageId "") (mkModuleName str)
diff --git a/src/Haddock/HsDoc.hs b/src/Haddock/HsDoc.hs
index 489873a7..bb355a26 100644
--- a/src/Haddock/HsDoc.hs
+++ b/src/Haddock/HsDoc.hs
@@ -3,14 +3,8 @@ module Haddock.HsDoc (
   docParagraph
   ) where
 
-#if __GLASGOW_HASKELL__ <= 610
-
-import HsDoc -- just re-export
-
-#else
 
 import Haddock.Types
-
 import Data.Char (isSpace)
 
 
@@ -68,6 +62,3 @@ docCodeBlock (DocString s)
 docCodeBlock (DocAppend l r)
   = DocAppend l (docCodeBlock r)
 docCodeBlock d = d
-
-#endif
-
diff --git a/src/Haddock/Interface.hs b/src/Haddock/Interface.hs
index 9baa8e01..8816b294 100644
--- a/src/Haddock/Interface.hs
+++ b/src/Haddock/Interface.hs
@@ -79,13 +79,9 @@ createInterfaces' verbosity modules flags instIfaceMap = do
   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 +90,6 @@ createInterfaces' verbosity modules flags instIfaceMap = do
          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
@@ -159,12 +152,7 @@ mkGhcModule (mdl, file, checkedMod) dynflags = GhcModule {
 }
   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
 
 
diff --git a/src/Haddock/Interface/AttachInstances.hs b/src/Haddock/Interface/AttachInstances.hs
index 43f2466d..b6d988dc 100644
--- a/src/Haddock/Interface/AttachInstances.hs
+++ b/src/Haddock/Interface/AttachInstances.hs
@@ -28,13 +28,7 @@ import InstEnv
 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
diff --git a/src/Haddock/Interface/LexParseRn.hs b/src/Haddock/Interface/LexParseRn.hs
index 026e753c..dc7744c7 100644
--- a/src/Haddock/Interface/LexParseRn.hs
+++ b/src/Haddock/Interface/LexParseRn.hs
@@ -19,18 +19,13 @@ module Haddock.Interface.LexParseRn (
   ) where
 
 import Haddock.Types
-
-import Data.Maybe
-
-#if __GLASGOW_HASKELL__ >= 611
 import Haddock.Interface.Lex
 import Haddock.Interface.Parse
 import Haddock.Interface.Rn
 import Haddock.Interface.ParseModuleHeader
 import Haddock.HsDoc
+import Data.Maybe
 import FastString
-#endif
-
 import GHC
 import RdrName
 
@@ -47,7 +42,6 @@ lexParseRnHaddockCommentList hty gre docStrs = do
 
 lexParseRnHaddockComment :: HaddockCommentType ->
     GlobalRdrEnv -> HsDocString -> ErrMsgM (Maybe (HsDoc Name))
-#if __GLASGOW_HASKELL__ >= 611
 lexParseRnHaddockComment hty gre (HsDocString fs) = do
    let str = unpackFS fs
    let toks = tokenise str
@@ -59,9 +53,6 @@ lexParseRnHaddockComment hty gre (HsDocString fs) = do
        tell ["doc comment parse failed: "++str]
        return Nothing
      Just doc -> return (Just (rnHsDoc gre doc))
-#else
-lexParseRnHaddockComment _ _ doc = return (Just doc)
-#endif
 
 lexParseRnMbHaddockComment :: HaddockCommentType -> GlobalRdrEnv -> Maybe HsDocString -> ErrMsgM (Maybe (HsDoc Name))
 lexParseRnMbHaddockComment _ _ Nothing = return Nothing
@@ -69,7 +60,6 @@ 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 gre mbStr = do
   let failure = (emptyHaddockModInfo, Nothing)
   case mbStr of
@@ -82,7 +72,3 @@ lexParseRnHaddockModHeader gre mbStr = do
           return failure
         Right (info, doc) ->
           return (rnHaddockModInfo gre info, Just (rnHsDoc gre doc))
-#else
-lexParseRnHaddockModHeader _ hdr = return hdr
-#endif
-
diff --git a/src/Haddock/Interface/Rename.hs b/src/Haddock/Interface/Rename.hs
index 48a14d23..0d678537 100644
--- a/src/Haddock/Interface/Rename.hs
+++ b/src/Haddock/Interface/Rename.hs
@@ -156,17 +156,9 @@ renameDocForDecl (mbDoc, fnArgsDoc) = do
 renameMaybeDoc :: Maybe (HsDoc Name) -> RnM (Maybe (HsDoc 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)
@@ -336,15 +328,9 @@ renameLTyClD (L loc d) = return . L loc =<< renameTyClD d
 
 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
diff --git a/src/Haddock/InterfaceFile.hs b/src/Haddock/InterfaceFile.hs
index ed49a533..cfcc8fbd 100644
--- a/src/Haddock/InterfaceFile.hs
+++ b/src/Haddock/InterfaceFile.hs
@@ -54,11 +54,7 @@ binaryInterfaceMagic = 0xD0Cface
 -- 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
diff --git a/src/Haddock/Types.hs b/src/Haddock/Types.hs
index be326c60..0a8f0407 100644
--- a/src/Haddock/Types.hs
+++ b/src/Haddock/Types.hs
@@ -1,5 +1,5 @@
 {-# OPTIONS_HADDOCK hide #-}
-{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE DeriveDataTypeable, DeriveFunctor #-}
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  Haddock.Types
@@ -17,13 +17,7 @@
 
 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
 
 
@@ -42,10 +36,6 @@ type Doc  = HsDoc Name
 
 type DocInstance name = (InstHead name, Maybe (HsDoc name))
 
-#if __GLASGOW_HASKELL__ <= 610
-type HsDocString = HsDoc Name
-type LHsDocString = Located HsDocString
-#endif
 
 -- | Arguments and result are indexed by Int, zero-based from the left,
 -- because that's the easiest to use when recursing over types.
@@ -143,11 +133,9 @@ type InstIfaceMap  = Map Module InstalledInterface
 type DocMap        = Map Name (HsDoc DocName)
 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
 -- type checking phase
@@ -276,12 +264,12 @@ toInstalledIface interface = InstalledInterface {
 }
 
 unrenameHsDoc :: HsDoc DocName -> HsDoc Name
-unrenameHsDoc = fmapHsDoc getName
+unrenameHsDoc = fmap getName
 unrenameDocForDecl :: DocForDecl DocName -> DocForDecl Name
 unrenameDocForDecl (mbDoc, fnArgsDoc) =
     (fmap unrenameHsDoc mbDoc, fmap unrenameHsDoc fnArgsDoc)
 
-#if __GLASGOW_HASKELL__ >= 611
+
 data HsDoc id
   = DocEmpty
   | DocAppend (HsDoc id) (HsDoc id)
@@ -298,10 +286,11 @@ data HsDoc id
   | DocURL String
   | DocPic String
   | DocAName String
-  deriving (Eq, Show)
+  deriving (Eq, Show, Functor)
+
 
 type LHsDoc id = Located (HsDoc id)
-#endif
+
 
 data DocMarkup id a = Markup {
   markupEmpty         :: a,
@@ -321,7 +310,7 @@ data DocMarkup id a = Markup {
   markupPic           :: String -> a
 }
 
-#if __GLASGOW_HASKELL__ >= 611
+
 data HaddockModInfo name = HaddockModInfo {
         hmi_description :: Maybe (HsDoc name),
         hmi_portability :: Maybe String,
@@ -329,6 +318,7 @@ data HaddockModInfo name = HaddockModInfo {
         hmi_maintainer  :: Maybe String
 }
 
+
 emptyHaddockModInfo :: HaddockModInfo a
 emptyHaddockModInfo = HaddockModInfo {
         hmi_description = Nothing,
@@ -336,7 +326,6 @@ emptyHaddockModInfo = HaddockModInfo {
         hmi_stability   = Nothing,
         hmi_maintainer  = Nothing
 }
-#endif
 
 
 -- A monad which collects error messages, locally defined to avoid a dep on mtl
@@ -395,23 +384,3 @@ instance Monad ErrMsgGhc where
   return a = WriterGhc (return (a, []))
   m >>= k = WriterGhc $ runWriterGhc m >>= \ (a, msgs1) ->
                fmap (second (msgs1 ++)) (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)
-