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

import Control.Applicative (
#if !MIN_VERSION_simple_cmd_args(0,1,3)
    (<|>),
#endif
#if !MIN_VERSION_base(4,8,0)
    (<$>), (<*>)
#endif
  )
import Control.Concurrent.Async (concurrently)
import Control.Monad
import Control.Monad.Extra (concatMapM)
import qualified Data.ByteString.Char8 as B
import Data.List
import Data.Maybe
import Data.RPM.NVRA
#if !MIN_VERSION_base(4,11,0)
import Data.Semigroup ((<>))
#endif
import qualified Data.Text as T
import qualified Data.Text.Lazy as TL
import Data.Text.Lazy.Encoding (decodeUtf8)
import Network.HTTP.Client (httpLbs, managerResponseTimeout, newManager,
                            parseRequest, responseBody, responseTimeoutMicro)
import Network.HTTP.Client.TLS (tlsManagerSettings)
import Network.HTTP.Directory
import Network.HTTP.Types (hContentType)
import SimpleCmdArgs
import System.Directory (doesDirectoryExist, listDirectory)
import System.FilePath ((</>))
import System.FilePath.Glob (compile, match)
#if !MIN_VERSION_simple_cmd(0,2,0)
-- for warning
import System.IO (hPutStrLn, stderr)
#endif

import SimpleCmd (cmd, error',
#if MIN_VERSION_simple_cmd(0,2,0)
                  warning
#endif
                 )

import qualified Distribution.Koji as Koji

import Distribution.RPM.PackageTreeDiff
import Paths_pkgtreediff (version)

data Summary = AutoSummary
             | NoSummary
             | ShowSummary
  deriving Eq

data Mode = Added
          | Deleted
          | Updated
          | Downgraded
  deriving Eq

main :: IO ()
main =
  simpleCmdArgs (Just version) "Package tree comparison tool"
  "pkgtreediff compares the packages in two OS trees or instances" $
  compareDirs
    <$> recursiveOpt
    <*> optional subdirOpt
    <*> ignoreVR
    <*> many modeOpt
    <*> summaryOpt
    <*> switchWith 'R' "rst" "Use ReSTructured Text format"
    <*> optional patternOpt
    <*> timeoutOpt
    <*> sourceArg "1"
    <*> sourceArg "2"
  where
    sourceArg :: String -> Parser String
    sourceArg pos = strArg ("URL|DIR|FILE|KOJITAG|CMD" <> pos)

    modeOpt :: Parser Mode
    modeOpt =
      flagWith' Added 'N' "new" "Show only added packages" <|>
      flagWith' Deleted 'D' "deleted" "Show only removed packages" <|>
      flagWith' Updated 'U' "updated" "Show only upgraded packages" <|>
      flagWith' Downgraded 'u' "downgraded" "Show only downgraded packages"

    summaryOpt =
      flagWith' ShowSummary 's' "show-summary" ("Show summary of changes (default when >" <> show summaryThreshold <> " changes)") <|>
      flagWith AutoSummary NoSummary 'S' "no-summary" "Do not display summary"

    -- ignoreArch :: Parser Bool
    -- ignoreArch = switchWith 'A' "ignore-arch" "Ignore arch differences"

    ignoreVR :: Parser Ignore
    ignoreVR =
      flagWith' IgnoreRelease 'R' "ignore-release" "Only show version changes (ignore release)" <|>
      flagWith IgnoreNone IgnoreVersion 'V' "ignore-version" "Only show package changes (ignore version-release)"

    recursiveOpt :: Parser Bool
    recursiveOpt = switchWith 'r' "recursive" "Recursive down into subdirectories"

    subdirOpt :: Parser String
    subdirOpt = strOptionWith 'd' "subdir" "SUBDIR" "Select specific subdir (eg x86_64 or source)"

    patternOpt :: Parser String
    patternOpt = strOptionWith 'p' "pattern" "PKGPATTERN" "Limit packages to glob matches"

    timeoutOpt :: Parser Int
    timeoutOpt = optionalWith auto 't' "timeout" "SECONDS" "Maximum seconds to wait for http response before timing out (default 30)" 30

-- | The threshold for the number of differences for compareDirs to auto-output a summary
summaryThreshold :: Int
summaryThreshold = 20

data SourceType = URL | Tag | Dir | File | Cmd
  deriving Eq

-- >>> kojiUrlTag "koji://tag@fedora"
-- Just ("tag", "https://koji.fedoraproject.org/kojihub")
kojiUrlTag :: String -> Maybe (String, String)
kojiUrlTag s = if not (isKojiScheme s)
               then Nothing
               else case elemIndex '@' s of
                      Just pos -> Just (drop (length kojiScheme) $ take pos s, hubUrl $ drop (pos+1) s)
                      Nothing -> Nothing
  where
    kojiScheme = "koji://"
    isKojiScheme loc = kojiScheme `isPrefixOf` loc
    hubUrl "fedora" = Koji.fedoraKojiHub
    hubUrl "centos" = Koji.centosKojiHub
    hubUrl loc = loc

sourceType :: String -> IO SourceType
sourceType s
  | isHttp s  = return URL
  | isKoji s  = return Tag
  | otherwise = do
      dir <- doesDirectoryExist s
      if dir then return Dir
        else if ' ' `elem` s then return Cmd
             else return File
  where
    isKoji :: String -> Bool
    isKoji loc = isJust (kojiUrlTag loc)
    isHttp :: String -> Bool
    isHttp loc = "http:" `isPrefixOf` loc || "https:" `isPrefixOf` loc

-- | Frontend for the pkgtreediff tool
compareDirs :: Bool -> Maybe String -> Ignore -> [Mode] -> Summary -> Bool
            -> Maybe String -> Int -> String -> String -> IO ()
compareDirs recursive msubdir ignore modes summary rst mpattern timeout tree1 tree2 = do
  (ps1,ps2) <- getTrees tree1 tree2
  let diff = diffPkgs ignore ps1 ps2
  if rst
    then printRST diff
    else mapM_ putStrLn . mapMaybe (showPkgDiff modes) $ diff
  when (summary /= NoSummary && null modes) $
    when (summary == ShowSummary || length diff > summaryThreshold) $ do
    putStrLn ""
    (if rst then printRSTHeader else putStrLn) "Summary"
    let diffsum = changesummary diff
    putStrLn $ "Updated: " <> show (updateSum diffsum)
    putStrLn $ "Downgraded: " <> show (downgradeSum diffsum)
    putStrLn $ "Added: " <> show (newSum diffsum)
    putStrLn $ "Deleted: " <> show (delSum diffsum)
    putStrLn $ "Arch changed: " <> show (archSum diffsum)
    putStrLn $ "Total packages: " <> show (length ps1) <> " -> " <> show (length ps2)
  where
    printRSTHeader name = do
      putStrLn ""
      putStrLn name
      putStrLn $ replicate (length name) '~'
      putStrLn ""
    printRSTElem = putStrLn . mappend "- "
    printRSTDiffElem = printRSTElem . drop 2
    printRST diff = do
      printRSTHeader "Updated"
      mapM_ printRSTElem $ mapMaybe (showPkgDiff modes) [x | x@(PkgUpdate _ _) <- diff]
      printRSTHeader "Downgraded"
      mapM_ printRSTElem $ mapMaybe (showPkgDiff modes) [x | x@(PkgDowngrade _ _) <- diff]
      printRSTHeader "Added"
      mapM_ printRSTDiffElem $ mapMaybe (showPkgDiff modes) [x | x@(PkgAdd _) <- diff]
      printRSTHeader "Removed"
      mapM_ printRSTDiffElem $ mapMaybe (showPkgDiff modes) [x | x@(PkgDel _) <- diff]

    getTrees :: String -> String -> IO ([NVRA],[NVRA])
    getTrees t1 t2 = do
      when (t1 == t2) $ warning "Comparing the same tree!"
      src1 <- sourceType t1
      src2 <- sourceType t2
      mmgr <- if src1 == URL || src2 == URL
        then do
        let ms = responseTimeoutMicro $ timeout * 1000000
        Just <$> newManager tlsManagerSettings {managerResponseTimeout = ms}
        else return Nothing
      let act1 = readPackages src1 mmgr t1
          act2 = readPackages src2 mmgr t2
      if (src1,src2) == (Cmd,Cmd)
        then do
        ps1 <- act1
        ps2 <- act2
        return (ps1,ps2)
        else concurrently act1 act2

    readPackages :: SourceType -> Maybe Manager -> String -> IO [NVRA]
    readPackages source mmgr loc = do
      fs <- case source of
              URL -> httpPackages True (fromJust mmgr) loc
              Tag -> kojiPackages (fromJust (kojiUrlTag loc))
              Dir -> dirPackages True loc
              File -> filePackages loc
              Cmd -> cmdPackages $ words loc
      let ps = map readNVRA $ maybe id (filter . (match . compile)) mpattern fs
      return $ sort ps

    httpPackages :: Bool -> Manager -> String -> IO [String]
    httpPackages recurse mgr url = do
      exists <- httpExists mgr url
      fs <-
        if exists
        then do
          mcontenttype <- lookup hContentType <$> httpFileHeaders mgr url
          if mcontenttype == Just (B.pack "text/plain; charset=UTF-8")
            then do
            request <- parseRequest url
            body <- responseBody <$> httpLbs request mgr
            return $ (filter (".rpm" `isSuffixOf`) . map TL.unpack . TL.lines . decodeUtf8) body
            else map T.unpack . filter (\f -> "/" `T.isSuffixOf` f || ".rpm" `T.isSuffixOf` f) <$> httpDirectory mgr url
        else error' $ "Could not get " <> url
      if (recurse || recursive) && all isDir fs
        then concatMapM (httpPackages False mgr) (map (url </>) (filterSubdir fs))
        else return $ filter (not . isDir) fs

    filterSubdir :: [String] -> [String]
    filterSubdir fs =
      case msubdir of
        Just subdir | (subdir <> "/") `elem` fs -> [subdir]
        _ -> fs

    dirPackages recurse dir = do
      fs <- map (dir </>) . sort <$> listDirectory dir
      alldirs <- mapM doesDirectoryExist fs
      if (recurse || recursive) && and alldirs
        then concatMapM (dirPackages False) (filterSubdir fs)
        -- FIXME strictly should limit to files
        else return $ filter (".rpm" `isSuffixOf`) fs

    isDir = ("/" `isSuffixOf`)

    filePackages file =
      filter (not . isPrefixOf "gpg-pubkey-") . words <$> readFile file

    cmdPackages [] = error' "No command prefix given"
    cmdPackages (c:args) =
      -- use words since container seems to append '\r'
      filter (not . isPrefixOf "gpg-pubkey-") . words <$> cmd c args

    kojiPackages (tag, kojiUrl) = map Koji.kbNvr <$> Koji.kojiListTaggedBuilds kojiUrl True tag

showPkgDiff :: [Mode] -> RPMPkgDiff -> Maybe String
showPkgDiff modes diff =
  case diff of
    PkgAdd p -> maybeShowDiff Added "+ " $ showNVRA p
    PkgDel p -> maybeShowDiff Deleted "- " $ showNVRA p
    PkgUpdate p1 p2 -> maybeShowDiff Updated "" $ showPkgChange p1 p2
    PkgArch p1 p2 -> maybeShowDiff Updated "" $ showArchChange p1 p2
    PkgDowngrade p1 p2 -> maybeShowDiff Downgraded "~ " $ showPkgChange p1 p2
  where
    maybeShowDiff :: Mode -> String -> String -> Maybe String
    maybeShowDiff m prefix ds
      | null modes || (m `elem` modes && length modes > 1)
      = Just $ prefix ++ ds
      | modes == [m] = Just ds
      | otherwise = Nothing

    showPkgChange :: NVRA -> NVRA -> String
    showPkgChange p p' =
      showPkgIdent p <> ": " <> showPkgVerRel p <> " -> " <> showPkgVerRel p'

    showArchChange :: NVRA -> NVRA -> String
    showArchChange p p' =
      rpmName p <> ": " <> rpmDetails p <> " -> " <> rpmDetails p'
      where
        rpmDetails :: NVRA -> String
        rpmDetails pkg = showPkgVerRel pkg <> "." <> rpmArch pkg

data DiffSum = DS {updateSum, downgradeSum, newSum, delSum, archSum :: Int}

emptyDS :: DiffSum
emptyDS = DS 0 0 0 0 0

changesummary :: [RPMPkgDiff] -> DiffSum
changesummary =
  foldl' countDiff emptyDS
  where
    countDiff :: DiffSum -> RPMPkgDiff -> DiffSum
    countDiff ds pd =
      case pd of
        PkgUpdate {} -> ds {updateSum = updateSum ds + 1}
        PkgDowngrade {} -> ds {downgradeSum = downgradeSum ds + 1}
        PkgAdd _ -> ds {newSum = newSum ds + 1}
        PkgDel _ -> ds {delSum = delSum ds + 1}
        PkgArch {} -> ds {archSum = archSum ds + 1}

#if !MIN_VERSION_simple_cmd(0,2,0)
warning :: String -> IO ()
warning = hPutStrLn stderr
#endif