EvalTest.hs

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