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

-- Todo:
-- cache dist package lists?
-- push subpackages to Hackage
-- compare branch versions
-- compare with LTS
-- arbitrary command
-- query-format string

module Main where

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

import System.Directory (doesDirectoryExist, doesFileExist,
                         setCurrentDirectory,
#if (defined(MIN_VERSION_directory) && MIN_VERSION_directory(1,2,3))
                         withCurrentDirectory
#endif
                        )
import System.Environment (getArgs, getProgName)
import System.Exit (ExitCode (..), exitWith)
import System.FilePath ((</>))
import System.IO (hPutStrLn, stderr)
--import System.Posix.Env (getEnv)

import Dists (Dist, dists, distBranch, hackageRelease, releaseVersion)
import Koji (kojiListPkgs)
import RPM (rpmspec)
import Utils ((+-+), cmd, cmd_, cmdBool, cmdMaybe, maybeRemovePrefix,
              removePrefix,
#if (defined(MIN_VERSION_directory) && MIN_VERSION_directory(1,2,3))
#else
              withCurrentDirectory
#endif
             )

main :: IO ()
main = do
  margs <- getArgs >>= parseArgs
  case margs of
    Nothing -> return ()
    Just (com, mdist, pkgs) ->
      case com of
        "list" -> withPackages mdist pkgs (mapM_ putStrLn)
        "count" -> withPackages mdist pkgs (print . length)
        "hackage" -> do
          let currentHackage = Just hackageRelease
          unless (isNothing mdist || mdist == currentHackage) $ error $ "Hackage is currently for" +-+ fromJust currentHackage ++ "!"
          withPackages currentHackage pkgs (repoqueryHackageCSV currentHackage)
        "clone" -> withPackages mdist pkgs $
                   repoAction_ True False mdist (return ())
        "clone-new" -> do
          new <- newPackages mdist
          withPackages mdist new $ repoAction_ True False mdist (return ())
        "pull" -> withPackages mdist pkgs $
                  repoAction_ True False mdist (cmd_ "git" ["pull", "--rebase"])
        "diff" -> withPackages mdist pkgs $
                  repoAction_ True False mdist (cmd_ "git" ["--no-pager", "diff"])
        "diff-branch" -> withPackages mdist pkgs $
                  repoAction False True mdist compareRawhide
        "diff-stackage" -> withPackages mdist pkgs $
                  repoAction True True mdist compareStackage
        "verrel" -> withPackages mdist pkgs $
                    repoAction_ False True mdist (cmd_ "fedpkg" ["verrel"])
        "subpkgs" -> withPackages mdist pkgs $
                     repoAction True True mdist (\ p -> rpmspec [] (Just "%{name}-%{version}") (p ++ ".spec") >>= putStrLn)
        "new" -> newPackages mdist >>= mapM_ putStrLn
        _ -> return ()
  where
    withPackages :: Maybe Dist -> [Package] -> ([Package] -> IO ()) -> IO ()
    withPackages mdist pkgs act =
      (if null pkgs then repoqueryHaskell False mdist else return pkgs) >>= act

commands :: [(String, String)]
commands = [("clone", "clone repos"),
            ("clone-new", "clone new packages"),
            ("count", "count number of packages"),
            ("diff", "git diff"),
            ("diff-branch","compare branch with master"),
            ("diff-stackage","compare with stackage"),
            ("hackage", "generate Hackage distro data"),
            ("list", "list packages"),
            ("new", "new unbuilt packages"),
            ("pull", "pull repos"),
            ("subpkgs", "list subpackages"),
            ("verrel", "show nvr of packages")]

cmds :: [String]
cmds = map fst commands

help :: IO ()
help = do
  progName <- getProgName
  hPutStrLn stderr $ "Usage:" +-+ progName +-+ "CMD [DIST]\n"
    ++ "\n"
    ++ "Commands:\n"
  mapM_ (putStrLn . (\(c, desc) -> "  " ++ c ++ replicate (mx - length c) ' ' +-+ "-" +-+ desc)) commands
  exitWith (ExitFailure 1)
  where
    mx = maximum $ map length cmds

type Package = String

type Arguments = Maybe (String, Maybe Dist, [Package])

parseArgs :: [String] -> IO Arguments
parseArgs [c] =
                if c `elem` cmds
                then return (Just (c, Nothing, []))
                else giveUp $ "No such command '" ++ c ++ "'"
parseArgs (c:dist:pkgs) | c `notElem` cmds =
                          giveUp $ "No such command '" ++ c ++ "'"
                        | dist `notElem` dists =
                            return $ Just (c, Nothing, dist:pkgs)
                        | otherwise =
                          return $ Just (c, Just dist, pkgs)
parseArgs _ = help >> return Nothing

giveUp :: String -> IO Arguments
giveUp err = do
  hPutStrLn stderr err
  help >> return Nothing


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

repoqueryHackageCSV :: Maybe Dist -> [Package] -> IO ()
repoqueryHackageCSV mdist pkgs = do
  let relver = maybe "rawhide" releaseVersion mdist
  -- Hackage csv chokes on final newline so remove it
  init . unlines . sort . map (replace "\"ghc-" "\"")  . lines <$> cmd "dnf" (["repoquery", "--quiet", "--releasever=" ++ relver, "--latest-limit=1", "-q", "--qf=\"%{name}\",\"%{version}\",\"https://src.fedoraproject.org/rpms/%{name}\""] ++ pkgs) >>= putStr

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
  -- fixme: should use repoquery instead:
  base <- cmd "ghc-pkg" ["--simple-output", "list", "base"]
  ghcver <- cmd "ghc" ["--numeric-version"]
  let relver = maybe "rawhide" releaseVersion mdist
  when verbose $ putStrLn "Getting packages from repoquery"
  bin <- words <$> cmd "dnf" ["repoquery", "--quiet", "--releasever=" ++ relver, "--whatrequires", "libHS" ++ base ++ "-ghc" ++ ghcver ++ ".so()(64bit)", "--qf=%{source_name}"]
  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

repoAction :: Bool -> Bool -> Maybe Dist -> (Package -> IO ()) -> [Package] -> IO ()
repoAction _ _ _ _ [] = return ()
repoAction header needsSpec mdist 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"
    -- let anon = "-a"
    dirExists <- doesDirectoryExist pkg
    unless dirExists $
      cmd_ "fedpkg" $ ["clone"] ++ (if branchGiven then ["-b", branch] else ["-B"]) ++ [pkg]
    singleDir <- doesFileExist $ pkg </> ".git/config"
    unless singleDir $ do
      branchDir <- doesDirectoryExist $ pkg </> branch
      unless branchDir $
        withCurrentDirectory pkg $
          cmd_ "fedpkg" ["clone", "-b", branch, pkg, branch]
    wd <- pkgDir pkg branch ""
    setCurrentDirectory wd
    pkggit <- do
      gd <- doesFileExist ".git/config"
      if gd
        then cmdBool "grep" ["-q", "pkgs.fedoraproject.org", ".git/config"]
        else return False
    unless pkggit $
      error $ "not a Fedora pkg git dir!:" +-+ wd
    when dirExists $ do
      actual <- gitBranch
      when (branch /= actual) $
        cmd_ "fedpkg" ["switch-branch", branch]
      isDead <- doesFileExist "dead.package"
      unless isDead $ do
        let spec = pkg ++ ".spec"
        hasSpec <- doesFileExist spec
        unless hasSpec $ putStrLn "No spec file!"
        unless (needsSpec && not hasSpec) $
          action pkg
  repoAction header needsSpec mdist action rest

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

pkgDir :: String -> String -> FilePath -> IO FilePath
pkgDir dir branch top = do
  b <- doesDirectoryExist $ top </> dir </> branch
  return $ top </> dir </> if b then branch else ""

gitBranch :: IO String
gitBranch =
  (removePrefix "* " . head . filter (isPrefixOf "* ") . lines) <$> cmd "git" ["branch"]

compareStackage :: Package -> IO ()
compareStackage p = do
  nvr <- cmd "fedpkg" ["verrel"]
  stkg <- cmdMaybe "stackage" ["package", "lts", 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) +-+ "(lts)"


compareRawhide :: Package -> IO ()
compareRawhide p = do
  nvr <- rpmspec ["--srpm"] (Just "%{name}-%{version}-%{release}") (p ++ ".spec")
  nvr' <- withCurrentDirectory "../master" $
          rpmspec ["--srpm"] (Just "%{name}-%{version}-%{release}") (p ++ ".spec")
  when (removeDisttag nvr /= removeDisttag nvr') $ do
    putStrLn nvr
    putStrLn nvr'
    putStrLn ""
  where
    removeDisttag = reverse . tail . dropWhile (/= '.') . reverse