Add tests for Net-based REPL

4 files changed, 112 insertions, 2 deletions

diff --git a/lambda-calcul/haskell/minilang.cabal b/lambda-calcul/haskell/minilang.cabal
index 46f74c4..37ec9a1 100644
--- a/lambda-calcul/haskell/minilang.cabal
+++ b/lambda-calcul/haskell/minilang.cabal
@@ -92,6 +92,7 @@ test-suite minilang-test
       Minilang.Lambda.ParserSpec
       Minilang.REPLSpec
       Minilang.REPL.HaskelineSpec
+      Minilang.REPL.NetSpec
   hs-source-dirs:
       test
   default-extensions:
@@ -108,6 +109,7 @@ test-suite minilang-test
       hspec-discover:hspec-discover
   build-depends:
       QuickCheck
+    , aeson
     , async
     , base
     , bytestring
@@ -119,11 +121,16 @@ test-suite minilang-test
     , haskeline
     , hspec
     , hspec-discover
+    , http-types
     , minilang
     , mtl
+    , stm
     , text
     , unix
     , unordered-containers
+    , wai
+    , warp
+    , websockets
   default-language: Haskell2010
 
 executable lambda
diff --git a/lambda-calcul/haskell/public/index.html b/lambda-calcul/haskell/public/index.html
index 2672e8d..500f298 100644
--- a/lambda-calcul/haskell/public/index.html
+++ b/lambda-calcul/haskell/public/index.html
@@ -3,13 +3,14 @@
   <head>
     <meta charset="UTF-8">
     <title>Minilang</title>
-    <link rel="stylesheet" href="minilang.css" >
+    <link rel="stylesheet" href="/minilang.css" >
     <link rel="icon"
           type="image/png"
           href="/pi.png">
     <link href="https://fonts.googleapis.com/css?family=Inconsolata&display=swap" rel="stylesheet">
   </head>
   <body>
+    <h1>λ-Calculus Terminal</h1>
     <div class="edit">
       <textarea id="program"></textarea>
       <div>
diff --git a/lambda-calcul/haskell/public/minilang.css b/lambda-calcul/haskell/public/minilang.css
index 2e20838..5512efc 100644
--- a/lambda-calcul/haskell/public/minilang.css
+++ b/lambda-calcul/haskell/public/minilang.css
@@ -1,9 +1,10 @@
 html {
     font-family: Inconsolata, Courier;
+    background-color: #f0f0f0;
 }
 
 div#minilang {
-    height: 90vh;
+    height: 85vh;
     overflow-y: auto;
 }
 
@@ -18,6 +19,8 @@ textarea#program {
     height: 90%;
     padding: 1em;
     font-family: Inconsolata, Courier;
+    background-color: black;
+    color: white;
     font-size: 12pt;
     resize: none;
     white-space: pre;
@@ -65,3 +68,11 @@ div.command {
     vertical-align: middle;
     height: 2em;
 }
+
+button#send {
+    background-color: rgb(125, 207, 161);
+    border-radius: 5px;
+    font-size: 1em;
+    font-weight: bold;
+    padding: 5px 10px 5px 10px;
+}
diff --git a/lambda-calcul/haskell/test/Minilang/REPL/NetSpec.hs b/lambda-calcul/haskell/test/Minilang/REPL/NetSpec.hs
new file mode 100644
index 0000000..076b073
--- /dev/null
+++ b/lambda-calcul/haskell/test/Minilang/REPL/NetSpec.hs
@@ -0,0 +1,91 @@
+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 (newEnv)
+import Minilang.Lambda.Infer (newContext)
+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 definition and returns defined symbol" $ \Server {serverPort} -> do
+    --   let inp = [In "Unit : U = Sum(tt)"]
+    --       expectedOutput = [Right $ Defined (B "Unit") (U 0)]
+    --   res <- runTestClient serverPort ".newenv1" inp
+
+    --   res `shouldBe` expectedOutput
+
+    it "allows retrieving empty initial env" $ \Server {serverPort} -> do
+      let inp = [Com DumpEnv]
+          expectedOutput = [Right $ CurrentEnv newEnv newContext]
+      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