{-# LANGUAGE CPP #-}
{-# OPTIONS_GHC -Wno-dodgy-imports #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
module Ide.Main(defaultMain, runLspMode) where
import Control.Monad.Extra
import qualified Data.Aeson.Encode.Pretty as A
import qualified Data.ByteString.Lazy.Char8 as LBS
import Data.Default
import Data.List (sort)
import qualified Data.Text as T
import Development.IDE.Core.Rules
import Development.IDE.Core.Tracing (withTelemetryLogger)
import Development.IDE.Graph (ShakeOptions (shakeThreads))
import Development.IDE.Main (isLSP)
import qualified Development.IDE.Main as Main
import qualified Development.IDE.Session as Session
import Development.IDE.Types.Logger as G
import qualified Development.IDE.Types.Options as Ghcide
import Ide.Arguments
import Ide.Logger
import Ide.Plugin.ConfigUtils (pluginsToDefaultConfig,
pluginsToVSCodeExtensionSchema)
import Ide.Types (IdePlugins, PluginId (PluginId),
ipMap)
import Ide.Version
import qualified Language.LSP.Server as LSP
import qualified System.Directory.Extra as IO
import System.IO
import qualified System.Log.Logger as L
defaultMain :: Arguments -> IdePlugins IdeState -> IO ()
defaultMain :: Arguments -> IdePlugins IdeState -> IO ()
defaultMain Arguments
args IdePlugins IdeState
idePlugins = do
String
hlsVer <- IO String
haskellLanguageServerVersion
case Arguments
args of
Arguments
ProbeToolsMode -> do
ProgramsOfInterest
programsOfInterest <- IO ProgramsOfInterest
findProgramVersions
String -> IO ()
putStrLn String
hlsVer
String -> IO ()
putStrLn String
"Tool versions found on the $PATH"
String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ ProgramsOfInterest -> String
showProgramVersionOfInterest ProgramsOfInterest
programsOfInterest
VersionMode PrintVersion
PrintVersion ->
String -> IO ()
putStrLn String
hlsVer
VersionMode PrintVersion
PrintNumericVersion ->
String -> IO ()
putStrLn String
haskellLanguageServerNumericVersion
Arguments
ListPluginsMode -> do
let pluginNames :: [String]
pluginNames = [String] -> [String]
forall a. Ord a => [a] -> [a]
sort
([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ ((PluginId, PluginDescriptor IdeState) -> String)
-> [(PluginId, PluginDescriptor IdeState)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ((\(PluginId Text
t) -> Text -> String
T.unpack Text
t) (PluginId -> String)
-> ((PluginId, PluginDescriptor IdeState) -> PluginId)
-> (PluginId, PluginDescriptor IdeState)
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PluginId, PluginDescriptor IdeState) -> PluginId
forall a b. (a, b) -> a
fst)
([(PluginId, PluginDescriptor IdeState)] -> [String])
-> [(PluginId, PluginDescriptor IdeState)] -> [String]
forall a b. (a -> b) -> a -> b
$ IdePlugins IdeState -> [(PluginId, PluginDescriptor IdeState)]
forall ideState.
IdePlugins ideState -> [(PluginId, PluginDescriptor ideState)]
ipMap IdePlugins IdeState
idePlugins
(String -> IO ()) -> [String] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ String -> IO ()
putStrLn [String]
pluginNames
BiosMode BiosAction
PrintCradleType -> do
String
dir <- IO String
IO.getCurrentDirectory
Maybe String
hieYaml <- SessionLoadingOptions -> String -> IO (Maybe String)
Session.findCradle SessionLoadingOptions
forall a. Default a => a
def String
dir
Cradle Void
cradle <- SessionLoadingOptions -> Maybe String -> String -> IO (Cradle Void)
Session.loadCradle SessionLoadingOptions
forall a. Default a => a
def Maybe String
hieYaml String
dir
Cradle Void -> IO ()
forall a. Show a => a -> IO ()
print Cradle Void
cradle
Ghcide GhcideArguments
ghcideArgs -> do
Handle -> String -> IO ()
hPutStrLn Handle
stderr String
hlsVer
GhcideArguments -> IdePlugins IdeState -> IO ()
runLspMode GhcideArguments
ghcideArgs IdePlugins IdeState
idePlugins
Arguments
VSCodeExtensionSchemaMode -> do
ByteString -> IO ()
LBS.putStrLn (ByteString -> IO ()) -> ByteString -> IO ()
forall a b. (a -> b) -> a -> b
$ Value -> ByteString
forall a. ToJSON a => a -> ByteString
A.encodePretty (Value -> ByteString) -> Value -> ByteString
forall a b. (a -> b) -> a -> b
$ IdePlugins IdeState -> Value
forall a. IdePlugins a -> Value
pluginsToVSCodeExtensionSchema IdePlugins IdeState
idePlugins
Arguments
DefaultConfigurationMode -> do
ByteString -> IO ()
LBS.putStrLn (ByteString -> IO ()) -> ByteString -> IO ()
forall a b. (a -> b) -> a -> b
$ Value -> ByteString
forall a. ToJSON a => a -> ByteString
A.encodePretty (Value -> ByteString) -> Value -> ByteString
forall a b. (a -> b) -> a -> b
$ IdePlugins IdeState -> Value
forall a. IdePlugins a -> Value
pluginsToDefaultConfig IdePlugins IdeState
idePlugins
hlsLogger :: G.Logger
hlsLogger :: Logger
hlsLogger = (Priority -> Text -> IO ()) -> Logger
G.Logger ((Priority -> Text -> IO ()) -> Logger)
-> (Priority -> Text -> IO ()) -> Logger
forall a b. (a -> b) -> a -> b
$ \Priority
pri Text
txt ->
case Priority
pri of
Priority
G.Telemetry -> String -> IO ()
forall (m :: * -> *). MonadIO m => String -> m ()
logm (Text -> String
T.unpack Text
txt)
Priority
G.Debug -> String -> IO ()
forall (m :: * -> *). MonadIO m => String -> m ()
debugm (Text -> String
T.unpack Text
txt)
Priority
G.Info -> String -> IO ()
forall (m :: * -> *). MonadIO m => String -> m ()
logm (Text -> String
T.unpack Text
txt)
Priority
G.Warning -> String -> IO ()
forall (m :: * -> *). MonadIO m => String -> m ()
warningm (Text -> String
T.unpack Text
txt)
Priority
G.Error -> String -> IO ()
forall (m :: * -> *). MonadIO m => String -> m ()
errorm (Text -> String
T.unpack Text
txt)
runLspMode :: GhcideArguments -> IdePlugins IdeState -> IO ()
runLspMode :: GhcideArguments -> IdePlugins IdeState -> IO ()
runLspMode ghcideArgs :: GhcideArguments
ghcideArgs@GhcideArguments{Bool
Int
Maybe String
Command
argsProjectGhcVersion :: GhcideArguments -> Bool
argsThreads :: GhcideArguments -> Int
argsLogFile :: GhcideArguments -> Maybe String
argsDebugOn :: GhcideArguments -> Bool
argsExamplePlugin :: GhcideArguments -> Bool
argsTesting :: GhcideArguments -> Bool
argsShakeProfiling :: GhcideArguments -> Maybe String
argsCwd :: GhcideArguments -> Maybe String
argsCommand :: GhcideArguments -> Command
argsProjectGhcVersion :: Bool
argsThreads :: Int
argsLogFile :: Maybe String
argsDebugOn :: Bool
argsExamplePlugin :: Bool
argsTesting :: Bool
argsShakeProfiling :: Maybe String
argsCwd :: Maybe String
argsCommand :: Command
..} IdePlugins IdeState
idePlugins = (Logger -> IO ()) -> IO ()
forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
(Logger -> m a) -> m a
withTelemetryLogger ((Logger -> IO ()) -> IO ()) -> (Logger -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Logger
telemetryLogger -> do
Maybe String -> (String -> IO ()) -> IO ()
forall (m :: * -> *) a.
Applicative m =>
Maybe a -> (a -> m ()) -> m ()
whenJust Maybe String
argsCwd String -> IO ()
IO.setCurrentDirectory
String
dir <- IO String
IO.getCurrentDirectory
Maybe String -> [String] -> Priority -> IO ()
LSP.setupLogger Maybe String
argsLogFile [String
"hls", String
"hie-bios"]
(Priority -> IO ()) -> Priority -> IO ()
forall a b. (a -> b) -> a -> b
$ if Bool
argsDebugOn then Priority
L.DEBUG else Priority
L.INFO
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Command -> Bool
isLSP Command
argsCommand) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
Handle -> String -> IO ()
hPutStrLn Handle
stderr String
"Starting (haskell-language-server)LSP server..."
Handle -> String -> IO ()
hPutStrLn Handle
stderr (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
" with arguments: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> GhcideArguments -> String
forall a. Show a => a -> String
show GhcideArguments
ghcideArgs
Handle -> String -> IO ()
hPutStrLn Handle
stderr (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
" with plugins: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> [PluginId] -> String
forall a. Show a => a -> String
show (((PluginId, PluginDescriptor IdeState) -> PluginId)
-> [(PluginId, PluginDescriptor IdeState)] -> [PluginId]
forall a b. (a -> b) -> [a] -> [b]
map (PluginId, PluginDescriptor IdeState) -> PluginId
forall a b. (a, b) -> a
fst ([(PluginId, PluginDescriptor IdeState)] -> [PluginId])
-> [(PluginId, PluginDescriptor IdeState)] -> [PluginId]
forall a b. (a -> b) -> a -> b
$ IdePlugins IdeState -> [(PluginId, PluginDescriptor IdeState)]
forall ideState.
IdePlugins ideState -> [(PluginId, PluginDescriptor ideState)]
ipMap IdePlugins IdeState
idePlugins)
Handle -> String -> IO ()
hPutStrLn Handle
stderr (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
" in directory: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
dir
Arguments -> IO ()
Main.defaultMain Arguments
forall a. Default a => a
def
{ argCommand :: Command
Main.argCommand = Command
argsCommand
, argsHlsPlugins :: IdePlugins IdeState
Main.argsHlsPlugins = IdePlugins IdeState
idePlugins
, argsLogger :: IO Logger
Main.argsLogger = Logger -> IO Logger
forall (f :: * -> *) a. Applicative f => a -> f a
pure Logger
hlsLogger IO Logger -> IO Logger -> IO Logger
forall a. Semigroup a => a -> a -> a
<> Logger -> IO Logger
forall (f :: * -> *) a. Applicative f => a -> f a
pure Logger
telemetryLogger
, argsThreads :: Maybe Natural
Main.argsThreads = if Int
argsThreads Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 then Maybe Natural
forall a. Maybe a
Nothing else Natural -> Maybe Natural
forall a. a -> Maybe a
Just (Natural -> Maybe Natural) -> Natural -> Maybe Natural
forall a b. (a -> b) -> a -> b
$ Int -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
argsThreads
, argsIdeOptions :: Config -> Action IdeGhcSession -> IdeOptions
Main.argsIdeOptions = \Config
_config Action IdeGhcSession
sessionLoader ->
let defOptions :: IdeOptions
defOptions = Action IdeGhcSession -> IdeOptions
Ghcide.defaultIdeOptions Action IdeGhcSession
sessionLoader
in IdeOptions
defOptions
{ optShakeProfiling :: Maybe String
Ghcide.optShakeProfiling = Maybe String
argsShakeProfiling
, optTesting :: IdeTesting
Ghcide.optTesting = Bool -> IdeTesting
Ghcide.IdeTesting Bool
argsTesting
, optShakeOptions :: ShakeOptions
Ghcide.optShakeOptions = (IdeOptions -> ShakeOptions
Ghcide.optShakeOptions IdeOptions
defOptions)
{shakeThreads :: Int
shakeThreads = Int
argsThreads}
}
}