From df879037d135c0b300735185d5fdc0857ed797d6 Mon Sep 17 00:00:00 2001
From: Arnaud Bailly <arnaud@pankzsoft.com>
Date: Tue, 4 Nov 2025 09:06:01 +0100
Subject: Serve index.html when requesting '/'

---
 lambda-calcul/haskell/src/Minilang/API.hs         | 10 ++++++----
 lambda-calcul/haskell/src/Minilang/App.hs         | 14 ++++++++++----
 lambda-calcul/haskell/src/Minilang/Server.hs      |  8 +-------
 lambda-calcul/haskell/test/Minilang/ServerSpec.hs | 18 ++++++++++++++----
 4 files changed, 31 insertions(+), 19 deletions(-)

(limited to 'lambda-calcul/haskell')

diff --git a/lambda-calcul/haskell/src/Minilang/API.hs b/lambda-calcul/haskell/src/Minilang/API.hs
index 65e652a..2b8743f 100644
--- a/lambda-calcul/haskell/src/Minilang/API.hs
+++ b/lambda-calcul/haskell/src/Minilang/API.hs
@@ -1,13 +1,13 @@
 {-# LANGUAGE DataKinds #-}
-{-# LANGUAGE TypeOperators #-}
 {-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE TypeOperators #-}
 
 module Minilang.API where
 
+import Data.Aeson (FromJSON, ToJSON)
 import Data.Time (UTCTime)
-import Servant (Get, JSON, (:>))
 import GHC.Generics (Generic)
-import Data.Aeson (ToJSON, FromJSON)
+import Servant (Get, JSON, (:<|>), (:>), Raw)
 
 data Score = Score
   { name :: String,
@@ -16,4 +16,6 @@ data Score = Score
   }
   deriving (Eq, Show, Generic, ToJSON, FromJSON)
 
-type LambdaAPI = "api" :> "leaderboard" :> Get '[JSON] [Score]
+type LambdaAPI =
+  "api" :> "leaderboard" :> Get '[JSON] [Score]
+    :<|> Raw
diff --git a/lambda-calcul/haskell/src/Minilang/App.hs b/lambda-calcul/haskell/src/Minilang/App.hs
index 2d21961..8c1fb2b 100644
--- a/lambda-calcul/haskell/src/Minilang/App.hs
+++ b/lambda-calcul/haskell/src/Minilang/App.hs
@@ -1,14 +1,20 @@
 module Minilang.App where
 
-import Minilang.API (LambdaAPI, Score (..))
-import Servant.Server (Handler, Server)
-import Data.Time (getCurrentTime)
 import Control.Monad.IO.Class (liftIO)
+import Data.Time (getCurrentTime)
+import Minilang.API (LambdaAPI, Score (..))
+import Network.Wai.Application.Static (defaultFileServerSettings, staticApp)
+import Servant ((:<|>) (..))
+import Servant.Server (Application, Handler, Server, Tagged (..))
 
 lambdaApp :: Server LambdaAPI
-lambdaApp = getLeaderboard
+lambdaApp = getLeaderboard :<|> Tagged staticResources
 
 getLeaderboard :: Handler [Score]
 getLeaderboard = do
   now <- liftIO getCurrentTime
   pure [Score "Alice" 95 now, Score "Bob" 88 now]
+
+-- | Serve static resources under `public/` directory
+staticResources :: Application
+staticResources = staticApp (defaultFileServerSettings "public")
diff --git a/lambda-calcul/haskell/src/Minilang/Server.hs b/lambda-calcul/haskell/src/Minilang/Server.hs
index 8717081..d627271 100644
--- a/lambda-calcul/haskell/src/Minilang/Server.hs
+++ b/lambda-calcul/haskell/src/Minilang/Server.hs
@@ -45,9 +45,7 @@ startServer serverPort = do
   loggerMiddleware <- runHTTPLog logger
   let app =
         loggerMiddleware $
-          runNetREPL logger envs $
-            staticResources $
-              serveAPI
+          runNetREPL logger envs serveAPI
   (port, action) <- startWarp serverPort app
   thread <- async action
   logInfo logger $ object ["action" .= ("Started" :: Text), "port" .= port]
@@ -78,7 +76,3 @@ stopServer _ = pure ()
 waitServer :: Server -> IO ()
 waitServer (Server (Just th) _) = wait th
 waitServer _ = pure ()
-
--- | Serve static resources under `public/` directory
-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
index 6a25ec5..962dcdc 100644
--- a/lambda-calcul/haskell/test/Minilang/ServerSpec.hs
+++ b/lambda-calcul/haskell/test/Minilang/ServerSpec.hs
@@ -3,22 +3,32 @@
 
 module Minilang.ServerSpec where
 
-import Data.Aeson (eitherDecode, FromJSON)
+import Data.Aeson (FromJSON, eitherDecode)
+import Data.ByteString (isInfixOf, toStrict)
+import Data.Data (Proxy (..))
 import Minilang.API (Score)
 import Minilang.Server (serveAPI)
 import Network.Wai (Application)
 import Test.Hspec (Spec, it)
 import Test.Hspec.Wai (get, matchBody, shouldRespondWith, with)
 import Test.Hspec.Wai.Matcher (MatchBody (..))
-import Data.Data (Proxy (..))
 
 spec :: Spec
-spec = with app $
+spec = with app $ do
+  it "GET / returns 'index.html'" $ do
+    get "/"
+      `shouldRespondWith` 200
+        { matchBody = MatchBody $ \_ actual ->
+            if "<html>" `isInfixOf` toStrict actual
+              then Nothing
+              else Just "Expected HTML content"
+        }
+
   it "GET /api/leaderboard returns empty list of scores" $ do
     get "/api/leaderboard"
       `shouldRespondWith` 200 {matchBody = arrayOfLengthOf (Proxy @Score) 2}
 
-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]) ->
-- 
cgit v1.3.1