diff --git a/CHANGES.txt b/CHANGES.txt
--- a/CHANGES.txt
+++ b/CHANGES.txt
@@ -1,5 +1,9 @@
 Changelog for HLint (* = breaking change)
 
+2.2.4, released 2019-11-02
+    Allow haskell-src-exts-1.22
+    #788, give less redundant context on unused variable capture
+    #334, add --ignore=glob flag
 2.2.3, released 2019-09-29
     #766, turn on more extensions when parsing config files
     #255, don't match variables with type application
diff --git a/hlint.cabal b/hlint.cabal
--- a/hlint.cabal
+++ b/hlint.cabal
@@ -1,7 +1,7 @@
 cabal-version:      >= 1.18
 build-type:         Simple
 name:               hlint
-version:            2.2.3
+version:            2.2.4
 license:            BSD3
 license-file:       LICENSE
 category:           Development
@@ -58,13 +58,14 @@
         cpphs >= 1.20.1,
         cmdargs >= 0.10,
         yaml >= 0.5.0,
-        haskell-src-exts >= 1.21 && < 1.22,
+        haskell-src-exts >= 1.21 && < 1.23,
         haskell-src-exts-util >= 0.2.5,
         uniplate >= 1.5,
         ansi-terminal >= 0.6.2,
         extra >= 1.6.6,
         refact >= 0.3,
         aeson >= 1.1.2.0,
+        filepattern >= 0.1.1,
         syb >= 0.7,
         mtl >= 2.2.2
     if !flag(ghc-lib) && impl(ghc >= 8.8.0) && impl(ghc < 8.9.0)
diff --git a/src/Apply.hs b/src/Apply.hs
--- a/src/Apply.hs
+++ b/src/Apply.hs
@@ -51,7 +51,7 @@
     [ map (classify classifiers . removeRequiresExtensionNotes (hseModule m)) $
         order [] (hintModule hints settings nm m) `merge`
         concat [order [fromNamed d] $ decHints d | d <- moduleDecls (hseModule m)] `merge`
-        concat [order (maybeToList $ declName $ GHC.unLoc d) $ decHints' d | d <- hsmodDecls $ GHC.unLoc $ ghcModule m]
+        concat [order (maybeToList $ declName d) $ decHints' d | d <- hsmodDecls $ GHC.unLoc $ ghcModule m]
     | (nm, m) <- mns
     , let classifiers = cls ++ mapMaybe readPragma (universeBi (hseModule m)) ++ concatMap readComment (ghcComments m)
     , seq (length classifiers) True -- to force any errors from readPragma or readComment
diff --git a/src/CmdLine.hs b/src/CmdLine.hs
--- a/src/CmdLine.hs
+++ b/src/CmdLine.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE PatternGuards, DeriveDataTypeable #-}
+{-# LANGUAGE PatternGuards, DeriveDataTypeable, TupleSections #-}
 {-# OPTIONS_GHC -fno-warn-missing-fields -fno-cse -O0 #-}
 
 module CmdLine(
@@ -28,6 +28,7 @@
 import System.IO.Error
 import System.Info.Extra
 import System.Process
+import System.FilePattern
 
 import Util
 import Paths_hlint
@@ -122,6 +123,7 @@
         ,cmdRefactor :: Bool            -- ^ Run the `refactor` executable to automatically perform hints
         ,cmdRefactorOptions :: String   -- ^ Options to pass to the `refactor` executable.
         ,cmdWithRefactor :: FilePath    -- ^ Path to refactor tool
+        ,cmdIgnoreGlob :: [FilePattern]
         }
     | CmdGrep
         {cmdFiles :: [FilePath]    -- ^ which files to run it on, nothing = none given
@@ -185,6 +187,7 @@
         ,cmdRefactor = nam_ "refactor" &= help "Automatically invoke `refactor` to apply hints"
         ,cmdRefactorOptions = nam_ "refactor-options" &= typ "OPTIONS" &= help "Options to pass to the `refactor` executable"
         ,cmdWithRefactor = nam_ "with-refactor" &= help "Give the path to refactor"
+        ,cmdIgnoreGlob = nam_ "ignore-glob" &= help "Ignore paths matching glob pattern"
         } &= auto &= explicit &= name "lint"
     ,CmdGrep
         {cmdFiles = def &= args &= typ "FILE/DIR"
@@ -265,20 +268,29 @@
     -> Maybe FilePath -- ^ Temporary file
     -> FilePath       -- ^ File to resolve, may be "-" for stdin
     -> IO [FilePath]
-resolveFile cmd = getFile (cmdPath cmd) (cmdExtension cmd)
+resolveFile cmd = getFile (toPredicate $ cmdIgnoreGlob cmd) (cmdPath cmd) (cmdExtension cmd)
+    where
+        toPredicate :: [FilePattern] -> FilePath -> Bool
+        toPredicate [] = const False
+        toPredicate globs = \x -> not $ null $ m [((), cleanup x)]
+            where m = matchMany (map ((),) globs)
 
+        cleanup :: FilePath -> FilePath
+        cleanup ('.':x:xs) | isPathSeparator x, not $ null xs = xs
+        cleanup x = x
 
-getFile :: [FilePath] -> [String] -> Maybe FilePath -> FilePath -> IO [FilePath]
-getFile path _ (Just tmpfile) "-" =
+
+getFile :: (FilePath -> Bool) -> [FilePath] -> [String] -> Maybe FilePath -> FilePath -> IO [FilePath]
+getFile _ path _ (Just tmpfile) "-" =
     -- make sure we don't reencode any Unicode
     BS.getContents >>= BS.writeFile tmpfile >> return [tmpfile]
-getFile path _ Nothing "-" = return ["-"]
-getFile [] exts _ file = exitMessage $ "Couldn't find file: " ++ file
-getFile (p:ath) exts t file = do
+getFile _ path _ Nothing "-" = return ["-"]
+getFile _ [] exts _ file = exitMessage $ "Couldn't find file: " ++ file
+getFile ignore (p:ath) exts t file = do
     isDir <- doesDirectoryExist $ p <\> file
     if isDir then do
         let avoidDir x = let y = takeFileName x in "_" `isPrefixOf` y || ("." `isPrefixOf` y && not (all (== '.') y))
-            avoidFile x = let y = takeFileName x in "." `isPrefixOf` y
+            avoidFile x = let y = takeFileName x in "." `isPrefixOf` y || ignore x
         xs <- listFilesInside (return . not . avoidDir) $ p <\> file
         return [x | x <- xs, drop 1 (takeExtension x) `elem` exts, not $ avoidFile x]
      else do
@@ -288,7 +300,7 @@
             res <- getModule p exts file
             case res of
                 Just x -> return [x]
-                Nothing -> getFile ath exts t file
+                Nothing -> getFile ignore ath exts t file
 
 
 getModule :: FilePath -> [String] -> FilePath -> IO (Maybe FilePath)
diff --git a/src/GHC/Util/HsDecl.hs b/src/GHC/Util/HsDecl.hs
--- a/src/GHC/Util/HsDecl.hs
+++ b/src/GHC/Util/HsDecl.hs
@@ -15,8 +15,8 @@
 -- 'Nothing' is returned instead.  This is useful because we don't
 -- want to tell users to rename binders that they aren't creating
 -- right now and therefore usually cannot change.
-declName :: HsDecl GhcPs -> Maybe String
-declName x = occNameString . occName <$> case x of
+declName :: LHsDecl GhcPs -> Maybe String
+declName (LL _ x) = occNameString . occName <$> case x of
     TyClD _ FamDecl{tcdFam=FamilyDecl{fdLName}} -> Just $ unLoc fdLName
     TyClD _ SynDecl{tcdLName} -> Just $ unLoc tcdLName
     TyClD _ DataDecl{tcdLName} -> Just $ unLoc tcdLName
@@ -30,3 +30,4 @@
     ForD _ ForeignImport{fd_name} -> Just $ unLoc fd_name
     ForD _ ForeignExport{fd_name} -> Just $ unLoc fd_name
     _ -> Nothing
+declName _ = Nothing {- COMPLETE LL-}
diff --git a/src/GHC/Util/HsExpr.hs b/src/GHC/Util/HsExpr.hs
--- a/src/GHC/Util/HsExpr.hs
+++ b/src/GHC/Util/HsExpr.hs
@@ -8,13 +8,14 @@
 
 module GHC.Util.HsExpr (
     noSyntaxExpr'
-  , isDol', isDot', isSection', isRecConstr', isRecUpdate', isVar', isPar', isApp', isAnyApp', isLexeme', isReturn'
+  , isTag', isDol', isDot', isSection', isRecConstr', isRecUpdate', isVar', isPar', isApp', isAnyApp', isLexeme', isReturn'
   , dotApp'
   , simplifyExp', niceLambda', niceDotApp'
   , Brackets'(..)
-  , rebracket1', appsBracket', transformAppsM', fromApps', apps', universeApps'
+  , rebracket1', appsBracket', transformAppsM', fromApps', apps', universeApps', universeParentExp'
   , varToStr', strToVar'
   , paren', fromChar'
+  , replaceBranches'
 ) where
 
 import HsSyn
@@ -63,20 +64,30 @@
   | isAtom' x  = x
   | otherwise = addParen' x
 
-isVar',isReturn',isLexeme',isDotApp',isRecUpdate',isRecConstr',isDol', isDot' :: LHsExpr GhcPs -> Bool
+-- 'True' if the provided expression is a variable with name 'tag'.
+isTag' :: LHsExpr GhcPs -> String -> Bool
+isTag' (LL _ (HsVar _ (L _ s))) tag = occNameString (rdrNameOcc s) == tag
+isTag' _ _ = False
+
+isVar',isReturn',isLexeme',isDotApp',isRecUpdate',isRecConstr',isDol',isDot' :: LHsExpr GhcPs -> Bool
 isPar' (LL _ HsPar{}) = True; isPar' _ = False
 isVar' (LL _ HsVar{}) = True; isVar' _ = False
-isDot' (LL _ (HsVar _ (LL _ ident))) = occNameString (rdrNameOcc ident) == "."; isDot' _ = False
-isDol' (LL _ (HsVar _ (L _ ident))) = occNameString (rdrNameOcc ident) == "$"; isDol' _ = False
+isDot' x = isTag' x "."
+isDol' x = isTag' x "$"
+isReturn' x = isTag' x "return" || isTag' x "pure" -- Allow both 'pure' and 'return' as they have the same semantics.
 isRecConstr' (LL _ RecordCon{}) = True; isRecConstr' _ = False
 isRecUpdate' (LL _ RecordUpd{}) = True; isRecUpdate' _ = False
 isDotApp' (LL _ (OpApp _ _ op _)) = isDot' op; isDotApp' _ = False
 isLexeme' (LL _ HsVar{}) = True;isLexeme' (LL _ HsOverLit{}) = True;isLexeme' (LL _ HsLit{}) = True;isLexeme' _ = False
--- Allow both 'pure' and 'return' as they have the same semantics.
-isReturn' (LL _ (HsVar _ (LL _ (Unqual x)))) = occNameString x == "return" || occNameString x == "pure"; isReturn' _ = False
 
 --
 
+universeParentExp' :: Data a => a -> [(Maybe (Int, LHsExpr GhcPs), LHsExpr GhcPs)]
+universeParentExp' xs = concat [(Nothing, x) : f x | x <- childrenBi xs]
+    where f p = concat [(Just (i,p), c) : f c | (i,c) <- zip [0..] $ children p]
+
+--
+
 apps' :: [LHsExpr GhcPs] -> LHsExpr GhcPs
 apps' = foldl1' mkApp where mkApp x y = noLoc (HsApp noExt x y)
 
@@ -222,3 +233,26 @@
 fromChar' :: LHsExpr GhcPs -> Maybe Char
 fromChar' (LL _ (HsLit _ (HsChar _ x))) = Just x
 fromChar' _ = Nothing
+
+--
+
+-- 'case' and 'if' expressions have branches, nothing else does (this
+-- doesn't consider 'HsMultiIf' perhaps it should?).
+replaceBranches' :: LHsExpr GhcPs -> ([LHsExpr GhcPs], [LHsExpr GhcPs] -> LHsExpr GhcPs)
+replaceBranches' (LL l (HsIf _ _ a b c)) = ([b, c], \[b, c] -> cL l (HsIf noExt Nothing a b c))
+
+replaceBranches' (LL s (HsCase _ a (MG _ (L l bs) FromSource))) =
+  (concatMap f bs, \xs -> cL s (HsCase noExt a (MG noExt (cL l (g bs xs)) Generated)))
+  where
+    f :: LMatch GhcPs (LHsExpr GhcPs) -> [LHsExpr GhcPs]
+    f (LL _ (Match _ CaseAlt _ (GRHSs _ xs _))) = [x | (LL _ (GRHS _ _ x)) <- xs]
+    f _ = undefined -- {-# COMPLETE LL #-}
+
+    g :: [LMatch GhcPs (LHsExpr GhcPs)] -> [LHsExpr GhcPs] -> [LMatch GhcPs (LHsExpr GhcPs)]
+    g (LL s1 (Match _ CaseAlt a (GRHSs _ ns b)) : rest) xs =
+      cL s1 (Match noExt CaseAlt a (GRHSs noExt [cL a (GRHS noExt gs x) | (LL a (GRHS _ gs _), x) <- zip ns as] b)) : g rest bs
+      where  (as, bs) = splitAt (length ns) xs
+    g [] [] = []
+    g _ _ = error "GHC.Util.HsExpr.replaceBranches': internal invariant failed, lists are of differing lengths"
+
+replaceBranches' x = ([], \[] -> x)
diff --git a/src/GHC/Util/Pat.hs b/src/GHC/Util/Pat.hs
--- a/src/GHC/Util/Pat.hs
+++ b/src/GHC/Util/Pat.hs
@@ -3,7 +3,7 @@
 module GHC.Util.Pat (
     strToPat', patToStr'
   , Brackets'(..)
-  , fromPChar', isPFieldWildcard', hasPFieldsDotDot'
+  , fromPChar', isPFieldWildcard', hasPFieldsDotDot', isPWildCard'
   ) where
 
 import HsSyn
@@ -42,3 +42,7 @@
 isPFieldWildcard' (LL _ HsRecField {hsRecPun=True}) = True
 isPFieldWildcard' (LL _ HsRecField {}) = False
 isPFieldWildcard' _ = False -- {-# COMPLETE LL #-}
+
+isPWildCard' :: Pat GhcPs -> Bool
+isPWildCard' (LL _ (WildPat _)) = True
+isPWildCard' _ = False
diff --git a/src/GHC/Util/View.hs b/src/GHC/Util/View.hs
--- a/src/GHC/Util/View.hs
+++ b/src/GHC/Util/View.hs
@@ -3,13 +3,14 @@
 module GHC.Util.View (
    fromParen', fromPParen'
   , View'(..)
-  , Var_'(Var_'), PVar_'(PVar_'), PApp_'(PApp_'), App2'(App2')
+  , Var_'(Var_'), PVar_'(PVar_'), PApp_'(PApp_'), App2'(App2'),LamConst1'(LamConst1')
 ) where
 
 import HsSyn
 import SrcLoc
 import RdrName
 import OccName
+import BasicTypes
 
 fromParen' :: LHsExpr GhcPs -> LHsExpr GhcPs
 fromParen' (LL _ (HsPar _ x)) = fromParen' x
@@ -26,6 +27,12 @@
 data PVar_' = NoPVar_' | PVar_' String
 data PApp_' = NoPApp_' | PApp_' String [Pat GhcPs]
 data App2'  = NoApp2'  | App2' (LHsExpr GhcPs) (LHsExpr GhcPs) (LHsExpr GhcPs)
+data LamConst1' = NoLamConst1' | LamConst1' (LHsExpr GhcPs)
+
+instance View' (LHsExpr GhcPs) LamConst1' where
+  view' (fromParen' -> (LL _ (HsLam _ (MG _ (L _ [LL _ (Match _ LambdaExpr [LL _ WildPat {}]
+    (GRHSs _ [LL _ (GRHS _ [] x)] (LL _ (EmptyLocalBinds _))))]) FromSource)))) = LamConst1' x
+  view' _ = NoLamConst1'
 
 instance View' (LHsExpr GhcPs) Var_' where
     view' (fromParen' -> (LL _ (HsVar _ (LL _ (Unqual x))))) = Var_' $ occNameString x
diff --git a/src/HSE/Match.hs b/src/HSE/Match.hs
--- a/src/HSE/Match.hs
+++ b/src/HSE/Match.hs
@@ -3,7 +3,7 @@
 module HSE.Match(
     View(..), Named(..),
     (~=), isSym,
-    App2(App2), LamConst1(LamConst1), PVar_(PVar_), Var_(Var_)
+    App2(App2), PVar_(PVar_), Var_(Var_)
     ) where
 
 import Data.Char
@@ -28,13 +28,6 @@
 instance View Exp_ App1 where
     view (fromParen -> App _ f x) = App1 f x
     view _ = NoApp1
-
--- \_ -> body
-data LamConst1 = NoLamConst1 | LamConst1 Exp_ deriving Show
-
-instance View Exp_ LamConst1 where
-    view (fromParen -> Lambda _ [PWildCard _] x) = LamConst1 x
-    view _ = NoLamConst1
 
 data PVar_ = NoPVar_ | PVar_ String
 
diff --git a/src/Hint/All.hs b/src/Hint/All.hs
--- a/src/Hint/All.hs
+++ b/src/Hint/All.hs
@@ -46,9 +46,7 @@
 builtin x = case x of
     -- Hse.
     HintExtensions -> modu extensionsHint
-    HintMonad      -> decl monadHint
     HintLambda     -> decl lambdaHint
-    HintPattern    -> decl patternHint
 
     -- Ghc.
     HintImport     -> modu importHint
@@ -64,6 +62,8 @@
     HintNaming     -> decl' namingHint
     HintBracket    -> decl' bracketHint
     HintSmell      -> mempty{hintDecl'=smellHint,hintModule=smellModuleHint}
+    HintPattern    -> decl' patternHint
+    HintMonad      -> decl' monadHint
     where
         wrap = timed "Hint" (drop 4 $ show x) . forceList
         decl f = mempty{hintDecl=const $ \a b c -> wrap $ f a b c}
diff --git a/src/Hint/Duplicate.hs b/src/Hint/Duplicate.hs
--- a/src/Hint/Duplicate.hs
+++ b/src/Hint/Duplicate.hs
@@ -51,9 +51,9 @@
          , let y = bagToList b
          ]
     where
-      ds = [(modName m, fromMaybe "" (declName d), d)
+      ds = [(modName m, fromMaybe "" (declName d), unLoc d)
            | ModuleEx _ _ m _ <- map snd ms
-           , d <- map unLoc (hsmodDecls (unLoc m))]
+           , d <- hsmodDecls (unLoc m)]
 
 dupes :: (Outputable e, Data e) => [(String, String, [Located e])] -> [Idea]
 dupes ys =
diff --git a/src/Hint/Export.hs b/src/Hint/Export.hs
--- a/src/Hint/Export.hs
+++ b/src/Hint/Export.hs
@@ -25,7 +25,7 @@
 exportHint _ (ModuleEx _ _ (LL s m@HsModule {hsmodName = Just name, hsmodExports = exports}) _)
   | Nothing <- exports =
       let r = o{ hsmodExports = Just (noLoc [noLoc (IEModuleContents noExt name)] )} in
-      [(ignore' "Use module export list" (L s o) (noLoc r) []){ideaNote = [Note "an explicit list is usally better"]}]
+      [(ignore' "Use module export list" (L s o) (noLoc r) []){ideaNote = [Note "an explicit list is usually better"]}]
   | Just (L _ xs) <- exports
   , mods <- [x | x <- xs, isMod x]
   , modName <- moduleNameString (unLoc name)
diff --git a/src/Hint/ListRec.hs b/src/Hint/ListRec.hs
--- a/src/Hint/ListRec.hs
+++ b/src/Hint/ListRec.hs
@@ -127,7 +127,8 @@
 asDo (view' ->
        App2' bind lhs
          (LL _ (HsLam _ MG {
-             mg_alts=LL _ [
+              mg_origin=FromSource
+            , mg_alts=LL _ [
                  LL _ Match {  m_ctxt=LambdaExpr
                             , m_pats=[LL _ v@VarPat{}]
                             , m_grhss=GRHSs _
@@ -148,7 +149,7 @@
 findCase x = do
   -- Match a function binding with two alternatives.
   (LL _ (ValD _ FunBind {fun_matches=
-              MG{mg_alts=
+              MG{mg_origin=FromSource, mg_alts=
                      (LL _
                             [ x1@(LL _ Match{..}) -- Match fields.
                             , x2]), ..} -- Match group fields.
diff --git a/src/Hint/Monad.hs b/src/Hint/Monad.hs
--- a/src/Hint/Monad.hs
+++ b/src/Hint/Monad.hs
@@ -1,5 +1,4 @@
 {-# LANGUAGE ViewPatterns, PatternGuards, FlexibleContexts #-}
-
 {-
     Find and match:
 
@@ -45,7 +44,7 @@
 main = do foo x; return 3; bar z -- do foo x; bar z
 main = void $ forM_ f xs -- forM_ f xs
 main = void $ forM f xs -- void $ forM_ f xs
-main = do _ <- forM_ f xs; bar -- do forM_ f xs; bar
+main = do _ <- forM_ f xs; bar -- forM_ f xs
 main = do bar; forM_ f xs; return () -- do bar; forM_ f xs
 main = do a; when b c; return () -- do a; when b c
 </TEST>
@@ -54,149 +53,172 @@
 
 module Hint.Monad(monadHint) where
 
-import Control.Applicative
+import Hint.Type(DeclHint',Idea,ideaNote,warn',toSS',suggest',Note(Note))
+
+import HsSyn
+import SrcLoc
+import BasicTypes
+import TcEvidence
+import RdrName
+import OccName
+import Bag
+import GHC.Util
+
 import Data.Tuple.Extra
 import Data.Maybe
 import Data.List.Extra
-import Hint.Type
-import Refact.Types
+import Refact.Types hiding (Match)
 import qualified Refact.Types as R
-import Prelude
 
-
 badFuncs :: [String]
 badFuncs = ["mapM","foldM","forM","replicateM","sequence","zipWithM","traverse","for","sequenceA"]
 unitFuncs :: [String]
 unitFuncs = ["when","unless","void"]
 
-
-monadHint :: DeclHint
-monadHint _ _ d = concatMap (monadExp d) $ universeParentExp d
-
-monadExp :: Decl_ -> (Maybe (Int, Exp_), Exp_) -> [Idea]
-monadExp (fromNamed -> decl) (parent, x) = case x of
-        (view -> App2 op x1 x2) | op ~= ">>" -> f x1
-        (view -> App2 op x1 (view -> LamConst1 _)) | op ~= ">>=" -> f x1
-        App an op x | op ~= "void" -> seenVoid (App an op) x
-        InfixApp an op dol x | op ~= "void", isDol dol -> seenVoid (InfixApp an op dol) x
-        Do an [Qualifier _ y] -> [warn "Redundant do" x y [Replace Expr (toSS x) [("y", toSS y)] "y"] | not $ doOperator parent y]
-        Do an xs ->
-            monadSteps (Do an) xs ++
-            [suggest "Use let" x (Do an y) rs | Just (y, rs) <- [monadLet xs]] ++
-            concat [f x | Qualifier _ x <- init xs] ++
-            concat [f x | Generator _ (PWildCard _) x <- init xs]
-        _ -> []
-    where
-        f = monadNoResult decl id
-        seenVoid wrap x = monadNoResult decl wrap x ++ [warn "Redundant void" (wrap x) x [] | returnsUnit x]
-
+monadHint :: DeclHint'
+monadHint _ _ d = concatMap (monadExp d) $ universeParentExp' d
 
+monadExp :: LHsDecl GhcPs -> (Maybe (Int, LHsExpr GhcPs), LHsExpr GhcPs) -> [Idea]
+monadExp (declName -> decl) (parent, x) =
+  case x of
+    (view' -> App2' op x1 x2) | isTag' op ">>" -> f x1
+    (view' -> App2' op x1 (view' -> LamConst1' _)) | isTag' op ">>=" -> f x1
+    (LL l (HsApp _ op x)) | isTag' op "void" -> seenVoid (cL l . HsApp noExt op) x
+    (LL l (OpApp _ op dol x)) | isTag' op "void", isDol' dol -> seenVoid (cL l . OpApp noExt op dol) x
+    (LL loc (HsDo _ _ (LL _ [LL _ (BodyStmt _ y _ _ )]))) -> [warn' "Redundant do" x y [Replace Expr (toSS' x) [("y", toSS' y)] "y"] | not $ doOperator parent y]
+    (LL loc (HsDo _ DoExpr (L _ xs))) ->
+      monadSteps (cL loc . HsDo noExt DoExpr . noLoc) xs ++
+      [suggest' "Use let" x (cL loc (HsDo noExt DoExpr (noLoc y)) :: LHsExpr GhcPs) rs | Just (y, rs) <- [monadLet xs]] ++
+      concat [f x | (LL _ (BodyStmt _ x _ _)) <- init xs] ++
+      concat [f x | (LL _ (BindStmt _ (LL _ WildPat{}) x _ _)) <- init xs]
+    _ -> []
+  where
+    f = monadNoResult (fromMaybe "" decl) id
+    seenVoid wrap x = monadNoResult (fromMaybe "" decl) wrap x ++ [warn' "Redundant void" (wrap x) x [] | returnsUnit x]
 
--- Sometimes people write a * do a + b, to avoid brackets
-doOperator :: (Eq a, Num a) => Maybe (a, Exp S) -> Exp l -> Bool
-doOperator (Just (1, InfixApp _ _ op _)) InfixApp{} | not $ isDol op = True
+-- Sometimes people write 'a * do a + b', to avoid brackets.
+doOperator :: (Eq a, Num a) => Maybe (a, LHsExpr GhcPs) -> LHsExpr GhcPs -> Bool
+doOperator (Just (2, LL _ (OpApp _ _ op _ )))  (LL _ OpApp {}) | not $ isDol' op = True
 doOperator _ _ = False
 
-
-returnsUnit :: Exp_ -> Bool
-returnsUnit (Paren _ x) = returnsUnit x
-returnsUnit (App _ x _) = returnsUnit x
-returnsUnit (InfixApp _ x op _) | isDol op = returnsUnit x
-returnsUnit (Var _ x) = any (x ~=) $ map (++ "_") badFuncs ++ unitFuncs
+returnsUnit :: LHsExpr GhcPs -> Bool
+returnsUnit (LL _ (HsPar _ x)) = returnsUnit x
+returnsUnit (LL _ (HsApp _ x _)) = returnsUnit x
+returnsUnit (LL _ (OpApp _ x op _)) | isDol' op = returnsUnit x
+returnsUnit (LL _ (HsVar _ (L _ x))) = occNameString (rdrNameOcc x) `elem` map (++ "_") badFuncs ++ unitFuncs
 returnsUnit _ = False
 
-
--- see through Paren and down if/case etc
--- return the name to use in the hint, and the revised expression
-monadNoResult :: String -> (Exp_ -> Exp_) -> Exp_ -> [Idea]
-monadNoResult inside wrap (Paren l x) = monadNoResult inside (wrap . Paren l) x
-monadNoResult inside wrap (App l x y) = monadNoResult inside (\x -> wrap $ App l x y) x
-monadNoResult inside wrap (InfixApp l x op y)
-    | isDol op = monadNoResult inside (\x -> wrap $ InfixApp l x op y) x
-    | op ~= ">>=" = monadNoResult inside (wrap . InfixApp l x op) y
+-- See through HsPar, and down HsIf/HsCase, return the name to use in
+-- the hint, and the revised expression.
+monadNoResult :: String -> (LHsExpr GhcPs -> LHsExpr GhcPs) -> LHsExpr GhcPs -> [Idea]
+monadNoResult inside wrap (LL l (HsPar _ x)) = monadNoResult inside (wrap . cL l . HsPar noExt) x
+monadNoResult inside wrap (LL l (HsApp _ x y)) = monadNoResult inside (\x -> wrap $ cL l (HsApp noExt x y)) x
+monadNoResult inside wrap (LL l (OpApp _ x tag@(LL _ (HsVar _ (L _ op))) y))
+    | isDol' tag = monadNoResult inside (\x -> wrap $ cL l (OpApp noExt x tag y)) x
+    | occNameString (rdrNameOcc op) == ">>=" = monadNoResult inside (wrap . cL l . OpApp noExt x tag) y
 monadNoResult inside wrap x
-    | x2:_ <- filter (x ~=) badFuncs
+    | x2 : _ <- filter (isTag' x) badFuncs
     , let x3 = x2 ++ "_"
-    = [warn ("Use " ++ x3) (wrap x) (wrap $ toNamed x3) [Replace Expr (toSS x) [] x3] | inside /= x3]
-monadNoResult inside wrap (replaceBranches -> (bs, rewrap)) =
+    = [warn' ("Use " ++ x3) (wrap x) (wrap $ strToVar' x3) [Replace Expr (toSS' x) [] x3] | inside /= x3]
+monadNoResult inside wrap (replaceBranches' -> (bs, rewrap)) =
     map (\x -> x{ideaNote=nubOrd $ Note "May require adding void to other branches" : ideaNote x}) $ concat
         [monadNoResult inside id b | b <- bs]
 
-
-monadStep :: ([Stmt S] -> Exp_) -> [Stmt S] -> [Idea]
+monadStep :: ([ExprLStmt GhcPs] -> LHsExpr GhcPs)
+           -> [ExprLStmt GhcPs] -> [Idea]
 
--- do return x; $2 ==> do $2
-monadStep wrap o@(Qualifier _ (fromRet -> Just (ret, _)):x:xs) =
-    [warn ("Redundant " ++ ret) (wrap o) (wrap $ x:xs) [Delete Stmt (toSS (head o))]]
+-- Rewrite 'do return x; $2' as 'do $2'.
+monadStep wrap o@(LL _ (BodyStmt _ (fromRet -> Just (ret, _)) _ _ ) : x : xs)
+  = [warn' ("Redundant " ++ ret) (wrap o) (wrap $ x:xs) [Delete Stmt (toSS' (head o))]]
 
--- do a <- $1; return a ==> do $1
-monadStep wrap o@[g@(Generator _ (PVar _ p) x), q@(Qualifier _ (fromRet -> Just (ret, Var _ v)))]
-    | fromNamed v == fromNamed p
-    = [warn ("Redundant " ++ ret) (wrap o) (wrap [Qualifier an x])
-            [Replace Stmt (toSS g) [("x", toSS x)] "x", Delete Stmt (toSS q)]]
+-- Rewrite 'do a <- $1; return a' as 'do $1'.
+monadStep wrap o@[ g@(LL _ (BindStmt _ (LL _ (VarPat _ (L _ p))) x _ _ ))
+                  , q@(LL _ (BodyStmt _ (fromRet -> Just (ret, LL _ (HsVar _ (L _ v)))) _ _))]
+  | occNameString (rdrNameOcc p) == occNameString (rdrNameOcc v)
+  = [warn' ("Redundant " ++ ret) (wrap o) (wrap [noLoc $ BodyStmt noExt x noSyntaxExpr' noSyntaxExpr'])
+      [Replace Stmt (toSS' g) [("x", toSS' x)] "x", Delete Stmt (toSS' q)]]
 
--- do x <- $1; x; $2  ==> do join $1; $2
-monadStep wrap o@(g@(Generator _ (view -> PVar_ p) x):q@(Qualifier _ (view -> Var_ v)):xs)
-    | p == v && v `notElem` varss xs
-    = [warn "Use join" (wrap o) (wrap $ Qualifier an (rebracket1 $ App an (toNamed "join") x):xs) r]
-    where r = [Replace Stmt (toSS g) [("x", toSS x)] "join x", Delete Stmt (toSS q)]
+-- Suggest to use join. Rewrite 'do x <- $1; x; $2' as 'do join $1; $2'.
+monadStep wrap o@(g@(LL _ (BindStmt _ (view' -> PVar_' p) x _ _)):q@(LL _ (BodyStmt _ (view' -> Var_' v) _ _)):xs)
+  | p == v && v `notElem` varss' xs
+  = let app = noLoc $ HsApp noExt (strToVar' "join") x
+        body = noLoc $ BodyStmt noExt (rebracket1' app) noSyntaxExpr' noSyntaxExpr'
+        stmts = body : xs
+    in [warn' "Use join" (wrap o) (wrap stmts) r]
+  where r = [Replace Stmt (toSS' g) [("x", toSS' x)] "join x", Delete Stmt (toSS' q)]
 
--- do _ <- <return ()>; $1 ==> do <return ()>; $1
-monadStep wrap o@(Generator an PWildCard{} x:rest)
-    | returnsUnit x
-    = [warn "Redundant variable capture" (wrap o) (wrap $ Qualifier an x : rest) []]
+-- Redundant variable capture. Rewrite 'do _ <- <return ()>; $1' as
+-- 'do <return ()>; $1'.
+monadStep wrap (o@(LL loc (BindStmt _ p x _ _)) : rest)
+    | isPWildCard' p, returnsUnit x
+    = let body = cL loc $ BodyStmt noExt x noSyntaxExpr' noSyntaxExpr' :: ExprLStmt GhcPs
+      in [warn' "Redundant variable capture" o body []]
 
--- do <return ()>; return ()
-monadStep wrap o@[Qualifier an x, Qualifier _ (fromRet -> Just (ret, unit))]
-    | returnsUnit x, unit ~= "()"
-    = [warn ("Redundant " ++ ret) (wrap o) (wrap $ take 1 o) []]
+-- Redundant unit return : 'do <return ()>; return ()'.
+monadStep
+  wrap o@[ LL _ (BodyStmt _ x _ _)
+         , LL _ (BodyStmt _ (fromRet -> Just (ret, LL _ (HsVar _ (L _ unit)))) _ _)]
+     | returnsUnit x, occNameString (rdrNameOcc unit) == "()"
+  = [warn' ("Redundant " ++ ret) (wrap o) (wrap $ take 1 o) []]
 
--- do x <- $1; return $ f $ g x ==> f . g <$> x
+-- Rewrite 'do x <- $1; return $ f $ g x' as 'f . g <$> x'
 monadStep wrap
-    o@[g@(Generator _ (view -> PVar_ u) x)
-      ,q@(Qualifier _ (fromApplies -> (ret:f:fs, view -> Var_ v)))]
-        | isReturn ret, notDol x, u == v, length fs < 3, all isSimple (f:fs), v `notElem` vars (f:fs)
-        = [warn "Use <$>" (wrap o) (wrap [Qualifier an (InfixApp an (foldl' (flip (InfixApp an) (toNamed ".")) f fs) (toNamed "<$>") x)])
-            [Replace Stmt (toSS g) (("x", toSS x):zip vs (toSS <$> f:fs)) (intercalate " . " (take (length fs + 1) vs) ++ " <$> x"), Delete Stmt (toSS q)]]
-    where
-        isSimple (fromApps -> xs) = all isAtom (x:xs)
-        vs = ('f':) . show <$> [0..]
-        notDol (InfixApp _ _ op _) = not $ isDol op
-        notDol _ = True
+  o@[g@(LL _ (BindStmt _ (view' -> PVar_' u) x _ _))
+    , q@(LL _ (BodyStmt _ (fromApplies -> (ret:f:fs, view' -> Var_' v)) _ _))]
+  | isReturn' ret, notDol x, u == v, length fs < 3, all isSimple (f : fs), v `notElem` vars' (f : fs)
+  =
+      [warn' "Use <$>" (wrap o) (wrap [noLoc $ BodyStmt noExt (noLoc $ OpApp noExt (foldl' (\acc e -> noLoc $ OpApp noExt acc (strToVar' ".") e) f fs) (strToVar' "<$>") x) noSyntaxExpr' noSyntaxExpr'])
+      [Replace Stmt (toSS' g) (("x", toSS' x):zip vs (toSS' <$> f:fs)) (intercalate " . " (take (length fs + 1) vs) ++ " <$> x"), Delete Stmt (toSS' q)]]
+  where
+    isSimple (fromApps' -> xs) = all isAtom' (x : xs)
+    vs = ('f':) . show <$> [0..]
 
+    notDol :: LHsExpr GhcPs -> Bool
+    notDol (LL _ (OpApp _ _ op _)) = not $ isDol' op
+    notDol _ = True
+
 monadStep _ _ = []
 
 -- Suggest removing a return
-monadSteps :: ([Stmt S] -> Exp_) -> [Stmt S] -> [Idea]
-monadSteps wrap (x:xs) = monadStep wrap (x:xs) ++ monadSteps (wrap . (x :)) xs
+monadSteps :: ([ExprLStmt GhcPs] -> LHsExpr GhcPs) -> [ExprLStmt GhcPs] -> [Idea]
+monadSteps wrap (x : xs) = monadStep wrap (x : xs) ++ monadSteps (wrap . (x :)) xs
 monadSteps _ _ = []
 
-
--- | do ...; x <- return y; ... ==> do ...; let x = y; ...
-monadLet :: [Stmt S] -> Maybe ([Stmt S], [Refactoring R.SrcSpan])
+-- | Rewrite 'do ...; x <- return y; ...' as 'do ...; let x = y; ...'.
+monadLet :: [ExprLStmt GhcPs] -> Maybe ([ExprLStmt GhcPs], [Refactoring R.SrcSpan])
 monadLet xs = if null rs then Nothing else Just (ys, rs)
-    where
-        (ys, catMaybes -> rs) = unzip $ map mkLet xs
-        vs = concatMap pvars [p | Generator _ p _ <- xs]
-        mkLet g@(Generator _ v@(view -> PVar_ p) (fromRet -> Just (_, y)))
-            | p `notElem` vars y, p `notElem` delete p vs
-            = (template (toNamed p) y, Just refact)
-         where
-            refact = Replace Stmt (toSS g) [("lhs", toSS v), ("rhs", toSS y)]
-                      (prettyPrint $ template (toNamed "lhs") (toNamed "rhs"))
-        mkLet x = (x, Nothing)
-        template lhs rhs = LetStmt an $ BDecls an [PatBind an lhs (UnGuardedRhs an rhs) Nothing]
+  where
+    (ys, catMaybes -> rs) = unzip $ map mkLet xs
+    vs = concatMap pvars' [p | (LL _ (BindStmt _ p _ _ _)) <- xs]
 
+    mkLet :: ExprLStmt GhcPs -> (ExprLStmt GhcPs, Maybe (Refactoring R.SrcSpan))
+    mkLet g@(LL _ (BindStmt _ v@(view' -> PVar_' p) (fromRet -> Just (_, y)) _ _ ))
+      | p `notElem` vars' y, p `notElem` delete p vs
+      = (template p y, Just refact)
+      where
+        refact = Replace Stmt (toSS' g) [("lhs", toSS' v), ("rhs", toSS' y)]
+                      (unsafePrettyPrint $ template "lhs" (strToVar' "rhs"))
+    mkLet x = (x, Nothing)
 
-fromApplies :: Exp_ -> ([Exp_], Exp_)
-fromApplies (App _ f x) = first (f:) $ fromApplies (fromParen x)
-fromApplies (InfixApp _ f (isDol -> True) x) = first (f:) $ fromApplies x
-fromApplies x = ([], x)
+    template :: String -> LHsExpr GhcPs -> ExprLStmt GhcPs
+    template lhs rhs =
+        let p = noLoc $ mkRdrUnqual (mkVarOcc lhs)
+            grhs = noLoc (GRHS noExt [] rhs)
+            grhss = GRHSs noExt [grhs] (noLoc (EmptyLocalBinds noExt))
+            match = noLoc $ Match noExt (FunRhs p Prefix NoSrcStrict) [] grhss
+            fb = noLoc $ FunBind noExt p (MG noExt (noLoc [match]) Generated) WpHole []
+            binds = unitBag fb
+            valBinds = ValBinds noExt binds []
+            localBinds = noLoc $ HsValBinds noExt valBinds
+         in noLoc $ LetStmt noExt localBinds
 
+fromApplies :: LHsExpr GhcPs -> ([LHsExpr GhcPs], LHsExpr GhcPs)
+fromApplies (LL _ (HsApp _ f x)) = first (f:) $ fromApplies (fromParen' x)
+fromApplies (LL _ (OpApp _ f (isDol' -> True) x)) = first (f:) $ fromApplies x
+fromApplies x = ([], x)
 
--- | Match @return x@ to @Just x@.
-fromRet :: Exp_ -> Maybe (String, Exp_)
-fromRet (Paren _ x) = fromRet x
-fromRet (InfixApp _ x y z) | opExp y ~= "$" = fromRet $ App an x z
-fromRet (App _ x y) | isReturn x = Just (prettyPrint x, y)
+fromRet :: LHsExpr GhcPs -> Maybe (String, LHsExpr GhcPs)
+fromRet (LL _ (HsPar _ x)) = fromRet x
+fromRet (LL _ (OpApp _ x (LL _ (HsVar _ (L _ y))) z)) | occNameString (rdrNameOcc y) == "$" = fromRet $ noLoc (HsApp noExt x z)
+fromRet (LL _ (HsApp _ x y)) | isReturn' x = Just (unsafePrettyPrint x, y)
 fromRet _ = Nothing
diff --git a/src/Hint/Naming.hs b/src/Hint/Naming.hs
--- a/src/Hint/Naming.hs
+++ b/src/Hint/Naming.hs
@@ -82,7 +82,7 @@
         replacedDecl = replaceNames suggestedNames originalDecl
 
 shorten :: LHsDecl GhcPs -> LHsDecl GhcPs
-shorten (LL locDecl (ValD ttg0 bind@(FunBind _ _ matchGroup@(MG _ (LL locMatches matches) _) _ _))) =
+shorten (LL locDecl (ValD ttg0 bind@(FunBind _ _ matchGroup@(MG _ (LL locMatches matches) FromSource) _ _))) =
     LL locDecl (ValD ttg0 bind {fun_matches = matchGroup {mg_alts = LL locMatches $ map shortenMatch matches}})
 shorten (LL locDecl (ValD ttg0 bind@(PatBind _ _ grhss@(GRHSs _ rhss _) _))) =
     LL locDecl (ValD ttg0 bind {pat_rhs = grhss {grhssGRHSs = map shortenLGRHS rhss}})
@@ -102,8 +102,7 @@
 shortenLGRHS x = x
 
 getNames :: LHsDecl GhcPs -> [String]
-getNames (LL _ decl) = maybeToList (declName decl) ++ getConstructorNames decl
-getNames _ = [] -- {-# COMPLETE LL #-}
+getNames decl = maybeToList (declName decl) ++ getConstructorNames (unLoc decl)
 
 getConstructorNames :: HsDecl GhcPs -> [String]
 getConstructorNames (TyClD _ (DataDecl _ _ _ _ (HsDataDefn _ _ _ _ _ cons _))) =
diff --git a/src/Hint/Pattern.hs b/src/Hint/Pattern.hs
--- a/src/Hint/Pattern.hs
+++ b/src/Hint/Pattern.hs
@@ -55,56 +55,41 @@
 
 module Hint.Pattern(patternHint) where
 
-import Hint.Type
+import Hint.Type(DeclHint',Idea,ghcAnnotations,ideaTo,toSS',toRefactSrcSpan,ghcSpanToHSE,suggest',warn')
+import Data.Generics.Uniplate.Operations
 import Data.Function
 import Data.List.Extra
 import Data.Tuple
 import Data.Maybe
 import Data.Either
-import Refact.Types hiding (RType(Pattern, Match))
+import Refact.Types hiding (RType(Pattern, Match), SrcSpan)
 import qualified Refact.Types as R (RType(Pattern, Match), SrcSpan)
 
+import HsSyn
+import SrcLoc
+import RdrName
+import OccName
+import Bag
+import BasicTypes
 
-patternHint :: DeclHint
-patternHint _ modu x =
+import GHC.Util
+
+patternHint :: DeclHint'
+patternHint _scope modu x =
     concatMap (uncurry hints . swap) (asPattern x) ++
-    -- PatBind (used in Let and Where) contains lazy-by-default patterns, everything else is strict
-    concatMap (patHint strict False) (universeBi [p | PatBind _ p _ _ <- universe x]) ++
-    concatMap (patHint strict True) (universeBi $ transform noPatBind x) ++
+    -- PatBind (used in 'let' and 'where') contains lazy-by-default
+    -- patterns, everything else is strict.
+    concatMap (patHint strict False) (located [p | PatBind _ p _ _ <- universeBi x :: [HsBind GhcPs]]) ++
+    concatMap (patHint strict True) (located (universeBi $ transformBi noPatBind x)) ++
     concatMap expHint (universeBi x)
-    where
-        noPatBind (PatBind a _ b c) = PatBind a (PWildCard a) b c
-        noPatBind x = x
-
-        strict = "Strict" `elem` [n | LanguagePragma _ ns <- modulePragmas (hseModule modu), Ident _ n <- ns]
-
+  where
+    located ps = [p | p@XPat{} <- ps]  -- restrict attention to patterns with locs
+    exts = nubOrd $ concatMap snd (langExts (pragmas (ghcAnnotations modu))) -- language extensions enabled at source
+    strict = "Strict" `elem` exts
 
-hints :: (String -> Pattern -> [Refactoring R.SrcSpan] -> Idea) -> Pattern -> [Idea]
-hints gen (Pattern l rtype pat (UnGuardedRhs d bod) bind)
-    | length guards > 2 = [gen "Use guards" (Pattern l rtype pat (GuardedRhss d guards) bind) [refactoring]]
-    where rawGuards = asGuards bod
-          mkGuard a = GuardedRhs an [Qualifier an a]
-          guards = map (uncurry mkGuard) rawGuards
-          (lhs, rhs) = unzip rawGuards
-          mkTemplate c ps =
-            -- Check if the expression has been injected or is natural
-            let checkAn p v = if ann p == an then Left p else Right ( c ++ [v], toSS p)
-            in zipWith checkAn ps ['1' .. '9']
-          patSubts = case pat of
-                       [p] -> [Left p] -- Substitution doesn't work properly for PatBinds
-                                       -- This will probably produce
-                                       -- unexpected results if the pattern
-                                       -- contains any template variables
-                       ps  -> mkTemplate "p100" ps
-          guardSubts = mkTemplate "g100" lhs
-          exprSubts  = mkTemplate "e100" rhs
-          templateGuards = zipWith (mkGuard `on` toString) guardSubts exprSubts
-          toString (Left e) = e
-          toString (Right (v, _)) = toNamed v
-          template = fromMaybe "" $ ideaTo (gen "" (Pattern l rtype (map toString patSubts) (GuardedRhss d templateGuards) bind) [])
-          f :: [Either a (String, R.SrcSpan)] -> [(String, R.SrcSpan)]
-          f = rights
-          refactoring = Replace rtype (toRefactSrcSpan $ srcInfoSpan l) (f patSubts ++ f guardSubts ++ f exprSubts) template
+    noPatBind :: LHsBind GhcPs -> LHsBind GhcPs
+    noPatBind (LL loc a@PatBind{}) = cL loc a{pat_lhs=noLoc (WildPat noExt)}
+    noPatBind x = x
 
 {-
 -- Do not suggest view patterns, they aren't something everyone likes sufficiently
@@ -118,81 +103,134 @@
         decsBind = nub $ concatMap declBind $ childrenBi bind
 -}
 
-hints gen (Pattern l t pats (GuardedRhss _ [GuardedRhs _ [test] bod]) bind)
-    | prettyPrint test `elem` ["otherwise","True"]
-    = [gen "Redundant guard" (Pattern l t pats (UnGuardedRhs an bod) bind) [Delete Stmt (toSS test)]]
+hints :: (String -> Pattern -> [Refactoring R.SrcSpan] -> Idea) -> Pattern -> [Idea]
+hints gen (Pattern l rtype pat (GRHSs _ [LL _ (GRHS _ [] bod)] bind))
+  | length guards > 2 = [gen "Use guards" (Pattern l rtype pat (GRHSs noExt guards bind)) [refactoring]]
+  where
+    rawGuards :: [(LHsExpr GhcPs, LHsExpr GhcPs)]
+    rawGuards = asGuards bod
 
-hints gen (Pattern l t pats bod (Just bind)) | f bind
-    = [gen "Redundant where" (Pattern l t pats bod Nothing) []]
-    where
-        f (BDecls _ x) = null x
-        f (IPBinds _ x) = null x
+    mkGuard :: LHsExpr GhcPs -> (LHsExpr GhcPs -> GRHS GhcPs (LHsExpr GhcPs))
+    mkGuard a = GRHS noExt [noLoc $ BodyStmt noExt a noSyntaxExpr' noSyntaxExpr']
 
-hints gen (Pattern l t pats (GuardedRhss _ (unsnoc -> Just (gs, GuardedRhs _ [test] bod))) bind)
-    | prettyPrint test == "True"
-    = [gen "Use otherwise" (Pattern l t pats (GuardedRhss an $ gs ++ [GuardedRhs an [Qualifier an $ toNamed "otherwise"] bod]) bind) [Replace Expr (toSS test) [] "otherwise"]]
+    guards :: [LGRHS GhcPs (LHsExpr GhcPs)]
+    guards = map (noLoc . uncurry mkGuard) rawGuards
 
-hints _ _ = []
+    (lhs, rhs) = unzip rawGuards
 
+    mkTemplate c ps =
+      -- Check if the expression has been injected or is natural.
+      zipWith checkLoc ps ['1' .. '9']
+      where
+        checkLoc p@(LL l _) v = if l == noSrcSpan then Left p else Right (c ++ [v], toSS' p)
+        checkLoc _ v = undefined -- {-# COMPLETE LL #-}
 
-asGuards :: Exp_ -> [(Exp S, Exp S)]
-asGuards (Paren _ x) = asGuards x
-asGuards (If _ a b c) = (a, b) : asGuards c
-asGuards x = [(toNamed "otherwise", x)]
+    patSubts =
+      case pat of
+        [p] -> [Left p] -- Substitution doesn't work properly for PatBinds.
+                        -- This will probably produce unexpected results if the pattern contains any template variables.
+        ps  -> mkTemplate "p100" ps
+    guardSubts = mkTemplate "g100" lhs
+    exprSubts  = mkTemplate "e100" rhs
+    templateGuards = map noLoc (zipWith (mkGuard `on` toString) guardSubts exprSubts)
 
+    toString (Left e) = e
+    toString (Right (v, _)) = strToVar' v
+    toString' (Left e) = e
+    toString' (Right (v, _)) = strToPat' v
 
-data Pattern = Pattern S R.RType [Pat_] (Rhs S) (Maybe (Binds S))
+    template = fromMaybe "" $ ideaTo (gen "" (Pattern l rtype (map toString' patSubts) (GRHSs noExt templateGuards bind)) [])
 
--- Invariant: Number of patterns may not change
-asPattern :: Decl_ -> [(Pattern, String -> Pattern -> [Refactoring R.SrcSpan] -> Idea)]
-asPattern x = concatMap decl (universeBi x) ++ concatMap alt (universeBi x)
-    where
-        decl o@(PatBind a pat rhs bind) = [(Pattern a Bind [pat] rhs bind, \msg (Pattern _ _ [pat] rhs bind) rs -> suggest msg o (PatBind a pat rhs bind) rs)]
-        decl (FunBind _ xs) = map match xs
-        decl _ = []
-        match o@(Match a b pat rhs bind) = (Pattern a R.Match pat rhs bind, \msg (Pattern _ _ pat rhs bind) rs -> suggest msg o (Match a b pat rhs bind) rs)
-        match o@(InfixMatch a p b ps rhs bind) = (Pattern a R.Match (p:ps) rhs bind, \msg (Pattern _ _ (p:ps) rhs bind) rs -> suggest msg o (InfixMatch a p b ps rhs bind) rs)
-        alt o@(Alt a pat rhs bind) = [(Pattern a R.Match [pat] rhs bind, \msg (Pattern _ _ [pat] rhs bind) rs -> suggest msg o (Alt a pat rhs bind) [])]
+    f :: [Either a (String, R.SrcSpan)] -> [(String, R.SrcSpan)]
+    f = rights
+    refactoring = Replace rtype (toRefactSrcSpan$ ghcSpanToHSE l) (f patSubts ++ f guardSubts ++ f exprSubts) template
+hints gen (Pattern l t pats o@(GRHSs _ [LL _ (GRHS _ [test] bod)] bind))
+  | unsafePrettyPrint test `elem` ["otherwise", "True"]
+  = [gen "Redundant guard" (Pattern l t pats o{grhssGRHSs=[noLoc (GRHS noExt [] bod)]}) [Delete Stmt (toSS' test)]]
+hints gen (Pattern l t pats bod@(GRHSs _ _ binds)) | f binds
+  = [gen "Redundant where" (Pattern l t pats bod{grhssLocalBinds=noLoc (EmptyLocalBinds noExt)}) []]
+  where
+    f :: LHsLocalBinds GhcPs -> Bool
+    f (LL _ (HsValBinds _ (ValBinds _ bag _))) = isEmptyBag bag
+    f (LL _ (HsIPBinds _ (IPBinds _ l))) = null l
+    f _ = False
+hints gen (Pattern l t pats o@(GRHSs _ (unsnoc -> Just (gs, LL _ (GRHS _ [test] bod))) binds))
+  | unsafePrettyPrint test == "True"
+  = let tag = noLoc (mkRdrUnqual $ mkVarOcc "otherwise")
+        otherwise_ = noLoc $ BodyStmt noExt (noLoc (HsVar noExt tag)) noSyntaxExpr' noSyntaxExpr' in
+      [gen "Use otherwise" (Pattern l t pats o{grhssGRHSs = gs ++ [noLoc (GRHS noExt [otherwise_] bod)]}) [Replace Expr (toSS' test) [] "otherwise"]]
+hints _ _ = []
 
+asGuards :: LHsExpr GhcPs -> [(LHsExpr GhcPs, LHsExpr GhcPs)]
+asGuards (LL _ (HsPar _ x)) = asGuards x
+asGuards (LL _ (HsIf _ _ a b c)) = (a, b) : asGuards c
+asGuards x = [(noLoc (HsVar noExt (noLoc (mkRdrUnqual $ mkVarOcc "otherwise"))), x)]
 
--- First Bool is if Strict is a language extension
--- Second Bool is if this pattern in this context is going to be evaluated strictly
-patHint :: Bool -> Bool -> Pat_ -> [Idea]
-patHint lang strict o@(PApp _ name args) | length args >= 3 && all isPWildCard args =
-  [suggest "Use record patterns" o (PRec an name []) [Replace R.Pattern (toSS o) [] (prettyPrint $ PRec an name [])] ]
-patHint lang strict o@(PVar _ v) | prettyPrint v == "otherwise" = [warn "Used otherwise as a pattern" o (PWildCard an) []]
+data Pattern = Pattern SrcSpan R.RType [Pat GhcPs] (GRHSs GhcPs (LHsExpr GhcPs))
 
-patHint lang strict o@(PBangPat _ x) | strict, f x = [warn "Redundant bang pattern" o x [r]]
-    where f (PParen _ x) = f x
-          f (PAsPat _ _ x) = f x
-          f PLit{} = True
-          f PApp{} = True
-          f PInfixApp{} = True
-          f PTuple{} = True
-          f PList{} = True
-          f PRec{} = True
-          f (PatTypeSig _ x _) = f x
-          f _ = False
-          r = Replace R.Pattern (toSS o) [("x", toSS x)] "x"
-patHint False strict o@(PIrrPat _ x) | f x = [warn "Redundant irrefutable pattern" o x [r]]
-    where f (PParen _ x) = f x
-          f (PAsPat _ _ x) = f x
-          f PWildCard{} = True
-          f PVar{} = True
-          f _ = False
-          r = Replace R.Pattern (toSS o) [("x", toSS x)] "x"
-patHint lang strict o@(PAsPat u v PWildCard{}) = [warn "Redundant as-pattern" o v []]
-patHint _ _ _ = []
+-- Invariant: Number of patterns may not change
+asPattern :: LHsDecl GhcPs  -> [(Pattern, String -> Pattern -> [Refactoring R.SrcSpan] -> Idea)]
+asPattern (LL loc x) = concatMap decl (universeBi x)
+  where
+    decl :: HsBind GhcPs -> [(Pattern, String -> Pattern -> [Refactoring R.SrcSpan] -> Idea)]
+    decl o@(PatBind _ pat rhs _) = [(Pattern loc Bind [pat] rhs, \msg (Pattern _ _ [pat] rhs) rs -> suggest' msg (cL loc o :: LHsBind GhcPs) (noLoc (PatBind noExt pat rhs ([], [])) :: LHsBind GhcPs) rs)]
+    decl (FunBind _ _ (MG _ (LL _ xs) _) _ _) = map match xs
+    decl _ = []
 
+    match :: LMatch GhcPs (LHsExpr GhcPs) -> (Pattern, String -> Pattern -> [Refactoring R.SrcSpan] -> Idea)
+    match o@(LL loc (Match _ ctx pats grhss)) = (Pattern loc R.Match pats grhss, \msg (Pattern _ _ pats grhss) rs -> suggest' msg o (noLoc (Match noExt ctx  pats grhss) :: LMatch GhcPs (LHsExpr GhcPs)) rs)
+    match _ = undefined -- {-# COMPLETE LL #-}
+asPattern _ = [] -- {-# COMPLETE LL #-}
 
-expHint :: Exp_ -> [Idea]
-expHint o@(Case _ _ [Alt _ PWildCard{} (UnGuardedRhs _ e) Nothing]) =
-  [suggest "Redundant case" o e [r]]
+-- First Bool is if 'Strict' is a language extension. Second Bool is
+-- if this pattern in this context is going to be evaluated strictly.
+patHint :: Bool -> Bool -> Pat GhcPs -> [Idea]
+patHint _ _ o@(LL _ (ConPatIn name (PrefixCon args)))
+  | length args >= 3 && all isPWildCard' args =
+  let rec_fields = HsRecFields [] Nothing :: HsRecFields GhcPs (Pat GhcPs)
+      new        = ConPatIn name (RecCon rec_fields) :: Pat GhcPs
+  in
+  [suggest' "Use record patterns" o new [Replace R.Pattern (toSS' o) [] (unsafePrettyPrint new)]]
+patHint _ _ o@(LL _ (VarPat _ (L _ name)))
+  | occNameString (rdrNameOcc name) == "otherwise" =
+    [warn' "Used otherwise as a pattern" o (noLoc (WildPat noExt) :: Pat GhcPs) []]
+patHint lang strict o@(LL _ (BangPat _ (LL _ x)))
+  | strict, f x = [warn' "Redundant bang pattern" o x [r]]
   where
-    r = Replace Expr (toSS o) [("x", toSS e)] "x"
-expHint o@(Case _ (Var _ x) [Alt _ (PVar _ y) (UnGuardedRhs _ e) Nothing])
-    | x =~= UnQual an y =
-      [suggest "Redundant case" o e [r]]
+    f :: Pat GhcPs -> Bool
+    f (ParPat _ (LL _ x)) = f x
+    f (AsPat _ _ (LL _ x)) = f x
+    f LitPat {} = True
+    f NPat {} = True
+    f ConPatIn {} = True
+    f TuplePat {} = True
+    f ListPat {} = True
+    f (SigPat _ (LL _ p) _) = f p
+    f _ = False
+    r = Replace R.Pattern (toSS' o) [("x", toSS' x)] "x"
+patHint False _ o@(LL _ (LazyPat _ (LL _ x)))
+  | f x = [warn' "Redundant irrefutable pattern" o x [r]]
   where
-    r = Replace Expr (toSS o) [("x", toSS e)] "x"
+    f :: Pat GhcPs -> Bool
+    f (ParPat _ (LL _ x)) = f x
+    f (AsPat _ _ (LL _ x)) = f x
+    f WildPat{} = True
+    f VarPat{} = True
+    f _ = False
+    r = Replace R.Pattern (toSS' o) [("x", toSS' x)] "x"
+patHint _ _ o@(LL _ (AsPat _ v (LL _ (WildPat _)))) =
+  [warn' "Redundant as-pattern" o v []]
+patHint _ _ _ = []
+
+expHint :: LHsExpr GhcPs -> [Idea]
+ -- Note the 'FromSource' in these equations (don't warn on generated match groups).
+expHint o@(LL _ (HsCase _ _ (MG _ (L _ [LL _ (Match _ CaseAlt [LL _ (WildPat _)] (GRHSs _ [LL _ (GRHS _ [] e)] (LL  _ (EmptyLocalBinds _)))) ]) FromSource ))) =
+  [suggest' "Redundant case" o e [r]]
+  where
+    r = Replace Expr (toSS' o) [("x", toSS' e)] "x"
+expHint o@(LL _ (HsCase _ (LL _ (HsVar _ (L _ x))) (MG _ (L _ [LL _ (Match _ CaseAlt [LL _ (VarPat _ (L _ y))] (GRHSs _ [LL _ (GRHS _ [] e)] (LL  _ (EmptyLocalBinds _)))) ]) FromSource )))
+  | occNameString (rdrNameOcc x) == occNameString (rdrNameOcc y) =
+      [suggest' "Redundant case" o e [r]]
+  where
+    r = Replace Expr (toSS' o) [("x", toSS' e)] "x"
 expHint _ = []
diff --git a/src/Hint/Restrict.hs b/src/Hint/Restrict.hs
--- a/src/Hint/Restrict.hs
+++ b/src/Hint/Restrict.hs
@@ -119,7 +119,7 @@
 checkFunctions modu decls (def, mp) =
     [ (ideaMessage riMessage $ ideaNoTo $ warn' "Avoid restricted function" x x []){ideaDecl = [dname]}
     | d <- decls
-    , let dname = fromMaybe "" (declName (unLoc d))
+    , let dname = fromMaybe "" (declName d)
     , x <- universeBi d :: [Located RdrName]
     , let ri@RestrictItem{..} = Map.findWithDefault (RestrictItem [] [("","") | def] Nothing) (occNameString (rdrNameOcc (unLoc x))) mp
     , not $ within modu dname ri
diff --git a/src/Hint/Smell.hs b/src/Hint/Smell.hs
--- a/src/Hint/Smell.hs
+++ b/src/Hint/Smell.hs
@@ -132,7 +132,8 @@
 declSpans
    (LL _ (ValD _
      FunBind {fun_matches=MG {
-                  mg_alts=(LL _ [LL _ Match {
+                   mg_origin=FromSource
+                 , mg_alts=(LL _ [LL _ Match {
                        m_ctxt=ctx
                      , m_grhss=GRHSs{grhssGRHSs=[locGrhs]
                                  , grhssLocalBinds=where_}}])}})) =
diff --git a/src/Hint/Unsafe.hs b/src/Hint/Unsafe.hs
--- a/src/Hint/Unsafe.hs
+++ b/src/Hint/Unsafe.hs
@@ -52,7 +52,7 @@
      -- 'x' does not declare a new function.
      | d@(ValD _
            FunBind {fun_id=L _ (Unqual x)
-                      , fun_matches=MG{mg_alts=L _ [L _ Match {m_pats=[]}]}}) <- [d]
+                      , fun_matches=MG{mg_origin=FromSource,mg_alts=L _ [L _ Match {m_pats=[]}]}}) <- [d]
      -- 'x' is a synonym for an appliciation involing 'unsafePerformIO'
      , isUnsafeDecl d
      -- 'x' is not marked 'NOINLINE'.
@@ -68,7 +68,7 @@
         ) <- hsmodDecls m]
 
 isUnsafeDecl :: HsDecl GhcPs -> Bool
-isUnsafeDecl (ValD _ FunBind {fun_matches=MG {mg_alts=LL _ alts}}) =
+isUnsafeDecl (ValD _ FunBind {fun_matches=MG {mg_origin=FromSource,mg_alts=LL _ alts}}) =
   any isUnsafeApp (childrenBi alts) || any isUnsafeDecl (childrenBi alts)
 isUnsafeDecl _ = False