Skip to content

Commit fbdbbd6

Browse files
drsoochdrsooch
authored
Fix test failure for AlternateNumberFormat (#2752)
* Fix test failure for AlternateNumberFormat * Update AlternateNumberFormat.hs * Update AlternateNumberFormat.hs * Add -Wall * Fix 8.8 compile error * Remove unneccessary tests * Bump plugin version
1 parent 73fdd91 commit fbdbbd6

18 files changed

+39
-85
lines changed

‎.github/workflows/test.yml

+1-1
Original file line numberDiff line numberDiff line change
@@ -224,7 +224,7 @@ jobs:
224224
name: Test hls-module-name-plugin test suite
225225
run: cabal test hls-module-name-plugin --test-options="$TEST_OPTS" || cabal test hls-module-name-plugin --test-options="$TEST_OPTS" || LSP_TEST_LOG_COLOR=0 LSP_TEST_LOG_MESSAGES=true LSP_TEST_LOG_STDERR=true cabal test hls-module-name-plugin --test-options="$TEST_OPTS"
226226

227-
- if: matrix.test && matrix.ghc != '9.2.1'
227+
- if: matrix.test
228228
name: Test hls-alternate-number-format-plugin test suite
229229
run: cabal test hls-alternate-number-format-plugin --test-options="$TEST_OPTS" || cabal test hls-alternate-number-format-plugin --test-options="$TEST_OPTS" || LSP_TEST_LOG_COLOR=0 LSP_TEST_LOG_MESSAGES=true LSP_TEST_LOG_STDERR=true cabal test hls-alternate-number-format-plugin --test-options="$TEST_OPTS"
230230

‎plugins/hls-alternate-number-format-plugin/README.md

+4
Original file line numberDiff line numberDiff line change
@@ -44,3 +44,7 @@ To generate suggestions, the plugin leverages the `Numeric` package which provid
4444

4545
### 1.0.1.1
4646
- Buildable with GHC 9.2
47+
48+
### 1.0.2.0
49+
- Test Suite upgraded for 9.2 semantics (GHC2021)
50+
- Fix SYB parsing with GHC 9.2

‎plugins/hls-alternate-number-format-plugin/hls-alternate-number-format-plugin.cabal

+2-1
Original file line numberDiff line numberDiff line change
@@ -1,6 +1,6 @@
11
cabal-version: 2.4
22
name: hls-alternate-number-format-plugin
3-
version: 1.0.1.1
3+
version: 1.0.2.0
44
synopsis: Provide Alternate Number Formats plugin for Haskell Language Server
55
description:
66
Please see the README on GitHub at <https://github.com/haskell/haskell-language-server#readme>
@@ -21,6 +21,7 @@ library
2121
exposed-modules: Ide.Plugin.AlternateNumberFormat, Ide.Plugin.Conversion
2222
other-modules: Ide.Plugin.Literals
2323
hs-source-dirs: src
24+
ghc-options: -Wall
2425
build-depends:
2526
aeson
2627
, base >=4.12 && < 5

‎plugins/hls-alternate-number-format-plugin/src/Ide/Plugin/AlternateNumberFormat.hs

+1-3
Original file line numberDiff line numberDiff line change
@@ -22,8 +22,7 @@ import Development.IDE.Types.Logger as Logger
2222
import GHC.Generics (Generic)
2323
import Ide.Plugin.Conversion (FormatType, alternateFormat,
2424
toFormatTypes)
25-
import Ide.Plugin.Literals (Literal (..), collectLiterals,
26-
getSrcSpan, getSrcText)
25+
import Ide.Plugin.Literals
2726
import Ide.PluginUtils (handleMaybe, handleMaybeM,
2827
response)
2928
import Ide.Types
@@ -126,7 +125,6 @@ requestLiterals state = handleMaybeM "Error: Could not Collect Literals"
126125
. runAction "AlternateNumberFormat.CollectLiterals" state
127126
. use CollectLiterals
128127

129-
130128
logIO :: (MonadIO m, Show a) => IdeState -> a -> m ()
131129
logIO state = liftIO . Logger.logDebug (ideLogger state) . T.pack . show
132130

‎plugins/hls-alternate-number-format-plugin/src/Ide/Plugin/Literals.hs

+19-34
Original file line numberDiff line numberDiff line change
@@ -1,7 +1,9 @@
1+
{-# LANGUAGE CPP #-}
12
{-# LANGUAGE DeriveDataTypeable #-}
23
{-# LANGUAGE DeriveGeneric #-}
34
{-# LANGUAGE FlexibleInstances #-}
45
{-# LANGUAGE RankNTypes #-}
6+
{-# LANGUAGE ViewPatterns #-}
57
module Ide.Plugin.Literals (
68
collectLiterals
79
, Literal(..)
@@ -13,7 +15,6 @@ import Data.Maybe (maybeToList)
1315
import Data.Text (Text)
1416
import qualified Data.Text as T
1517
import Development.IDE.GHC.Compat hiding (getSrcSpan)
16-
import Development.IDE.GHC.Util (unsafePrintSDoc)
1718
import Development.IDE.Graph.Classes (NFData (rnf))
1819
import qualified GHC.Generics as GHC
1920
import Generics.SYB (Data, Typeable, everything,
@@ -48,25 +49,36 @@ getSrcSpan = \case
4849
collectLiterals :: (Data ast, Typeable ast) => ast -> [Literal]
4950
collectLiterals = everything (<>) (maybeToList . (const Nothing `extQ` getLiteral `extQ` getPattern))
5051

52+
5153
-- | Translate from HsLit and HsOverLit Types to our Literal Type
52-
getLiteral :: GenLocated SrcSpan (HsExpr GhcPs) -> Maybe Literal
53-
getLiteral (L (UnhelpfulSpan _) _) = Nothing
54-
getLiteral (L (RealSrcSpan sSpan _ ) expr) = case expr of
54+
getLiteral :: (LHsExpr GhcPs) -> Maybe Literal
55+
getLiteral (L (locA -> (RealSrcSpan sSpan _)) expr) = case expr of
5556
HsLit _ lit -> fromLit lit sSpan
5657
HsOverLit _ overLit -> fromOverLit overLit sSpan
5758
_ -> Nothing
59+
getLiteral _ = Nothing
60+
61+
62+
63+
-- GHC 8.8 typedefs LPat = Pat
64+
#if __GLASGOW_HASKELL__ == 808
65+
type LocPat a = GenLocated SrcSpan (Pat a)
66+
#else
67+
type LocPat a = LPat a
68+
#endif
5869

5970
-- | Destructure Patterns to unwrap any Literals
60-
getPattern :: GenLocated SrcSpan (Pat GhcPs) -> Maybe Literal
61-
getPattern (L (UnhelpfulSpan _) _) = Nothing
62-
getPattern (L (RealSrcSpan patSpan _) pat) = case pat of
71+
getPattern :: (LocPat GhcPs) -> Maybe Literal
72+
getPattern (L (locA -> (RealSrcSpan patSpan _)) pat) = case pat of
6373
LitPat _ lit -> case lit of
6474
HsInt _ val -> fromIntegralLit patSpan val
6575
HsRat _ val _ -> fromFractionalLit patSpan val
6676
_ -> Nothing
77+
-- a located HsOverLit is (GenLocated SrcSpan HsOverLit) NOT (GenLocated SrcSpanAnn' a HsOverLit)
6778
NPat _ (L (RealSrcSpan sSpan _) overLit) _ _ -> fromOverLit overLit sSpan
6879
NPlusKPat _ _ (L (RealSrcSpan sSpan _) overLit1) _ _ _ -> fromOverLit overLit1 sSpan
6980
_ -> Nothing
81+
getPattern _ = Nothing
7082

7183
fromLit :: HsLit p -> RealSrcSpan -> Maybe Literal
7284
fromLit lit sSpan = case lit of
@@ -91,30 +103,3 @@ fromSourceText :: SourceText -> Maybe Text
91103
fromSourceText = \case
92104
SourceText s -> Just $ T.pack s
93105
NoSourceText -> Nothing
94-
95-
-- mostly for debugging purposes
96-
literalToString :: HsLit p -> String
97-
literalToString = \case
98-
HsChar _ c -> "Char: " <> show c
99-
HsCharPrim _ c -> "CharPrim: " <> show c
100-
HsString _ fs -> "String: " <> show fs
101-
HsStringPrim _ bs -> "StringPrim: " <> show bs
102-
HsInt _ il -> "Int: " <> show il
103-
HsIntPrim _ n -> "IntPrim: " <> show n
104-
HsWordPrim _ n -> "WordPrim: " <> show n
105-
HsInt64Prim _ n -> "Int64Prim: " <> show n
106-
HsWord64Prim _ n -> "Word64Prim: " <> show n
107-
HsInteger _ n ty -> "Integer: " <> show n <> " Type: " <> tyToLiteral ty
108-
HsRat _ fl ty -> "Rat: " <> show fl <> " Type: " <> tyToLiteral ty
109-
HsFloatPrim _ fl -> "FloatPrim: " <> show fl
110-
HsDoublePrim _ fl -> "DoublePrim: " <> show fl
111-
_ -> "XHsLit"
112-
where
113-
tyToLiteral :: Type -> String
114-
tyToLiteral = unsafePrintSDoc . ppr
115-
116-
overLitToString :: OverLitVal -> String
117-
overLitToString = \case
118-
HsIntegral int -> case int of { IL{il_value} -> "IntegralOverLit: " <> show il_value}
119-
HsFractional frac -> case frac of { fl -> "RationalOverLit: " <> show (rationalFromFractionalLit fl)}
120-
HsIsString _ str -> "HIsString: " <> show str

‎plugins/hls-alternate-number-format-plugin/test/Main.hs

+6-25
Original file line numberDiff line numberDiff line change
@@ -23,7 +23,6 @@ main = defaultTestRunner test
2323
alternateNumberFormatPlugin :: PluginDescriptor IdeState
2424
alternateNumberFormatPlugin = AlternateNumberFormat.descriptor mempty "alternateNumberFormat"
2525

26-
2726
-- NOTE: For whatever reason, this plugin does not play nice with creating Code Actions on time.
2827
-- As a result tests will mostly pass if `import Prelude` is added at the top. We (mostly fendor) surmise this has something
2928
-- to do with how
@@ -37,36 +36,18 @@ test = testGroup "alternateNumberFormat" [
3736
, codeActionFloatHex "TFracDtoHF" 4 13
3837
, codeActionDecimal "TIntHtoD" 3 13
3938
, codeActionDecimal "TFracHFtoD" 4 13
40-
, codeActionProperties "TFindLiteralIntPattern" [(3, 25), (4,25)] $ \actions -> do
39+
, codeActionProperties "TFindLiteralIntPattern" [(4, 25), (5,25)] $ \actions -> do
4140
liftIO $ length actions @?= 4
42-
, codeActionProperties "TFindLiteralIntCase" [(3, 29)] $ \actions -> do
41+
, codeActionProperties "TFindLiteralIntCase" [(4, 29)] $ \actions -> do
4342
liftIO $ length actions @?= 2
44-
, codeActionProperties "TFindLiteralIntCase2" [(4, 21)] $ \actions -> do
43+
, codeActionProperties "TFindLiteralIntCase2" [(5, 21)] $ \actions -> do
4544
liftIO $ length actions @?= 2
46-
, codeActionProperties "TFindLiteralDoReturn" [(5, 10)] $ \actions -> do
45+
, codeActionProperties "TFindLiteralDoReturn" [(6, 10)] $ \actions -> do
4746
liftIO $ length actions @?= 2
48-
, codeActionProperties "TFindLiteralDoLet" [(5, 13), (6, 13)] $ \actions -> do
47+
, codeActionProperties "TFindLiteralDoLet" [(6, 13), (7, 13)] $ \actions -> do
4948
liftIO $ length actions @?= 4
50-
, codeActionProperties "TFindLiteralList" [(3, 28)] $ \actions -> do
51-
liftIO $ length actions @?= 2
52-
, codeActionProperties "TExpectNoBinaryFormat" [(3, 12)] $ \actions -> do
53-
liftIO $ length actions @?= 2
54-
liftIO $ actions `doesNotContain` binaryRegex @? "Contains binary codeAction"
55-
, codeActionProperties "TExpectBinaryFormat" [(4, 10)] $ \actions -> do
56-
liftIO $ length actions @?= 3
57-
liftIO $ actions `contains` binaryRegex @? "Does not contain binary codeAction"
58-
, codeActionProperties "TExpectNoHexFloatFormat" [(3, 14)] $ \actions -> do
59-
liftIO $ length actions @?= 1
60-
liftIO $ actions `doesNotContain` hexFloatRegex @? "Contains hex float codeAction"
61-
, codeActionProperties "TExpectHexFloatFormat" [(4, 12)] $ \actions -> do
62-
liftIO $ length actions @?= 2
63-
liftIO $ actions `contains` hexFloatRegex @? "Does not contain hex float codeAction"
64-
, codeActionProperties "TExpectNoNumDecimalFormat" [(3, 16)] $ \actions -> do
49+
, codeActionProperties "TFindLiteralList" [(4, 28)] $ \actions -> do
6550
liftIO $ length actions @?= 2
66-
liftIO $ actions `doesNotContain` numDecimalRegex @? "Contains numDecimal codeAction"
67-
, codeActionProperties "TExpectNumDecimalFormat" [(4, 14)] $ \actions -> do
68-
liftIO $ length actions @?= 5
69-
liftIO $ actions `contains` numDecimalRegex @? "Contains numDecimal codeAction"
7051
, conversions
7152
]
7253

‎plugins/hls-alternate-number-format-plugin/test/testdata/TExpectBinaryFormat.hs

-4
This file was deleted.

‎plugins/hls-alternate-number-format-plugin/test/testdata/TExpectHexFloatFormat.hs

-4
This file was deleted.

‎plugins/hls-alternate-number-format-plugin/test/testdata/TExpectNoBinaryFormat.hs

-3
This file was deleted.

‎plugins/hls-alternate-number-format-plugin/test/testdata/TExpectNoHexFloatFormat.hs

-3
This file was deleted.

‎plugins/hls-alternate-number-format-plugin/test/testdata/TExpectNoNumDecimalFormat.hs

-3
This file was deleted.

‎plugins/hls-alternate-number-format-plugin/test/testdata/TExpectNumDecimalFormat.hs

-4
This file was deleted.

‎plugins/hls-alternate-number-format-plugin/test/testdata/TFindLiteralDoLet.hs

+1
Original file line numberDiff line numberDiff line change
@@ -1,3 +1,4 @@
1+
{-# LANGUAGE NoBinaryLiterals #-}
12
module TFindLiteralDoLet where
23

34
doLet :: IO ()

‎plugins/hls-alternate-number-format-plugin/test/testdata/TFindLiteralDoReturn.hs

+1
Original file line numberDiff line numberDiff line change
@@ -1,3 +1,4 @@
1+
{-# LANGUAGE NoBinaryLiterals #-}
12
module TFindLiteralDoReturn where
23

34
doReturn :: IO Integer

‎plugins/hls-alternate-number-format-plugin/test/testdata/TFindLiteralIntCase.hs

+1
Original file line numberDiff line numberDiff line change
@@ -1,3 +1,4 @@
1+
{-# LANGUAGE NoBinaryLiterals #-}
12
module TFindLiteralIntCase where
23

34
caseExpression x = case x + 34 of

‎plugins/hls-alternate-number-format-plugin/test/testdata/TFindLiteralIntCase2.hs

+1
Original file line numberDiff line numberDiff line change
@@ -1,3 +1,4 @@
1+
{-# LANGUAGE NoBinaryLiterals #-}
12
module TFindLiteralIntCase where
23

34
caseExpression x = case x of

‎plugins/hls-alternate-number-format-plugin/test/testdata/TFindLiteralIntPattern.hs

+1
Original file line numberDiff line numberDiff line change
@@ -1,3 +1,4 @@
1+
{-# LANGUAGE NoBinaryLiterals #-}
12
module TFindLiteralIntPattern where
23

34
patternMatchingFunction 1 = "one"

‎plugins/hls-alternate-number-format-plugin/test/testdata/TFindLiteralList.hs

+1
Original file line numberDiff line numberDiff line change
@@ -1,3 +1,4 @@
1+
{-# LANGUAGE NoBinaryLiterals #-}
12
module TFindLiteralList where
23

34
listTest = [reverse $ show 57]

0 commit comments

Comments
 (0)