diff options
Diffstat (limited to 'lambda-calcul')
| -rw-r--r-- | lambda-calcul/haskell/minilang.cabal | 1 | ||||
| -rw-r--r-- | lambda-calcul/haskell/src/Minilang/REPL/Types.hs | 2 | ||||
| -rw-r--r-- | lambda-calcul/haskell/test/Minilang/REPL/NetSpec.hs | 13 | ||||
| -rw-r--r-- | lambda-calcul/haskell/test/Minilang/REPLSpec.hs | 20 | ||||
| -rw-r--r-- | lambda-calcul/haskell/test/Minilang/ServerSpec.hs | 20 |
5 files changed, 38 insertions, 18 deletions
diff --git a/lambda-calcul/haskell/minilang.cabal b/lambda-calcul/haskell/minilang.cabal index 3911553..40c5d47 100644 --- a/lambda-calcul/haskell/minilang.cabal +++ b/lambda-calcul/haskell/minilang.cabal @@ -135,6 +135,7 @@ test-suite minilang-test , unix , unordered-containers , wai + , wai-extra , warp , websockets default-language: Haskell2010 diff --git a/lambda-calcul/haskell/src/Minilang/REPL/Types.hs b/lambda-calcul/haskell/src/Minilang/REPL/Types.hs index 74cf028..b7a324b 100644 --- a/lambda-calcul/haskell/src/Minilang/REPL/Types.hs +++ b/lambda-calcul/haskell/src/Minilang/REPL/Types.hs @@ -53,7 +53,7 @@ data REPLEnv = REPLEnv } initialREPL :: REPLEnv -initialREPL = REPLEnv newEnv newContext 0 False False Typed +initialREPL = REPLEnv newEnv newContext 0 False False Untyped -- | Input data In diff --git a/lambda-calcul/haskell/test/Minilang/REPL/NetSpec.hs b/lambda-calcul/haskell/test/Minilang/REPL/NetSpec.hs index 0c2be66..7f77eeb 100644 --- a/lambda-calcul/haskell/test/Minilang/REPL/NetSpec.hs +++ b/lambda-calcul/haskell/test/Minilang/REPL/NetSpec.hs @@ -68,17 +68,20 @@ spec :: Spec spec = around withServer $ describe "MiniLang Network REPL" $ do it "evaluates expression and returns evaluation result" $ \Server {serverPort} -> do - let inp = [In "((lam (x) x) y)"] - expectedOutput = [Right $ Evaluated (AST.Sym "y") (Var "y") (TyVar "b")] + 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 "b") + ] res <- runTestClient serverPort ".newenv1" inp res `shouldBe` expectedOutput it "allows retrieving empty initial env" $ \Server {serverPort} -> do - let inp = [Com (Set (SelectLanguage Untyped)), Com DumpEnv] + let inp = [Com (Set (SelectLanguage Typed)), Com DumpEnv] expectedOutput = - [ Right (Msg "Language set to Untyped"), - Right $ CurrentEnv newEnv newContext Untyped + [ Right (Msg "Language set to Typed"), + Right $ CurrentEnv newEnv newContext Typed ] res <- runTestClient serverPort ".newenv2" inp diff --git a/lambda-calcul/haskell/test/Minilang/REPLSpec.hs b/lambda-calcul/haskell/test/Minilang/REPLSpec.hs index 5469a59..cf6ef01 100644 --- a/lambda-calcul/haskell/test/Minilang/REPLSpec.hs +++ b/lambda-calcul/haskell/test/Minilang/REPLSpec.hs @@ -13,17 +13,17 @@ import Prelude hiding (lines, readFile, writeFile) spec :: Spec spec = parallel $ describe "MiniLang REPL" $ do - it "evaluates MiniLang terms read from pure Monad" $ do + it "evaluates untyped MiniLang terms read from pure Monad" $ do let out = withInput ["((lam (x) x) y)"] out `shouldBe` [ "Bye!", - "y : b" + "y : <?>" ] - it "defaults to try to typecheck terms" $ do + it "defaults untyped terms" $ do let out = withInput [ "(let ((Succ (lam (n z s) (s n))) \ @@ -33,13 +33,13 @@ spec = parallel $ out `shouldBe` [ "Bye!", - "Cannot unify type variable f with type (e -> f -> e) -> e due to circularity: The variable already occurs in the type." + "(lam (z s) (s ((lam (n z s) (s n)) (lam (z s) z)))) : <?>" ] - it "do not typecheck term when language is set to 'untyped'" $ do + it "do typecheck term when language is set to 'Typed'" $ do let out = withInput - [ ":lang Untyped", + [ ":lang Typed", "(let ((Succ (lam (n z s) (s n))) \ \ (Zero (lam (z s) z))) \ \ (Succ (Succ Zero)))" @@ -47,8 +47,8 @@ spec = parallel $ out `shouldBe` [ "Bye!", - "(lam (z s) (s ((lam (n z s) (s n)) (lam (z s) z)))) : <?>", - "Language set to Untyped" + "Cannot unify type variable f with type (e -> f -> e) -> e due to circularity: The variable already occurs in the type.", + "Language set to Typed" ] it "shows error when trying to load a non-existent file" $ do @@ -65,7 +65,7 @@ spec = parallel $ fileName "(let ((Succ (lam (n z s) (s n))) \ \ (Zero (lam (z s) z))) \ - \ Zero)" + \ (Succ Zero))" _ <- withFile fileName ReadMode $ \hin -> withFile outputFileName AppendMode $ \hout -> @@ -74,7 +74,7 @@ spec = parallel $ out <- readFile outputFileName out - `shouldBe` "\955\928> (lam (z s) z) : c -> d -> c\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 = diff --git a/lambda-calcul/haskell/test/Minilang/ServerSpec.hs b/lambda-calcul/haskell/test/Minilang/ServerSpec.hs index 309ded8..6a25ec5 100644 --- a/lambda-calcul/haskell/test/Minilang/ServerSpec.hs +++ b/lambda-calcul/haskell/test/Minilang/ServerSpec.hs @@ -1,15 +1,31 @@ +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} + module Minilang.ServerSpec where +import Data.Aeson (eitherDecode, FromJSON) +import Minilang.API (Score) import Minilang.Server (serveAPI) import Network.Wai (Application) import Test.Hspec (Spec, it) -import Test.Hspec.Wai (get, shouldRespondWith, with) +import Test.Hspec.Wai (get, matchBody, shouldRespondWith, with) +import Test.Hspec.Wai.Matcher (MatchBody (..)) +import Data.Data (Proxy (..)) spec :: Spec spec = with app $ it "GET /api/leaderboard returns empty list of scores" $ do get "/api/leaderboard" - `shouldRespondWith` "[]" + `shouldRespondWith` 200 {matchBody = arrayOfLengthOf (Proxy @Score) 2} + +arrayOfLengthOf :: forall elem proxy . (FromJSON elem) => proxy elem -> Int -> MatchBody +arrayOfLengthOf _ len = MatchBody $ \_ actual -> + case eitherDecode actual of + Right (scores :: [elem]) -> + if length scores == len + then Nothing + else Just $ "Expected array of length " ++ show len ++ ", but got " ++ show (length scores) + Left err -> Just $ "Failed to decode JSON: " ++ err app :: IO Application app = pure serveAPI |