{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}

module Main where

import Control.Monad ( MonadFail(fail) )
import Data.Text qualified as T
import Gargantext.Prelude
import System.IO ( BufferMode(NoBuffering), hGetContents, hSetBuffering )
import System.IO.Error (userError)
import System.Process
import System.Posix.Process ( getProcessGroupIDOf )
import System.Posix.Signals ( keyboardSignal, signalProcessGroup )
import Test.API qualified as API
import Test.Database.Operations qualified as DB
import Test.Database.Transactions qualified as DBT
import Test.Hspec ( hspec, sequential, describe )
import Test.Server.ReverseProxy qualified as ReverseProxy
import Test.Core.LinearAlgebra         qualified as LinearAlgebra
import Test.Core.Notifications         qualified as Notifications
import Test.Core.Orchestrator          qualified as Orchestrator
import Test.Core.Similarity            qualified as Similarity
import Test.Core.Text.Corpus.Query     qualified as CorpusQuery
import Test.Core.Text.Corpus.TSV       qualified as TSVParser
import Test.Core.Phylo                 qualified as CorePhylo
import Test.Core.Utils                 qualified as Utils
import Test.Core.Worker                qualified as Worker
import Test.Graph.Clustering           qualified as Clustering
import Test.Graph.Distance             qualified as Distance
import Test.Ngrams.Lang.Occurrences    qualified as Occurrences
import Test.Ngrams.NLP                 qualified as NLP
import Test.Ngrams.Query               qualified as NgramsQuery
import Test.Ngrams.Terms               qualified as NgramsTerms
import Test.Offline.Errors             qualified as Errors
import Test.Offline.JSON               qualified as JSON
import Test.Offline.Ngrams             qualified as Ngrams
import Test.Offline.Phylo              qualified as Phylo
import Test.Offline.Stemming.Lancaster qualified as Lancaster
import Test.Parsers.Date               qualified as PD
import Test.Utils.Crypto               qualified as Crypto
import Test.Utils.Jobs                 qualified as Jobs


startCoreNLPServer :: IO (Handle, Handle, ProcessHandle)
startCoreNLPServer = do
  let p = proc "nix" [ "run"
                     , "git+https://gitlab.iscpif.fr/gargantext/corenlp-nix.git" ]
  (_, m_stdout_hdl, m_stderr_hdl, hdl) <- (createProcess $ p { cwd = Nothing
                    -- NOTE(adn) Issue #451, this one has to stay disabled, because if we
                    -- turn it on, despite the confusing documentation on the `process` library
                    -- it will cause the Haskell RTS to completely ignore the Ctrl^c and instead
                    -- delegate it exclusively to the process here, which means that our CoreNLP
                    -- server will shut down correctly, but the test running will stop responding
                    -- to Ctrl^C requests.
                    , delegate_ctlc = False
                    , create_group = True
                    , std_out = CreatePipe
                    , std_err = CreatePipe
                    }) `catch` \(e :: SomeException) ->
                                 case e of
                                   _ | True <- "does not exist" `T.isInfixOf` (T.pack . show @SomeException $ e)
                                     -> fail $ "Cannot execute the 'corenlp' via nix flakes. Make sure you have 'nix' installed."
                                     | otherwise -> throwIO e

  let stdout_hdl = fromMaybe (errorTrace "Can't get stdout handle!") m_stdout_hdl
  let stderr_hdl = fromMaybe (errorTrace "Can't get stderr handle!") m_stderr_hdl
                                     
  pure (stdout_hdl, stderr_hdl, hdl)

killProcessTree :: (Handle, Handle, ProcessHandle) -> IO ()
killProcessTree (_stdout_hdl, stderr_hdl, ph) = do
  pid <- getPid ph
  case pid of
    Nothing -> putText "Process already terminated"
    Just p -> do
      pgid <- getProcessGroupIDOf p
      signalProcessGroup keyboardSignal pgid
      -- cleanupProcess (Nothing, Just stdout_hdl, Just stderr_hdl, ph)
      -- putText "killProcessTree terminating process"
      -- terminateProcess ph
  errContent <- hGetContents stderr_hdl
  unless (errContent == "") $ putText $ "CoreNLP ERROR:\n" <> T.pack errContent


-- NOTE(seeg) createProcess is nonblocking, and so its exception
-- handling is incomplete:
--   λ> createProcess $ proc "l" []
--   *** Exception: l: createProcess: posix_spawnp: does not exist (No such file or directory)
--   λ> createProcess $ proc "ls" ["haha"]
--   ls: cannot access 'haha': No such file or directory
-- Credit for this construct goes to @adn
waitOrDie :: (Handle, Handle, ProcessHandle) -> IO ()
waitOrDie (stdout_h, stderr_h, h) = do
  ec <- waitForProcess h
  when (ec /= ExitSuccess) $ do
    out <- hGetContents stdout_h
    err <- hGetContents stderr_h
    throwIO $ userError ("Async process quit!\nStdout:\n" <> out <> "\nStderr:\n" <> err)


-- It's especially important to use Hspec for DB tests, because,
-- unlike 'tasty', 'Hspec' has explicit control over parallelism,
-- and it's important that DB tests are run according to a very
-- precise order, as they are not independent from each other.
-- Unfortunately it's not possibly to use the 'tasty-hspec' adapter
-- because by the time we get a 'TestTree' out of the adapter library,
-- the information about parallelism is lost.
main :: IO ()
main = do
  hSetBuffering stdout NoBuffering
  bracket startCoreNLPServer killProcessTree $ \h -> do
    corenlpP <- async $ waitOrDie h
    testP <- async run_tests

    void $ wait testP

    cancel corenlpP
  where
    run_tests = hspec $ sequential $ do
      API.tests
      ReverseProxy.tests
      DB.tests
      DBT.tests
      DB.nodeStoryTests
      describe "Utils" $ Utils.test
      describe "CorePhylo" $ CorePhylo.test
      describe "Graph Clustering" $ Clustering.test
      describe "Graph Distance" $ Distance.test
      describe "Date split" $ PD.testDateSplit
      describe "Crypto" $ Crypto.test
      describe "NLP" $ NLP.test
      describe "Jobs" $ Jobs.test
      describe "Similarity" $ Similarity.test
      describe "Notifications" $ Notifications.test
      describe "Occurrences" $ Occurrences.test
      describe "LinearAlgebra" $ LinearAlgebra.tests
      describe "Orchestrator" $ Orchestrator.qcTests
      describe "Corpus Query" $ CorpusQuery.tests
      describe "TSV Parser"   $ TSVParser.tests
      describe "Worker"       $ Worker.tests
      describe "Ngrams Query" $ NgramsQuery.tests
      describe "Ngrams Terms" $ NgramsTerms.tests
      describe "Offline" $ do
        describe "Errors" $ Errors.tests
        describe "JSON" $ JSON.tests
        describe "Ngrams" $ Ngrams.tests
        describe "Phylo" $ Phylo.tests
        describe "Lancaster" $ Lancaster.tests
