content: {-# LANGUAGE LambdaCase, OverloadedStrings, ViewPatterns, QuasiQuotes #-}
  module Main (main) where
  
  import Text.RE.TDFA.Text.Lazy
  import Text.Printf
  import qualified Data.Text.Lazy as LT
  import qualified Data.Text.Lazy.Encoding as LT
  import qualified Data.Text.Lazy.IO as LT
  import qualified Data.ByteString.Lazy.Char8 as LBS
  import qualified System.Process as P
  import System.FilePath
  import System.IO.Temp
  import System.Exit
  import System.IO
  import Control.Exception
  
  import Test.Tasty
  import Test.Tasty.Golden as G
  import Test.Tasty.Golden.Advanced as G
  
  import Test.DAP.RunInTerminal
  import Test.Utils
  
  main :: IO ()
  main = do
    goldens <- mapM (mkGoldenTest False) =<< findByExtension [".hdb-test"] "test/golden"
    defaultMain $
      testGroup "Tests"
        [ testGroup "Golden tests" goldens
        , testGroup "Unit tests" unitTests
        ]
  
  unitTests =
    [ runInTerminalTests
    ]
  
  -- | Receives as an argument the path to the @*.hdb-test@ which contains the
  -- shell invocation for running 
  mkGoldenTest :: Bool -> FilePath -> IO TestTree
  mkGoldenTest keepTmpDirs path = do
    let testName   = takeBaseName     path
    let goldenPath = replaceExtension path ".hdb-stdout"
    return (goldenVsStringComparing testName goldenPath action)
    where
      action :: IO LBS.ByteString
      action = do
        script <- readFile path
        withHermeticDir keepTmpDirs (takeDirectory path) $ \test_dir -> do
          (_, Just hout, _, p)
            <- P.createProcess (P.shell script){P.cwd = Just test_dir, P.std_out = P.CreatePipe}
          P.waitForProcess p >>= \case
            ExitSuccess   -> LBS.hGetContents hout
            ExitFailure c -> error $ "Test script in " ++ test_dir ++ " failed with exit code: " ++ show c
          
  --------------------------------------------------------------------------------
  -- Tasty Golden Advanced wrapper
  --------------------------------------------------------------------------------
  
  -- | Compare a given string against the golden file's contents using the given normalising function
  -- This is inlined from 'goldenVsString' and the accompanying functions. We
  -- wanted the same but with a normalising function.
  goldenVsStringComparing
    :: TestName -- ^ test name
    -> FilePath -- ^ path to the «golden» file (the file that contains correct output)
    -> IO LBS.ByteString
    -- ^ action that returns a string
    -> TestTree
    -- ^ the test verifies that the returned string is the same as the golden file contents
  goldenVsStringComparing name ref act = do
  
    -- Normalise the output. The test file should already be saved normalised.
    goldenTest name (LT.decodeUtf8 <$> readFileStrict ref) normalisingAct cmpNormalising upd
  
    where
    upd = createDirectoriesAndWriteFile ref . LT.encodeUtf8
  
    -- Normalise the action producing the output
    normalisingAct = do
      tmpDir <- getCanonicalTemporaryDirectory
      replaceRE <- compileSearchReplace (tmpDir ++ ".*" ++ takeBaseName (takeDirectory ref) {- the folder in which the test is run, inside the canonical temp dir-})
                                        "<TEMPORARY-DIRECTORY>"
  
      let normalising (LT.decodeUtf8 -> txt) = txt *=~/ replaceRE
  
      normalising <$> act
  
    readFileStrict :: FilePath -> IO LBS.ByteString
    readFileStrict path = do
      s <- LBS.readFile path
      evaluate $ forceLbs s
      return s
  
    forceLbs :: LBS.ByteString -> ()
    forceLbs = LBS.foldr seq ()
  
  --------------------------------------------------------------------------------
  -- Normalisation
  --------------------------------------------------------------------------------
  
    -- | Compare the golden test against the actual output after normalisation
    cmpNormalising :: LT.Text -> LT.Text -> IO (Maybe String)
    cmpNormalising x y = do
  
      let
        msg = printf "Test output was different from '%s'. It was:\n" ref <> (LT.unpack y)
  
      if x == y
        then return Nothing
        else do
          -- Call diff to show the difference
          withSystemTempFile "x.txt" $ \xf xH -> do
            withSystemTempFile "y.txt" $ \yf yH -> do
              LT.hPutStr xH x
              LT.hPutStr yH y
              hFlush xH
              hFlush yH
              hClose xH
              hClose yH
              (_exitCode, out, err) <- P.readProcessWithExitCode "diff" ["-u", xf, yf] ""
              return $ Just $ msg ++ "\nDiff output:\n" ++ out ++ err
  
  