Skip to content

Commit 84a7680

Browse files
committed
Merge pull request #1824 from owst/master
Fix #1816 - give more descriptive errors when .cabal file cannot be found
2 parents 3f061c7 + 2dd651c commit 84a7680

File tree

6 files changed

+73
-36
lines changed

6 files changed

+73
-36
lines changed

cabal-install/Distribution/Client/IndexUtils.hs

Lines changed: 31 additions & 20 deletions
Original file line numberDiff line numberDiff line change
@@ -55,7 +55,7 @@ import Distribution.Text
5555
import Distribution.Verbosity
5656
( Verbosity, normal, lessVerbose )
5757
import Distribution.Simple.Utils
58-
( die, warn, info, fromUTF8, tryFindPackageDesc )
58+
( die, warn, info, fromUTF8 )
5959

6060
import Data.Char (isAlphaNum)
6161
import Data.Maybe (mapMaybe, fromMaybe)
@@ -69,7 +69,8 @@ import qualified Data.ByteString.Lazy.Char8 as BS.Char8
6969
import qualified Data.ByteString.Char8 as BSS
7070
import Data.ByteString.Lazy (ByteString)
7171
import Distribution.Client.GZipUtils (maybeDecompress)
72-
import Distribution.Client.Utils (byteStringToFilePath)
72+
import Distribution.Client.Utils ( byteStringToFilePath
73+
, tryFindAddSourcePackageDesc )
7374
import Distribution.Compat.Exception (catchIO)
7475
import Distribution.Client.Compat.Time (getFileAge, getModTime)
7576
import System.Directory (doesFileExist)
@@ -351,7 +352,8 @@ extractPkg entry blockNo = case Tar.entryContent entry of
351352
| Tar.isBuildTreeRefTypeCode typeCode ->
352353
Just $ do
353354
let path = byteStringToFilePath content
354-
cabalFile <- tryFindPackageDesc path
355+
err = "Error reading package index."
356+
cabalFile <- tryFindAddSourcePackageDesc path err
355357
descr <- PackageDesc.Parse.readPackageDescription normal cabalFile
356358
return $ BuildTreeRef (refTypeFromTypeCode typeCode) (packageId descr)
357359
descr path blockNo
@@ -452,8 +454,9 @@ packageIndexFromCache mkPkg hnd entrs mode = accum mempty [] entrs
452454
-- package id for build tree references - the user might edit the .cabal
453455
-- file after the reference was added to the index.
454456
path <- liftM byteStringToFilePath . getEntryContent $ blockno
455-
pkg <- do cabalFile <- tryFindPackageDesc path
456-
PackageDesc.Parse.readPackageDescription normal cabalFile
457+
pkg <- do let err = "Error reading package index from cache."
458+
file <- tryFindAddSourcePackageDesc path err
459+
PackageDesc.Parse.readPackageDescription normal file
457460
let srcpkg = mkPkg (BuildTreeRef refType (packageId pkg) pkg path blockno)
458461
accum (srcpkg:srcpkgs) prefs entries
459462

@@ -503,31 +506,32 @@ data IndexCacheEntry = CachePackageId PackageId BlockNo
503506
| CachePreference Dependency
504507
deriving (Eq)
505508

509+
packageKey, blocknoKey, buildTreeRefKey, preferredVersionKey :: String
510+
packageKey = "pkg:"
511+
blocknoKey = "b#"
512+
buildTreeRefKey = "build-tree-ref:"
513+
preferredVersionKey = "pref-ver:"
514+
506515
readIndexCacheEntry :: BSS.ByteString -> Maybe IndexCacheEntry
507516
readIndexCacheEntry = \line ->
508517
case BSS.words line of
509518
[key, pkgnamestr, pkgverstr, sep, blocknostr]
510-
| key == packageKey && sep == blocknoKey ->
519+
| key == BSS.pack packageKey && sep == BSS.pack blocknoKey ->
511520
case (parseName pkgnamestr, parseVer pkgverstr [],
512521
parseBlockNo blocknostr) of
513522
(Just pkgname, Just pkgver, Just blockno)
514523
-> Just (CachePackageId (PackageIdentifier pkgname pkgver) blockno)
515524
_ -> Nothing
516-
[key, typecodestr, blocknostr] | key == buildTreeRefKey ->
525+
[key, typecodestr, blocknostr] | key == BSS.pack buildTreeRefKey ->
517526
case (parseRefType typecodestr, parseBlockNo blocknostr) of
518527
(Just refType, Just blockno)
519528
-> Just (CacheBuildTreeRef refType blockno)
520529
_ -> Nothing
521530

522-
(key: remainder) | key == preferredVersionKey ->
531+
(key: remainder) | key == BSS.pack preferredVersionKey ->
523532
fmap CachePreference (simpleParse (BSS.unpack (BSS.unwords remainder)))
524533
_ -> Nothing
525534
where
526-
packageKey = BSS.pack "pkg:"
527-
blocknoKey = BSS.pack "b#"
528-
buildTreeRefKey = BSS.pack "build-tree-ref:"
529-
preferredVersionKey = BSS.pack "pref-ver:"
530-
531535
parseName str
532536
| BSS.all (\c -> isAlphaNum c || c == '-') str
533537
= Just (PackageName (BSS.unpack str))
@@ -554,13 +558,20 @@ readIndexCacheEntry = \line ->
554558
_ -> Nothing
555559

556560
showIndexCacheEntry :: IndexCacheEntry -> String
557-
showIndexCacheEntry entry = case entry of
558-
CachePackageId pkgid b -> "pkg: " ++ display (packageName pkgid)
559-
++ " " ++ display (packageVersion pkgid)
560-
++ " b# " ++ show b
561-
CacheBuildTreeRef t b -> "build-tree-ref: " ++ (typeCodeFromRefType t:" ")
562-
++ show b
563-
CachePreference dep -> "pref-ver: " ++ display dep
561+
showIndexCacheEntry entry = unwords $ case entry of
562+
CachePackageId pkgid b -> [ packageKey
563+
, display (packageName pkgid)
564+
, display (packageVersion pkgid)
565+
, blocknoKey
566+
, show b
567+
]
568+
CacheBuildTreeRef t b -> [ buildTreeRefKey
569+
, [typeCodeFromRefType t]
570+
, show b
571+
]
572+
CachePreference dep -> [ preferredVersionKey
573+
, display dep
574+
]
564575

565576
readIndexCache :: BSS.ByteString -> [IndexCacheEntry]
566577
readIndexCache = mapMaybe readIndexCacheEntry . BSS.lines

cabal-install/Distribution/Client/Sandbox.hs

Lines changed: 4 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -64,7 +64,8 @@ import Distribution.Client.Sandbox.Types ( SandboxPackageInfo(..)
6464
, UseSandbox(..) )
6565
import Distribution.Client.Types ( PackageLocation(..)
6666
, SourcePackage(..) )
67-
import Distribution.Client.Utils ( inDir, tryCanonicalizePath )
67+
import Distribution.Client.Utils ( inDir, tryCanonicalizePath
68+
, tryFindAddSourcePackageDesc )
6869
import Distribution.PackageDescription.Configuration
6970
( flattenPackageDescription )
7071
import Distribution.PackageDescription.Parse ( readPackageDescription )
@@ -80,7 +81,6 @@ import Distribution.Simple.Setup ( Flag(..), HaddockFlags(..)
8081
import Distribution.Simple.SrcDist ( prepareTree )
8182
import Distribution.Simple.Utils ( die, debug, notice, info, warn
8283
, debugNoWrap, defaultPackageDesc
83-
, tryFindPackageDesc
8484
, intercalate, topHandlerWith
8585
, createDirectoryIfMissingVerbose )
8686
import Distribution.Package ( Package(..) )
@@ -618,9 +618,9 @@ withSandboxPackageInfo verbosity configFlags globalFlags
618618
-- List all packages installed in the sandbox.
619619
installedPkgIndex <- getInstalledPackagesInSandbox verbosity
620620
configFlags comp conf
621-
621+
let err = "Error reading sandbox package information."
622622
-- Get the package descriptions for all add-source deps.
623-
depsCabalFiles <- mapM tryFindPackageDesc buildTreeRefs
623+
depsCabalFiles <- mapM (flip tryFindAddSourcePackageDesc err) buildTreeRefs
624624
depsPkgDescs <- mapM (readPackageDescription verbosity) depsCabalFiles
625625
let depsMap = M.fromList (zip buildTreeRefs depsPkgDescs)
626626
isInstalled pkgid = not . null

cabal-install/Distribution/Client/Sandbox/Index.hs

Lines changed: 4 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -29,9 +29,10 @@ import Distribution.Client.Types ( Repo(..), LocalRepo(..)
2929
, SourcePackage(..), PackageLocation(..) )
3030
import Distribution.Client.Utils ( byteStringToFilePath, filePathToByteString
3131
, makeAbsoluteToCwd, tryCanonicalizePath
32-
, canonicalizePathNoThrow )
32+
, canonicalizePathNoThrow
33+
, tryFindAddSourcePackageDesc )
3334

34-
import Distribution.Simple.Utils ( die, debug, tryFindPackageDesc )
35+
import Distribution.Simple.Utils ( die, debug )
3536
import Distribution.Verbosity ( Verbosity )
3637

3738
import qualified Data.ByteString.Lazy as BS
@@ -61,7 +62,7 @@ buildTreeRefFromPath refType dir = do
6162
dirExists <- doesDirectoryExist dir
6263
unless dirExists $
6364
die $ "directory '" ++ dir ++ "' does not exist"
64-
_ <- tryFindPackageDesc dir
65+
_ <- tryFindAddSourcePackageDesc dir "Error adding source reference."
6566
return . Just $ BuildTreeRef refType dir
6667

6768
-- | Given a tar archive entry, try to parse it as a local build tree reference.

cabal-install/Distribution/Client/Sandbox/Timestamp.hs

Lines changed: 7 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -31,8 +31,7 @@ import Distribution.Simple.Setup (Flag (..),
3131
SDistFlags (..),
3232
defaultSDistFlags,
3333
sdistCommand)
34-
import Distribution.Simple.Utils (debug, die,
35-
tryFindPackageDesc, warn)
34+
import Distribution.Simple.Utils (debug, die, warn)
3635
import Distribution.System (Platform)
3736
import Distribution.Text (display)
3837
import Distribution.Verbosity (Verbosity, lessVerbose,
@@ -47,7 +46,8 @@ import Distribution.Client.SetupWrapper (SetupScriptOptions (..),
4746
defaultSetupScriptOptions,
4847
setupWrapper)
4948
import Distribution.Client.Utils (inDir, removeExistingFile,
50-
tryCanonicalizePath)
49+
tryCanonicalizePath,
50+
tryFindAddSourcePackageDesc)
5151

5252
import Distribution.Compat.Exception (catchIO)
5353
import Distribution.Client.Compat.Time (EpochTime, getCurTime,
@@ -213,9 +213,10 @@ withActionOnCompilerTimestamps f sandboxDir compId platform act = do
213213
-- FIXME: This function is not thread-safe because of 'inDir'.
214214
allPackageSourceFiles :: Verbosity -> FilePath -> IO [FilePath]
215215
allPackageSourceFiles verbosity packageDir = inDir (Just packageDir) $ do
216-
pkg <- fmap (flattenPackageDescription)
217-
. readPackageDescription verbosity =<< tryFindPackageDesc packageDir
218-
216+
pkg <- do
217+
let err = "Error reading source files of add-source dependency."
218+
desc <- tryFindAddSourcePackageDesc packageDir err
219+
flattenPackageDescription `fmap` readPackageDescription verbosity desc
219220
let file = "cabal-sdist-list-sources"
220221
flags = defaultSDistFlags {
221222
sDistVerbosity = Flag $ if verbosity == normal

cabal-install/Distribution/Client/Targets.hs

Lines changed: 8 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -58,6 +58,7 @@ import Distribution.Client.PackageIndex (PackageIndex)
5858
import qualified Distribution.Client.PackageIndex as PackageIndex
5959
import qualified Distribution.Client.Tar as Tar
6060
import Distribution.Client.FetchUtils
61+
import Distribution.Client.Utils ( tryFindPackageDesc )
6162

6263
import Distribution.PackageDescription
6364
( GenericPackageDescription, FlagName(..), FlagAssignment )
@@ -70,7 +71,7 @@ import Distribution.Text
7071
( Text(..), display )
7172
import Distribution.Verbosity (Verbosity)
7273
import Distribution.Simple.Utils
73-
( die, warn, intercalate, tryFindPackageDesc, fromUTF8, lowercase )
74+
( die, warn, intercalate, fromUTF8, lowercase )
7475

7576
import Data.List
7677
( find, nub )
@@ -422,7 +423,7 @@ expandUserTarget worldFile userTarget = case userTarget of
422423

423424
UserTargetLocalCabalFile file -> do
424425
let dir = takeDirectory file
425-
_ <- tryFindPackageDesc dir -- just as a check
426+
_ <- tryFindPackageDesc dir (localPackageError dir) -- just as a check
426427
return [ PackageTargetLocation (LocalUnpackedPackage dir) ]
427428

428429
UserTargetLocalTarball tarballFile ->
@@ -431,6 +432,9 @@ expandUserTarget worldFile userTarget = case userTarget of
431432
UserTargetRemoteTarball tarballURL ->
432433
return [ PackageTargetLocation (RemoteTarballPackage tarballURL ()) ]
433434

435+
localPackageError :: FilePath -> String
436+
localPackageError dir =
437+
"Error reading local package.\nCouldn't find .cabal file in: " ++ dir
434438

435439
-- ------------------------------------------------------------
436440
-- * Fetching and reading package targets
@@ -468,7 +472,8 @@ readPackageTarget verbosity target = case target of
468472
PackageTargetLocation location -> case location of
469473

470474
LocalUnpackedPackage dir -> do
471-
pkg <- readPackageDescription verbosity =<< tryFindPackageDesc dir
475+
pkg <- tryFindPackageDesc dir (localPackageError dir) >>=
476+
readPackageDescription verbosity
472477
return $ PackageTargetLocation $
473478
SourcePackage {
474479
packageInfoId = packageId pkg,

cabal-install/Distribution/Client/Utils.hs

Lines changed: 19 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -8,12 +8,15 @@ module Distribution.Client.Utils ( MergeResult(..)
88
, byteStringToFilePath, tryCanonicalizePath
99
, canonicalizePathNoThrow
1010
, moreRecentFile, existsAndIsMoreRecentThan
11+
, tryFindAddSourcePackageDesc
12+
, tryFindPackageDesc
1113
, relaxEncodingErrors)
1214
where
1315

1416
import Distribution.Compat.Exception ( catchIO )
1517
import Distribution.Client.Compat.Time ( getModTime )
1618
import Distribution.Simple.Setup ( Flag(..) )
19+
import Distribution.Simple.Utils ( die, findPackageDesc )
1720
import qualified Data.ByteString.Lazy as BS
1821
import Control.Monad
1922
( when )
@@ -216,3 +219,19 @@ relaxEncodingErrors handle = do
216219
_ ->
217220
#endif
218221
return ()
222+
223+
-- |Like 'tryFindPackageDesc', but with error specific to add-source deps.
224+
tryFindAddSourcePackageDesc :: FilePath -> String -> IO FilePath
225+
tryFindAddSourcePackageDesc depPath err = tryFindPackageDesc depPath $
226+
err ++ "\n" ++ "Failed to read cabal file of add-source dependency: "
227+
++ depPath
228+
229+
-- |Try to find a @.cabal@ file, in directory @depPath@. Fails if one cannot be
230+
-- found, with @err@ prefixing the error message. This function simply allows
231+
-- us to give a more descriptive error than that provided by @findPackageDesc@.
232+
tryFindPackageDesc :: FilePath -> String -> IO FilePath
233+
tryFindPackageDesc depPath err = do
234+
errOrCabalFile <- findPackageDesc depPath
235+
case errOrCabalFile of
236+
Right file -> return file
237+
Left _ -> die err

0 commit comments

Comments
 (0)