debian/0000755000000000000000000000000012154332773007175 5ustar debian/watch0000644000000000000000000000034612036250614010221 0ustar version=3 opts="downloadurlmangle=s|archive/([\w\d_-]+)/([\d\.]+)/|archive/$1/$2/$1-$2.tar.gz|,\ filenamemangle=s|(.*)/$|leksah-server-$1.tar.gz|" \ http://hackage.haskell.org/packages/archive/leksah-server \ ([\d\.]*\d)/ debian/README.source0000644000000000000000000000076712036250613011355 0ustar leksah needs a modified process library. To avoid packaging it for Debian individually, we bundle it in this source package. pkg-haskell-checkout does not handle that (because uscan does not). To build this package, please run: wget http://hackage.haskell.org/packages/archive/process-leksah/1.0.1.3/process-leksah-1.0.1.3.tar.gz -O ../haskell-leksah-server_0.8.0.6.orig-process-leksah.tar.gz tar xzf ../haskell-leksah-server_0.8.0.6.orig-process-leksah.tar.gz mv process-leksah-1.0.1.3 process-leksah debian/rules0000755000000000000000000000044412036250614010247 0ustar #!/usr/bin/make -f DEB_BUILD_DEPENDENCIES = build-arch include /usr/share/cdbs/1/rules/debhelper.mk include /usr/share/cdbs/1/class/hlibrary.mk # If no threaded RTS is found, disable it DEB_SETUP_GHC_CONFIGURE_ARGS := $(shell test -e /usr/lib/ghc/libHSrts_thr.a || echo --flags=-threaded) debian/leksah-server.install0000644000000000000000000000014212036250613013324 0ustar dist-ghc/build/leksah-server/leksah-server /usr/bin dist-ghc/build/leksahecho/leksahecho /usr/bin debian/copyright0000644000000000000000000000471012036250613011121 0ustar Format-Specification: http://svn.debian.org/wsvn/dep/web/deps/dep5.mdwn?op=file&rev=135 Name: haskell-leksah-server Maintainer: Jürgen Nicklisch-Franken Source: http://hackage.haskell.org/package/binary-shared Copyright: 2007-2010, Juergen "jutaro" Nicklisch-Franken 2007-2010, Hamish Mackenzie License: GPL-2 This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. . On Debian GNU/Linux systems, the complete text of the GNU General Public License can be found in `/usr/share/common-licenses/GPL-2' Files: process-leksah/* Copyright: 2004-2008 The University of Glasgow 2002 Simon Peyton Jones License: The Glasgow Haskell Compiler License Copyright 2002-2009, The University Court of the University of Glasgow. All rights reserved. . Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: . * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. . * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. . * Neither name of the University nor the names of its contributors may be used to endorse or promote products derived from this software without specific prior written permission. . THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW AND THE CONTRIBUTORS ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. debian/source/0000755000000000000000000000000012036250614010465 5ustar debian/source/format0000644000000000000000000000001412036250614011673 0ustar 3.0 (quilt) debian/patches/0000755000000000000000000000000012145674706010631 5ustar debian/patches/series0000644000000000000000000000003412145674706012043 0ustar ghc-7.6-compatibility.patch debian/patches/ghc-7.6-compatibility.patch0000644000000000000000000025110712145674706015600 0ustar From dc892c956ce07b3386778fc1fe7597adb9f8505b Mon Sep 17 00:00:00 2001 From: Hamish Mackenzie 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") debian/compat0000644000000000000000000000000212147616242010371 0ustar 9 debian/control0000644000000000000000000000560212150230141010561 0ustar Source: haskell-leksah-server Section: haskell Priority: extra Maintainer: Debian Haskell Group Uploaders: Joachim Breitner Build-Depends: debhelper (>= 9) , cdbs , haskell-devscripts (>= 0.8.15) , ghc , libghc-binary-shared-dev (>= 0.8) , libghc-binary-shared-dev (<< 0.9) , libghc-binary-shared-prof , libghc-ltk-dev (>= 0.12.1.0) , libghc-ltk-dev (<< 0.13) , libghc-parsec3-dev (<< 3.2) , libghc-hslogger-dev (>= 1.0.7) , libghc-hslogger-dev (<< 1.3) , libghc-network-dev (>= 2.2) , libghc-network-dev (<< 3) , libghc-enumerator-dev (>= 0.4.14) , libghc-enumerator-dev (<< 0.5) , libghc-attoparsec-enumerator-dev (>= 0.3) , libghc-attoparsec-enumerator-dev (<< 0.4) , libghc-attoparsec-dev (>= 0.10.0.3) , libghc-attoparsec-dev (<< 0.11) , libghc-transformers-dev (>= 0.2.2.0) , libghc-transformers-dev (<< 0.4) , libghc-strict-dev (>= 0.3.2) , libghc-strict-dev (<< 0.4) , libghc-haddock-dev (>= 2.7.2) , libghc-haddock-dev (<< 2.14) , dpkg (>= 1.14.27) Build-Depends-Indep: ghc-doc , libghc-binary-shared-doc , libghc-ltk-doc , libghc-parsec3-doc , libghc-deepseq-doc , libghc-network-doc , libghc-haddock-doc , libghc-enumerator-doc , libghc-attoparsec-doc , libghc-attoparsec-enumerator-doc , libghc-transformers-doc , libghc-hslogger-doc , libghc-strict-doc Standards-Version: 3.9.4 Homepage: http://hackage.haskell.org/package/leksah-server Vcs-Darcs: http://darcs.debian.org/pkg-haskell/haskell-leksah-server Vcs-Browser: http://darcs.debian.org/cgi-bin/darcsweb.cgi?r=pkg-haskell/haskell-leksah-server Package: leksah-server Architecture: any Depends: ${misc:Depends}, ${shlibs:Depends} Description: haskell editor - GHC interface Leksah is an Haskell IDE. It is written in Haskell and provides a graphical interface based on Gtk. Leksah is a practical tool to support the Haskell development process. . The leksah-server package contains the background daemon interfacing with the GHC compiler and usually is not started on its own. Package: libghc-leksah-server-dev Architecture: any Depends: ${haskell:Depends} , ${shlibs:Depends} , ${misc:Depends} Recommends: ${haskell:Recommends} Suggests: ${haskell:Suggests} Provides: ${haskell:Provides} Description: haskell editor - GHC interface library${haskell:ShortBlurb} The library is used by the leksah package to interface with the leksah server. It is not required to use leksah, only to build it. . ${haskell:Blurb} Package: libghc-leksah-server-doc Section: doc Architecture: all Depends: ${misc:Depends}, ${haskell:Depends} Recommends: ${haskell:Recommends} Suggests: ${haskell:Suggests} Description: haskell editor - GHC interface library${haskell:ShortBlurb} The library is used by the leksah package to interface with the leksah server. It is not required to use leksah, only to build it. . ${haskell:Blurb} debian/changelog0000644000000000000000000000643612154332773011060 0ustar haskell-leksah-server (0.12.1.2-3build2) saucy; urgency=low * Rebuild for new GHC ABIs. -- Colin Watson Fri, 07 Jun 2013 11:29:15 +0100 haskell-leksah-server (0.12.1.2-3build1) saucy; urgency=low * Rebuild for new GHC ABIs. -- Colin Watson Fri, 31 May 2013 00:17:48 +0100 haskell-leksah-server (0.12.1.2-3) unstable; urgency=low * Move Haskell blurb to the end of the description, reduces the impact of #708703 -- Joachim Breitner Sat, 25 May 2013 23:52:27 +0200 haskell-leksah-server (0.12.1.2-2) unstable; urgency=low [ Iain Lane ] * Lower haskell-binary-shared requirement to >= 0.8, per the Cabal file [ Joachim Breitner ] * Enable compat level 9 * Use substvars for Haskell description blurbs -- Joachim Breitner Fri, 24 May 2013 12:51:16 +0200 haskell-leksah-server (0.12.1.2-1) experimental; urgency=low [ Joachim Breitner ] * Depend on haskell-devscripts 0.8.13 to ensure this packages is built against experimental * Bump standards version, no change * New upstream release [ Iain Lane ] * Backport upstream patch to fix build with GHC 7.6 and bump BDs accordingly * Remove bump-transformers-dependency patch which is no longer necessary given the above. -- Iain Lane Sat, 13 Apr 2013 22:25:52 +0100 haskell-leksah-server (0.12.0.4-3) unstable; urgency=low * More consequently bump transformers dependency -- Joachim Breitner Sat, 26 May 2012 19:35:54 +0200 haskell-leksah-server (0.12.0.4-2) unstable; urgency=low * Bump transformers dependency -- Joachim Breitner Sat, 19 May 2012 19:26:17 +0200 haskell-leksah-server (0.12.0.4-1) unstable; urgency=low * New upstream release * patches/use_bundled_leksah-process.patch: dropped, current process provided by GHC is new enough -- Joachim Breitner Tue, 13 Mar 2012 14:24:43 +0100 haskell-leksah-server (0.10.0.4-2) unstable; urgency=low * Fix detection of threaded runtime in debian/rules (Closes: #637940) -- Joachim Breitner Sun, 28 Aug 2011 18:58:03 +0200 haskell-leksah-server (0.10.0.4-1) unstable; urgency=low [ Marco Silva ] * Use ghc instead of ghc6 [ Joachim Breitner ] * New upstream release * threaded_flag.cabal: Removed, applied upstream -- Joachim Breitner Fri, 27 May 2011 20:44:12 +0200 haskell-leksah-server (0.8.0.6-3) unstable; urgency=low * Fix "haskell-leksah-server - FTBFS: cannot find -lHSrts_thr" by also consider the flag when building leksahecho. (Closes: #594070) -- Marco Túlio Gontijo e Silva Mon, 23 Aug 2010 10:42:31 -0300 haskell-leksah-server (0.8.0.6-2) unstable; urgency=low * Fix "FTBFS [!x86]: /usr/bin/ld: cannot find -lHSrts_thr" by creating the threaded flag. Thanks for Hamish Mackenzie for the patch in upstream. (Closes: #592822) -- Marco Túlio Gontijo e Silva Mon, 23 Aug 2010 08:25:31 -0300 haskell-leksah-server (0.8.0.6-1) unstable; urgency=low * Initial release. (Closes: #574693) * Bundle leksah-process in this source package -- Joachim Breitner Thu, 24 Jun 2010 09:12:02 +0200