1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
|
-----------------------------------------------------------------------------
-- |
-- Module : Distribution.Client.Update
-- Copyright : (c) David Himmelstrup 2005
-- License : BSD-like
--
-- Maintainer : lemmih@gmail.com
-- Stability : provisional
-- Portability : portable
--
--
-----------------------------------------------------------------------------
module Distribution.Client.Update
( update
) where
import Distribution.Client.Types
( Repo(..), RemoteRepo(..), LocalRepo(..), SourcePackageDb(..) )
import Distribution.Client.HttpUtils
( DownloadResult(..) )
import Distribution.Client.FetchUtils
( downloadIndex )
import qualified Distribution.Client.PackageIndex as PackageIndex
import Distribution.Client.IndexUtils
( getSourcePackages, updateRepoIndexCache )
import qualified Paths_cabal_install
( version )
import Distribution.Package
( PackageName(..), packageVersion )
import Distribution.Version
( anyVersion, withinRange )
import Distribution.Simple.Utils
( writeFileAtomic, warn, notice )
import Distribution.Verbosity
( Verbosity )
import qualified Data.ByteString.Lazy as BS
import Distribution.Client.GZipUtils (maybeDecompress)
import qualified Data.Map as Map
import System.FilePath (dropExtension)
import Data.Maybe (fromMaybe)
import Control.Monad (unless)
-- | 'update' downloads the package list from all known servers
update :: Verbosity -> [Repo] -> IO ()
update verbosity [] =
warn verbosity $ "No remote package servers have been specified. Usually "
++ "you would have one specified in the config file."
update verbosity repos = mapM_ (updateRepo verbosity) repos
updateRepo :: Verbosity -> Repo -> IO ()
updateRepo verbosity repo = case repoKind repo of
Right LocalRepo -> return ()
Left remoteRepo -> do
notice verbosity $ "Downloading the latest package list from "
++ remoteRepoName remoteRepo
downloadResult <- downloadIndex verbosity remoteRepo (repoLocalDir repo)
case downloadResult of
FileAlreadyInCache -> return ()
FileDownloaded indexPath -> do
writeFileAtomic (dropExtension indexPath) . maybeDecompress
=<< BS.readFile indexPath
updateRepoIndexCache verbosity repo
checkForSelfUpgrade :: Verbosity -> [Repo] -> IO ()
checkForSelfUpgrade verbosity repos = do
SourcePackageDb sourcePkgIndex prefs <- getSourcePackages verbosity repos
let self = PackageName "cabal-install"
preferredVersionRange = fromMaybe anyVersion (Map.lookup self prefs)
currentVersion = Paths_cabal_install.version
laterPreferredVersions =
[ packageVersion pkg
| pkg <- PackageIndex.lookupPackageName sourcePkgIndex self
, let version = packageVersion pkg
, version > currentVersion
, version `withinRange` preferredVersionRange ]
unless (null laterPreferredVersions) $
notice verbosity $
"Note: there is a new version of cabal-install available.\n"
++ "To upgrade, run: cabal install cabal-install"
|
