Conflicts:
	Language/Haskell/GhcMod/CabalConfig.hs
This commit is contained in:
Daniel Gröber
2014-09-12 05:21:12 +02:00
9 changed files with 66 additions and 16 deletions

View File

@@ -17,7 +17,7 @@ import Language.Haskell.GhcMod.Gap (benchmarkBuildInfo, benchmarkTargets,
import Language.Haskell.GhcMod.GhcPkg
import Language.Haskell.GhcMod.Types
import MonadUtils (MonadIO, liftIO)
import MonadUtils (liftIO)
import Control.Applicative ((<$>))
import qualified Control.Exception as E
import Control.Monad (filterM)
@@ -73,20 +73,22 @@ includeDirectories cdir wdir dirs = uniqueAndSort (extdirs ++ [cdir,wdir])
----------------------------------------------------------------
-- | Parse a cabal file and return a 'PackageDescription'.
parseCabalFile :: (MonadIO m, Error e, MonadError e m)
=> FilePath
parseCabalFile :: (IOish m, MonadError GhcModError m)
=> Cradle
-> FilePath
-> m PackageDescription
parseCabalFile file = do
parseCabalFile cradle file = do
cid <- liftIO getGHCId
epgd <- liftIO $ readPackageDescription silent file
case toPkgDesc cid epgd of
flags <- cabalConfigFlags cradle
case toPkgDesc cid flags epgd of
Left deps -> fail $ show deps ++ " are not installed"
Right (pd,_) -> if nullPkg pd
then fail $ file ++ " is broken"
else return pd
where
toPkgDesc cid =
finalizePackageDescription [] (const True) buildPlatform cid []
toPkgDesc cid flags =
finalizePackageDescription flags (const True) buildPlatform cid []
nullPkg pd = name == ""
where
PackageName name = C.pkgName (P.package pd)

View File

@@ -5,6 +5,7 @@
module Language.Haskell.GhcMod.CabalConfig (
CabalConfig
, cabalConfigDependencies
, cabalConfigFlags
) where
import Language.Haskell.GhcMod.Error
@@ -34,6 +35,7 @@ import Data.List (find,tails,isPrefixOf,isInfixOf,nub,stripPrefix)
import Distribution.Package (InstalledPackageId(..)
, PackageIdentifier(..)
, PackageName(..))
import Distribution.PackageDescription (FlagAssignment)
import Distribution.Simple.BuildPaths (defaultDistPref)
import Distribution.Simple.Configure (localBuildInfoFile)
import Distribution.Simple.LocalBuildInfo (ComponentName)
@@ -152,6 +154,20 @@ configDependencies thisPkg config = map fromInstalledPackageId deps
Right x -> x
Left msg -> error $ "reading config " ++ f ++ " failed ("++msg++")"
-- | Get the flag assignment from the local build info of the given cradle
cabalConfigFlags :: (IOish m, MonadError GhcModError m)
=> Cradle
-> m FlagAssignment
cabalConfigFlags cradle = do
config <- getConfig cradle
case configFlags config of
Right x -> return x
Left msg -> throwError (GMECabalFlags (GMEString msg))
-- | Extract the cabal flags from the 'CabalConfig'
configFlags :: CabalConfig -> Either String FlagAssignment
configFlags config = readEither =<< flip extractField "configConfigurationsFlags" =<< extractField config "configFlags"
-- | Find @field@ in 'CabalConfig'. Returns 'Left' containing a user readable
-- error message with lots of context on failure.
extractField :: CabalConfig -> String -> Either String String

View File

@@ -31,7 +31,7 @@ debugInfo = cradle >>= \c -> convert' =<< do
simpleCompilerOption = options >>= \op ->
return $ CompilerOptions (ghcUserOptions op) [] []
fromCabalFile c = options >>= \opts -> do
pkgDesc <- parseCabalFile $ fromJust $ cradleCabalFile c
pkgDesc <- parseCabalFile c $ fromJust $ cradleCabalFile c
getCompilerOptions (ghcUserOptions opts) c pkgDesc
----------------------------------------------------------------

View File

@@ -18,6 +18,8 @@ data GhcModError = GMENoMsg
-- 'fail' calls on GhcModT.
| GMECabalConfigure GhcModError
-- ^ Configuring a cabal project failed.
| GMECabalFlags GhcModError
-- ^ Retrieval of the cabal configuration flags failed.
| GMEProcess [String] GhcModError
-- ^ Launching an operating system process failed. The first
-- field is the command.

View File

@@ -204,7 +204,7 @@ initializeFlagsWithCradle opt c
cabal = isJust mCradleFile
ghcopts = ghcUserOptions opt
withCabal = do
pkgDesc <- parseCabalFile $ fromJust mCradleFile
pkgDesc <- parseCabalFile c $ fromJust mCradleFile
compOpts <- getCompilerOptions ghcopts c pkgDesc
initSession CabalPkg opt compOpts
withSandbox = initSession SingleFile opt compOpts