summaryrefslogtreecommitdiff
path: root/lambda-calcul/haskell/src/Minilang
diff options
context:
space:
mode:
Diffstat (limited to 'lambda-calcul/haskell/src/Minilang')
-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
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")