fhpkg.hs

{-# LANGUAGE CPP #-}

-- |
-- Module      :  Packages
-- Copyright   :  (C) 2017-2019  Jens Petersen
--
-- Maintainer  :  Jens Petersen <petersen@fedoraproject.org>
-- Stability   :  alpha
--
-- Explanation: Cloning and pulling package git repos

-- 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.

#if (defined(MIN_VERSION_base) && MIN_VERSION_base(4,13,0))
#else
import Control.Applicative (optional, some, (<|>)
#if (defined(MIN_VERSION_base) && MIN_VERSION_base(4,8,0))
#else
                           , pure, (<$>), (<*>)
#endif
                           )
#endif
import Control.Monad (filterM, unless, when, (>=>))
import Control.Monad.Extra (mapMaybeM, unlessM, whenJustM)
import qualified Data.ByteString.Char8 as B
import qualified Data.ByteString.Lazy.Char8 as BL
import Data.Char (isDigit)
import Data.Maybe
import Data.List

import Data.List.Split (splitOn)
import Network.HTTP.Simple
import Network.HTTP.Types
import System.Directory (doesDirectoryExist, doesFileExist,
                         getCurrentDirectory, getHomeDirectory,
#if (defined(MIN_VERSION_directory) && MIN_VERSION_directory(1,2,5))
                         listDirectory,
#else
                         getDirectoryContents,
#endif
                         setCurrentDirectory)
import System.FilePath ((</>), (<.>), takeFileName)
import System.IO (BufferMode(..), hIsTerminalDevice, hSetBuffering, stdout)
--import System.Posix.Env (getEnv)
import Text.CSV (parseCSV)

import Distribution.Fedora (Dist(..), distBranch, distRepo, distUpdates,
                            getLatestFedoraDist, getRawhideDist)
--import Distribution.Fedora.Branch (Branch(..))

import SimpleCmd
#if !MIN_VERSION_simple_cmd(0,2,3)
import System.Exit
import qualified System.Process as P
#endif
import SimpleCmd.Git
import SimpleCmdArgs

import Build (build, readBuildCmd)
import Dist (distArg, distRemote, hackageRelease, ltsStream)
import Koji (rpkg)
import Paths_fedora_haskell_tools (version)
import RPM (buildRequires, haskellSrcPkgs, Package, pkgDir,
            repoquery, rpmspec, rqfnewline)
import Utils (checkPkgsGit, withCurrentDirectory)

#if (defined(MIN_VERSION_directory) && MIN_VERSION_directory(1,2,5))
#else
listDirectory :: FilePath -> IO [FilePath]
listDirectory path =
  filter f <$> getDirectoryContents path
  where f filename = filename /= "." && filename /= ".."
#endif

main :: IO ()
main = do
  hSetBuffering stdout NoBuffering
  cwd <- getCurrentDirectory
  branched <- getLatestFedoraDist
  simpleCmdArgs (Just version) "Fedora Haskell packages tool"
    "Fedora packages maintenance tool" $
    subcommands . sort $
    [ Subcommand "checkout" "fedpkg switch-branch" $
      repoAction_ branched True False (return ()) <$> distArg <*> pkgArgs
    , Subcommand "clone"  "clone repos" $
      clone branched <$> branching <*> distArg <*> pkgArgs
    , Subcommand "clone-new" "clone new packages" $
      cloneNew branched <$> branching <*> distArg
    , Subcommand "cblrpm" "Run cblrpm command" $
      cblrpm branched <$> strOptionWith 'c' "cmd" "CMD" "command to execute" <*> distArg <*> pkgArgs
    , Subcommand "cmd" "arbitrary command (with args)" $
      execCmd branched <$> strOptionWith 'c' "cmd" "CMD" "command to execute" <*> distArg <*> pkgArgs
    , Subcommand "count" "count number of packages" $
      (repoqueryHaskellPkgs branched False >=> (print . length)) <$> distArg
    , Subcommand "depends" "cabal-depends" $
      repoAction branched False (Output cabalDepends) <$> distArg <*> pkgArgs
    , Subcommand "diff" "git diff" $
      gitDiff branched <$> optional gitFormat
      <*> optional (strOptionWith 'w' "with-branch" "BRANCH" "Branch to compare")
      <*> distArg <*> pkgArgs
    , Subcommand "diff-origin" "git diff origin" $
      gitDiffOrigin branched <$> distArg <*> pkgArgs
--    , Subcommand "diff-branch" "compare branch with master" $
--      repoAction branched True (Header False compareRawhide) <$> distArg <*> pkgArgs
    , Subcommand "diffstat" "Show diffstat output" $
      repoAction branched False (Output (const diffStat)) <$> distArg <*> pkgArgs
    , Subcommand "hackage-upload" "upload Hackage distro data" $
      hackageUpload branched <$> switchRefresh
    , Subcommand "hackage-compare" "compare with Hackage distro data" $
      hackageCompare branched <$> switchRefresh
    -- more or less the same as 'pushed'
    , Subcommand "head-origin" "packages with head in sync with origin" $
      headOrigin branched <$> distArg <*> pkgArgs
    , Subcommand "leaf" "list leaf packages (slow!)" $
      leaves branched <$> switchWith 'v' "deps" "show also deps" <*> distArg <*> pkgArgs
    , Subcommand "list" "list packages that BR ghc-Cabal-devel" $
      (repoqueryHaskellPkgs branched False >=> putStrList) <$> distArg
    , Subcommand "merge" "git merge" $
      merge branched <$> strOptionWith 'f' "from" "BRANCH" "specify branch to merge from" <*> distArg <*> pkgArgs
    , Subcommand "missing" "missing dependency source packages" $
      missingDeps branched <$> distArg <*> pkgArgs
    , Subcommand "new" "unbuilt packages" $
      (newPackages branched >=> putStrList) <$> distArg
    , Subcommand "old-packages" "packages not in repoquery" $
      oldPackages branched <$> distArg <*> pkgArgs
    , Subcommand "prep" "fedpkg prep" $
      prep branched <$> distArg <*> pkgArgs
    , Subcommand "stackage-compare" "compare with stackage" $
      stackageCompare branched <$> streamOpt <*> stackageOpts <*> distArg <*> pkgArgs
    , Subcommand "commit" "fedpkg commit" $
      commit branched <$> strOptionWith 'm' "message" "COMMITMSG" "commit message" <*> distArg <*> pkgArgs
    , Subcommand "fetch" "git fetch repos" $
      repoAction_ branched True False (git_ "fetch" []) <$> distArg <*> pkgArgs
    , Subcommand "pull" "git pull repos" $
      repoAction_ branched True False (git_ "pull" ["--rebase"]) <$> distArg <*> pkgArgs
    , Subcommand "push" "git push repos" $
      repoAction_ branched True False (git_ "push" []) <$> distArg <*> pkgArgs
    , Subcommand "pushed" "show git pushed packages" $
      pushed branched <$> distArg <*> pkgArgs
    , Subcommand "refresh" "cabal-rpm refresh" $
      refresh branched <$> switchWith 'n' "dry-run" "Show patch but don't apply" <*> distArg <*> pkgArgs
    , Subcommand "remaining" "remaining packages to be built in TAG" $
      remaining <$> switchWith 'c' "count" "show many packages left" <*> strArg "TAG" <*> pkgArgs
    , Subcommand "subpkgs" "list subpackages" $
      repoAction branched True (Header True (\ p -> rpmspec [] (Just "%{name}-%{version}") (p <.> "spec") >>= putStrList)) <$> distArg <*> pkgArgs
    , Subcommand "subpackaged" "list subpackaged libraries" $
      subpackaged branched <$> switchWith 'V' "show-versions" "Show versions" <*> distArg <*> pkgArgs
    , Subcommand "tagged" "list koji DIST tagged builds" $
      listTagged_ <$> switchWith 's' "short" "list packages not builds" <*> strArg "TAG"
    , Subcommand "unbranched" "packages without this branch" $
      unbranched branched <$> distArg <*> pkgArgs
    , Subcommand "unpushed" "show unpushed commits" $
      unpushed branched <$> switchWith 's' "short" "no log" <*> distArg <*> pkgArgs
    , Subcommand "update" "cabal-rpm update" $
      update branched <$> keepOpt <*> streamOpt <*> distArg <*> pkgArgs
    , Subcommand "verrel" "show nvr of packages" $
      verrel branched <$> distArg <*> pkgArgs] ++
    map (buildCmd cwd) [ ("install", "build locally and install")
                       , ("mock", "build in mock")
                       , ("chain", "build deps recursively in Koji")
                       , ("koji", "build in Koji (deprecated) without checking dependencies")
                       , ("pending", "show planned changes")
                       , ("changed", "show changed pkgs")
                       , ("built", "show pkgs whose NVR already built")
                       , ("bump", "bump release for NVRs already built")
                       , ("not-installed", "list packages not locally installed")
                       ]
  where
    pkgArgs = some (removeSuffix "/" <$> strArg "PKG...")

    branching = switchWith 'B' "branches" "clone branch dirs (fedpkg clone -B)"

    gitFormat :: Parser DiffFormat
    gitFormat =
      flagWith' DiffShort 's' "short" "Just output package name" <|>
      DiffContext <$> optionWith auto 'u' "unified" "CONTEXT" "Lines of context"

    buildCmd cwd (c, desc) =
      Subcommand c desc  $
      build cwd Nothing False (readBuildCmd c) <$> distArg <*> pkgArgs

    switchRefresh = switchWith 'r' "refresh" "repoquery --refresh"

    streamOpt = strOptionalWith 's' "stream" "STACKAGESTREAM" ("Stackage stream [" ++ ltsStream ++ "]") ltsStream

    stackageOpts :: Parser StkgOpt
    stackageOpts =
      flagWith' StkgMissing 'm' "missing" "only list missing packages" <|>
      flagWith StkgAll StkgOnly 'o' "only" "only Stackage packages"

    keepOpt = switchWith 'k' "keep-going" "Keep going after an error"

data DiffFormat =
  DiffShort | DiffContext Int
  deriving (Eq)

data StkgOpt = StkgAll | StkgOnly | StkgMissing
  deriving Eq

putStrList :: [String] -> IO ()
putStrList =
  putStr . unlines

-- should make separate rhel client so -B does not need dist
clone :: Dist -> Bool -> Dist -> [Package] -> IO ()
clone _ True dist pkgs = cloneAllBranches dist pkgs
clone branched False dist pkgs =
  repoAction_ branched True False (return ()) dist pkgs

cloneNew :: Dist -> Bool -> Dist -> IO ()
cloneNew branched True dist = do
  rawhide <- getRawhideDist
  newPackages branched rawhide >>= cloneAllBranches dist
cloneNew branched False dist =
  newPackages branched dist >>= repoAction_ branched True False (return ()) dist

execCmd :: Dist -> String -> Dist -> [Package] -> IO ()
execCmd _ "" _ _ = error "CMD string must be given"
execCmd branched cs dist pkgs =
  repoAction_ branched True True (shell_ cs) dist pkgs

gitDiff :: Dist -> Maybe DiffFormat -> Maybe String -> Dist -> [Package] -> IO ()
gitDiff branched (Just DiffShort) mbrnch =
  repoAction branched False (Header False doGitDiff)
  where
    doGitDiff pkg = do
      let branch = maybeToList mbrnch
      out <- git "diff" branch
      unless (null out) $ putStrLn pkg
gitDiff branched fmt mbrnch =
  repoAction branched False (Output (const doGitDiff))
  where
    doGitDiff = do
      let branch = maybeToList mbrnch
          contxt = case fmt of
                     (Just (DiffContext n)) -> ["--unified=" ++ show n]
                     _ -> []
      out <- git "diff" $ branch ++ contxt
      return $ if null out then "" else out

gitDiffOrigin :: Dist -> Dist -> [Package] -> IO ()
gitDiffOrigin branched dist =
  repoAction branched False (Output (const (git "diff" [distRemote branched dist]))) dist

-- FIXME option only to show PVP X.Y bumps or X.Y.Z bumps
stackageCompare :: Dist -> String -> StkgOpt -> Dist -> [Package] -> IO ()
stackageCompare branched stream opt dist =
  repoAction branched True (Header False compareStackage) dist
  where
    compareStackage :: Package -> IO ()
    compareStackage p = do
      nvr <- cmd (rpkg dist) ["verrel"]
      let hkg = removePrefix "ghc-" p
      (ok,_out,err) <- cmdFull "stack" ["--resolver" , stream, "list", hkg] ""
      -- FIXME rename to mstkgver?
      let stkg =
            if ok then
              case filter (not . ("Selected resolver:" `isPrefixOf`)) (lines err) of
                [nv] -> Just (removePrefix (hkg ++ "-") nv)
                _ -> Nothing
            else Nothing
      let same = isJust stkg && (fromJust stkg ++ "-") `isInfixOf` nvr
      unless same $
        if opt == StkgMissing
        then when (isNothing stkg) $ putStrLn p
        else
          if isNothing stkg
          then unless (opt == StkgOnly) $
               putStrLn $ stream ++ " missing: " ++ removePrefix "ghc-" p
          else do
            putStrLn nvr
            putStrLn $ replicate (length (dropVerrel nvr) + 1) ' ' ++ fromJust stkg +-+ "(" ++ stream ++ ")"

diffStat :: IO String
diffStat = git "diff" ["--stat"]

hackageUpload :: Dist -> Bool -> IO ()
hackageUpload branched refreshData = do
  csv <- repoqueryHackageCSV hackageRelease
  home <- getHomeDirectory
  [username, password] <- map B.pack . words <$> readFile (home </> ".fedora/hackage.auth")
  req <- setRequestBasicAuth username password .
         setRequestBodyLBS (BL.pack csv) .
         addRequestHeader hContentType (B.pack "text/csv") .
         setRequestMethod methodPut <$>
         parseRequestThrow "https://hackage.haskell.org/distro/Fedora/packages.csv"
  resp <- httpLbs req
  BL.putStrLn $ getResponseBody resp
  where
    repoqueryHackageCSV :: Dist -> IO String
    repoqueryHackageCSV dist = do
      pkgs <- repoqueryHackages branched hackageRelease
      -- Hackage csv chokes on a final newline
      intercalate "\n" . sort . map (replace "\"ghc-" "\"")  . lines <$>
        repoquery dist (["--repo=fedora", "--repo=updates", "--latest-limit=1", "--qf=\"%{name}\",\"%{version}\",\"https://src.fedoraproject.org/rpms/%{source_name}\"" ++ rqfnewline] ++ ["--refresh" | refreshData] ++ pkgs)

hackageCompare :: Dist -> Bool -> IO ()
hackageCompare branched refreshData =
  repoqueryHackages branched hackageRelease >>=
  compareHackage hackageRelease
  where
    compareHackage :: Dist -> [Package] -> IO ()
    compareHackage dist pkgs' = do
      req <- addRequestHeader hContentType (B.pack "text/csv") <$>
             parseRequestThrow "https://hackage.haskell.org/distro/Fedora/packages.csv"
      hck <- getResponseBody <$> httpLbs req
      let hackage = sort . either (error "Malformed Hackage csv") (map mungeHackage) $ parseCSV "packages.csv" (BL.unpack hck)
      repoquery dist (["--repo=fedora", "--repo=updates", "--latest-limit=1", "--qf=%{name},%{version}" ++ rqfnewline] ++ ["--refresh" | refreshData] ++ pkgs') >>=
        compareSets True hackage . sort . map mungeRepo . lines

    mungeHackage :: [String] -> PkgVer
    mungeHackage [n,v,_] = PV n v
    mungeHackage _ = error "Malformed Hackage csv"

    mungeRepo :: String -> PkgVer
    mungeRepo s | ',' `elem` s =
                  let (p,v) = break (== ',') s in
                    PV (removePrefix "ghc-" p) (tail v)
                | otherwise = error "Malformed repoquery output"

    compareSets :: Bool -> [PkgVer] -> [PkgVer] -> IO ()
    compareSets _ [] [] = return ()
    compareSets _ [] (f:fs) = do
      putStrLn (show f +-+ "(new)")
      compareSets False [] fs
    compareSets all' (h:hs) [] = do
      when all' $ putStrLn ("Removed:" +-+ show h)
      compareSets all' hs []
    compareSets all' (h:hs) (f:fs) | h == f = compareSets all' hs fs
                                   | h < f = do
                                       when all' $ putStrLn $ "Removed:" +-+ show h
                                       compareSets all' hs (f:fs)
                                   | h > f = do
                                       putStrLn $ show f +-+ "(new)"
                                       compareSets all' (h:hs) fs
                                   | otherwise = do
                                       putStrLn $ pvPkg h ++ ":" +-+ pvVer h +-+ "->" +-+ pvVer f
                                       compareSets all' hs fs

headOrigin :: Dist -> Dist -> [Package] -> IO ()
headOrigin branched dist =
  repoAction branched False (Header False gitHeadAtOrigin) dist
  where
    gitHeadAtOrigin :: Package -> IO ()
    gitHeadAtOrigin pkg = do
      -- use gitDiffQuiet
      same <- gitBool "diff" ["--quiet", distRemote branched dist ++ "..HEAD"]
      when same $ putStrLn pkg

-- FIXME does not take static requires into account
leaves :: Dist -> Bool -> Dist -> [Package] -> IO ()
leaves branched verb =
  repoAction branched True (Header verb checkLeafPkg)
  where
    -- FIXME: make a dependency cache
    checkLeafPkg :: Package -> IO ()
    checkLeafPkg pkg = do
      dir <- takeFileName <$> getCurrentDirectory
      let branchdir = dir /= pkg
          top = if branchdir then "../.." else ".."
          spec = pkg <.> "spec"
      subpkgs <- rpmspec ["--builtrpms"] (Just "%{name}") spec
      allpkgs <- listDirectory top
      let other = map (\ p -> top </> p </> (if branchdir then dir else "") </> p <.> "spec") $ allpkgs \\ [pkg]
      found <- filterM (dependsOn subpkgs) other
      if null found
        then putStrLn pkg
        else when verb $ putStrList found
        where
          dependsOn :: [Package] -> Package -> IO Bool
          dependsOn subpkgs p = do
            file <- doesFileExist p
            if file
              then do
              deps <- buildRequires p
              return $ any (`elem` deps) subpkgs
              else return False

merge :: Dist -> String -> Dist -> [Package] -> IO ()
merge branched branch =
  repoAction_ branched True False (git_ "merge" [branch])

missingDeps :: Dist -> Dist -> [Package] -> IO ()
missingDeps branched dist =
  repoAction branched True (Output checkForMissingDeps) dist
  where
    checkForMissingDeps :: Package -> IO String
    checkForMissingDeps pkg = do
      dir <- takeFileName <$> getCurrentDirectory
      let top = if dir == pkg then ".." else "../.."
          spec = pkg <.> "spec"
      hasSpec <- doesFileExist spec
      if hasSpec
        then do
        deps <- buildRequires (pkg <.> "spec") >>= haskellSrcPkgs top dist
        unlines <$> filterM (noPkgDir top) deps
        else putStrLn ("no " ++ pkg ++ ".spec file found!") >> return ""
        where
          noPkgDir :: FilePath -> Package -> IO Bool
          noPkgDir top dep =
            not <$> doesDirectoryExist (top </> dep)

oldPackages :: Dist -> Dist -> [Package] -> IO ()
oldPackages branched dist pkgs = do
  repopkgs <- repoqueryHaskellPkgs branched True dist
  putStrList (pkgs \\ repopkgs)

prep :: Dist -> Dist -> [Package] -> IO ()
prep branched dist =
  repoAction_ branched True True (cmd_ (rpkg dist) ["prep"]) dist

commit :: Dist -> String -> Dist -> [Package] -> IO ()
commit branched logmsg dist =
  repoAction branched False (Output (const commitChanges)) dist
  where
    commitChanges :: IO String
    commitChanges = do
      nochgs <- gitDiffQuiet []
      if nochgs
        then return ""
        else cmd (rpkg dist) ["commit", "-m", logmsg]

unpushed :: Dist -> Bool -> Dist -> [Package] -> IO ()
unpushed branched nolog dist =
  repoAction branched True (Header False gitLogOneLine) dist
  where
    gitLogOneLine :: Package -> IO ()
    gitLogOneLine pkg = do
      out <- git "log" [distRemote branched dist ++ "..HEAD", "--pretty=oneline"]
      unless (null out) $
        putStrLn $ pkg ++ if nolog then "" else (unwords . map replaceHash . words) out
        where
          replaceHash h = if length h /= 40 then h else ":"

pushed :: Dist -> Dist -> [Package] -> IO ()
pushed branched dist =
  repoAction branched True (Header False checkPushed) dist
  where
    checkPushed :: Package -> IO ()
    checkPushed pkg = do
      out <- git "log" [distRemote branched dist ++ "..HEAD", "--pretty=oneline"]
      when (null out) $ putStrLn pkg

verrel :: Dist -> Dist -> [Package] -> IO ()
verrel branched dist =
  repoAction_ branched False True (cmd_ (rpkg dist) ["verrel"]) dist

data PkgVer = PV { pvPkg :: String, pvVer :: String}
  deriving (Eq)

instance Show PkgVer
  where
    show (PV p v) = p ++ "-" ++ v

instance Ord PkgVer
  where
    compare (PV p _) (PV p' _) = compare p p'

replace :: Eq a => [a] -> [a] -> [a] -> [a]
replace a b s@(x:xs) =
  if a `isPrefixOf` s
  then b ++ replace a b (drop (length a) s)
  else x:replace a b xs
replace _ _ [] = []

repoqueryHaskellPkgs :: Dist -> Bool -> Dist -> IO [Package]
repoqueryHaskellPkgs branched verbose dist = do
  when verbose $ do
    tty <- hIsTerminalDevice stdout
    when tty $ warning "Getting packages from repoquery"
  let repo = distRepo branched dist
      updates = maybeToList $ distUpdates branched dist
  bin <- words <$> repoquery dist (["--repo=" ++ repo ++ "-source"] ++ ["--repo=" ++ u  ++ "-source" | u <- updates] ++ ["--qf=%{name}" ++ rqfnewline, "--whatrequires", "ghc-Cabal-*"])
  when (null bin) $ error "No packages using ghc-Cabal-devel found!"
  return $ sort $ filter (not . isGhcXY) $ nub bin
  where
    isGhcXY :: String -> Bool
    isGhcXY p = let prefix = head (splitOn "-" p)
                 in all (\c -> isDigit c || c == '.') (removePrefix "ghc" prefix)

repoqueryHackages :: Dist -> Dist -> IO [Package]
repoqueryHackages branched dist = do
  srcs <- repoqueryHaskellPkgs branched False dist
  libs <- repoqueryHaskellLibs False
  let binsrcs = filter (not . ("ghc-" `isPrefixOf`)) srcs
      sublibs = libs \\ map ("ghc-" ++) binsrcs
  return $ sort $ nub (delete "haskell-platform" srcs ++ sublibs)
  where
    repoqueryHaskellLibs :: Bool -> IO [Package]
    repoqueryHaskellLibs verbose = do
      when verbose $ putStrLn "Getting libraries from repoquery"
      let repo = distRepo branched dist
          updates = maybeToList $ distUpdates branched dist
      bin <- words <$> repoquery dist (["--repo=" ++ repo] ++ ["--repo=" ++ u | u <- updates] ++ ["--qf=%{name}" ++ rqfnewline, "--whatprovides", "libHS*-ghc*.so()(64bit)"])
      when (null bin) $ error "No libHS*.so providers found!"
      return $ sort $ filter ("ghc-" `isPrefixOf`) $ nub bin

newPackages :: Dist -> Dist -> IO [Package]
newPackages branched dist = do
  ps <- repoqueryHaskellPkgs branched True dist
  pps <- cmdLines "pagure" ["list", "--namespace", "rpms", "ghc*"]
  local <- listDirectory "."
  filterM (\ d -> not <$> doesFileExist (d </> "dead.package")) $ nub (pps ++ ps) \\ (local ++ ["Agda-stdlib", "ghc", "ghc-rpm-macros", "ghc-srpm-macros", "haskell-platform"])

haveSshKey :: IO Bool
haveSshKey = do
  home <- getHomeDirectory
  doesFileExist $ home </> ".ssh/id_rsa"

cloneAllBranches :: Dist -> [Package] -> IO ()
cloneAllBranches _ [] = return ()
cloneAllBranches dist (pkg:rest) = do
  withCurrentDirectory "." $ do
    putStrLn $ "\n==" +-+ pkg +-+ "=="
    -- muser <- getEnv "USER"
    haveSSH <- haveSshKey
    dirExists <- doesDirectoryExist pkg
    unless dirExists $
      cmd_ (rpkg dist) $ ["clone"] ++ ["-a" | not haveSSH] ++ ["-B", pkg]
    singleDir <- isGitDir pkg
    when singleDir $
      error "branch checkout already exists!"
  cloneAllBranches dist rest

data Action = Output (Package -> IO String) | Header Bool (Package -> IO ())

showHeader :: Action -> Bool
showHeader (Header b _) = b
showHeader (Output _) = False

repoAction :: Dist -> Bool -> Action -> Dist -> [Package] -> IO ()
repoAction _ _ _ _ [] = return ()
repoAction branched needsSpec action dist (pkg:rest) = do
  withCurrentDirectory "." $ do
    let branch = distBranch branched dist
    when (showHeader action) $
      putStrLn $ "\n==" +-+ pkg +-+ branch +-+ "=="
    -- muser <- getEnv "USER"
    haveSSH <- haveSshKey
    fileExists <- doesFileExist pkg
    if fileExists
      then error $ pkg +-+ "is a file"
      else do
      dirExists <- doesDirectoryExist pkg
      unless dirExists $
        cmd_ (rpkg dist) $ ["clone"] ++ ["-a" | not haveSSH] ++ ["-b", branch, pkg]
      singleDir <- isGitDir pkg
      unless singleDir $ do
        branchDir <- doesDirectoryExist $ pkg </> branch
        unless branchDir $
          withCurrentDirectory pkg $
          cmd_ (rpkg dist) ["clone", "-b", branch, pkg, branch]
      wd <- pkgDir pkg branch ""
      setCurrentDirectory wd
      pkggit <- do
        gd <- isGitDir "."
        if gd
          then checkPkgsGit
          else return False
      unless pkggit $
        error $ "not a Fedora pkg git dir!:" +-+ wd
      actual <- gitBranch
      when (branch /= actual) $
        whenJustM (cmdMaybe (rpkg dist) ["switch-branch", branch]) $ \ out ->
        when (showHeader action) $ putStrLn out
      currentBranch <- gitBranch
      when (branch == currentBranch) $
        unlessM (doesFileExist "dead.package") $ do
          let spec = pkg <.> "spec"
          hasSpec <- doesFileExist spec
          -- FIXME: silence for cmds that only output package names (eg unpushed -s)
          when (not hasSpec && showHeader action) $
            putStrLn "No spec file!"
          unless (needsSpec && not hasSpec) $
            case action of
              Header _ act -> act pkg
              Output act -> do
                out <- act pkg
                unless (null out) $ do
                  putStrLn $ "\n==" +-+ pkg +-+ branch +-+ "=="
                  putStrLn out
  repoAction branched needsSpec action dist rest

-- io independent of package
repoAction_ :: Dist -> Bool -> Bool -> IO () -> Dist -> [Package] -> IO ()
repoAction_ branched header needsSpec action =
  repoAction branched needsSpec (Header header (const action))

-- compareRawhide :: Package -> IO ()
-- compareRawhide p = do
--   let spec = p <.> "spec"
--   nvr <- removeDisttag . unwords <$> rpmspec ["--srpm"] (Just "%{name}-%{version}-%{release}") spec
--   nvr' <- withBranch "master" $ do
--     haveSpec <- doesFileExist spec
--     unless haveSpec $ cmdSilent "git" ["pull"]
--     removeDisttag . unwords <$> rpmspec ["--srpm"] (Just "%{name}-%{version}-%{release}") spec
--   if nvr == nvr'
--     then putStrLn nvr
--     else do
--     putStrLn nvr
--     putStrLn nvr'
--   putStrLn ""
--   where
--     removeDisttag = reverse . tail . dropWhile (/= '.') . reverse

isFromHackage :: Package -> IO Bool
isFromHackage pkg =
  grep_ "hackage.haskell.org/package/" $ pkg <.> "spec"

update :: Dist -> Bool -> String -> Dist -> [Package] -> IO ()
update branched keep stream =
  repoAction branched True (Header True doUpdate)
  where
    doUpdate :: Package -> IO ()
    doUpdate pkg = do
      hckg <- isFromHackage pkg
      if hckg
        then do
        ok <- cmdBool "cabal-rpm" ["update", "-s", stream]
        unless (ok || keep) $
          error' $ "cabal-rpm update failed for: " ++ pkg
        else putStrLn "skipping since not hackage"

refresh :: Dist -> Bool -> Dist -> [Package] -> IO ()
refresh branched dryrun =
  repoAction branched True (Header True refreshPkg)
  where
    refreshPkg :: Package -> IO ()
    refreshPkg pkg = do
      hckg <- isFromHackage pkg
      if hckg
        then cmd_ "cabal-rpm" $ "refresh" : ["--dry-run" | dryrun]
        else putStrLn "skipping since not hackage"

listTagged_ :: Bool -> String -> IO ()
listTagged_ short tag =
  listTagged short tag >>= putStrList

listTagged :: Bool -> String -> IO [String]
listTagged short tag = do
  builds <- map (head . words) <$> cmdLines "koji" ["list-tagged", "--quiet", tag]
  return $ nub $ map (if short then dropVerrel else id) builds

dropVerrel :: String -> String
dropVerrel nvr =
  let parts = splitOn "-" nvr in
    intercalate "-" $ take (length parts - 2) parts

remaining :: Bool -> String -> [Package] -> IO ()
remaining count tag pkgs = do
  built <- listTagged True tag
  let left = pkgs \\ built
  if count
    then print $ length left
    else cmd_ "rpmbuild-order" $ ["sort", "-p"] ++ left

cabalDepends :: Package -> IO String
cabalDepends p = do
  hckg <- isFromHackage p
  if hckg then do
    vr <- removePrefix "ghc-" . head <$>
      rpmspec ["--srpm"] (Just "%{name}-%{version}") (p <.> "spec")
    setCurrentDirectory vr
    cmdQuiet "cabal-depends" ["--not-build", "--unique"]
    else return ""

cblrpm :: Dist -> String -> Dist -> [Package] -> IO ()
cblrpm _ "" = error "CMD string must be given"
cblrpm branched cs =
  repoAction branched True (Header True doCblRpm)
  where
    doCblRpm :: Package -> IO ()
    doCblRpm p = do
    hckg <- isFromHackage p
    when hckg $
      cmd_ "cblrpm" [cs]

unbranched :: Dist -> Dist -> [Package] -> IO ()
unbranched branched dist =
  mapM_ checkBranch
  where
    checkBranch :: Package -> IO ()
    checkBranch pkg =
      withCurrentDirectory pkg $ do
      dead <- doesFileExist "dead.package"
      unless dead $ do
        let distbranch = distBranch branched dist
        branch <- gitBool "show-ref" ["--verify", "--quiet", "refs/heads/" ++ distbranch]
        unless branch $ do
          remotebranch <- gitBool "ls-remote" ["--exit-code", "--refs", "origin", distbranch]
          unless remotebranch $
            putStrLn pkg

subpackaged :: Dist -> Bool -> Dist -> [Package] -> IO ()
subpackaged branched versions dist pkgs = do
  repoAction branched True (Output listSubpkgs) dist pkgs
  where
    listSubpkgs pkg = do
      msubpkgs <- fmap (drop 2 . words) <$> cmdMaybe "grep" ["%global subpkgs", pkg <.> "spec"]
      case msubpkgs of
        Nothing -> return ""
        Just subpkgs ->
          intercalate "\n" <$> mapMaybeM expand subpkgs
      where
        expand subpkg =
          let macro = (init . drop 2) subpkg in
            fmap (removeVersion . last . words) <$> cmdMaybe "grep" ["%global " ++ macro, pkg <.> "spec"]

        removeVersion nv =
          if versions then nv else init (dropWhileEnd (/= '-') nv)

#if !MIN_VERSION_simple_cmd(0,2,2)
-- | 'gitBool c args' runs git command and return result
gitBool :: String -- ^ git command
        -> [String] -- ^ arguments
        -> IO Bool -- ^ result
gitBool c args = do
  mout <- cmdMaybe "git" (c:args)
  return $ isJust mout
#endif

#if !MIN_VERSION_simple_cmd(0,2,3)
cmdFull :: String -> [String] -> String -> IO (Bool, String, String)
cmdFull c args input = do
  (ret, out, err) <- P.readProcessWithExitCode c args input
  return (ret == ExitSuccess, removeTrailingNewline out, removeTrailingNewline err)
  where
    removeTrailingNewline :: String -> String
    removeTrailingNewline "" = ""
    removeTrailingNewline str' =
      if last str' == '\n'
      then init str'
      else str'
#endif