Commit 73505b7a authored by Duncan Coutts's avatar Duncan Coutts
Browse files

Add a local path and type param to PackageLocation

So we can now use PackageLocation FilePath or Maybe FilePath to
describe what we know about the fetch status of package tarballs.
parent 16b3c2ec
......@@ -117,11 +117,11 @@ fromPlanPackage :: Platform -> CompilerId
fromPlanPackage (Platform arch os) comp planPackage = case planPackage of
InstallPlan.Installed pkg@(ConfiguredPackage (AvailablePackage {
packageSource = RepoTarballPackage repo }) _ _) result
packageSource = RepoTarballPackage repo _ _ }) _ _) result
-> Just $ (BuildReport.new os arch comp pkg (Right result), repo)
InstallPlan.Failed pkg@(ConfiguredPackage (AvailablePackage {
packageSource = RepoTarballPackage repo }) _ _) result
packageSource = RepoTarballPackage repo _ _ }) _ _) result
-> Just $ (BuildReport.new os arch comp pkg (Left result), repo)
_ -> Nothing
......@@ -83,7 +83,7 @@ fetch verbosity packageDBs repos comp conf flags deps = do
includeDeps comp
installed availableDb deps'
pkgs' <- filterM (fmap not . isFetched) pkgs
pkgs' <- filterM (fmap not . isFetched . packageSource) pkgs
when (null pkgs') $
notice verbosity $ "No packages need to be fetched. "
++ "All the requested packages are already cached."
......@@ -93,7 +93,7 @@ fetch verbosity packageDBs repos comp conf flags deps = do
: map (display . packageId) pkgs'
else sequence_
[ fetchRepoTarball verbosity repo pkgid
| (AvailablePackage pkgid _ (RepoTarballPackage repo)) <- pkgs' ]
| (AvailablePackage pkgid _ (RepoTarballPackage repo _ _)) <- pkgs' ]
where
includeDeps = fromFlag (fetchDeps flags)
dryRun = fromFlag (fetchDryRun flags)
......
......@@ -36,6 +36,7 @@ import Distribution.Text
import Distribution.Verbosity
( Verbosity )
import Data.Maybe
import System.Directory
( doesFileExist, createDirectoryIfMissing )
import System.FilePath
......@@ -52,12 +53,12 @@ import Network.URI
-- | Returns @True@ if the package has already been fetched
-- or does not need fetching.
--
isFetched :: AvailablePackage -> IO Bool
isFetched (AvailablePackage pkgid _ source) = case source of
LocalUnpackedPackage _ -> return True
LocalTarballPackage _ -> return True
RemoteTarballPackage _ -> return False --TODO: ad-hoc download caching
RepoTarballPackage repo -> doesFileExist (packageFile repo pkgid)
isFetched :: PackageLocation (Maybe FilePath) -> IO Bool
isFetched loc = case loc of
LocalUnpackedPackage _dir -> return True
LocalTarballPackage _file -> return True
RemoteTarballPackage _uri local -> return (isJust local)
RepoTarballPackage repo pkgid _ -> doesFileExist (packageFile repo pkgid)
-- | Fetch a repo package if we don't have it already.
--
......
......@@ -150,7 +150,7 @@ readRepoIndex verbosity repo = handleNotFound $ do
[ AvailablePackage {
packageInfoId = pkgid,
packageDescription = pkg,
packageSource = RepoTarballPackage repo
packageSource = RepoTarballPackage repo pkgid Nothing
}
| (pkgid, pkg) <- pkgs]
......
......@@ -743,7 +743,7 @@ executeInstallPlan plan installPkg = case InstallPlan.ready plan of
--
installConfiguredPackage :: Platform -> CompilerId
-> ConfigFlags -> ConfiguredPackage
-> (ConfigFlags -> PackageLocation
-> (ConfigFlags -> PackageLocation (Maybe FilePath)
-> PackageDescription -> a)
-> a
installConfiguredPackage platform comp configFlags
......@@ -761,7 +761,7 @@ installConfiguredPackage platform comp configFlags
installAvailablePackage
:: Verbosity -> PackageIdentifier -> PackageLocation
:: Verbosity -> PackageIdentifier -> PackageLocation (Maybe FilePath)
-> (Maybe FilePath -> IO BuildResult)
-> IO BuildResult
installAvailablePackage _ _ (LocalUnpackedPackage dir) installPkg =
......@@ -775,7 +775,7 @@ installAvailablePackage verbosity pkgid
tarballPath tmpDirPath installPkg
installAvailablePackage verbosity pkgid
(RemoteTarballPackage tarballURL) installPkg = do
(RemoteTarballPackage tarballURL _) installPkg = do
tmp <- getTemporaryDirectory
withTempDirectory verbosity tmp (display pkgid) $ \tmpDirPath ->
onFailure DownloadFailed $ do
......@@ -787,7 +787,7 @@ installAvailablePackage verbosity pkgid
installLocalTarballPackage verbosity pkgid
tarballPath tmpDirPath installPkg
installAvailablePackage verbosity pkgid (RepoTarballPackage repo) installPkg =
installAvailablePackage verbosity pkgid (RepoTarballPackage repo _ _) installPkg =
onFailure DownloadFailed $ do
tarballPath <- fetchRepoTarball verbosity repo pkgid
tmp <- getTemporaryDirectory
......
......@@ -344,7 +344,8 @@ mergePackageInfo installedPkgs availablePkgs =
--
updateFileSystemPackageDetails :: PackageDisplayInfo -> IO PackageDisplayInfo
updateFileSystemPackageDetails pkginfo = do
fetched <- maybe (return False) isFetched (latestAvailable pkginfo)
fetched <- maybe (return False) (isFetched . packageSource)
(latestAvailable pkginfo)
docsExist <- doesDirectoryExist (haddockHtml pkginfo)
return pkginfo {
haveTarball = fetched,
......
......@@ -93,7 +93,7 @@ instance PackageFixedDeps ConfiguredPackage where
data AvailablePackage = AvailablePackage {
packageInfoId :: PackageId,
packageDescription :: GenericPackageDescription,
packageSource :: PackageLocation
packageSource :: PackageLocation (Maybe FilePath)
}
deriving Show
......@@ -103,7 +103,7 @@ instance Package AvailablePackage where packageId = packageInfoId
-- * Package locations and repositories
-- ------------------------------------------------------------
data PackageLocation =
data PackageLocation local =
-- | An unpacked package in the given dir, or current dir
LocalUnpackedPackage FilePath
......@@ -112,21 +112,25 @@ data PackageLocation =
| LocalTarballPackage FilePath
-- | A package as a tarball from a remote URI
| RemoteTarballPackage URI
| RemoteTarballPackage URI local
-- | A package available as a tarball from a repository.
--
-- It may be from a local repository or from a remote repository, with a
-- locally cached copy. ie a package available from hackage
| RepoTarballPackage Repo
| RepoTarballPackage Repo PackageId local
--TODO:
-- * add support for darcs and other SCM style remote repos with a local cache
-- | ScmPackage
deriving Show
--TODO:
-- * add support for darcs and other SCM style remote repos with a local cache
instance Functor PackageLocation where
fmap _ (LocalUnpackedPackage dir) = LocalUnpackedPackage dir
fmap _ (LocalTarballPackage file) = LocalTarballPackage file
fmap f (RemoteTarballPackage uri x) = RemoteTarballPackage uri (f x)
fmap f (RepoTarballPackage repo pkg x) = RepoTarballPackage repo pkg (f x)
data LocalRepo = LocalRepo
deriving (Show,Eq)
......
......@@ -77,7 +77,7 @@ unpack flags repos deps = do
AvailablePackage pkgid _ (LocalTarballPackage tarballPath) ->
unpackPackage verbosity prefix pkgid tarballPath
AvailablePackage pkgid _ (RemoteTarballPackage tarballURL) -> do
AvailablePackage pkgid _ (RemoteTarballPackage tarballURL _) -> do
tmp <- getTemporaryDirectory
(tarballPath, hnd) <- openTempFile tmp (display pkgid)
hClose hnd
......@@ -87,7 +87,7 @@ unpack flags repos deps = do
downloadURI verbosity tarballURL tarballPath
unpackPackage verbosity prefix pkgid tarballPath
AvailablePackage pkgid _ (RepoTarballPackage repo) -> do
AvailablePackage pkgid _ (RepoTarballPackage repo _ _) -> do
tarballPath <- fetchRepoTarball verbosity repo pkgid
unpackPackage verbosity prefix pkgid tarballPath
......
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