summaryrefslogtreecommitdiff
path: root/lambda-calcul/haskell/src/Minilang/Server.hs
diff options
context:
space:
mode:
Diffstat (limited to 'lambda-calcul/haskell/src/Minilang/Server.hs')
-rw-r--r--lambda-calcul/haskell/src/Minilang/Server.hs18
1 files changed, 11 insertions, 7 deletions
diff --git a/lambda-calcul/haskell/src/Minilang/Server.hs b/lambda-calcul/haskell/src/Minilang/Server.hs
index d627271..a8ab7ca 100644
--- a/lambda-calcul/haskell/src/Minilang/Server.hs
+++ b/lambda-calcul/haskell/src/Minilang/Server.hs
@@ -13,20 +13,21 @@ import Data.Aeson
(.=),
)
import Data.ByteString.Lazy (fromStrict)
+import Data.Data (Proxy (..))
import Data.Default
import Data.Text (Text)
+import Minilang.API (LambdaAPI)
+import Minilang.App (Env (..), lambdaApp, runApp)
import Minilang.Log
import Minilang.REPL.Net
import Network.Wai
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 (hoistServer)
import Servant.Server (serve)
import System.Log.FastLogger (fromLogStr)
-import Data.Data (Proxy (..))
-import Minilang.API (LambdaAPI)
-import Minilang.App (lambdaApp)
+import System.Random (newStdGen)
data Server = Server
{ -- | If the server is running, this will contain the underlying
@@ -43,9 +44,10 @@ startServer serverPort = do
envs <- newTVarIO mempty
logger <- newLog "minilang"
loggerMiddleware <- runHTTPLog logger
+ env <- Env <$> (newStdGen >>= newTVarIO)
let app =
loggerMiddleware $
- runNetREPL logger envs serveAPI
+ runNetREPL logger envs (serveAPI env)
(port, action) <- startWarp serverPort app
thread <- async action
logInfo logger $ object ["action" .= ("Started" :: Text), "port" .= port]
@@ -63,8 +65,10 @@ startServer serverPort = do
destination = Callback (\str -> logInfo logger (decode @Value $ fromStrict $ fromLogStr str))
}
-serveAPI :: Application
-serveAPI = serve apiProxy lambdaApp
+serveAPI :: Env -> Application
+serveAPI env =
+ serve apiProxy $
+ hoistServer apiProxy (runApp env) lambdaApp
apiProxy :: Proxy LambdaAPI
apiProxy = Proxy