Extracted renderLegacyGhciScriptFunction

AndrewRademacher · AndrewRademacher · commit 782eda883d4f · 2016-07-30T18:51:59.000-05:00
diff --git a/src/Stack/Ghci.hs b/src/Stack/Ghci.hs
@@ -14,6 +14,9 @@ module Stack.Ghci
     , GhciException(..)
     , ghciSetup
     , ghci
+
+    -- TODO: Address what should and should not be exported.
+    , renderLegacyGhciScript
     ) where
 
 import           Control.Applicative
@@ -171,20 +174,41 @@ ghci opts@GhciOpts{..} = do
                  -- include CWD.
                   "-i" :
                   odir <> pkgopts <> ghciArgs <> extras)
-    withSystemTempDir "ghci" $ \tmpDir -> do
-        let macrosFile = tmpDir </> $(mkRelFile "cabal_macros.h")
-        macrosOpts <- preprocessCabalMacros pkgs macrosFile
-        if ghciNoLoadModules
-            then execGhci macrosOpts
-            else do
-                let scriptPath = tmpDir </> $(mkRelFile "ghci-script")
-                    fp = toFilePath scriptPath
-                    loadModules = ":add " <> unwords (map quoteFileName modulesToLoad)
-                    addMainFile = maybe "" ((":add " <>) . quoteFileName . toFilePath) mainFile
-                    bringIntoScope = ":module + " <> unwords modulesToLoad
-                liftIO (writeFile fp (unlines [loadModules,addMainFile,bringIntoScope]))
-                setScriptPerms fp
-                execGhci (macrosOpts ++ ["-ghci-script=" <> fp])
+
+    withSystemTempDir "ghci" $ \tmpDirectory -> do
+      macrosOptions <- writeMacrosFile tmpDirectory pkgs
+      if ghciNoLoadModules
+          then execGhci macrosOptions
+          else do
+              scriptPath <- writeGhciScript tmpDirectory (renderLegacyGhciScript modulesToLoad mainFile)
+              execGhci (macrosOptions ++ ["-ghci-script=" <> toFilePath scriptPath])
+
+writeMacrosFile :: (MonadIO m) => Path Abs Dir -> [GhciPkgInfo] -> m [String]
+writeMacrosFile tmpDirectory packages = do
+  macrosOptions <- preprocessCabalMacros packages macrosFile
+  return macrosOptions
+  where
+    macrosFile = tmpDirectory </> $(mkRelFile "cabal_macros.h")
+
+writeGhciScript :: (MonadIO m) => Path Abs Dir -> String -> m (Path Abs File)
+writeGhciScript tmpDirectory script = do
+  liftIO $ writeFile scriptFilePath script
+  setScriptPerms scriptFilePath
+  return scriptPath
+  where
+    scriptPath = tmpDirectory </> $(mkRelFile "ghci-script")
+    scriptFilePath = toFilePath scriptPath
+
+renderLegacyGhciScript :: [String] -> Maybe (Path b t) -> String
+renderLegacyGhciScript modulesToLoad mainFile =
+    let loadModules = ":add" <> case unwords (map quoteFileName modulesToLoad) of
+                                  [] -> ""
+                                  xs -> " " <> xs
+        addMainFile = maybe "" ((":add " <>) . quoteFileName . toFilePath) mainFile
+        bringIntoScope = ":module +" <> case unwords modulesToLoad of
+                                          [] -> ""
+                                          xs -> " " <> xs
+    in unlines [loadModules,addMainFile,bringIntoScope]
 
 -- | Figure out the main-is file to load based on the targets. Sometimes there
 -- is none, sometimes it's unambiguous, sometimes it's
diff --git a/src/test/Stack/GhciSpec.hs b/src/test/Stack/GhciSpec.hs
@@ -0,0 +1,52 @@
+{-# LANGUAGE QuasiQuotes #-}
+{-# LANGUAGE TemplateHaskell #-}
+
+-- | Test suite for GHCi like applications including both GHCi and Intero.
+module Stack.GhciSpec where
+
+import           Data.Text (Text)
+import qualified Data.Text as T
+import           Test.Hspec
+import           NeatInterpolation
+import           Path
+
+import           Stack.Ghci
+
+spec :: Spec
+spec = do
+  describe "GHCi" $ do
+    describe "Script rendering" $ do
+      it "should render legacy script when given project:exe" $ do
+        renderLegacyGhciScript [] (Just $(mkAbsFile "/Users/someone/src/project-a/exe/Main.hs"))
+          `shouldBe` T.unpack ghciScript_projectWithMain
+
+      it "should render legacy script when given project" $ do
+        renderLegacyGhciScript ["Lib.A"] (Just $(mkAbsFile "/Users/someone/src/project-a/exe/Main.hs"))
+          `shouldBe` T.unpack ghciScript_projectWithLibAndMain
+
+      it "should render legacy script when given multiple project:lib" $ do
+        renderLegacyGhciScript ["Lib.A", "Lib.B"] Nothing
+          `shouldBe` T.unpack ghciScript_multipleProjectsWithLib
+
+-- Exptected GHCi scripts
+
+ghciScript_projectWithMain :: Text
+ghciScript_projectWithMain = [text|
+:add
+:add /Users/someone/src/project-a/exe/Main.hs
+:module +
+|]
+
+ghciScript_projectWithLibAndMain :: Text
+ghciScript_projectWithLibAndMain = [text|
+:add Lib.A
+:add /Users/someone/src/project-a/exe/Main.hs
+:module + Lib.A
+|]
+
+ghciScript_multipleProjectsWithLib :: Text
+ghciScript_multipleProjectsWithLib = [text|
+:add Lib.A Lib.B
+
+:module + Lib.A Lib.B
+|]
diff --git a/stack.cabal b/stack.cabal
@@ -306,6 +306,7 @@ test-suite stack-test
                 , hspec <2.3
                 , http-conduit
                 , monad-logger
+                , neat-interpolation
                 , path >= 0.5.7
                 , path-io >= 1.1.0 && < 2.0.0
                 , resourcet
