Status.hs

{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}

module Cmd.Status (statusCmd) where

import Common
import Common.System

import Data.Fixed
import Data.Time.Clock
import Data.Time.LocalTime
import Fedora.Bodhi

import Bugzilla
import Branches
import Git
import Koji
import ListReviews
import Package

-- FIXME instead --pull?
-- FIXME --pending
-- FIXME handle not cloned (remote only)
-- FIXME silence fetching of new branches? (for --reviews etc)
statusCmd :: Bool -> Bool -> (BranchesReq,[String]) -> IO ()
statusCmd nofetch reviews (breq, pkgs) = do
  reviewpkgs <- if reviews then
    map reviewBugToPackage <$> listReviewsAll True ReviewRepoCreated
    else return []
  -- FIXME dirty not okay for multiple branches?
  withPackagesByBranches HeaderMay False (if nofetch then dirtyGit else dirtyGitFetch) AnyNumber statusBranch (breq, pkgs ++ reviewpkgs)

-- FIXME note dirty when local changes
statusBranch :: Package -> AnyBranch -> IO ()
statusBranch _ (OtherBranch _) =
  error' "status currently only defined for release branches"
statusBranch pkg rbr@(RelBranch br) = do
  brExists <- checkIfRemoteBranchExists rbr
  if not brExists
    then do
    name <- getDirectoryName
    putStrLn $ name ++ " has no branch " ++ show br
    else do
    gitSwitchBranch rbr
    let spec = packageSpec pkg
    ifM (notM (doesFileExist spec))
      (ifM initialPkgRepo
        (putStrLn $ show br ++ ": initial repo")
        (putStrLn $ "missing " ++ spec)) $
      do
      mnvr <- pkgNameVerRel br spec
      case mnvr of
        Nothing -> do
          putStrLn "undefined NVR!\n"
          putStr "HEAD "
          whenJustM (gitShortLog1 Nothing) $ putStrLn . showCommit
        Just nvr -> do
          -- unless (br == Rawhide) $ do
          --   newerBr <- newerBranch br <$> getFedoraBranches
          --   ancestor <- gitBool "merge-base" ["--is-ancestor", "HEAD", show newerBr]
          --   when ancestor $ do
          --     unmerged <- gitOneLineLog $ "HEAD..origin/" ++ show newerBr
          --     unless (null unmerged) $ do
          --       putStrLn $ "Newer commits in " ++ show newerBr ++ ":"
          --       mapM_ putStrLn unmerged
          unpushed <- gitShortLog1 $ Just $ "origin/" ++ show br ++ "..HEAD"
          if null unpushed
            then do
            mbuild <- kojiGetBuildID fedoraHub nvr
            case mbuild of
              Nothing -> do
                mlatest <- kojiLatestNVR (branchDestTag br) (unPackage pkg)
                case mlatest of
                  Nothing -> putStrLn $ "new " ++ nvr
                  Just latest ->
                    putStrLn $ if equivNVR nvr latest then latest ++ " is latest modulo disttag" else (if null latest then "new " else (head . words) latest ++ " ->\n") ++ nvr
              Just buildid -> do
                tags <- kojiBuildTags fedoraHub (buildIDInfo buildid)
                if null tags then do
                  mstatus <- kojiBuildStatus nvr
                  -- FIXME show pending archs building
                  whenJust mstatus $ \ status ->
                    -- FIXME better Show BuildStatus
                    putStr $ nvr ++ " (" ++ show status ++ ")"
                else do
                  -- FIXME hide testing if ga/stable
                  putStr $ nvr ++ " (" ++ unwords tags ++ ")"
                  unless (isStable tags) $ do
                    updates <- bodhiUpdates
                               [makeItem "display_user" "0",
                                makeItem "builds" nvr]
                    case updates of
                      [] -> putStrLn "No update found"
                      [update] -> do
                        -- FIXME could show minus time left using stable_days?
                        let msince = lookupKey "date_testing" update :: Maybe LocalTime
                        case msince of
                          Nothing -> return ()
                          Just date -> do
                            let since = localTimeToUTC utc date
                            current <- getCurrentTime
                            let diff = diffUTCTime current since
                            putAge diff
                      _ -> putStrLn "More than one update found!"
                putNewLn
            else whenJust unpushed $ putStrLn . ((show br ++ ": ") ++) . showCommit
  where
    isStable :: [String] -> Bool
    isStable = not . all ("-testing" `isSuffixOf`)

    putAge :: NominalDiffTime -> IO ()
    putAge diff = do
      -- FIXME time-1.10 has formatTime of NominalDiffTime
      let (days,nomRest) = diff `divMod'` nominalDay :: (Int,NominalDiffTime)
          nominalHour = 3600 :: NominalDiffTime
          hours = nomRest `div'` nominalHour :: Int
      putStr $ " " ++ plural days "day" +-+ plural hours "hour"

#if !MIN_VERSION_time(1,8,0)
    nominalDay = 3600 * 24 :: NominalDiffTime
#endif