Skip to content

Commit 3bd2338

Browse files
jneirajneira
authored
Merge pull request #616 from konn/modulename-main-like
Module Name Plugin: Treat modules starting with lowercase as Main module
2 parents 1473a28 + 0d707a9 commit 3bd2338

File tree

5 files changed

+89
-123
lines changed

5 files changed

+89
-123
lines changed

‎plugins/default/src/Ide/Plugin/ModuleName.hs

Lines changed: 73 additions & 96 deletions
Original file line numberDiff line numberDiff line change
@@ -1,9 +1,6 @@
11
{-# OPTIONS_GHC -Wwarn -fno-warn-type-defaults -fno-warn-unused-binds -fno-warn-unused-imports #-}
2-
{-# LANGUAGE NamedFieldPuns #-}
3-
{-# LANGUAGE NoMonomorphismRestriction #-}
4-
{-# LANGUAGE OverloadedStrings #-}
5-
{-# LANGUAGE RecordWildCards #-}
6-
{-# LANGUAGE ScopedTypeVariables #-}
2+
{-# LANGUAGE NamedFieldPuns, NoMonomorphismRestriction, OverloadedStrings #-}
3+
{-# LANGUAGE RecordWildCards, ScopedTypeVariables #-}
74

85
{-| Keep the module name in sync with its file path.
96
@@ -16,84 +13,61 @@ module Ide.Plugin.ModuleName
1613
)
1714
where
1815

19-
import Control.Monad ( join )
20-
import Control.Monad.IO.Class ( MonadIO(liftIO) )
21-
import Control.Monad.Trans.Maybe ( )
22-
import Data.Aeson ( ToJSON(toJSON)
23-
, Value(Null)
24-
)
25-
import qualified Data.HashMap.Strict as Map
26-
import Data.List ( isPrefixOf )
27-
import Data.List.Extra ( replace )
28-
import Data.Maybe ( listToMaybe )
29-
import Data.String ( IsString )
30-
import Data.Text ( Text )
31-
import qualified Data.Text as T
32-
import Development.IDE ( hscEnvWithImportPaths
33-
, GetParsedModule
34-
( GetParsedModule
35-
)
36-
, GhcSession(GhcSession)
37-
, HscEnvEq
38-
, IdeState
39-
, List(..)
40-
, NormalizedFilePath
41-
, Position(Position)
42-
, Range(Range)
43-
, evalGhcEnv
44-
, realSrcSpanToRange
45-
, runAction
46-
, toNormalizedUri
47-
, uriToFilePath'
48-
, use
49-
, use_
50-
)
51-
import Development.IDE.Plugin ( getPid )
52-
import GHC ( DynFlags(importPaths)
53-
, GenLocated(L)
54-
, HsModule(hsmodName)
55-
, ParsedModule(pm_parsed_source)
56-
, SrcSpan(RealSrcSpan)
57-
, unLoc
58-
, getSessionDynFlags
59-
)
60-
import Ide.Types ( CommandFunction
61-
, PluginCommand(..)
62-
, PluginDescriptor(..)
63-
, PluginId(..)
64-
, defaultPluginDescriptor
65-
)
66-
import Language.Haskell.LSP.Core ( LspFuncs
67-
, getVirtualFileFunc
68-
)
69-
import Language.Haskell.LSP.Types ( ApplyWorkspaceEditParams(..)
70-
, CAResult(CACodeAction)
71-
, CodeAction(CodeAction)
72-
, CodeActionKind
73-
( CodeActionQuickFix
74-
)
75-
, CodeLens(CodeLens)
76-
, CodeLensParams(CodeLensParams)
77-
, Command(Command)
78-
, ServerMethod(..)
79-
, TextDocumentIdentifier
80-
( TextDocumentIdentifier
81-
)
82-
, TextEdit(TextEdit)
83-
, Uri
84-
, WorkspaceEdit(..)
85-
, uriToNormalizedFilePath
86-
)
87-
import Language.Haskell.LSP.VFS ( virtualFileText )
88-
import System.FilePath ( splitDirectories
89-
, dropExtension
90-
)
91-
import Ide.Plugin ( mkLspCmdId )
92-
import Development.IDE.Types.Logger
93-
import Development.IDE.Core.Shake
94-
import Data.Text ( pack )
95-
import System.Directory ( canonicalizePath )
16+
import Control.Monad (join)
17+
import Control.Monad.IO.Class (MonadIO (liftIO))
18+
import Control.Monad.Trans.Maybe ()
19+
import Data.Aeson (ToJSON (toJSON), Value (Null))
20+
import Data.Char (isUpper)
21+
import qualified Data.HashMap.Strict as Map
9622
import Data.List
23+
import Data.List (isPrefixOf)
24+
import Data.List.Extra (replace)
25+
import Data.Maybe (listToMaybe)
26+
import Data.String (IsString)
27+
import Data.Text (Text, pack)
28+
import qualified Data.Text as T
29+
import Development.IDE (GetParsedModule (GetParsedModule),
30+
GhcSession (GhcSession),
31+
HscEnvEq, IdeState, List (..),
32+
NormalizedFilePath,
33+
Position (Position),
34+
Range (Range), evalGhcEnv,
35+
hscEnvWithImportPaths,
36+
realSrcSpanToRange, runAction,
37+
toNormalizedUri, uriToFilePath',
38+
use, use_)
39+
import Development.IDE.Core.Shake
40+
import Development.IDE.Plugin (getPid)
41+
import Development.IDE.Types.Logger
42+
import GHC (DynFlags (importPaths),
43+
GenLocated (L),
44+
HsModule (hsmodName),
45+
ParsedModule (pm_parsed_source),
46+
SrcSpan (RealSrcSpan),
47+
getSessionDynFlags, unLoc)
48+
import Ide.Plugin (mkLspCmdId)
49+
import Ide.Types (CommandFunction,
50+
PluginCommand (..),
51+
PluginDescriptor (..),
52+
PluginId (..),
53+
defaultPluginDescriptor)
54+
import Language.Haskell.LSP.Core (LspFuncs, getVirtualFileFunc)
55+
import Language.Haskell.LSP.Types (ApplyWorkspaceEditParams (..),
56+
CAResult (CACodeAction),
57+
CodeAction (CodeAction),
58+
CodeActionKind (CodeActionQuickFix),
59+
CodeLens (CodeLens),
60+
CodeLensParams (CodeLensParams),
61+
Command (Command),
62+
ServerMethod (..),
63+
TextDocumentIdentifier (TextDocumentIdentifier),
64+
TextEdit (TextEdit), Uri,
65+
WorkspaceEdit (..),
66+
uriToNormalizedFilePath)
67+
import Language.Haskell.LSP.VFS (virtualFileText)
68+
import System.Directory (canonicalizePath)
69+
import System.FilePath (dropExtension, splitDirectories,
70+
takeFileName)
9771
-- |Plugin descriptor
9872
descriptor :: PluginId -> PluginDescriptor
9973
descriptor plId = (defaultPluginDescriptor plId)
@@ -188,20 +162,23 @@ pathModuleName state normFilePath filePath = do
188162
out state ["import paths", show srcPaths]
189163
paths <- mapM canonicalizePath srcPaths
190164
mdlPath <- canonicalizePath filePath
191-
out state ["canonic paths", show paths, "mdlPath", mdlPath]
192-
let maybePrefix = listToMaybe . filter (`isPrefixOf` mdlPath) $ paths
193-
out state ["prefix", show maybePrefix]
194-
195-
let maybeMdlName =
196-
(\prefix ->
197-
intercalate "."
198-
. splitDirectories
199-
. drop (length prefix + 1)
200-
$ dropExtension mdlPath
201-
)
202-
<$> maybePrefix
203-
out state ["mdlName", show maybeMdlName]
204-
return $ T.pack <$> maybeMdlName
165+
if isUpper $ head $ takeFileName mdlPath
166+
then do
167+
out state ["canonic paths", show paths, "mdlPath", mdlPath]
168+
let maybePrefix = listToMaybe . filter (`isPrefixOf` mdlPath) $ paths
169+
out state ["prefix", show maybePrefix]
170+
171+
let maybeMdlName =
172+
(\prefix ->
173+
intercalate "."
174+
. splitDirectories
175+
. drop (length prefix + 1)
176+
$ dropExtension mdlPath
177+
)
178+
<$> maybePrefix
179+
out state ["mdlName", show maybeMdlName]
180+
return $ T.pack <$> maybeMdlName
181+
else return $ Just "Main"
205182

206183
-- | The module name, as stated in the module
207184
codeModuleName :: IdeState -> NormalizedFilePath -> IO (Maybe (Range, Text))

‎test/functional/ModuleName.hs

Lines changed: 14 additions & 26 deletions
Original file line numberDiff line numberDiff line change
@@ -7,38 +7,26 @@ module ModuleName
77
)
88
where
99

10-
import Control.Applicative.Combinators
11-
( skipManyTill )
12-
import Control.Monad.IO.Class ( MonadIO(liftIO) )
13-
import qualified Data.Text.IO as T
14-
import Language.Haskell.LSP.Test ( fullCaps
15-
, documentContents
16-
, executeCommand
17-
, getCodeLenses
18-
, openDoc
19-
, runSession
20-
, anyMessage
21-
, message
22-
)
23-
import Language.Haskell.LSP.Types ( ApplyWorkspaceEditRequest
24-
, CodeLens(..)
25-
)
26-
import System.FilePath ( (<.>)
27-
, (</>)
28-
)
29-
import Test.Hls.Util ( hlsCommand )
30-
import Test.Tasty ( TestTree
31-
, testGroup
32-
)
33-
import Test.Tasty.HUnit ( testCase
34-
, (@?=)
35-
)
10+
import Control.Applicative.Combinators (skipManyTill)
11+
import Control.Monad.IO.Class (MonadIO (liftIO))
12+
import qualified Data.Text.IO as T
13+
import Language.Haskell.LSP.Test (anyMessage, documentContents,
14+
executeCommand, fullCaps,
15+
getCodeLenses, message,
16+
openDoc, runSession)
17+
import Language.Haskell.LSP.Types (ApplyWorkspaceEditRequest,
18+
CodeLens (..))
19+
import System.FilePath ((<.>), (</>))
20+
import Test.Hls.Util (hlsCommand)
21+
import Test.Tasty (TestTree, testGroup)
22+
import Test.Tasty.HUnit (testCase, (@?=))
3623

3724
tests :: TestTree
3825
tests = testGroup
3926
"moduleName"
4027
[ testCase "Add module header to empty module" $ goldenTest "TEmptyModule.hs"
4128
, testCase "Fix wrong module name" $ goldenTest "TWrongModuleName.hs"
29+
, testCase "Must infer module name as Main, if the file name starts with a lowercase" $ goldenTest "mainlike.hs"
4230
]
4331

4432
goldenTest :: FilePath -> IO ()

‎test/testdata/moduleName/hie.yaml

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1 +1 @@
1-
cradle: { direct: { arguments: ["TEmptyModule", "TWrongModuleName"] } }
1+
cradle: { direct: { arguments: ["TEmptyModule", "TWrongModuleName", "mainlike"] } }

‎test/testdata/moduleName/mainlike.hs

Whitespace-only changes.

‎test/testdata/moduleName/mainlike.hs.expected

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1 @@
1+
module Main where

0 commit comments

Comments
 (0)