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.hs16
1 files changed, 13 insertions, 3 deletions
diff --git a/lambda-calcul/haskell/src/Minilang/Server.hs b/lambda-calcul/haskell/src/Minilang/Server.hs
index 6f820ed..8dc8c17 100644
--- a/lambda-calcul/haskell/src/Minilang/Server.hs
+++ b/lambda-calcul/haskell/src/Minilang/Server.hs
@@ -1,4 +1,6 @@
{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE ScopedTypeVariables #-}
-- | An HTTP server providing a basic REPL and text editor to work
-- collaboratively on Minilang code.
@@ -10,13 +12,13 @@ import Data.Aeson
( Value,
decode,
object,
- (.=),
+ (.=), eitherDecodeFileStrict,
)
import Data.ByteString.Lazy (fromStrict)
import Data.Data (Proxy (..))
import Data.Default
import Data.Text (Text)
-import Minilang.API (LambdaAPI)
+import Minilang.API (LambdaAPI, Challenge, defaultChallenges)
import Minilang.App (Env (..), lambdaApp, runApp, makeEnv)
import Minilang.Log
import Minilang.REPL.Net
@@ -28,6 +30,7 @@ import Servant (hoistServer)
import Servant.Server (serve)
import System.Log.FastLogger (fromLogStr)
import System.Random (newStdGen)
+import Control.Exception (IOException, try)
data Server = Server
{ -- | If the server is running, this will contain the underlying
@@ -44,7 +47,8 @@ startServer serverPort = do
envs <- newTVarIO mempty
logger <- newLog "minilang"
loggerMiddleware <- runHTTPLog logger
- env <- newStdGen >>= makeEnv
+ challenges <- readChallenges
+ env <- newStdGen >>= (`makeEnv` challenges)
let app =
loggerMiddleware $
runNetREPL logger envs (serveAPI env)
@@ -65,6 +69,12 @@ startServer serverPort = do
destination = Callback (\str -> logInfo logger (decode @Value $ fromStrict $ fromLogStr str))
}
+readChallenges :: IO [Challenge]
+readChallenges = do
+ eitherDecodeFileStrict "challenges.json" >>= \case
+ Right challenges -> pure challenges
+ Left _ -> pure defaultChallenges
+
serveAPI :: Env -> Application
serveAPI env =
serve apiProxy $