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