Use Set to remove duplicates from CollectLiterals Result.

Certain AST representations are traversed multiple times with the switch
to SYB. Using Set allows to easily remove duplicate Literals from our
result.

Added a test suite to monitor for regressions.

Author: drsooch

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

@@ -20,6 +20,7 @@ library
   build-depends:
       aeson
     , base                 >=4.12 && < 5
+    , containers
     , ghcide               >=1.5.0  && <1.6
     , ghc-boot-th
     , hls-graph
@@ -54,8 +55,9 @@ test-suite tests
     , filepath
     , hls-alternate-number-format-plugin
     , hls-test-utils       >=1.0 && <1.2
-    , regex-tdfa
+    , lsp
     , QuickCheck
+    , regex-tdfa
     , tasty-quickcheck
     , text
 

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

@@ -12,10 +12,10 @@ import qualified Data.HashMap.Strict                  as HashMap
 import           Data.Maybe                           (fromMaybe, isJust)
 import           Data.Text                            (Text)
 import qualified Data.Text                            as T
+import           Debug.Trace                          (traceM)
 import           Development.IDE                      (GetParsedModule (GetParsedModule),
                                                        IdeState, RuleResult,
                                                        Rules, define, ideLogger,
-                                                       noRange,
                                                        realSrcSpanToRange,
                                                        runAction, use,
                                                        useWithStale)
@@ -83,8 +83,7 @@ codeActionHandler state _ (CodeActionParams _ _ docId currRange _) = response $
         -- make a code action for every literal and its' alternates (then flatten the result)
         actions = concatMap (\(lit, alts) -> map (mkCodeAction nfp lit) alts) literalPairs
 
-    logIO state "Literals: "
-    mapM_ (logIO state) literals
+    logIO state $ "Literals: " <> show literals
 
     pure $ List actions
     where
@@ -108,7 +107,6 @@ codeActionHandler state _ (CodeActionParams _ _ docId currRange _) = response $
         mkWorkspaceEdit :: NormalizedFilePath -> Literal -> Text -> WorkspaceEdit
         mkWorkspaceEdit nfp lit alt = WorkspaceEdit changes Nothing Nothing
             where
-                -- NOTE: currently our logic filters our any noRange possibilities
                 txtEdit = TextEdit (realSrcSpanToRange $ getSrcSpan lit) alt
                 changes = Just $ HashMap.fromList [( filePathToUri $ fromNormalizedFilePath nfp, List [txtEdit])]
 
@@ -119,12 +117,6 @@ contains Range {_start, _end} x = isInsideRealSrcSpan _start x || isInsideRealSr
 isInsideRealSrcSpan :: Position -> RealSrcSpan -> Bool
 p `isInsideRealSrcSpan` r = let (Range sp ep) = realSrcSpanToRange r in sp <= p && p <= ep
 
--- a source span that provides no meaningful information is NOT a valid source span for our use case
-isRealSrcSpan :: SrcSpan -> Bool
-isRealSrcSpan (UnhelpfulSpan _) = False
-isRealSrcSpan _                 = True
-
-
 getNormalizedFilePath :: Monad m => TextDocumentIdentifier -> ExceptT String m NormalizedFilePath
 getNormalizedFilePath docId = handleMaybe "Error: converting to NormalizedFilePath"
         $ uriToNormalizedFilePath
@@ -138,5 +130,5 @@ requestLiterals state = handleMaybeM "Error: Could not get ParsedModule"
 
 
 logIO :: (MonadIO m, Show a) => IdeState -> a -> m ()
-logIO state = liftIO . Logger.logDebug (ideLogger state) . T.pack . show
+logIO state = liftIO . Logger.logInfo (ideLogger state) . T.pack . show
 

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

@@ -4,6 +4,8 @@
 {-# LANGUAGE RankNTypes        #-}
 module Ide.Plugin.Literals where
 import           Data.Maybe                    (fromMaybe, maybeToList)
+import           Data.Set                      (Set)
+import qualified Data.Set                      as S
 import           Data.Text                     (Text)
 import qualified Data.Text                     as T
 import           Development.IDE.GHC.Compat
@@ -18,7 +20,7 @@ import           Generics.SYB                  (Data, Typeable, cast,
 -- we currently don't have any use for PrimLiterals. They never have source text so we always drop them
 data Literal = IntLiteral      RealSrcSpan Text Integer
              | FracLiteral     RealSrcSpan Text Rational
-             deriving (GHC.Generic, Show)
+             deriving (GHC.Generic, Show, Ord, Eq)
 
 instance NFData RealSrcSpan where
     rnf x = x `seq` ()
@@ -37,46 +39,49 @@ getSrcSpan = \case
 
 -- | Find all literals in a Parsed Source File
 collectLiterals :: (Data ast, Typeable ast) => ast -> [Literal]
-collectLiterals = everything (<>) (mkQ2 ([] :: [Literal])  traverseLExpr traverseLPat)
+collectLiterals = S.toList . collectLiterals'
 
--- Located Patterns for whatever reason don't get picked up when using `(mkQ ([] :: [Literal]) traverseLExpr)
+collectLiterals' :: (Data ast, Typeable ast) => ast -> Set Literal
+collectLiterals' = everything (<>) (mkQ2 (S.empty :: Set Literal)  traverseLExpr traverseLPat)
+
+-- Located Patterns for whatever reason don't get picked up when using `(mkQ (S.empty :: Set Literal) traverseLExpr)
 -- as such we need to explicit traverse those in order to pull out any literals
 mkQ2 :: (Typeable a, Typeable b, Typeable c) => r -> (b -> r) -> (c -> r) -> a -> r
 mkQ2 def left right datum = case cast datum of
-  Just datum' -> left datum'
-  Nothing     -> maybe def right (cast datum)
+        Just datum' -> left datum'
+        Nothing     -> maybe def right (cast datum)
 
-traverseLPat :: GenLocated SrcSpan (Pat GhcPs) -> [Literal]
+traverseLPat :: GenLocated SrcSpan (Pat GhcPs) -> Set Literal
 traverseLPat (L sSpan pat) = traversePat sSpan pat
 
-traversePat :: SrcSpan -> Pat GhcPs -> [Literal]
+traversePat :: SrcSpan -> Pat GhcPs -> Set Literal
 traversePat sSpan = \case
     LitPat _ lit                             -> getLiteralAsList sSpan lit
     NPat _ (L olSpan overLit) sexpr1 sexpr2  -> getOverLiteralAsList olSpan overLit
-                                            <> collectLiterals sexpr1
-                                            <> collectLiterals sexpr2
+                                            <> collectLiterals' sexpr1
+                                            <> collectLiterals' sexpr2
     NPlusKPat _ _ (L olSpan loverLit) overLit sexpr1 sexpr2 -> getOverLiteralAsList olSpan loverLit
                                                     <> getOverLiteralAsList sSpan overLit
-                                                    <> collectLiterals sexpr1
-                                                    <> collectLiterals sexpr2
-    ast -> collectLiterals ast
+                                                    <> collectLiterals' sexpr1
+                                                    <> collectLiterals' sexpr2
+    ast -> collectLiterals' ast
 
-traverseLExpr :: GenLocated SrcSpan (HsExpr GhcPs) -> [Literal]
+traverseLExpr :: GenLocated SrcSpan (HsExpr GhcPs) -> Set Literal
 traverseLExpr (L sSpan hsExpr) = traverseExpr sSpan hsExpr
 
-traverseExpr :: SrcSpan -> HsExpr GhcPs -> [Literal]
+traverseExpr :: SrcSpan -> HsExpr GhcPs -> Set Literal
 traverseExpr sSpan = \case
       HsOverLit _ overLit -> getOverLiteralAsList sSpan overLit
       HsLit _ lit         -> getLiteralAsList sSpan lit
-      expr                -> collectLiterals expr
+      expr                -> collectLiterals' expr
 
-getLiteralAsList :: SrcSpan -> HsLit GhcPs -> [Literal]
+getLiteralAsList :: SrcSpan -> HsLit GhcPs -> Set Literal
 getLiteralAsList sSpan lit =  case sSpan of
     RealSrcSpan rss _ -> getLiteralAsList' lit rss
-    _                 -> []
+    _                 -> S.empty
 
-getLiteralAsList' :: HsLit GhcPs -> RealSrcSpan -> [Literal]
-getLiteralAsList' lit = maybeToList . flip getLiteral lit
+getLiteralAsList' :: HsLit GhcPs -> RealSrcSpan -> Set Literal
+getLiteralAsList' lit = maybe S.empty S.singleton . flip getLiteral lit
 
 -- Translate from Hs Type to our Literal type
 getLiteral :: RealSrcSpan -> HsLit GhcPs -> Maybe Literal
@@ -87,13 +92,13 @@ getLiteral sSpan = \case
   HsRat _ val _ -> fromFractionalLit sSpan val
   _             -> Nothing
 
-getOverLiteralAsList :: SrcSpan -> HsOverLit GhcPs -> [Literal]
+getOverLiteralAsList :: SrcSpan -> HsOverLit GhcPs -> Set Literal
 getOverLiteralAsList sSpan lit =  case sSpan of
     RealSrcSpan rss _ -> getOverLiteralAsList' lit rss
-    _                 -> []
+    _                 -> S.empty
 
-getOverLiteralAsList' :: HsOverLit GhcPs -> RealSrcSpan -> [Literal]
-getOverLiteralAsList' lit = maybeToList . flip getOverLiteral lit
+getOverLiteralAsList' :: HsOverLit GhcPs -> RealSrcSpan -> Set Literal
+getOverLiteralAsList' lit sSpan = maybe S.empty S.singleton (getOverLiteral sSpan lit)
 
 getOverLiteral :: RealSrcSpan -> HsOverLit GhcPs -> Maybe Literal
 getOverLiteral sSpan OverLit{..} = case ol_val of

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

@@ -3,14 +3,16 @@
 {-# LANGUAGE ViewPatterns   #-}
 module Main ( main ) where
 
-import           Control.Concurrent               (threadDelay)
+import           Data.Either                      (rights)
 import           Data.List                        (find)
 import           Data.Text                        (Text)
 import qualified Data.Text                        as T
 import           Debug.Trace
 import qualified Ide.Plugin.AlternateNumberFormat as AlternateNumberFormat
 import qualified Ide.Plugin.Conversion            as Conversion
-import           Properties.Conversion
+import           Language.LSP.Types               (toEither)
+import           Language.LSP.Types.Lens          (kind)
+import           Properties.Conversion            (conversions)
 import           System.FilePath                  ((</>))
 import           Test.Hls
 import           Text.Regex.TDFA                  ((=~))
@@ -21,32 +23,87 @@ main = defaultTestRunner test
 alternateNumberFormatPlugin :: PluginDescriptor IdeState
 alternateNumberFormatPlugin = AlternateNumberFormat.descriptor "alternateNumberFormat"
 
+
+-- NOTE: For whatever reason, this plugin does not play nice with creating Code Actions on time.
+-- As a result tests will mostly pass if `import Prelude` is added at the top. We (mostly fendor) surmise this has something
+-- to do with how
 test :: TestTree
 test = testGroup "alternateNumberFormat" [
-    -- codeActionHex "TIntDtoH" 4 13
-    conversions ]
+    codeActionHex "TIntDtoH" 3 13
+    , codeActionOctal "TIntDtoO" 3 13
+    , codeActionBinary "TIntDtoB" 4 13
+    , codeActionNumDecimal "TIntDtoND" 5 13
+    , codeActionFracExp "TFracDtoE" 3 13
+    , codeActionFloatHex "TFracDtoHF" 4 13
+    , codeActionDecimal "TIntHtoD" 3 13
+    , codeActionDecimal "TFracHFtoD" 4 13
+    , codeActionProperties "TFindLiteralIntPattern" [(3, 25), (4,25)] $ \actions -> do
+        liftIO $ length actions @?= 4
+    , codeActionProperties "TFindLiteralIntCase" [(3, 29)] $ \actions -> do
+        liftIO $ length actions @?= 2
+    , codeActionProperties "TFindLiteralIntCase2" [(4, 21)] $ \actions -> do
+        liftIO $ length actions @?= 2
+    , codeActionProperties "TFindLiteralDoReturn" [(5, 10)] $ \actions -> do
+        liftIO $ length actions @?= 2
+    , codeActionProperties "TFindLiteralDoLet" [(5, 13), (6, 13)] $ \actions -> do
+        liftIO $ length actions @?= 4
+    , codeActionProperties "TFindLiteralList" [(3, 28)] $ \actions -> do
+        liftIO $ length actions @?= 2
+    , conversions
+    ]
+
+codeActionProperties :: TestName -> [(Int, Int)] -> ([CodeAction] -> Session ()) -> TestTree
+codeActionProperties fp locs assertions = testCase fp $ do
+    runSessionWithServer alternateNumberFormatPlugin testDataDir $ do
+        openDoc (fp <> ".hs") "haskell" >>= codeActionsFromLocs >>= findAlternateNumberActions >>= assertions
+    where
+        -- similar to codeActionTest
+        codeActionsFromLocs doc = concat <$> mapM (getCodeActions doc . uncurry pointRange) locs
+
+findAlternateNumberActions :: [Command |? CodeAction] -> Session [CodeAction]
+findAlternateNumberActions = pure . filter isAlternateNumberCodeAction . rights . map toEither
+    where
+        isAlternateNumberCodeAction CodeAction{_kind} = case _kind of
+          Nothing -> False
+          Just kind -> case kind of
+            CodeActionUnknown txt -> txt == "alternate.style"
+            _                     -> False
+
+-- most helpers derived from explicit-imports-plugin Main Test file
 
 testDataDir :: FilePath
 testDataDir = "test" </> "testdata"
 
--- most helpers derived from explicit-imports-plugin Main Test file
-
 goldenAlternateFormat :: FilePath -> (TextDocumentIdentifier -> Session ()) -> TestTree
 goldenAlternateFormat fp = goldenWithHaskellDoc alternateNumberFormatPlugin (fp <> " (golden)") testDataDir fp "expected" "hs"
 
 codeActionTest :: (Maybe Text -> Bool) -> FilePath -> Int -> Int -> TestTree
 codeActionTest filter' fp line col = goldenAlternateFormat fp $ \doc -> do
-  -- _ <- waitForDiagnostics
   actions <- getCodeActions doc (pointRange line col)
-  traceM $ "Code actions: " ++ show actions
   -- can't generate code actions?
   case find (filter' . codeActionTitle) actions of
     Just (InR x) -> executeCodeAction x
     _            -> liftIO $ assertFailure "Unable to find CodeAction"
 
+
+codeActionDecimal :: FilePath -> Int -> Int -> TestTree
+codeActionDecimal = codeActionTest isDecimalCodeAction
+
 codeActionHex :: FilePath -> Int -> Int -> TestTree
 codeActionHex = codeActionTest isHexCodeAction
 
+codeActionOctal :: FilePath -> Int -> Int -> TestTree
+codeActionOctal = codeActionTest isOctalCodeAction
+
+codeActionBinary :: FilePath -> Int -> Int -> TestTree
+codeActionBinary = codeActionTest isBinaryCodeAction
+
+codeActionNumDecimal :: FilePath -> Int -> Int -> TestTree
+codeActionNumDecimal = codeActionTest isNumDecimalCodeAction
+
+codeActionFracExp :: FilePath -> Int -> Int -> TestTree
+codeActionFracExp = codeActionTest isNumDecimalCodeAction
+
 codeActionFloatHex :: FilePath -> Int -> Int -> TestTree
 codeActionFloatHex = codeActionTest isHexFloatCodeAction
 
@@ -86,6 +143,8 @@ isBinaryCodeAction = isCodeAction binaryRegex
 isOctalCodeAction :: Maybe Text -> Bool
 isOctalCodeAction = isCodeAction octalRegex
 
+-- This can match EITHER an integer as NumDecimal extension or a Fractional
+-- as in 1.23e-3 (so anything with an exponent really)
 isNumDecimalCodeAction :: Maybe Text -> Bool
 isNumDecimalCodeAction = isCodeAction numDecimalRegex
 

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

@@ -0,0 +1,7 @@
+module TFindLiteralDoLet where
+
+doLet :: IO ()
+doLet = do
+    let x = 199
+        y = 144
+    pure ()

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

@@ -0,0 +1,5 @@
+module TFindLiteralDoReturn where
+
+doReturn :: IO Integer
+doReturn = do
+    pure 54

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

@@ -0,0 +1,4 @@
+module TFindLiteralIntCase where
+
+caseExpression x = case x + 34 of
+                    _ -> "testing if we find a literal in the case statement"

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

@@ -0,0 +1,5 @@
+module TFindLiteralIntCase where
+
+caseExpression x = case x of
+                    57 -> "testing to find literals in matching cases"
+                    _  -> ""

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

@@ -0,0 +1,5 @@
+module TFindLiteralIntPattern where
+
+patternMatchingFunction 1 = "one"
+patternMatchingFunction 2 = "two"
+patternMatchingFunction _ = "the rest of the numbers"

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

@@ -0,0 +1,3 @@
+module TFindLiteralList where
+
+listTest = [reverse $ show 57]

plugins/hls-alternate-number-format-plugin/test/testdata/TFracDtoE.expected.hs

@@ -0,0 +1,3 @@
+module TFracDtoE where
+
+convertMe = 1.2345e2

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

@@ -0,0 +1,3 @@
+module TFracDtoE where
+
+convertMe = 123.45

plugins/hls-alternate-number-format-plugin/test/testdata/TFracDtoHF.expected.hs

@@ -0,0 +1,4 @@
+{-# LANGUAGE HexFloatLiterals #-}
+module TFracDtoHF where
+
+convertMe = 0x1.edccccccccccdp6

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

@@ -0,0 +1,4 @@
+{-# LANGUAGE HexFloatLiterals #-}
+module TFracDtoHF where
+
+convertMe = 123.45

plugins/hls-alternate-number-format-plugin/test/testdata/TFracHFtoD.expected.hs

@@ -0,0 +1,4 @@
+{-# LANGUAGE HexFloatLiterals #-}
+module TFracDtoHF where
+
+convertMe = 123.45

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

@@ -0,0 +1,4 @@
+{-# LANGUAGE HexFloatLiterals #-}
+module TFracDtoHF where
+
+convertMe = 0x1.edccccccccccdp6

plugins/hls-alternate-number-format-plugin/test/testdata/TIntDtoB.expected.hs

@@ -0,0 +1,4 @@
+{-# LANGUAGE BinaryLiterals #-}
+module TIntDtoB where
+
+convertMe = 0b1100

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

@@ -0,0 +1,4 @@
+{-# LANGUAGE BinaryLiterals #-}
+module TIntDtoB where
+
+convertMe = 12

plugins/hls-alternate-number-format-plugin/test/testdata/TIntDtoH.expected.hs

@@ -1,5 +1,3 @@
 module TIntDtoH where
 
-import Prelude
-
 convertMe = 0xC

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

@@ -1,5 +1,3 @@
 module TIntDtoH where
 
-import Prelude
-
 convertMe = 12

plugins/hls-alternate-number-format-plugin/test/testdata/TIntDtoND.expected.hs

@@ -0,0 +1,5 @@
+{-# LANGUAGE NumDecimals #-}
+module TIntDtoND where
+
+convertMe :: Integer
+convertMe = 125.345e3

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

@@ -0,0 +1,5 @@
+{-# LANGUAGE NumDecimals #-}
+module TIntDtoND where
+
+convertMe :: Integer
+convertMe = 125345

plugins/hls-alternate-number-format-plugin/test/testdata/TIntDtoO.expected.hs

@@ -0,0 +1,3 @@
+module TIntDtoO where
+
+convertMe = 0o14

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

@@ -0,0 +1,3 @@
+module TIntDtoO where
+
+convertMe = 12