Skip to content

Commit 32a8e70

Browse files
pepeiborrapepeiborra
committed
reuse Development.IDE.Main.Command
1 parent e288132 commit 32a8e70

File tree

7 files changed

+72
-73
lines changed

7 files changed

+72
-73
lines changed

Diff for: ‎exe/Main.hs

+4-3
Original file line numberDiff line numberDiff line change
@@ -4,7 +4,8 @@
44
{-# LANGUAGE RecordWildCards #-}
55
module Main(main) where
66

7-
import Ide.Arguments (Arguments (..), LspArguments (..), getArguments)
7+
import Ide.Arguments (Arguments (..), GhcideArguments (..),
8+
getArguments)
89
import Ide.Main (defaultMain)
910
import Plugins
1011

@@ -14,7 +15,7 @@ main = do
1415

1516
let withExamples =
1617
case args of
17-
LspMode LspArguments{..} -> argsExamplePlugin
18-
_ -> False
18+
Ghcide GhcideArguments{..} -> argsExamplePlugin
19+
_ -> False
1920

2021
defaultMain args (idePlugins withExamples)

Diff for: ‎ghcide/exe/Arguments.hs

+10-23
Original file line numberDiff line numberDiff line change
@@ -1,18 +1,13 @@
11
-- Copyright (c) 2019 The DAML Authors. All rights reserved.
22
-- SPDX-License-Identifier: Apache-2.0
33

4-
module Arguments(Arguments, Arguments'(..), getArguments, IdeCmd(..)) where
4+
module Arguments(Arguments(..), getArguments) where
55

6-
import HieDb.Run
6+
import Development.IDE.Main (Command (..), commandP)
77
import Options.Applicative
88

9-
type Arguments = Arguments' IdeCmd
10-
11-
data IdeCmd = Typecheck [FilePath] | DbCmd Options Command | DbIndex [FilePath] | LSP
12-
13-
data Arguments' a = Arguments
14-
{argLSP :: Bool
15-
,argsCwd :: Maybe FilePath
9+
data Arguments = Arguments
10+
{argsCwd :: Maybe FilePath
1611
,argsVersion :: Bool
1712
,argsVSCodeExtensionSchema :: Bool
1813
,argsDefaultConfig :: Bool
@@ -22,7 +17,7 @@ data Arguments' a = Arguments
2217
,argsDisableKick :: Bool
2318
,argsThreads :: Int
2419
,argsVerbose :: Bool
25-
,argFilesOrCmd :: a
20+
,argsCommand :: Command
2621
}
2722

2823
getArguments :: IO Arguments
@@ -34,8 +29,7 @@ getArguments = execParser opts
3429

3530
arguments :: Parser Arguments
3631
arguments = Arguments
37-
<$> switch (long "lsp" <> help "Start talking to an LSP client")
38-
<*> optional (strOption $ long "cwd" <> metavar "DIR" <> help "Change to this directory")
32+
<$> optional (strOption $ long "cwd" <> metavar "DIR" <> help "Change to this directory")
3933
<*> switch (long "version" <> help "Show ghcide and GHC versions")
4034
<*> switch (long "vscode-extension-schema" <> help "Print generic config schema for plugins (used in the package.json of haskell vscode extension)")
4135
<*> switch (long "generate-default-config" <> help "Print config supported by the server with default values")
@@ -45,14 +39,7 @@ arguments = Arguments
4539
<*> switch (long "test-no-kick" <> help "Disable kick. Useful for testing cancellation")
4640
<*> option auto (short 'j' <> help "Number of threads (0: automatic)" <> metavar "NUM" <> value 0 <> showDefault)
4741
<*> switch (long "verbose" <> help "Include internal events in logging output")
48-
<*> ( hsubparser (command "typecheck" (info (Typecheck <$> fileCmd) fileInfo)
49-
<> command "hiedb" (info (DbCmd <$> optParser "" True <*> cmdParser <**> helper) hieInfo)
50-
<> command "index" (info (DbIndex <$> fileCmd) indexInfo)
51-
<> command "lsp" (info (pure LSP <**> helper) lspInfo))
52-
<|> Typecheck <$> fileCmd )
53-
where
54-
fileCmd = many (argument str (metavar "FILES/DIRS..."))
55-
lspInfo = fullDesc <> progDesc "Start talking to an LSP client"
56-
fileInfo = fullDesc <> progDesc "Used as a test bed to check your IDE will work"
57-
hieInfo = fullDesc <> progDesc "Query .hie files"
58-
indexInfo = fullDesc <> progDesc "Load the given files and index all the known targets"
42+
<*> (commandP <|> lspCommand <|> checkCommand)
43+
where
44+
checkCommand = Check <$> many (argument str (metavar "FILES/DIRS..."))
45+
lspCommand = LSP <$ switch (long "lsp" <> help "Start talking to an LSP client")

Diff for: ‎ghcide/exe/Main.hs

+5-8
Original file line numberDiff line numberDiff line change
@@ -5,8 +5,8 @@
55

66
module Main(main) where
77

8-
import Arguments (Arguments' (..),
9-
IdeCmd (..), getArguments)
8+
import Arguments (Arguments (..),
9+
getArguments)
1010
import Control.Concurrent.Extra (newLock, withLock)
1111
import Control.Monad.Extra (unless, when, whenJust)
1212
import qualified Data.Aeson.Encode.Pretty as A
@@ -22,6 +22,7 @@ import Development.IDE (Logger (Logger),
2222
Priority (Info), action)
2323
import Development.IDE.Core.OfInterest (kick)
2424
import Development.IDE.Core.Rules (mainRule)
25+
import Development.IDE.Main (Command (LSP))
2526
import qualified Development.IDE.Main as Main
2627
import qualified Development.IDE.Plugin.HLS.GhcIde as GhcIde
2728
import qualified Development.IDE.Plugin.Test as Test
@@ -76,18 +77,14 @@ main = do
7677
T.putStrLn $ T.pack ("[" ++ upper (show pri) ++ "] ") <> msg
7778
logLevel = if argsVerbose then minBound else Info
7879

79-
case argFilesOrCmd of
80+
case argsCommand of
8081
LSP -> do
8182
hPutStrLn stderr "Starting LSP server..."
8283
hPutStrLn stderr "If you are seeing this in a terminal, you probably should have run ghcide WITHOUT the --lsp option!"
8384
_ -> return ()
8485

8586
Main.defaultMain def
86-
{Main.argCommand = case argFilesOrCmd of
87-
Typecheck x | not argLSP -> Main.Check x
88-
DbCmd x y -> Main.Db "." x y
89-
DbIndex dir -> Main.Index dir
90-
_ -> Main.Lsp
87+
{Main.argCommand = argsCommand
9188

9289
,Main.argsLogger = pure logger
9390

Diff for: ‎ghcide/ghcide.cabal

+1
Original file line numberDiff line numberDiff line change
@@ -63,6 +63,7 @@ library
6363
lsp == 1.2.*,
6464
mtl,
6565
network-uri,
66+
optparse-applicative,
6667
parallel,
6768
prettyprinter-ansi-terminal,
6869
prettyprinter-ansi-terminal,

Diff for: ‎ghcide/src/Development/IDE/Main.hs

+32-5
Original file line numberDiff line numberDiff line change
@@ -1,6 +1,9 @@
1+
{-# OPTIONS_GHC -Wno-orphans #-}
12
module Development.IDE.Main
23
(Arguments(..)
34
,Command(..)
5+
,isLSP
6+
,commandP
47
,defaultMain
58
) where
69
import Control.Concurrent.Extra (newLock, readVar,
@@ -77,6 +80,7 @@ import Ide.PluginUtils (allLspCmdIds',
7780
pluginDescToIdePlugins)
7881
import Ide.Types (IdePlugins)
7982
import qualified Language.LSP.Server as LSP
83+
import Options.Applicative hiding (action)
8084
import qualified System.Directory.Extra as IO
8185
import System.Exit (ExitCode (ExitFailure),
8286
exitWith)
@@ -93,10 +97,33 @@ import System.Time.Extra (offsetTime,
9397
import Text.Printf (printf)
9498

9599
data Command
96-
= Lsp -- ^ Run the LSP server
97-
| Check [FilePath] -- ^ Typecheck some paths and print diagnostics. Exit code is the number of failures
98-
| Index [FilePath] -- ^ Index all the targets and print the path to the database
100+
= Check [FilePath] -- ^ Typecheck some paths and print diagnostics. Exit code is the number of failures
99101
| Db FilePath HieDb.Options HieDb.Command -- ^ Run a command in the hiedb
102+
| Index [FilePath] -- ^ Index all the targets and print the path to the database
103+
| LSP -- ^ Run the LSP server
104+
deriving Show
105+
106+
-- TODO move these to hiedb
107+
deriving instance Show HieDb.Command
108+
deriving instance Show HieDb.Options
109+
110+
isLSP :: Command -> Bool
111+
isLSP LSP = True
112+
isLSP _ = False
113+
114+
commandP :: Parser Command
115+
commandP = hsubparser (command "typecheck" (info (Check <$> fileCmd) fileInfo)
116+
<> command "hiedb" (info (Db "." <$> HieDb.optParser "" True <*> HieDb.cmdParser <**> helper) hieInfo)
117+
<> command "index" (info (Index <$> fileCmd) indexInfo)
118+
<> command "lsp" (info (pure LSP <**> helper) lspInfo)
119+
)
120+
where
121+
fileCmd = many (argument str (metavar "FILES/DIRS..."))
122+
lspInfo = fullDesc <> progDesc "Start talking to an LSP client"
123+
fileInfo = fullDesc <> progDesc "Used as a test bed to check your IDE will work"
124+
hieInfo = fullDesc <> progDesc "Query .hie files"
125+
indexInfo = fullDesc <> progDesc "Load the given files and index all the known targets"
126+
100127

101128
data Arguments = Arguments
102129
{ argsOTMemoryProfiling :: Bool
@@ -118,7 +145,7 @@ data Arguments = Arguments
118145
instance Default Arguments where
119146
def = Arguments
120147
{ argsOTMemoryProfiling = False
121-
, argCommand = Lsp
148+
, argCommand = LSP
122149
, argsLogger = stderrLogger
123150
, argsRules = mainRule >> action kick
124151
, argsGhcidePlugin = mempty
@@ -172,7 +199,7 @@ defaultMain Arguments{..} = do
172199
outH <- argsHandleOut
173200

174201
case argCommand of
175-
Lsp -> do
202+
LSP -> do
176203
t <- offsetTime
177204
hPutStrLn stderr "Starting LSP server..."
178205
hPutStrLn stderr "If you are seeing this in a terminal, you probably should have run ghcide WITHOUT the --lsp option!"

Diff for: ‎src/Ide/Arguments.hs

+12-14
Original file line numberDiff line numberDiff line change
@@ -8,7 +8,7 @@
88

99
module Ide.Arguments
1010
( Arguments(..)
11-
, LspArguments(..)
11+
, GhcideArguments(..)
1212
, PrintVersion(..)
1313
, getArguments
1414
, haskellLanguageServerVersion
@@ -17,7 +17,7 @@ module Ide.Arguments
1717

1818
import Data.Version
1919
import Development.GitRev
20-
import HieDb.Run
20+
import Development.IDE.Main (Command (..), commandP)
2121
import Options.Applicative
2222
import Paths_haskell_language_server
2323
import System.Environment
@@ -27,15 +27,13 @@ import System.Environment
2727
data Arguments
2828
= VersionMode PrintVersion
2929
| ProbeToolsMode
30-
| DbCmd Options Command
31-
| LspMode LspArguments
30+
| Ghcide GhcideArguments
3231
| VSCodeExtensionSchemaMode
3332
| DefaultConfigurationMode
3433

35-
data LspArguments = LspArguments
36-
{argLSP :: Bool
34+
data GhcideArguments = GhcideArguments
35+
{argsCommand :: Command
3736
,argsCwd :: Maybe FilePath
38-
,argFiles :: [FilePath]
3937
,argsShakeProfiling :: Maybe FilePath
4038
,argsTesting :: Bool
4139
,argsExamplePlugin :: Bool
@@ -55,12 +53,10 @@ data PrintVersion
5553
getArguments :: String -> IO Arguments
5654
getArguments exeName = execParser opts
5755
where
58-
hieInfo = fullDesc <> progDesc "Query .hie files"
5956
opts = info ((
6057
VersionMode <$> printVersionParser exeName
6158
<|> probeToolsParser exeName
62-
<|> hsubparser (command "hiedb" (info (DbCmd <$> optParser "" True <*> cmdParser <**> helper) hieInfo))
63-
<|> LspMode <$> arguments
59+
<|> Ghcide <$> arguments
6460
<|> vsCodeExtensionSchemaModeParser
6561
<|> defaultConfigurationModeParser)
6662
<**> helper)
@@ -91,12 +87,11 @@ defaultConfigurationModeParser =
9187
flag' DefaultConfigurationMode
9288
(long "generate-default-config" <> help "Print config supported by the server with default values")
9389

94-
arguments :: Parser LspArguments
95-
arguments = LspArguments
96-
<$> switch (long "lsp" <> help "Start talking to an LSP server")
90+
arguments :: Parser GhcideArguments
91+
arguments = GhcideArguments
92+
<$> (commandP <|> lspCommand <|> checkCommand)
9793
<*> optional (strOption $ long "cwd" <> metavar "DIR"
9894
<> help "Change to this directory")
99-
<*> many (argument str (metavar "FILES/DIRS..."))
10095
<*> optional (strOption $ long "shake-profiling" <> metavar "DIR"
10196
<> help "Dump profiling reports to this directory")
10297
<*> switch (long "test"
@@ -124,6 +119,9 @@ arguments = LspArguments
124119
)
125120
<*> switch (long "project-ghc-version"
126121
<> help "Work out the project GHC version and print it")
122+
where
123+
lspCommand = LSP <$ switch (long "lsp" <> help "Start talking to an LSP server")
124+
checkCommand = Check <$> many (argument str (metavar "FILES/DIRS..."))
127125

128126
-- ---------------------------------------------------------------------
129127

Diff for: ‎src/Ide/Main.hs

+8-20
Original file line numberDiff line numberDiff line change
@@ -15,12 +15,11 @@ import qualified Data.ByteString.Lazy.Char8 as LBS
1515
import Data.Default
1616
import qualified Data.Text as T
1717
import Development.IDE.Core.Rules
18+
import Development.IDE.Main (isLSP)
1819
import qualified Development.IDE.Main as Main
19-
import Development.IDE.Session (getHieDbLoc, setInitialDynFlags)
2020
import Development.IDE.Types.Logger as G
2121
import qualified Development.IDE.Types.Options as Ghcide
2222
import Development.Shake (ShakeOptions (shakeThreads))
23-
import HieDb.Run
2423
import Ide.Arguments
2524
import Ide.Logger
2625
import Ide.Plugin.ConfigUtils (pluginsToDefaultConfig,
@@ -29,7 +28,6 @@ import Ide.Types (IdePlugins, ipMap)
2928
import Ide.Version
3029
import qualified Language.LSP.Server as LSP
3130
import qualified System.Directory.Extra as IO
32-
import System.Exit
3331
import System.IO
3432
import qualified System.Log.Logger as L
3533

@@ -52,20 +50,10 @@ defaultMain args idePlugins = do
5250
VersionMode PrintNumericVersion ->
5351
putStrLn haskellLanguageServerNumericVersion
5452

55-
DbCmd opts cmd -> do
56-
dir <- IO.getCurrentDirectory
57-
dbLoc <- getHieDbLoc dir
58-
hPutStrLn stderr $ "Using hiedb at: " ++ dbLoc
59-
mlibdir <- setInitialDynFlags def
60-
case mlibdir of
61-
Nothing -> exitWith $ ExitFailure 1
62-
Just libdir ->
63-
runCommand libdir opts{database = dbLoc} cmd
64-
65-
LspMode lspArgs -> do
53+
Ghcide ghcideArgs -> do
6654
{- see WARNING above -}
6755
hPutStrLn stderr hlsVer
68-
runLspMode lspArgs idePlugins
56+
runLspMode ghcideArgs idePlugins
6957

7058
VSCodeExtensionSchemaMode -> do
7159
LBS.putStrLn $ A.encodePretty $ pluginsToVSCodeExtensionSchema idePlugins
@@ -86,22 +74,22 @@ hlsLogger = G.Logger $ \pri txt ->
8674

8775
-- ---------------------------------------------------------------------
8876

89-
runLspMode :: LspArguments -> IdePlugins IdeState -> IO ()
90-
runLspMode lspArgs@LspArguments{..} idePlugins = do
77+
runLspMode :: GhcideArguments -> IdePlugins IdeState -> IO ()
78+
runLspMode ghcideArgs@GhcideArguments{..} idePlugins = do
9179
whenJust argsCwd IO.setCurrentDirectory
9280
dir <- IO.getCurrentDirectory
9381
LSP.setupLogger argsLogFile ["hls", "hie-bios"]
9482
$ if argsDebugOn then L.DEBUG else L.INFO
9583

96-
when argLSP $ do
84+
when (isLSP argsCommand) $ do
9785
hPutStrLn stderr "Starting (haskell-language-server)LSP server..."
98-
hPutStrLn stderr $ " with arguments: " <> show lspArgs
86+
hPutStrLn stderr $ " with arguments: " <> show ghcideArgs
9987
hPutStrLn stderr $ " with plugins: " <> show (map fst $ ipMap idePlugins)
10088
hPutStrLn stderr $ " in directory: " <> dir
10189
hPutStrLn stderr "If you are seeing this in a terminal, you probably should have run ghcide WITHOUT the --lsp option!"
10290

10391
Main.defaultMain def
104-
{ Main.argCommand = if argLSP then Main.Lsp else Main.Check argFiles
92+
{ Main.argCommand = argsCommand
10593
, Main.argsHlsPlugins = idePlugins
10694
, Main.argsLogger = pure hlsLogger
10795
, Main.argsIdeOptions = \_config sessionLoader ->

0 commit comments

Comments
 (0)