summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--lambda-calcul/haskell/minilang.cabal6
-rw-r--r--lambda-calcul/haskell/public/leaderboard.js31
-rw-r--r--lambda-calcul/haskell/src/Minilang/API.hs19
-rw-r--r--lambda-calcul/haskell/src/Minilang/App.hs14
-rw-r--r--lambda-calcul/haskell/src/Minilang/REPL/Net.hs29
-rw-r--r--lambda-calcul/haskell/src/Minilang/Server.hs33
-rw-r--r--lambda-calcul/haskell/test/Minilang/ServerSpec.hs15
7 files changed, 124 insertions, 23 deletions
diff --git a/lambda-calcul/haskell/minilang.cabal b/lambda-calcul/haskell/minilang.cabal
index 37ec9a1..3911553 100644
--- a/lambda-calcul/haskell/minilang.cabal
+++ b/lambda-calcul/haskell/minilang.cabal
@@ -25,6 +25,8 @@ source-repository head
library
exposed-modules:
+ Minilang.API
+ Minilang.App
Minilang.IO
Minilang.Lambda
Minilang.Lambda.Unify
@@ -69,6 +71,7 @@ library
, haskeline
, megaparsec
, mtl
+ , servant-server
, stm
, text
, time
@@ -76,6 +79,7 @@ library
, wai
, wai-app-static
, wai-extra
+ , wai-middleware-static
, websockets
, wai-websockets
, warp
@@ -93,6 +97,7 @@ test-suite minilang-test
Minilang.REPLSpec
Minilang.REPL.HaskelineSpec
Minilang.REPL.NetSpec
+ Minilang.ServerSpec
hs-source-dirs:
test
default-extensions:
@@ -121,6 +126,7 @@ test-suite minilang-test
, haskeline
, hspec
, hspec-discover
+ , hspec-wai
, http-types
, minilang
, mtl
diff --git a/lambda-calcul/haskell/public/leaderboard.js b/lambda-calcul/haskell/public/leaderboard.js
index b8c1a9a..63dcfde 100644
--- a/lambda-calcul/haskell/public/leaderboard.js
+++ b/lambda-calcul/haskell/public/leaderboard.js
@@ -2,10 +2,35 @@ const updateLeaderboard = () => {
const rows = document.querySelectorAll('table#leaderboard > tbody > tr');
rows.forEach(row => {
- const scoreCell = row.querySelector('td.score');
- const randomScore = Math.floor(Math.random() * 1000);
- scoreCell.textContent = randomScore;
+ row.remove();
});
+
+ fetch('/api/leaderboard')
+ .then(response => response.json())
+ .then(data => {
+ const tbody = document.querySelector('table#leaderboard > tbody');
+
+ data.forEach((entry, index) => {
+ const row = document.createElement('tr');
+
+ const nameCell = document.createElement('td');
+ nameCell.textContent = entry.name;
+ row.appendChild(nameCell);
+
+ const scoreCell = document.createElement('td');
+ scoreCell.textContent = entry.grade;
+ row.appendChild(scoreCell);
+
+ const timeCell = document.createElement('td');
+ timeCell.textContent = entry.lastTest;
+ row.appendChild(timeCell);
+
+ tbody.appendChild(row);
+ });
+ })
+ .catch(error => {
+ console.error('Error fetching leaderboard data:', error);
+ });
};
document.addEventListener('DOMContentLoaded', () => {
diff --git a/lambda-calcul/haskell/src/Minilang/API.hs b/lambda-calcul/haskell/src/Minilang/API.hs
new file mode 100644
index 0000000..65e652a
--- /dev/null
+++ b/lambda-calcul/haskell/src/Minilang/API.hs
@@ -0,0 +1,19 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE DeriveAnyClass #-}
+
+module Minilang.API where
+
+import Data.Time (UTCTime)
+import Servant (Get, JSON, (:>))
+import GHC.Generics (Generic)
+import Data.Aeson (ToJSON, FromJSON)
+
+data Score = Score
+ { name :: String,
+ grade :: Int,
+ lastTest :: UTCTime
+ }
+ deriving (Eq, Show, Generic, ToJSON, FromJSON)
+
+type LambdaAPI = "api" :> "leaderboard" :> Get '[JSON] [Score]
diff --git a/lambda-calcul/haskell/src/Minilang/App.hs b/lambda-calcul/haskell/src/Minilang/App.hs
new file mode 100644
index 0000000..2d21961
--- /dev/null
+++ b/lambda-calcul/haskell/src/Minilang/App.hs
@@ -0,0 +1,14 @@
+module Minilang.App where
+
+import Minilang.API (LambdaAPI, Score (..))
+import Servant.Server (Handler, Server)
+import Data.Time (getCurrentTime)
+import Control.Monad.IO.Class (liftIO)
+
+lambdaApp :: Server LambdaAPI
+lambdaApp = getLeaderboard
+
+getLeaderboard :: Handler [Score]
+getLeaderboard = do
+ now <- liftIO getCurrentTime
+ pure [Score "Alice" 95 now, Score "Bob" 88 now]
diff --git a/lambda-calcul/haskell/src/Minilang/REPL/Net.hs b/lambda-calcul/haskell/src/Minilang/REPL/Net.hs
index 43d2560..a067a15 100644
--- a/lambda-calcul/haskell/src/Minilang/REPL/Net.hs
+++ b/lambda-calcul/haskell/src/Minilang/REPL/Net.hs
@@ -5,8 +5,15 @@ module Minilang.REPL.Net where
import Control.Concurrent.STM (atomically)
import Control.Concurrent.STM.TVar
-import Control.Monad.Catch
+ ( newTVarIO, readTVarIO, writeTVar, TVar )
+import Control.Monad.Catch ( MonadThrow(..), MonadCatch(..) )
import Control.Monad.State
+ ( MonadIO(..),
+ MonadTrans(..),
+ MonadState,
+ StateT(StateT),
+ evalStateT,
+ gets )
import Data.Aeson
( ToJSON,
eitherDecode,
@@ -17,22 +24,24 @@ import Data.Aeson
import Data.ByteString (ByteString)
import qualified Data.ByteString.Lazy as LBS
import Data.Either (fromRight)
-import Data.Map as Map
-import Data.Serialize hiding (encode)
-import Data.Text (Text, pack, unpack)
+import Data.Map as Map ( Map )
+import Data.Serialize
+ ( getLazyByteString,
+ getWord64be,
+ putLazyByteString,
+ putWord64be,
+ Serialize(..) )
+import Data.Text (Text)
import Data.Text.Encoding (decodeUtf8With)
import Data.Text.Encoding.Error (lenientDecode)
-import Minilang.Log
-import Minilang.REPL (withInputs)
+import Minilang.Log ( LoggerEnv(logInfo) )
import Minilang.REPL.Pure (render)
-import Minilang.REPL.Purer (purerREPL)
import Minilang.REPL.Run (runREPL)
import Minilang.REPL.Types
+ ( initialREPL, In(In), MonadREPL(..), Out, REPLEnv )
import Network.Wai (Application)
-import Network.Wai.Handler.WebSockets
+import Network.Wai.Handler.WebSockets ( websocketsOr )
import qualified Network.WebSockets as WS
-import System.Directory (getCurrentDirectory)
-import System.FilePath (takeFileName, (</>))
-- | Configuration of the WS server
data ServerConfig = ServerConfig
diff --git a/lambda-calcul/haskell/src/Minilang/Server.hs b/lambda-calcul/haskell/src/Minilang/Server.hs
index 5c34db4..8717081 100644
--- a/lambda-calcul/haskell/src/Minilang/Server.hs
+++ b/lambda-calcul/haskell/src/Minilang/Server.hs
@@ -18,19 +18,22 @@ import Data.Text (Text)
import Minilang.Log
import Minilang.REPL.Net
import Network.Wai
-import Network.Wai.Application.Static
import Network.Wai.Handler.Warp as Warp
import Network.Wai.Middleware.RequestLogger
import Network.Wai.Middleware.RequestLogger.JSON
+import Network.Wai.Middleware.Static (addBase, defaultOptions, staticPolicyWithOptions)
+import Servant.Server (serve)
import System.Log.FastLogger (fromLogStr)
-import Control.Concurrent.Async
+import Data.Data (Proxy (..))
+import Minilang.API (LambdaAPI)
+import Minilang.App (lambdaApp)
data Server = Server
- { serverThread :: Maybe (Async ())
- -- ^If the server is running, this will contain the underlying
- , serverPort :: Int
- -- ^The actual port this server is listening on. Useful when
- }
+ { -- | If the server is running, this will contain the underlying
+ serverThread :: Maybe (Async ()),
+ -- | The actual port this server is listening on. Useful when
+ serverPort :: Int
+ }
-- | Starts HTTP server on given port.
-- This server serves static files from public/ directory and also
@@ -40,7 +43,11 @@ startServer serverPort = do
envs <- newTVarIO mempty
logger <- newLog "minilang"
loggerMiddleware <- runHTTPLog logger
- let app = loggerMiddleware $ runNetREPL logger envs staticResources
+ let app =
+ loggerMiddleware $
+ runNetREPL logger envs $
+ staticResources $
+ serveAPI
(port, action) <- startWarp serverPort app
thread <- async action
logInfo logger $ object ["action" .= ("Started" :: Text), "port" .= port]
@@ -58,6 +65,12 @@ startServer serverPort = do
destination = Callback (\str -> logInfo logger (decode @Value $ fromStrict $ fromLogStr str))
}
+serveAPI :: Application
+serveAPI = serve apiProxy lambdaApp
+
+apiProxy :: Proxy LambdaAPI
+apiProxy = Proxy
+
stopServer :: Server -> IO ()
stopServer (Server (Just th) _) = cancel th
stopServer _ = pure ()
@@ -67,5 +80,5 @@ waitServer (Server (Just th) _) = wait th
waitServer _ = pure ()
-- | Serve static resources under `public/` directory
-staticResources :: Application
-staticResources = staticApp (defaultFileServerSettings "public")
+staticResources :: Middleware
+staticResources = staticPolicyWithOptions defaultOptions (addBase "public")
diff --git a/lambda-calcul/haskell/test/Minilang/ServerSpec.hs b/lambda-calcul/haskell/test/Minilang/ServerSpec.hs
new file mode 100644
index 0000000..309ded8
--- /dev/null
+++ b/lambda-calcul/haskell/test/Minilang/ServerSpec.hs
@@ -0,0 +1,15 @@
+module Minilang.ServerSpec where
+
+import Minilang.Server (serveAPI)
+import Network.Wai (Application)
+import Test.Hspec (Spec, it)
+import Test.Hspec.Wai (get, shouldRespondWith, with)
+
+spec :: Spec
+spec = with app $
+ it "GET /api/leaderboard returns empty list of scores" $ do
+ get "/api/leaderboard"
+ `shouldRespondWith` "[]"
+
+app :: IO Application
+app = pure serveAPI
generated by cgit v1.3.1 (git 2.54.0) at 2026-10-24 03:26:33 +0000