module TestPsci.EvalTest where import Prelude () import Prelude.Compat 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 qualified System.FilePath.Glob as Glob import System.IO.UTF8 (readUTF8File) import Test.Hspec import TestPsci.TestEnv 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 $ intercalate " " 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