-- |
-- Module      :  Packages
-- Copyright   :  (C) 2017  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.

module Main where

#if (defined(MIN_VERSION_base) && MIN_VERSION_base(4,8,2))
#else
import Control.Applicative ((<$>))
#endif
import Control.Monad (filterM, unless, when)
import Data.Char (isUpper, toLower, toUpper)
import Data.Maybe
import Data.List (find, isInfixOf, isPrefixOf, nub, partition, sort, (\\))

import Network.HTTP (getRequest, getResponseBody, simpleHTTP)
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.Environment (getArgs, getProgName)
import System.Exit (ExitCode (..), exitWith)
import System.FilePath ((</>), takeFileName)
import System.IO (BufferMode(..), hPutStrLn, hSetBuffering, stderr,
                  stdout)
--import System.Posix.Env (getEnv)
import Text.CSV (parseCSV)
import Text.Read (readMaybe)

import Dists (Dist, dists, distBranch, distRepo, distUpdates, hackageRelease,
              rawhide, releaseVersion)
import Koji (kojiListPkgs, rpkg)
import RPM (buildRequires, haskellSrcPkgs, Package, pkgDir,
            repoquery, rpmspec)
import Utils ((+-+), checkPkgsGit, cmd, cmd_, cmdBool, cmdMaybe, cmdSilent, grep,
              git, git_, gitBranch, maybeRemovePrefix, removePrefix, removeSuffix,
              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
  as <- getArgs
  if null as
    then help ""
    else
    runCommand $ parseCmdArgs as

runCommand :: Arguments -> IO ()
runCommand (com, os, ps) = do
  let (global, opts) = partition (`elem` globalOpts) os
      allpkgs = OptNull 'A' `elem` global
      mdist = getOptVal (OptArg 'b' "brnch") global
  hSetBuffering stdout LineBuffering
  case mdist of
    Nothing -> return ()
    Just d -> if d `elem` dists || "rhel" `isPrefixOf` d
      then return ()
      else putStrLn "Unknown branch"
  when (not allpkgs && null ps && com `notElem` [Hackage, HackageCompare, Count]) $
    help "Please specify package(s)"
  if allpkgs && (not . null) ps
    then error "Cannot have '-A' and list of packages"
    else do
      pkgs <- if allpkgs
              then repoqueryHaskell False mdist
              else return ps
      case com of
        List -> mapM_ putStrLn pkgs
        Count -> repoqueryHaskell False mdist >>= (print . length)
        Hackage -> do
          -- add check for no pkg args
          checkHackageDist mdist
          repoqueryHackageCSV hackageRelease
        HackageCompare -> do
          checkHackageDist mdist
          withPackages (Just hackageRelease) pkgs $ compareHackage (null pkgs) hackageRelease
        New -> newPackages mdist >>= mapM_ putStrLn
        OldPackages -> do
          repopkgs <- repoqueryHaskell True mdist
          mapM_ putStrLn $ pkgs \\ repopkgs

        -- repo actions (header, needs-spec :: Bool)
        Checkout -> repoAction_ mdist global True False (return ()) pkgs
        Clone -> repoAction_ mdist global True False (return ()) pkgs
        CloneNew ->
          newPackages mdist >>= repoAction_ mdist global True False (return ())
        Commit -> repoAction_ mdist global True True (commitChanges mdist opts) pkgs
        Cmd -> repoAction_ mdist global True True (execCmd opts) pkgs
        Diff -> repoAction mdist global False False (gitDiff opts) pkgs
        DiffBranch -> repoAction mdist global False True compareRawhide pkgs
        DiffOrigin -> repoAction_ mdist global True False (git_ "diff" [maybe "origin" ("origin/" ++) mdist]) pkgs
        DiffStackage -> repoAction mdist global True True (compareStackage mdist) pkgs
        HeadOrigin -> repoAction mdist global False False (gitHeadAtOrigin mdist) pkgs
        Leaf -> repoAction mdist global (OptNull 'v' `elem` opts) True (checkLeafPkg opts) pkgs
        Merge -> repoAction_ mdist global True False (gitMerge opts) pkgs
        Missing -> repoAction mdist global True True (checkForMissingDeps mdist) pkgs
        Pull -> repoAction_ mdist global True False (git_ "pull" ["--rebase"]) pkgs
        Push -> repoAction_ mdist global True False (git_ "push" []) pkgs
        Prep -> repoAction_ mdist global True True (cmd_ (rpkg mdist) ["prep"]) pkgs
        Refresh -> repoAction mdist global True True (updateOrRefreshPackage True) pkgs
        Unpushed -> repoAction mdist global False True (gitLogOneLine mdist opts) pkgs
        Update -> repoAction mdist global True True (updateOrRefreshPackage False) pkgs
        Verrel -> repoAction_ mdist global False True (cmd_ (rpkg mdist) ["verrel"]) pkgs
        Subpkgs -> repoAction mdist global True True (\ p -> rpmspec [] (Just "%{name}-%{version}\n") (p ++ ".spec") >>= putStrLn) pkgs
  where
    checkHackageDist mdist =
      unless (isNothing mdist || mdist == Just hackageRelease) $ error $ "Hackage is currently for" +-+ hackageRelease ++ "!"

    withPackages :: Maybe Dist -> [Package] -> ([Package] -> IO ()) -> IO ()
    withPackages mdst pkgs act =
      (if null pkgs then repoqueryHaskell False mdst else return pkgs) >>= act

-- name, summary
data Command = Command { cmdName :: CmdName , cmdDescription :: String}

data CmdName = Checkout | Clone | CloneNew | Cmd | Count
             | Diff | DiffOrigin | DiffBranch | DiffStackage
             | Hackage | HackageCompare | HeadOrigin
             | List | Merge | New | OldPackages | Prep | Commit | Pull | Push
             | Unpushed | Update | Refresh | Subpkgs | Missing | Leaf | Verrel
  deriving (Read, Show, Eq)

-- SomeCommand -> "some-command"
showCmd :: CmdName -> String
showCmd c = render "" (show c) +-+ showCmdOpts c
  where
    render :: String -> String -> String
    render os "" = os
    render "" (i:is) = render [toLower i] is
    render os (i:is) = render (os ++ if isUpper i then "-" ++ [toLower i] else [i]) is

-- "some-command" -> SomeCommand
readCmd :: String -> CmdName
readCmd c = fromMaybe (error $ "Unknown command " ++ c) (readMaybe $ parse "" c)
  where
    parse :: String -> String -> String
    parse os "" = os
    parse "" (i:is) = parse [toUpper i] is
    parse os ('-':is) = parse (os ++ [toUpper $ head is]) (tail is)
    parse os (i:is) = parse (os ++ [i]) is

commands :: [Command]
commands = [ Command Checkout "fedpkg switch-branch"
           , Command Clone "clone repos"
           , Command CloneNew "clone new packages"
           , Command Cmd "arbitrary command (with args)"
           , Command Count "count number of packages"
           , Command Diff "git diff"
           , Command DiffOrigin "git diff origin"
           , Command DiffBranch "compare branch with master"
           , Command DiffStackage "compare with stackage"
           , Command Hackage "generate Hackage distro data"
           , Command HackageCompare "compare with Hackage distro data"
           , Command HeadOrigin "head in sync with origin"
           , Command Leaf "list leaf packages"
           , Command List "list packages"
           , Command Merge "git merge"
           , Command Missing "missing dependency source packages"
           , Command New "new unbuilt packages"
           , Command OldPackages "packages not in repoquery"
           , Command Prep "fedpkg prep"
           , Command Commit "fedpkg commit"
           , Command Pull "git pull repos"
           , Command Push "git push repos"
           , Command Unpushed "show unpushed commits"
           , Command Update "cabal-rpm update"
           , Command Refresh "cabal-rpm refresh"
           , Command Subpkgs "list subpackages"
           , Command Verrel "show nvr of packages"]

type CommandOptions = [(Option, Bool)]

-- True: mandatory
-- False: optional
cmdOpts :: CmdName ->  CommandOptions
cmdOpts Commit = [(OptArg 'm' "\"COMMITMSG\"", True)]
cmdOpts Diff = [(OptArg 'w' "BRANCH", False),
                (OptNull 's', False)]
cmdOpts Merge = [(OptArg 'f' "BRANCH", True)]
cmdOpts Cmd = [(OptLong "cmd" "\"command\"", True)]
cmdOpts Leaf = [(OptNull 'v', False)]
cmdOpts Unpushed = [(OptNull 's', False)]
cmdOpts _ = []

globalOptsDesc :: [(Option, String)]
globalOptsDesc =
  [ (OptNull 'A', "all Fedora Haskell packages")
  , (OptNull 'B', "clone branch dirs (fedpkg clone -B)")
  , (OptArg 'b' "BRANCH", "branch to use (fedpkg -b)")
  ]

globalOpts :: [Option]
globalOpts = map fst globalOptsDesc

help :: String -> IO a
help err = do
  if null err
    then do
    progName <- getProgName
    putStrLn $ "Usage:" +-+ progName +-+ "CMD" +-+ showOpts globalOptsNotAll +-+ "PKG..."
    putStrLn $ "      " +-+ progName +-+ "CMD -A \n"
    putStrLn "Global options:"
    mapM_ (putStrLn . describeOpt) globalOptsDesc
    putStrLn ""
    putStrLn "Commands:"
    mapM_ renderCmd commands
    else hPutStrLn stderr err
  exitWith (ExitFailure 1)
  where
    globalOptsNotAll = filter (/= OptNull 'A') globalOpts
    cmds :: [CmdName]
    cmds = map cmdName commands
    mx = maximum $ map (length . showCmd) cmds
    renderCmd :: Command -> IO ()
    renderCmd (Command c desc) = do
      let txt = showCmd c
      putStrLn $ "  " ++ txt ++ replicate (mx - length txt) ' ' +-+ "-" +-+ desc

-- add description
data Option = OptNull Char | OptArg Char String | OptLong String String

instance Eq Option
  where
    OptNull c == OptNull c' = c == c'
    OptArg c _ == OptArg c' _ = c == c'
    OptLong s _ == OptLong s' _ = s == s'
    _ == _ = False

hasOptNull :: Char -> [Option] -> Bool
hasOptNull c opts = OptNull c `elem` opts

getOptVal :: Option -> [Option] -> Maybe String
getOptVal (OptNull _) _ = Nothing
getOptVal opt opts = maybe Nothing mval optval
  where
    optval = find (== opt) opts
    mval (OptNull _) = Nothing
    mval (OptArg _ v) = Just v
    mval (OptLong _ v) = Just v

--isNull :: Option -> Bool
--isNull (OptNull _) = True
--isNull _ = False

instance Show Option
  where
    show (OptNull c) = "-" ++ [c]
    show (OptArg c v) = "-" ++ [c] ++ ('=':v)
    show (OptLong s v) = "--" ++ s ++ ('=':v)

showOpts :: [Option] -> String
showOpts = unwords . map (\ s -> "[" ++ show s ++ "]")

showCmdOpts :: CmdName -> String
showCmdOpts = unwords . map
              (\ (s,o) -> if o then show s else "[" ++ show s ++ "]") . cmdOpts

describeOpt :: (Option, String) -> String
describeOpt (opt, desc) =
  "  " ++ show opt ++ ":" +-+ desc

type Arguments = (CmdName, [Option], [Package])

-- FIXME: should check mandatory opts present
parseCmdArgs :: [String] -> Arguments
parseCmdArgs [] = error "Need to pass more arguments" -- should not happen
parseCmdArgs as =
      let (os, args) = partition isFlag as in
        if null args
        then error "Please give an command"
        else
          let (cstr:rest) = args
              c = readCmd cstr
              opts =
                let res = map parseOpt os in
                  if all (`elem` globalOpts ++ map fst (cmdOpts c)) res then res
                  else error "invalid option"
              pkgs = map (removeSuffix "/") rest
          in if hasOptNull 'A' opts && (not . null) pkgs
             then error "Can't give packages with -A"
             else (c, opts, pkgs)
  where
    isFlag ['-', c] | c /= '-' = True
    isFlag ('-':c:'=':_) | c /= '-' = True
    isFlag ('-':'-':_) = True
    isFlag _ = False

    parseOpt :: String -> Option
    parseOpt [] = error "Empty option"
    parseOpt ['-',l] = OptNull l
    parseOpt ('-':l:'=':val) = OptArg l val
    parseOpt ('-':'-':assgn)
      | '=' `elem` assgn =
          let (n,v) = break (== '=') assgn
          in if null n || null v then error "malformed long option"
             else OptLong n (tail v)
    parseOpt ls = error $ "Cannot parse option:" +-+ ls

repoqueryHackageCSV :: Dist -> IO ()
repoqueryHackageCSV dist = do
  pkgs <- repoqueryHaskell False (Just dist)
  let relver = releaseVersion dist
  -- Hackage csv chokes on final newline so remove it
  init . unlines . sort . map (replace "\"ghc-" "\"")  . lines <$> repoquery relver (["--repo=fedora", "--repo=updates", "--latest-limit=1", "--qf=\"%{name}\",\"%{version}\",\"https://src.fedoraproject.org/rpms/%{name}\""] ++ pkgs) >>= putStr

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'

compareHackage :: Bool -> Dist -> [Package] -> IO ()
compareHackage all' dist pkgs = do
  hck <- simpleHTTP (getRequest "http://hackage.haskell.org/distro/Fedora/packages.csv") >>= getResponseBody
  let hackage = sort . either (error "Malformed Hackage csv") (map mungeHackage) $ parseCSV "packages.csv" hck
      relver = releaseVersion dist
  fedora <- sort . map mungeRepo . lines <$> repoquery relver (["--repo=fedora", "--repo=updates", "--latest-limit=1", "--qf=%{name},%{version}"] ++ pkgs)
  compareSets all' hackage fedora
  where
    mungeHackage :: [String] -> PkgVer
    mungeHackage [_,v,u] = PV (takeFileName u) v
    mungeHackage _ = error "Malformed Hackage csv"

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

compareSets :: Bool -> [PkgVer] -> [PkgVer] -> IO ()
compareSets _ [] [] = return ()
compareSets _ [] (f:fs) = do
  putStrLn ("New:" +-+ show f)
  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 $ "New:" +-+ show f
                              compareSets all' (h:hs) fs
                          | otherwise = do
                              putStrLn $ pvPkg h ++ ":" +-+ pvVer h +-+ "->" +-+ pvVer f
                              compareSets all' hs fs

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 _ _ [] = []

repoqueryHaskell :: Bool -> Maybe Dist -> IO [Package]
repoqueryHaskell verbose mdist = do
  let relver = maybe Nothing releaseVersion mdist
  when verbose $ putStrLn "Getting packages from repoquery"
  let repo = maybe "rawhide" distRepo mdist
      updates = maybeToList $ maybe Nothing distUpdates mdist
  bin <- words <$> repoquery relver (["--repo=" ++ repo] ++ ["--repo=" ++ u | u <- updates] ++ ["--qf=%{source_name}", "--whatrequires", "libHSbase-*-ghc*.so()(64bit)"])
  when (null bin) $ error "No libHSbase consumers found!"
  return $ sort $ nub bin

newPackages :: Maybe Dist -> IO [Package]
newPackages mdist = do
  ps <- repoqueryHaskell True mdist
  kps <- kojiListHaskell True mdist
  return $ kps \\ ps

kojiListHaskell :: Bool -> Maybe Dist -> IO [Package]
kojiListHaskell verbose mdist = do
  when verbose $ putStrLn "Getting package list from Koji"
  libs <- filter (\ p -> "ghc-" `isPrefixOf` p && p `notElem` ["ghc-rpm-macros", "ghc-srpm-macros"]) <$> kojiListPkgs (fromMaybe "rawhide" mdist)
  when (null libs) $ error "No library packages found"
  return $ sort $ nub libs

repoAction :: Maybe Dist -> [Option] -> Bool -> Bool -> (Package -> IO ()) -> [Package] -> IO ()
repoAction _ _ _ _ _ [] = return ()
repoAction mdist opts header needsSpec action (pkg:rest) = do
  withCurrentDirectory "." $ do
    let branchGiven = isJust mdist
        branch = maybe "master" distBranch mdist
    when header $
      putStrLn $ "\n==" +-+ pkg ++ (if branchGiven then ":" ++ branch else "") +-+ "=="
    -- muser <- getEnv "USER"
    home <- getHomeDirectory
    haveSSH <- doesFileExist $ home </> ".ssh/id_rsa"
    dirExists <- doesDirectoryExist pkg
    unless dirExists $
      cmd_ (rpkg mdist) $ ["clone"] ++ ["-a" | not haveSSH] ++ (if hasOptNull 'B' opts then ["-B"] else ["-b", branch]) ++ [pkg]
    singleDir <- doesFileExist $ pkg </> ".git/config"
    unless singleDir $ do
      branchDir <- doesDirectoryExist $ pkg </> branch
      unless branchDir $
        withCurrentDirectory pkg $
          cmd_ (rpkg mdist) ["clone", "-b", branch, pkg, branch]
    wd <- pkgDir pkg branch ""
    setCurrentDirectory wd
    pkggit <- do
      gd <- doesFileExist ".git/config"
      if gd
        then checkPkgsGit
        else return False
    unless pkggit $
      error $ "not a Fedora pkg git dir!:" +-+ wd
    when dirExists $ do
      actual <- gitBranch
      when (branch /= actual) $
        cmd_ (rpkg mdist) ["switch-branch", branch]
    isDead <- doesFileExist "dead.package"
    unless isDead $ do
      let spec = pkg ++ ".spec"
      hasSpec <- doesFileExist spec
      -- FIXME: silence for cmds that only output package names (eg unpushed -s)
      unless hasSpec $ putStrLn $ (if header then "" else pkg ++ ": ") ++ "No spec file!"
      unless (needsSpec && not hasSpec) $
        action pkg
  repoAction mdist opts header needsSpec action rest

repoAction_ :: Maybe Dist -> [Option] -> Bool -> Bool -> IO () -> [Package] -> IO ()
repoAction_ mdist opts header needsSpec action =
  repoAction mdist opts header needsSpec (const action)

compareStackage :: Maybe Dist -> Package -> IO ()
compareStackage mdist p = do
  nvr <- cmd (rpkg mdist) ["verrel"]
  let stream = "lts-11"
  stkg <- cmdMaybe "stackage" ["package", stream, maybeRemovePrefix "ghc-" p]
  let same = isJust stkg && fromJust stkg `isInfixOf` nvr
  putStrLn $ removePrefix (p ++ "-") nvr +-+ "(fedora)"
  putStrLn $ (if same then "same" else fromMaybe "none" stkg) +-+ "(" ++ stream ++ ")"


compareRawhide :: Package -> IO ()
compareRawhide p = do
  let spec = p ++ ".spec"
  nvr <- removeDisttag <$> rpmspec ["--srpm"] (Just "%{name}-%{version}-%{release}") spec
  nvr' <- withCurrentDirectory "../master" $ do
    haveSpec <- doesFileExist spec
    unless haveSpec $ cmdSilent "git" ["pull"]
    removeDisttag <$> 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"


updateOrRefreshPackage :: Bool -> Package -> IO ()
updateOrRefreshPackage refresh pkg = do
  hckg <- isFromHackage pkg
  let mode = if refresh then "refresh" else "update"
  if hckg
    then cmd_ "cabal-rpm" [mode]
    else putStrLn "skipping since not hackage"

commitChanges :: Maybe Dist -> [Option] -> IO ()
commitChanges mdist [OptArg 'm' msg] = do
  chgs <- cmd "git" ["diff"]
  if null chgs
    then putStrLn "no changes"
    else cmd_ (rpkg mdist) ["commit", "-m", msg]
commitChanges _ _ = error "commit requires: -m=\"commit message\""

gitMerge :: [Option] -> IO ()
gitMerge [OptArg 'f' branch] = git_ "merge" [branch]
gitMerge _ = error "merge needs -f=BRANCH option"

gitDiff :: [Option] -> Package -> IO ()
gitDiff opts pkg = do
  let mbrnch = getOptVal (OptArg 'w' "branch") opts
      branch = maybeToList mbrnch
      short  = hasOptNull 's' opts
  out <- git "diff" branch
  if short
    then unless (null out) $ putStrLn pkg
    else putStrLn out

execCmd :: [Option] -> IO ()
execCmd [OptLong "cmd" cs]
  | null cs = error "a string must be passed to --cmd="
  | otherwise = let (c:args) = words cs in
                  cmd_ c args
execCmd _ = error "cmd needs --cmd= option"

checkForMissingDeps :: Maybe Dist -> Package -> IO ()
checkForMissingDeps mdist pkg = do
  dir <- takeFileName <$> getCurrentDirectory
  let top = if dir == pkg then ".." else "../.."
      dist = fromMaybe rawhide mdist
      spec = pkg ++ ".spec"
  hasSpec <- doesFileExist spec
  if hasSpec
    then do
    deps <- buildRequires (pkg ++ ".spec") >>= haskellSrcPkgs top dist
    mapM_ (checkMissing top) deps
    else putStrLn "no spec file found!"
  where
    checkMissing :: FilePath -> Package -> IO ()
    checkMissing top dep = do
      exists <- doesDirectoryExist $ top </> dep
      unless exists $ putStrLn $ "Missing" +-+ dep

-- fixme: make a dependency cache
checkLeafPkg :: [Option] -> Package -> IO ()
checkLeafPkg opts pkg = do
  dir <- takeFileName <$> getCurrentDirectory
  let branchdir = dir /= pkg
      top = if branchdir then "../.." else ".."
      spec = pkg ++ ".spec"
  subpkgs <- lines <$> rpmspec ["--builtrpms"] (Just "%{name}\n") spec
  allpkgs <- listDirectory top
  let other = map (\ p -> top </> p </> (if branchdir then dir else "") </> p ++ ".spec") $ allpkgs \\ [pkg]
      verb = hasOptNull 'v' opts
  found <- filterM (dependsOn subpkgs) other
  if null found
    then putStrLn pkg
    else when verb $ mapM_ putStrLn 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

gitLogOneLine :: Maybe Dist -> [Option] -> Package -> IO ()
gitLogOneLine mdist opts pkg = do
  out <- git "log" [maybe "origin" ("origin/" ++) mdist ++ "..HEAD", "--pretty=oneline"]
  let short = hasOptNull 's' opts
  unless (null out) $
    putStrLn $ pkg ++ if short then "" else (unwords . map replaceHash . words) out
  where
    replaceHash h = if length h /= 40 then h else ":"

gitHeadAtOrigin :: Maybe Dist -> Package -> IO ()
gitHeadAtOrigin mdist pkg = do
  same <- cmdBool "git" ["diff", "--quiet", maybe "origin" ("origin/" ++) mdist ++ "..HEAD"]
  when same $ putStrLn pkg