Skip to content

Commit d106c31

Browse files
alanzalanz
committed
Working on tests.
Currently suspect the range we get to format the whole file is wrong, second time around.
1 parent 739f8bd commit d106c31

File tree

9 files changed

+202
-154
lines changed

9 files changed

+202
-154
lines changed

‎src/Ide/Plugin/Example.hs‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -163,7 +163,7 @@ addTodoCmd (AddTodoParams uri todoText) = do
163163
pos = Position 0 0
164164
textEdits = List
165165
[TextEdit (Range pos pos)
166-
("-- TODO:" <> todoText)
166+
("-- TODO:" <> todoText <> "\n")
167167
]
168168
res = WorkspaceEdit
169169
(Just $ Map.singleton uri textEdits)

‎src/Ide/Plugin/Example2.hs‎

Lines changed: 42 additions & 17 deletions
Original file line numberDiff line numberDiff line change
@@ -1,10 +1,10 @@
11
{-# LANGUAGE ViewPatterns #-}
2+
{-# LANGUAGE DeriveAnyClass #-}
23
{-# LANGUAGE DeriveGeneric #-}
34
{-# LANGUAGE DuplicateRecordFields #-}
45
{-# LANGUAGE FlexibleContexts #-}
56
{-# LANGUAGE FlexibleInstances #-}
67
{-# LANGUAGE OverloadedStrings #-}
7-
{-# LANGUAGE RecordWildCards #-}
88
{-# LANGUAGE TupleSections #-}
99
{-# LANGUAGE TypeFamilies #-}
1010

@@ -15,25 +15,26 @@ module Ide.Plugin.Example2
1515

1616
import Control.DeepSeq ( NFData )
1717
import Control.Monad.Trans.Maybe
18-
import Data.Aeson.Types (toJSON)
18+
import Data.Aeson
1919
import Data.Binary
2020
import Data.Functor
2121
import qualified Data.HashMap.Strict as Map
22-
import Data.Hashable
2322
import qualified Data.HashSet as HashSet
23+
import Data.Hashable
2424
import qualified Data.Text as T
2525
import Data.Typeable
2626
import Development.IDE.Core.OfInterest
27-
import Development.IDE.Core.Rules
2827
import Development.IDE.Core.RuleTypes
28+
import Development.IDE.Core.Rules
2929
import Development.IDE.Core.Service
3030
import Development.IDE.Core.Shake
3131
import Development.IDE.Types.Diagnostics as D
3232
import Development.IDE.Types.Location
3333
import Development.IDE.Types.Logger
3434
import Development.Shake hiding ( Diagnostic )
35-
import Ide.Types
3635
import GHC.Generics
36+
import Ide.Plugin
37+
import Ide.Types
3738
import Language.Haskell.LSP.Types
3839
import Text.Regex.TDFA.Text()
3940

@@ -43,12 +44,12 @@ descriptor :: PluginId -> PluginDescriptor
4344
descriptor plId = PluginDescriptor
4445
{ pluginId = plId
4546
, pluginRules = exampleRules
46-
, pluginCommands = []
47+
, pluginCommands = [PluginCommand "codelens.todo" "example adding" addTodoCmd]
4748
, pluginCodeActionProvider = Just codeAction
4849
, pluginCodeLensProvider = Just codeLens
4950
, pluginDiagnosticProvider = Nothing
50-
, pluginHoverProvider = Just hover
51-
, pluginSymbolProvider = Nothing
51+
, pluginHoverProvider = Just hover
52+
, pluginSymbolProvider = Nothing
5253
, pluginFormattingProvider = Nothing
5354
, pluginCompletionProvider = Nothing
5455
}
@@ -63,6 +64,8 @@ blah _ (Position line col)
6364
= return $ Just (Just (Range (Position line col) (Position (line+1) 0)), ["example hover 2\n"])
6465

6566
-- ---------------------------------------------------------------------
67+
-- Generating Diagnostics via rules
68+
-- ---------------------------------------------------------------------
6669

6770
data Example2 = Example2
6871
deriving (Eq, Show, Typeable, Generic)
@@ -100,6 +103,8 @@ mkDiag file diagSource sev loc msg = (file, D.ShowDiag,)
100103
}
101104

102105
-- ---------------------------------------------------------------------
106+
-- code actions
107+
-- ---------------------------------------------------------------------
103108

104109
-- | Generate code actions.
105110
codeAction
@@ -125,24 +130,43 @@ codeLens
125130
-> PluginId
126131
-> CodeLensParams
127132
-> IO (Either ResponseError (List CodeLens))
128-
codeLens ideState _plId CodeLensParams{_textDocument=TextDocumentIdentifier uri} =
133+
codeLens ideState plId CodeLensParams{_textDocument=TextDocumentIdentifier uri} = do
134+
logInfo (ideLogger ideState) "Example2.codeLens entered (ideLogger)" -- AZ
129135
case uriToFilePath' uri of
130136
Just (toNormalizedFilePath -> filePath) -> do
131137
_ <- runAction ideState $ runMaybeT $ useE TypeCheck filePath
132138
_diag <- getDiagnostics ideState
133139
_hDiag <- getHiddenDiagnostics ideState
134140
let
135141
title = "Add TODO2 Item via Code Lens"
136-
tedit = [TextEdit (Range (Position 3 0) (Position 3 0))
137-
"-- TODO2 added by Example2 Plugin via code lens action\n"]
138-
edit = WorkspaceEdit (Just $ Map.singleton uri $ List tedit) Nothing
139142
range = Range (Position 3 0) (Position 4 0)
140-
pure $ Right $ List
141-
-- [ CodeLens range (Just (Command title "codelens.do" (Just $ List [toJSON edit]))) Nothing
142-
[ CodeLens range (Just (Command title "codelens.todo" (Just $ List [toJSON edit]))) Nothing
143-
]
143+
let cmdParams = AddTodoParams uri "do abc"
144+
cmd <- mkLspCommand plId "codelens.todo" title (Just [toJSON cmdParams])
145+
pure $ Right $ List [ CodeLens range (Just cmd) Nothing ]
144146
Nothing -> pure $ Right $ List []
145147

148+
-- ---------------------------------------------------------------------
149+
-- | Parameters for the addTodo PluginCommand.
150+
data AddTodoParams = AddTodoParams
151+
{ file :: Uri -- ^ Uri of the file to add the pragma to
152+
, todoText :: T.Text
153+
}
154+
deriving (Show, Eq, Generic, ToJSON, FromJSON)
155+
156+
addTodoCmd :: AddTodoParams -> IO (Either ResponseError Value,
157+
Maybe (ServerMethod, ApplyWorkspaceEditParams))
158+
addTodoCmd (AddTodoParams uri todoText) = do
159+
let
160+
pos = Position 0 0
161+
textEdits = List
162+
[TextEdit (Range pos pos)
163+
("-- TODO2:" <> todoText <> "\n")
164+
]
165+
res = WorkspaceEdit
166+
(Just $ Map.singleton uri textEdits)
167+
Nothing
168+
return (Right Null, Just (WorkspaceApplyEdit, ApplyWorkspaceEditParams res))
169+
146170
-- ---------------------------------------------------------------------
147171

148172
foundHover :: (Maybe Range, [T.Text]) -> Either ResponseError (Maybe Hover)
@@ -166,7 +190,8 @@ request label getResults notFound found ide (TextDocumentPositionParams (TextDoc
166190
Nothing -> pure Nothing
167191
pure $ maybe notFound found mbResult
168192

169-
logAndRunRequest :: T.Text -> (NormalizedFilePath -> Position -> Action b) -> IdeState -> Position -> String -> IO b
193+
logAndRunRequest :: T.Text -> (NormalizedFilePath -> Position -> Action b)
194+
-> IdeState -> Position -> String -> IO b
170195
logAndRunRequest label getResults ide pos path = do
171196
let filePath = toNormalizedFilePath path
172197
logInfo (ideLogger ide) $

‎test/functional/FormatSpec.hs‎

Lines changed: 19 additions & 11 deletions
Original file line numberDiff line numberDiff line change
@@ -26,7 +26,7 @@ spec = do
2626
describe "format range" $ do
2727
it "works" $ runSession hieCommand fullCaps "test/testdata" $ do
2828
doc <- openDoc "Format.hs" "haskell"
29-
formatRange doc (FormattingOptions 2 True) (Range (Position 1 0) (Position 3 10))
29+
formatRange doc (FormattingOptions 2 True) (Range (Position 2 0) (Position 4 10))
3030
documentContents doc >>= liftIO . (`shouldBe` formattedRangeTabSize2)
3131
it "works with custom tab size" $ do
3232
pendingWith "ormolu does not accept parameters"
@@ -47,7 +47,7 @@ spec = do
4747
formatDoc doc (FormattingOptions 2 True)
4848
documentContents doc >>= liftIO . (`shouldBe` orig)
4949

50-
formatRange doc (FormattingOptions 2 True) (Range (Position 1 0) (Position 3 10))
50+
formatRange doc (FormattingOptions 2 True) (Range (Position 2 0) (Position 4 10))
5151
documentContents doc >>= liftIO . (`shouldBe` orig)
5252

5353
it "can change on the fly" $ runSession hieCommand fullCaps "test/testdata" $ do
@@ -116,7 +116,8 @@ spec = do
116116

117117
formattedDocOrmolu :: T.Text
118118
formattedDocOrmolu =
119-
"module Format where\n\n\
119+
"{-# LANGUAGE NoImplicitPrelude #-}\n\n\
120+
\module Format where\n\n\
120121
\foo :: Int -> Int\n\
121122
\foo 3 = 2\n\
122123
\foo x = x\n\n\
@@ -149,19 +150,21 @@ formattedDocTabSize5 =
149150

150151
formattedRangeTabSize2 :: T.Text
151152
formattedRangeTabSize2 =
152-
"module Format where\n\
153+
"{-# LANGUAGE NoImplicitPrelude #-}\n\
154+
\module Format where\n\
153155
\foo :: Int -> Int\n\
154156
\foo 3 = 2\n\
155157
\foo x = x\n\
156158
\bar :: String -> IO String\n\
157159
\bar s = do\n\
158160
\ x <- return \"hello\"\n\
159161
\ return \"asdf\"\n\
160-
\ \n"
162+
\"
161163

162164
formattedRangeTabSize5 :: T.Text
163165
formattedRangeTabSize5 =
164-
"module Format where\n\
166+
"{-# LANGUAGE NoImplicitPrelude #-}\n\n\
167+
\module Format where\n\
165168
\foo :: Int -> Int\n\
166169
\foo 3 = 2\n\
167170
\foo x = x\n\
@@ -173,7 +176,8 @@ formattedRangeTabSize5 =
173176

174177
formattedFloskell :: T.Text
175178
formattedFloskell =
176-
"module Format where\n\
179+
"{-# LANGUAGE NoImplicitPrelude #-}\n\n\
180+
\module Format where\n\
177181
\\n\
178182
\foo :: Int -> Int\n\
179183
\foo 3 = 2\n\
@@ -189,7 +193,8 @@ formattedFloskell =
189193
-- (duplicated last line)
190194
formattedFloskellPostBrittany :: T.Text
191195
formattedFloskellPostBrittany =
192-
"module Format where\n\
196+
"{-# LANGUAGE NoImplicitPrelude #-}\n\n\
197+
\module Format where\n\
193198
\\n\
194199
\foo :: Int -> Int\n\
195200
\foo 3 = 2\n\
@@ -204,7 +209,8 @@ formattedFloskellPostBrittany =
204209

205210
formattedBrittanyPostFloskell :: T.Text
206211
formattedBrittanyPostFloskell =
207-
"module Format where\n\
212+
"{-# LANGUAGE NoImplicitPrelude #-}\n\n\
213+
\module Format where\n\
208214
\\n\
209215
\foo :: Int -> Int\n\
210216
\foo 3 = 2\n\
@@ -217,7 +223,8 @@ formattedBrittanyPostFloskell =
217223

218224
formattedOrmolu :: T.Text
219225
formattedOrmolu =
220-
"module Format where\n\
226+
"{-# LANGUAGE NoImplicitPrelude #-}\n\n\
227+
\module Format where\n\
221228
\\n\
222229
\foo :: Int -> Int\n\
223230
\foo 3 = 2\n\
@@ -230,7 +237,8 @@ formattedOrmolu =
230237

231238
unchangedOrmolu :: T.Text
232239
unchangedOrmolu =
233-
"module Format where\n\
240+
"{-# LANGUAGE NoImplicitPrelude #-}\n\n\
241+
\module Format where\n\
234242
\foo :: Int -> Int\n\
235243
\foo 3 = 2\n\
236244
\foo x = x\n\

‎test/functional/PluginSpec.hs‎

Lines changed: 15 additions & 13 deletions
Original file line numberDiff line numberDiff line change
@@ -3,7 +3,7 @@
33
{-# LANGUAGE TypeApplications #-}
44
module PluginSpec where
55

6-
import Control.Applicative.Combinators
6+
-- import Control.Applicative.Combinators
77
import Control.Lens hiding (List)
88
-- import Control.Monad
99
import Control.Monad.IO.Class
@@ -44,24 +44,26 @@ spec =
4444

4545
-- diag2 ^. L.source `shouldBe` Just "example"
4646

47-
cas@(CACodeAction ca:_) <- getAllCodeActions doc
48-
liftIO $ length cas `shouldBe` 2
47+
_cas@(CACodeAction ca:_) <- getAllCodeActions doc
48+
-- liftIO $ length cas `shouldBe` 2
4949

50-
liftIO $ putStrLn $ "cas = " ++ show cas -- AZ
50+
-- liftIO $ putStrLn $ "cas = " ++ show cas -- AZ
5151

5252
liftIO $ [ca ^. L.title] `shouldContain` ["Add TODO Item 1"]
5353

54-
liftIO $ putStrLn $ "A" -- AZ
54+
-- liftIO $ putStrLn $ "A" -- AZ
5555
executeCodeAction ca
56-
liftIO $ putStrLn $ "B" -- AZ
56+
-- liftIO $ putStrLn $ "B" -- AZ
5757

58-
_ <- skipManyTill anyMessage (message @RegisterCapabilityRequest)
59-
liftIO $ putStrLn $ "B2" -- AZ
58+
-- _ <- skipMany (message @RegisterCapabilityRequest)
59+
-- liftIO $ putStrLn $ "B2" -- AZ
6060

61-
-- <- skipManyTill anyMessage $ between (satisfy startPred) (satisfy donePred) $
61+
_diags2 <- waitForDiagnostics
62+
-- liftIO $ putStrLn $ "diags2 = " ++ show _diags2 -- AZ
6263

63-
contents <- getDocumentEdit doc
64-
liftIO $ putStrLn $ "C" -- AZ
65-
liftIO $ contents `shouldBe` "main = undefined\nfoo x = x\n"
64+
-- contents <- getDocumentEdit doc
65+
-- liftIO $ putStrLn $ "C" -- AZ
66+
-- liftIO $ contents `shouldBe` "main = undefined\nfoo x = x\n"
6667

67-
noDiagnostics
68+
-- noDiagnostics
69+
return ()

‎test/testdata/BrittanyCRLF.hs‎

Lines changed: 5 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -1,3 +1,5 @@
1-
foo :: Int -> String-> IO ()
2-
foo x y = do print x
3-
return 42
1+
module BrittanyCRLF where
2+
3+
foo :: Int -> String-> IO ()
4+
foo x y = do print x
5+
return ()

‎test/testdata/BrittanyLF.hs‎

Lines changed: 3 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,3 +1,5 @@
1+
module BrittanyLF where
2+
13
foo :: Int -> String-> IO ()
24
foo x y = do print x
3-
return 42
5+
return ()

‎test/testdata/Format.hs‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,3 +1,4 @@
1+
{-# LANGUAGE NoImplicitPrelude #-}
12
module Format where
23
foo :: Int -> Int
34
foo 3 = 2
@@ -6,4 +7,3 @@ bar :: String -> IO String
67
bar s = do
78
x <- return "hello"
89
return "asdf"
9-

0 commit comments

Comments
 (0)