blob: 6a2b1ab5881f99ea2f7941b10d63336a538a9467 (
plain)
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
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
|
module Minilang.REPL.NetSpec where
-- import Control.Concurrent (threadDelay)
import Control.Concurrent.Async
import Control.Concurrent.STM.TVar
import Control.Exception (bracket)
import Control.Monad (forM)
import Data.Aeson (eitherDecode, encode)
import Minilang.Lambda.Eval (Term (..), newEnv)
import Minilang.Lambda.Infer (newContext)
import qualified Minilang.Lambda.Parser as AST
import Minilang.Lambda.Unify (Type (..))
import Minilang.Log
import Minilang.REPL.Net
import Minilang.REPL.Types
import Minilang.Server (Server (..))
import Network.HTTP.Types (status400)
import Network.Wai (responseLBS)
import Network.Wai.Handler.Warp as Warp
import Network.WebSockets as WS
import System.Directory
import System.FilePath ((</>))
import System.IO (hClose)
import System.Posix.Temp (mkstemp)
import Test.Hspec
import Prelude hiding (lines, readFile, writeFile)
startServer :: IO Server
startServer = do
(port, socket) <- openFreePort
envs <- newTVarIO mempty
logger <- newLog "test"
let app = runNetREPL logger envs (\_ resp -> resp $ responseLBS status400 [] "Not a WebSocket request")
settings = setGracefulShutdownTimeout (Just 0) defaultSettings
thread <- async $ Warp.runSettingsSocket settings socket app
pure $ Server (Just thread) port
stopServer :: Server -> IO ()
stopServer (Server (Just th) _) = cancel th
stopServer _ = pure ()
withServer :: (Server -> IO c) -> IO c
withServer =
bracket startServer stopServer
runTestClient :: Int -> String -> [In] -> IO [Either String Out]
runTestClient port envId inputs =
runClient "127.0.0.1" port ("/repl/" <> envId) client
where
client cnx = do
outs <- forM inputs $ \inp -> do
WS.sendBinaryData cnx (encode inp)
eitherDecode <$> WS.receiveData cnx
WS.sendBinaryData cnx (encode EOF)
WS.sendClose cnx (encode ("" :: String))
pure outs
temporaryFile :: (FilePath -> IO c) -> IO c
temporaryFile = bracket newTempFile removeFile
where
newTempFile = do
dir <- getTemporaryDirectory
(f, h) <- mkstemp (dir </> "repl.test")
hClose h
pure f
spec :: Spec
spec = around withServer $
describe "MiniLang Network REPL" $ do
it "evaluates expression and returns evaluation result" $ \Server {serverPort} -> do
let inp = [Com (Set (SelectLanguage Typed)), In "((lam (x) x) y)"]
expectedOutput =
[ Right (Msg "Language set to Typed"),
Right $ Evaluated (AST.Sym "y") (Var "y") (TyVar "a")
]
res <- runTestClient serverPort ".newenv1" inp
res `shouldBe` expectedOutput
it "allows retrieving empty initial env" $ \Server {serverPort} -> do
let inp = [Com (Set (SelectLanguage Typed)), Com DumpEnv]
expectedOutput =
[ Right (Msg "Language set to Typed"),
Right $ CurrentEnv newEnv newContext Typed
]
res <- runTestClient serverPort ".newenv2" inp
res `shouldBe` expectedOutput
it "can reconnect to existing environment" $ \Server {serverPort} -> do
let inp = [In "Unit : U = Sum(tt)"]
_ <- runTestClient serverPort ".newenv3" inp
res <- runTestClient serverPort ".newenv3" [In "Unit"]
res `shouldSatisfy` isEvaluated
isEvaluated :: [Either a Out] -> Bool
isEvaluated [Right (Evaluated _ _ _)] = True
isEvaluated _ = False
|
