diff --git a/hdevtools.cabal b/hdevtools.cabal --- a/hdevtools.cabal +++ b/hdevtools.cabal @@ -1,5 +1,5 @@ name: hdevtools -version: 0.1.0.6 +version: 0.1.0.7 synopsis: Persistent GHC powered background server for FAST haskell development tools description: 'hdevtools' is a backend for text editor plugins, to allow for things such as @@ -33,14 +33,14 @@ maintainer: schell.scivally@synapsegroup.com copyright: See AUTHORS file category: Development -homepage: https://github.com/bitc/hdevtools/ -bug-reports: https://github.com/bitc/hdevtools/issues/ +homepage: https://github.com/schell/hdevtools/ +bug-reports: https://github.com/schell/hdevtools/issues/ build-type: Simple cabal-version: >=1.8 source-repository head type: git - location: git://github.com/bitc/hdevtools.git + location: git://github.com/schell/hdevtools.git executable hdevtools hs-source-dirs: src @@ -58,6 +58,7 @@ Types, Util, Paths_hdevtools + build-depends: base == 4.*, cmdargs, directory, @@ -75,4 +76,8 @@ if impl(ghc >= 7.7) build-depends: Cabal >= 1.18 + cpp-options: -DENABLE_CABAL + + if impl(ghc >= 7.9) + build-depends: Cabal >= 1.22 cpp-options: -DENABLE_CABAL diff --git a/src/Cabal.hs b/src/Cabal.hs --- a/src/Cabal.hs +++ b/src/Cabal.hs @@ -27,6 +27,10 @@ import Distribution.Simple.Program.Types (ConfiguredProgram(programVersion), simpleProgram) import Distribution.Simple.Program.GHC (GhcOptions(..), renderGhcOptions) import Distribution.Simple.Setup (ConfigFlags(..), defaultConfigFlags, toFlag) +#if __GLASGOW_HASKELL__ >= 709 +import Distribution.Utils.NubList +import qualified Distribution.Simple.GHC as GHC(configure) +#endif import Distribution.Verbosity (silent) import Distribution.Version (Version(..)) @@ -126,14 +130,24 @@ let mbLibName = pkgLibName pkgDescr let ghcOpts' = foldl' mappend mempty $ map (getComponentGhcOptions localBuildInfo) $ flip allComponentsBy (\c -> c) . localPkgDescr $ localBuildInfo +#if __GLASGOW_HASKELL__ >= 709 -- FIX bug in GhcOptions' `mappend` - ghcOpts = ghcOpts' { ghcOptExtra = filter (/= "-Werror") $ nub $ ghcOptExtra ghcOpts' + ghcOpts = ghcOpts' { ghcOptExtra = overNubListR (filter (/= "-Werror")) $ ghcOptExtra ghcOpts' , ghcOptPackageDBs = sort $ nub (ghcOptPackageDBs ghcOpts') + , ghcOptPackages = overNubListR (filter (\(_, pkgId, _) -> Just (pkgName pkgId) /= mbLibName)) $ (ghcOptPackages ghcOpts') + , ghcOptSourcePath = overNubListR (map (baseDir )) (ghcOptSourcePath ghcOpts') + } + + (ghcInfo,_,_) <- GHC.configure silent (Just path) Nothing defaultProgramConfiguration + + return $ Right $ renderGhcOptions ghcInfo ghcOpts +#else + ghcOpts = ghcOpts' { ghcOptExtra = filter (/= "-Werror") $ nub $ ghcOptExtra ghcOpts' , ghcOptPackages = filter (\(_, pkgId) -> Just (pkgName pkgId) /= mbLibName) $ nub (ghcOptPackages ghcOpts') , ghcOptSourcePath = map (baseDir ) (ghcOptSourcePath ghcOpts') } - return $ Right $ renderGhcOptions ghcVersion ghcOpts +#endif pkgLibName :: PackageDescription -> Maybe PackageName pkgLibName pkgDescr = if hasLibrary pkgDescr diff --git a/src/Info.hs b/src/Info.hs --- a/src/Info.hs +++ b/src/Info.hs @@ -18,6 +18,8 @@ #endif #if __GLASGOW_HASKELL__ >= 708 import qualified HsExpr +#else +import qualified TcRnTypes #endif import qualified GHC import qualified HscTypes @@ -26,7 +28,6 @@ import qualified PprTyThing import qualified Pretty import qualified TcHsSyn -import qualified TcRnTypes getIdentifierInfo :: FilePath -> String -> GHC.Ghc (Either String String) getIdentifierInfo file identifier = @@ -131,29 +132,31 @@ getTypeLHsBind :: GHC.TypecheckedModule -> GHC.LHsBind GHC.Id -> GHC.Ghc (Maybe (GHC.SrcSpan, GHC.Type)) #if __GLASGOW_HASKELL__ >= 708 -getTypeLHsBind _ (GHC.L spn GHC.FunBind{GHC.fun_matches = HsExpr.MG _ _ typ _}) = return $ Just (spn, typ) +getTypeLHsBind _ (GHC.L spn GHC.FunBind{GHC.fun_matches = grp}) = return $ Just (spn, HsExpr.mg_res_ty grp) #else getTypeLHsBind _ (GHC.L spn GHC.FunBind{GHC.fun_matches = GHC.MatchGroup _ typ}) = return $ Just (spn, typ) #endif getTypeLHsBind _ _ = return Nothing getTypeLHsExpr :: GHC.TypecheckedModule -> GHC.LHsExpr GHC.Id -> GHC.Ghc (Maybe (GHC.SrcSpan, GHC.Type)) +#if __GLASGOW_HASKELL__ >= 708 +getTypeLHsExpr _ e = do +#else getTypeLHsExpr tcm e = do +#endif hs_env <- GHC.getSession #if __GLASGOW_HASKELL__ >= 708 - let fm_inst_env = TcRnTypes.tcg_fam_inst_env $ fst $ GHC.tm_internals_ tcm (_, mbe) <- liftIO $ Desugar.deSugarExpr hs_env e #else + let modu = GHC.ms_mod $ GHC.pm_mod_summary $ GHC.tm_parsed_module tcm + rn_env = TcRnTypes.tcg_rdr_env $ fst $ GHC.tm_internals_ tcm + ty_env = TcRnTypes.tcg_type_env $ fst $ GHC.tm_internals_ tcm (_, mbe) <- liftIO $ Desugar.deSugarExpr hs_env modu rn_env ty_env e #endif return () case mbe of Nothing -> return Nothing Just expr -> return $ Just (GHC.getLoc e, CoreUtils.exprType expr) - where - modu = GHC.ms_mod $ GHC.pm_mod_summary $ GHC.tm_parsed_module tcm - rn_env = TcRnTypes.tcg_rdr_env $ fst $ GHC.tm_internals_ tcm - ty_env = TcRnTypes.tcg_type_env $ fst $ GHC.tm_internals_ tcm getTypeLPat :: GHC.TypecheckedModule -> GHC.LPat GHC.Id -> GHC.Ghc (Maybe (GHC.SrcSpan, GHC.Type)) getTypeLPat _ (GHC.L spn pat) = return $ Just (spn, TcHsSyn.hsPatType pat) @@ -208,7 +211,11 @@ | (const False `extQ` postTcType `extQ` fixity `extQ` nameSet) x = z | otherwise = foldl k (f x) (gmapQ (everythingStaged stage k z f) x) where nameSet = const (stage `elem` [Parser,TypeChecker]) :: NameSet.NameSet -> Bool +#if __GLASGOW_HASKELL__ >= 709 + postTcType = const (stage Bool +#else postTcType = const (stage Bool +#endif fixity = const (stage Bool ------------------------------------------------------------------------------