aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--haddock.cabal21
-rw-r--r--src/Haddock/Backends/Html.hs3
-rw-r--r--src/Haddock/Convert.hs2
-rw-r--r--src/Haddock/GhcUtils.hs6
-rw-r--r--src/Haddock/HsDoc.hs9
-rw-r--r--src/Haddock/Interface.hs12
-rw-r--r--src/Haddock/Interface/AttachInstances.hs6
-rw-r--r--src/Haddock/Interface/LexParseRn.hs16
-rw-r--r--src/Haddock/Interface/Rename.hs16
-rw-r--r--src/Haddock/InterfaceFile.hs6
-rw-r--r--src/Haddock/Types.hs51
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)
-
generated by cgit v1.2.3 (git 2.39.1) at 2024-09-21 11:10:07 +0000