Update.hs

{-# LANGUAGE CPP #-}

-- |
-- Module      :  Commands.Update
-- Copyright   :  (C) 2014-2020  Jens Petersen
--
-- Maintainer  :  Jens Petersen <petersen@fedoraproject.org>
-- Stability   :  alpha
--
-- Explanation: update spec file to a new package version

-- This program is free software: you can redistribute it and/or modify
-- it under the terms of the GNU General Public License as published by
-- the Free Software Foundation, either version 3 of the License, or
-- (at your option) any later version.

module Commands.Update (
  update
  ) where

import Commands.Spec (createSpecFile)
import Header (headerOption, withSpecHead)
import PackageUtils (PackageData (..), bringTarball, editSpecField,
                     getRevisedCabal, getSpecField, latestPackage,
                     patchSpec, pkgSpecPkgData, prepare)
import Stackage (defaultLTS)
import SysCmd (die)
import Types

import SimpleCabal (PackageDescription (customFieldsPD, package),
                    PackageIdentifier (..), showVersion)
import SimpleCmd (cmd_, error', grep_, shell_, (+-+))
import SimpleCmd.Git (grepGitConfig, rwGitDir)
#if (defined(MIN_VERSION_base) && MIN_VERSION_base(4,8,0))
#else
import Control.Applicative ((<$>))
#endif
import Control.Monad (unless, when)
import Data.Maybe (isJust)
import Distribution.Text (display)
import Distribution.Verbosity (silent)
import System.Directory (createDirectoryIfMissing, doesDirectoryExist,
                         removeDirectoryRecursive, renameFile)
import System.FilePath ((<.>))

update :: Maybe PackageVersionSpecifier -> IO ()
update mpvs = do
  pkgdata <- pkgSpecPkgData [] (pvsPackage =<< mpvs) True
  case specFilename pkgdata of
    Nothing -> die "No (unique) .spec file in directory."
    Just spec -> do
      let pkgDesc = packageDesc pkgdata
          oldPkgId = package pkgDesc
          name = pkgName oldPkgId
          wasrevised = isJust $ lookup "x-revision" (customFieldsPD pkgDesc)
      putStrLn $ display oldPkgId +-+ "->"
      (newPkgId, mstream) <-
        case mpvs of
          Nothing -> do
            stream <-
              withSpecHead spec $ \ headerwords -> do
              let mspecstream = read <$> headerOption "--stream" headerwords
              case mspecstream of
                Just specStream -> do
                  putStrLn $ "Using stream" +-+ showStream specStream  +-+ "from spec file"
                  when (specStream <= defaultLTS) $
                    putStrLn $ "Warning: < current default stream" +-+ showStream defaultLTS
                Nothing -> return ()
              return mspecstream
            latest <- latestPackage stream name
            return (latest, stream)
          Just pvs ->
            case pvs of
              PVStreamPackage stream mpkg ->
                case mpkg of
                  Just pkg | pkg /= name -> error' "different package name"
                  _ -> do
                    latest <- latestPackage (Just stream) name
                    return (latest, Just stream)
              PVPackageId pkgid -> return (pkgid, Nothing)
              PVPackageName pkg -> do
                latest <- latestPackage Nothing pkg
                return (latest, Nothing)

      let newver = pkgVersion newPkgId
          oldver = pkgVersion oldPkgId
          updated = newver > oldver
      if newver < oldver
        then putStrLn $ "current" +-+ display oldver +-+ "is newer!"
        else do
        newrev <- getRevisedCabal newPkgId
        unless updated $
          putStrLn "Package is already latest version."
        when (newrev || updated) $ do
          subpkg <- grep_ "%{subpkgs}" spec
          (curspec, _) <- createSpecVersion oldPkgId spec wasrevised (if subpkg then Just Nothing else Nothing)
          (newspec, newrevised) <- createSpecVersion newPkgId spec True (if subpkg then Just mstream else Nothing)
          currel <- getSpecField "Release" spec
          let suffix = "%{?dist}"
              defrelease = "1"
          editSpecField "Release" (defrelease ++ suffix) spec
          patchSpec False Nothing curspec newspec
          ver' <- readVersion <$> getSpecField "Version" spec
          when (ver' /= newver) $
            editSpecField "Version" (showVersion newver) spec
          if updated && not subpkg
            then editSpecField "Release" (defrelease ++ suffix) spec
            else editSpecField "Release" (currel ++ suffix) spec
          when updated $ do
            -- FIXME reset when all subpkgs updated
            unless subpkg $
              editSpecField "Release" ("0" ++ suffix) spec
            cmd_ "rpmdev-bumpspec" ["-c", "update to" +-+ showVersion newver, spec]
            rwGit <- rwGitDir
            when (rwGit && subpkg) $ do
              cmd_ "cp" ["-p", "sources", "sources.cblrpm"]
              cmd_ "sed" ["-i", "/" ++ display oldPkgId <.> "tar.gz" ++ "/d", "sources.cblrpm"]
            bringTarball newPkgId False (Just spec)
            distgit <- grepGitConfig "\\(pkgs\\|src\\)."
            when (rwGit && distgit) $ do
              cmd_ "fedpkg" ["new-sources", display newPkgId <.> "tar.gz"]
              when subpkg $ do
                shell_ $ "cat sources >>" +-+ "sources.cblrpm"
                renameFile "sources.cblrpm" "sources"
              when newrevised $
                cmd_ "git" ["add", display newPkgId <.> "cabal"]
              when wasrevised $
                cmd_ "git" ["rm", display oldPkgId <.> "cabal"]
              cmd_ "git" ["commit", "-a", "-m", "update to" +-+ showVersion newver]
  where
    -- Just Nothing is default stream
    createSpecVersion :: PackageIdentifier -> String -> Bool -> Maybe (Maybe Stream) -> IO (FilePath, Bool)
    createSpecVersion pkgid spec revise subpkgStream = do
      pd <- prepare [] (streamPkgToPVS Nothing (Just pkgid)) revise
      let pkgdata = pd { specFilename = Just spec }
          dir = ".Cblrpm/" ++ display pkgid ++ if revise then ".revised" else ".orig"
      direxists <- doesDirectoryExist dir
      when direxists $ removeDirectoryRecursive dir
      createDirectoryIfMissing True dir
      newspec <- createSpecFile silent [] False False (SpecFile spec) subpkgStream (Just dir) (streamPkgToPVS Nothing (Just pkgid))
      let newrevised =
            isJust $ lookup "x-revision" (customFieldsPD (packageDesc pkgdata))
      return (newspec, newrevised)