summaryrefslogtreecommitdiff
path: root/p/haskell-leksah-server
diff options
context:
space:
mode:
authorIain Lane <laney@debian.org>2013-04-14 14:10:57 +0400
committerIain Lane <laney@debian.org>2013-04-14 14:10:57 +0400
commit01829bd71f46bc27a46847b913b70a5e7684cb34 (patch)
tree2f7185dc3b5663a0d116e80fde2fde06e17283f5 /p/haskell-leksah-server
parentfacb70bc42b47c446ffb195a5df66365ab33beb7 (diff)
downloadDHG_packages-01829bd71f46bc27a46847b913b70a5e7684cb34.tar.gz
haskell-leksah-server: Add forgotten patch
Diffstat (limited to 'p/haskell-leksah-server')
-rw-r--r--p/haskell-leksah-server/debian/patches/ghc-7.6-compatibility.patch1843
1 files changed, 1843 insertions, 0 deletions
diff --git a/p/haskell-leksah-server/debian/patches/ghc-7.6-compatibility.patch b/p/haskell-leksah-server/debian/patches/ghc-7.6-compatibility.patch
new file mode 100644
index 000000000..9492abcd9
--- /dev/null
+++ b/p/haskell-leksah-server/debian/patches/ghc-7.6-compatibility.patch
@@ -0,0 +1,1843 @@
+From dc892c956ce07b3386778fc1fe7597adb9f8505b Mon Sep 17 00:00:00 2001
+From: Hamish Mackenzie <Hamish.K.Mackenzie@googlemail.com>
+Date: Wed, 10 Oct 2012 17:24:49 +1300
+Subject: [PATCH] GHC 7.6 fixes (Iain Lane: slightly modified for Debian)
+
+---
+ leksah-server.cabal | 44 +++---
+ src/IDE/Core/CTypes.hs | 2 +
+ src/IDE/HeaderParser.hs | 50 +++---
+ src/IDE/Metainfo/InterfaceCollector.hs | 122 +++++++++------
+ src/IDE/Metainfo/PackageCollector.hs | 13 +-
+ src/IDE/Metainfo/SourceCollectorH.hs | 271 ++++++++++++++++++++-------------
+ src/IDE/Metainfo/WorkspaceCollector.hs | 228 +++++++++++++++++----------
+ src/IDE/Utils/FileUtils.hs | 41 ++---
+ src/IDE/Utils/GHCUtils.hs | 38 ++++-
+ src/IDE/Utils/Server.hs | 9 +-
+ src/IDE/Utils/VersionUtils.hs | 9 +-
+ 11 files changed, 519 insertions(+), 308 deletions(-)
+
+Index: b/leksah-server.cabal
+===================================================================
+--- a/leksah-server.cabal
++++ b/leksah-server.cabal
+@@ -32,22 +32,25 @@
+
+ library
+ default-language: Haskell98
+- build-depends: Cabal >=1.6.0.1 && <1.15, base >= 4.0.0.0 && <4.6, binary >=0.5.0.0 && <0.6,
+- binary-shared >=0.8 && <0.9, bytestring >=0.9.0.1 && <0.10,
+- containers >=0.2.0.0 && <0.5,
+- directory >=1.0.0.2 && <1.2, filepath >=1.1.0.1 && <1.4, ghc >=6.10.1 && <7.5,
++ build-depends: Cabal >=1.6.0.1 && <1.17, base >= 4.0.0.0 && <4.7, binary >=0.5.0.0 && <0.6,
++ binary-shared >=0.8 && <0.9, bytestring >=0.9.0.1 && <0.11,
++ containers >=0.2.0.0 && <0.6,
++ directory >=1.0.0.2 && <1.3, filepath >=1.1.0.1 && <1.4, ghc >=6.10.1 && <7.7,
+ ltk >=0.12.1.0 && <0.13, parsec >=2.1.0.1 && <3.2,
+ pretty >=1.0.1.0 && <1.2, time >=1.1 && <1.5, deepseq >=1.1 && <1.4,
+- hslogger >= 1.0.7 && <1.2, network >=2.2 && <3.0, enumerator >=0.4.14 && < 0.5,
++ hslogger >= 1.0.7 && <1.3, network >=2.2 && <3.0, enumerator >=0.4.14 && < 0.5,
+ attoparsec-enumerator >=0.3 && <0.4, attoparsec >=0.10.0.3 && <0.11,
+ transformers >=0.2.2.0 && <0.4, strict >=0.3.2 && <0.4
+
+ if (impl(ghc >= 7.2))
+ binary-shared >=0.8.2
+
+- if (impl(ghc >= 7.4))
+- build-depends: haddock >= 2.7.2 && <2.11
++ if (impl(ghc >= 7.6))
++ build-depends: haddock >= 2.7.2 && <2.14
+ else
++ if (impl(ghc >= 7.4))
++ build-depends: haddock >= 2.7.2 && <2.11
++ else
+ if (impl(ghc >= 7.2))
+ build-depends: haddock >= 2.7.2 && <2.10
+ else
+@@ -68,7 +71,7 @@
+ build-depends: Win32 >=2.2.0.0 && <2.3
+ extra-libraries: kernel32 pango-1.0 glib-2.0
+ else
+- build-depends: unix >=2.3.1.0 && <2.6
++ build-depends: unix >=2.3.1.0 && <2.7
+
+ if flag(curl) || os(osx)
+ cpp-options: -DUSE_CURL
+@@ -96,18 +99,21 @@
+
+ executable leksah-server
+ default-language: Haskell98
+- build-depends: Cabal >=1.6.0.1 && <1.15, base >= 4.0.0.0 && <4.6, binary >=0.5.0.0 && <0.6,
+- binary-shared >=0.8 && <0.9, bytestring >=0.9.0.1 && <0.10,
+- containers >=0.2.0.0 && <0.5,
+- directory >=1.0.0.2 && <1.2, filepath >=1.1.0.1 && <1.6, ghc >=6.10.1 && <7.5,
++ build-depends: Cabal >=1.6.0.1 && <1.17, base >= 4.0.0.0 && <4.7, binary >=0.5.0.0 && <0.6,
++ binary-shared >=0.8 && <0.9, bytestring >=0.9.0.1 && <0.11,
++ containers >=0.2.0.0 && <0.6,
++ directory >=1.0.0.2 && <1.3, filepath >=1.1.0.1 && <1.6, ghc >=6.10.1 && <7.7,
+ ltk >=0.12.1.0 && <0.13, parsec >=2.1.0.1 && <3.2,
+ pretty >=1.0.1.0 && <1.2, time >=1.1 && <1.5, deepseq >=1.1 && <1.4,
+- hslogger >= 1.0.7 && <1.2, network >=2.2 && <3.0, enumerator >= 0.4.14 && <0.5,
++ hslogger >= 1.0.7 && <1.3, network >=2.2 && <3.0, enumerator >= 0.4.14 && <0.5,
+ attoparsec-enumerator >=0.3 && <0.4, attoparsec >=0.10.0.3 && <0.11,
+ transformers >=0.2.2.0 && <0.4, strict >=0.3.2 && <0.4
+- if (impl(ghc >= 7.4))
+- build-depends: haddock >= 2.7.2 && <2.11
++ if (impl(ghc >= 7.6))
++ build-depends: haddock >= 2.7.2 && <2.14
+ else
++ if (impl(ghc >= 7.4))
++ build-depends: haddock >= 2.7.2 && <2.11
++ else
+ if (impl(ghc >= 7.2))
+ build-depends: haddock >= 2.7.2 && <2.10
+ else
+@@ -128,7 +134,7 @@
+ build-depends: Win32 >=2.2.0.0 && <2.3
+ extra-libraries: kernel32 pango-1.0 glib-2.0
+ else
+- build-depends: unix >=2.3.1.0 && <2.6
++ build-depends: unix >=2.3.1.0 && <2.7
+
+ if flag(curl) || os(osx)
+ cpp-options: -DUSE_CURL
+@@ -167,8 +173,8 @@
+ hs-source-dirs: src
+ ghc-prof-options: -auto-all -prof
+ -- ghc-shared-options: -auto-all -prof
+- build-depends: base >= 4.0.0.0 && <4.6, hslogger >= 1.0.7 && <1.2, deepseq >=1.1 && <1.4,
+- bytestring >=0.9.0.1 && <0.10, enumerator >= 0.4.14 && <0.5,
++ build-depends: base >= 4.0.0.0 && <4.7, hslogger >= 1.0.7 && <1.3, deepseq >=1.1 && <1.4,
++ bytestring >=0.9.0.1 && <0.11, enumerator >= 0.4.14 && <0.5,
+ attoparsec-enumerator >=0.3 && <0.4, attoparsec >=0.10.0.3 && <0.11,
+ transformers >=0.2.2.0 && <0.4
+
+@@ -190,7 +196,7 @@
+ type: exitcode-stdio-1.0
+ hs-source-dirs: tests
+ main-is: TestTool.hs
+- build-depends: base >= 4.0.0.0 && <4.6, hslogger >= 1.0.7 && <1.3,
++ build-depends: base >= 4.0.0.0 && <4.7, hslogger >= 1.0.7 && <1.3,
+ leksah-server,
+ HUnit >=1.2 && <1.3, transformers >=0.2.2.0 && <0.4, enumerator >=0.4.14 && <0.5
+
+Index: b/src/IDE/Core/CTypes.hs
+===================================================================
+--- a/src/IDE/Core/CTypes.hs
++++ b/src/IDE/Core/CTypes.hs
+@@ -542,7 +542,9 @@
+
+ instance NFData DescrType where rnf a = seq a ()
+
++#if !MIN_VERSION_bytestring(0,10,0)
+ instance NFData BS.ByteString where rnf b = seq b ()
++#endif
+
+ #if !MIN_VERSION_deepseq(1,3,0)
+ instance NFData Version where rnf v = seq v ()
+Index: b/src/IDE/HeaderParser.hs
+===================================================================
+--- a/src/IDE/HeaderParser.hs
++++ b/src/IDE/HeaderParser.hs
+@@ -21,17 +21,31 @@
+ import IDE.Core.CTypes hiding(SrcSpan(..))
+ import GHC hiding (ImportDecl)
+ import FastString(unpackFS)
+-import RdrName(showRdrName)
+ import IDE.Utils.GHCUtils
+ import Data.Maybe (mapMaybe)
+ #if MIN_VERSION_ghc(7,4,1)
+-import Outputable(pprPrefixOcc,showSDoc)
++import Outputable(pprPrefixOcc, ppr)
+ #else
+-import Outputable(pprHsVar,showSDoc)
++import Outputable(pprHsVar, ppr)
++#endif
++#if MIN_VERSION_ghc(7,6,0)
++import Outputable(showSDoc)
++#else
++import qualified Outputable as O
+ #endif
+ import IDE.Utils.FileUtils (figureOutHaddockOpts)
+ import Control.Monad.IO.Class (MonadIO(..))
+
++#if !MIN_VERSION_ghc(7,6,0)
++showSDoc :: DynFlags -> O.SDoc -> String
++showSDoc _ = O.showSDoc
++showSDocUnqual :: DynFlags -> O.SDoc -> String
++showSDocUnqual _ = O.showSDocUnqual
++#endif
++
++showRdrName :: DynFlags -> RdrName -> String
++showRdrName dflags r = showSDoc dflags (ppr r)
++
+ parseTheHeader :: FilePath -> IO ServerAnswer
+ parseTheHeader filePath = do
+ text <- readFile filePath
+@@ -39,7 +53,7 @@
+ parseResult <- liftIO $ myParseHeader filePath text opts
+ case parseResult of
+ Left str -> return (ServerFailed str)
+- Right (pr@HsModule{ hsmodImports = []}) -> do
++ Right (_, pr@HsModule{ hsmodImports = []}) -> do
+ let i = case hsmodDecls pr of
+ decls@(_hd:_tl) -> (foldl (\ a b -> min a (srcSpanStartLine' (getLoc b))) 0 decls) - 1
+ [] -> case hsmodExports pr of
+@@ -48,13 +62,13 @@
+ Nothing -> 0
+ Just mn -> srcSpanEndLine' (getLoc mn) + 2
+ return (ServerHeader (Right i))
+- Right (_pr@HsModule{ hsmodImports = imports }) -> return (ServerHeader (Left (transformImports imports)))
++ Right (dflags, _pr@HsModule{ hsmodImports = imports }) -> return (ServerHeader (Left (transformImports dflags imports)))
+
+-transformImports :: [LImportDecl RdrName] -> [ImportDecl]
+-transformImports = map transformImport
++transformImports :: DynFlags -> [LImportDecl RdrName] -> [ImportDecl]
++transformImports dflags = map (transformImport dflags)
+
+-transformImport :: LImportDecl RdrName -> ImportDecl
+-transformImport (L srcSpan importDecl) =
++transformImport :: DynFlags -> LImportDecl RdrName -> ImportDecl
++transformImport dflags (L srcSpan importDecl) =
+ ImportDecl {
+ importLoc = srcSpanToLocation srcSpan,
+ importModule = modName,
+@@ -73,19 +87,19 @@
+ Just mn -> Just (moduleNameString mn)
+ specs = case ideclHiding importDecl of
+ Nothing -> Nothing
+- Just (hide, list) -> Just (ImportSpecList hide (mapMaybe transformEntity list))
++ Just (hide, list) -> Just (ImportSpecList hide (mapMaybe (transformEntity dflags) list))
+
+-transformEntity :: LIE RdrName -> Maybe ImportSpec
++transformEntity :: DynFlags -> LIE RdrName -> Maybe ImportSpec
+ #if MIN_VERSION_ghc(7,2,0)
+-transformEntity (L _ (IEVar name)) = Just (IVar (showSDoc (pprPrefixOcc name)))
++transformEntity dflags (L _ (IEVar name)) = Just (IVar (showSDoc dflags (pprPrefixOcc name)))
+ #else
+-transformEntity (L _ (IEVar name)) = Just (IVar (showSDoc (pprHsVar name)))
++transformEntity dflags (L _ (IEVar name)) = Just (IVar (showSDoc dflags (pprHsVar name)))
+ #endif
+-transformEntity (L _ (IEThingAbs name)) = Just (IAbs (showRdrName name))
+-transformEntity (L _ (IEThingAll name)) = Just (IThingAll (showRdrName name))
+-transformEntity (L _ (IEThingWith name list)) = Just (IThingWith (showRdrName name)
+- (map showRdrName list))
+-transformEntity _ = Nothing
++transformEntity dflags (L _ (IEThingAbs name)) = Just (IAbs (showRdrName dflags name))
++transformEntity dflags (L _ (IEThingAll name)) = Just (IThingAll (showRdrName dflags name))
++transformEntity dflags (L _ (IEThingWith name list)) = Just (IThingWith (showRdrName dflags name)
++ (map (showRdrName dflags) list))
++transformEntity _ _ = Nothing
+
+ #if MIN_VERSION_ghc(7,2,0)
+ srcSpanToLocation :: SrcSpan -> Location
+Index: b/src/IDE/Metainfo/InterfaceCollector.hs
+===================================================================
+--- a/src/IDE/Metainfo/InterfaceCollector.hs
++++ b/src/IDE/Metainfo/InterfaceCollector.hs
+@@ -23,6 +23,7 @@
+ import Module hiding (PackageId,ModuleName)
+ import qualified Module as Module (ModuleName)
+ import qualified Maybes as M
++import DynFlags (DynFlags)
+ #if MIN_VERSION_ghc(7,2,0)
+ import HscTypes
+ import GhcMonad hiding (liftIO)
+@@ -36,7 +37,12 @@
+ import TysWiredIn ( eqTyConName )
+ #endif
+ import LoadIface
++#if MIN_VERSION_ghc(7,6,0)
+ import Outputable hiding(trace)
++#else
++import Outputable hiding(trace, showSDoc, showSDocUnqual)
++import qualified Outputable as O
++#endif
+ import IfaceSyn
+ import FastString
+ import Name
+@@ -65,15 +71,21 @@
+ import IDE.Utils.GHCUtils
+ import Control.DeepSeq(deepseq)
+
++#if !MIN_VERSION_ghc(7,6,0)
++showSDoc :: DynFlags -> SDoc -> String
++showSDoc _ = O.showSDoc
++showSDocUnqual :: DynFlags -> SDoc -> String
++showSDocUnqual _ = O.showSDocUnqual
++#endif
+
+ collectPackageFromHI :: PackageConfig -> IO PackageDescr
+-collectPackageFromHI packageConfig = inGhcIO [] [] $ \ _ -> do
++collectPackageFromHI packageConfig = inGhcIO [] [] $ \ dflags -> do
+ session <- getSession
+ exportedIfaceInfos <- getIFaceInfos (getThisPackage packageConfig)
+ (IPI.exposedModules packageConfig) session
+ hiddenIfaceInfos <- getIFaceInfos (getThisPackage packageConfig)
+ (IPI.hiddenModules packageConfig) session
+- let pd = extractInfo exportedIfaceInfos hiddenIfaceInfos (getThisPackage packageConfig)
++ let pd = extractInfo dflags exportedIfaceInfos hiddenIfaceInfos (getThisPackage packageConfig)
+ #if MIN_VERSION_Cabal(1,8,0)
+ [] -- TODO 6.12 (IPI.depends $ packageConfigToInstalledPackageInfo packageConfig))
+ #else
+@@ -101,20 +113,20 @@
+
+ -------------------------------------------------------------------------
+
+-extractInfo :: [(ModIface, FilePath)] -> [(ModIface, FilePath)] -> PackageIdentifier ->
++extractInfo :: DynFlags -> [(ModIface, FilePath)] -> [(ModIface, FilePath)] -> PackageIdentifier ->
+ [PackageIdentifier] -> PackageDescr
+-extractInfo ifacesExp ifacesHid pid buildDepends =
+- let allDescrs = concatMap (extractExportedDescrH pid)
++extractInfo dflags ifacesExp ifacesHid pid buildDepends =
++ let allDescrs = concatMap (extractExportedDescrH dflags pid)
+ (map fst (ifacesHid ++ ifacesExp))
+- mods = map (extractExportedDescrR pid allDescrs) (map fst ifacesExp)
++ mods = map (extractExportedDescrR dflags pid allDescrs) (map fst ifacesExp)
+ in PackageDescr {
+ pdPackage = pid
+ , pdModules = mods
+ , pdBuildDepends = buildDepends
+ , pdMbSourcePath = Nothing}
+
+-extractExportedDescrH :: PackageIdentifier -> ModIface -> [Descr]
+-extractExportedDescrH pid iface =
++extractExportedDescrH :: DynFlags -> PackageIdentifier -> ModIface -> [Descr]
++extractExportedDescrH dflags pid iface =
+ let mid = (fromJust . simpleParse . moduleNameString . moduleName) (mi_module iface)
+ exportedNames = Set.fromList
+ #if MIN_VERSION_Cabal(1,11,0)
+@@ -129,14 +141,15 @@
+ exportedDecls = filter (\ ifdecl -> (occNameString $ ifName ifdecl)
+ `Set.member` exportedNames)
+ (map snd (mi_decls iface))
+- in concatMap (extractIdentifierDescr pid [mid]) exportedDecls
++ in concatMap (extractIdentifierDescr dflags pid [mid]) exportedDecls
+
+
+-extractExportedDescrR :: PackageIdentifier
++extractExportedDescrR :: DynFlags
++ -> PackageIdentifier
+ -> [Descr]
+ -> ModIface
+ -> ModuleDescr
+-extractExportedDescrR pid hidden iface =
++extractExportedDescrR dflags pid hidden iface =
+ let mid = (fromJust . simpleParse . moduleNameString . moduleName) (mi_module iface)
+ exportedNames = Set.fromList
+ #if MIN_VERSION_Cabal(1,11,0)
+@@ -151,12 +164,12 @@
+ exportedDecls = filter (\ ifdecl -> (occNameString $ifName ifdecl)
+ `Set.member` exportedNames)
+ (map snd (mi_decls iface))
+- ownDecls = concatMap (extractIdentifierDescr pid [mid]) exportedDecls
++ ownDecls = concatMap (extractIdentifierDescr dflags pid [mid]) exportedDecls
+ otherDecls = exportedNames `Set.difference` (Set.fromList (map dscName ownDecls))
+ reexported = map (\d -> Reexported (ReexportedDescr (Just (PM pid mid)) d))
+ $ filter (\k -> (dscName k) `Set.member` otherDecls) hidden
+- inst = concatMap (extractInstances (PM pid mid)) (mi_insts iface)
+- uses = Map.fromList . catMaybes $ map extractUsages (mi_usages iface)
++ inst = concatMap (extractInstances dflags (PM pid mid)) (mi_insts iface)
++ uses = Map.fromList . catMaybes $ map (extractUsages dflags) (mi_usages iface)
+ declsWithExp = map withExp ownDecls
+ withExp (Real d) = Real $ d{dscExported' = Set.member (dscName' d) exportedNames}
+ withExp _ = error "Unexpected Reexported"
+@@ -166,14 +179,14 @@
+ , mdReferences = uses
+ , mdIdDescriptions = declsWithExp ++ inst ++ reexported}
+
+-extractIdentifierDescr :: PackageIdentifier -> [ModuleName] -> IfaceDecl -> [Descr]
+-extractIdentifierDescr package modules decl
++extractIdentifierDescr :: DynFlags -> PackageIdentifier -> [ModuleName] -> IfaceDecl -> [Descr]
++extractIdentifierDescr dflags package modules decl
+ = if null modules
+ then []
+ else
+ let descr = RealDescr{
+ dscName' = unpackFS $occNameFS (ifName decl)
+- , dscMbTypeStr' = Just (BS.pack $ unlines $ nonEmptyLines $ filterExtras $ showSDocUnqual $ppr decl)
++ , dscMbTypeStr' = Just (BS.pack $ unlines $ nonEmptyLines $ filterExtras $ showSDocUnqual dflags $ppr decl)
+ , dscMbModu' = Just (PM package (last modules))
+ , dscMbLocation' = Nothing
+ , dscMbComment' = Nothing
+@@ -188,20 +201,20 @@
+ #endif
+ -> map Real [descr]
+ #if MIN_VERSION_Cabal(1,11,0)
+- (IfaceData name _ _ ifCons' _ _ _)
++ (IfaceData {ifName=name, ifCons=ifCons'})
+ #else
+ (IfaceData name _ _ ifCons' _ _ _ _)
+ #endif
+ -> let d = case ifCons' of
+ IfDataTyCon _decls
+ -> let
+- fieldNames = concatMap extractFields (visibleIfConDecls ifCons')
+- constructors' = extractConstructors name (visibleIfConDecls ifCons')
++ fieldNames = concatMap (extractFields dflags) (visibleIfConDecls ifCons')
++ constructors' = extractConstructors dflags name (visibleIfConDecls ifCons')
+ in DataDescr constructors' fieldNames
+ IfNewTyCon _
+ -> let
+- fieldNames = concatMap extractFields (visibleIfConDecls ifCons')
+- constructors' = extractConstructors name (visibleIfConDecls ifCons')
++ fieldNames = concatMap (extractFields dflags) (visibleIfConDecls ifCons')
++ constructors' = extractConstructors dflags name (visibleIfConDecls ifCons')
+ mbField = case fieldNames of
+ [] -> Nothing
+ [fn] -> Just fn
+@@ -217,21 +230,29 @@
+ #else
+ IfAbstractTyCon -> DataDescr [] []
+ #endif
++#if MIN_VERSION_ghc(7,6,0)
++ IfDataFamTyCon -> DataDescr [] []
++#else
+ IfOpenDataTyCon -> DataDescr [] []
++#endif
+ in [Real (descr{dscTypeHint' = d})]
+ (IfaceClass context _ _ _ _ ifSigs' _ )
+ -> let
+- classOpsID = map extractClassOp ifSigs'
++ classOpsID = map (extractClassOp dflags) ifSigs'
+ superclasses = extractSuperClassNames context
+ in [Real $ descr{dscTypeHint' = ClassDescr superclasses classOpsID}]
+- (IfaceSyn _ _ _ _ _ )
++ (IfaceSyn {})
+ -> [Real $ descr{dscTypeHint' = TypeDescr}]
+- (IfaceForeign _ _)
++#if MIN_VERSION_ghc(7,6,0)
++ (IfaceAxiom {})
++ -> [Real $ descr]
++#endif
++ (IfaceForeign {})
+ -> [Real $ descr]
+
+-extractConstructors :: OccName -> [IfaceConDecl] -> [SimpleDescr]
+-extractConstructors name decls = map (\decl -> SimpleDescr (unpackFS $occNameFS (ifConOcc decl))
+- (Just (BS.pack $ filterExtras $ showSDocUnqual $
++extractConstructors :: DynFlags -> OccName -> [IfaceConDecl] -> [SimpleDescr]
++extractConstructors dflags name decls = map (\decl -> SimpleDescr (unpackFS $occNameFS (ifConOcc decl))
++ (Just (BS.pack $ filterExtras $ showSDocUnqual dflags $
+ pprIfaceForAllPart (ifConUnivTvs decl ++ ifConExTvs decl)
+ (eq_ctxt decl ++ ifConCtxt decl) (pp_tau decl)))
+ Nothing Nothing True) decls
+@@ -248,20 +269,20 @@
+ #endif
+ | (tv,ty) <- ifConEqSpec decl]
+
+-extractFields :: IfaceConDecl -> [SimpleDescr]
+-extractFields decl = map (\ (n, t) -> SimpleDescr n t Nothing Nothing True)
++extractFields :: DynFlags -> IfaceConDecl -> [SimpleDescr]
++extractFields dflags decl = map (\ (n, t) -> SimpleDescr n t Nothing Nothing True)
+ $ zip (map extractFieldNames (ifConFields decl))
+- (map extractType (ifConArgTys decl))
++ (map (extractType dflags) (ifConArgTys decl))
+
+-extractType :: IfaceType -> Maybe ByteString
+-extractType it = Just ((BS.pack . filterExtras . showSDocUnqual . ppr) it)
++extractType :: DynFlags -> IfaceType -> Maybe ByteString
++extractType dflags it = Just ((BS.pack . filterExtras . showSDocUnqual dflags . ppr) it)
+
+ extractFieldNames :: OccName -> String
+ extractFieldNames occName = unpackFS $occNameFS occName
+
+-extractClassOp :: IfaceClassOp -> SimpleDescr
+-extractClassOp (IfaceClassOp occName _dm ty) = SimpleDescr (unpackFS $occNameFS occName)
+- (Just (BS.pack $ showSDocUnqual (ppr ty)))
++extractClassOp :: DynFlags -> IfaceClassOp -> SimpleDescr
++extractClassOp dflags (IfaceClassOp occName _dm ty) = SimpleDescr (unpackFS $occNameFS occName)
++ (Just (BS.pack $ showSDocUnqual dflags (ppr ty)))
+ Nothing Nothing True
+
+ extractSuperClassNames :: [IfacePredType] -> [String]
+@@ -273,10 +294,17 @@
+ #endif
+ extractSuperClassName _ = Nothing
+
+-extractInstances :: PackModule -> IfaceInst -> [Descr]
+-extractInstances pm ifaceInst =
+- let className = showSDocUnqual $ ppr $ ifInstCls ifaceInst
+- dataNames = map (\iftc -> showSDocUnqual $ ppr iftc)
++extractInstances :: DynFlags
++ -> PackModule
++#if MIN_VERSION_ghc(7,6,0)
++ -> IfaceClsInst
++#else
++ -> IfaceInst
++#endif
++ -> [Descr]
++extractInstances dflags pm ifaceInst =
++ let className = showSDocUnqual dflags $ ppr $ ifInstCls ifaceInst
++ dataNames = map (\iftc -> showSDocUnqual dflags $ ppr iftc)
+ $ map fromJust
+ $ filter isJust
+ $ ifInstTys ifaceInst
+@@ -290,24 +318,24 @@
+ , dscExported' = False})]
+
+
+-extractUsages :: Usage -> Maybe (ModuleName, Set String)
++extractUsages :: DynFlags -> Usage -> Maybe (ModuleName, Set String)
+ #if MIN_VERSION_Cabal(1,11,0)
+-extractUsages (UsagePackageModule usg_mod' _ _) =
++extractUsages _ (UsagePackageModule usg_mod' _ _) =
+ #else
+-extractUsages (UsagePackageModule usg_mod' _ ) =
++extractUsages _ (UsagePackageModule usg_mod' _ ) =
+ #endif
+ let name = (fromJust . simpleParse . moduleNameString) (moduleName usg_mod')
+ in Just (name, Set.fromList [])
+ #if MIN_VERSION_Cabal(1,11,0)
+-extractUsages (UsageHomeModule usg_mod_name' _ usg_entities' _ _) =
++extractUsages dflags (UsageHomeModule usg_mod_name' _ usg_entities' _ _) =
+ #else
+-extractUsages (UsageHomeModule usg_mod_name' _ usg_entities' _) =
++extractUsages _ (UsageHomeModule usg_mod_name' _ usg_entities' _) =
+ #endif
+ let name = (fromJust . simpleParse . moduleNameString) usg_mod_name'
+- ids = map (showSDocUnqual . ppr . fst) usg_entities'
++ ids = map (showSDocUnqual dflags . ppr . fst) usg_entities'
+ in Just (name, Set.fromList ids)
+ #if MIN_VERSION_ghc(7,4,0)
+-extractUsages (UsageFile _ _) = Nothing
++extractUsages _ (UsageFile _ _) = Nothing
+ #endif
+
+ filterExtras, filterExtras' :: String -> String
+Index: b/src/IDE/Metainfo/PackageCollector.hs
+===================================================================
+--- a/src/IDE/Metainfo/PackageCollector.hs
++++ b/src/IDE/Metainfo/PackageCollector.hs
+@@ -55,9 +55,8 @@
+ import System.Process (system)
+ #endif
+ #endif
+-import Prelude hiding(catch)
+ import Control.Monad.IO.Class (MonadIO, MonadIO(..))
+-import qualified Control.Exception as NewException (SomeException, catch)
++import qualified Control.Exception as E (SomeException, catch)
+ import IDE.Utils.Tool (runTool')
+
+ collectPackage :: Bool -> Prefs -> Int -> (PackageConfig,Int) -> IO PackageCollectStats
+@@ -132,15 +131,15 @@
+ filePath = collectorPath </> packString <.> leksahMetadataSystemFileExtension
+ debugM "leksah-server" $ "collectPackage: before retreiving = " ++ fullUrl
+ #if defined(USE_LIBCURL)
+- catch (do
++ E.catch (do
+ (code, string) <- curlGetString_ fullUrl []
+ when (code == CurlOK) $
+ withBinaryFile filePath WriteMode $ \ file -> do
+ hPutStr file string)
+ #elif defined(USE_CURL)
+- catch ((system $ "curl -OL --fail " ++ fullUrl) >> return ())
++ E.catch ((system $ "curl -OL --fail " ++ fullUrl) >> return ())
+ #else
+- catch ((system $ "wget " ++ fullUrl) >> return ())
++ E.catch ((system $ "wget " ++ fullUrl) >> return ())
+ #endif
+ (\(e :: SomeException) ->
+ debugM "leksah-server" $ "collectPackage: Error when calling wget " ++ show e)
+@@ -154,8 +153,8 @@
+ runCabalConfigure fpSource = do
+ let dirPath = dropFileName fpSource
+ setCurrentDirectory dirPath
+- NewException.catch (runTool' "cabal" (["configure","--user"]) Nothing >> return ())
+- (\ (_e :: NewException.SomeException) -> do
++ E.catch (runTool' "cabal" (["configure","--user"]) Nothing >> return ())
++ (\ (_e :: E.SomeException) -> do
+ debugM "leksah-server" "Can't configure"
+ return ())
+
+Index: b/src/IDE/Metainfo/SourceCollectorH.hs
+===================================================================
+--- a/src/IDE/Metainfo/SourceCollectorH.hs
++++ b/src/IDE/Metainfo/SourceCollectorH.hs
+@@ -35,7 +35,11 @@
+ import Documentation.Haddock
+ #endif
+ import Distribution.Text (simpleParse)
++#if MIN_VERSION_ghc(7,6,0)
++import InstEnv (ClsInst(..))
++#else
+ import InstEnv (Instance(..))
++#endif
+ import MyMissing
+ import Data.Map (Map)
+ import qualified Data.Map as Map (empty)
+@@ -70,8 +74,14 @@
+ import System.Log.Logger (warningM, debugM)
+ import Control.DeepSeq (deepseq)
+ import Data.ByteString.Char8 (ByteString)
+-import Outputable hiding (trace)
++#if MIN_VERSION_ghc(7,6,0)
++import Outputable hiding(trace)
++#else
++import Outputable hiding(trace, showSDoc, showSDocUnqual)
++import qualified Outputable as O
++#endif
+ import GHC.Show(showSpace)
++import Name
+
+ #ifdef MIN_VERSION_haddock_leksah
+ #else
+@@ -84,15 +94,22 @@
+ isEmptyDoc DocEmpty = True
+ isEmptyDoc _ = False
+
+-show' :: Outputable alpha => alpha -> String
+ #if MIN_VERSION_ghc(6,12,1)
+ type MyLDocDecl = LDocDecl
+-show' = showSDoc . ppr
+ #else
+ type MyLDocDecl = LDocDecl Name
+-show' = showSDoc . ppr
+ #endif
+
++#if !MIN_VERSION_ghc(7,6,0)
++showSDoc :: DynFlags -> SDoc -> String
++showSDoc _ = O.showSDoc
++showSDocUnqual :: DynFlags -> SDoc -> String
++showSDocUnqual _ = O.showSDocUnqual
++#endif
++
++show' :: Outputable alpha => DynFlags -> alpha -> String
++show' dflags = showSDoc dflags . ppr
++
+ data PackageCollectStats = PackageCollectStats {
+ packageString :: String,
+ modulesTotal :: Maybe Int,
+@@ -136,14 +153,14 @@
+ warningM "leksah-server" ("Ghc failed to process: " ++ show e)
+ return (Nothing, PackageCollectStats packageName Nothing False False
+ (Just ("Ghc failed to process: " ++ show e)))
+- inner ghcFlags = inGhcIO ghcFlags [Opt_Haddock] $ \ _flags -> do
++ inner ghcFlags = inGhcIO ghcFlags [Opt_Haddock] $ \ dflags -> do
+ #if MIN_VERSION_haddock(2,8,0)
+ (interfaces,_) <- processModules verbose (exportedMods ++ hiddenMods) [] []
+ #else
+ (interfaces,_) <- createInterfaces verbose (exportedMods ++ hiddenMods) [] []
+ #endif
+ liftIO $ print (length interfaces)
+- let mods = map (interfaceToModuleDescr dirPath (getThisPackage packageConfig)) interfaces
++ let mods = map (interfaceToModuleDescr dflags dirPath (getThisPackage packageConfig)) interfaces
+ sp <- liftIO $ myCanonicalizePath dirPath
+ let pd = PackageDescr {
+ pdPackage = getThisPackage packageConfig
+@@ -159,8 +176,8 @@
+
+ -- Heaven
+
+-interfaceToModuleDescr :: FilePath -> PackageIdentifier -> Interface -> ModuleDescr
+-interfaceToModuleDescr _dirPath pid interface =
++interfaceToModuleDescr :: DynFlags -> FilePath -> PackageIdentifier -> Interface -> ModuleDescr
++interfaceToModuleDescr dflags _dirPath pid interface =
+ ModuleDescr {
+ mdModuleId = PM pid modName
+ , mdMbSourcePath = Just filepath
+@@ -170,30 +187,42 @@
+ filepath = ifaceOrigFilename interface
+ modName = forceJust ((simpleParse . moduleNameString . moduleName . ifaceMod) interface)
+ "Can't parse module name"
+- descrs = extractDescrs (PM pid modName)
++ descrs = extractDescrs dflags (PM pid modName)
+ (ifaceDeclMap interface) (ifaceExportItems interface)
+ (ifaceInstances interface) [] --(ifaceLocals interface)
+ imports = Map.empty --TODO
+
++#if MIN_VERSION_ghc(7,6,0)
++getDoc :: Documentation Name -> Maybe NDoc
++getDoc = documentationDoc
++#else
++getDoc :: Maybe NDoc -> Maybe NDoc
++getDoc = id
++#endif
++
+ #if MIN_VERSION_ghc(7,4,1)
+ type DeclInfo = [LHsDecl Name]
+ #endif
+ #if MIN_VERSION_ghc(6,12,1)
+-extractDescrs :: PackModule -> Map Name DeclInfo -> [ExportItem Name] -> [Instance] -> [Name] -> [Descr]
+-extractDescrs pm _ifaceDeclMap ifaceExportItems' ifaceInstances' _ifaceLocals =
+- transformToDescrs pm exportedDeclInfo ++ map (toDescrInst pm) ifaceInstances'
++#if MIN_VERSION_ghc(7,6,0)
++extractDescrs :: DynFlags -> PackModule -> Map Name DeclInfo -> [ExportItem Name] -> [ClsInst] -> [Name] -> [Descr]
++#else
++extractDescrs :: DynFlags -> PackModule -> Map Name DeclInfo -> [ExportItem Name] -> [Instance] -> [Name] -> [Descr]
++#endif
++extractDescrs dflags pm _ifaceDeclMap ifaceExportItems' ifaceInstances' _ifaceLocals =
++ transformToDescrs dflags pm exportedDeclInfo ++ map (toDescrInst dflags pm) ifaceInstances'
+ where
+ exportedDeclInfo = mapMaybe toDeclInfo ifaceExportItems'
+ toDeclInfo (ExportDecl decl mbDoc subDocs _) =
+- Just(decl,fst mbDoc,map (\ (a,b) -> (a,fst b)) subDocs)
++ Just(decl,getDoc $ fst mbDoc,map (\ (a,b) -> (a,getDoc $ fst b)) subDocs)
+ toDeclInfo (ExportNoDecl _ _) = Nothing
+ toDeclInfo (ExportGroup _ _ _) = Nothing
+ toDeclInfo (ExportDoc _) = Nothing
+ toDeclInfo (ExportModule _) = Nothing
+ #else
+-extractDescrs :: PackModule -> Map Name DeclInfo -> [ExportItem Name] -> [Instance] -> [Name] -> [Descr]
+-extractDescrs pm _ifaceDeclMap ifaceExportItems' ifaceInstances' _ifaceLocals =
+- transformToDescrs pm exportedDeclInfo ++ map (toDescrInst pm) ifaceInstances'
++extractDescrs :: DynFlags -> PackModule -> Map Name DeclInfo -> [ExportItem Name] -> [Instance] -> [Name] -> [Descr]
++extractDescrs dflags pm _ifaceDeclMap ifaceExportItems' ifaceInstances' _ifaceLocals =
++ transformToDescrs dflags pm exportedDeclInfo ++ map (toDescrInst dflags pm) ifaceInstances'
+ where
+ exportedDeclInfo = mapMaybe toDeclInfo ifaceExportItems'
+ toDeclInfo (ExportDecl decl mbDoc subDocs _) = Just(decl,mbDoc,subDocs)
+@@ -203,8 +232,8 @@
+ toDeclInfo (ExportModule _) = Nothing
+ #endif
+
+-transformToDescrs :: PackModule -> [(LHsDecl Name, Maybe NDoc, [(Name, Maybe NDoc)])] -> [Descr]
+-transformToDescrs pm = concatMap transformToDescr
++transformToDescrs :: DynFlags -> PackModule -> [(LHsDecl Name, Maybe NDoc, [(Name, Maybe NDoc)])] -> [Descr]
++transformToDescrs dflags pm = concatMap transformToDescr
+ where
+ #if MIN_VERSION_ghc(7,2,0)
+ transformToDescr ((L loc (SigD (TypeSig [name] typ))), mbComment,_subCommentList) =
+@@ -213,136 +242,174 @@
+ #endif
+ [Real $ RealDescr {
+ dscName' = getOccString (unLoc name)
+- , dscMbTypeStr' = Just (BS.pack (showSDocUnqual $ppr typ))
++ , dscMbTypeStr' = Just (BS.pack (showSDocUnqual dflags $ppr typ))
+ , dscMbModu' = Just pm
+ , dscMbLocation' = srcSpanToLocation loc
+- , dscMbComment' = toComment mbComment []
++ , dscMbComment' = toComment dflags mbComment []
+ , dscTypeHint' = VariableDescr
+ , dscExported' = True}]
+
+ transformToDescr ((L _loc (SigD _)), _mbComment, _subCommentList) = []
++
++#if MIN_VERSION_ghc(7,6,0)
++ transformToDescr ((L loc (TyClD typ@(ForeignType {tcdLName = lid}))), mbComment,_sigList) =
++ [Real $ RealDescr {
++ dscName' = getOccString (unLoc lid)
++ , dscMbTypeStr' = Just (BS.pack (showSDocUnqual dflags $ppr typ))
++ , dscMbModu' = Just pm
++ , dscMbLocation' = srcSpanToLocation loc
++ , dscMbComment' = toComment dflags mbComment []
++ , dscTypeHint' = TypeDescr
++ , dscExported' = True}]
++
++ transformToDescr ((L loc (TyClD typ@(TyFamily {tcdLName = lid}))), mbComment,_sigList) =
++ [Real $ RealDescr {
++ dscName' = getOccString (unLoc lid)
++ , dscMbTypeStr' = Just (BS.pack (showSDocUnqual dflags $ppr typ))
++ , dscMbModu' = Just pm
++ , dscMbLocation' = srcSpanToLocation loc
++ , dscMbComment' = toComment dflags mbComment []
++ , dscTypeHint' = TypeDescr
++ , dscExported' = True}]
++#endif
++
++#if MIN_VERSION_ghc(7,6,0)
++ transformToDescr ((L loc (TyClD typ@(TyDecl {tcdLName = lid, tcdTyDefn = TySynonym {}}))), mbComment,_sigList) =
++#else
+ transformToDescr ((L loc (TyClD typ@(TySynonym lid _ _ _ ))), mbComment, _subCommentList) =
++#endif
+ [Real $ RealDescr {
+ dscName' = getOccString (unLoc lid)
+- , dscMbTypeStr' = Just (BS.pack (showSDocUnqual $ppr typ))
++ , dscMbTypeStr' = Just (BS.pack (showSDocUnqual dflags $ppr typ))
+ , dscMbModu' = Just pm
+ , dscMbLocation' = srcSpanToLocation loc
+- , dscMbComment' = toComment mbComment []
++ , dscMbComment' = toComment dflags mbComment []
+ , dscTypeHint' = TypeDescr
+ , dscExported' = True}]
+
+- transformToDescr ((L loc (TyClD typ@(TyData DataType _ tcdLName' _ _ _ lConDecl tcdDerivs'))), mbComment,_subCommentList) =
++#if MIN_VERSION_ghc(7,6,0)
++ transformToDescr ((L loc (TyClD typ@(TyDecl {tcdLName = lid, tcdTyDefn = TyData {td_cons=lConDecl, td_derivs=tcdDerivs'}}))), mbComment,_sigList) =
++#else
++ transformToDescr ((L loc (TyClD typ@(TyData DataType _ lid _ _ _ lConDecl tcdDerivs'))), mbComment,_subCommentList) =
++#endif
+ [Real $ RealDescr {
+ dscName' = name
+- , dscMbTypeStr' = Just (BS.pack (showSDocUnqual $ppr (uncommentData typ)))
++ , dscMbTypeStr' = Just (BS.pack (showSDocUnqual dflags $ppr (uncommentData typ)))
+ , dscMbModu' = Just pm
+ , dscMbLocation' = srcSpanToLocation loc
+- , dscMbComment' = toComment mbComment []
++ , dscMbComment' = toComment dflags mbComment []
+ , dscTypeHint' = DataDescr constructors fields
+ , dscExported' = True}]
+ ++ derivings tcdDerivs'
+ where
+- constructors = map extractConstructor lConDecl
+- fields = nub $ concatMap extractRecordFields lConDecl
+- name = getOccString (unLoc tcdLName')
++ constructors = map (extractConstructor dflags) lConDecl
++ fields = nub $ concatMap (extractRecordFields dflags) lConDecl
++ name = getOccString (unLoc lid)
+ derivings Nothing = []
+ derivings (Just _l) = []
+
++#if !MIN_VERSION_ghc(7,6,0)
+ transformToDescr ((L loc (TyClD typ@(TyData NewType _ tcdLName' _ _ _ lConDecl tcdDerivs'))), mbComment,_subCommentList) =
+ [Real $ RealDescr {
+ dscName' = name
+- , dscMbTypeStr' = Just (BS.pack (showSDocUnqual $ppr (uncommentData typ)))
++ , dscMbTypeStr' = Just (BS.pack (showSDocUnqual dflags $ppr (uncommentData typ)))
+ , dscMbModu' = Just pm
+ , dscMbLocation' = srcSpanToLocation loc
+- , dscMbComment' = toComment mbComment []
++ , dscMbComment' = toComment dflags mbComment []
+ , dscTypeHint' = NewtypeDescr constructor mbField
+ , dscExported' = True}]
+ ++ derivings tcdDerivs'
+ where
+- constructor = forceHead (map extractConstructor lConDecl)
++ constructor = forceHead (map (extractConstructor dflags) lConDecl)
+ "WorkspaceCollector>>transformToDescr: no constructor for newtype"
+- mbField = case concatMap extractRecordFields lConDecl of
++ mbField = case concatMap (extractRecordFields dflags) lConDecl of
+ [] -> Nothing
+ a:_ -> Just a
+ name = getOccString (unLoc tcdLName')
+ derivings Nothing = []
+ derivings (Just _l) = []
++#endif
+
+ transformToDescr ((L loc (TyClD cl@(ClassDecl{tcdLName=tcdLName', tcdSigs=tcdSigs', tcdDocs=docs}))), mbComment,_subCommentList) =
+ [Real $ RealDescr {
+ dscName' = getOccString (unLoc tcdLName')
+- , dscMbTypeStr' = Just (BS.pack (showSDocUnqual $ppr cl{tcdMeths = emptyLHsBinds}))
++ , dscMbTypeStr' = Just (BS.pack (showSDocUnqual dflags $ppr cl{tcdMeths = emptyLHsBinds}))
+ , dscMbModu' = Just pm
+ , dscMbLocation' = srcSpanToLocation loc
+- , dscMbComment' = toComment mbComment []
++ , dscMbComment' = toComment dflags mbComment []
+ , dscTypeHint' = ClassDescr super methods
+ , dscExported' = True }]
+ where
+- methods = extractMethods tcdSigs' docs
++ methods = extractMethods dflags tcdSigs' docs
+ super = []
+
+ transformToDescr (_, _mbComment, _sigList) = []
+
+-toDescrInst :: PackModule -> Instance -> Descr
+-toDescrInst pm inst@(Instance is_cls' _is_tcs _is_tvs is_tys' _is_dfun _is_flag) =
++#if MIN_VERSION_ghc(7,6,0)
++toDescrInst :: DynFlags -> PackModule -> ClsInst -> Descr
++toDescrInst dflags pm inst@(ClsInst {is_cls = is_cls', is_tys = is_tys'}) =
++#else
++toDescrInst :: DynFlags -> PackModule -> Instance -> Descr
++toDescrInst dflags pm inst@(Instance is_cls' _is_tcs _is_tvs is_tys' _is_dfun _is_flag) =
++#endif
+ Real $ RealDescr {
+ dscName' = getOccString is_cls'
+- , dscMbTypeStr' = Just (BS.pack (showSDocUnqual $ppr inst))
++ , dscMbTypeStr' = Just (BS.pack (showSDocUnqual dflags $ppr inst))
+ , dscMbModu' = Just pm
+ , dscMbLocation' = srcSpanToLocation (getSrcSpan inst)
+ , dscMbComment' = Nothing
+- , dscTypeHint' = InstanceDescr (map (showSDocUnqual . ppr) is_tys')
++ , dscTypeHint' = InstanceDescr (map (showSDocUnqual dflags . ppr) is_tys')
+ , dscExported' = True}
+
+-extractMethods :: [LSig Name] -> [MyLDocDecl] -> [SimpleDescr]
+-extractMethods sigs docs =
+- let pairs = attachComments' sigs docs
+- in mapMaybe extractMethod pairs
++extractMethods :: DynFlags -> [LSig Name] -> [MyLDocDecl] -> [SimpleDescr]
++extractMethods dflags sigs docs =
++ let pairs = attachComments' dflags sigs docs
++ in mapMaybe (extractMethod dflags) pairs
+
+-extractMethod :: (LHsDecl Name, Maybe NDoc) -> Maybe SimpleDescr
++extractMethod :: DynFlags -> (LHsDecl Name, Maybe NDoc) -> Maybe SimpleDescr
+ #if MIN_VERSION_ghc(7,2,0)
+-extractMethod ((L loc (SigD ts@(TypeSig [name] _typ))), mbDoc) =
++extractMethod dflags ((L loc (SigD ts@(TypeSig [name] _typ))), mbDoc) =
+ #else
+-extractMethod ((L loc (SigD ts@(TypeSig name _typ))), mbDoc) =
++extractMethod dflags ((L loc (SigD ts@(TypeSig name _typ))), mbDoc) =
+ #endif
+ Just $ SimpleDescr
+ (getOccString (unLoc name))
+- (Just (BS.pack (showSDocUnqual $ ppr ts)))
++ (Just (BS.pack (showSDocUnqual dflags $ ppr ts)))
+ (srcSpanToLocation loc)
+- (toComment mbDoc [])
++ (toComment dflags mbDoc [])
+ True
+-extractMethod (_, _mbDoc) = Nothing
++extractMethod _dflags (_, _mbDoc) = Nothing
+
+-extractConstructor :: LConDecl Name -> SimpleDescr
+-extractConstructor decl@(L loc (ConDecl {con_name = name, con_doc = doc})) =
++extractConstructor :: DynFlags -> LConDecl Name -> SimpleDescr
++extractConstructor dflags decl@(L loc (ConDecl {con_name = name, con_doc = doc})) =
+ SimpleDescr
+ (getOccString (unLoc name))
+- (Just (BS.pack (showSDocUnqual $ppr (uncommentDecl decl))))
++ (Just (BS.pack (showSDocUnqual dflags $ppr (uncommentDecl decl))))
+ (srcSpanToLocation loc)
+ (case doc of
+ Nothing -> Nothing
+- Just (L _ d) -> Just (BS.pack (printHsDoc'' d)))
++ Just (L _ d) -> Just (BS.pack (printHsDoc d)))
+ True
+
+-extractRecordFields :: LConDecl Name -> [SimpleDescr]
+-extractRecordFields (L _ _decl@(ConDecl {con_details=(RecCon flds)})) =
++extractRecordFields :: DynFlags -> LConDecl Name -> [SimpleDescr]
++extractRecordFields dflags (L _ _decl@(ConDecl {con_details=(RecCon flds)})) =
+ map extractRecordFields' flds
+ where
+ extractRecordFields' _field@(ConDeclField (L loc name) typ doc) =
+ SimpleDescr
+ (getOccString name)
+- (Just (BS.pack (showSDocUnqual $ ppr typ)))
++ (Just (BS.pack (showSDocUnqual dflags $ ppr typ)))
+ (srcSpanToLocation loc)
+ (case doc of
+ Nothing -> Nothing
+- Just (L _ d) -> Just (BS.pack (printHsDoc'' d)))
++ Just (L _ d) -> Just (BS.pack (printHsDoc d)))
+ True
+-extractRecordFields _ = []
++extractRecordFields _ _ = []
+
+-toComment :: Maybe NDoc -> [NDoc] -> Maybe ByteString
+-toComment (Just c) _ = Just (BS.pack (printHsDoc' c))
+-toComment Nothing (c:_) = Just (BS.pack (printHsDoc' c))
+-toComment Nothing [] = Nothing
++toComment :: DynFlags -> Maybe NDoc -> [NDoc] -> Maybe ByteString
++toComment dflags (Just c) _ = Just (BS.pack (printHsDoc' dflags c))
++toComment dflags Nothing (c:_) = Just (BS.pack (printHsDoc' dflags c))
++toComment _ Nothing [] = Nothing
+
+
+ {--
+@@ -353,66 +420,62 @@
+ = addLocationAndComment (l,st) (unLoc lid) loc mbComment' [Class] []
+ --}
+
+-printHsDoc' :: HsDoc Name -> String
+-printHsDoc' d = show (PPDoc d)
+-
+-#if MIN_VERSION_ghc(6,12,1)
+-printHsDoc'' :: HsDocString -> String
+-printHsDoc'' = printHsDoc
+-#else
+-printHsDoc'' :: HsDoc Name -> String
+-printHsDoc'' = printHsDoc'
+-#endif
++printHsDoc' :: DynFlags -> HsDoc Name -> String
++printHsDoc' dflags d = show (PPDoc dflags d)
+
+-newtype PPDoc alpha = PPDoc (HsDoc alpha)
++data PPDoc alpha = PPDoc DynFlags (HsDoc alpha)
+
+ instance Outputable alpha => Show (PPDoc alpha) where
+- showsPrec _ (PPDoc DocEmpty) = id
+- showsPrec _ (PPDoc (DocAppend l r)) = shows (PPDoc l) . shows (PPDoc r)
+- showsPrec _ (PPDoc (DocString str)) = showString str
+- showsPrec _ (PPDoc (DocParagraph d)) = shows (PPDoc d) . showChar '\n'
+- showsPrec _ (PPDoc (DocIdentifier l)) = foldr (\i _f -> showChar '\'' .
+- ((showString . showSDoc . ppr) i) . showChar '\'') id [l]
+- showsPrec _ (PPDoc (DocModule str)) = showChar '"' . showString str . showChar '"'
+- showsPrec _ (PPDoc (DocEmphasis doc)) = showChar '/' . shows (PPDoc doc) . showChar '/'
+- showsPrec _ (PPDoc (DocMonospaced doc)) = showChar '@' . shows (PPDoc doc) . showChar '@'
+- showsPrec _ (PPDoc (DocUnorderedList l)) =
+- foldr (\s r -> showString "* " . shows (PPDoc s) . showChar '\n' . r) id l
+- showsPrec _ (PPDoc (DocOrderedList l)) =
+- foldr (\(i,n) _f -> shows n . showSpace . shows (PPDoc i)) id (zip l [1 .. length l])
+- showsPrec _ (PPDoc (DocDefList li)) =
+- foldr (\(l,r) f -> showString "[@" . shows (PPDoc l) . showString "[@ " . shows (PPDoc r) . f) id li
+- showsPrec _ (PPDoc (DocCodeBlock doc)) = showChar '@' . shows (PPDoc doc) . showChar '@'
+- showsPrec _ (PPDoc (DocURL str)) = showChar '<' . showString str . showChar '>'
+- showsPrec _ (PPDoc (DocAName str)) = showChar '#' . showString str . showChar '#'
+- showsPrec _ (PPDoc _) = id
++ showsPrec _ (PPDoc _ DocEmpty) = id
++ showsPrec _ (PPDoc d (DocAppend l r)) = shows (PPDoc d l) . shows (PPDoc d r)
++ showsPrec _ (PPDoc _ (DocString str)) = showString str
++ showsPrec _ (PPDoc d (DocParagraph doc)) = shows (PPDoc d doc) . showChar '\n'
++ showsPrec _ (PPDoc d (DocIdentifier l)) = foldr (\i _f -> showChar '\'' .
++ ((showString . showSDoc d . ppr) i) . showChar '\'') id [l]
++ showsPrec _ (PPDoc _ (DocModule str)) = showChar '"' . showString str . showChar '"'
++ showsPrec _ (PPDoc d (DocEmphasis doc)) = showChar '/' . shows (PPDoc d doc) . showChar '/'
++ showsPrec _ (PPDoc d (DocMonospaced doc)) = showChar '@' . shows (PPDoc d doc) . showChar '@'
++ showsPrec _ (PPDoc d (DocUnorderedList l)) =
++ foldr (\s r -> showString "* " . shows (PPDoc d s) . showChar '\n' . r) id l
++ showsPrec _ (PPDoc d (DocOrderedList l)) =
++ foldr (\(i,n) _f -> shows n . showSpace . shows (PPDoc d i)) id (zip l [1 .. length l])
++ showsPrec _ (PPDoc d (DocDefList li)) =
++ foldr (\(l,r) f -> showString "[@" . shows (PPDoc d l) . showString "[@ " . shows (PPDoc d r) . f) id li
++ showsPrec _ (PPDoc d (DocCodeBlock doc)) = showChar '@' . shows (PPDoc d doc) . showChar '@'
++#if MIN_VERSION_ghc(7,6,0)
++ showsPrec _ (PPDoc _ (DocHyperlink h)) = showChar '<' . showString (show h) . showChar '>'
++#else
++ showsPrec _ (PPDoc _ (DocURL str)) = showChar '<' . showString str . showChar '>'
++#endif
++ showsPrec _ (PPDoc _ (DocAName str)) = showChar '#' . showString str . showChar '#'
++ showsPrec _ (PPDoc _ _) = id
+
+-attachComments' :: [LSig Name] -> [MyLDocDecl] -> [(LHsDecl Name, Maybe (HsDoc Name))]
+-attachComments' sigs docs = collectDocs' $ sortByLoc $
++attachComments' :: DynFlags -> [LSig Name] -> [MyLDocDecl] -> [(LHsDecl Name, Maybe (HsDoc Name))]
++attachComments' dflags sigs docs = collectDocs' dflags $ sortByLoc $
+ ((map (\ (L l i) -> L l (SigD i)) sigs) ++ (map (\ (L l i) -> L l (DocD i)) docs))
+
+ -- | Collect the docs and attach them to the right declaration.
+-collectDocs' :: [LHsDecl Name] -> [(LHsDecl Name, (Maybe (HsDoc Name)))]
+-collectDocs' = collect' Nothing DocEmpty
++collectDocs' :: DynFlags -> [LHsDecl Name] -> [(LHsDecl Name, (Maybe (HsDoc Name)))]
++collectDocs' dflags = collect' dflags Nothing DocEmpty
+
+-collect' :: Maybe (LHsDecl Name) -> HsDoc Name -> [LHsDecl Name] -> [(LHsDecl Name, (Maybe (HsDoc Name)))]
+-collect' d doc_so_far [] =
++collect' :: DynFlags -> Maybe (LHsDecl Name) -> HsDoc Name -> [LHsDecl Name] -> [(LHsDecl Name, (Maybe (HsDoc Name)))]
++collect' _dflags d doc_so_far [] =
+ case d of
+ Nothing -> []
+ Just d0 -> finishedDoc' d0 doc_so_far []
+
+-collect' d doc_so_far (e:es) =
++collect' dflags d doc_so_far (e:es) =
+ case e of
+ L _ (DocD (DocCommentNext str)) ->
+ case d of
+- Nothing -> collect' d (DocAppend doc_so_far (DocString (show' str))) es
+- Just d0 -> finishedDoc' d0 doc_so_far (collect' Nothing (DocString (show' str)) es)
++ Nothing -> collect' dflags d (DocAppend doc_so_far (DocString (show' dflags str))) es
++ Just d0 -> finishedDoc' d0 doc_so_far (collect' dflags Nothing (DocString (show' dflags str)) es)
+
+- L _ (DocD (DocCommentPrev str)) -> collect' d (DocAppend doc_so_far (DocString (show' str))) es
++ L _ (DocD (DocCommentPrev str)) -> collect' dflags d (DocAppend doc_so_far (DocString (show' dflags str))) es
+
+ _ -> case d of
+- Nothing -> collect' (Just e) doc_so_far es
+- Just d0 -> finishedDoc' d0 doc_so_far (collect' (Just e) DocEmpty es)
++ Nothing -> collect' dflags (Just e) doc_so_far es
++ Just d0 -> finishedDoc' d0 doc_so_far (collect' dflags (Just e) DocEmpty es)
+
+ finishedDoc' :: LHsDecl alpha -> NDoc -> [(LHsDecl alpha, (Maybe ((HsDoc Name))))]
+ -> [(LHsDecl alpha, (Maybe ((HsDoc Name))))]
+Index: b/src/IDE/Metainfo/WorkspaceCollector.hs
+===================================================================
+--- a/src/IDE/Metainfo/WorkspaceCollector.hs
++++ b/src/IDE/Metainfo/WorkspaceCollector.hs
+@@ -35,7 +35,12 @@
+ #if !MIN_VERSION_ghc(7,2,0)
+ import HscTypes hiding (liftIO)
+ #endif
++#if MIN_VERSION_ghc(7,6,0)
+ import Outputable hiding(trace)
++#else
++import Outputable hiding(trace, showSDoc, showSDocUnqual)
++import qualified Outputable as O
++#endif
+ import ErrUtils
+ import qualified Data.Map as Map
+ import Data.Map(Map)
+@@ -54,9 +59,10 @@
+ import StringBuffer(hGetStringBuffer)
+ import Data.List(partition,sortBy,nub,find)
+ import Data.Ord(comparing)
+-import RdrName (showRdrName)
+ import GHC.Exception
++#if !MIN_VERSION_ghc(7,6,0)
+ import MyMissing(forceHead)
++#endif
+ import LoadIface(findAndReadIface)
+ import Distribution.Text(display)
+ import TcRnMonad (initTcRnIf, IfGblEnv(..))
+@@ -75,13 +81,13 @@
+ #else
+ import GHC.Show(showSpace)
+ #endif
++import Control.Exception as E
+
+ type NDecl = LHsDecl RdrName
+ myDocEmpty :: NDoc
+ myDocAppend :: NDoc -> NDoc -> NDoc
+ isEmptyDoc :: NDoc -> Bool
+
+-
+ #if MIN_VERSION_ghc(6,12,1)
+ type NDoc = HsDocString
+ type MyLDocDecl = LDocDecl
+@@ -101,6 +107,16 @@
+ #endif
+ type NSig = Located (Sig RdrName)
+
++#if !MIN_VERSION_ghc(7,6,0)
++showSDoc :: DynFlags -> SDoc -> String
++showSDoc _ = O.showSDoc
++showSDocUnqual :: DynFlags -> SDoc -> String
++showSDocUnqual _ = O.showSDocUnqual
++#endif
++
++showRdrName :: DynFlags -> RdrName -> String
++showRdrName dflags r = showSDoc dflags (ppr r)
++
+ -- | Test
+ collectWorkspace :: PackageIdentifier -> [(String,FilePath)] -> Bool -> Bool -> FilePath -> IO()
+ collectWorkspace packId moduleList forceRebuild writeAscii dir = do
+@@ -146,25 +162,25 @@
+
+ collectModule' :: FilePath -> FilePath -> Bool -> PackageIdentifier -> [String] -> ModuleName -> IO()
+ collectModule' sourcePath destPath writeAscii packId opts moduleName' = gcatch (
+- inGhcIO (opts++["-cpp"]) [Opt_Haddock] $ \ _dynFlags -> do
++ inGhcIO (opts++["-cpp"]) [Opt_Haddock] $ \ dynFlags -> do
+ session <- getSession
+ #if MIN_VERSION_ghc(7,2,0)
+ (dynFlags3,fp') <- liftIO $ preprocess session (sourcePath,Nothing)
+ #else
+ (dynFlags3,fp') <- preprocess session (sourcePath,Nothing)
+ #endif
+- mbInterfaceDescr <- mayGetInterfaceDescription packId moduleName'
++ mbInterfaceDescr <- mayGetInterfaceDescription dynFlags packId moduleName'
+ liftIO $ do
+ stringBuffer <- hGetStringBuffer fp'
+ parseResult <- myParseModule dynFlags3 sourcePath (Just stringBuffer)
+ case parseResult of
+ Right (L _ hsMod@(HsModule{})) -> do
+- let moduleDescr = extractModDescr packId moduleName' sourcePath hsMod
++ let moduleDescr = extractModDescr dynFlags packId moduleName' sourcePath hsMod
+ let moduleDescr' = case mbInterfaceDescr of
+ Nothing -> moduleDescr
+ Just md -> mergeWithInterfaceDescr moduleDescr md
+- catch (writeExtractedModule destPath writeAscii moduleDescr')
+- (\ _ -> errorM "leksah-server" ("Can't write extracted package " ++ destPath))
++ E.catch (writeExtractedModule destPath writeAscii moduleDescr')
++ (\ (_::IOException) -> errorM "leksah-server" ("Can't write extracted package " ++ destPath))
+ Left errMsg -> do
+ errorM "leksah-server" $ "Failed to parse " ++ sourcePath ++ " " ++ show errMsg
+ let moduleDescr = ModuleDescr {
+@@ -181,8 +197,8 @@
+ , dscMbComment' = Just (BS.pack $ show errMsg)
+ , dscTypeHint' = ErrorDescr
+ , dscExported' = False}]}
+- catch (deepseq moduleDescr $ writeExtractedModule destPath writeAscii moduleDescr)
+- (\ _ -> errorM "leksah-server" ("Can't write extracted module " ++ destPath))
++ E.catch (deepseq moduleDescr $ writeExtractedModule destPath writeAscii moduleDescr)
++ (\ (_::IOException) -> errorM "leksah-server" ("Can't write extracted module " ++ destPath))
+ ) (\ (e :: SomeException) -> errorM "leksah-server" ("Can't extract module " ++ destPath ++ " " ++ show e))
+
+
+@@ -195,22 +211,22 @@
+ -----------------------------------------------------------------------------------
+ -- Format conversion
+
+-extractModDescr :: PackageIdentifier -> ModuleName -> FilePath -> HsModule RdrName -> ModuleDescr
+-extractModDescr packId moduleName' sourcePath hsMod = ModuleDescr {
++extractModDescr :: DynFlags -> PackageIdentifier -> ModuleName -> FilePath -> HsModule RdrName -> ModuleDescr
++extractModDescr dflags packId moduleName' sourcePath hsMod = ModuleDescr {
+ mdModuleId = PM packId moduleName'
+ , mdMbSourcePath = Just sourcePath
+ , mdReferences = Map.empty -- imports
+ , mdIdDescriptions = descrs'}
+ where
+- descrs = extractDescrs (PM packId moduleName') (hsmodDecls hsMod)
+- descrs' = fixExports (hsmodExports hsMod) descrs
++ descrs = extractDescrs dflags (PM packId moduleName') (hsmodDecls hsMod)
++ descrs' = fixExports dflags (hsmodExports hsMod) descrs
+
+ -----------------------------------------------------------------------------------
+ -- Add exported hint
+
+-fixExports :: Maybe [LIE RdrName] -> [Descr] -> [Descr]
+-fixExports Nothing descrs = descrs
+-fixExports (Just iel) descrs = map (fixDescr (map unLoc iel)) descrs
++fixExports :: DynFlags -> Maybe [LIE RdrName] -> [Descr] -> [Descr]
++fixExports _ Nothing descrs = descrs
++fixExports dflags (Just iel) descrs = map (fixDescr (map unLoc iel)) descrs
+ where
+ fixDescr :: [IE RdrName] -> Descr -> Descr
+ fixDescr _ d@(Reexported _) = d
+@@ -223,18 +239,18 @@
+ Nothing -> nothingExported rd
+ Just (IEThingAll _) -> allExported rd
+ Just (IEThingAbs _) -> someExported rd []
+- Just (IEThingWith _ l) -> someExported rd (map showRdrName l)
++ Just (IEThingWith _ l) -> someExported rd (map (showRdrName dflags) l)
+ _ -> allExported rd
+ findVar = find (\ a ->
+ case a of
+- IEVar r | showRdrName r == dscName' rd -> True
++ IEVar r | showRdrName dflags r == dscName' rd -> True
+ _ -> False)
+ list
+ findThing = find (\ a ->
+ case a of
+- IEThingAbs r | showRdrName r == dscName' rd -> True
+- IEThingAll r | showRdrName r == dscName' rd -> True
+- IEThingWith r _list | showRdrName r == dscName' rd -> True
++ IEThingAbs r | showRdrName dflags r == dscName' rd -> True
++ IEThingAll r | showRdrName dflags r == dscName' rd -> True
++ IEThingWith r _list | showRdrName dflags r == dscName' rd -> True
+ _ -> False)
+ list
+ allExported rd = rd
+@@ -265,14 +281,14 @@
+ maySetExportedSD list sd = sd{sdExported = elem (sdName sd) list}
+
+
+-extractDescrs :: PackModule -> [NDecl] -> [Descr]
+-extractDescrs pm decls = transformToDescrs pm tripleWithSigs
++extractDescrs :: DynFlags -> PackModule -> [NDecl] -> [Descr]
++extractDescrs dflags pm decls = transformToDescrs dflags pm tripleWithSigs
+ where
+ sortedDecls = sortByLoc decls
+ pairedWithDocs = collectDocs sortedDecls
+ filteredDecls = filterUninteresting pairedWithDocs
+ (withoutSignatures,signatures) = partitionSignatures filteredDecls
+- tripleWithSigs = attachSignatures signatures withoutSignatures
++ tripleWithSigs = attachSignatures dflags signatures withoutSignatures
+
+ -- | Sort by source location
+ sortByLoc :: [Located a] -> [Located a]
+@@ -343,15 +359,15 @@
+ sigNameNoLoc' = maybe [] (:[]) . sigNameNoLoc
+ #endif
+
+-attachSignatures :: [(NDecl, (Maybe NDoc))] -> [(NDecl,Maybe NDoc)]
++attachSignatures :: DynFlags -> [(NDecl, (Maybe NDoc))] -> [(NDecl,Maybe NDoc)]
+ -> [(NDecl, (Maybe NDoc), [(NSig,Maybe NDoc)])]
+-attachSignatures signatures = map (attachSignature signaturesMap)
++attachSignatures dflags signatures = map (attachSignature signaturesMap)
+ where
+ signaturesMap = Map.fromListWith (++) $ concatMap sigMap signatures
+
+ sigMap (L loc (SigD sig),c) | nameList <- sigNameNoLoc' sig =
+ map (\n -> (n, [(L loc sig,c)])) nameList
+- sigMap v = error ("Unexpected location type" ++ (showSDoc . ppr) v)
++ sigMap v = error ("Unexpected location type" ++ (showSDoc dflags . ppr) v)
+
+ attachSignature :: Map RdrName [(NSig,Maybe NDoc)] -> (NDecl, (Maybe NDoc))
+ -> (NDecl, (Maybe NDoc), [(NSig,Maybe NDoc)])
+@@ -366,24 +382,72 @@
+ declName _ = Nothing
+
+
+-transformToDescrs :: PackModule -> [(NDecl, (Maybe NDoc), [(NSig, Maybe NDoc)])] -> [Descr]
+-transformToDescrs pm = concatMap transformToDescr
++transformToDescrs :: DynFlags -> PackModule -> [(NDecl, (Maybe NDoc), [(NSig, Maybe NDoc)])] -> [Descr]
++transformToDescrs dflags pm = concatMap transformToDescr
+ where
+ transformToDescr :: (NDecl, (Maybe NDoc), [(NSig, Maybe NDoc)]) -> [Descr]
+ transformToDescr ((L loc (ValD (FunBind lid _ _ _ _ _))), mbComment,sigList) =
+ [Real $ RealDescr {
+- dscName' = showRdrName (unLoc lid)
+- , dscMbTypeStr' = sigToByteString sigList
++ dscName' = showRdrName dflags (unLoc lid)
++ , dscMbTypeStr' = sigToByteString dflags sigList
+ , dscMbModu' = Just pm
+ , dscMbLocation' = srcSpanToLocation loc
+ , dscMbComment' = toComment mbComment (catMaybes (map snd sigList))
+ , dscTypeHint' = VariableDescr
+ , dscExported' = True}]
+
++#if MIN_VERSION_ghc(7,6,0)
++ transformToDescr ((L loc (TyClD typ@(ForeignType {tcdLName = lid}))), mbComment,_sigList) =
++ [Real $ RealDescr {
++ dscName' = showRdrName dflags (unLoc lid)
++ , dscMbTypeStr' = Just (BS.pack (showSDocUnqual dflags $ppr typ))
++ , dscMbModu' = Just pm
++ , dscMbLocation' = srcSpanToLocation loc
++ , dscMbComment' = toComment mbComment []
++ , dscTypeHint' = TypeDescr
++ , dscExported' = True}]
++
++ transformToDescr ((L loc (TyClD typ@(TyFamily {tcdLName = lid}))), mbComment,_sigList) =
++ [Real $ RealDescr {
++ dscName' = showRdrName dflags (unLoc lid)
++ , dscMbTypeStr' = Just (BS.pack (showSDocUnqual dflags $ppr typ))
++ , dscMbModu' = Just pm
++ , dscMbLocation' = srcSpanToLocation loc
++ , dscMbComment' = toComment mbComment []
++ , dscTypeHint' = TypeDescr
++ , dscExported' = True}]
++
++ transformToDescr ((L loc (TyClD typ@(TyDecl {tcdLName = lid, tcdTyDefn = TySynonym {}}))), mbComment,_sigList) =
++ [Real $ RealDescr {
++ dscName' = showRdrName dflags (unLoc lid)
++ , dscMbTypeStr' = Just (BS.pack (showSDocUnqual dflags $ppr typ))
++ , dscMbModu' = Just pm
++ , dscMbLocation' = srcSpanToLocation loc
++ , dscMbComment' = toComment mbComment []
++ , dscTypeHint' = TypeDescr
++ , dscExported' = True}]
++
++ transformToDescr ((L loc (TyClD typ@(TyDecl {tcdLName = lid, tcdTyDefn = TyData {td_cons=lConDecl, td_derivs=tcdDerivs'}}))), mbComment,_sigList) =
++ [Real $ RealDescr {
++ dscName' = name
++ , dscMbTypeStr' = Just (BS.pack (showSDocUnqual dflags $ppr (uncommentData typ)))
++ , dscMbModu' = Just pm
++ , dscMbLocation' = srcSpanToLocation loc
++ , dscMbComment' = toComment mbComment []
++ , dscTypeHint' = DataDescr constructors fields
++ , dscExported' = True}]
++ ++ derivings tcdDerivs'
++ where
++ constructors = map (extractConstructor dflags) lConDecl
++ fields = nub $ concatMap (extractRecordFields dflags) lConDecl
++ name = showRdrName dflags (unLoc lid)
++ derivings Nothing = []
++ derivings (Just l) = map (extractDeriving dflags pm name) l
++#else
+ transformToDescr ((L loc (TyClD typ@(TySynonym lid _ _ _ ))), mbComment,_sigList) =
+ [Real $ RealDescr {
+- dscName' = showRdrName (unLoc lid)
+- , dscMbTypeStr' = Just (BS.pack (showSDocUnqual $ppr typ))
++ dscName' = showRdrName dflags (unLoc lid)
++ , dscMbTypeStr' = Just (BS.pack (showSDocUnqual dflags $ppr typ))
+ , dscMbModu' = Just pm
+ , dscMbLocation' = srcSpanToLocation loc
+ , dscMbComment' = toComment mbComment []
+@@ -393,7 +457,7 @@
+ transformToDescr ((L loc (TyClD typ@(TyData DataType _ tcdLName' _ _ _ lConDecl tcdDerivs'))), mbComment,_sigList) =
+ [Real $ RealDescr {
+ dscName' = name
+- , dscMbTypeStr' = Just (BS.pack (showSDocUnqual $ppr (uncommentData typ)))
++ , dscMbTypeStr' = Just (BS.pack (showSDocUnqual dflags $ppr (uncommentData typ)))
+ , dscMbModu' = Just pm
+ , dscMbLocation' = srcSpanToLocation loc
+ , dscMbComment' = toComment mbComment []
+@@ -401,16 +465,16 @@
+ , dscExported' = True}]
+ ++ derivings tcdDerivs'
+ where
+- constructors = map extractConstructor lConDecl
+- fields = nub $ concatMap extractRecordFields lConDecl
+- name = showRdrName (unLoc tcdLName')
++ constructors = map (extractConstructor dflags) lConDecl
++ fields = nub $ concatMap (extractRecordFields dflags) lConDecl
++ name = showRdrName dflags (unLoc tcdLName')
+ derivings Nothing = []
+- derivings (Just l) = map (extractDeriving pm name) l
++ derivings (Just l) = map (extractDeriving dflags pm name) l
+
+ transformToDescr ((L loc (TyClD typ@(TyData NewType _ tcdLName' _ _ _ lConDecl tcdDerivs'))), mbComment,_sigList) =
+ [Real $ RealDescr {
+ dscName' = name
+- , dscMbTypeStr' = Just (BS.pack (showSDocUnqual $ppr (uncommentData typ)))
++ , dscMbTypeStr' = Just (BS.pack (showSDocUnqual dflags $ppr (uncommentData typ)))
+ , dscMbModu' = Just pm
+ , dscMbLocation' = srcSpanToLocation loc
+ , dscMbComment' = toComment mbComment []
+@@ -418,39 +482,44 @@
+ , dscExported' = True}]
+ ++ derivings tcdDerivs'
+ where
+- constructor = forceHead (map extractConstructor lConDecl)
++ constructor = forceHead (map (extractConstructor dflags) lConDecl)
+ "WorkspaceCollector>>transformToDescr: no constructor for newtype"
+- mbField = case concatMap extractRecordFields lConDecl of
++ mbField = case concatMap (extractRecordFields dflags) lConDecl of
+ [] -> Nothing
+ a:_ -> Just a
+- name = showRdrName (unLoc tcdLName')
++ name = showRdrName dflags (unLoc tcdLName')
+ derivings Nothing = []
+- derivings (Just l) = map (extractDeriving pm name) l
++ derivings (Just l) = map (extractDeriving dflags pm name) l
++#endif
+
+ transformToDescr ((L loc (TyClD cl@(ClassDecl{tcdLName=tcdLName', tcdSigs=tcdSigs', tcdDocs=docs}))), mbComment,_sigList) =
+ [Real $ RealDescr {
+- dscName' = showRdrName (unLoc tcdLName')
+- , dscMbTypeStr' = Just (BS.pack (showSDocUnqual $ppr cl{tcdMeths = emptyLHsBinds}))
++ dscName' = showRdrName dflags (unLoc tcdLName')
++ , dscMbTypeStr' = Just (BS.pack (showSDocUnqual dflags $ppr cl{tcdMeths = emptyLHsBinds}))
+ , dscMbModu' = Just pm
+ , dscMbLocation' = srcSpanToLocation loc
+ , dscMbComment' = toComment mbComment []
+ , dscTypeHint' = ClassDescr super methods
+ , dscExported' = True }]
+ where
+- methods = extractMethods tcdSigs' docs
++ methods = extractMethods dflags tcdSigs' docs
+ super = []
+
++#if MIN_VERSION_ghc(7,6,0)
++ transformToDescr ((L loc (InstD _inst@(ClsInstD typ _ _ _))), mbComment, _sigList) =
++#else
+ transformToDescr ((L loc (InstD _inst@(InstDecl typ _ _ _))), mbComment, _sigList) =
++#endif
+ [Real $ RealDescr {
+ dscName' = name
+- , dscMbTypeStr' = Just (BS.pack ("instance " ++ (showSDocUnqual $ppr typ)))
++ , dscMbTypeStr' = Just (BS.pack ("instance " ++ (showSDocUnqual dflags $ppr typ)))
+ , dscMbModu' = Just pm
+ , dscMbLocation' = srcSpanToLocation loc
+ , dscMbComment' = toComment mbComment []
+ , dscTypeHint' = InstanceDescr other
+ , dscExported' = True}]
+ where
+- (name,other) = case words (showSDocUnqual $ppr typ) of
++ (name,other) = case words (showSDocUnqual dflags $ppr typ) of
+ [] -> ("",[])
+ hd:tl -> (hd,tl)
+
+@@ -458,7 +527,12 @@
+
+
+ uncommentData :: TyClDecl a -> TyClDecl a
++#if MIN_VERSION_ghc(7,6,0)
++uncommentData td@(TyDecl {tcdTyDefn = def@(TyData{td_cons = conDecls})}) = td{
++ tcdTyDefn = def{td_cons = map uncommentDecl conDecls}}
++#else
+ uncommentData td@(TyData {tcdCons = conDecls}) = td{tcdCons = map uncommentDecl conDecls}
++#endif
+ uncommentData other = other
+
+ uncommentDecl :: LConDecl a -> LConDecl a
+@@ -489,8 +563,8 @@
+ Just d -> dscMbTypeStr d}
+ addType _ d = d
+
+-extractDeriving :: OutputableBndr alpha => PackModule -> String -> LHsType alpha -> Descr
+-extractDeriving pm name (L loc typ) =
++extractDeriving :: OutputableBndr alpha => DynFlags -> PackModule -> String -> LHsType alpha -> Descr
++extractDeriving dflags pm name (L loc typ) =
+ Real $ RealDescr {
+ dscName' = className
+ , dscMbTypeStr' = Just (BS.pack ("instance " ++ (className ++ " " ++ name)))
+@@ -500,61 +574,61 @@
+ , dscTypeHint' = InstanceDescr (words name)
+ , dscExported' = True}
+ where
+- className = showSDocUnqual $ ppr typ
++ className = showSDocUnqual dflags $ ppr typ
+
+-extractMethods :: [LSig RdrName] -> [MyLDocDecl] -> [SimpleDescr]
+-extractMethods sigs docs =
++extractMethods :: DynFlags -> [LSig RdrName] -> [MyLDocDecl] -> [SimpleDescr]
++extractMethods dflags sigs docs =
+ let pairs = attachComments sigs docs
+- in mapMaybe extractMethod pairs
++ in mapMaybe (extractMethod dflags) pairs
+
+-extractMethod :: OutputableBndr alpha => (LHsDecl alpha, Maybe (NDoc)) -> Maybe SimpleDescr
++extractMethod :: OutputableBndr alpha => DynFlags -> (LHsDecl alpha, Maybe (NDoc)) -> Maybe SimpleDescr
+ #if MIN_VERSION_ghc(7,2,0)
+-extractMethod ((L loc (SigD ts@(TypeSig [name] _typ))), mbDoc) =
++extractMethod dflags ((L loc (SigD ts@(TypeSig [name] _typ))), mbDoc) =
+ #else
+-extractMethod ((L loc (SigD ts@(TypeSig name _typ))), mbDoc) =
++extractMethod dflags ((L loc (SigD ts@(TypeSig name _typ))), mbDoc) =
+ #endif
+ Just $ SimpleDescr
+- ((showSDoc . ppr) (unLoc name))
+- (Just (BS.pack (showSDocUnqual $ ppr ts)))
++ ((showSDoc dflags . ppr) (unLoc name))
++ (Just (BS.pack (showSDocUnqual dflags $ ppr ts)))
+ (srcSpanToLocation loc)
+ (toComment mbDoc [])
+ True
+-extractMethod (_, _mbDoc) = Nothing
++extractMethod _ (_, _mbDoc) = Nothing
+
+-extractConstructor :: Located (ConDecl RdrName) -> SimpleDescr
+-extractConstructor decl@(L loc (ConDecl {con_name = name, con_doc = doc})) =
++extractConstructor :: DynFlags -> Located (ConDecl RdrName) -> SimpleDescr
++extractConstructor dflags decl@(L loc (ConDecl {con_name = name, con_doc = doc})) =
+ SimpleDescr
+- ((showSDoc . ppr) (unLoc name))
+- (Just (BS.pack (showSDocUnqual $ppr (uncommentDecl decl))))
++ ((showSDoc dflags . ppr) (unLoc name))
++ (Just (BS.pack (showSDocUnqual dflags $ppr (uncommentDecl decl))))
+ (srcSpanToLocation loc)
+ (case doc of
+ Nothing -> Nothing
+ Just (L _ d) -> Just (BS.pack (printHsDoc d)))
+ True
+
+-extractRecordFields :: Located (ConDecl RdrName) -> [SimpleDescr]
+-extractRecordFields (L _ _decl@(ConDecl {con_details = RecCon flds})) =
++extractRecordFields :: DynFlags -> Located (ConDecl RdrName) -> [SimpleDescr]
++extractRecordFields dflags (L _ _decl@(ConDecl {con_details = RecCon flds})) =
+ map extractRecordFields' flds
+ where
+ extractRecordFields' _field@(ConDeclField (L loc name) typ doc) =
+ SimpleDescr
+- ((showSDoc . ppr) name)
+- (Just (BS.pack (showSDocUnqual $ ppr typ)))
++ ((showSDoc dflags . ppr) name)
++ (Just (BS.pack (showSDocUnqual dflags $ ppr typ)))
+ (srcSpanToLocation loc)
+ (case doc of
+ Nothing -> Nothing
+ Just (L _ d) -> Just (BS.pack (printHsDoc d)))
+ True
+-extractRecordFields _ = []
++extractRecordFields _ _ = []
+
+ attachComments :: [LSig RdrName] -> [MyLDocDecl] -> [(LHsDecl RdrName, Maybe (NDoc))]
+ attachComments sigs docs = collectDocs $ sortByLoc $
+ ((map (\ (L l i) -> L l (SigD i)) sigs) ++ (map (\ (L l i) -> L l (DocD i)) docs))
+
+-sigToByteString :: [(NSig, Maybe NDoc)] -> Maybe ByteString
+-sigToByteString [] = Nothing
+-sigToByteString [(sig,_)] = Just (BS.pack (showSDocUnqual $ppr sig))
+-sigToByteString ((sig,_):_) = Just (BS.pack (showSDocUnqual $ppr sig))
++sigToByteString :: DynFlags -> [(NSig, Maybe NDoc)] -> Maybe ByteString
++sigToByteString _ [] = Nothing
++sigToByteString dflags [(sig,_)] = Just (BS.pack (showSDocUnqual dflags $ppr sig))
++sigToByteString dflags ((sig,_):_) = Just (BS.pack (showSDocUnqual dflags $ppr sig))
+
+ srcSpanToLocation :: SrcSpan -> Maybe Location
+ #if MIN_VERSION_ghc(7,2,0)
+@@ -638,16 +712,16 @@
+ M.Succeeded val -> return (Just val)
+ _ -> return Nothing
+
+-mayGetInterfaceDescription :: PackageIdentifier -> ModuleName -> Ghc (Maybe ModuleDescr)
+-mayGetInterfaceDescription pid mn = do
++mayGetInterfaceDescription :: DynFlags -> PackageIdentifier -> ModuleName -> Ghc (Maybe ModuleDescr)
++mayGetInterfaceDescription dflags pid mn = do
+ mbIf <- mayGetInterfaceFile pid mn
+ case mbIf of
+ Nothing -> do
+ liftIO $ debugM "leksah-server" ("no interface file for " ++ show mn)
+ return Nothing
+ Just (mif,_) ->
+- let allDescrs = extractExportedDescrH pid mif
+- mod' = extractExportedDescrR pid allDescrs mif
++ let allDescrs = extractExportedDescrH dflags pid mif
++ mod' = extractExportedDescrR dflags pid allDescrs mif
+ in do
+ liftIO $ debugM "leksah-server" ("interface file for " ++ show mn ++ " descrs: " ++
+ show (length (mdIdDescriptions mod')))
+Index: b/src/IDE/Utils/FileUtils.hs
+===================================================================
+--- a/src/IDE/Utils/FileUtils.hs
++++ b/src/IDE/Utils/FileUtils.hs
+@@ -80,6 +80,7 @@
+ import System.Log.Logger(errorM,warningM,debugM)
+ import IDE.Utils.Tool
+ import Control.Monad.IO.Class (MonadIO(..), MonadIO)
++import Control.Exception as E (SomeException, catch)
+
+ haskellSrcExts :: [String]
+ haskellSrcExts = ["hs","lhs","chs","hs.pp","lhs.pp","chs.pp","hsc"]
+@@ -122,12 +123,12 @@
+
+ find' :: [FilePath] -> IO (Maybe FilePath)
+ find' [] = return Nothing
+-find' (h:t) = catch (do
++find' (h:t) = E.catch (do
+ exists <- doesFileExist h
+ if exists
+ then return (Just h)
+ else find' t)
+- $ \ _ -> return Nothing
++ $ \ (_ :: SomeException) -> return Nothing
+
+ -- | The directory where config files reside
+ --
+@@ -181,7 +182,7 @@
+ return (cd </> fn)
+
+ allModules :: FilePath -> IO [ModuleName]
+-allModules filePath = catch (do
++allModules filePath = E.catch (do
+ exists <- doesDirectoryExist filePath
+ if exists
+ then do
+@@ -202,7 +203,7 @@
+ otherModules <- mapM allModules dirs
+ return (mbModuleNames ++ concat otherModules)
+ else return [])
+- $ \ _ -> return []
++ $ \ (_ :: SomeException) -> return []
+
+ allHiFiles :: FilePath -> IO [FilePath]
+ allHiFiles = allFilesWithExtensions [".hi"] True []
+@@ -214,7 +215,7 @@
+ allHaskellSourceFiles = allFilesWithExtensions [".hs",".lhs"] True []
+
+ allFilesWithExtensions :: [String] -> Bool -> [FilePath] -> FilePath -> IO [FilePath]
+-allFilesWithExtensions extensions recurseFurther collecting filePath = catch (do
++allFilesWithExtensions extensions recurseFurther collecting filePath = E.catch (do
+ exists <- doesDirectoryExist filePath
+ if exists
+ then do
+@@ -231,18 +232,18 @@
+ else return (choosenFiles ++ collecting)
+ return (allFiles)
+ else return collecting)
+- $ \ _ -> return collecting
++ $ \ (_ :: SomeException) -> return collecting
+
+
+ moduleNameFromFilePath :: FilePath -> IO (Maybe String)
+-moduleNameFromFilePath fp = catch (do
++moduleNameFromFilePath fp = E.catch (do
+ exists <- doesFileExist fp
+ if exists
+ then do
+ str <- readFile fp
+ moduleNameFromFilePath' fp str
+ else return Nothing)
+- $ \ _ -> return Nothing
++ $ \ (_ :: SomeException) -> return Nothing
+
+ moduleNameFromFilePath' :: FilePath -> String -> IO (Maybe String)
+ moduleNameFromFilePath' fp str = do
+@@ -300,24 +301,24 @@
+ <?> "midentifier"
+
+ findKnownPackages :: FilePath -> IO (Set String)
+-findKnownPackages filePath = catch (do
++findKnownPackages filePath = E.catch (do
+ paths <- getDirectoryContents filePath
+ let nameList = map dropExtension $filter (\s -> leksahMetadataSystemFileExtension `isSuffixOf` s) paths
+ return (Set.fromList nameList))
+- $ \ _ -> return (Set.empty)
++ $ \ (_ :: SomeException) -> return (Set.empty)
+
+ isEmptyDirectory :: FilePath -> IO Bool
+-isEmptyDirectory filePath = catch (do
++isEmptyDirectory filePath = E.catch (do
+ exists <- doesDirectoryExist filePath
+ if exists
+ then do
+ filesAndDirs <- getDirectoryContents filePath
+ return . null $ filter (not . ("." `isPrefixOf`) . takeFileName) filesAndDirs
+ else return False)
+- (\_ -> return False)
++ (\ (_ :: SomeException) -> return False)
+
+ cabalFileName :: FilePath -> IO (Maybe FilePath)
+-cabalFileName filePath = catch (do
++cabalFileName filePath = E.catch (do
+ exists <- doesDirectoryExist filePath
+ if exists
+ then do
+@@ -332,7 +333,7 @@
+ warningM "leksah-server" "Multiple cabal files"
+ return Nothing
+ else return Nothing)
+- (\_ -> return Nothing)
++ (\ (_ :: SomeException) -> return Nothing)
+
+ getCabalUserPackageDir :: IO (Maybe FilePath)
+ getCabalUserPackageDir = do
+@@ -355,7 +356,7 @@
+
+ autoExtractTarFiles' :: FilePath -> IO ()
+ autoExtractTarFiles' filePath =
+- catch (do
++ E.catch (do
+ exists <- doesDirectoryExist filePath
+ if exists
+ then do
+@@ -376,7 +377,7 @@
+ mapM_ autoExtractTarFiles' dirs
+ return ()
+ else return ()
+- ) $ \ _ -> return ()
++ ) $ \ (_ :: SomeException) -> return ()
+
+
+ getCollectorPath :: MonadIO m => m FilePath
+@@ -391,21 +392,21 @@
+ return filePath
+
+ getSysLibDir :: IO FilePath
+-getSysLibDir = catch (do
++getSysLibDir = E.catch (do
+ (!output,_) <- runTool' "ghc" ["--print-libdir"] Nothing
+ let libDir = toolline $ head output
+ libDir2 = if ord (last libDir) == 13
+ then List.init libDir
+ else libDir
+ return (normalise libDir2)
+- ) $ \ _ -> error ("FileUtils>>getSysLibDir failed")
++ ) $ \ (_ :: SomeException) -> error ("FileUtils>>getSysLibDir failed")
+
+ getInstalledPackageIds :: IO [PackageIdentifier]
+-getInstalledPackageIds = catch (do
++getInstalledPackageIds = E.catch (do
+ (!output, _) <- runTool' "ghc-pkg" ["list", "--simple-output"] Nothing
+ let names = toolline $ head output
+ return (catMaybes (map T.simpleParse (words names)))
+- ) $ \ _ -> error ("FileUtils>>getInstalledPackageIds failed")
++ ) $ \ (_ :: SomeException) -> error ("FileUtils>>getInstalledPackageIds failed")
+
+ figureOutHaddockOpts :: IO [String]
+ figureOutHaddockOpts = do
+Index: b/src/IDE/Utils/GHCUtils.hs
+===================================================================
+--- a/src/IDE/Utils/GHCUtils.hs
++++ b/src/IDE/Utils/GHCUtils.hs
+@@ -37,7 +37,11 @@
+ import Lexer (mkPState,ParseResult(..),getMessages,unP)
+ import Outputable (ppr)
+ #if MIN_VERSION_ghc(7,2,0)
+-import ErrUtils (dumpIfSet_dyn,printBagOfErrors,printBagOfWarnings,errorsFound,mkPlainErrMsg,showPass,ErrMsg(..))
++#if MIN_VERSION_ghc(7,6,0)
++#else
++import ErrUtils (printBagOfWarnings)
++#endif
++import ErrUtils (dumpIfSet_dyn,printBagOfErrors,errorsFound,mkPlainErrMsg,showPass,ErrMsg(..))
+ import Control.Monad (unless)
+ #else
+ import ErrUtils (dumpIfSet_dyn,printErrorsAndWarnings,mkPlainErrMsg,showPass,ErrMsg(..))
+@@ -101,7 +105,9 @@
+ getInstalledPackageInfos :: Ghc [PackageConfig]
+ getInstalledPackageInfos = do
+ dflags1 <- getSessionDynFlags
++#if !MIN_VERSION_ghc(7,6,0)
+ setSessionDynFlags $ dopt_set dflags1 Opt_ReadUserPackageConf
++#endif
+ pkgInfos <- case pkgDatabase dflags1 of
+ Nothing -> return []
+ #if MIN_VERSION_Cabal(1,8,0)
+@@ -158,14 +164,22 @@
+ case unP P.parseModule (mkPState buf' loc dflags) of {
+ #endif
+
+- PFailed span' err -> return (Left (mkPlainErrMsg span' err));
++#if MIN_VERSION_ghc(7,6,0)
++ PFailed span' err -> return (Left (mkPlainErrMsg dflags span' err));
++#else
++ PFailed span' err -> return (Left (mkPlainErrMsg span' err));
++#endif
+
+ POk pst rdr_module -> do {
+
+ #if MIN_VERSION_ghc(7,2,0)
+ let {ms@(warnings, errors) = getMessages pst};
+ printBagOfErrors dflags errors;
++#if MIN_VERSION_ghc(7,6,0)
++ unless (errorsFound dflags ms) $ printBagOfErrors dflags warnings;
++#else
+ unless (errorsFound dflags ms) $ printBagOfWarnings dflags warnings;
++#endif
+ #else
+ let {ms = getMessages pst};
+ printErrorsAndWarnings dflags ms;
+@@ -181,7 +195,7 @@
+ -- ToDo: free the string buffer later.
+ }}
+
+-myParseHeader :: FilePath -> String -> [String] -> IO (Either String (HsModule RdrName))
++myParseHeader :: FilePath -> String -> [String] -> IO (Either String (DynFlags, HsModule RdrName))
+ myParseHeader fp _str opts = inGhcIO (opts++["-cpp"]) [] $ \ _dynFlags -> do
+ session <- getSession
+ #if MIN_VERSION_ghc(7,2,0)
+@@ -193,7 +207,7 @@
+ stringBuffer <- hGetStringBuffer fp'
+ parseResult <- myParseModuleHeader dynFlags' fp (Just stringBuffer)
+ case parseResult of
+- Right (L _ mod') -> return (Right mod')
++ Right (L _ mod') -> return (Right (dynFlags', mod'))
+ Left errMsg -> do
+ let str = "Failed to parse " ++ show errMsg
+ return (Left str)
+@@ -204,9 +218,9 @@
+ myParseModuleHeader :: DynFlags -> FilePath -> Maybe StringBuffer
+ -> IO (Either ErrMsg (Located (HsModule RdrName)))
+ myParseModuleHeader dflags src_filename maybe_src_buf
+- = -------------------------- Parser ----------------
+- showPass dflags "Parser" >>
+- {-# SCC "Parser" #-} do
++ = -------------------------- Parser ----------------
++ showPass dflags "Parser" >>
++ {-# SCC "Parser" #-} do
+
+ -- sometimes we already have the buffer in memory, perhaps
+ -- because we needed to parse the imports out of it, or get the
+@@ -227,14 +241,22 @@
+ case unP P.parseHeader (mkPState buf' loc dflags) of {
+ #endif
+
+- PFailed span' err -> return (Left (mkPlainErrMsg span' err));
++#if MIN_VERSION_ghc(7,6,0)
++ PFailed span' err -> return (Left (mkPlainErrMsg dflags span' err));
++#else
++ PFailed span' err -> return (Left (mkPlainErrMsg span' err));
++#endif
+
+ POk pst rdr_module -> do {
+
+ #if MIN_VERSION_ghc(7,2,0)
+ let {ms@(warnings, errors) = getMessages pst};
+ printBagOfErrors dflags errors;
++#if MIN_VERSION_ghc(7,6,0)
++ unless (errorsFound dflags ms) $ printBagOfErrors dflags warnings;
++#else
+ unless (errorsFound dflags ms) $ printBagOfWarnings dflags warnings;
++#endif
+ #else
+ let {ms = getMessages pst};
+ printErrorsAndWarnings dflags ms;
+Index: b/src/IDE/Utils/Server.hs
+===================================================================
+--- a/src/IDE/Utils/Server.hs
++++ b/src/IDE/Utils/Server.hs
+@@ -1,4 +1,4 @@
+-{-# OPTIONS_GHC -XFlexibleInstances #-}
++{-# LANGUAGE FlexibleInstances, ScopedTypeVariables #-}
+ -----------------------------------------------------------------------------
+ --
+ -- Module : IDE.Utils.Server
+@@ -28,7 +28,7 @@
+
+ import System.IO
+ import Control.Concurrent
+-import Control.Exception hiding (catch)
++import Control.Exception as E
+
+ import Data.Word
+ import System.Log.Logger (infoM)
+@@ -97,9 +97,10 @@
+ waitFor (_, mvar) = waitFor mvar
+
+ acceptance :: Socket -> ServerRoutine -> IO ()
+-acceptance sock action = catch (do
++acceptance sock action = E.catch (do
+ dta <- accept sock
+- forkIO (action dta) >> return ()) print >>
++ forkIO (action dta) >> return ())
++ (\(e :: SomeException) -> print e) >>
+ acceptance sock action
+
+
+Index: b/src/IDE/Utils/VersionUtils.hs
+===================================================================
+--- a/src/IDE/Utils/VersionUtils.hs
++++ b/src/IDE/Utils/VersionUtils.hs
+@@ -22,9 +22,10 @@
+ import Data.Char (ord)
+ import qualified Data.List as List (init)
+ import System.Log.Logger (debugM)
++import Control.Exception as E (SomeException, catch)
+
+ getGhcVersion :: IO FilePath
+-getGhcVersion = catch (do
++getGhcVersion = E.catch (do
+ (!output,_) <- runTool' "ghc" ["--numeric-version"] Nothing
+ let vers = toolline $ head output
+ vers2 = if ord (last vers) == 13
+@@ -32,17 +33,17 @@
+ else vers
+ debugM "leksah-server" $ "Got GHC Version " ++ vers2
+ return vers2
+- ) $ \ _ -> error ("FileUtils>>getGhcVersion failed")
++ ) $ \ (_ :: SomeException) -> error ("FileUtils>>getGhcVersion failed")
+
+ getHaddockVersion :: IO String
+-getHaddockVersion = catch (do
++getHaddockVersion = E.catch (do
+ (!output,_) <- runTool' "haddock" ["--version"] Nothing
+ let vers = toolline $ head output
+ vers2 = if ord (last vers) == 13
+ then List.init vers
+ else vers
+ return vers2
+- ) $ \ _ -> error ("FileUtils>>getHaddockVersion failed")
++ ) $ \ (_ :: SomeException) -> error ("FileUtils>>getHaddockVersion failed")
generated by cgit v1.2.3 (git 2.46.0) at 2025-12-04 20:39:53 +0000