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

#if (defined(MIN_VERSION_directory) && MIN_VERSION_directory(1,2,3))
#else
import Control.Exception (bracket)
#endif
import Control.Monad
import qualified Data.ByteString.Char8 as B
import Data.Char (isDigit)
import Data.List
import qualified Data.Map.Strict (assocs, keys, lookup)
import Data.Maybe
import Data.Semigroup ((<>))
import qualified Data.Set as Set
import qualified Data.Text as T
import Data.Version
import Options.Applicative
import System.Directory
import System.FilePath
import System.IO (hPutStrLn, stderr)
import System.Posix.IO (stdInput)
import System.Posix.Terminal (queryTerminal)
import Text.ParserCombinators.ReadP (readP_to_S)

import Stackage.Types hiding (unPackageName)
import Data.Foldable (traverse_)
import Data.Yaml hiding (Parser)
import Distribution.Package (PackageName, unPackageName)
import Distribution.Text (disp)
import Network.HTTP.Directory (httpManager, httpRedirect)

import SimpleCmd (cmd_)
import SimpleCmdArgs

import Paths_stackage_query (version)

data Snapshot = LatestNightly | LatestLTS | NightlySnap String | LtsSnap String | LtsMajor String

instance Show Snapshot where
  show LatestNightly = "nightly"
  show LatestLTS = "lts"
  show (NightlySnap date) = "nightly-" <> date
  show (LtsSnap ver) = "lts-" <> ver
  show (LtsMajor ver) = "lts-" <> ver

instance Read Snapshot where
  readsPrec _ "nightly" = [(LatestNightly,"")]
  readsPrec _ "lts" = [(LatestLTS,"")]
  readsPrec _ input | "nightly-" `isPrefixOf` input =
    let (date,rest) = span (\ c -> isDigit c || c == '-') $ removePrefix "nightly-" input in
       [(NightlySnap date,rest)]
  readsPrec _ input | "lts-" `isPrefixOf` input =
    let (ver,rest) = span (\ c -> isDigit c || c == '.') $ removePrefix "lts-" input in
      [(if '.' `elem` ver then LtsSnap ver else LtsMajor ver,rest)]
  readsPrec _ _ = []

removePrefix :: String -> String-> String
removePrefix pref orig = fromMaybe orig (stripPrefix pref orig)

data Project = LTS | Nightly deriving (Eq)

instance Show Project where
  show LTS = "lts-haskell"
  show Nightly = "stackage-nightly"

type Pkg = String

consumeParser :: Parser Int
consumeParser =
  optionalWith auto 'm' "minimum" "THRESHOLD" "Show packages with at least THRESHOLD consumers (default 5)" 5

parsePkg :: Parser Pkg
parsePkg = strArg "PKG"

parseSnap :: Parser Snapshot
parseSnap = argument auto $ metavar "SNAP"

main :: IO ()
main =
  simpleCmdArgs (Just version) "Stackage query tool" "" $
  subcommands
    [ Subcommand "package" "Show version of PKG in SNAP" $
      buildplanPackage <$> parseSnap <*> parsePkg
    , Subcommand "users" "Revdeps for PKG in SNAP" $
      buildplanUsers <$> parseSnap <*> parsePkg
    , Subcommand "github" "Stackage owners for PKG in SNAP" $
      buildplanGithub <$> parseSnap <*> parsePkg
    , Subcommand "constraints" "Stackage constraints for PKG in SNAP" $
      buildplanConstraints <$> parseSnap <*> parsePkg
    , Subcommand "dependencies" "Dependencies for PKG in SNAP" $
      buildplanDependencies <$> parseSnap <*> parsePkg
    , Subcommand "executables" "Executables of PKG in SNAP" $
      buildplanExecutables <$> parseSnap <*> parsePkg
    , Subcommand "modules" "Modules of PKG in SNAP" $
      buildplanModules <$> parseSnap <*> parsePkg
    , Subcommand "latest" "Latest snap for PROJECT (nightly or lts)" $
      buildplanLatest <$> parseSnap
    , Subcommand "ghc" "GHC version for SNAP" $
      buildplanGHC <$> parseSnap
    , Subcommand "core" "GHC core libraries for SNAP" $
      buildplanCore <$> parseSnap
    , Subcommand "tools" "Tools for SNAP" $
      buildplanTools <$> parseSnap <*> optional parsePkg
    , Subcommand "packages" "All packages in SNAP" $
      buildplanPackages <$> parseSnap
    , Subcommand "consumers" "No of users of packages in SNAP" $
      buildplanConsumers <$> consumeParser <*> parseSnap
    , Subcommand "config" "Download cabal.config file for SNAP" $
      stackageConfig <$> parseSnap
    ]

topurl :: String
topurl = "https://www.stackage.org/"

stackageConfig :: Snapshot -> IO ()
stackageConfig snap = do
  let url = topurl </> show snap </> "cabal.config"
  cmd_ "curl" ["-L", "-O", url]

getConfigDir :: IO FilePath
getConfigDir = do
  home <- getHomeDirectory
  let confdir = home </> ".stackage-query"
  createDirectoryIfMissing False confdir
  return confdir

getProjectDir :: Project -> IO FilePath
getProjectDir project = do
  configDir <- getConfigDir
  let projectDir = configDir </> show project
  haveProj <- doesDirectoryExist projectDir
  unless haveProj $ createDirectoryIfMissing False projectDir
  return projectDir

getBuildPlan :: Snapshot -> IO BuildPlan
getBuildPlan snap = do
  ebp <- findBuildPlanYaml >>= decodeFileEither
  either (error . prettyPrintParseException) return ebp
  where
    findBuildPlanYaml :: IO FilePath
    findBuildPlanYaml = do
      dir <- getProjectDir $ snapProject snap
      findSnap dir snap

snapProject :: Snapshot -> Project
snapProject LatestLTS = LTS
snapProject (LtsSnap _) = LTS
snapProject (LtsMajor _) = LTS
snapProject _ = Nightly

findSnap :: FilePath -> Snapshot -> IO FilePath
findSnap dir snap = do
  fs <-  sortProject . filter (show snap `isPrefixOf`) <$> getDirectoryContents dir
  if null fs
    then downloadLatest
    else return $ dir </> last fs
  where
    sortProject :: [String] -> [String]
    sortProject =
      if snapProject snap == Nightly
      then sort
      else map ((\v -> "lts-" <> v <.> "yaml") . showVersion) . sort . map (readVersion . takeBaseName . removePrefix "lts-")

    downloadLatest :: IO FilePath
    downloadLatest = do
      latest <- latestSnap snap
      downloadSnap latest
      return $ dir </> show latest <.> "yaml"

    downloadSnap :: Snapshot -> IO ()
    downloadSnap snp = do
      let proj = snapProject snp
      withCurrentDirectory dir $ do
        tty <- queryTerminal stdInput
        let silent = if tty then ["-#"] else ["-s", "-S"]
            yaml = show snp <.> "yaml"
            url = "https://raw.githubusercontent.com/commercialhaskell" </> show proj </> "master" </> yaml
        hPutStrLn stderr $ "Downloading " <> yaml
        cmd_ "curl" $ silent ++ ["-O", url]

readVersion :: String -> Version
readVersion s =
  let vp = readP_to_S parseVersion s in
    if null vp then giveup
    else case last vp of
           (ver,"") -> ver
           _ -> giveup
  where
    giveup = error $ "readVersion: failed to parse " <> s

buildplanGHC :: Snapshot -> IO ()
buildplanGHC snap = do
  bp <- getBuildPlan snap
  let si = bpSystemInfo bp
  putStrLn $ (showVersion . siGhcVersion) si

showPkgVer :: (PackageName, Version) -> String
showPkgVer (p,v) = unPackageName p <> " " <> showVersion v

buildplanCore :: Snapshot -> IO ()
buildplanCore snap = do
  bp <- getBuildPlan snap
  let si = bpSystemInfo bp
  traverse_ (putStrLn . showPkgVer) $ (Data.Map.Strict.assocs . siCorePackages) si

buildplanTools :: Snapshot -> Maybe Pkg -> IO ()
buildplanTools snap mpkg = do
  bp <- getBuildPlan snap
  maybe (traverse_ (putStrLn . showPkgVer) $ bpTools bp) (buildplanPkgTools snap) mpkg

buildplanPackages :: Snapshot -> IO ()
buildplanPackages snap = do
  bp <- getBuildPlan snap
  traverse_ (putStrLn . showPkgVer) $ Data.Map.Strict.assocs $ ppVersion <$> bpPackages bp

buildplanConsumers :: Int -> Snapshot -> IO ()
buildplanConsumers threshold snap = do
  bp <- getBuildPlan snap
  traverse_ putPkgConsumption $ Data.Map.Strict.assocs $ ppUsers <$> bpPackages bp
  where
    putPkgConsumption :: (PackageName, Set.Set PackageName) -> IO ()
    putPkgConsumption (p, users) = do
      let n = length users
      when (n >= threshold) $
        putStrLn $ show n <> " " <> unPackageName p

evalPackageBuildPlan :: Snapshot -> Pkg -> (PackagePlan -> String) -> IO ()
evalPackageBuildPlan snap pkg expr = do
  bp <- getBuildPlan snap
  let mpkgplan = Data.Map.Strict.lookup (mkPackageName pkg) $ bpPackages bp
  putStrLn $ maybe (error "Package not found") expr mpkgplan

buildplanPackage :: Snapshot -> Pkg -> IO ()
buildplanPackage snap pkg =
  evalPackageBuildPlan snap pkg (showVersion . ppVersion)

buildplanUsers :: Snapshot -> Pkg -> IO ()
buildplanUsers snap pkg =
  evalPackageBuildPlan snap pkg (unwords . Set.elems . Set.map unPackageName . ppUsers)

buildplanGithub :: Snapshot -> Pkg -> IO ()
buildplanGithub snap pkg =
  evalPackageBuildPlan snap pkg (unwords . Set.elems . Set.map T.unpack . ppGithubPings)

latestSnap :: Snapshot -> IO Snapshot
latestSnap snap = do
  mgr <- httpManager
  latest <- httpRedirect mgr $ topurl </> show snap
  return $ maybe snap (read . B.unpack . B.tail) latest

buildplanLatest :: Snapshot -> IO ()
buildplanLatest =
  latestSnap >=> print

buildplanConstraints :: Snapshot -> Pkg -> IO ()
buildplanConstraints snap pkg =
  evalPackageBuildPlan snap pkg (show . disp . pcVersionRange . ppConstraints)

buildplanDependencies :: Snapshot -> Pkg -> IO ()
buildplanDependencies snap pkg =
  evalPackageBuildPlan snap pkg (unlines . map unPackageName . Data.Map.Strict.keys . sdPackages . ppDesc)

buildplanExecutables :: Snapshot -> Pkg -> IO ()
buildplanExecutables snap pkg =
  evalPackageBuildPlan snap pkg (unlines . map (T.unpack . unExeName) . Set.toList. sdProvidedExes . ppDesc)

buildplanPkgTools :: Snapshot -> Pkg -> IO ()
buildplanPkgTools snap pkg =
  evalPackageBuildPlan snap pkg (unlines . map (T.unpack . unExeName) . Data.Map.Strict.keys . sdTools . ppDesc)

buildplanModules :: Snapshot -> Pkg -> IO ()
buildplanModules snap pkg =
  evalPackageBuildPlan snap pkg (unlines . map T.unpack . Set.toList. sdModules . ppDesc)

#if (defined(MIN_VERSION_directory) && MIN_VERSION_directory(1,2,3))
#else
withCurrentDirectory :: FilePath -> IO a -> IO a
withCurrentDirectory dir action =
  bracket getCurrentDirectory setCurrentDirectory $ \ _ -> do
    setCurrentDirectory dir
    action
#endif