Update.hs 3.48 KB
Newer Older
1
2
-----------------------------------------------------------------------------
-- |
3
-- Module      :  Distribution.Client.Update
4
5
6
7
8
9
10
11
12
-- Copyright   :  (c) David Himmelstrup 2005
-- License     :  BSD-like
--
-- Maintainer  :  lemmih@gmail.com
-- Stability   :  provisional
-- Portability :  portable
--
--
-----------------------------------------------------------------------------
13
module Distribution.Client.Update
14
15
16
    ( update
    ) where

17
import Distribution.Client.Types
18
         ( Repo(..), RemoteRepo(..), LocalRepo(..), SourcePackageDb(..) )
td123's avatar
td123 committed
19
20
import Distribution.Client.HttpUtils
         ( DownloadResult(..) )
Duncan Coutts's avatar
Duncan Coutts committed
21
import Distribution.Client.FetchUtils
td123's avatar
td123 committed
22
         ( downloadIndex )
23
import qualified Distribution.Client.PackageIndex as PackageIndex
24
import Distribution.Client.IndexUtils
25
         ( getSourcePackages, updateRepoIndexCache )
26
27
import qualified Paths_cabal_install
         ( version )
28

29
import Distribution.Package
30
31
         ( PackageName(..), packageVersion )
import Distribution.Version
32
         ( anyVersion, withinRange )
33
import Distribution.Simple.Utils
34
         ( writeFileAtomic, warn, notice )
35
36
import Distribution.Verbosity
         ( Verbosity )
37

38
import qualified Data.ByteString.Lazy       as BS
39
import Distribution.Client.GZipUtils (maybeDecompress)
40
import qualified Data.Map as Map
bjorn@bringert.net's avatar
bjorn@bringert.net committed
41
import System.FilePath (dropExtension)
42
import Data.List       (intercalate)
43
import Data.Maybe      (fromMaybe)
44
import Data.Version    (showVersion)
EyalLotem's avatar
EyalLotem committed
45
import Control.Monad   (unless)
mnislaih's avatar
mnislaih committed
46

47
-- | 'update' downloads the package list from all known servers
48
update :: Verbosity -> [Repo] -> IO ()
EyalLotem's avatar
EyalLotem committed
49
update verbosity [] =
50
51
  warn verbosity $ "No remote package servers have been specified. Usually "
                ++ "you would have one specified in the config file."
52
53
54
update verbosity repos = do
  mapM_ (updateRepo verbosity) repos
  checkForSelfUpgrade verbosity repos
55

56
updateRepo :: Verbosity -> Repo -> IO ()
57
58
59
updateRepo verbosity repo = case repoKind repo of
  Right LocalRepo -> return ()
  Left remoteRepo -> do
60
61
    notice verbosity $ "Downloading the latest package list from "
                    ++ remoteRepoName remoteRepo
62
63
64
65
66
67
68
    downloadResult <- downloadIndex verbosity remoteRepo (repoLocalDir repo)
    case downloadResult of
      FileAlreadyInCache -> return ()
      FileDownloaded indexPath -> do
        writeFileAtomic (dropExtension indexPath) . maybeDecompress
                                                =<< BS.readFile indexPath
        updateRepoIndexCache verbosity repo
69
70
71

checkForSelfUpgrade :: Verbosity -> [Repo] -> IO ()
checkForSelfUpgrade verbosity repos = do
72
  SourcePackageDb sourcePkgIndex prefs <- getSourcePackages verbosity repos
73
74

  let self = PackageName "cabal-install"
75
      preferredVersionRange  = fromMaybe anyVersion (Map.lookup self prefs)
76
77
      currentVersion         = Paths_cabal_install.version
      laterPreferredVersions =
78
        [ version
79
        | pkg <- PackageIndex.lookupPackageName sourcePkgIndex self
80
81
        , let version = packageVersion pkg
        , version > currentVersion
82
83
        , version `withinRange` preferredVersionRange
        ]
84

85
  unless (null laterPreferredVersions) $ mapM_ (notice verbosity)
86
87
88
    [ "Note: You are not currently running the latest version of cabal-install."
    , "The currently running version is: " ++ showVersion currentVersion
    , "These available versions are newer: "
Mikhail Glushenkov's avatar
Mikhail Glushenkov committed
89
      ++ (intercalate ", " . map showVersion) laterPreferredVersions
90
    , "If you have already installed a newer version, and intended "
91
      ++ "to run it, maybe check your PATH environment variable?"
92
    ]