hasufell/ghc-mod
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Extend Package to include id

Browse Source 
This commit
1. rename Package with PackageBaseName
2. Pacakge = (PackageBaseName, Maybe String) to save its id
3. Expose packages with id if available
This commit is contained in:
Naohiro Aota 2014-01-30 20:42:25 +09:00
parent 7c6fbb2af1
commit a0db24b0a5
8 changed files with 31 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
Language/Haskell/GhcMod/CabalApi.hs
View File

@ -44,26 +44,34 @@ getCompilerOptions ghcopts cradle pkgDesc = do
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 @@ cabalAllBuildInfo pd = libBI ++ execBI ++ testBI ++ benchBI
----------------------------------------------------------------
-- | Extracting package names of dependency.
cabalDependPackages :: [BuildInfo] -> [Package]
cabalDependPackages :: [BuildInfo] -> [PackageBaseName]
cabalDependPackages bis = uniqueAndSort $ pkgs
where
pkgs = map getDependencyPackageName $ concatMap targetBuildDepends bis

4
Language/Haskell/GhcMod/Cradle.hs
View File

@ -32,6 +32,7 @@ findCradle = do
, cradleCabalDir = Nothing
, cradleCabalFile = Nothing
, cradlePackageDbOpts = []
, cradlePackages = []
}
findCradle' :: FilePath -> IO Cradle
@ -43,13 +44,14 @@ findCradle' wdir = do
, 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 = [] }
----------------------------------------------------------------

2
Language/Haskell/GhcMod/Debug.hs
View File

@ -41,7 +41,7 @@ debug opt cradle fileName = do
, "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

4
Language/Haskell/GhcMod/Gap.hs
View File

@ -234,8 +234,10 @@ addDevPkgs df pkgs = df''
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
----------------------------------------------------------------
----------------------------------------------------------------

6
Language/Haskell/GhcMod/Types.hs
View File

@ -90,6 +90,7 @@ data Cradle = Cradle {
, 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 GHCOption = String
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

2
test/CabalApiSpec.hs
View File

@ -28,7 +28,7 @@ spec = do
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

6
test/CradleSpec.hs
View File

@ -22,6 +22,7 @@ spec = do
, cradleCabalDir = Nothing
, cradleCabalFile = Nothing
, cradlePackageDbOpts = []
, cradlePackages = []
}
it "finds a cabal file and a sandbox" $ do
withDirectory "test/data/subdir1/subdir2" $ \dir -> do
@ -31,6 +32,7 @@ spec = do
, cradleCabalDir = Just ("test" </> "data")
, cradleCabalFile = Just ("test" </> "data" </> "cabalapi.cabal")
, cradlePackageDbOpts = ["-no-user-package-db", "-package-db", "test" </> "data" </> ".cabal-sandbox" </> "/home/me/work/ghc-mod/test/data/.cabal-sandbox/i386-osx-ghc-7.6.3-packages.conf.d"]
, cradlePackages = []
}
it "works even if a sandbox config file is broken" $ do
withDirectory "test/data/broken-sandbox" $ \dir -> do
@ -40,6 +42,7 @@ spec = do
, cradleCabalDir = Just ("test" </> "data" </> "broken-sandbox")
, cradleCabalFile = Just ("test" </> "data" </> "broken-sandbox" </> "dummy.cabal")
, cradlePackageDbOpts = []
, cradlePackages = []
}
describe "getPackageDbDir" $ do
@ -51,11 +54,10 @@ spec = do
getPackageDbDir "test/data/bad.config" `shouldThrow` anyException
relativeCradle :: FilePath -> Cradle -> Cradle
relativeCradle dir cradle = Cradle {
relativeCradle dir cradle = cradle {
cradleCurrentDir = toRelativeDir dir $ cradleCurrentDir cradle
, cradleCabalDir = toRelativeDir dir <$> cradleCabalDir cradle
, cradleCabalFile = toRelativeDir dir <$> cradleCabalFile cradle
, cradlePackageDbOpts = cradlePackageDbOpts cradle
}
-- Work around GHC 7.2.2 where `canonicalizePath "/"` returns "/.".

2
test/DebugSpec.hs
View File

@ -7,7 +7,7 @@ import Dir
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]