summaryrefslogtreecommitdiff
path: root/lambda-calcul/haskell
diff options
context:
space:
mode:
Diffstat (limited to 'lambda-calcul/haskell')
-rw-r--r--lambda-calcul/haskell/src/Minilang/API.hs10
-rw-r--r--lambda-calcul/haskell/src/Minilang/App.hs14
-rw-r--r--lambda-calcul/haskell/src/Minilang/Server.hs8
-rw-r--r--lambda-calcul/haskell/test/Minilang/ServerSpec.hs18
4 files changed, 31 insertions, 19 deletions
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]) ->