Skip to content

Commit

Permalink
Replace faulty signature test (#1792)
Browse files Browse the repository at this point in the history
Co-authored-by: mergify[bot] <37929162+mergify[bot]@users.noreply.github.com>
  • Loading branch information
kderme and mergify[bot] authored May 5, 2021
1 parent ee7b5a9 commit ef0e9fd
Showing 1 changed file with 43 additions and 15 deletions.
58 changes: 43 additions & 15 deletions ghcide/test/exe/Main.hs
Original file line number Diff line number Diff line change
Expand Up @@ -2785,13 +2785,39 @@ removeRedundantConstraintsTests = let
, " in h"
]

typeSignatureMultipleLines :: T.Text
typeSignatureMultipleLines = T.unlines $ header <>
[ "foo :: (Num a, Eq a, Monoid a)"
, "=> a -> Bool"
, "foo x = x == 1"
typeSignatureLined1 = T.unlines $ header <>
[ "foo :: Eq a =>"
, " a -> Bool"
, "foo _ = True"
]

typeSignatureLined2 = T.unlines $ header <>
[ "foo :: (Eq a, Show a)"
, " => a -> Bool"
, "foo _ = True"
]

typeSignatureOneLine = T.unlines $ header <>
[ "foo :: a -> Bool"
, "foo _ = True"
]

typeSignatureLined3 = T.unlines $ header <>
[ "foo :: ( Eq a"
, " , Show a"
, " )"
, " => a -> Bool"
, "foo x = x == x"
]

typeSignatureLined3' = T.unlines $ header <>
[ "foo :: ( Eq a"
, " )"
, " => a -> Bool"
, "foo x = x == x"
]


check :: T.Text -> T.Text -> T.Text -> TestTree
check actionTitle originalCode expectedCode = testSession (T.unpack actionTitle) $ do
doc <- createDoc "Testing.hs" "haskell" originalCode
Expand All @@ -2802,13 +2828,6 @@ removeRedundantConstraintsTests = let
modifiedCode <- documentContents doc
liftIO $ expectedCode @=? modifiedCode

checkPeculiarFormatting :: String -> T.Text -> TestTree
checkPeculiarFormatting title code = testSession title $ do
doc <- createDoc "Testing.hs" "haskell" code
_ <- waitForDiagnostics
actionsOrCommands <- getAllCodeActions doc
liftIO $ assertBool "Found some actions" (null actionsOrCommands)

in testGroup "remove redundant function constraints"
[ check
"Remove redundant constraint `Eq a` from the context of the type signature for `foo`"
Expand Down Expand Up @@ -2846,9 +2865,18 @@ removeRedundantConstraintsTests = let
"Remove redundant constraints `(Monoid a, Show a)` from the context of the type signature for `foo`"
(typeSignatureSpaces $ Just "Monoid a, Show a")
(typeSignatureSpaces Nothing)
, checkPeculiarFormatting
"should do nothing when constraints contain line feeds"
typeSignatureMultipleLines
, check
"Remove redundant constraint `Eq a` from the context of the type signature for `foo`"
typeSignatureLined1
typeSignatureOneLine
, check
"Remove redundant constraints `(Eq a, Show a)` from the context of the type signature for `foo`"
typeSignatureLined2
typeSignatureOneLine
, check
"Remove redundant constraint `Show a` from the context of the type signature for `foo`"
typeSignatureLined3
typeSignatureLined3'
]

addSigActionTests :: TestTree
Expand Down

0 comments on commit ef0e9fd

Please sign in to comment.