1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
|
module TestPsci.TestEnv where
import Prelude ()
import Prelude.Compat
import Control.Monad.IO.Class (liftIO)
import Control.Monad.Trans.RWS.Strict (evalRWST, RWST)
import qualified Language.PureScript as P
import Language.PureScript.Interactive
import System.Directory (getCurrentDirectory)
import System.Exit
import System.FilePath ((</>))
import qualified System.FilePath.Glob as Glob
import System.Process (readProcessWithExitCode)
import Test.Hspec (shouldBe)
-- | 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" </> "bower_components"
let supportFiles ext = Glob.globDir1 (Glob.compile ("purescript-*/src/**/*." ++ ext)) supportDir
pursFiles <- supportFiles "purs"
modulesOrError <- loadAllModules pursFiles
case modulesOrError of
Left err ->
print err >> exitFailure
Right modules -> do
-- Make modules
makeResultOrError <- runMake . make $ modules
case makeResultOrError of
Left errs -> putStrLn (P.prettyPrintMultipleErrors P.defaultPPEOptions errs) >> exitFailure
Right (externs, env) ->
return (PSCiState [] [] (zip (map snd modules) externs), PSCiConfig pursFiles env)
-- | 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 "require('$PSCI')['$main']();"
process <- findNodeProcess
result <- traverse (\node -> readProcessWithExitCode node [indexFile] "") process
case result of
Just (ExitSuccess, out, _) -> return out
Just (ExitFailure _, _, err) -> putStrLn err >> exitFailure
Nothing -> putStrLn "Couldn't find node.js" >> exitFailure
-- | Run a PSCi command and evaluate the output with 'eval'.
runAndEval :: String -> TestPSCi () -> TestPSCi ()
runAndEval comm eval =
case parseCommand comm of
Left errStr -> liftIO $ putStrLn errStr >> exitFailure
Right command ->
-- the JS result can be ignored, as it's already written in a source file
-- for the detail, please refer to Interactive.hs
handleCommand (\_ -> eval) (return ()) (\_ -> return ()) command
-- | Run a PSCi command and ignore the output
run :: String -> TestPSCi ()
run comm = runAndEval comm $ jsEval *> 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 if a command evaluates to a string
evaluatesTo :: String -> String -> TestPSCi ()
evaluatesTo command expected = runAndEval command $ do
actual <- jsEval
actual `equalsTo` (expected ++ "\n")
|
