Remove Maybe from cabalConfigDependencies and fromInstalledPackageId

This commit is contained in:
Daniel Gröber 2014-05-03 14:51:58 +02:00
parent f750d10a9a
commit 9d9f66e942
2 changed files with 21 additions and 8 deletions

View File

@ -20,7 +20,7 @@ import Control.Applicative ((<$>))
import Control.Exception (throwIO,catch,SomeException) import Control.Exception (throwIO,catch,SomeException)
import Control.Monad (filterM) import Control.Monad (filterM)
import CoreMonad (liftIO) import CoreMonad (liftIO)
import Data.Maybe (maybeToList, mapMaybe) import Data.Maybe (maybeToList)
import Data.Set (fromList, toList) import Data.Set (fromList, toList)
import Data.List (find,tails,isPrefixOf) import Data.List (find,tails,isPrefixOf)
import Distribution.ModuleName (ModuleName,toFilePath) import Distribution.ModuleName (ModuleName,toFilePath)
@ -53,7 +53,7 @@ getCompilerOptions :: [GHCOption]
-> IO CompilerOptions -> IO CompilerOptions
getCompilerOptions ghcopts cradle pkgDesc = do getCompilerOptions ghcopts cradle pkgDesc = do
gopts <- getGHCOptions ghcopts cradle rdir $ head buildInfos gopts <- getGHCOptions ghcopts cradle rdir $ head buildInfos
Just depPkgs <- cabalConfigDependencies <$> cabalGetConfig cradle depPkgs <- cabalConfigDependencies <$> cabalGetConfig cradle
return $ CompilerOptions gopts idirs depPkgs return $ CompilerOptions gopts idirs depPkgs
where where
wdir = cradleCurrentDir cradle wdir = cradleCurrentDir cradle
@ -225,12 +225,17 @@ cabalGetConfig cradle =
cabalConfigPath :: FilePath cabalConfigPath :: FilePath
cabalConfigPath = localBuildInfoFile defaultDistPref cabalConfigPath = localBuildInfoFile defaultDistPref
cabalConfigDependencies :: CabalConfig -> Maybe [Package] cabalConfigDependencies :: CabalConfig -> [Package]
cabalConfigDependencies config = cabalConfigDependencies config =
cfgDepends >>= return . mapMaybe (fromInstalledPackageId . snd) (fromInstalledPackageId . snd) <$> cfgDepends
where where
cfgDepends :: Maybe [(PackageName, InstalledPackageId)] cfgDepends :: [(PackageName, InstalledPackageId)]
cfgDepends = extractCabalSetupConfig "configDependencies" config cfgDepends =
case extractCabalSetupConfig "configDependencies" config of
Just x -> x
Nothing -> error $
"cabalConfigDependencies: Extracting field `configDependencies' from"
++ " setup-config failed"
-- | Extract part of cabal's @setup-config@, this is done with a mix of manual -- | Extract part of cabal's @setup-config@, this is done with a mix of manual

View File

@ -7,6 +7,7 @@ module Language.Haskell.GhcMod.GhcPkg (
, ghcDbStackOpts , ghcDbStackOpts
, ghcDbOpt , ghcDbOpt
, fromInstalledPackageId , fromInstalledPackageId
, fromInstalledPackageId'
, getSandboxDb , getSandboxDb
, getPackageDbStack , getPackageDbStack
) where ) where
@ -84,13 +85,20 @@ packageLine l =
Just ((Hidden,p),_) -> Just p Just ((Hidden,p),_) -> Just p
_ -> Nothing _ -> Nothing
fromInstalledPackageId :: InstalledPackageId -> Maybe Package fromInstalledPackageId' :: InstalledPackageId -> Maybe Package
fromInstalledPackageId pid = let fromInstalledPackageId' pid = let
InstalledPackageId pkg = pid InstalledPackageId pkg = pid
in case reverse $ splitOn "-" pkg of in case reverse $ splitOn "-" pkg of
i:v:rest -> Just (intercalate "-" (reverse rest), v, i) i:v:rest -> Just (intercalate "-" (reverse rest), v, i)
_ -> Nothing _ -> Nothing
fromInstalledPackageId :: InstalledPackageId -> Package
fromInstalledPackageId pid =
case fromInstalledPackageId' pid of
Just p -> p
Nothing -> error $
"fromInstalledPackageId: `"++show pid++"' is not a valid package-id"
data PackageState = Normal | Hidden | Broken deriving (Eq,Show) data PackageState = Normal | Hidden | Broken deriving (Eq,Show)
packageLineP :: ReadP (PackageState, Package) packageLineP :: ReadP (PackageState, Package)