Add error logging and configurable path for extensions.yaml

codeworld-compiler/exec/Main.hs

@@ -123,7 +123,7 @@ compileBase Options {..} err = do
             readFile linkBase >>= hPutStrLn stderr
             hPutStrLn stderr "========================="
         let stage = GenBase "LinkBase" linkBase (fromJust output) (fromJust baseSymbols)
-        compileSource stage linkMain noModuleFinder err mode verbose
+        compileSource stage linkMain noModuleFinder Nothing err mode verbose
 
 compile :: Options -> FilePath -> IO CompileStatus
 compile opts@Options {..} err = do
@@ -132,7 +132,7 @@ compile opts@Options {..} err = do
                 (Nothing, _, _) -> ErrorCheck
                 (Just out, Nothing, _) -> FullBuild out
                 (Just out, Just syms, Just url) -> UseBase out syms url
-    compileSource stage source noModuleFinder err mode verbose
+    compileSource stage source noModuleFinder Nothing err mode verbose
 
 noModuleFinder :: String -> IO (Maybe FilePath)
 noModuleFinder _ = return Nothing

codeworld-compiler/src/CodeWorld/Compile.hs

@@ -40,7 +40,6 @@ import Control.Monad.IO.Class
 import Control.Monad.State
 import Data.ByteString (ByteString)
 import qualified Data.ByteString as B
-import Data.Either (fromRight)
 import Data.Function
 import Data.List
 import qualified Data.Map as Map
@@ -50,10 +49,11 @@ import qualified Data.Set as Set
 import Data.Text (Text)
 import qualified Data.Text as T
 import Data.Text.Encoding (decodeUtf8, encodeUtf8)
-import Data.Yaml (FromJSON(..), withObject, (.:), decodeFileEither)
+import Data.Yaml (FromJSON(..), withObject, (.:), decodeFileEither, prettyPrintParseException)
 import ErrorSanitizer
 import Language.Haskell.Exts.SrcLoc
 import System.Directory
+import System.Environment
 import System.Exit (ExitCode (..))
 import System.FilePath
 import System.IO
@@ -108,8 +108,8 @@ writeUtf8 :: FilePath -> Text -> IO ()
 writeUtf8 f = B.writeFile f . encodeUtf8
 
 compileSource ::
-  Stage -> FilePath -> (String -> IO (Maybe FilePath)) -> FilePath -> String -> Bool -> IO CompileStatus
-compileSource stage src moduleFinder err mode verbose =
+  Stage -> FilePath -> (String -> IO (Maybe FilePath)) -> Maybe FilePath -> FilePath -> String -> Bool -> IO CompileStatus
+compileSource stage src moduleFinder extConfigPath err mode verbose =
   fromMaybe CompileAborted <$> do
     withTimeout timeout $
       withSystemTempDirectory "build" $
@@ -132,7 +132,8 @@ compileSource stage src moduleFinder err mode verbose =
           compileReadSource = Map.empty,
           compileParsedSource = Map.empty,
           compileGHCParsedSource = Map.empty,
-          compileImportLocations = Map.empty
+          compileImportLocations = Map.empty,
+          compileExtensionsConfigPath = extConfigPath
         }
     timeout = case stage of
       GenBase _ _ _ _ -> maxBound :: Int
@@ -191,9 +192,17 @@ prepareCompile dir = do
       liftIO $ copyFile syms (dir </> "out.base.symbs")
       return ["-dedupe", "-use-base", "out.base.symbs"]
   mainMod <- getMainModuleName
-  parseResult <- liftIO $ decodeFileEither "extensions.yaml"
-  let ExtraExtensions extraCW extraH = fromRight (ExtraExtensions [] []) parseResult
-      extraExts
+  extConfigPath <- gets compileExtensionsConfigPath
+  exePath <- liftIO $ getExecutablePath
+  let configDir = fromMaybe (takeDirectory exePath ++ "/extensions.yaml") extConfigPath
+  parseResult <- liftIO $ decodeFileEither configDir
+  ExtraExtensions extraCW extraH <- case parseResult of
+    Left error -> do
+      liftIO $ hPutStrLn stderr "An error occurred while trying to load extensions.yaml."
+      liftIO $ hPutStrLn stderr $ prettyPrintParseException error
+      pure $ ExtraExtensions [] []
+    Right result -> pure result
+  let extraExts
         | mode == "codeworld" = extraCW
         | otherwise = extraH
   return $ localSrcs ++ buildArgs mainMod mode extraExts ++ extraPkgArgs ++ linkArgs

codeworld-compiler/src/CodeWorld/Compile/Framework.hs

@@ -120,7 +120,8 @@ data CompileState = CompileState
     compileReadSource :: Map FilePath ByteString,
     compileParsedSource :: Map FilePath ParsedCode,
     compileGHCParsedSource :: Map FilePath GHCParsedCode,
-    compileImportLocations :: Map FilePath SrcSpanInfo
+    compileImportLocations :: Map FilePath SrcSpanInfo,
+    compileExtensionsConfigPath :: Maybe FilePath
   }
 
 type MonadCompile m = (MonadState CompileState m, MonadIO m, MonadMask m)

codeworld-compiler/test/Main.hs

@@ -43,6 +43,7 @@ compilerOutput testName =
       ErrorCheck
       ("test/testcases" </> testName </> "source.hs")
       (magicModuleFinder testName dir)
+      Nothing
       (dir </> "output.txt")
       buildMode
       False

codeworld-server/src/Main.hs

@@ -296,8 +296,9 @@ compileProgram ctx basePath mode programId = do
     _ -> return CompileAborted
 
 compileIncrementally :: FilePath -> BuildMode -> ProgramId -> Text -> IO CompileStatus
-compileIncrementally basePath mode programId ver =
-  compileSource stage source (projectModuleFinder (Just sourceDir) mode) result (getMode mode) False
+compileIncrementally basePath mode programId ver = do
+  extConfigPath <- lookupEnv "EXTENSIONS_CONFIG_PATH" :: IO (Maybe FilePath)
+  compileSource stage source (projectModuleFinder (Just sourceDir) mode) extConfigPath result (getMode mode) False
   where
     sourceDir = basePath </> "source"
     source = sourceDir </> sourceFile programId
@@ -327,14 +328,15 @@ buildBaseIfNeeded :: Context -> Text -> IO CompileStatus
 buildBaseIfNeeded ctx ver = do
   codeExists <- doesFileExist (baseCodeFile ver)
   symbolsExist <- doesFileExist (baseSymbolFile ver)
+  extConfigPath <- lookupEnv "EXTENSIONS_CONFIG_PATH" :: IO (Maybe FilePath)
   if not codeExists || not symbolsExist
     then MSem.with (baseSem ctx) $ withSystemTempDirectory "genbase" $ \tmpdir -> do
       let linkMain = tmpdir </> "LinkMain.hs"
       let linkBase = tmpdir </> "LinkBase.hs"
       let err = tmpdir </> "output.txt"
       generateBaseBundle basePaths baseIgnore "codeworld" linkMain linkBase
       let stage = GenBase "LinkBase" linkBase (baseCodeFile ver) (baseSymbolFile ver)
-      compileSource stage linkMain noModuleFinder err "codeworld" False
+      compileSource stage linkMain noModuleFinder extConfigPath err "codeworld" False
     else return CompileSuccess
 
 basePaths :: [FilePath]
@@ -348,9 +350,10 @@ errorCheck ctx mode source = withSystemTempDirectory "cw_errorCheck" $ \dir -> d
   let srcFile = dir </> "program.hs"
   let errFile = dir </> "output.txt"
   B.writeFile srcFile source
+  extConfigPath <- lookupEnv "EXTENSIONS_CONFIG_PATH" :: IO (Maybe FilePath)
   status <-
     MSem.with (errorSem ctx) $ MSem.with (compileSem ctx) $
-      compileSource ErrorCheck srcFile (projectModuleFinder Nothing mode) errFile (getMode mode) False
+      compileSource ErrorCheck srcFile (projectModuleFinder Nothing mode) extConfigPath errFile (getMode mode) False
   hasOutput <- doesFileExist errFile
   output <- if hasOutput then B.readFile errFile else return B.empty
   return (status, output)

config/keter.yaml

@@ -10,6 +10,7 @@ stanzas:
       LANG: "C.UTF-8"
       LC_ALL: "C.UTF-8"
       PATH: "/usr/local/sbin:/usr/local/bin:/usr/sbin:/usr/bin:/sbin:/bin:/opt/codeworld/build/bin"
+      EXTENSIONS_CONFIG_PATH: "/opt/codeworld/extensions.yaml"
 
     hosts:
       - localhost

extensions.yaml

@@ -1,5 +1,4 @@
-codeworld:
-  - []
+codeworld: []
 haskell:
   - LambdaCase
   - NoTemplateHaskell

run.sh

@@ -28,4 +28,5 @@ fuser -k -n tcp "${PORT}"
 
 mkdir -p log
 
+export EXTENSIONS_CONFIG_PATH=$(pwd)/extensions.yaml
 run . ./build/bin/codeworld-server -p $PORT --no-access-log