Refactor collectLiterals in AlternateNumberFormat.

- Re-enable the alternateNumberFormat plugin

- Refactor collectLiterals to look for HsLit and HsOverLit directly
  rather than HsExpr.

- This new change removes the issue of finding duplicate Literal
  entries, as well as drastically reducing the time to parse

ISSUE:

- Currently the parsing only captures literals on the RHS of the
  function declaration. Patterns are not being matched properly. This
  was found in the prior iteration, but was remediated (at the cost of
  performance).

Author: drsooch

haskell-language-server.cabal

@@ -165,7 +165,7 @@ flag splice
 
 flag alternateNumberFormat
   description: Enable Alternate Number Format plugin
-  default:     False
+  default:     True
   manual:      True
 
 flag qualifyImportedNames

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

@@ -60,6 +60,7 @@ collectLiteralsRule = define $ \CollectLiterals nfp -> do
     let fmts = getFormatTypes <$> pm
         -- collect all the literals for a file
         lits = collectLiterals . pm_parsed_source <$> pm
+
     pure ([], CLR <$> lits <*> fmts)
     where
         getFormatTypes = toFormatTypes . toList . extensionFlags . ms_hspp_opts . pm_mod_summary
@@ -121,5 +122,5 @@ requestLiterals state = handleMaybeM "Error: Could not Collect Literals"
 
 
 logIO :: (MonadIO m, Show a) => IdeState -> a -> m ()
-logIO state = liftIO . Logger.logDebug (ideLogger state) . T.pack . show
+logIO state = liftIO . Logger.logError (ideLogger state) . T.pack . show
 

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

@@ -9,6 +9,9 @@ module Ide.Plugin.Literals (
     , getSrcSpan
 ) where
 
+import           Data.Generics                 (mkQ)
+import           Data.Maybe                    (catMaybes, mapMaybe,
+                                                maybeToList)
 import           Data.Set                      (Set)
 import qualified Data.Set                      as S
 import           Data.Text                     (Text)
@@ -18,7 +21,7 @@ import           Development.IDE.GHC.Util      (unsafePrintSDoc)
 import           Development.IDE.Graph.Classes (NFData (rnf))
 import qualified GHC.Generics                  as GHC
 import           Generics.SYB                  (Data, Typeable, cast,
-                                                everything)
+                                                everything, listify)
 
 -- data type to capture what type of literal we are dealing with
 -- provides location and possibly source text (for OverLits) as well as it's value
@@ -46,72 +49,33 @@ getSrcSpan = \case
     FracLiteral ss _ _ -> ss
 
 -- | Find all literals in a Parsed Source File
-collectLiterals :: (Data ast, Typeable ast) => ast -> [Literal]
-collectLiterals = S.toList . collectLiterals'
-
-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)
-
-traverseLPat :: GenLocated SrcSpan (Pat GhcPs) -> Set Literal
-traverseLPat (L sSpan pat) = traversePat sSpan pat
-
-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
-    NPlusKPat _ _ (L olSpan loverLit) overLit sexpr1 sexpr2 -> getOverLiteralAsList olSpan loverLit
-                                                    <> getOverLiteralAsList sSpan overLit
-                                                    <> collectLiterals' sexpr1
-                                                    <> collectLiterals' sexpr2
-    ast -> collectLiterals' ast
-
-traverseLExpr :: GenLocated SrcSpan (HsExpr GhcPs) -> Set Literal
-traverseLExpr (L sSpan hsExpr) = traverseExpr sSpan hsExpr
-
-traverseExpr :: SrcSpan -> HsExpr GhcPs -> Set Literal
-traverseExpr sSpan = \case
-      HsOverLit _ overLit -> getOverLiteralAsList sSpan overLit
-      HsLit _ lit         -> getLiteralAsList sSpan lit
-      expr                -> collectLiterals' expr
+collectLiterals' :: (Data ast, Typeable ast) => ast -> [Literal]
+collectLiterals' = mapMaybe getLiteral . listify isReal
+    where
+        isReal :: GenLocated SrcSpan (HsExpr GhcPs) -> Bool
+        isReal (L (RealSrcSpan _ _) lit) = case lit of
+            HsLit{}     -> True
+            HsOverLit{} -> True
+            _           -> False
+        isReal _                       = False
 
-getLiteralAsList :: SrcSpan -> HsLit GhcPs -> Set Literal
-getLiteralAsList sSpan lit =  case sSpan of
-    RealSrcSpan rss _ -> getLiteralAsList' lit rss
-    _                 -> S.empty
-
-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
-getLiteral sSpan = \case
-  HsInt _ val   -> fromIntegralLit sSpan val
-  HsRat _ val _ -> fromFractionalLit sSpan val
-  _             -> Nothing
-
-getOverLiteralAsList :: SrcSpan -> HsOverLit GhcPs -> Set Literal
-getOverLiteralAsList sSpan lit =  case sSpan of
-    RealSrcSpan rss _ -> getOverLiteralAsList' lit rss
-    _                 -> S.empty
-
-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
-  HsIntegral il   -> fromIntegralLit sSpan il
-  HsFractional fl -> fromFractionalLit sSpan fl
-  _               -> Nothing
-getOverLiteral _ _ = Nothing
+collectLiterals :: (Data ast, Typeable ast) => ast -> [Literal]
+collectLiterals = everything (<>) (mkQ ([] :: [Literal]) (maybeToList . getLiteral))
+
+-- | Translate from HsLit and HsOverLit Types to our Literal Type
+getLiteral :: GenLocated SrcSpan (HsExpr GhcPs) -> Maybe Literal
+getLiteral (L (UnhelpfulSpan _) _) = Nothing
+getLiteral (L (RealSrcSpan sSpan _ ) lit) = case lit of
+    -- only want
+    HsLit _ lit -> case lit of
+        HsInt _ val   -> fromIntegralLit sSpan val
+        HsRat _ val _ -> fromFractionalLit sSpan val
+        _             -> Nothing
+    HsOverLit _ OverLit{..} -> case ol_val of
+        HsIntegral il   -> fromIntegralLit sSpan il
+        HsFractional fl -> fromFractionalLit sSpan fl
+        _               -> Nothing
+    _             -> Nothing
 
 fromIntegralLit :: RealSrcSpan -> IntegralLit -> Maybe Literal
 fromIntegralLit s (IL txt _ val) = fmap (\txt' -> IntLiteral s txt' val) (fromSourceText txt)