Expose shake options used

ghcide/CHANGELOG.md

@@ -1,5 +1,7 @@
-### 0.7.1 (2020-01-13)
+### 0.7.2 (2020-01-14)
+* Expose shakeOptions used - (Pepe Iborra)
 
+### 0.7.1 (2020-01-13)
 * Fix sticky diagnostics bug (#1188) - (Pepe Iborra)
 * Use completionSnippetsOn flag (#1195) - (Yuya Kono)
 * Update tested-with GHC in cabal config - (jneira)
@@ -13,7 +15,6 @@
 * fix suggestAddTypeAnnotation regex (#760) - (Kostas Dermentzis)
 
 ### 0.7.0 (2020-01-03)
-
 * Ghcide now loads HLS plugins internally - (Pepe Iborra)
 * Retry a failed cradle if the cradle descriptor changes (#762) - (Pepe Iborra)
 * Fix extend imports regression (#769) - (Pepe Iborra)

ghcide/exe/Main.hs

@@ -30,6 +30,7 @@ import Development.IDE.Types.Logger
 import Development.IDE.Plugin
 import Development.IDE.Plugin.Test as Test
 import Development.IDE.Session (loadSession)
+import Development.Shake (ShakeOptions (shakeThreads))
 import qualified Language.Haskell.LSP.Core as LSP
 import Language.Haskell.LSP.Messages
 import Language.Haskell.LSP.Types
@@ -114,15 +115,16 @@ main = do
             hPutStrLn stderr $ "Started LSP server in " ++ showDuration t
             sessionLoader <- loadSession $ fromMaybe dir rootPath
             config <- fromMaybe def <$> getConfig
-            let options = (defaultIdeOptions sessionLoader)
+            let options = defOptions
                     { optReportProgress    = clientSupportsProgress caps
                     , optShakeProfiling    = argsShakeProfiling
                     , optOTMemoryProfiling = IdeOTMemoryProfiling argsOTMemoryProfiling
                     , optTesting           = IdeTesting argsTesting
-                    , optThreads           = argsThreads
+                    , optShakeOptions      = (optShakeOptions defOptions){shakeThreads = argsThreads}
                     , optCheckParents      = checkParents config
                     , optCheckProject      = checkProject config
                     }
+                defOptions = defaultIdeOptions sessionLoader
                 logLevel = if argsVerbose then minBound else Info
             debouncer <- newAsyncDebouncer
             let rules = do
@@ -160,14 +162,15 @@ main = do
         debouncer <- newAsyncDebouncer
         let dummyWithProg _ _ f = f (const (pure ()))
         sessionLoader <- loadSession dir
-        let options = (defaultIdeOptions sessionLoader)
+        let options = defOptions
                     { optShakeProfiling    = argsShakeProfiling
                     -- , optOTMemoryProfiling = IdeOTMemoryProfiling argsOTMemoryProfiling
                     , optTesting           = IdeTesting argsTesting
-                    , optThreads           = argsThreads
+                    , optShakeOptions      = (optShakeOptions defOptions){shakeThreads = argsThreads}
                     , optCheckParents      = NeverCheck
                     , optCheckProject      = False
                     }
+            defOptions = defaultIdeOptions sessionLoader
             logLevel = if argsVerbose then minBound else Info
         ide <- initialise def mainRule (pure $ IdInt 0) (showEvent lock) dummyWithProg (const (const id)) (logger logLevel) debouncer options vfs
 

ghcide/ghcide.cabal

@@ -2,7 +2,7 @@ cabal-version:      1.20
 build-type:         Simple
 category:           Development
 name:               ghcide
-version:            0.7.1.0
+version:            0.7.2.0
 license:            Apache-2.0
 license-file:       LICENSE
 author:             Digital Asset and Ghcide contributors
@@ -277,6 +277,7 @@ executable ghcide
         ghcide,
         lens,
         optparse-applicative,
+        shake,
         text,
         unordered-containers
     other-modules:

ghcide/src/Development/IDE/Core/Service.hs

@@ -18,7 +18,6 @@ module Development.IDE.Core.Service(
     updatePositionMapping,
     ) where
 
-import Data.Maybe
 import Development.IDE.Types.Options (IdeOptions(..))
 import Development.IDE.Core.Debouncer
 import           Development.IDE.Core.FileStore  (VFSHandle, fileStoreRules)
@@ -62,10 +61,8 @@ initialise caps mainRule getLspId toDiags wProg wIndefProg logger debouncer opti
         (optShakeProfiling options)
         (optReportProgress options)
         (optTesting options)
-        shakeOptions
-          { shakeThreads = optThreads options
-          , shakeFiles   = fromMaybe "/dev/null" (optShakeFiles options)
-          } $ do
+        (optShakeOptions options)
+          $ do
             addIdeGlobal $ GlobalIdeOptions options
             fileStoreRules vfs
             ofInterestRules

ghcide/src/Development/IDE/Types/Options.hs

@@ -15,7 +15,7 @@ module Development.IDE.Types.Options
   , IdeResult
   , IdeGhcSession(..)
   , OptHaddockParse(..)
-  ) where
+  ,optShakeFiles) where
 
 import Data.Default
 import Development.Shake
@@ -50,12 +50,6 @@ data IdeOptions = IdeOptions
     -- ^ How to locate source and @.hie@ files given a module name.
   , optExtensions :: [String]
     -- ^ File extensions to search for code, defaults to Haskell sources (including @.hs@)
-
-  , optThreads :: Int
-    -- ^ Number of threads to use. Use 0 for number of threads on the machine.
-  , optShakeFiles :: Maybe FilePath
-  -- ^ Directory where the shake database should be stored. For ghcide this is always set to `Nothing` for now
-  -- meaning we keep everything in memory but the daml CLI compiler uses this for incremental builds.
   , optShakeProfiling :: Maybe FilePath
     -- ^ Set to 'Just' to create a directory of profiling reports.
   , optOTMemoryProfiling :: IdeOTMemoryProfiling
@@ -90,8 +84,16 @@ data IdeOptions = IdeOptions
   , optCustomDynFlags :: DynFlags -> DynFlags
     -- ^ Will be called right after setting up a new cradle,
     --   allowing to customize the Ghc options used
+  , optShakeOptions :: ShakeOptions
   }
 
+optShakeFiles :: IdeOptions -> Maybe FilePath
+optShakeFiles opts
+  | value == defValue = Nothing
+  | otherwise = Just value
+  where
+    value = shakeFiles (optShakeOptions opts)
+    defValue = shakeFiles (optShakeOptions $ defaultIdeOptions undefined)
 data OptHaddockParse = HaddockParse | NoHaddockParse
   deriving (Eq,Ord,Show,Enum)
 
@@ -119,8 +121,10 @@ defaultIdeOptions session = IdeOptions
     ,optGhcSession = session
     ,optExtensions = ["hs", "lhs"]
     ,optPkgLocationOpts = defaultIdePkgLocationOptions
-    ,optThreads = 0
-    ,optShakeFiles = Nothing
+    ,optShakeOptions = shakeOptions
+        {shakeThreads = 0
+        ,shakeFiles = "/dev/null"
+        }
     ,optShakeProfiling = Nothing
     ,optOTMemoryProfiling = IdeOTMemoryProfiling False
     ,optReportProgress = IdeReportProgress False

src/Ide/Main.hs

@@ -55,7 +55,7 @@ import System.FilePath
 import System.IO
 import qualified System.Log.Logger as L
 import System.Time.Extra
-import Development.Shake (action)
+import Development.Shake (ShakeOptions (shakeThreads), action)
 
 ghcIdePlugins :: T.Text -> IdePlugins IdeState -> (Plugin Config, [T.Text])
 ghcIdePlugins pid ps = (asGhcIdePlugin ps, allLspCmdIds' pid ps)
@@ -131,14 +131,13 @@ runLspMode lspArgs@LspArguments{..} idePlugins = do
             hPutStrLn stderr $ "Started LSP server in " ++ showDuration t
             sessionLoader <- loadSession dir
             -- config <- fromMaybe defaultLspConfig <$> getConfig
-            let options = (defaultIdeOptions sessionLoader)
+            let options = defOptions
                     { optReportProgress = clientSupportsProgress caps
                     , optShakeProfiling = argsShakeProfiling
                     , optTesting        = IdeTesting argsTesting
-                    , optThreads        = argsThreads
-                    -- , optCheckParents   = checkParents config
-                    -- , optCheckProject   = checkProject config
+                    , optShakeOptions   = (optShakeOptions defOptions){shakeThreads = argsThreads}
                     }
+                defOptions = defaultIdeOptions sessionLoader
             debouncer <- newAsyncDebouncer
             initialise caps (mainRule >> pluginRules plugins >> action kick)
                 getLspId event wProg wIndefProg hlsLogger debouncer options vfs