Add options to codeworld-compiler to do incremental building.

This is a step toward #540

Author: cdsmith

codeworld-compiler/exec/Main.hs

@@ -18,51 +18,69 @@
 -}
 
 import           Compile
+import           Control.Applicative (optional)
 import           Control.Monad (join)
 import           Data.Monoid ((<>))
 import           Options.Applicative
 import           System.Environment
 import           System.Directory
 import           System.IO
 
-data Options = Options { source :: String, 
-                         output :: String, 
-                         err :: String, 
-                         mode :: String
+data Options = Options { source      :: String,
+                         output      :: String,
+                         err         :: String,
+                         mode        :: String,
+                         baseModule  :: Maybe String,
+                         baseSymbols :: Maybe String
                        } deriving (Show)
 
 main = execParser opts >>= runWithOptions
     where
-        parser = Options <$> argument str (  metavar "SourceFile" 
-                                          <> help "Location of source file" )
-                         <*> strOption    (  long "output" 
-                                          <> short 'o' 
-                                          <> metavar "OutputFile" 
-                                          <> help "Location of output file" )
-                         <*> strOption    (  long "error" 
-                                          <> short 'e' 
-                                          <> metavar "ErrorFile"  
-                                          <> help "Location of error file" )
-                         <*> strOption    (  long "mode" 
-                                          <> short 'm' 
-                                          <> metavar "BuildMode"  
-                                          <> help "Enter the mode of compilation" )
+        parser = Options <$> argument str        (  metavar "SourceFile"
+                                                 <> help "Location of source file" )
+                         <*> strOption           (  long "output"
+                                                 <> short 'o'
+                                                 <> metavar "OutputFile"
+                                                 <> help "Location of output file" )
+                         <*> strOption           (  long "error"
+                                                 <> short 'e'
+                                                 <> metavar "ErrorFile"
+                                                 <> help "Location of error file" )
+                         <*> strOption           (  long "mode"
+                                                 <> short 'm'
+                                                 <> metavar "BuildMode"
+                                                 <> help "Enter the mode of compilation" )
+                         <*> optional (strOption (  long "base-module"
+                                                 <> short 'b'
+                                                 <> metavar "BaseModule"
+                                                 <> help "Base module to build dependencies" ))
+                         <*> optional (strOption (  long "base-syms"
+                                                 <> short 's'
+                                                 <> metavar "BaseSyms"
+                                                 <> help "Location of base symbol file" ))
         opts = info parser mempty
 
+optionsToStage :: Options -> Stage
+optionsToStage Options{..} = case (baseModule, baseSymbols) of
+    (Just mod, Just syms) -> GenBase mod syms
+    (Nothing, Just syms)  -> UseBase syms
+    (Nothing, Nothing)    -> FullBuild
+    _                     -> error "--base-module must be used with --base-syms"
+
 runWithOptions :: Options -> IO ()
-runWithOptions Options{..} = do
+runWithOptions opts@Options{..} = do
     fileExists <- doesFileExist source
     if fileExists 
       then do
-        compileOutput <- extractSource source output err mode
+        compileOutput <- extractSource (optionsToStage opts) source output err mode
         return ()
       else 
         putStrLn $ "File not found:" ++ (show source)
 
-extractSource :: String -> String -> String -> String -> IO Bool
-extractSource  source out err mode = do 
-    res <- compileSource source out err mode
-    case res of 
+extractSource :: Stage -> String -> String -> String -> String -> IO Bool
+extractSource stage source out err mode = do
+    res <- compileSource stage source out err mode
+    case res of
         True -> return True
         False -> do
             errMsg <- readFile err

codeworld-compiler/src/Compile.hs

@@ -17,7 +17,7 @@
   limitations under the License.
 -}
 
-module Compile ( compileSource ) where
+module Compile ( compileSource, Stage(..) ) where
 
 import           Control.Concurrent
 import           Control.Monad
@@ -35,8 +35,12 @@ import           Text.Regex.TDFA
 
 import ParseCode
 
-compileSource :: FilePath -> FilePath -> FilePath -> String -> IO Bool
-compileSource src out err mode = checkDangerousSource src >>= \case
+data Stage = FullBuild
+           | GenBase String FilePath
+           | UseBase FilePath
+
+compileSource :: Stage -> FilePath -> FilePath -> FilePath -> String -> IO Bool
+compileSource stage src out err mode = checkDangerousSource src >>= \case
     True -> do
         B.writeFile err
             "Sorry, but your program refers to forbidden language features."
@@ -49,7 +53,11 @@ compileSource src out err mode = checkDangerousSource src >>= \case
         baseArgs <- case mode of
             "haskell"   -> return haskellCompatibleBuildArgs
             "codeworld" -> standardBuildArgs <$> hasOldStyleMain src
-        let ghcjsArgs = baseArgs ++ [ "program.hs" ]
+        let linkArgs = case stage of
+                FullBuild      -> []
+                GenBase name _ -> ["-generate-base", name]
+                UseBase path   -> ["-use-base", path]
+        let ghcjsArgs = baseArgs ++ linkArgs ++ [ "program.hs" ]
         runCompiler tmpdir userCompileMicros ghcjsArgs >>= \case
             Nothing -> return False
             Just output -> do
@@ -67,6 +75,10 @@ compileSource src out err mode = checkDangerousSource src >>= \case
                     libCode <- B.readFile $ target </> "lib.js"
                     outCode <- B.readFile $ target </> "out.js"
                     B.writeFile out (rtsCode <> libCode <> outCode)
+                    case stage of
+                        GenBase _ sympath ->
+                            copyFile (target </> "out.base.symbs") sympath
+                        _ -> return ()
                 return hasTarget
 
 userCompileMicros :: Int

codeworld-server/src/Main.hs

@@ -380,6 +380,7 @@ compileIfNeeded mode programId = do
     if hasResult
         then return hasTarget
         else compileSource
+                 FullBuild
                  (buildRootDir mode </> sourceFile programId)
                  (buildRootDir mode </> targetFile programId)
                  (buildRootDir mode </> resultFile programId)