test update and error handling in CabalApi.
This commit is contained in:
Kazu Yamamoto
parent
b2d2542435
commit
3bbc008907
|
|
@ -2,9 +2,10 @@
|
|||
|
||||
module Language.Haskell.GhcMod.CabalApi (
|
||||
fromCabalFile
|
||||
, cabalParseFile
|
||||
, parseCabalFile
|
||||
, cabalAllDependPackages
|
||||
, cabalAllSourceDirs
|
||||
, cabalAllBuildInfo
|
||||
, getGHCVersion
|
||||
) where
|
||||
|
||||
|
|
@ -13,7 +14,9 @@ import Control.Exception (throwIO)
|
|||
import Data.List (intercalate)
|
||||
import Data.Maybe (maybeToList)
|
||||
import Data.Set (fromList, toList)
|
||||
import Distribution.Package (Dependency(Dependency), PackageName(PackageName))
|
||||
import Distribution.Package (Dependency(Dependency)
|
||||
, PackageName(PackageName)
|
||||
, PackageIdentifier(pkgName))
|
||||
import Distribution.PackageDescription
|
||||
import Distribution.PackageDescription.Configuration (finalizePackageDescription)
|
||||
import Distribution.PackageDescription.Parse (readPackageDescription)
|
||||
|
|
@ -33,7 +36,7 @@ fromCabalFile :: [GHCOption]
|
|||
-> Cradle
|
||||
-> IO ([GHCOption],[IncludeDir],[Package])
|
||||
fromCabalFile ghcOptions cradle = do
|
||||
cabal <- cabalParseFile cfile
|
||||
cabal <- parseCabalFile cfile
|
||||
return $ cookInfo ghcOptions cradle cabal
|
||||
where
|
||||
Just cfile = cradleCabalFile cradle
|
||||
|
|
@ -46,7 +49,7 @@ cookInfo ghcOptions cradle cabal = (gopts,idirs,depPkgs)
|
|||
Just cdir = cradleCabalDir cradle
|
||||
Just cfile = cradleCabalFile cradle
|
||||
buildInfos = cabalAllBuildInfo cabal
|
||||
gopts = getGHCOptions ghcOptions $ head buildInfos -- FIXME
|
||||
gopts = getGHCOptions ghcOptions $ head buildInfos
|
||||
idirs = includeDirectories cdir wdir $ cabalAllSourceDirs buildInfos
|
||||
depPkgs = removeMe cfile $ cabalAllDependPackages buildInfos
|
||||
|
||||
|
|
@ -61,15 +64,20 @@ includeDirectories cdir wdir dirs = uniqueAndSort (map (cdir </>) dirs ++ [cdir,
|
|||
|
||||
----------------------------------------------------------------
|
||||
|
||||
cabalParseFile :: FilePath -> IO PackageDescription
|
||||
cabalParseFile file = do
|
||||
parseCabalFile :: FilePath -> IO PackageDescription
|
||||
parseCabalFile file = do
|
||||
cid <- getGHCId
|
||||
epgd <- readPackageDescription silent file
|
||||
case toPkgDesc cid epgd of
|
||||
Left _ -> throwIO $ userError "cabal file is broken"
|
||||
Right (pd,_) -> return pd -- FIXME check empty
|
||||
Left deps -> throwIO $ userError $ show deps ++ " are not installed"
|
||||
Right (pd,_) -> if nullPkg pd
|
||||
then throwIO $ userError $ file ++ " is broken"
|
||||
else return pd
|
||||
where
|
||||
toPkgDesc cid = finalizePackageDescription [] (const True) buildPlatform cid []
|
||||
nullPkg pd = name == ""
|
||||
where
|
||||
PackageName name = pkgName (package pd)
|
||||
|
||||
----------------------------------------------------------------
|
||||
|
||||
|
|
|
|||
|
|
@ -1,27 +1,29 @@
|
|||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
|
||||
module CabalApiSpec where
|
||||
|
||||
import Control.Applicative
|
||||
import Control.Exception
|
||||
import Language.Haskell.GhcMod.CabalApi
|
||||
import Test.Hspec
|
||||
|
||||
spec :: Spec
|
||||
spec = do
|
||||
describe "parseCabalFile" $ do
|
||||
it "throws an exception if the cabal file is broken" $ do
|
||||
parseCabalFile "test/data/broken-cabal/broken.cabal" `shouldThrow` (\(e::IOException) -> True)
|
||||
|
||||
describe "cabalAllDependPackages" $ do
|
||||
it "extracts dependent packages" $ do
|
||||
pkgs <- cabalAllDependPackages <$> cabalParseFile "test/data/cabalapi.cabal"
|
||||
pkgs <- cabalAllDependPackages . cabalAllBuildInfo <$> parseCabalFile "test/data/cabalapi.cabal"
|
||||
pkgs `shouldBe` ["Cabal","base","template-haskell"]
|
||||
|
||||
describe "cabalAllSourceDirs" $ do
|
||||
it "extracts all hs-source-dirs" $ do
|
||||
dirs <- cabalAllSourceDirs <$> cabalParseFile "test/data/check-test-subdir/check-test-subdir.cabal"
|
||||
dirs <- cabalAllSourceDirs . cabalAllBuildInfo <$> parseCabalFile "test/data/check-test-subdir/check-test-subdir.cabal"
|
||||
dirs `shouldBe` ["src", "test"]
|
||||
|
||||
describe "cabalBuildInfo" $ do
|
||||
it "extracts build info" $ do
|
||||
info <- cabalBuildInfo <$> cabalParseFile "test/data/cabalapi.cabal"
|
||||
let infoStr = show info
|
||||
infoStr `shouldBe` "Just (BuildInfo {buildable = True, buildTools = [], cppOptions = [], ccOptions = [], ldOptions = [], pkgconfigDepends = [], frameworks = [], cSources = [], hsSourceDirs = [], otherModules = [ModuleName [\"Browse\"],ModuleName [\"CabalApi\"],ModuleName [\"Cabal\"],ModuleName [\"CabalDev\"],ModuleName [\"Check\"],ModuleName [\"ErrMsg\"],ModuleName [\"Flag\"],ModuleName [\"GHCApi\"],ModuleName [\"GHCChoice\"],ModuleName [\"Gap\"],ModuleName [\"Info\"],ModuleName [\"Lang\"],ModuleName [\"Lint\"],ModuleName [\"List\"],ModuleName [\"Paths_ghc_mod\"],ModuleName [\"Types\"]], defaultLanguage = Nothing, otherLanguages = [], defaultExtensions = [], otherExtensions = [], oldExtensions = [], extraLibs = [], extraLibDirs = [], includeDirs = [], includes = [], installIncludes = [], options = [(GHC,[\"-Wall\"])], ghcProfOptions = [], ghcSharedOptions = [], customFieldsBI = [], targetBuildDepends = []})"
|
||||
|
||||
it "returns Nothing if the cabal file is broken" $ do
|
||||
info <- cabalBuildInfo <$> cabalParseFile "test/data/broken-cabal/broken.cabal"
|
||||
info `shouldBe` Nothing
|
||||
info <- cabalAllBuildInfo <$> parseCabalFile "test/data/cabalapi.cabal"
|
||||
show info `shouldBe` "[BuildInfo {buildable = True, buildTools = [], cppOptions = [], ccOptions = [], ldOptions = [], pkgconfigDepends = [], frameworks = [], cSources = [], hsSourceDirs = [\".\"], otherModules = [ModuleName [\"Browse\"],ModuleName [\"CabalApi\"],ModuleName [\"Cabal\"],ModuleName [\"CabalDev\"],ModuleName [\"Check\"],ModuleName [\"ErrMsg\"],ModuleName [\"Flag\"],ModuleName [\"GHCApi\"],ModuleName [\"GHCChoice\"],ModuleName [\"Gap\"],ModuleName [\"Info\"],ModuleName [\"Lang\"],ModuleName [\"Lint\"],ModuleName [\"List\"],ModuleName [\"Paths_ghc_mod\"],ModuleName [\"Types\"]], defaultLanguage = Nothing, otherLanguages = [], defaultExtensions = [], otherExtensions = [], oldExtensions = [], extraLibs = [], extraLibDirs = [], includeDirs = [], includes = [], installIncludes = [], options = [(GHC,[\"-Wall\"])], ghcProfOptions = [], ghcSharedOptions = [], customFieldsBI = [], targetBuildDepends = [Dependency (PackageName \"Cabal\") (UnionVersionRanges (ThisVersion (Version {versionBranch = [1,10], versionTags = []})) (LaterVersion (Version {versionBranch = [1,10], versionTags = []}))),Dependency (PackageName \"base\") (IntersectVersionRanges (UnionVersionRanges (ThisVersion (Version {versionBranch = [4,0], versionTags = []})) (LaterVersion (Version {versionBranch = [4,0], versionTags = []}))) (EarlierVersion (Version {versionBranch = [5], versionTags = []}))),Dependency (PackageName \"template-haskell\") AnyVersion]},BuildInfo {buildable = True, buildTools = [], cppOptions = [], ccOptions = [], ldOptions = [], pkgconfigDepends = [], frameworks = [], cSources = [], hsSourceDirs = [\"test\",\".\"], otherModules = [ModuleName [\"Expectation\"],ModuleName [\"BrowseSpec\"],ModuleName [\"CabalApiSpec\"],ModuleName [\"FlagSpec\"],ModuleName [\"LangSpec\"],ModuleName [\"LintSpec\"],ModuleName [\"ListSpec\"]], defaultLanguage = Nothing, otherLanguages = [], defaultExtensions = [], otherExtensions = [], oldExtensions = [], extraLibs = [], extraLibDirs = [], includeDirs = [], includes = [], installIncludes = [], options = [], ghcProfOptions = [], ghcSharedOptions = [], customFieldsBI = [], targetBuildDepends = [Dependency (PackageName \"Cabal\") (UnionVersionRanges (ThisVersion (Version {versionBranch = [1,10], versionTags = []})) (LaterVersion (Version {versionBranch = [1,10], versionTags = []}))),Dependency (PackageName \"base\") (IntersectVersionRanges (UnionVersionRanges (ThisVersion (Version {versionBranch = [4,0], versionTags = []})) (LaterVersion (Version {versionBranch = [4,0], versionTags = []}))) (EarlierVersion (Version {versionBranch = [5], versionTags = []})))]}]"
|
||||
|
|
|
|||
Loading…
Reference in New Issue