{-# LANGUAGE CPP             #-}
{-# LANGUAGE LambdaCase      #-}
{-# LANGUAGE NamedFieldPuns  #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections   #-}
{-# LANGUAGE ViewPatterns    #-}

-- | cabal-install CLI command: update
--
module Distribution.Client.CmdUpdate (
    updateCommand,
    updateAction,
  ) where

import Prelude ()
import Control.Exception
import Distribution.Client.Compat.Prelude

import Distribution.Client.NixStyleOptions
         ( NixStyleFlags (..), nixStyleOptions, defaultNixStyleFlags )
import Distribution.Client.Compat.Directory
         ( setModificationTime )
import Distribution.Client.ProjectOrchestration
import Distribution.Client.ProjectConfig
         ( ProjectConfig(..)
         , ProjectConfigShared(projectConfigConfigFile)
         , projectConfigWithSolverRepoContext
         , withProjectOrGlobalConfig )
import Distribution.Client.ProjectFlags
         ( ProjectFlags (..) )
import Distribution.Client.Types
         ( Repo(..), RepoName (..), unRepoName, RemoteRepo(..), repoName )
import Distribution.Client.HttpUtils
         ( DownloadResult(..) )
import Distribution.Client.FetchUtils
         ( downloadIndex )
import Distribution.Client.JobControl
         ( newParallelJobControl, spawnJob, collectJob )
import Distribution.Client.Setup
         ( GlobalFlags, ConfigFlags(..)
         , UpdateFlags, defaultUpdateFlags
         , RepoContext(..) )
import Distribution.Simple.Flag
         ( fromFlagOrDefault )
import Distribution.Simple.Utils
         ( die', notice, wrapText, writeFileAtomic, noticeNoWrap, warn )
import Distribution.Verbosity
         ( normal, lessVerbose )
import Distribution.Client.IndexUtils.IndexState
import Distribution.Client.IndexUtils
         ( updateRepoIndexCache, Index(..), writeIndexTimestamp
         , currentIndexTimestamp, indexBaseName, updatePackageIndexCacheFile )

import qualified Data.Maybe as Unsafe (fromJust)
import qualified Distribution.Compat.CharParsing as P
import qualified Text.PrettyPrint                as Disp

import qualified Data.ByteString.Lazy       as BS
import Distribution.Client.GZipUtils (maybeDecompress)
import System.FilePath ((<.>), dropExtension)
import Data.Time (getCurrentTime)
import Distribution.Simple.Command
         ( CommandUI(..), usageAlternatives )

import qualified Hackage.Security.Client as Sec
import Distribution.Client.IndexUtils.Timestamp (nullTimestamp)

updateCommand :: CommandUI (NixStyleFlags ())
updateCommand :: CommandUI (NixStyleFlags ())
updateCommand = CommandUI
  { commandName :: String
commandName         = String
"v2-update"
  , commandSynopsis :: String
commandSynopsis     = String
"Updates list of known packages."
  , commandUsage :: String -> String
commandUsage        = String -> [String] -> String -> String
usageAlternatives String
"v2-update" [ String
"[FLAGS] [REPOS]" ]
  , commandDescription :: Maybe (String -> String)
commandDescription  = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ \String
_ -> String -> String
wrapText forall a b. (a -> b) -> a -> b
$
          String
"For all known remote repositories, download the package list."

  , commandNotes :: Maybe (String -> String)
commandNotes        = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ \String
pname ->
        String
"REPO has the format <repo-id>[,<index-state>] where index-state follows\n"
     forall a. [a] -> [a] -> [a]
++ String
"the same format and syntax that is supported by the --index-state flag.\n\n"
     forall a. [a] -> [a] -> [a]
++ String
"Examples:\n"
     forall a. [a] -> [a] -> [a]
++ String
"  " forall a. [a] -> [a] -> [a]
++ String
pname forall a. [a] -> [a] -> [a]
++ String
" v2-update\n"
     forall a. [a] -> [a] -> [a]
++ String
"    Download the package list for all known remote repositories.\n\n"
     forall a. [a] -> [a] -> [a]
++ String
"  " forall a. [a] -> [a] -> [a]
++ String
pname forall a. [a] -> [a] -> [a]
++ String
" v2-update hackage.haskell.org,@1474732068\n"
     forall a. [a] -> [a] -> [a]
++ String
"  " forall a. [a] -> [a] -> [a]
++ String
pname forall a. [a] -> [a] -> [a]
++ String
" v2-update hackage.haskell.org,2016-09-24T17:47:48Z\n"
     forall a. [a] -> [a] -> [a]
++ String
"  " forall a. [a] -> [a] -> [a]
++ String
pname forall a. [a] -> [a] -> [a]
++ String
" v2-update hackage.haskell.org,HEAD\n"
     forall a. [a] -> [a] -> [a]
++ String
"  " forall a. [a] -> [a] -> [a]
++ String
pname forall a. [a] -> [a] -> [a]
++ String
" v2-update hackage.haskell.org\n"
     forall a. [a] -> [a] -> [a]
++ String
"    Download hackage.haskell.org at a specific index state.\n\n"
     forall a. [a] -> [a] -> [a]
++ String
"  " forall a. [a] -> [a] -> [a]
++ String
pname forall a. [a] -> [a] -> [a]
++ String
" v2-update hackage.haskell.org head.hackage\n"
     forall a. [a] -> [a] -> [a]
++ String
"    Download hackage.haskell.org and head.hackage\n"
     forall a. [a] -> [a] -> [a]
++ String
"    head.hackage must be a known repo-id. E.g. from\n"
     forall a. [a] -> [a] -> [a]
++ String
"    your cabal.project(.local) file.\n"

  , commandOptions :: ShowOrParseArgs -> [OptionField (NixStyleFlags ())]
commandOptions      = forall a.
(ShowOrParseArgs -> [OptionField a])
-> ShowOrParseArgs -> [OptionField (NixStyleFlags a)]
nixStyleOptions forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> a
const []
  , commandDefaultFlags :: NixStyleFlags ()
commandDefaultFlags = forall a. a -> NixStyleFlags a
defaultNixStyleFlags ()
  }

data UpdateRequest = UpdateRequest
  { UpdateRequest -> RepoName
_updateRequestRepoName  :: RepoName
  , UpdateRequest -> RepoIndexState
_updateRequestRepoState :: RepoIndexState
  } deriving (Int -> UpdateRequest -> String -> String
[UpdateRequest] -> String -> String
UpdateRequest -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [UpdateRequest] -> String -> String
$cshowList :: [UpdateRequest] -> String -> String
show :: UpdateRequest -> String
$cshow :: UpdateRequest -> String
showsPrec :: Int -> UpdateRequest -> String -> String
$cshowsPrec :: Int -> UpdateRequest -> String -> String
Show)

instance Pretty UpdateRequest where
    pretty :: UpdateRequest -> Doc
pretty (UpdateRequest RepoName
n RepoIndexState
s) = forall a. Pretty a => a -> Doc
pretty RepoName
n Doc -> Doc -> Doc
<<>> Doc
Disp.comma Doc -> Doc -> Doc
<<>> forall a. Pretty a => a -> Doc
pretty RepoIndexState
s

instance Parsec UpdateRequest where
  parsec :: forall (m :: * -> *). CabalParsing m => m UpdateRequest
parsec = do
      RepoName
name <- forall a (m :: * -> *). (Parsec a, CabalParsing m) => m a
parsec
      RepoIndexState
state <- forall (m :: * -> *). CharParsing m => Char -> m Char
P.char Char
',' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall a (m :: * -> *). (Parsec a, CabalParsing m) => m a
parsec forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *) a. Applicative f => a -> f a
pure RepoIndexState
IndexStateHead
      forall (m :: * -> *) a. Monad m => a -> m a
return (RepoName -> RepoIndexState -> UpdateRequest
UpdateRequest RepoName
name RepoIndexState
state)

updateAction :: NixStyleFlags () -> [String] -> GlobalFlags -> IO ()
updateAction :: NixStyleFlags () -> [String] -> GlobalFlags -> IO ()
updateAction flags :: NixStyleFlags ()
flags@NixStyleFlags {()
ConfigFlags
HaddockFlags
TestFlags
BenchmarkFlags
ProjectFlags
InstallFlags
ConfigExFlags
extraFlags :: forall a. NixStyleFlags a -> a
projectFlags :: forall a. NixStyleFlags a -> ProjectFlags
benchmarkFlags :: forall a. NixStyleFlags a -> BenchmarkFlags
testFlags :: forall a. NixStyleFlags a -> TestFlags
haddockFlags :: forall a. NixStyleFlags a -> HaddockFlags
installFlags :: forall a. NixStyleFlags a -> InstallFlags
configExFlags :: forall a. NixStyleFlags a -> ConfigExFlags
configFlags :: forall a. NixStyleFlags a -> ConfigFlags
extraFlags :: ()
projectFlags :: ProjectFlags
benchmarkFlags :: BenchmarkFlags
testFlags :: TestFlags
haddockFlags :: HaddockFlags
installFlags :: InstallFlags
configExFlags :: ConfigExFlags
configFlags :: ConfigFlags
..} [String]
extraArgs GlobalFlags
globalFlags = do
  let ignoreProject :: Flag Bool
ignoreProject = ProjectFlags -> Flag Bool
flagIgnoreProject ProjectFlags
projectFlags

  ProjectConfig
projectConfig <- forall a.
Verbosity
-> Flag Bool
-> Flag String
-> IO a
-> (ProjectConfig -> IO a)
-> IO a
withProjectOrGlobalConfig Verbosity
verbosity Flag Bool
ignoreProject Flag String
globalConfigFlag
    (ProjectBaseContext -> ProjectConfig
projectConfig forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Verbosity
-> ProjectConfig -> CurrentCommand -> IO ProjectBaseContext
establishProjectBaseContext Verbosity
verbosity ProjectConfig
cliConfig CurrentCommand
OtherCommand)
    (\ProjectConfig
globalConfig -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ ProjectConfig
globalConfig forall a. Semigroup a => a -> a -> a
<> ProjectConfig
cliConfig)

  forall a.
Verbosity
-> ProjectConfigShared
-> ProjectConfigBuildOnly
-> (RepoContext -> IO a)
-> IO a
projectConfigWithSolverRepoContext Verbosity
verbosity
    (ProjectConfig -> ProjectConfigShared
projectConfigShared ProjectConfig
projectConfig) (ProjectConfig -> ProjectConfigBuildOnly
projectConfigBuildOnly ProjectConfig
projectConfig)
    forall a b. (a -> b) -> a -> b
$ \RepoContext
repoCtxt -> do

    let repos :: [Repo]
        repos :: [Repo]
repos = RepoContext -> [Repo]
repoContextRepos RepoContext
repoCtxt

        parseArg :: String -> IO UpdateRequest
        parseArg :: String -> IO UpdateRequest
parseArg String
s = case forall a. Parsec a => String -> Maybe a
simpleParsec String
s of
          Just UpdateRequest
r -> forall (m :: * -> *) a. Monad m => a -> m a
return UpdateRequest
r
          Maybe UpdateRequest
Nothing -> forall a. Verbosity -> String -> IO a
die' Verbosity
verbosity forall a b. (a -> b) -> a -> b
$
                     String
"'v2-update' unable to parse repo: \"" forall a. [a] -> [a] -> [a]
++ String
s forall a. [a] -> [a] -> [a]
++ String
"\""

    [UpdateRequest]
updateRepoRequests <- forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse String -> IO UpdateRequest
parseArg [String]
extraArgs

    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [UpdateRequest]
updateRepoRequests) forall a b. (a -> b) -> a -> b
$ do
      let remoteRepoNames :: [RepoName]
remoteRepoNames = forall a b. (a -> b) -> [a] -> [b]
map Repo -> RepoName
repoName [Repo]
repos
          unknownRepos :: [RepoName]
unknownRepos = [RepoName
r | (UpdateRequest RepoName
r RepoIndexState
_) <- [UpdateRequest]
updateRepoRequests
                            , Bool -> Bool
not (RepoName
r forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [RepoName]
remoteRepoNames)]
      forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [RepoName]
unknownRepos) forall a b. (a -> b) -> a -> b
$
        forall a. Verbosity -> String -> IO a
die' Verbosity
verbosity forall a b. (a -> b) -> a -> b
$ String
"'v2-update' repo(s): \""
                         forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [[a]] -> [a]
intercalate String
"\", \"" (forall a b. (a -> b) -> [a] -> [b]
map RepoName -> String
unRepoName [RepoName]
unknownRepos)
                         forall a. [a] -> [a] -> [a]
++ String
"\" can not be found in known remote repo(s): "
                         forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [[a]] -> [a]
intercalate String
", " (forall a b. (a -> b) -> [a] -> [b]
map RepoName -> String
unRepoName [RepoName]
remoteRepoNames)

    let reposToUpdate :: [(Repo, RepoIndexState)]
        reposToUpdate :: [(Repo, RepoIndexState)]
reposToUpdate = case [UpdateRequest]
updateRepoRequests of
          -- If we are not given any specific repository, update all
          -- repositories to HEAD.
          [] -> forall a b. (a -> b) -> [a] -> [b]
map (,RepoIndexState
IndexStateHead) [Repo]
repos
          [UpdateRequest]
updateRequests -> let repoMap :: [(RepoName, Repo)]
repoMap = [(Repo -> RepoName
repoName Repo
r, Repo
r) | Repo
r <- [Repo]
repos]
                                lookup' :: RepoName -> Repo
lookup' RepoName
k = forall a. HasCallStack => Maybe a -> a
Unsafe.fromJust (forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup RepoName
k [(RepoName, Repo)]
repoMap)
                            in [ (RepoName -> Repo
lookup' RepoName
name, RepoIndexState
state)
                               | (UpdateRequest RepoName
name RepoIndexState
state) <- [UpdateRequest]
updateRequests ]

    case [(Repo, RepoIndexState)]
reposToUpdate of
      [] ->
        Verbosity -> String -> IO ()
notice Verbosity
verbosity String
"No remote repositories configured"
      [(Repo
remoteRepo, RepoIndexState
_)] ->
        Verbosity -> String -> IO ()
notice Verbosity
verbosity forall a b. (a -> b) -> a -> b
$ String
"Downloading the latest package list from "
                        forall a. [a] -> [a] -> [a]
++ RepoName -> String
unRepoName (Repo -> RepoName
repoName Repo
remoteRepo)
      [(Repo, RepoIndexState)]
_ -> Verbosity -> String -> IO ()
notice Verbosity
verbosity forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
unlines
              forall a b. (a -> b) -> a -> b
$ String
"Downloading the latest package lists from: "
              forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map ((String
"- " forall a. [a] -> [a] -> [a]
++) forall b c a. (b -> c) -> (a -> b) -> a -> c
. RepoName -> String
unRepoName forall b c a. (b -> c) -> (a -> b) -> a -> c
. Repo -> RepoName
repoName forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) [(Repo, RepoIndexState)]
reposToUpdate

    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Repo, RepoIndexState)]
reposToUpdate) forall a b. (a -> b) -> a -> b
$ do
      JobControl IO ()
jobCtrl <- forall a. WithCallStack (Int -> IO (JobControl IO a))
newParallelJobControl (forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Repo, RepoIndexState)]
reposToUpdate)
      forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (forall (m :: * -> *) a. JobControl m a -> m a -> m ()
spawnJob JobControl IO ()
jobCtrl forall b c a. (b -> c) -> (a -> b) -> a -> c
. Verbosity
-> UpdateFlags -> RepoContext -> (Repo, RepoIndexState) -> IO ()
updateRepo Verbosity
verbosity UpdateFlags
defaultUpdateFlags RepoContext
repoCtxt)
        [(Repo, RepoIndexState)]
reposToUpdate
      forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (\(Repo, RepoIndexState)
_ -> forall (m :: * -> *) a. JobControl m a -> m a
collectJob JobControl IO ()
jobCtrl) [(Repo, RepoIndexState)]
reposToUpdate

  where
    verbosity :: Verbosity
verbosity = forall a. a -> Flag a -> a
fromFlagOrDefault Verbosity
normal (ConfigFlags -> Flag Verbosity
configVerbosity ConfigFlags
configFlags)
    cliConfig :: ProjectConfig
cliConfig = forall a.
GlobalFlags
-> NixStyleFlags a -> ClientInstallFlags -> ProjectConfig
commandLineFlagsToProjectConfig GlobalFlags
globalFlags NixStyleFlags ()
flags forall a. Monoid a => a
mempty -- ClientInstallFlags, not needed here
    globalConfigFlag :: Flag String
globalConfigFlag = ProjectConfigShared -> Flag String
projectConfigConfigFile (ProjectConfig -> ProjectConfigShared
projectConfigShared ProjectConfig
cliConfig)

updateRepo :: Verbosity -> UpdateFlags -> RepoContext -> (Repo, RepoIndexState)
           -> IO ()
updateRepo :: Verbosity
-> UpdateFlags -> RepoContext -> (Repo, RepoIndexState) -> IO ()
updateRepo Verbosity
verbosity UpdateFlags
_updateFlags RepoContext
repoCtxt (Repo
repo, RepoIndexState
indexState) = do
  HttpTransport
transport <- RepoContext -> IO HttpTransport
repoContextGetTransport RepoContext
repoCtxt
  case Repo
repo of
    RepoLocalNoIndex{} -> do
      let index :: Index
index = RepoContext -> Repo -> Index
RepoIndex RepoContext
repoCtxt Repo
repo
      Verbosity -> Index -> IO ()
updatePackageIndexCacheFile Verbosity
verbosity Index
index

    RepoRemote{String
RemoteRepo
repoRemote :: Repo -> RemoteRepo
repoLocalDir :: Repo -> String
repoLocalDir :: String
repoRemote :: RemoteRepo
..} -> do
      DownloadResult
downloadResult <- HttpTransport
-> Verbosity -> RemoteRepo -> String -> IO DownloadResult
downloadIndex HttpTransport
transport Verbosity
verbosity
                        RemoteRepo
repoRemote String
repoLocalDir
      case DownloadResult
downloadResult of
        DownloadResult
FileAlreadyInCache ->
          String -> UTCTime -> IO ()
setModificationTime (Repo -> String
indexBaseName Repo
repo String -> String -> String
<.> String
"tar")
          forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO UTCTime
getCurrentTime
        FileDownloaded String
indexPath -> do
          String -> ByteString -> IO ()
writeFileAtomic (String -> String
dropExtension String
indexPath) forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
maybeDecompress
                                                  forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< String -> IO ByteString
BS.readFile String
indexPath
          Verbosity -> Index -> IO ()
updateRepoIndexCache Verbosity
verbosity (RepoContext -> Repo -> Index
RepoIndex RepoContext
repoCtxt Repo
repo)
    RepoSecure{} -> RepoContext
-> forall a.
   Repo -> (forall (down :: * -> *). Repository down -> IO a) -> IO a
repoContextWithSecureRepo RepoContext
repoCtxt Repo
repo forall a b. (a -> b) -> a -> b
$ \Repository down
repoSecure -> do
      let index :: Index
index = RepoContext -> Repo -> Index
RepoIndex RepoContext
repoCtxt Repo
repo
      -- NB: This may be a nullTimestamp if we've never updated before
      Timestamp
current_ts <- Verbosity -> RepoContext -> Repo -> IO Timestamp
currentIndexTimestamp (Verbosity -> Verbosity
lessVerbose Verbosity
verbosity) RepoContext
repoCtxt Repo
repo
      -- NB: always update the timestamp, even if we didn't actually
      -- download anything
      Index -> RepoIndexState -> IO ()
writeIndexTimestamp Index
index RepoIndexState
indexState
      Maybe UTCTime
ce <- if RepoContext -> Bool
repoContextIgnoreExpiry RepoContext
repoCtxt
              then forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` IO UTCTime
getCurrentTime
              else forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
      HasUpdates
updated <- forall a.
((Throws VerificationError, Throws SomeRemoteError,
  Throws InvalidPackageException) =>
 IO a)
-> IO a
Sec.uncheckClientErrors forall a b. (a -> b) -> a -> b
$ forall (down :: * -> *).
(Throws VerificationError, Throws SomeRemoteError) =>
Repository down -> Maybe UTCTime -> IO HasUpdates
Sec.checkForUpdates Repository down
repoSecure Maybe UTCTime
ce
      -- this resolves indexState (which could be HEAD) into a timestamp
      Timestamp
new_ts <- Verbosity -> RepoContext -> Repo -> IO Timestamp
currentIndexTimestamp (Verbosity -> Verbosity
lessVerbose Verbosity
verbosity) RepoContext
repoCtxt Repo
repo
      let rname :: RepoName
rname = RemoteRepo -> RepoName
remoteRepoName (Repo -> RemoteRepo
repoRemote Repo
repo)

      -- Update cabal's internal index as well so that it's not out of sync
      -- (If all access to the cache goes through hackage-security this can go)
      case HasUpdates
updated of
        HasUpdates
Sec.NoUpdates  -> do
          UTCTime
now <- IO UTCTime
getCurrentTime
          String -> UTCTime -> IO ()
setModificationTime (Repo -> String
indexBaseName Repo
repo String -> String -> String
<.> String
"tar") UTCTime
now forall a. IO a -> (IOException -> IO a) -> IO a
`catchIO`
             (\IOException
e -> Verbosity -> String -> IO ()
warn Verbosity
verbosity forall a b. (a -> b) -> a -> b
$ String
"Could not set modification time of index tarball -- " forall a. [a] -> [a] -> [a]
++ forall e. Exception e => e -> String
displayException IOException
e)
          Verbosity -> String -> IO ()
noticeNoWrap Verbosity
verbosity forall a b. (a -> b) -> a -> b
$
            String
"Package list of " forall a. [a] -> [a] -> [a]
++ forall a. Pretty a => a -> String
prettyShow RepoName
rname forall a. [a] -> [a] -> [a]
++ String
" is up to date."

        HasUpdates
Sec.HasUpdates -> do
          Verbosity -> Index -> IO ()
updateRepoIndexCache Verbosity
verbosity Index
index
          Verbosity -> String -> IO ()
noticeNoWrap Verbosity
verbosity forall a b. (a -> b) -> a -> b
$
            String
"Package list of " forall a. [a] -> [a] -> [a]
++ forall a. Pretty a => a -> String
prettyShow RepoName
rname forall a. [a] -> [a] -> [a]
++ String
" has been updated."

      Verbosity -> String -> IO ()
noticeNoWrap Verbosity
verbosity forall a b. (a -> b) -> a -> b
$
        String
"The index-state is set to " forall a. [a] -> [a] -> [a]
++ forall a. Pretty a => a -> String
prettyShow (Timestamp -> RepoIndexState
IndexStateTime Timestamp
new_ts) forall a. [a] -> [a] -> [a]
++ String
"."

      -- TODO: This will print multiple times if there are multiple
      -- repositories: main problem is we don't have a way of updating
      -- a specific repo.  Once we implement that, update this.

      -- In case current_ts is a valid timestamp different from new_ts, let
      -- the user know how to go back to current_ts
      forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Timestamp
current_ts forall a. Eq a => a -> a -> Bool
/= Timestamp
nullTimestamp Bool -> Bool -> Bool
&& Timestamp
new_ts forall a. Eq a => a -> a -> Bool
/= Timestamp
current_ts) forall a b. (a -> b) -> a -> b
$
        Verbosity -> String -> IO ()
noticeNoWrap Verbosity
verbosity forall a b. (a -> b) -> a -> b
$
          String
"To revert to previous state run:\n" forall a. [a] -> [a] -> [a]
++
          String
"    cabal v2-update '" forall a. [a] -> [a] -> [a]
++ forall a. Pretty a => a -> String
prettyShow (RepoName -> RepoIndexState -> UpdateRequest
UpdateRequest RepoName
rname (Timestamp -> RepoIndexState
IndexStateTime Timestamp
current_ts)) forall a. [a] -> [a] -> [a]
++ String
"'\n"