diff options
Diffstat (limited to 'lambda-calcul/haskell/test/Minilang/IntegrationSpec.hs')
| -rw-r--r-- | lambda-calcul/haskell/test/Minilang/IntegrationSpec.hs | 17 |
1 files changed, 14 insertions, 3 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 |
