Skip to content

Commit c628078

Browse files
tittoassinitittoassini
committed
Added tests, canonicalized paths
1 parent d035ea1 commit c628078

File tree

8 files changed

+140
-45
lines changed

8 files changed

+140
-45
lines changed

‎haskell-language-server.cabal

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -263,6 +263,7 @@ test-suite func-test
263263
FunctionalLiquid
264264
HieBios
265265
Highlight
266+
ModuleName
266267
Progress
267268
Reference
268269
Rename

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

Lines changed: 32 additions & 17 deletions
Original file line numberDiff line numberDiff line change
@@ -8,7 +8,7 @@
88
{-| Keep the module name in sync with its file path.
99
1010
Provide CodeLenses to:
11-
* Add a module header ('module <moduleName> where") to empty Haskell files
11+
* Add a module header ("module /moduleName/ where") to empty Haskell files
1212
* Fix the module name if incorrect
1313
-}
1414
module Ide.Plugin.ModuleName
@@ -85,9 +85,16 @@ import Language.Haskell.LSP.Types ( ApplyWorkspaceEditParams(..)
8585
, uriToNormalizedFilePath
8686
)
8787
import Language.Haskell.LSP.VFS ( virtualFileText )
88-
import System.FilePath ( dropExtension )
88+
import System.FilePath ( splitDirectories
89+
, dropExtension
90+
)
8991
import Ide.Plugin ( mkLspCmdId )
90-
92+
import Development.IDE.Types.Logger
93+
import Development.IDE.Core.Shake
94+
import Data.Text ( pack )
95+
import System.Directory ( canonicalizePath )
96+
import Data.List
97+
import Ide.Plugin.Tactic.Debug ( unsafeRender )
9198
-- |Plugin descriptor
9299
descriptor :: PluginId -> PluginDescriptor
93100
descriptor plId = (defaultPluginDescriptor plId)
@@ -143,15 +150,14 @@ actions
143150
actions convert lsp state uri = do
144151
let Just nfp = uriToNormalizedFilePath $ toNormalizedUri uri
145152
let Just fp = uriToFilePath' uri
146-
out ["actions[", fp]
147153

148154
contents <- liftIO $ getVirtualFileFunc lsp $ toNormalizedUri uri
149155
let emptyModule =
150156
maybe True ((== 0) . T.length . T.strip . virtualFileText) contents
151157

152158
correctNameMaybe <- pathModuleName state nfp fp
153159
statedNameMaybe <- codeModuleName state nfp
154-
out ["correct", show correctNameMaybe, "stated", show statedNameMaybe]
160+
out state ["correct", show correctNameMaybe, "stated", show statedNameMaybe]
155161

156162
let act = Action uri
157163
let
@@ -167,29 +173,35 @@ actions convert lsp state uri = do
167173
in [convert $ act (Range (Position 0 0) (Position 0 0)) code code]
168174
_ -> []
169175

170-
out ["actions", show actions]
176+
out state ["actions", show actions]
171177
pure . Right . List $ actions
172178

173179
-- | The module name, as derived by the position of the module in its source directory
174180
pathModuleName :: IdeState -> NormalizedFilePath -> String -> IO (Maybe Text)
175-
pathModuleName state nfp fp = do
181+
pathModuleName state normFilePath filePath = do
176182
session :: HscEnvEq <- runAction "ModuleName.ghcSession" state
177-
$ use_ GhcSession nfp
183+
$ use_ GhcSession normFilePath
178184

179-
paths <-
185+
srcPaths <-
180186
evalGhcEnv (hscEnvWithImportPaths session)
181187
$ importPaths
182188
<$> getSessionDynFlags
183-
out ["import paths", show paths]
189+
out state ["import paths", show srcPaths]
190+
paths <- mapM canonicalizePath srcPaths
191+
mdlPath <- canonicalizePath filePath
192+
out state ["canonic paths", show paths, "mdlPath", mdlPath]
193+
let maybePrefix = listToMaybe . filter (`isPrefixOf` mdlPath) $ paths
194+
out state ["prefix", show maybePrefix]
184195

185-
let maybePrefix = listToMaybe . filter (`isPrefixOf` fp) $ paths
186-
out ["prefix", show maybePrefix]
187196
let maybeMdlName =
188197
(\prefix ->
189-
replace "/" "." . drop (length prefix + 1) $ dropExtension fp
198+
intercalate "."
199+
. splitDirectories
200+
. drop (length prefix + 1)
201+
$ dropExtension mdlPath
190202
)
191203
<$> maybePrefix
192-
out ["mdlName", show maybeMdlName]
204+
out state ["mdlName", show maybeMdlName]
193205
return $ T.pack <$> maybeMdlName
194206

195207
-- | The module name, as stated in the module
@@ -226,6 +238,9 @@ asEdit act@Action {..} =
226238
asTextEdits :: Action -> [TextEdit]
227239
asTextEdits Action {..} = [TextEdit aRange aCode]
228240

229-
out :: [String] -> IO ()
230-
-- out = print . unwords . ("Plugin ModuleName " :)
231-
out _ = return ()
241+
out :: IdeState -> [String] -> IO ()
242+
out state =
243+
logPriority (ideLogger state) Debug
244+
. pack
245+
. unwords
246+
. ("Plugin ModuleName " :)

‎test/functional/Main.hs

Lines changed: 31 additions & 28 deletions
Original file line numberDiff line numberDiff line change
@@ -1,39 +1,41 @@
11
module Main where
22

3-
import Test.Tasty
4-
import Test.Tasty.Runners (listingTests, consoleTestReporter)
5-
import Test.Tasty.Ingredients.Rerun
6-
import Test.Tasty.Runners.AntXML
3+
import Test.Tasty
4+
import Test.Tasty.Runners ( listingTests
5+
, consoleTestReporter
6+
)
7+
import Test.Tasty.Ingredients.Rerun
8+
import Test.Tasty.Runners.AntXML
79

8-
import Command
9-
import Completion
10-
import Deferred
11-
import Definition
12-
import Diagnostic
13-
import Eval
14-
import Format
15-
import FunctionalBadProject
16-
import FunctionalCodeAction
17-
import FunctionalLiquid
18-
import HieBios
19-
import Highlight
20-
import Progress
21-
import Reference
22-
import Rename
23-
import Symbol
24-
import Tactic
25-
import TypeDefinition
10+
import Command
11+
import Completion
12+
import Deferred
13+
import Definition
14+
import Diagnostic
15+
import Eval
16+
import Format
17+
import FunctionalBadProject
18+
import FunctionalCodeAction
19+
import FunctionalLiquid
20+
import HieBios
21+
import Highlight
22+
import Progress
23+
import Reference
24+
import Rename
25+
import Symbol
26+
import Tactic
27+
import TypeDefinition
28+
import ModuleName
2629

2730
main :: IO ()
2831
main =
2932
-- ingredient: xml runner writes json file of test results (https://github.com/ocharles/tasty-ant-xml/blob/master/Test/Tasty/Runners/AntXML.hs)
3033
-- rerunningTests allow rerun of failed tests (https://github.com/ocharles/tasty-rerun/blob/master/src/Test/Tasty/Ingredients/Rerun.hs)
31-
defaultMainWithIngredients [
32-
antXMLRunner
33-
, rerunningTests [ listingTests, consoleTestReporter ]
34-
]
35-
$ testGroup "haskell-language-server" [
36-
Command.tests
34+
defaultMainWithIngredients
35+
[antXMLRunner, rerunningTests [listingTests, consoleTestReporter]]
36+
$ testGroup
37+
"haskell-language-server"
38+
[ Command.tests
3739
, Completion.tests
3840
, Deferred.tests
3941
, Definition.tests
@@ -45,6 +47,7 @@ main =
4547
, FunctionalLiquid.tests
4648
, HieBios.tests
4749
, Highlight.tests
50+
, ModuleName.tests
4851
, Progress.tests
4952
, Reference.tests
5053
, Rename.tests

‎test/functional/ModuleName.hs

Lines changed: 57 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,57 @@
1+
{-# LANGUAGE NamedFieldPuns #-}
2+
{-# LANGUAGE OverloadedStrings #-}
3+
{-# LANGUAGE ScopedTypeVariables #-}
4+
5+
module ModuleName
6+
( tests
7+
)
8+
where
9+
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 ( hieCommand )
30+
import Test.Tasty ( TestTree
31+
, testGroup
32+
)
33+
import Test.Tasty.HUnit ( testCase
34+
, (@?=)
35+
)
36+
37+
tests :: TestTree
38+
tests = testGroup
39+
"moduleName"
40+
[ testCase "Add module header to empty module" $ goldenTest "TEmptyModule.hs"
41+
, testCase "Fix wrong module name" $ goldenTest "TWrongModuleName.hs"
42+
]
43+
44+
goldenTest :: FilePath -> IO ()
45+
goldenTest input = runSession hieCommand fullCaps testdataPath $ do
46+
doc <- openDoc input "haskell"
47+
-- getCodeLenses doc >>= liftIO . print . length
48+
[CodeLens { _command = Just c }] <- getCodeLenses doc
49+
executeCommand c
50+
_resp :: ApplyWorkspaceEditRequest <- skipManyTill anyMessage message
51+
edited <- documentContents doc
52+
-- liftIO $ T.writeFile (testdataPath </> input <.> "expected") edited
53+
expected <- liftIO $ T.readFile $ testdataPath </> input <.> "expected"
54+
liftIO $ edited @?= expected
55+
56+
testdataPath :: FilePath
57+
testdataPath = "test/testdata/moduleName"

‎test/testdata/moduleName/TEmptyModule.hs

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,2 @@
1+
2+

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

Lines changed: 3 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,3 @@
1+
module TEmptyModule where
2+
3+

‎test/testdata/moduleName/TWrongModuleName.hs

Lines changed: 7 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,7 @@
1+
module BadName
2+
( x
3+
)
4+
where
5+
6+
x :: Integer
7+
x = 11

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

Lines changed: 7 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,7 @@
1+
module TWrongModuleName
2+
( x
3+
)
4+
where
5+
6+
x :: Integer
7+
x = 11

0 commit comments

Comments
 (0)