From 214f32e43e33285f2c3c05c55a4963d665e33e23 Mon Sep 17 00:00:00 2001 From: David Waern Date: Sat, 28 Nov 2009 15:05:03 +0000 Subject: Remove cruft due to compatibility with older GHCs --- src/Haddock/Backends/Html.hs | 3 +- src/Haddock/Convert.hs | 2 -- src/Haddock/GhcUtils.hs | 6 ++-- src/Haddock/HsDoc.hs | 9 ------ src/Haddock/Interface.hs | 12 -------- src/Haddock/Interface/AttachInstances.hs | 6 ---- src/Haddock/Interface/LexParseRn.hs | 16 +--------- src/Haddock/Interface/Rename.hs | 16 +--------- src/Haddock/InterfaceFile.hs | 6 +--- src/Haddock/Types.hs | 51 +++++++------------------------- 10 files changed, 16 insertions(+), 111 deletions(-) (limited to 'src') 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) - -- cgit v1.2.3