1-- Copyright (c) 2019 The DAML Authors. All rights reserved.
2-- SPDX-License-Identifier: Apache-2.0
3{-# LANGUAGE CPP                 #-}
4{-# OPTIONS_GHC -Wno-dodgy-imports #-} -- GHC no longer exports def in GHC 8.6 and above
5{-# LANGUAGE OverloadedStrings   #-}
6{-# LANGUAGE RecordWildCards     #-}
7{-# LANGUAGE ScopedTypeVariables #-}
8{-# LANGUAGE TypeFamilies        #-}
9
10module Ide.Main(defaultMain, runLspMode) where
11
12import           Control.Monad.Extra
13import qualified Data.Aeson.Encode.Pretty      as A
14import qualified Data.ByteString.Lazy.Char8    as LBS
15import           Data.Default
16import           Data.List                     (sort)
17import qualified Data.Text                     as T
18import           Development.IDE.Core.Rules
19import           Development.IDE.Graph         (ShakeOptions (shakeThreads))
20import           Development.IDE.Main          (isLSP)
21import qualified Development.IDE.Main          as Main
22import qualified Development.IDE.Session       as Session
23import           Development.IDE.Types.Logger  as G
24import qualified Development.IDE.Types.Options as Ghcide
25import           Ide.Arguments
26import           Ide.Logger
27import           Ide.Plugin.ConfigUtils        (pluginsToDefaultConfig,
28                                                pluginsToVSCodeExtensionSchema)
29import           Ide.Types                     (IdePlugins, PluginId (PluginId),
30                                                ipMap)
31import           Ide.Version
32import qualified Language.LSP.Server           as LSP
33import qualified System.Directory.Extra        as IO
34import           System.IO
35import qualified System.Log.Logger             as L
36
37defaultMain :: Arguments -> IdePlugins IdeState -> IO ()
38defaultMain args idePlugins = do
39    -- WARNING: If you write to stdout before runLanguageServer
40    --          then the language server will not work
41
42    hlsVer <- haskellLanguageServerVersion
43    case args of
44        ProbeToolsMode -> do
45            programsOfInterest <- findProgramVersions
46            putStrLn hlsVer
47            putStrLn "Tool versions found on the $PATH"
48            putStrLn $ showProgramVersionOfInterest programsOfInterest
49
50        VersionMode PrintVersion ->
51            putStrLn hlsVer
52
53        VersionMode PrintNumericVersion ->
54            putStrLn haskellLanguageServerNumericVersion
55
56        ListPluginsMode -> do
57            let pluginNames = sort
58                    $ map ((\(PluginId t) -> T.unpack t) . fst)
59                    $ ipMap idePlugins
60            mapM_ putStrLn pluginNames
61
62        BiosMode PrintCradleType -> do
63            dir <- IO.getCurrentDirectory
64            hieYaml <- Session.findCradle def dir
65            cradle <- Session.loadCradle def hieYaml dir
66            print cradle
67
68        Ghcide ghcideArgs -> do
69            {- see WARNING above -}
70            hPutStrLn stderr hlsVer
71            runLspMode ghcideArgs idePlugins
72
73        VSCodeExtensionSchemaMode -> do
74          LBS.putStrLn $ A.encodePretty $ pluginsToVSCodeExtensionSchema idePlugins
75
76        DefaultConfigurationMode -> do
77          LBS.putStrLn $ A.encodePretty $ pluginsToDefaultConfig idePlugins
78
79-- ---------------------------------------------------------------------
80
81hlsLogger :: G.Logger
82hlsLogger = G.Logger $ \pri txt ->
83    case pri of
84      G.Telemetry -> logm     (T.unpack txt)
85      G.Debug     -> debugm   (T.unpack txt)
86      G.Info      -> logm     (T.unpack txt)
87      G.Warning   -> warningm (T.unpack txt)
88      G.Error     -> errorm   (T.unpack txt)
89
90-- ---------------------------------------------------------------------
91
92runLspMode :: GhcideArguments -> IdePlugins IdeState -> IO ()
93runLspMode ghcideArgs@GhcideArguments{..} idePlugins = do
94    whenJust argsCwd IO.setCurrentDirectory
95    dir <- IO.getCurrentDirectory
96    LSP.setupLogger argsLogFile ["hls", "hie-bios"]
97      $ if argsDebugOn then L.DEBUG else L.INFO
98
99    when (isLSP argsCommand) $ do
100        hPutStrLn stderr "Starting (haskell-language-server)LSP server..."
101        hPutStrLn stderr $ "  with arguments: " <> show ghcideArgs
102        hPutStrLn stderr $ "  with plugins: " <> show (map fst $ ipMap idePlugins)
103        hPutStrLn stderr $ "  in directory: " <> dir
104
105    Main.defaultMain def
106      { Main.argCommand = argsCommand
107      , Main.argsHlsPlugins = idePlugins
108      , Main.argsLogger = pure hlsLogger
109      , Main.argsIdeOptions = \_config sessionLoader ->
110        let defOptions = Ghcide.defaultIdeOptions sessionLoader
111        in defOptions
112            { Ghcide.optShakeProfiling = argsShakeProfiling
113            , Ghcide.optTesting = Ghcide.IdeTesting argsTesting
114            , Ghcide.optShakeOptions = (Ghcide.optShakeOptions defOptions)
115                {shakeThreads = argsThreads}
116            }
117      }
118