mirror of
https://github.com/haskell/haskell-ide-engine.git
synced 2024-09-11 11:05:30 +03:00
Demote HsImport func-tests to unit-test
Previously, we had long running func-tests for HsImport. However, after the first code-action tests, we actually are testing the same functionality over and over again. Moreover, we dont have to test that HsImport works as intended since they have a huge set of tests, anyways. Now, we only test that our implementation of the plugin truly maps correctly to HsImport, accelerating execution time of func-tests as a side-effect. Hooray!
This commit is contained in:
parent
2dc8b65362
commit
88cc608522
@ -200,6 +200,7 @@ test-suite unit-test
|
||||
GhcModPluginSpec
|
||||
-- HaRePluginSpec
|
||||
HooglePluginSpec
|
||||
HsImportSpec
|
||||
JsonSpec
|
||||
LiquidSpec
|
||||
PackagePluginSpec
|
||||
@ -208,7 +209,7 @@ test-suite unit-test
|
||||
build-tool-depends: cabal-helper:cabal-helper-main, hspec-discover:hspec-discover
|
||||
build-depends: QuickCheck
|
||||
, aeson
|
||||
, cabal-helper
|
||||
, cabal-helper
|
||||
, ghc
|
||||
, base
|
||||
, bytestring
|
||||
|
@ -10,7 +10,6 @@ import Control.Monad.IO.Class
|
||||
import Data.Aeson
|
||||
import Data.Default
|
||||
import qualified Data.HashMap.Strict as HM
|
||||
import qualified Data.Set as Set
|
||||
import Data.Maybe
|
||||
#if __GLASGOW_HASKELL__ < 808
|
||||
import Data.Monoid ((<>))
|
||||
@ -132,139 +131,39 @@ spec = describe "code actions" $ do
|
||||
_:x:_ <- T.lines <$> documentContents doc
|
||||
liftIO $ x `shouldBe` "foo = putStrLn \"world\""
|
||||
|
||||
describe "import suggestions" $ do
|
||||
describe "import suggestions" $
|
||||
it "works with 3.8 code action kinds" $ runSession hieCommand fullCaps "test/testdata" $ do
|
||||
doc <- openDoc "CodeActionImport.hs" "haskell"
|
||||
-- No Formatting:
|
||||
let config = def { formattingProvider = "none" }
|
||||
sendNotification WorkspaceDidChangeConfiguration (DidChangeConfigurationParams (toJSON config))
|
||||
|
||||
-- ignore the first empty hlint diagnostic publish
|
||||
[_,diag:_] <- count 2 waitForDiagnostics
|
||||
liftIO $ diag ^. L.message `shouldBe` "Variable not in scope: when :: Bool -> IO () -> IO ()"
|
||||
|
||||
actionsOrCommands <- getAllCodeActions doc
|
||||
let actns = map fromAction actionsOrCommands
|
||||
|
||||
liftIO $ do
|
||||
head actns ^. L.title `shouldBe` "Import module Control.Monad"
|
||||
head (tail actns) ^. L.title `shouldBe` "Import module Control.Monad (when)"
|
||||
forM_ actns $ \a -> do
|
||||
a ^. L.kind `shouldBe` Just CodeActionQuickFix
|
||||
a ^. L.command `shouldSatisfy` isJust
|
||||
a ^. L.edit `shouldBe` Nothing
|
||||
let hasOneDiag (Just (List [_])) = True
|
||||
hasOneDiag _ = False
|
||||
a ^. L.diagnostics `shouldSatisfy` hasOneDiag
|
||||
length actns `shouldBe` 10
|
||||
|
||||
executeCodeAction (head actns)
|
||||
|
||||
contents <- getDocumentEdit doc
|
||||
liftIO $ contents `shouldBe` "import Control.Monad\nmain :: IO ()\nmain = when True $ putStrLn \"hello\""
|
||||
|
||||
-- ---------------------------------
|
||||
|
||||
describe "formats with brittany" $ hsImportSpec "brittany"
|
||||
[ -- Expected output for simple format.
|
||||
[ "import qualified Data.Maybe"
|
||||
, "import Control.Monad"
|
||||
, "main :: IO ()"
|
||||
, "main = when True $ putStrLn \"hello\""
|
||||
]
|
||||
, -- Use an import list and format the output.
|
||||
[ "import qualified Data.Maybe"
|
||||
, "import Control.Monad ( when )"
|
||||
, "main :: IO ()"
|
||||
, "main = when True $ putStrLn \"hello\""
|
||||
]
|
||||
, -- Multiple import lists, should not introduce multiple newlines.
|
||||
[ "import System.IO ( stdout"
|
||||
, " , hPutStrLn"
|
||||
, " )"
|
||||
, "import Control.Monad ( when )"
|
||||
, "import Data.Maybe ( fromMaybe )"
|
||||
, "-- | Main entry point to the program"
|
||||
, "main :: IO ()"
|
||||
, "main ="
|
||||
, " when True"
|
||||
, " $ hPutStrLn stdout"
|
||||
, " $ fromMaybe \"Good night, World!\" (Just \"Hello, World!\")"
|
||||
]
|
||||
, -- Complex imports for Constructos and functions
|
||||
[ "{-# LANGUAGE NoImplicitPrelude #-}"
|
||||
, "import System.IO ( IO"
|
||||
, " , hPutStrLn"
|
||||
, " , stderr"
|
||||
, " )"
|
||||
, "import Prelude ( Bool(..) )"
|
||||
, "import Control.Monad ( when )"
|
||||
, "import Data.Function ( ($) )"
|
||||
, "import Data.Maybe ( fromMaybe"
|
||||
, " , Maybe(Just)"
|
||||
, " )"
|
||||
, "-- | Main entry point to the program"
|
||||
, "main :: IO ()"
|
||||
, "main ="
|
||||
, " when True"
|
||||
, " $ hPutStrLn stderr"
|
||||
, " $ fromMaybe \"Good night, World!\" (Just \"Hello, World!\")"
|
||||
]
|
||||
]
|
||||
describe "formats with floskell" $ hsImportSpec "floskell"
|
||||
[ -- Expected output for simple format.
|
||||
[ "import qualified Data.Maybe"
|
||||
, "import Control.Monad"
|
||||
, "main :: IO ()"
|
||||
, "main = when True $ putStrLn \"hello\""
|
||||
]
|
||||
, -- Use an import list and format the output.
|
||||
[ "import qualified Data.Maybe"
|
||||
, "import Control.Monad (when)"
|
||||
, "main :: IO ()"
|
||||
, "main = when True $ putStrLn \"hello\""
|
||||
]
|
||||
, -- Multiple import lists, should not introduce multiple newlines.
|
||||
[ "import System.IO (stdout, hPutStrLn)"
|
||||
, "import Control.Monad (when)"
|
||||
, "import Data.Maybe (fromMaybe)"
|
||||
, "-- | Main entry point to the program"
|
||||
, "main :: IO ()"
|
||||
, "main ="
|
||||
, " when True"
|
||||
, " $ hPutStrLn stdout"
|
||||
, " $ fromMaybe \"Good night, World!\" (Just \"Hello, World!\")"
|
||||
]
|
||||
, -- Complex imports for Constructos and functions
|
||||
[ "{-# LANGUAGE NoImplicitPrelude #-}"
|
||||
, "import System.IO (IO, hPutStrLn, stderr)"
|
||||
, "import Prelude (Bool(..))"
|
||||
, "import Control.Monad (when)"
|
||||
, "import Data.Function (($))"
|
||||
, "import Data.Maybe (fromMaybe, Maybe(Just))"
|
||||
, "-- | Main entry point to the program"
|
||||
, "main :: IO ()"
|
||||
, "main ="
|
||||
, " when True"
|
||||
, " $ hPutStrLn stderr"
|
||||
, " $ fromMaybe \"Good night, World!\" (Just \"Hello, World!\")"
|
||||
]
|
||||
]
|
||||
describe "formats with ormolu" $
|
||||
case ghcVersion of
|
||||
GHC86 -> hsImportSpec "ormolu"
|
||||
[ -- Expected output for simple format.
|
||||
[ "import Control.Monad"
|
||||
, "import qualified Data.Maybe"
|
||||
, "main :: IO ()"
|
||||
, "main = when True $ putStrLn \"hello\""
|
||||
]
|
||||
, -- Use an import list and format the output.
|
||||
[ "import Control.Monad (when)"
|
||||
, "import qualified Data.Maybe"
|
||||
, "main :: IO ()"
|
||||
, "main = when True $ putStrLn \"hello\""
|
||||
]
|
||||
, -- Multiple import lists, should not introduce multiple newlines.
|
||||
[ "import System.IO (hPutStrLn, stdout)"
|
||||
, "import Control.Monad (when)"
|
||||
, "import Data.Maybe (fromMaybe)"
|
||||
, "-- | Main entry point to the program"
|
||||
, "main :: IO ()"
|
||||
, "main ="
|
||||
, " when True"
|
||||
, " $ hPutStrLn stdout"
|
||||
, " $ fromMaybe \"Good night, World!\" (Just \"Hello, World!\")"
|
||||
]
|
||||
, -- Complex imports for Constructos and functions
|
||||
[ "{-# LANGUAGE NoImplicitPrelude #-}"
|
||||
, "import System.IO (IO, hPutStrLn, stderr)"
|
||||
, "import Prelude (Bool (..))"
|
||||
, "import Control.Monad (when)"
|
||||
, "import Data.Function (($))"
|
||||
, "import Data.Maybe (Maybe (Just), fromMaybe)"
|
||||
, "-- | Main entry point to the program"
|
||||
, "main :: IO ()"
|
||||
, "main ="
|
||||
, " when True"
|
||||
, " $ hPutStrLn stderr"
|
||||
, " $ fromMaybe \"Good night, World!\" (Just \"Hello, World!\")"
|
||||
]
|
||||
]
|
||||
_ -> it "is NOP formatter" $
|
||||
pendingWith "Ormolu only supported by GHC >= 8.6. Need to restore this."
|
||||
|
||||
describe "add package suggestions" $ do
|
||||
it "adds to .cabal files" $ do
|
||||
flushStackEnvironment
|
||||
@ -573,241 +472,6 @@ spec = describe "code actions" $ do
|
||||
kinds `shouldNotSatisfy` any (Just CodeActionRefactorInline /=)
|
||||
kinds `shouldSatisfy` all (Just CodeActionRefactorInline ==)
|
||||
|
||||
-- ---------------------------------------------------------------------
|
||||
-- Parameterized HsImport Spec.
|
||||
-- ---------------------------------------------------------------------
|
||||
hsImportSpec :: T.Text -> [[T.Text]]-> Spec
|
||||
hsImportSpec formatterName [e1, e2, e3, e4] =
|
||||
describe ("Execute HsImport with formatter " <> T.unpack formatterName) $ do
|
||||
it "works with 3.8 code action kinds" $ runSession hieCommand fullCaps "test/testdata" $ do
|
||||
doc <- openDoc "CodeActionImport.hs" "haskell"
|
||||
-- No Formatting:
|
||||
let config = def { formattingProvider = "none" }
|
||||
sendNotification WorkspaceDidChangeConfiguration (DidChangeConfigurationParams (toJSON config))
|
||||
|
||||
-- ignore the first empty hlint diagnostic publish
|
||||
[_,diag:_] <- count 2 waitForDiagnostics
|
||||
liftIO $ diag ^. L.message `shouldBe` "Variable not in scope: when :: Bool -> IO () -> IO ()"
|
||||
|
||||
actionsOrCommands <- getAllCodeActions doc
|
||||
let actns = map fromAction actionsOrCommands
|
||||
|
||||
liftIO $ do
|
||||
head actns ^. L.title `shouldBe` "Import module Control.Monad"
|
||||
head (tail actns) ^. L.title `shouldBe` "Import module Control.Monad (when)"
|
||||
forM_ actns $ \a -> do
|
||||
a ^. L.kind `shouldBe` Just CodeActionQuickFix
|
||||
a ^. L.command `shouldSatisfy` isJust
|
||||
a ^. L.edit `shouldBe` Nothing
|
||||
let hasOneDiag (Just (List [_])) = True
|
||||
hasOneDiag _ = False
|
||||
a ^. L.diagnostics `shouldSatisfy` hasOneDiag
|
||||
length actns `shouldBe` 10
|
||||
|
||||
executeCodeAction (head actns)
|
||||
|
||||
contents <- getDocumentEdit doc
|
||||
liftIO $ contents `shouldBe` "import Control.Monad\nmain :: IO ()\nmain = when True $ putStrLn \"hello\""
|
||||
|
||||
it "formats" $ runSession hieCommand fullCaps "test/testdata" $ do
|
||||
doc <- openDoc "CodeActionImportBrittany.hs" "haskell"
|
||||
_ <- waitForDiagnosticsSource "bios"
|
||||
|
||||
let config = def { formattingProvider = formatterName }
|
||||
sendNotification WorkspaceDidChangeConfiguration (DidChangeConfigurationParams (toJSON config))
|
||||
|
||||
actionsOrCommands <- getAllCodeActions doc
|
||||
let action:_ = map fromAction actionsOrCommands
|
||||
executeCodeAction action
|
||||
|
||||
contents <- getDocumentEdit doc
|
||||
liftIO $ T.lines contents `shouldMatchList` e1
|
||||
|
||||
it "import-list formats" $ runSession hieCommand fullCaps "test/testdata" $ do
|
||||
doc <- openDoc "CodeActionImportBrittany.hs" "haskell"
|
||||
_ <- waitForDiagnosticsSource "bios"
|
||||
|
||||
let config = def { formattingProvider = formatterName }
|
||||
sendNotification WorkspaceDidChangeConfiguration (DidChangeConfigurationParams (toJSON config))
|
||||
|
||||
actionsOrCommands <- getAllCodeActions doc
|
||||
let _:action:_ = map fromAction actionsOrCommands
|
||||
executeCodeAction action
|
||||
|
||||
contents <- getDocumentEdit doc
|
||||
liftIO $ T.lines contents `shouldMatchList` e2
|
||||
|
||||
-- ---------------------------------
|
||||
|
||||
it "multiple import-list formats" $ runSession hieCommand fullCaps "test/testdata" $ do
|
||||
doc <- openDoc "CodeActionImportList.hs" "haskell"
|
||||
|
||||
let config = def { formattingProvider = formatterName }
|
||||
sendNotification WorkspaceDidChangeConfiguration (DidChangeConfigurationParams (toJSON config))
|
||||
|
||||
let wantedCodeActionTitles = [ "Import module System.IO (hPutStrLn)"
|
||||
, "Import module System.IO (stdout)"
|
||||
, "Import module Control.Monad (when)"
|
||||
, "Import module Data.Maybe (fromMaybe)"
|
||||
]
|
||||
|
||||
contents <- executeAllCodeActions doc wantedCodeActionTitles
|
||||
|
||||
liftIO $ Set.fromList (T.lines contents) `shouldBe` Set.fromList e3
|
||||
|
||||
-- ---------------------------------
|
||||
|
||||
it "respects format config, multiple import-list" $ runSession hieCommand fullCaps "test/testdata" $ do
|
||||
doc <- openDoc "CodeActionImportList.hs" "haskell"
|
||||
|
||||
let config = def { formatOnImportOn = False, formattingProvider = formatterName }
|
||||
sendNotification WorkspaceDidChangeConfiguration (DidChangeConfigurationParams (toJSON config))
|
||||
|
||||
let wantedCodeActionTitles = [ "Import module System.IO (hPutStrLn)"
|
||||
, "Import module System.IO (stdout)"
|
||||
, "Import module Control.Monad (when)"
|
||||
, "Import module Data.Maybe (fromMaybe)"
|
||||
]
|
||||
|
||||
contents <- executeAllCodeActions doc wantedCodeActionTitles
|
||||
liftIO $ Set.fromList (T.lines contents) `shouldBe`
|
||||
Set.fromList
|
||||
[ "import System.IO (stdout, hPutStrLn)"
|
||||
, "import Control.Monad (when)"
|
||||
, "import Data.Maybe (fromMaybe)"
|
||||
, "-- | Main entry point to the program"
|
||||
, "main :: IO ()"
|
||||
, "main ="
|
||||
, " when True"
|
||||
, " $ hPutStrLn stdout"
|
||||
, " $ fromMaybe \"Good night, World!\" (Just \"Hello, World!\")"
|
||||
]
|
||||
it "respects format config" $ runSession hieCommand fullCaps "test/testdata" $ do
|
||||
doc <- openDoc "CodeActionImportBrittany.hs" "haskell"
|
||||
_ <- waitForDiagnosticsSource "bios"
|
||||
|
||||
let config = def { formatOnImportOn = False, formattingProvider = formatterName }
|
||||
sendNotification WorkspaceDidChangeConfiguration (DidChangeConfigurationParams (toJSON config))
|
||||
|
||||
actionsOrCommands <- getAllCodeActions doc
|
||||
let action:_ = map fromAction actionsOrCommands
|
||||
executeCodeAction action
|
||||
|
||||
contents <- getDocumentEdit doc
|
||||
liftIO $ do
|
||||
let [l1, l2, l3, l4] = T.lines contents
|
||||
l1 `shouldBe` "import qualified Data.Maybe"
|
||||
l2 `shouldBe` "import Control.Monad"
|
||||
l3 `shouldBe` "main :: IO ()"
|
||||
l4 `shouldBe` "main = when True $ putStrLn \"hello\""
|
||||
|
||||
it "import-list respects format config" $ runSession hieCommand fullCaps "test/testdata" $ do
|
||||
doc <- openDoc "CodeActionImportBrittany.hs" "haskell"
|
||||
_ <- waitForDiagnosticsSource "bios"
|
||||
|
||||
let config = def { formatOnImportOn = False, formattingProvider = formatterName }
|
||||
sendNotification WorkspaceDidChangeConfiguration (DidChangeConfigurationParams (toJSON config))
|
||||
|
||||
actionsOrCommands <- getAllCodeActions doc
|
||||
let _:action:_ = map fromAction actionsOrCommands
|
||||
executeCodeAction action
|
||||
|
||||
contents <- getDocumentEdit doc
|
||||
liftIO $ do
|
||||
let [l1, l2, l3, l4] = T.lines contents
|
||||
l1 `shouldBe` "import qualified Data.Maybe"
|
||||
l2 `shouldBe` "import Control.Monad (when)"
|
||||
l3 `shouldBe` "main :: IO ()"
|
||||
l4 `shouldBe` "main = when True $ putStrLn \"hello\""
|
||||
|
||||
it "complex import-list" $ runSession hieCommand fullCaps "test/testdata" $ do
|
||||
doc <- openDoc "CodeActionImportListElaborate.hs" "haskell"
|
||||
_ <- waitForDiagnosticsSource "bios"
|
||||
|
||||
let config = def { formatOnImportOn = True, formattingProvider = formatterName }
|
||||
sendNotification WorkspaceDidChangeConfiguration (DidChangeConfigurationParams (toJSON config))
|
||||
|
||||
let wantedCodeActionTitles = [ "Import module System.IO (hPutStrLn)"
|
||||
, "Import module Control.Monad (when)"
|
||||
, "Import module Data.Maybe (fromMaybe)"
|
||||
, "Import module Data.Function (($))"
|
||||
, "Import module Data.Maybe (Maybe (Just))"
|
||||
, "Import module Prelude (Bool (..))"
|
||||
, "Import module System.IO (stderr)"
|
||||
]
|
||||
|
||||
contents <- executeAllCodeActions doc wantedCodeActionTitles
|
||||
|
||||
liftIO $
|
||||
T.lines contents `shouldBe` e4
|
||||
|
||||
it "complex import-list respects format config" $ runSession hieCommand fullCaps "test/testdata" $ do
|
||||
doc <- openDoc "CodeActionImportListElaborate.hs" "haskell"
|
||||
_ <- waitForDiagnosticsSource "bios"
|
||||
|
||||
let config = def { formatOnImportOn = False, formattingProvider = formatterName }
|
||||
sendNotification WorkspaceDidChangeConfiguration (DidChangeConfigurationParams (toJSON config))
|
||||
|
||||
let wantedCodeActionTitles = [ "Import module System.IO (hPutStrLn)"
|
||||
, "Import module Control.Monad (when)"
|
||||
, "Import module Data.Maybe (fromMaybe)"
|
||||
, "Import module Data.Function (($))"
|
||||
, "Import module Data.Maybe (Maybe (Just))"
|
||||
, "Import module Prelude (Bool (..))"
|
||||
, "Import module System.IO (stderr)"
|
||||
]
|
||||
|
||||
contents <- executeAllCodeActions doc wantedCodeActionTitles
|
||||
|
||||
liftIO $
|
||||
T.lines contents `shouldBe`
|
||||
[ "{-# LANGUAGE NoImplicitPrelude #-}"
|
||||
, "import System.IO (IO, hPutStrLn, stderr)"
|
||||
, "import Prelude (Bool(..))"
|
||||
, "import Control.Monad (when)"
|
||||
, "import Data.Function (($))"
|
||||
, "import Data.Maybe (fromMaybe, Maybe(Just))"
|
||||
, "-- | Main entry point to the program"
|
||||
, "main :: IO ()"
|
||||
, "main ="
|
||||
, " when True"
|
||||
, " $ hPutStrLn stderr"
|
||||
, " $ fromMaybe \"Good night, World!\" (Just \"Hello, World!\")"
|
||||
]
|
||||
|
||||
where
|
||||
executeAllCodeActions :: TextDocumentIdentifier -> [T.Text] -> Session T.Text
|
||||
executeAllCodeActions doc names =
|
||||
foldM (\_ _ -> do
|
||||
_ <- waitForDiagnosticsSource "bios"
|
||||
executeCodeActionByName doc names
|
||||
content <- skipManyTill publishDiagnosticsNotification $ getDocumentEdit doc
|
||||
_ <- waitForDiagnosticsSource "bios"
|
||||
return content
|
||||
)
|
||||
(T.pack "")
|
||||
[ 1 .. length names ]
|
||||
|
||||
executeCodeActionByName :: TextDocumentIdentifier -> [T.Text] -> Session ()
|
||||
executeCodeActionByName doc names = do
|
||||
actionsOrCommands <- getAllCodeActions doc
|
||||
let allActions = map fromAction actionsOrCommands
|
||||
let actions = filter (\actn -> actn ^. L.title `elem` names) allActions
|
||||
case actions of
|
||||
(action:_) -> executeCodeAction action
|
||||
[] ->
|
||||
error
|
||||
$ "No action found to be executed!"
|
||||
++ "\n Actual actions titles: " ++ show (map (^. L.title) allActions)
|
||||
++ "\n Expected actions titles: " ++ show names
|
||||
|
||||
-- Silence warnings
|
||||
hsImportSpec formatter args =
|
||||
error $ "Not the right amount of arguments for \"hsImportSpec ("
|
||||
++ T.unpack formatter
|
||||
++ ")\", expected 4, got "
|
||||
++ show (length args)
|
||||
|
||||
-- ---------------------------------------------------------------------
|
||||
|
||||
fromAction :: CAResult -> CodeAction
|
||||
|
170
test/unit/HsImportSpec.hs
Normal file
170
test/unit/HsImportSpec.hs
Normal file
@ -0,0 +1,170 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
module HsImportSpec where
|
||||
|
||||
import Control.Monad.IO.Class
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.HashMap.Strict as Map
|
||||
import Haskell.Ide.Engine.MonadTypes
|
||||
import Haskell.Ide.Engine.PluginUtils
|
||||
import Haskell.Ide.Engine.Plugin.HsImport
|
||||
import qualified Haskell.Ide.Engine.Config as Config
|
||||
import qualified Haskell.Ide.Engine.Plugin.Brittany as Brittany
|
||||
import qualified Haskell.Ide.Engine.Plugin.Ormolu as Ormolu
|
||||
import qualified Haskell.Ide.Engine.Plugin.Floskell as Floskell
|
||||
import System.Directory
|
||||
import System.FilePath
|
||||
import Test.Hspec
|
||||
import TestUtils
|
||||
|
||||
|
||||
main :: IO ()
|
||||
main = hspec spec
|
||||
|
||||
spec :: Spec
|
||||
spec =
|
||||
describe "hsimport plugin" hsImportSpec
|
||||
|
||||
-- ---------------------------------------------------------------------
|
||||
|
||||
testPlugins :: IdePlugins
|
||||
testPlugins = pluginDescToIdePlugins
|
||||
[ Brittany.brittanyDescriptor "brittany"
|
||||
, Floskell.floskellDescriptor "floskell"
|
||||
, Ormolu.ormoluDescriptor "ormolu"
|
||||
]
|
||||
|
||||
brittanyFilePath :: FilePath
|
||||
brittanyFilePath = "test" </> "testdata" </> "CodeActionImportList.hs"
|
||||
|
||||
dispatchRequestP :: IdeGhcM a -> IO a
|
||||
dispatchRequestP act = do
|
||||
cwd <- liftIO $ getCurrentDirectory
|
||||
runIGM testPlugins (cwd </> "test" </> "testdata" </> "File.hs") act
|
||||
|
||||
-- ---------------------------------------------------------------------
|
||||
|
||||
hsImportSpec :: Spec
|
||||
hsImportSpec = do
|
||||
describe "formats with brittany" $ hsImportSpecRunner "brittany"
|
||||
[ -- Expected output for simple format.
|
||||
[ TextEdit (Range (toPos (2, 1)) (toPos (2, 1))) "import Control.Monad\n"
|
||||
]
|
||||
, [ TextEdit (Range (toPos (2, 1)) (toPos (2, 1))) "import Control.Monad ( when )\n"
|
||||
]
|
||||
, [ TextEdit (Range (toPos (2, 1)) (toPos (2, 1))) "import Data.Maybe ( Maybe )\n"
|
||||
]
|
||||
, [ TextEdit (Range (toPos (2, 1)) (toPos (2, 1))) "import Data.Maybe ( Maybe(..) )\n"
|
||||
]
|
||||
, [ TextEdit (Range (toPos (2, 1)) (toPos (2, 1))) "import Data.Maybe ( Maybe(Nothing) )\n"
|
||||
]
|
||||
, [ TextEdit (Range (toPos (2, 1)) (toPos (2, 1))) "import Data.Function ( ($) )\n"
|
||||
]
|
||||
]
|
||||
describe "formats with floskell" $ hsImportSpecRunner "floskell"
|
||||
[ -- Expected output for simple format.
|
||||
[ TextEdit (Range (toPos (2, 1)) (toPos (2, 1))) "import Control.Monad\n"
|
||||
]
|
||||
, [ TextEdit (Range (toPos (2, 1)) (toPos (2, 1))) "import Control.Monad (when)\n"
|
||||
]
|
||||
, [ TextEdit (Range (toPos (2, 1)) (toPos (2, 1))) "import Data.Maybe (Maybe)\n"
|
||||
]
|
||||
, [ TextEdit (Range (toPos (2, 1)) (toPos (2, 1))) "import Data.Maybe (Maybe(..))\n"
|
||||
]
|
||||
, [ TextEdit (Range (toPos (2, 1)) (toPos (2, 1))) "import Data.Maybe (Maybe(Nothing))\n"
|
||||
]
|
||||
, [ TextEdit (Range (toPos (2, 1)) (toPos (2, 1))) "import Data.Function (($))\n"
|
||||
]
|
||||
]
|
||||
describe "formats with ormolu" $ case ghcVersion of
|
||||
GHC86 -> hsImportSpecRunner "ormolu"
|
||||
[ -- Expected output for simple format.
|
||||
[ TextEdit (Range (toPos (2, 1)) (toPos (2, 1))) "import Control.Monad\n"
|
||||
]
|
||||
, [ TextEdit (Range (toPos (2, 1)) (toPos (2, 1))) "import Control.Monad (when)\n"
|
||||
]
|
||||
, [ TextEdit (Range (toPos (2, 1)) (toPos (2, 1))) "import Data.Maybe (Maybe)\n"
|
||||
]
|
||||
, [ TextEdit (Range (toPos (2, 1)) (toPos (2, 1))) "import Data.Maybe (Maybe (..))\n"
|
||||
]
|
||||
, [ TextEdit (Range (toPos (2, 1)) (toPos (2, 1))) "import Data.Maybe (Maybe (Nothing))\n"
|
||||
]
|
||||
, [ TextEdit (Range (toPos (2, 1)) (toPos (2, 1))) "import Data.Function (($))\n"
|
||||
]
|
||||
]
|
||||
_ -> it "is NOP formatter" $
|
||||
pendingWith "Ormolu only supported by GHC >= 8.6. Need to restore this."
|
||||
|
||||
-- ---------------------------------------------------------------------
|
||||
-- Parameterized HsImport Spec.
|
||||
-- ---------------------------------------------------------------------
|
||||
hsImportSpecRunner :: T.Text -> [[TextEdit]] -> Spec
|
||||
hsImportSpecRunner formatterName [e1, e2, e3, e4, e5, e6] = do
|
||||
it "formats" $ do
|
||||
fp <- makeAbsolute brittanyFilePath
|
||||
let uri = filePathToUri fp
|
||||
let act = importModule (ImportParams uri Simple "Control.Monad")
|
||||
|
||||
IdeResultOk (WorkspaceEdit (Just changes) _) <- runSingle' (setFormatter formatterName) testPlugins fp act
|
||||
case Map.lookup uri changes of
|
||||
Just (List val) -> val `shouldBe` e1
|
||||
Nothing -> fail "No Change found"
|
||||
|
||||
it "import-list formats" $ do
|
||||
fp <- makeAbsolute brittanyFilePath
|
||||
let uri = filePathToUri fp
|
||||
let act = importModule (ImportParams uri (Complex (Import $ Only "when")) "Control.Monad")
|
||||
|
||||
IdeResultOk (WorkspaceEdit (Just changes) _) <- runSingle' (setFormatter formatterName) testPlugins fp act
|
||||
case Map.lookup uri changes of
|
||||
Just (List val) -> val `shouldBe` e2
|
||||
Nothing -> fail "No Change found"
|
||||
|
||||
it "import-list type formats" $ do
|
||||
fp <- makeAbsolute brittanyFilePath
|
||||
let uri = filePathToUri fp
|
||||
let act = importModule (ImportParams uri (Complex (Import $ Only "Maybe")) "Data.Maybe")
|
||||
|
||||
IdeResultOk (WorkspaceEdit (Just changes) _) <- runSingle' (setFormatter formatterName) testPlugins fp act
|
||||
case Map.lookup uri changes of
|
||||
Just (List val) -> val `shouldBe` e3
|
||||
Nothing -> fail "No Change found"
|
||||
|
||||
it "import-list constructor formats" $ do
|
||||
fp <- makeAbsolute brittanyFilePath
|
||||
let uri = filePathToUri fp
|
||||
let act = importModule (ImportParams uri (Complex (Import $ AllOf "Maybe")) "Data.Maybe")
|
||||
|
||||
IdeResultOk (WorkspaceEdit (Just changes) _) <- runSingle' (setFormatter formatterName) testPlugins fp act
|
||||
case Map.lookup uri changes of
|
||||
Just (List val) -> val `shouldBe` e4
|
||||
Nothing -> fail "No Change found"
|
||||
|
||||
it "import-list constructor formats" $ do
|
||||
fp <- makeAbsolute brittanyFilePath
|
||||
let uri = filePathToUri fp
|
||||
let act = importModule (ImportParams uri (Complex (Import $ OneOf "Maybe" "Nothing")) "Data.Maybe")
|
||||
|
||||
IdeResultOk (WorkspaceEdit (Just changes) _) <- runSingle' (setFormatter formatterName) testPlugins fp act
|
||||
case Map.lookup uri changes of
|
||||
Just (List val) -> val `shouldBe` e5
|
||||
Nothing -> fail "No Change found"
|
||||
|
||||
it "import-list infix function formats" $ do
|
||||
fp <- makeAbsolute brittanyFilePath
|
||||
let uri = filePathToUri fp
|
||||
let act = importModule (ImportParams uri (Complex (Import $ Only "$")) "Data.Function")
|
||||
|
||||
IdeResultOk (WorkspaceEdit (Just changes) _) <- runSingle' (setFormatter formatterName) testPlugins fp act
|
||||
case Map.lookup uri changes of
|
||||
Just (List val) -> val `shouldBe` e6
|
||||
Nothing -> fail "No Change found"
|
||||
|
||||
-- Silence warnings
|
||||
hsImportSpecRunner formatter args =
|
||||
error $ "Not the right amount of arguments for \"hsImportSpec ("
|
||||
++ T.unpack formatter
|
||||
++ ")\", got "
|
||||
++ show (length args)
|
||||
|
||||
setFormatter :: T.Text -> Config.Config -> Config.Config
|
||||
setFormatter formatterName cfg = cfg { Config.formattingProvider = formatterName }
|
@ -5,9 +5,11 @@ module TestUtils
|
||||
, setupBuildToolFiles
|
||||
, testCommand
|
||||
, runSingle
|
||||
, runSingle'
|
||||
, runSingleReq
|
||||
, makeRequest
|
||||
, runIGM
|
||||
, runIGM'
|
||||
, ghcVersion, GhcVersion(..)
|
||||
, logFilePath
|
||||
, readResolver
|
||||
@ -34,6 +36,7 @@ import Language.Haskell.LSP.Core
|
||||
import Language.Haskell.LSP.Types (LspId(IdInt), fromNormalizedUri)
|
||||
import Haskell.Ide.Engine.MonadTypes hiding (withProgress, withIndefiniteProgress)
|
||||
import qualified Haskell.Ide.Engine.Cradle as Bios
|
||||
import qualified Haskell.Ide.Engine.Config as Config
|
||||
import System.Directory
|
||||
import System.Environment
|
||||
import System.FilePath
|
||||
@ -65,7 +68,10 @@ testCommand testPlugins fp act plugin cmd arg res = do
|
||||
fmap fromDynJSON oldApiRes `shouldBe` fmap Just res
|
||||
|
||||
runSingle :: IdePlugins -> FilePath -> IdeGhcM (IdeResult b) -> IO (IdeResult b)
|
||||
runSingle testPlugins fp act = runIGM testPlugins fp act
|
||||
runSingle = runSingle' id
|
||||
|
||||
runSingle' :: (Config.Config -> Config.Config) -> IdePlugins -> FilePath -> IdeGhcM (IdeResult b) -> IO (IdeResult b)
|
||||
runSingle' modifyConfig testPlugins fp act = runIGM' modifyConfig testPlugins fp act
|
||||
|
||||
runSingleReq :: ToJSON a
|
||||
=> IdePlugins -> FilePath -> PluginId -> CommandId -> a -> IO (IdeResult DynamicJSON)
|
||||
@ -75,11 +81,18 @@ makeRequest :: ToJSON a => PluginId -> CommandId -> a -> IdeGhcM (IdeResult Dyna
|
||||
makeRequest plugin com arg = runPluginCommand plugin com (toJSON arg)
|
||||
|
||||
runIGM :: IdePlugins -> FilePath -> IdeGhcM a -> IO a
|
||||
runIGM testPlugins fp f = do
|
||||
runIGM = runIGM' id
|
||||
|
||||
runIGM' :: (Config.Config -> Config.Config) -> IdePlugins -> FilePath -> IdeGhcM a -> IO a
|
||||
runIGM' modifyConfig testPlugins fp f = do
|
||||
stateVar <- newTVarIO $ IdeState emptyModuleCache Map.empty Map.empty Nothing
|
||||
crdl <- Bios.findLocalCradle fp
|
||||
mlibdir <- Bios.getProjectGhcLibDir crdl
|
||||
runIdeGhcM mlibdir testPlugins dummyLspFuncs stateVar f
|
||||
let tmpFuncs :: LspFuncs Config.Config
|
||||
tmpFuncs = dummyLspFuncs
|
||||
lspFuncs :: LspFuncs Config.Config
|
||||
lspFuncs = tmpFuncs { config = (fmap . fmap) modifyConfig (config tmpFuncs)}
|
||||
runIdeGhcM mlibdir testPlugins lspFuncs stateVar f
|
||||
|
||||
withFileLogging :: FilePath -> IO a -> IO a
|
||||
withFileLogging logFile f = do
|
||||
|
Loading…
Reference in New Issue
Block a user