Remove answers from sent challenges

Also fix integration test

5 files changed, 82 insertions, 75 deletions

diff --git a/lambda-calcul/haskell/test/Minilang/IntegrationSpec.hs b/lambda-calcul/haskell/test/Minilang/IntegrationSpec.hs
index ef05e20..d0265ac 100644
--- a/lambda-calcul/haskell/test/Minilang/IntegrationSpec.hs
+++ b/lambda-calcul/haskell/test/Minilang/IntegrationSpec.hs
@@ -6,8 +6,12 @@ import Control.Exception (bracket)
 import Data.Aeson (eitherDecodeFileStrict)
 import Data.Proxy (Proxy (..))
 import Data.Text (Text)
+import qualified Data.Text as Text
 import Minilang.API
-import Minilang.REPL.Types (Evaluator (..))
+import Minilang.Lambda.Parser (pretty)
+import Minilang.REPL (withInput, withInputs)
+import Minilang.REPL.Purer (PurerEnv (..))
+import Minilang.REPL.Types (Command (Load), Content (..), Evaluator (..), In (Com), Out (..), initialREPL)
 import Minilang.Server (Server (..), startServer, stopServer)
 import Network.HTTP.Client (defaultManagerSettings, newManager)
 import Servant.API ((:<|>) (..))
@@ -89,12 +93,19 @@ spec =
 -- | Fetch the current challenge for the token, post the known answer, and
 -- assert the server accepted it (200 OK / no exception).
 solveChallenge :: ClientEnv -> Token -> Challenge -> IO ()
-solveChallenge env token Challenge{level, answer} = do
+solveChallenge env token Challenge{level, expr} = do
   -- Confirm the server gives us the challenge we expect at this grade
   Challenge{level = serverLevel} <- runC env $ challengeClient (Just token)
   serverLevel `shouldBe` level
   -- Post the correct answer
-  runC env $ answerClient (Just token) answer
+  let PurerEnv{outputs} = withInputs initialREPL [Com (Load (Data expr))]
+  case outputs of
+    -- NOTE: Outputs are in reverse order, so the first output is the last one produced by the REPL.
+    (Bye : Evaluated ast _ _ : _) -> do
+      runC env $ answerClient (Just token) (pretty ast)
+    [Bye] ->
+      runC env $ answerClient (Just token) ""
+    answer -> fail $ "Unexpected answer format: " <> show answer
 
 -- ---------------------------------------------------------------------------
 -- Server lifecycle
diff --git a/lambda-calcul/haskell/test/Minilang/Lambda/ParserSpec.hs b/lambda-calcul/haskell/test/Minilang/Lambda/ParserSpec.hs
index 40866bb..0050973 100644
--- a/lambda-calcul/haskell/test/Minilang/Lambda/ParserSpec.hs
+++ b/lambda-calcul/haskell/test/Minilang/Lambda/ParserSpec.hs
@@ -8,10 +8,9 @@ import Data.Either (isLeft, isRight)
 import Data.Function ((&))
 import Data.Text (Text, pack)
 import qualified Data.Text as Text
-import Minilang.Lambda.Eval (Term (Lam))
+import Minilang.Lambda.Eval (Term (Lam), normalise)
 import qualified Minilang.Lambda.Eval as Eval
-import Minilang.Lambda.Parser (AST (..), desugar, initialChars, parse, parseProgram, pretty, restChars, escapeString)
-import Minilang.Lambda.Eval (normalise)
+import Minilang.Lambda.Parser (AST (..), desugar, escapeString, initialChars, parse, parseProgram, pretty, restChars)
 import Test.Hspec (Spec, describe, it, parallel, shouldBe, shouldSatisfy)
 import Test.Hspec.QuickCheck (prop)
 import Test.QuickCheck (
@@ -91,13 +90,13 @@ spec = parallel $ do
                     <> Text.concat
                       ( map
                           ( \(Identifier v, t) ->
-                              "(" <> v <> " " <> pretty t <> ")"
+                              "(" <> v <> " " <> pretty t <> ")\n"
                           )
                           bound
                       )
-                    <> ") "
+                    <> ")\n   "
                     <> pretty body
-                    <> ")"
+                    <> ")\n"
                 )
                 `shouldSatisfy` isRight
 
@@ -370,8 +369,8 @@ genAst depth =
 -- logic is tested separately.
 genStrLit :: Gen AST
 genStrLit = StrLit . pack <$> listOf (elements safeChars)
-  where
-    safeChars = filter (\c -> c /= '"' && c /= '\\') [' '..'~']
+ where
+  safeChars = filter (\c -> c /= '"' && c /= '\\') [' ' .. '~']
 
 genDef :: Int -> Gen AST
 genDef n = Def . unIdent <$> arbitrary <*> genAst n
diff --git a/lambda-calcul/haskell/test/Minilang/REPL/NetSpec.hs b/lambda-calcul/haskell/test/Minilang/REPL/NetSpec.hs
index 6a2b1ab..2f8880a 100644
--- a/lambda-calcul/haskell/test/Minilang/REPL/NetSpec.hs
+++ b/lambda-calcul/haskell/test/Minilang/REPL/NetSpec.hs
@@ -1,6 +1,5 @@
 module Minilang.REPL.NetSpec where
 
--- import           Control.Concurrent          (threadDelay)
 import Control.Concurrent.Async
 import Control.Concurrent.STM.TVar
 import Control.Exception (bracket)
@@ -46,48 +45,48 @@ withServer =
 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
+ 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
+ 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
+    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")
+            [ Right (Msg "Language set to Typed")
+            , Right $ Evaluated (AST.Sym "y") (Var "y") (Just $ TyVar "a")
             ]
       res <- runTestClient serverPort ".newenv1" inp
 
       res `shouldBe` expectedOutput
 
-    it "allows retrieving empty initial env" $ \Server {serverPort} -> do
+    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
+            [ 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
+    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"]
@@ -95,5 +94,5 @@ spec = around withServer $
       res `shouldSatisfy` isEvaluated
 
 isEvaluated :: [Either a Out] -> Bool
-isEvaluated [Right (Evaluated _ _ _)] = True
+isEvaluated [Right Evaluated{}] = True
 isEvaluated _ = False
diff --git a/lambda-calcul/haskell/test/Minilang/REPLSpec.hs b/lambda-calcul/haskell/test/Minilang/REPLSpec.hs
index e382df4..1754cdb 100644
--- a/lambda-calcul/haskell/test/Minilang/REPLSpec.hs
+++ b/lambda-calcul/haskell/test/Minilang/REPLSpec.hs
@@ -1,11 +1,9 @@
 module Minilang.REPLSpec where
 
 import Control.Exception (bracket)
-import Data.Either (isRight)
 import Data.Text.IO
 import Minilang.Lambda.Eval (Term (Lam, Var))
 import Minilang.Lambda.Parser (AST (..))
-import Minilang.Lambda.Unify (Type (TyVar))
 import Minilang.REPL
 import Minilang.REPL.Purer (PurerEnv (..))
 import Minilang.REPL.Run (loadProgramInEnv)
@@ -26,8 +24,8 @@ spec = parallel $
               ["((lam (x) x) y)"]
 
       out
-        `shouldBe` [ "Bye!",
-                     "y : <?>"
+        `shouldBe` [ "Bye!"
+                   , "y"
                    ]
 
     it "evaluates untyped MiniLang terms with definitions" $ do
@@ -36,24 +34,24 @@ spec = parallel $
               ["(def id (lam (x) x))", "(id y)"]
 
       out
-        `shouldBe` [ "Bye!",
-                     "y : <?>",
-                     "id : <?>"
+        `shouldBe` [ "Bye!"
+                   , "y"
+                   , "id"
                    ]
 
     it "evaluates typed MiniLang terms with definitions" $ do
       let out =
             withInput
-              [ ":lang   Typed",
-                "(def id (lam (x) x))",
-                "(id y)"
+              [ ":lang   Typed"
+              , "(def id (lam (x) x))"
+              , "(id y)"
               ]
 
       out
-        `shouldBe` [ "Bye!",
-                     "y : a",
-                     "id : a -> a",
-                     "Language set to Typed"
+        `shouldBe` [ "Bye!"
+                   , "y : a"
+                   , "id : a -> a"
+                   , "Language set to Typed"
                    ]
 
     it "defaults untyped terms" $ do
@@ -65,58 +63,58 @@ spec = parallel $
               ]
 
       out
-        `shouldBe` [ "Bye!",
-                     "(lam (z s) (s (lam (z s) (s (lam (z s) z))))) : <?>"
+        `shouldBe` [ "Bye!"
+                   , "(lam (z s) (s (lam (z s) (s (lam (z s) z)))))"
                    ]
 
     it "do typecheck term when language is set to 'Typed'" $ do
       let out =
             withInput
-              [ ":lang   Typed",
-                "(let ((Succ (lam (n z s) (s n))) \
+              [ ":lang   Typed"
+              , "(let ((Succ (lam (n z s) (s n))) \
                 \ (Zero (lam (z s) z))) \
                 \ (Succ (Succ Zero)))"
               ]
 
       out
-        `shouldBe` [ "Bye!",
-                     "(lam (z s) (s (lam (z s) (s (lam (z s) z))))) : a -> ((c -> ((e -> f -> e) -> g) -> g) -> h) -> h",
-                     "Language set to Typed"
+        `shouldBe` [ "Bye!"
+                   , "(lam (z s) (s (lam (z s) (s (lam (z s) z))))) : a -> ((c -> ((e -> f -> e) -> g) -> g) -> h) -> h"
+                   , "Language set to Typed"
                    ]
 
     it "shows error when trying to load a non-existent file" $ do
       withInput [":load foo"]
-        `shouldBe` [ "Bye!",
-                     "REPLError \"cannot load file foo in Pure interpreter\""
+        `shouldBe` [ "Bye!"
+                   , "REPLError \"cannot load file foo in Pure interpreter\""
                    ]
 
     it "can load 'bool-prog.lisp'" $ do
       boolProg <- readFile "bool-prog.lisp"
-      let PurerEnv {outputs} = runProgram (loadProgramInEnv boolProg)
+      let PurerEnv{outputs} = runProgram (loadProgramInEnv boolProg)
       outputs
-        `shouldBe` [ Evaluated (Abs ["f", "t"] (Sym "t")) (Lam "f" (Lam "t" (Var "t"))) (TyVar "<?>"),
-                     Evaluated (Abs ["f", "t"] (Sym "f")) (Lam "f" (Lam "t" (Var "f"))) (TyVar "<?>"),
-                     Evaluated (Abs ["f", "t"] (Sym "f")) (Lam "f" (Lam "t" (Var "f"))) (TyVar "<?>")
+        `shouldBe` [ Evaluated (Abs ["f", "t"] (Sym "t")) (Lam "f" (Lam "t" (Var "t"))) Nothing
+                   , Evaluated (Abs ["f", "t"] (Sym "f")) (Lam "f" (Lam "t" (Var "f"))) Nothing
+                   , Evaluated (Abs ["f", "t"] (Sym "f")) (Lam "f" (Lam "t" (Var "f"))) Nothing
                    ]
 
     it "can load 'bool.lisp'" $ do
       boolProg <- readFile "bool.lisp"
-      let PurerEnv {outputs} = runProgram (loadProgramInEnv boolProg)
+      let PurerEnv{outputs} = runProgram (loadProgramInEnv boolProg)
       outputs
         `shouldBe` [ Evaluated
                        (Abs ["f", "t"] (Sym "f"))
                        (Lam "f" (Lam "t" (Var "f")))
-                       (TyVar "<?>")
+                       Nothing
                    ]
 
     it "can load 'fac.lisp'" $ do
       boolProg <- readFile "fac.lisp"
-      let PurerEnv {outputs} = runProgram (loadProgramInEnv boolProg)
+      let PurerEnv{outputs} = runProgram (loadProgramInEnv boolProg)
       outputs
         `shouldBe` [ Evaluated
                        (Abs ["f", "t"] (Sym "t"))
                        (Lam "f" (Lam "t" (Var "t")))
-                       (TyVar "<?>")
+                       Nothing
                    ]
 
     around withTempFile $
@@ -136,11 +134,11 @@ spec = parallel $
         out <- readFile outputFileName
 
         out
-          `shouldBe` "\955\928> (lam (z s) (s (lam (z s) z))) : <?>\n\955\928> Bye!\n"
+          `shouldBe` "\955\928> (lam (z s) (s (lam (z s) z)))\n\955\928> Bye!\n"
 
 withTempFile :: (String -> IO ()) -> IO ()
 withTempFile =
   bracket mkTempFile rmTempFile
-  where
-    mkTempFile = getTemporaryDirectory >>= \dir -> mkstemp (dir </> "test-repl") >>= \(fp, h) -> hClose h >> pure fp
-    rmTempFile fn = removeFile fn >> removeFile (fn <.> "out")
+ where
+  mkTempFile = getTemporaryDirectory >>= \dir -> mkstemp (dir </> "test-repl") >>= \(fp, h) -> hClose h >> pure fp
+  rmTempFile fn = removeFile fn >> removeFile (fn <.> "out")
diff --git a/lambda-calcul/haskell/test/Minilang/ServerSpec.hs b/lambda-calcul/haskell/test/Minilang/ServerSpec.hs
index 2860c40..8d0b182 100644
--- a/lambda-calcul/haskell/test/Minilang/ServerSpec.hs
+++ b/lambda-calcul/haskell/test/Minilang/ServerSpec.hs
@@ -51,7 +51,7 @@ spec = with (app testSeed) $ do
 
   it "GET /api/leaderboard returns empty list of scores at start" $ do
     get "/api/leaderboard"
-      `shouldRespondWith` 200 {matchBody = arrayOfLengthOf (Proxy @Score) 0}
+      `shouldRespondWith` 200{matchBody = arrayOfLengthOf (Proxy @Score) 0}
 
   it "POST /api/register returns registration token given user is not registered" $ do
     postJSON "/api/register" alice
@@ -66,7 +66,7 @@ spec = with (app testSeed) $ do
   it "GET /api/leaderboard returns list of one element after user registers" $ do
     void $ postJSON "/api/register" alice
     get "/api/leaderboard"
-      `shouldRespondWith` 200 {matchBody = arrayOfLengthOf (Proxy @Score) 1}
+      `shouldRespondWith` 200{matchBody = arrayOfLengthOf (Proxy @Score) 1}
 
   it "POST /api/register returns 400 given user is already registered" $ do
     void $ postJSON "/api/register" alice
@@ -84,7 +84,7 @@ spec = with (app testSeed) $ do
       `shouldRespondWith` 404
 
   it "GET /api/challenge returns next challenge given user is registered" $ do
-    let expected = LT.unpack $ decodeUtf8 $ encode $ Challenge {level = 0, expr = "x", description = "A lone free variable. What does x reduce to?", answer = "x"}
+    let expected = LT.unpack $ decodeUtf8 $ encode $ Challenge{level = 0, expr = "x", description = "A lone free variable. What does x reduce to?"}
     postJSON "/api/register" alice
       `shouldRespondWith` 201
 
@@ -123,7 +123,7 @@ spec = with (app testSeed) $ do
       `shouldRespondWith` 400
 
   it "GET /api/challenge returns next level challenge after successful POST" $ do
-    let expected = LT.unpack $ decodeUtf8 $ encode $ Challenge {level = 1, expr = "y", description = "Another free variable. What does y reduce to?", answer = "y"}
+    let expected = LT.unpack $ decodeUtf8 $ encode $ Challenge{level = 1, expr = "y", description = "Another free variable. What does y reduce to?"}
 
     void $ postJSON "/api/register" alice
     void $ postJSON ("/api/challenge?token=" <> LBS.toStrict token) "\"x\""
@@ -147,7 +147,7 @@ spec = with (app testSeed) $ do
         { matchBody = MatchBody $ \_ actual ->
             case eitherDecode actual of
               Right (score :: Score) ->
-                if score == Score {user = User "alice", grade = 0, lastTest = Nothing, lastResult = Nothing}
+                if score == Score{user = User "alice", grade = 0, lastTest = Nothing, lastResult = Nothing}
                   then Nothing
                   else Just $ "Expected score with grade 0, but got " ++ show score
               Left err -> Just $ "Failed to decode JSON: " ++ err
@@ -190,7 +190,7 @@ spec = with (app testSeed) $ do
 postJSON :: BS.ByteString -> ByteString -> WaiSession () SResponse
 postJSON url = request "POST" url [("Content-Type", "application/json")]
 
-arrayOfLengthOf :: forall elem proxy. (FromJSON elem) => proxy elem -> Int -> MatchBody
+arrayOfLengthOf :: forall elem proxy. FromJSON elem => proxy elem -> Int -> MatchBody
 arrayOfLengthOf _ len = MatchBody $ \_ actual ->
   case eitherDecode actual of
     Right (scores :: [elem]) ->