Use extQ to choose parser.

- In the process of development, it was forgotten that the "parent" type
  of patterns and exprs is different. When traversal occurs, SYB would
  throw out `Pat` types as it was only expecting `HsExpr` types.

- Using `extQ` allows us to chain the expected types and we can then
  destructure patterns appropriately.

Author: drsooch

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

@@ -1,35 +1,31 @@
-{-# LANGUAGE DeriveGeneric     #-}
-{-# LANGUAGE DerivingVia       #-}
-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE RankNTypes        #-}
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE DeriveGeneric      #-}
+{-# LANGUAGE FlexibleInstances  #-}
+{-# LANGUAGE RankNTypes         #-}
 module Ide.Plugin.Literals (
     collectLiterals
     , Literal(..)
     , getSrcText
     , getSrcSpan
 ) where
 
-import           Data.Generics                 (mkQ)
-import           Data.Maybe                    (catMaybes, mapMaybe,
-                                                maybeToList)
-import           Data.Set                      (Set)
-import qualified Data.Set                      as S
+import           Data.Maybe                    (maybeToList)
 import           Data.Text                     (Text)
 import qualified Data.Text                     as T
 import           Development.IDE.GHC.Compat    hiding (getSrcSpan)
 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, listify)
+import           Generics.SYB                  (Data, Typeable, everything,
+                                                extQ)
 
 -- 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
 -- we currently don't have any use for PrimLiterals. They never have source text so we always drop them
 -- | Captures a Numeric Literals Location, Source Text, and Value.
-data Literal = IntLiteral      RealSrcSpan Text Integer
-             | FracLiteral     RealSrcSpan Text Rational
-             deriving (GHC.Generic, Show, Ord, Eq)
+data Literal = IntLiteral  RealSrcSpan Text Integer
+             | FracLiteral RealSrcSpan Text Rational
+             deriving (GHC.Generic, Show, Ord, Eq, Data)
 
 instance NFData RealSrcSpan where
     rnf x = x `seq` ()
@@ -49,33 +45,41 @@ getSrcSpan = \case
     FracLiteral ss _ _ -> ss
 
 -- | Find all literals in a Parsed Source File
-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
-
 collectLiterals :: (Data ast, Typeable ast) => ast -> [Literal]
-collectLiterals = everything (<>) (mkQ ([] :: [Literal]) (maybeToList . getLiteral))
+collectLiterals = everything (<>) (maybeToList . (const Nothing `extQ` getLiteral `extQ` getPattern))
 
 -- | 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
+getLiteral (L (RealSrcSpan sSpan _ ) expr) = case expr of
+    HsLit _ lit         -> fromLit lit sSpan
+    HsOverLit _ overLit -> fromOverLit overLit sSpan
+    _                   -> Nothing
+
+-- | Destructure Patterns to unwrap any Literals
+getPattern :: GenLocated SrcSpan (Pat GhcPs) -> Maybe Literal
+getPattern (L (UnhelpfulSpan _) _)       = Nothing
+getPattern (L (RealSrcSpan patSpan _) pat) = case pat of
+    LitPat _ lit -> case lit of
+        HsInt _ val   -> fromIntegralLit patSpan val
+        HsRat _ val _ -> fromFractionalLit patSpan val
+        _             -> Nothing
+    NPat _ (L (RealSrcSpan sSpan _) overLit) _ _ -> fromOverLit overLit sSpan
+    NPlusKPat _ _ (L (RealSrcSpan sSpan _) overLit1) _ _ _ -> fromOverLit overLit1 sSpan
+    _ -> Nothing
+
+fromLit :: HsLit p -> RealSrcSpan -> Maybe Literal
+fromLit lit sSpan = case lit of
         HsInt _ val   -> fromIntegralLit sSpan val
         HsRat _ val _ -> fromFractionalLit sSpan val
         _             -> Nothing
-    HsOverLit _ OverLit{..} -> case ol_val of
+
+fromOverLit :: HsOverLit p -> RealSrcSpan -> Maybe Literal
+fromOverLit OverLit{..} sSpan = case ol_val of
         HsIntegral il   -> fromIntegralLit sSpan il
         HsFractional fl -> fromFractionalLit sSpan fl
         _               -> Nothing
-    _             -> Nothing
+fromOverLit _ _ = Nothing
 
 fromIntegralLit :: RealSrcSpan -> IntegralLit -> Maybe Literal
 fromIntegralLit s (IL txt _ val) = fmap (\txt' -> IntLiteral s txt' val) (fromSourceText txt)