content: module TestPsci.TestEnv where
  
  import Prelude
  
  import Control.Exception.Lifted (bracket_)
  import Control.Monad (void, when)
  import Control.Monad.IO.Class (liftIO)
  import Control.Monad.Trans.RWS.Strict (evalRWST, asks, local, RWST)
  import Data.Foldable (traverse_)
  import Data.List (isSuffixOf)
  import Data.Text qualified as T
  import Language.PureScript qualified as P
  import Language.PureScript.CST qualified as CST
  import Language.PureScript.Interactive (Command(..), PSCiConfig(..), PSCiState, handleCommand, indexFile, initialPSCiState, loadAllModules, make, modulesDir, parseCommand, readNodeProcessWithExitCode, runMake, updateLoadedExterns)
  import System.Directory (getCurrentDirectory, doesPathExist, removeFile)
  import System.Exit
  import System.FilePath ((</>), pathSeparator)
  import System.FilePath.Glob qualified as Glob
  import Test.Hspec (shouldBe, Expectation)
  
  -- | A monad transformer for handle PSCi actions in tests
  type TestPSCi a = RWST PSCiConfig () PSCiState IO a
  
  -- | Initialise PSCi state and config for tests
  initTestPSCiEnv :: IO (PSCiState, PSCiConfig)
  initTestPSCiEnv = do
    -- Load test support packages
    cwd <- getCurrentDirectory
    let supportDir = cwd </> "tests" </> "support"
    psciFiles <- Glob.globDir1 (Glob.compile "**/*.purs") (supportDir </> "psci")
    libraries <- Glob.globDir1 (Glob.compile "purescript-*/src/**/*.purs") (supportDir </> "bower_components")
    let pursFiles = psciFiles ++ libraries
    modulesOrError <- loadAllModules pursFiles
    case modulesOrError of
      Left err ->
        print err >> exitFailure
      Right modules -> do
        -- Make modules
        makeResultOrError <- runMake . make $ fmap CST.pureResult <$> modules
        case makeResultOrError of
          Left errs -> putStrLn (P.prettyPrintMultipleErrors P.defaultPPEOptions errs) >> exitFailure
          Right (externs, _) ->
            return (updateLoadedExterns (const (zip (map snd modules) externs)) initialPSCiState, PSCiConfig pursFiles)
  
  -- | Execute a TestPSCi, returning IO
  execTestPSCi :: TestPSCi a -> IO a
  execTestPSCi i = do
    (s, c) <- initTestPSCiEnv -- init state and config
    fst <$> evalRWST i c s
  
  -- | Evaluate JS to which a PSCi input is compiled. The actual JS input is not
  -- needed as an argument, as it is already written in the file during the
  -- command evaluation.
  jsEval :: TestPSCi String
  jsEval = liftIO $ do
    writeFile indexFile "import('./$PSCI/index.js').then(({ $main }) => $main());"
    result <- readNodeProcessWithExitCode Nothing [indexFile] ""
    case result of
      Right (ExitSuccess, out, _)   -> return out
      Right (ExitFailure _, _, err) -> putStrLn err >> exitFailure
      Left err                      -> putStrLn err >> exitFailure
  
  -- | Run a PSCi command and evaluate its outputs:
  -- * jsOutputEval is used to evaluate compiled JS output by PSCi
  -- * printedOutputEval is used to evaluate text printed directly by PSCi itself
  runAndEval :: String -> TestPSCi () -> (String -> TestPSCi ()) -> TestPSCi ()
  runAndEval comm jsOutputEval textOutputEval =
    case parseCommand comm of
      Left errStr -> liftIO $ putStrLn errStr >> exitFailure
      Right commands ->
        -- The JS result is ignored, as it's already written in a JS source file.
        -- For the detail, please refer to Interactive.hs
        traverse_ (handleCommand (const jsOutputEval) (return ()) textOutputEval) commands
  
  -- | Run a PSCi command, evaluate compiled JS, and ignore evaluation output and printed output
  run :: String -> TestPSCi ()
  run comm = runAndEval comm (void jsEval) ignorePrinted
    where
      ignorePrinted _ = return ()
  
  -- | A lifted evaluation of Hspec 'shouldBe' for the TestPSCi
  equalsTo :: (Eq a, Show a) => a -> a -> TestPSCi ()
  equalsTo x y = liftIO $ x `shouldBe` y
  
  -- | An assertion to check command evaluated javascript output against a given string
  evaluatesTo :: String -> String -> TestPSCi ()
  evaluatesTo command expected = runAndEval command evalJsAndCompare ignorePrinted
    where
      evalJsAndCompare = do
        actual <- jsEval
        actual `equalsTo` (expected ++ "\n")
      ignorePrinted _ = return ()
  
  -- | An assertion to check command PSCi printed output against a given string
  prints :: String -> String -> TestPSCi ()
  prints command expected = printed command (`shouldBe` expected)
  
  printed :: String -> (String -> Expectation) -> TestPSCi ()
  printed command f = runAndEval command (void jsEval) (liftIO . f)
  
  simulateModuleEdit :: P.ModuleName -> FilePath -> TestPSCi a -> TestPSCi a
  simulateModuleEdit mn newPath action = do
    ms <- asks psciFileGlobs
    case replacePath ms of
      Nothing  -> fail $ "Did not find " ++ inputPath ++ " in psciFileGlobs"
      Just xs' -> local (\c -> c { psciFileGlobs = xs' }) temporarily <* rebuild
  
    where
    outputPath = modulesDir </> T.unpack (P.runModuleName mn) </> "index.js"
    inputPath  = T.unpack (T.replace "." slash (P.runModuleName mn)) ++ ".purs"
    slash      = T.singleton pathSeparator
  
    replacePath :: [String] -> Maybe [String]
    replacePath (x:xs)
      | inputPath `isSuffixOf` x = Just (newPath : xs)
      | otherwise                = fmap (x:) (replacePath xs)
    replacePath []               = Nothing
  
    -- Simply adding the file to `PSCiConfig.fileGlobs` isn't sufficient; running
    -- ":reload" might not rebuild because the compiled JS artifact has a more
    -- recent timestamp than the "new" source file `newPath`.
    temporarily   = bracket_ enableRebuild enableRebuild action
    enableRebuild = liftIO $ do { b <- doesPathExist outputPath; when b (removeFile outputPath) }
    rebuild       = handleCommand discard (return ()) discard ReloadState
    discard _     = return ()
  