content: module TestPsci.EvalTest where
  
  import Prelude
  
  import Control.Monad (forM_, foldM_)
  import Control.Monad.IO.Class (liftIO)
  import Data.List (stripPrefix, intercalate)
  import Data.List.Split (splitOn)
  import System.Directory (getCurrentDirectory)
  import System.Exit (exitFailure)
  import System.FilePath ((</>), takeFileName)
  import System.FilePath.Glob qualified as Glob
  import System.IO.UTF8 (readUTF8File)
  import Test.Hspec (Spec, context, runIO, specify)
  import TestPsci.TestEnv (TestPSCi, evaluatesTo, execTestPSCi, run)
  
  evalTests :: Spec
  evalTests = context "evalTests" $ do
    testFiles <- runIO evalTestFiles
    forM_ testFiles evalTest
  
  evalTestFiles :: IO [FilePath]
  evalTestFiles = do
    cwd <- getCurrentDirectory
    let psciExamples = cwd </> "tests" </> "purs" </> "psci"
    Glob.globDir1 (Glob.compile "**/*.purs") psciExamples
  
  data EvalLine = Line String
                | Comment EvalContext
                | Empty
                | Invalid String
                deriving (Show)
  
  data EvalContext = ShouldEvaluateTo String
                   | Paste [String]
                   | None
                   deriving (Show)
  
  evalCommentPrefix :: String
  evalCommentPrefix = "-- @"
  
  parseEvalLine :: String -> EvalLine
  parseEvalLine "" = Empty
  parseEvalLine line =
    case stripPrefix evalCommentPrefix line of
      Just rest ->
        case splitOn " " rest of
          "shouldEvaluateTo" : args -> Comment (ShouldEvaluateTo $ unwords args)
          ["paste"] -> Comment (Paste [])
          _ -> Invalid line
      Nothing -> Line line
  
  evalTest :: FilePath -> Spec
  evalTest f = specify (takeFileName f) $ do
    evalLines <- map parseEvalLine . lines <$> readUTF8File f
    execTestPSCi $ foldM_ handleLine None evalLines
  
  handleLine :: EvalContext -> EvalLine -> TestPSCi EvalContext
  handleLine ctx Empty = pure ctx
  handleLine None (Line stmt) = run stmt >> pure None
  handleLine None (Comment ctx) = pure ctx
  handleLine (ShouldEvaluateTo expected) (Line expr) = expr `evaluatesTo` expected >> pure None
  handleLine (Paste ls) (Line l) = pure . Paste $ ls ++ [l]
  handleLine (Paste ls) (Comment (Paste _)) = run (intercalate "\n" ls) >> pure None
  handleLine _ line = liftIO $ putStrLn ("unexpected: " ++ show line) >> exitFailure
  