ghc-mod 3.1.5 → 3.1.6

raw patch · 11 files changed

+125/−28 lines, 11 files

Files

• ChangeLog +5/−0
• Language/Haskell/GhcMod/Browse.hs +10/−9
• Language/Haskell/GhcMod/CabalApi.hs +13/−5
• Language/Haskell/GhcMod/Cradle.hs +44/−1
• Language/Haskell/GhcMod/Debug.hs +1/−1
• Language/Haskell/GhcMod/Doc.hs +6/−6
• Language/Haskell/GhcMod/Gap.hs +38/−2
• Language/Haskell/GhcMod/Types.hs +5/−1
• ghc-mod.cabal +1/−1
• test/CabalApiSpec.hs +1/−1
• test/DebugSpec.hs +1/−1

@@ -1,3 +1,8 @@+2014-02-07 v3.1.6+	* Testing with multi GHC versions. (@eagletmt)+	* Checking package ID. (@naota)+	* Supporting GHC 7.8.1 RC1. (@bartavelle)+ 2014-01-14 v3.1.5 	* Catching up to GHC 7.7. (@scottgw) 	* Testing with multi GHC versions. (@eagletmt)

@@ -5,18 +5,17 @@ import Data.Char import Data.List import Data.Maybe (catMaybes)-import DataCon (dataConRepType) import FastString (mkFastString) import GHC-import Panic(throwGhcException) import Language.Haskell.GhcMod.Doc (showUnqualifiedPage) import Language.Haskell.GhcMod.GHCApi+import Language.Haskell.GhcMod.Gap import Language.Haskell.GhcMod.Types import Name import Outputable+import Panic (throwGhcException) import TyCon import Type-import Var  ---------------------------------------------------------------- @@ -92,15 +91,17 @@     justIf _ False = Nothing  showThing :: DynFlags -> TyThing -> Maybe String-showThing dflag (AnId i)     = Just $ formatType dflag varType i-showThing dflag (ADataCon d) = Just $ formatType dflag dataConRepType d-showThing _     (ATyCon t)   = unwords . toList <$> tyType t+showThing dflag tything = showThing' dflag (fromTyThing tything)++showThing' :: DynFlags -> GapThing -> Maybe String+showThing' dflag (GtA a) = Just $ formatType dflag a+showThing' _     (GtT t) = unwords . toList <$> tyType t   where     toList t' = t' : getOccString t : map getOccString (tyConTyVars t)-showThing _     _            = Nothing+showThing' _     _       = Nothing -formatType :: NamedThing a => DynFlags -> (a -> Type) -> a -> String-formatType dflag f x = showOutputable dflag (removeForAlls $ f x)+formatType :: DynFlags -> Type -> String+formatType dflag a = showOutputable dflag (removeForAlls a)  tyType :: TyCon -> Maybe String tyType typ

@@ -44,26 +44,34 @@     wdir       = cradleCurrentDir cradle     Just cdir  = cradleCabalDir   cradle     Just cfile = cradleCabalFile  cradle+    pkgs       = cradlePackages   cradle     buildInfos = cabalAllBuildInfo pkgDesc     idirs      = includeDirectories cdir wdir $ cabalSourceDirs buildInfos-    depPkgs    = removeThem problematicPackages $ removeMe cfile $ cabalDependPackages buildInfos+    depPkgs    = attachPackageIds pkgs $ removeThem problematicPackages $ removeMe cfile $ cabalDependPackages buildInfos  ---------------------------------------------------------------- -- Dependent packages -removeMe :: FilePath -> [Package] -> [Package]+removeMe :: FilePath -> [PackageBaseName] -> [PackageBaseName] removeMe cabalfile = filter (/= me)   where     me = dropExtension $ takeFileName cabalfile -removeThem :: [Package] -> [Package] -> [Package]+removeThem :: [PackageBaseName] -> [PackageBaseName] -> [PackageBaseName] removeThem badpkgs = filter (`notElem` badpkgs) -problematicPackages :: [Package]+problematicPackages :: [PackageBaseName] problematicPackages = [     "base-compat" -- providing "Prelude"   ] +attachPackageIds :: [Package] -> [PackageBaseName] -> [Package]+attachPackageIds pkgs = map attachId+  where+    attachId x = case lookup x pkgs of+      Nothing -> (x, Nothing)+      Just p -> (x, p)+ ---------------------------------------------------------------- -- Include directories for modules @@ -138,7 +146,7 @@ ----------------------------------------------------------------  -- | Extracting package names of dependency.-cabalDependPackages :: [BuildInfo] -> [Package]+cabalDependPackages :: [BuildInfo] -> [PackageBaseName] cabalDependPackages bis = uniqueAndSort $ pkgs   where     pkgs = map getDependencyPackageName $ concatMap targetBuildDepends bis

@@ -4,6 +4,7 @@     findCradle   , findCradleWithoutSandbox   , getPackageDbDir+  , getPackageDbPackages   ) where  import Data.Char (isSpace)@@ -32,6 +33,7 @@       , cradleCabalDir      = Nothing       , cradleCabalFile     = Nothing       , cradlePackageDbOpts = []+      , cradlePackages      = []       }  findCradle' :: FilePath -> IO Cradle@@ -43,13 +45,14 @@       , cradleCabalDir      = Just cdir       , cradleCabalFile     = Just cfile       , cradlePackageDbOpts = pkgDbOpts+      , cradlePackages      = []       }  -- Just for testing findCradleWithoutSandbox :: IO Cradle findCradleWithoutSandbox = do     cradle <- findCradle-    return cradle { cradlePackageDbOpts = [] }+    return cradle { cradlePackageDbOpts = [], cradlePackages = [] }  ---------------------------------------------------------------- @@ -139,3 +142,43 @@     (verStr1,_:left) = break (== '.') $ findVer file     (verStr2,_)      = break (== '.') left     ver = read verStr1 * 100 + read verStr2++-- | Obtaining packages installed in a package db directory.+getPackageDbPackages :: FilePath -> IO [Package]+getPackageDbPackages cdir = (getPkgDb >>= listDbPackages) `E.catch` handler+  where+    getPkgDb = getPackageDbDir (cdir </> configFile)+    handler :: SomeException -> IO [Package]+    handler _ = return []++listDbPackages :: FilePath -> IO [Package]+listDbPackages pkgdir = do+  files <- filter (".conf" `isSuffixOf`) <$> getDirectoryContents pkgdir+  mapM extractPackage $ map (pkgdir </>) files++extractPackage :: FilePath -> IO Package+extractPackage pconf = do+  contents <- lines <$> readFile pconf+  -- Be strict to ensure that an error can be caught.+  let !name = extractName $ parseName contents+      !pid = extractId $ parseId contents+  return (name, Just pid)+  where+    parseName = parse nameKey+    extractName = extract nameKeyLength+    parseId = parse idKey+    extractId = extract idKeyLength+    parse key = head . filter (key `isPrefixOf`)+    extract keylen = fst . break isSpace . dropWhile isSpace . drop keylen++nameKey :: String+nameKey = "name:"++idKey :: String+idKey = "id:"++nameKeyLength :: Int+nameKeyLength = length nameKey++idKeyLength :: Int+idKeyLength = length idKey

@@ -41,7 +41,7 @@       , "Cabal file:          " ++ cabalFile       , "GHC options:         " ++ unwords gopts       , "Include directories: " ++ unwords incDir-      , "Dependent packages:  " ++ intercalate ", " pkgs+      , "Dependent packages:  " ++ (intercalate ", " $ map fst pkgs)       , "Fast check:          " ++ if fast then "Yes" else "No"       ]   where

@@ -1,9 +1,9 @@ module Language.Haskell.GhcMod.Doc where  import DynFlags (DynFlags)-import Language.Haskell.GhcMod.Gap (withStyle)+import Language.Haskell.GhcMod.Gap (withStyle, showDocWith) import Outputable-import Pretty+import Pretty (Mode(..))  ---------------------------------------------------------------- @@ -27,17 +27,17 @@  -- For "ghc-mod type" showQualifiedPage :: DynFlags -> SDoc -> String-showQualifiedPage dflag = showDocWith PageMode . withStyle dflag styleQualified+showQualifiedPage dflag = showDocWith dflag PageMode . withStyle dflag styleQualified  -- For "ghc-mod browse" and show GHC's error messages. showUnqualifiedPage :: DynFlags -> SDoc -> String-showUnqualifiedPage dflag = Pretty.showDocWith Pretty.PageMode+showUnqualifiedPage dflag = showDocWith dflag PageMode                           . withStyle dflag styleUnqualified  -- Not used showQualifiedOneLine :: DynFlags -> SDoc -> String-showQualifiedOneLine dflag = showDocWith OneLineMode . withStyle dflag styleQualified+showQualifiedOneLine dflag = showDocWith dflag OneLineMode . withStyle dflag styleQualified  -- To write Haskell code in a buffer showUnqualifiedOneLine :: DynFlags -> SDoc -> String-showUnqualifiedOneLine dflag = showDocWith OneLineMode . withStyle dflag styleUnqualified+showUnqualifiedOneLine dflag = showDocWith dflag OneLineMode . withStyle dflag styleUnqualified

@@ -26,13 +26,18 @@ #else   , module Pretty #endif+  , showDocWith+  , GapThing(..)+  , fromTyThing   ) where  import Control.Applicative hiding (empty) import Control.Monad+import CoreSyn import Data.List import Data.Maybe import Data.Time.Clock+import DataCon (dataConRepType) import Desugar (deSugarExpr) import DynFlags import ErrUtils@@ -45,13 +50,15 @@ import PprTyThing import StringBuffer import TcType-import CoreSyn+import Var (varType)  import qualified InstEnv import qualified Pretty import qualified StringBuffer as SB #if __GLASGOW_HASKELL__ >= 707 import FamInstEnv+import ConLike (ConLike(..))+import PatSyn (patSynType) #else import TcRnTypes #endif@@ -110,6 +117,15 @@     df { log_action = f df } #endif +showDocWith :: DynFlags -> Pretty.Mode -> Pretty.Doc -> String+#if __GLASGOW_HASKELL__ >= 707+-- Pretty.showDocWith disappeard.+-- https://github.com/ghc/ghc/commit/08a3536e4246e323fbcd8040e0b80001950fe9bc+showDocWith dflags mode = Pretty.showDoc mode (pprCols dflags)+#else+showDocWith _ = Pretty.showDocWith+#endif+ ---------------------------------------------------------------- ---------------------------------------------------------------- @@ -161,6 +177,8 @@         ++ [option | (option,_,_) <- fLangFlags] #elif __GLASGOW_HASKELL__ == 702 fOptions = [option | (option,_,_,_) <- fFlags]+        ++ [option | (option,_,_,_) <- fWarningFlags]+        ++ [option | (option,_,_,_) <- fLangFlags] #else fOptions = [option | (option,_,_) <- fFlags] #endif@@ -222,8 +240,10 @@     df' = dopt_set df Opt_HideAllPackages #endif     df'' = df' {-        packageFlags = map ExposePackage pkgs ++ packageFlags df+        packageFlags = map expose pkgs ++ packageFlags df       }+    expose (pkg, Nothing) = ExposePackage pkg+    expose (_, Just pid) = ExposePackageId pid  ---------------------------------------------------------------- ----------------------------------------------------------------@@ -315,3 +335,19 @@     rn_env = tcg_rdr_env tcgEnv     ty_env = tcg_type_env tcgEnv #endif++----------------------------------------------------------------+----------------------------------------------------------------++data GapThing = GtA Type | GtT TyCon | GtN++fromTyThing :: TyThing -> GapThing+fromTyThing (AnId i)                   = GtA $ varType i+#if __GLASGOW_HASKELL__ >= 707+fromTyThing (AConLike (RealDataCon d)) = GtA $ dataConRepType d+fromTyThing (AConLike (PatSynCon p))   = GtA $ patSynType p+#else+fromTyThing (ADataCon d)               = GtA $ dataConRepType d+#endif+fromTyThing (ATyCon t)                 = GtT t+fromTyThing _                          = GtN

@@ -90,6 +90,7 @@   , cradleCabalFile   :: Maybe FilePath   -- | The package db options. ([\"-no-user-package-db\",\"-package-db\",\"\/foo\/bar\/i386-osx-ghc-7.6.3-packages.conf.d\"])   , cradlePackageDbOpts :: [GHCOption]+  , cradlePackages :: [Package]   } deriving (Eq, Show)  ----------------------------------------------------------------@@ -101,7 +102,10 @@ type IncludeDir = FilePath  -- | A package name.-type Package    = String+type PackageBaseName = String++-- | A package name and its ID.+type Package    = (PackageBaseName, Maybe String)  -- | Haskell expression. type Expression = String

@@ -1,5 +1,5 @@ Name:                   ghc-mod-Version:                3.1.5+Version:                3.1.6 Author:                 Kazu Yamamoto <kazu@iij.ad.jp> Maintainer:             Kazu Yamamoto <kazu@iij.ad.jp> License:                BSD3

@@ -28,7 +28,7 @@                         ghcOptions  = ghcOptions res                       , includeDirs = map (toRelativeDir dir) (includeDirs res)                       }-                res' `shouldBe` CompilerOptions {ghcOptions = ["-no-user-package-db","-package-db","/home/me/work/ghc-mod/test/data/.cabal-sandbox/i386-osx-ghc-7.6.3-packages.conf.d","-XHaskell98"], includeDirs = ["test/data","test/data/dist/build","test/data/dist/build/autogen","test/data/subdir1/subdir2","test/data/test"], depPackages = ["Cabal","base","template-haskell"]}+                res' `shouldBe` CompilerOptions {ghcOptions = ["-no-user-package-db","-package-db","/home/me/work/ghc-mod/test/data/.cabal-sandbox/i386-osx-ghc-7.6.3-packages.conf.d","-XHaskell98"], includeDirs = ["test/data","test/data/dist/build","test/data/dist/build/autogen","test/data/subdir1/subdir2","test/data/test"], depPackages = [("Cabal", Nothing), ("base", Nothing) , ("template-haskell", Nothing)]}      describe "cabalDependPackages" $ do         it "extracts dependent packages" $ do

@@ -7,7 +7,7 @@  checkFast :: String -> String -> IO () checkFast file ans = withDirectory_ "test/data" $ do-    let cradle = Cradle "." Nothing Nothing []+    let cradle = Cradle "." Nothing Nothing [] []     res <- debugInfo defaultOptions cradle file     lines res `shouldContain` [ans]