From ddabd007fa2a41cb2c9d54fd4f2727c240eb5069 Mon Sep 17 00:00:00 2001 From: Harry Garrood Date: Sat, 30 May 2020 23:38:16 +0100 Subject: [PATCH 1/2] Allow any module name Seems to work. Fixes #174 --- README.md | 2 +- server/Main.hs | 4 +--- 2 files changed, 2 insertions(+), 4 deletions(-) diff --git a/README.md b/README.md index 3c068fce..79863765 100644 --- a/README.md +++ b/README.md @@ -117,7 +117,7 @@ Response body on compilation failure: } ``` -Response body on other errors (eg, the name of the module in request body was not Main, or the request body was too large) +Response body on other errors (eg, the request body was too large) ```javascript { diff --git a/server/Main.hs b/server/Main.hs index 3f6cf79e..03b2d971 100644 --- a/server/Main.hs +++ b/server/Main.hs @@ -71,7 +71,7 @@ server externs initNamesEnv initEnv port = do case CST.parseModuleFromFile "" input >>= CST.resFull of Left parseError -> return . Left . CompilerErrors . P.toJSONErrors False P.Error $ CST.toMultipleErrors "" parseError - Right m | P.getModuleName m == P.ModuleName "Main" -> do + Right m -> do (resultMay, ws) <- runLogger' . runExceptT . flip runReaderT P.defaultOptions $ do ((P.Module ss coms moduleName elaborated exps, env), nextVar) <- P.runSupplyT 0 $ do desugared <- P.desugar initNamesEnv externs [P.importPrim m] >>= \case @@ -87,8 +87,6 @@ server externs initNamesEnv initEnv port = do case resultMay of Left errs -> (return . Left . CompilerErrors . P.toJSONErrors False P.Error) errs Right js -> (return . Right) (P.toJSONErrors False P.Error ws, js) - Right _ -> - (return . Left . OtherError) "The name of the main module should be Main." scottyOpts (getOpts port) $ do get "/" $ From 34825f87b79fe166564eff512ea8e12632e2103d Mon Sep 17 00:00:00 2001 From: Harry Garrood Date: Sat, 30 May 2020 23:48:50 +0100 Subject: [PATCH 2/2] Rewrite the module name to $Main --- server/Main.hs | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/server/Main.hs b/server/Main.hs index 03b2d971..a576b62a 100644 --- a/server/Main.hs +++ b/server/Main.hs @@ -72,9 +72,13 @@ server externs initNamesEnv initEnv port = do Left parseError -> return . Left . CompilerErrors . P.toJSONErrors False P.Error $ CST.toMultipleErrors "" parseError Right m -> do + -- Rewrite the module name to "$Main" in order to ensure that the + -- module name doesn't clash with any existing module names in + -- the package set. + let rewriteModuleName (P.Module ss coms _ decls refs) = P.Module ss coms (P.moduleNameFromString "$Main") decls refs (resultMay, ws) <- runLogger' . runExceptT . flip runReaderT P.defaultOptions $ do ((P.Module ss coms moduleName elaborated exps, env), nextVar) <- P.runSupplyT 0 $ do - desugared <- P.desugar initNamesEnv externs [P.importPrim m] >>= \case + desugared <- P.desugar initNamesEnv externs [P.importPrim (rewriteModuleName m)] >>= \case [d] -> pure d _ -> error "desugaring did not produce one module" P.runCheck' (P.emptyCheckState initEnv) $ P.typeCheckModule desugared