diff --git a/codeworld-server/codeworld-server.cabal b/codeworld-server/codeworld-server.cabal index 080b314f9..26c5f5b4e 100644 --- a/codeworld-server/codeworld-server.cabal +++ b/codeworld-server/codeworld-server.cabal @@ -33,6 +33,7 @@ Executable codeworld-server regex-tdfa, snap-core, snap-server, + temporary, text Ghc-options: -threaded -Wall -funbox-strict-fields -O2 diff --git a/codeworld-server/src/Build.hs b/codeworld-server/src/Build.hs index 1fcdf9a34..44d5879e3 100644 --- a/codeworld-server/src/Build.hs +++ b/codeworld-server/src/Build.hs @@ -19,11 +19,13 @@ module Build where +import Control.Monad import Data.ByteString (ByteString) import qualified Data.ByteString as B import System.Directory import System.FilePath import System.IO +import System.IO.Temp (withSystemTempDirectory) import System.Process import Text.Regex.TDFA @@ -41,20 +43,21 @@ compileExistingSource mode programId = checkDangerousSource mode programId >>= \ B.writeFile (buildRootDir mode resultFile programId) $ "Sorry, but your program refers to forbidden language features." return False - False -> do + False -> withSystemTempDirectory "codeworld" $ \tmpdir -> do + copyFile (buildRootDir mode sourceFile programId) (tmpdir "program.hs") let baseArgs = case mode of BuildMode "haskell" -> haskellCompatibleBuildArgs _ -> standardBuildArgs - ghcjsArgs = baseArgs ++ [ sourceFile programId ] - success <- runCompiler mode userCompileMicros ghcjsArgs >>= \case - Nothing -> do - removeFileIfExists (buildRootDir mode resultFile programId) - removeFileIfExists (buildRootDir mode targetFile programId) - return False + ghcjsArgs = baseArgs ++ [ "program.hs" ] + success <- runCompiler tmpdir userCompileMicros ghcjsArgs >>= \case + Nothing -> return False Just output -> do B.writeFile (buildRootDir mode resultFile programId) output - doesFileExist (buildRootDir mode targetFile programId) - mapM_ (removeFileIfExists . (buildRootDir mode )) (auxiliaryFiles programId) + let target = tmpdir "program.jsexe" "all.js" + hasTarget <- doesFileExist target + when hasTarget $ + copyFile target (buildRootDir mode targetFile programId) + return hasTarget return success userCompileMicros :: Int @@ -70,11 +73,11 @@ checkDangerousSource mode programId = do matches :: ByteString -> ByteString -> Bool matches txt pat = txt =~ pat -runCompiler :: BuildMode -> Int -> [String] -> IO (Maybe ByteString) -runCompiler mode micros args = do +runCompiler :: FilePath -> Int -> [String] -> IO (Maybe ByteString) +runCompiler dir micros args = do (Just inh, Just outh, Just errh, pid) <- createProcess (proc "ghcjs" args) { - cwd = Just (buildRootDir mode), + cwd = Just dir, std_in = CreatePipe, std_out = CreatePipe, std_err = CreatePipe, diff --git a/codeworld-server/src/Util.hs b/codeworld-server/src/Util.hs index 147791ff5..2106ecdca 100644 --- a/codeworld-server/src/Util.hs +++ b/codeworld-server/src/Util.hs @@ -65,7 +65,7 @@ sourceXML :: ProgramId -> FilePath sourceXML programId = sourceBase programId <.> "xml" targetFile :: ProgramId -> FilePath -targetFile programId = sourceBase programId <.> "jsexe" "all.js" +targetFile programId = sourceBase programId <.> "js" resultFile :: ProgramId -> FilePath resultFile programId = sourceBase programId <.> "err.txt" diff --git a/web/js/codeworld_shared.js b/web/js/codeworld_shared.js index 3d7ec737b..9fe0a6ff3 100644 --- a/web/js/codeworld_shared.js +++ b/web/js/codeworld_shared.js @@ -275,10 +275,10 @@ function addToMessage(msg) { .replace(/&/g, '&') .replace(//g, '>') - .replace(/(user\/)?([PQ]..\/)?[PQ][A-Za-z0-9_=\-]*\.hs:(\d+):((\d+)(-\d+)?)/g, - 'Line $3, Column $4') - .replace(/(user\/)?([PQ]..\/)?[PQ][A-Za-z0-9_=\-]*\.hs:\((\d+),(\d+)\)-\((\d+),(\d+)\)/g, - 'Line $3-$5, Column $4-$6'); + .replace(/program\.hs:(\d+):((\d+)(-\d+)?)/g, + 'Line $1, Column $2') + .replace(/program\.hs:\((\d+),(\d+)\)-\((\d+),(\d+)\)/g, + 'Line $1-$3, Column $2-$4'); var message = document.getElementById('message'); message.innerHTML += msg