purescript · kritzcreek · Nov 3, 2018 · Nov 1, 2018
diff --git a/app/Command/Compile.hs b/app/Command/Compile.hs
@@ -135,22 +135,15 @@ codegenTargets = Opts.option targetParser $
       <> " The default target is 'js', but if this option is used only the targets specified will be used."
       )
 
-targets :: M.Map String P.CodegenTarget
-targets = M.fromList
-  [ ("js", P.JS)
-  , ("sourcemaps", P.JSSourceMap)
-  , ("corefn", P.CoreFn)
-  ]
-
 targetsMessage :: String
-targetsMessage = "Accepted codegen targets are '" <> intercalate "', '" (M.keys targets) <> "'."
+targetsMessage = "Accepted codegen targets are '" <> intercalate "', '" (M.keys P.codegenTargets) <> "'."
 
 targetParser :: Opts.ReadM [P.CodegenTarget]
 targetParser =
   Opts.str >>= \s ->
     for (T.split (== ',') s)
       $ maybe (Opts.readerError targetsMessage) pure
-      . flip M.lookup targets
+      . flip M.lookup P.codegenTargets
       . T.unpack
       . T.strip
 

diff --git a/psc-ide/PROTOCOL.md b/psc-ide/PROTOCOL.md
@@ -372,13 +372,17 @@ Arguments:
   - `actualFile :: Maybe String` Specifies the path to be used for location
     information and parse errors. This is useful in case a temp file is used as
     the source for a rebuild.
+  - `codegen :: Maybe [String]` Specified the codegen targets the
+    rebuild should produce. Uses the same target names as the command
+    line compiler. Defaults to just JS output
 
 ```json
 {
   "command": "rebuild",
   "params": {
-    "file": "/path/to/file.purs"
-    "actualFile": "/path/to/actualFile.purs"
+    "file": "/path/to/file.purs",
+    "actualFile": "/path/to/actualFile.purs",
+    "codegen": ["js", "corefn"]
   }
 }
 ```

diff --git a/src/Language/PureScript/Ide.hs b/src/Language/PureScript/Ide.hs
@@ -94,10 +94,10 @@ handleCommand c = case c of
       Right rs' -> answerRequest outfp rs'
       Left question ->
         pure (CompletionResult (map (completionFromMatch . simpleExport . map withEmptyAnn) question))
-  Rebuild file actualFile ->
-    rebuildFileAsync file actualFile
-  RebuildSync file actualFile ->
-    rebuildFileSync file actualFile
+  Rebuild file actualFile targets ->
+    rebuildFileAsync file actualFile targets
+  RebuildSync file actualFile targets ->
+    rebuildFileSync file actualFile targets
   Cwd ->
     TextResult . T.pack <$> liftIO getCurrentDirectory
   Reset ->

diff --git a/src/Language/PureScript/Ide/Command.hs b/src/Language/PureScript/Ide/Command.hs
@@ -17,6 +17,8 @@ module Language.PureScript.Ide.Command where
 import           Protolude
 
 import           Data.Aeson
+import qualified Data.Map as Map
+import qualified Data.Set as Set
 import qualified Language.PureScript               as P
 import           Language.PureScript.Ide.CaseSplit
 import           Language.PureScript.Ide.Completion
@@ -57,8 +59,8 @@ data Command
       -- Import InputFile OutputFile
     | Import FilePath (Maybe FilePath) [Filter] ImportCommand
     | List { listType :: ListType }
-    | Rebuild FilePath (Maybe FilePath)
-    | RebuildSync FilePath (Maybe FilePath)
+    | Rebuild FilePath (Maybe FilePath) (Set P.CodegenTarget)
+    | RebuildSync FilePath (Maybe FilePath) (Set P.CodegenTarget)
     | Cwd
     | Reset
     | Quit
@@ -172,7 +174,11 @@ instance FromJSON Command where
         Rebuild
           <$> params .: "file"
           <*> params .:? "actualFile"
+          <*> (parseCodegenTargets =<< params .:? "codegen" .!= [ "js" ])
       _ -> mzero
     where
+      parseCodegenTargets =
+        maybe mzero (pure . Set.fromList) . traverse (flip Map.lookup P.codegenTargets)
+
       mkAnnotations True = explicitAnnotations
       mkAnnotations False = noAnnotations
diff --git a/src/Language/PureScript/Ide/Rebuild.hs b/src/Language/PureScript/Ide/Rebuild.hs
@@ -42,10 +42,12 @@ rebuildFile
   -- ^ The file to rebuild
   -> Maybe FilePath
   -- ^ The file to use as the location for parsing and errors
+  -> Set P.CodegenTarget
+  -- ^ The targets to codegen
   -> (ReaderT IdeEnvironment (LoggingT IO) () -> m ())
   -- ^ A runner for the second build with open exports
   -> m Success
-rebuildFile file actualFile runOpenBuild = do
+rebuildFile file actualFile codegenTargets runOpenBuild = do
 
   input <- ideReadFile file
 
@@ -69,7 +71,7 @@ rebuildFile file actualFile runOpenBuild = do
   -- Rebuild the single module using the cached externs
   (result, warnings) <- logPerf (labelTimespec "Rebuilding Module") $
     liftIO
-    . P.runMake P.defaultOptions
+    . P.runMake (P.defaultOptions { P.optionsCodegenTargets = codegenTargets })
     . P.rebuildModule (buildMakeActions
                         >>= shushProgress $ makeEnv) externs $ m
   case result of
@@ -87,8 +89,8 @@ isEditorMode = asks (confEditorMode . ideConfiguration)
 
 rebuildFileAsync
   :: forall m. (Ide m, MonadLogger m, MonadError IdeError m)
-  => FilePath -> Maybe FilePath -> m Success
-rebuildFileAsync fp fp' = rebuildFile fp fp' asyncRun
+  => FilePath -> Maybe FilePath -> Set P.CodegenTarget -> m Success
+rebuildFileAsync fp fp' ts = rebuildFile fp fp' ts asyncRun
   where
     asyncRun :: ReaderT IdeEnvironment (LoggingT IO) () -> m ()
     asyncRun action = do
@@ -98,8 +100,8 @@ rebuildFileAsync fp fp' = rebuildFile fp fp' asyncRun
 
 rebuildFileSync
   :: forall m. (Ide m, MonadLogger m, MonadError IdeError m)
-  => FilePath -> Maybe FilePath -> m Success
-rebuildFileSync fp fp' = rebuildFile fp fp' syncRun
+  => FilePath -> Maybe FilePath -> Set P.CodegenTarget -> m Success
+rebuildFileSync fp fp' ts = rebuildFile fp fp' ts syncRun
   where
     syncRun :: ReaderT IdeEnvironment (LoggingT IO) () -> m ()
     syncRun action = do

diff --git a/src/Language/PureScript/Make/Actions.hs b/src/Language/PureScript/Make/Actions.hs
@@ -44,7 +44,7 @@ import           Language.PureScript.Errors
 import           Language.PureScript.Make.Monad
 import           Language.PureScript.Names
 import           Language.PureScript.Names (runModuleName, ModuleName)
-import           Language.PureScript.Options
+import           Language.PureScript.Options hiding (codegenTargets)
 import qualified Language.PureScript.Parser as PSParser
 import           Language.PureScript.Pretty.Common (SMap(..))
 import qualified Paths_purescript as Paths

diff --git a/src/Language/PureScript/Options.hs b/src/Language/PureScript/Options.hs
@@ -3,6 +3,8 @@ module Language.PureScript.Options where
 
 import Prelude.Compat
 import qualified Data.Set as S
+import Data.Map (Map)
+import qualified Data.Map as Map
 
 -- | The data type of compiler options
 data Options = Options
@@ -20,3 +22,10 @@ defaultOptions = Options False False (S.singleton JS)
 
 data CodegenTarget = JS | JSSourceMap | CoreFn
   deriving (Eq, Ord, Show)
+
+codegenTargets :: Map String CodegenTarget
+codegenTargets = Map.fromList
+  [ ("js", JS)
+  , ("sourcemaps", JSSourceMap)
+  , ("corefn", CoreFn)
+  ]
diff --git a/tests/Language/PureScript/Ide/CompletionSpec.hs b/tests/Language/PureScript/Ide/CompletionSpec.hs
@@ -4,7 +4,8 @@ module Language.PureScript.Ide.CompletionSpec where
 
 import Protolude
 
-import Language.PureScript as P
+import qualified Data.Set as Set
+import qualified Language.PureScript as P
 import Language.PureScript.Ide.Test as Test
 import Language.PureScript.Ide.Command as Command
 import Language.PureScript.Ide.Completion
@@ -30,7 +31,7 @@ load :: [Text] -> Command
 load = LoadSync . map Test.mn
 
 rebuildSync :: FilePath -> Command
-rebuildSync fp = RebuildSync ("src" </> fp) Nothing
+rebuildSync fp = RebuildSync ("src" </> fp) Nothing (Set.singleton P.JS)
 
 spec :: Spec
 spec = describe "Applying completion options" $ do
@@ -63,4 +64,4 @@ spec = describe "Applying completion options" $ do
       Test.runIde [ load ["CompletionSpecDocs"]
                   , typ "withType"
                   ]
-    result `shouldSatisfy` \res -> complDocumentation res == Just "Doc *123*\n"
+    result `shouldSatisfy` \res -> complDocumentation res == Just "Doc *123*\n"
diff --git a/tests/Language/PureScript/Ide/RebuildSpec.hs b/tests/Language/PureScript/Ide/RebuildSpec.hs
@@ -4,23 +4,29 @@ module Language.PureScript.Ide.RebuildSpec where
 
 import           Protolude
 
+import qualified Data.Set as Set
+import qualified Language.PureScript as P
 import           Language.PureScript.AST.SourcePos (spanName)
 import           Language.PureScript.Ide.Command
 import           Language.PureScript.Ide.Completion
 import           Language.PureScript.Ide.Matcher
 import           Language.PureScript.Ide.Types
 import qualified Language.PureScript.Ide.Test as Test
 import           System.FilePath
+import           System.Directory (doesFileExist, removePathForcibly)
 import           Test.Hspec
 
+defaultTarget :: Set P.CodegenTarget
+defaultTarget = Set.singleton P.JS
+
 load :: [Text] -> Command
 load = LoadSync . map Test.mn
 
 rebuild :: FilePath -> Command
-rebuild fp = Rebuild ("src" </> fp) Nothing
+rebuild fp = Rebuild ("src" </> fp) Nothing defaultTarget
 
 rebuildSync :: FilePath -> Command
-rebuildSync fp = RebuildSync ("src" </> fp) Nothing
+rebuildSync fp = RebuildSync ("src" </> fp) Nothing defaultTarget
 
 spec :: Spec
 spec = describe "Rebuilding single modules" $ do
@@ -67,6 +73,20 @@ spec = describe "Rebuilding single modules" $ do
         Test.runIde'
           editorConfig
           emptyIdeState
-          [ RebuildSync ("src" </> "RebuildSpecWithHiddenIdent.purs") (Just "actualFile")
+          [ RebuildSync ("src" </> "RebuildSpecWithHiddenIdent.purs") (Just "actualFile") defaultTarget
           , Complete [] (flexMatcher "hid") (Just (Test.mn "RebuildSpecWithHiddenIdent")) defaultCompletionOptions]
       map spanName (complLocation result) `shouldBe` Just "actualFile"
+    it "doesn't produce JS when an empty target list is supplied" $ do
+      exists <- Test.inProject $ do
+        let indexJs = "output" </> "RebuildSpecSingleModule" </> "index.js"
+        removePathForcibly ("output" </> "RebuildSpecSingleModule")
+        _ <- Test.runIde [ RebuildSync ("src" </> "RebuildSpecSingleModule.purs") Nothing Set.empty ]
+        doesFileExist indexJs
+      exists `shouldBe` False
+    it "does produce corefn if it's a codegen target" $ do
+      exists <- Test.inProject $ do
+        let corefn = "output" </> "RebuildSpecSingleModule" </> "corefn.json"
+        removePathForcibly ("output" </> "RebuildSpecSingleModule")
+        _ <- Test.runIde [ RebuildSync ("src" </> "RebuildSpecSingleModule.purs") Nothing (Set.singleton P.CoreFn) ]
+        doesFileExist corefn
+      exists `shouldBe` True