Commit 2bbe2742 authored by Mikhail Glushenkov's avatar Mikhail Glushenkov
Browse files

Rename 'findPackageDesc' to 'tryFindPackageDesc'.

Make 'findPackageDesc' return an 'Either'.
parent 0ce9d92f
......@@ -121,6 +121,7 @@ module Distribution.Simple.Utils (
-- * .cabal and .buildinfo files
defaultPackageDesc,
findPackageDesc,
tryFindPackageDesc,
defaultHookedPackageDesc,
findHookedPackageDesc,
......@@ -148,7 +149,7 @@ module Distribution.Simple.Utils (
) where
import Control.Monad
( when, unless, filterM )
( join, when, unless, filterM )
import Control.Concurrent.MVar
( newEmptyMVar, putMVar, takeMVar )
import Data.List
......@@ -1130,12 +1131,12 @@ currentDir = "."
-- |Package description file (/pkgname/@.cabal@)
defaultPackageDesc :: Verbosity -> IO FilePath
defaultPackageDesc _verbosity = findPackageDesc currentDir
defaultPackageDesc _verbosity = tryFindPackageDesc currentDir
-- |Find a package description file in the given directory. Looks for
-- @.cabal@ files.
findPackageDesc :: FilePath -- ^Where to look
-> IO FilePath -- ^<pkgname>.cabal
findPackageDesc :: FilePath -- ^Where to look
-> IO (Either String FilePath) -- ^<pkgname>.cabal
findPackageDesc dir
= do files <- getDirectoryContents dir
-- to make sure we do not mistake a ~/.cabal/ dir for a <pkgname>.cabal
......@@ -1146,19 +1147,23 @@ findPackageDesc dir
, let (name, ext) = splitExtension file
, not (null name) && ext == ".cabal" ]
case cabalFiles of
[] -> noDesc
[cabalFile] -> return cabalFile
multiple -> multiDesc multiple
[] -> return (Left noDesc)
[cabalFile] -> return (Right cabalFile)
multiple -> return (Left $ multiDesc multiple)
where
noDesc :: IO a
noDesc = die $ "No cabal file found.\n"
++ "Please create a package description file <pkgname>.cabal"
multiDesc :: [String] -> IO a
multiDesc l = die $ "Multiple cabal files found.\n"
++ "Please use only one of: "
++ intercalate ", " l
noDesc :: String
noDesc = "No cabal file found.\n"
++ "Please create a package description file <pkgname>.cabal"
multiDesc :: [String] -> String
multiDesc l = "Multiple cabal files found.\n"
++ "Please use only one of: "
++ intercalate ", " l
-- |Like 'findPackageDesc', but calls 'die' in case of error.
tryFindPackageDesc :: FilePath -> IO FilePath
tryFindPackageDesc dir = join . fmap (either die return) $ findPackageDesc dir
-- |Optional auxiliary package information file (/pkgname/@.buildinfo@)
defaultHookedPackageDesc :: IO (Maybe FilePath)
......
......@@ -55,7 +55,7 @@ import Distribution.Text
import Distribution.Verbosity
( Verbosity, normal, lessVerbose )
import Distribution.Simple.Utils
( die, warn, info, fromUTF8, findPackageDesc )
( die, warn, info, fromUTF8, tryFindPackageDesc )
import Data.Char (isAlphaNum)
import Data.Maybe (mapMaybe, fromMaybe)
......@@ -351,7 +351,7 @@ extractPkg entry blockNo = case Tar.entryContent entry of
| Tar.isBuildTreeRefTypeCode typeCode ->
Just $ do
let path = byteStringToFilePath content
cabalFile <- findPackageDesc path
cabalFile <- tryFindPackageDesc path
descr <- PackageDesc.Parse.readPackageDescription normal cabalFile
return $ BuildTreeRef (refTypeFromTypeCode typeCode) (packageId descr)
descr path blockNo
......@@ -452,7 +452,7 @@ packageIndexFromCache mkPkg hnd entrs mode = accum mempty [] entrs
-- package id for build tree references - the user might edit the .cabal
-- file after the reference was added to the index.
path <- liftM byteStringToFilePath . getEntryContent $ blockno
pkg <- do cabalFile <- findPackageDesc path
pkg <- do cabalFile <- tryFindPackageDesc path
PackageDesc.Parse.readPackageDescription normal cabalFile
let srcpkg = mkPkg (BuildTreeRef refType (packageId pkg) pkg path blockno)
accum (srcpkg:srcpkgs) prefs entries
......
......@@ -79,7 +79,7 @@ import Distribution.Simple.Setup ( Flag(..), HaddockFlags(..)
import Distribution.Simple.SrcDist ( prepareTree )
import Distribution.Simple.Utils ( die, debug, notice, info, warn
, debugNoWrap, defaultPackageDesc
, findPackageDesc
, tryFindPackageDesc
, intercalate, topHandlerWith
, createDirectoryIfMissingVerbose )
import Distribution.Package ( Package(..) )
......@@ -592,7 +592,7 @@ withSandboxPackageInfo verbosity configFlags globalFlags
configFlags comp conf
-- Get the package descriptions for all add-source deps.
depsCabalFiles <- mapM findPackageDesc buildTreeRefs
depsCabalFiles <- mapM tryFindPackageDesc buildTreeRefs
depsPkgDescs <- mapM (readPackageDescription verbosity) depsCabalFiles
let depsMap = M.fromList (zip buildTreeRefs depsPkgDescs)
isInstalled pkgid = not . null
......
......@@ -31,7 +31,7 @@ import Distribution.Client.Utils ( byteStringToFilePath, filePathToByteString
, makeAbsoluteToCwd, tryCanonicalizePath
, canonicalizePathNoThrow )
import Distribution.Simple.Utils ( die, debug, findPackageDesc )
import Distribution.Simple.Utils ( die, debug, tryFindPackageDesc )
import Distribution.Verbosity ( Verbosity )
import qualified Data.ByteString.Lazy as BS
......@@ -61,7 +61,7 @@ buildTreeRefFromPath refType dir = do
dirExists <- doesDirectoryExist dir
unless dirExists $
die $ "directory '" ++ dir ++ "' does not exist"
_ <- findPackageDesc dir
_ <- tryFindPackageDesc dir
return . Just $ BuildTreeRef refType dir
-- | Given a tar archive entry, try to parse it as a local build tree reference.
......
......@@ -33,7 +33,7 @@ import Distribution.Simple.Setup (Flag (..),
defaultSDistFlags,
sdistCommand)
import Distribution.Simple.Utils (debug, die,
findPackageDesc, warn)
tryFindPackageDesc, warn)
import Distribution.System (Platform)
import Distribution.Text (display)
import Distribution.Verbosity (Verbosity, lessVerbose,
......@@ -215,7 +215,7 @@ withActionOnCompilerTimestamps f sandboxDir compId platform act = do
allPackageSourceFiles :: Verbosity -> FilePath -> IO [FilePath]
allPackageSourceFiles verbosity packageDir = inDir (Just packageDir) $ do
pkg <- fmap (flattenPackageDescription)
. readPackageDescription verbosity =<< findPackageDesc packageDir
. readPackageDescription verbosity =<< tryFindPackageDesc packageDir
let file = "cabal-sdist-list-sources"
flags = defaultSDistFlags {
......
......@@ -69,7 +69,7 @@ import Distribution.Client.JobControl
import Distribution.Simple.Setup
( Flag(..) )
import Distribution.Simple.Utils
( die, debug, info, cabalVersion, findPackageDesc, comparing
( die, debug, info, cabalVersion, tryFindPackageDesc, comparing
, createDirectoryIfMissingVerbose, installExecutableFile
, copyFileVerbose, rewriteFile, intercalate )
import Distribution.Client.Utils
......@@ -159,7 +159,7 @@ setupWrapper verbosity options mpkg cmd flags extraArgs = do
checkBuildType buildType'
setupMethod verbosity options' (packageId pkg) buildType' mkArgs
where
getPkg = findPackageDesc (fromMaybe "." (useWorkingDir options))
getPkg = tryFindPackageDesc (fromMaybe "." (useWorkingDir options))
>>= readPackageDescription verbosity
>>= return . packageDescription
......
......@@ -70,7 +70,7 @@ import Distribution.Text
( Text(..), display )
import Distribution.Verbosity (Verbosity)
import Distribution.Simple.Utils
( die, warn, intercalate, findPackageDesc, fromUTF8, lowercase )
( die, warn, intercalate, tryFindPackageDesc, fromUTF8, lowercase )
import Data.List
( find, nub )
......@@ -422,7 +422,7 @@ expandUserTarget worldFile userTarget = case userTarget of
UserTargetLocalCabalFile file -> do
let dir = takeDirectory file
_ <- findPackageDesc dir -- just as a check
_ <- tryFindPackageDesc dir -- just as a check
return [ PackageTargetLocation (LocalUnpackedPackage dir) ]
UserTargetLocalTarball tarballFile ->
......@@ -468,7 +468,7 @@ readPackageTarget verbosity target = case target of
PackageTargetLocation location -> case location of
LocalUnpackedPackage dir -> do
pkg <- readPackageDescription verbosity =<< findPackageDesc dir
pkg <- readPackageDescription verbosity =<< tryFindPackageDesc dir
return $ PackageTargetLocation $
SourcePackage {
packageInfoId = packageId pkg,
......
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment