Merge pull request #61 from jneira/minor-changes

Some minor changes

Author: alanz

exe/Arguments.hs

@@ -36,8 +36,8 @@ data Arguments = Arguments
     -- them to just change the name of the exe and still work.
     , argsDebugOn       :: Bool
     , argsLogFile       :: Maybe String
-
-    }
+    , argsThread        :: Int
+    } deriving Show
 
 getArguments :: String -> IO Arguments
 getArguments exeName = execParser opts
@@ -73,6 +73,13 @@ arguments exeName = Arguments
           <> metavar "LOGFILE"
           <> help "File to log to, defaults to stdout"
            ))
+      <*> option auto
+           (short 'j'
+          <> help "Number of threads (0: automatic)"
+          <> metavar "NUM"
+          <> value 1
+          <> showDefault
+           )
 
 -- ---------------------------------------------------------------------
 -- Set the GHC libdir to the nix libdir if it's present.

exe/Main.hs

@@ -48,24 +48,25 @@ import Development.IDE.Types.Diagnostics
 import Development.IDE.Types.Location
 import Development.IDE.Types.Logger
 import Development.IDE.Types.Options
-import Development.Shake (Action,  action)
-import           DynFlags                       (gopt_set, gopt_unset,
+import Development.Shake                        (Action,  action)
+import DynFlags                                 (gopt_set, gopt_unset,
                                                  updOptLevel)
-import DynFlags (PackageFlag(..), PackageArg(..))
-import GHC hiding (def)
+import DynFlags                                 (PackageFlag(..), PackageArg(..))
+import GHC hiding                               (def)
 import           GHC.Check                      (runTimeVersion, compileTimeVersionFromLibdir)
 -- import GhcMonad
 import           HIE.Bios.Cradle
-import HIE.Bios.Environment (addCmdOpts)
+import HIE.Bios.Environment                     (addCmdOpts)
 import           HIE.Bios.Types
-import HscTypes (HscEnv(..), ic_dflags)
+import HscTypes                                 (HscEnv(..), ic_dflags)
 import qualified Language.Haskell.LSP.Core as LSP
 import Ide.Logger
 import Ide.Plugin
 import Ide.Plugin.Config
+import Ide.Types                                (IdePlugins, ipMap)
 import Language.Haskell.LSP.Messages
-import Language.Haskell.LSP.Types (LspId(IdInt))
-import Linker (initDynLinker)
+import Language.Haskell.LSP.Types               (LspId(IdInt))
+import Linker                                   (initDynLinker)
 import Module
 import NameCache
 import Packages
@@ -96,15 +97,16 @@ import Ide.Plugin.Pragmas                 as Pragmas
 
 -- ---------------------------------------------------------------------
 
+
+
 -- | The plugins configured for use in this instance of the language
 -- server.
 -- These can be freely added or removed to tailor the available
 -- features of the server.
-idePlugins :: T.Text -> Bool -> (Plugin Config, [T.Text])
-idePlugins pid includeExamples
-    = (asGhcIdePlugin ps, allLspCmdIds' pid ps)
+
+idePlugins :: Bool -> IdePlugins
+idePlugins includeExamples = pluginDescToIdePlugins allPlugins
   where
-    ps = pluginDescToIdePlugins allPlugins
     allPlugins = if includeExamples
                    then basePlugins ++ examplePlugins
                    else basePlugins
@@ -113,7 +115,7 @@ idePlugins pid includeExamples
       --   applyRefactDescriptor "applyrefact"
       -- , brittanyDescriptor    "brittany"
       -- , haddockDescriptor     "haddock"
-      -- -- , hareDescriptor        "hare"
+      -- , hareDescriptor        "hare"
       -- , hsimportDescriptor    "hsimport"
       -- , liquidDescriptor      "liquid"
       -- , packageDescriptor     "package"
@@ -130,6 +132,8 @@ idePlugins pid includeExamples
       -- ,hfaAlignDescriptor "hfaa"
       ]
 
+ghcIdePlugins :: T.Text -> IdePlugins -> (Plugin Config, [T.Text])
+ghcIdePlugins pid ps = (asGhcIdePlugin ps, allLspCmdIds' pid ps)
 
 -- ---------------------------------------------------------------------
 
@@ -141,14 +145,12 @@ main :: IO ()
 main = do
     -- WARNING: If you write to stdout before runLanguageServer
     --          then the language server will not work
-    Arguments{..} <- getArguments "haskell-language-server"
+    args@Arguments{..} <- getArguments "haskell-language-server"
 
     if argsVersion then ghcideVersion >>= putStrLn >> exitSuccess
     else hPutStrLn stderr {- see WARNING above -} =<< ghcideVersion
 
-    -- LSP.setupLogger (optLogFile opts) ["hie", "hie-bios"]
-    --   $ if optDebugOn opts then L.DEBUG else L.INFO
-    LSP.setupLogger argsLogFile ["hie", "hie-bios"]
+    LSP.setupLogger argsLogFile ["hls", "hie-bios"]
       $ if argsDebugOn then L.DEBUG else L.INFO
 
     -- lock to avoid overlapping output on stdout
@@ -162,8 +164,8 @@ main = do
 
     pid <- getPid
     let
-        (ps, commandIds) = idePlugins pid argsExamplePlugin
-        -- (ps, commandIds) = idePlugins pid True
+        idePlugins' = idePlugins argsExamplePlugin
+        (ps, commandIds) = ghcIdePlugins pid idePlugins'
         plugins = Completions.plugin <> CodeAction.plugin <>
                   Plugin mempty HoverDefinition.setHandlersDefinition <>
                   ps
@@ -174,6 +176,8 @@ main = do
     if argLSP then do
         t <- offsetTime
         hPutStrLn stderr "Starting (haskell-language-server)LSP server..."
+        hPutStrLn stderr $ "  with arguments: " <> show args
+        hPutStrLn stderr $ "  with plugins: " <> show (Map.keys $ ipMap idePlugins')
         hPutStrLn stderr "If you are seeing this in a terminal, you probably should have run ghcide WITHOUT the --lsp option!"
         runLanguageServer options (pluginHandler plugins) getInitialConfig getConfigFromNotification $ \getLspId event vfs caps -> do
             t <- t
@@ -183,7 +187,7 @@ main = do
                     , optShakeProfiling = argsShakeProfiling
                     , optTesting        = argsTesting
                     , optInterfaceLoadingDiagnostics = argsTesting
-                    , optThreads = 1
+                    , optThreads = argsThread
                     }
             debouncer <- newAsyncDebouncer
             initialise caps (mainRule >> pluginRules plugins >> action kick)

exe/Wrapper.hs

@@ -57,7 +57,7 @@ main = do
 
   progName <- getProgName
   logm $  "run entered for haskell-language-server-wrapper(" ++ progName ++ ") "
-            ++ hieVersion
+            ++ hlsVersion
   d <- getCurrentDirectory
   logm $ "Current directory:" ++ d
   logm $ "Operating system:" ++ os
@@ -74,12 +74,12 @@ main = do
   logm $ "Project GHC version:" ++ ghcVersion
 
   let
-    hieBin = "haskell-language-server-" ++ ghcVersion
-    backupHieBin =
+    hlsBin = "haskell-language-server-" ++ ghcVersion
+    backupHlsBin =
       case dropWhileEnd (/='.') ghcVersion of
         [] -> "haskell-language-server"
         xs -> "haskell-language-server-" ++ init xs
-    candidates' = [hieBin, backupHieBin, "haskell-language-server"]
+    candidates' = [hlsBin, backupHlsBin, "haskell-language-server"]
     candidates = map (++ exeExtension) candidates'
 
   logm $ "haskell-language-server exe candidates :" ++ show candidates

src/Ide/Logger.hs

@@ -29,15 +29,15 @@ hlsLogger = L.Logger $ \pri txt ->
 -- ---------------------------------------------------------------------
 
 logm :: MonadIO m => String -> m ()
-logm s = liftIO $ infoM "hie" s
+logm s = liftIO $ infoM "hls" s
 
 debugm :: MonadIO m => String -> m ()
-debugm s = liftIO $ debugM "hie" s
+debugm s = liftIO $ debugM "hls" s
 
 warningm :: MonadIO m => String -> m ()
-warningm s = liftIO $ warningM "hie" s
+warningm s = liftIO $ warningM "hls" s
 
 errorm :: MonadIO m => String -> m ()
-errorm s = liftIO $ errorM "hie" s
+errorm s = liftIO $ errorM "hls" s
 
 -- ---------------------------------------------------------------------

src/Ide/Plugin.hs

@@ -137,7 +137,7 @@ makeCodeAction cas lf ideState (CodeActionParams docId range context _) = do
       case literalSupport of
         Nothing -> do
             let cmdParams = [J.toJSON (FallbackCodeActionParams (action ^. edit) (action ^. command))]
-            cmd <- mkLspCommand "hie" "fallbackCodeAction" (action ^. title) (Just cmdParams)
+            cmd <- mkLspCommand "hls" "fallbackCodeAction" (action ^. title) (Just cmdParams)
             return $ Just (CACommand cmd)
         Just _ -> return $ Just (CACodeAction action)
 
@@ -224,7 +224,7 @@ makeExecuteCommands ecs lf ide = do
 
         case parseCmdId cmdId of
           -- Shortcut for immediately applying a applyWorkspaceEdit as a fallback for v3.8 code actions
-          Just ("hie", "fallbackCodeAction") ->
+          Just ("hls", "fallbackCodeAction") ->
             case J.fromJSON cmdParams of
               J.Success (FallbackCodeActionParams mEdit mCmd) -> do
 
@@ -289,7 +289,7 @@ makeExecuteCommands ecs lf ide = do
 
                 case parseCmdId cmdId of
                   -- Shortcut for immediately applying a applyWorkspaceEdit as a fallback for v3.8 code actions
-                  Just ("hie", "fallbackCodeAction") -> do
+                  Just ("hls", "fallbackCodeAction") -> do
                     case A.fromJSON cmdParams of
                       A.Success (FallbackCodeActionParams mEdit mCmd) -> do
 

src/Ide/Version.hs

@@ -17,8 +17,8 @@ import qualified Paths_haskell_language_server as Meta
 import           System.Directory
 import           System.Info
 
-hieVersion :: String
-hieVersion =
+hlsVersion :: String
+hlsVersion =
   let commitCount = $gitCommitCount
   in concat $ concat
     [ [$(simpleVersion Meta.version)]
@@ -27,13 +27,13 @@ hieVersion =
     , [" (" ++ commitCount ++ " commits)" | commitCount /= ("1"::String) &&
                                             commitCount /= ("UNKNOWN" :: String)]
     , [" ", display buildArch]
-    , [" ", hieGhcDisplayVersion]
+    , [" ", hlsGhcDisplayVersion]
     ]
 
 -- ---------------------------------------------------------------------
 
-hieGhcDisplayVersion :: String
-hieGhcDisplayVersion = compilerName ++ "-" ++ VERSION_ghc
+hlsGhcDisplayVersion :: String
+hlsGhcDisplayVersion = compilerName ++ "-" ++ VERSION_ghc
 
 getProjectGhcVersion :: Bios.Cradle Bios.CabalHelper -> IO String
 getProjectGhcVersion crdl =
@@ -42,8 +42,8 @@ getProjectGhcVersion crdl =
     (execProjectGhc crdl ["--numeric-version"])
 
 
-hieGhcVersion :: String
-hieGhcVersion = VERSION_ghc
+hlsGhcVersion :: String
+hlsGhcVersion = VERSION_ghc
 
 -- ---------------------------------------------------------------------