1-- Copyright (c) 2019 The DAML Authors. All rights reserved.
2-- SPDX-License-Identifier: Apache-2.0
3{-# OPTIONS_GHC -Wno-dodgy-imports #-} -- GHC no longer exports def in GHC 8.6 and above
4{-# LANGUAGE TemplateHaskell #-}
5
6module Main(main) where
7
8import           Arguments                         (Arguments (..),
9                                                    getArguments)
10import           Control.Monad.Extra               (unless, whenJust)
11import           Data.Default                      (Default (def))
12import           Data.Version                      (showVersion)
13import           Development.GitRev                (gitHash)
14import           Development.IDE                   (action)
15import           Development.IDE.Core.OfInterest   (kick)
16import           Development.IDE.Core.Rules        (mainRule)
17import           Development.IDE.Graph             (ShakeOptions (shakeThreads))
18import qualified Development.IDE.Main              as Main
19import qualified Development.IDE.Plugin.HLS.GhcIde as GhcIde
20import qualified Development.IDE.Plugin.Test       as Test
21import           Development.IDE.Types.Options
22import           Ide.Plugin.Config                 (Config (checkParents, checkProject))
23import           Ide.PluginUtils                   (pluginDescToIdePlugins)
24import           Paths_ghcide                      (version)
25import qualified System.Directory.Extra            as IO
26import           System.Environment                (getExecutablePath)
27import           System.Exit                       (exitSuccess)
28import           System.IO                         (hPutStrLn, stderr)
29import           System.Info                       (compilerVersion)
30
31ghcideVersion :: IO String
32ghcideVersion = do
33  path <- getExecutablePath
34  let gitHashSection = case $(gitHash) of
35        x | x == "UNKNOWN" -> ""
36        x                  -> " (GIT hash: " <> x <> ")"
37  return $ "ghcide version: " <> showVersion version
38             <> " (GHC: " <> showVersion compilerVersion
39             <> ") (PATH: " <> path <> ")"
40             <> gitHashSection
41
42main :: IO ()
43main = do
44    let hlsPlugins = pluginDescToIdePlugins GhcIde.descriptors
45    -- WARNING: If you write to stdout before runLanguageServer
46    --          then the language server will not work
47    Arguments{..} <- getArguments hlsPlugins
48
49    if argsVersion then ghcideVersion >>= putStrLn >> exitSuccess
50    else hPutStrLn stderr {- see WARNING above -} =<< ghcideVersion
51
52    whenJust argsCwd IO.setCurrentDirectory
53
54    Main.defaultMain def
55        {Main.argCommand = argsCommand
56
57        ,Main.argsRules = do
58            -- install the main and ghcide-plugin rules
59            mainRule
60            -- install the kick action, which triggers a typecheck on every
61            -- Shake database restart, i.e. on every user edit.
62            unless argsDisableKick $
63                action kick
64
65        ,Main.argsHlsPlugins =
66            pluginDescToIdePlugins $
67            GhcIde.descriptors
68            ++ [Test.blockCommandDescriptor "block-command" | argsTesting]
69
70        ,Main.argsGhcidePlugin = if argsTesting
71            then Test.plugin
72            else mempty
73
74        ,Main.argsIdeOptions = \config  sessionLoader ->
75            let defOptions = defaultIdeOptions sessionLoader
76            in defOptions
77                { optShakeProfiling = argsShakeProfiling
78                , optOTMemoryProfiling = IdeOTMemoryProfiling argsOTMemoryProfiling
79                , optTesting = IdeTesting argsTesting
80                , optShakeOptions = (optShakeOptions defOptions){shakeThreads = argsThreads}
81                , optCheckParents = pure $ checkParents config
82                , optCheckProject = pure $ checkProject config
83                }
84        }
85