Scaffold RESTish API for challenge

4 files changed, 75 insertions, 20 deletions

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")