{-# LANGUAGE ImportQualifiedPost #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE PatternGuards #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE ViewPatterns #-}

{-
    Find and match:

    mapM, foldM, forM, replicateM, sequence, zipWithM
    not at the last line of a do statement, or to the left of >>

    Use let x = y instead of x <- return y, unless x is contained
    within y, or bound more than once in that do block.

<TEST>
yes = do mapM print a; return b -- mapM_ print a
yes = do _ <- mapM print a; return b -- mapM_ print a
no = mapM print a
no = do foo ; mapM print a
yes = do (bar+foo) --
no = do bar ; foo
yes = do bar; a <- foo; return a -- do bar; foo
no = do bar; a <- foo; return b
yes = do x <- bar; x -- do join bar
no = do x <- bar; x; x
yes = do x <- bar; return (f x) -- do f <$> bar
yes = do x <- bar; return $ f x -- do f <$> bar
yes = do x <- bar; pure $ f x -- do f <$> bar
yes = do x <- bar; return $ f (g x) -- do f . g <$> bar
yes = do x <- bar; return (f $ g x) -- do f . g <$> bar
yes = do x <- bar $ baz; return (f $ g x)
no = do x <- bar; return (f x x)
{-# LANGUAGE RecursiveDo #-}; no = mdo hook <- mkTrigger pat (act >> rmHook hook) ; return hook
yes = do x <- return y; foo x -- @Suggestion let x = y
yes = do x <- return $ y + z; foo x -- let x = y + z
no = do x <- return x; foo x
no = do x <- return y; x <- return y; foo x
yes = do forM files $ \x -> return (); return () -- forM_ files $ \x -> return ()
yes = do if a then forM x y else return (); return 12 -- forM_ x y
yes = do case a of {_ -> forM x y; x:xs -> foo xs}; return () -- forM_ x y
foldM_ f a xs = foldM f a xs >> return ()
folder f a xs = foldM f a xs >> return () -- foldM_ f a xs
folder f a xs = foldM f a xs >>= \_ -> return () -- foldM_ f a xs
yes = mapM async ds >>= mapM wait >> return () -- mapM async ds >>= mapM_ wait
main = "wait" ~> do f a $ sleep 10
{-# LANGUAGE BlockArguments #-}; main = print do 17 + 25
{-# LANGUAGE BlockArguments #-}; main = print do 17 --
main = f $ do g a $ sleep 10 --
main = do f a $ sleep 10 -- @Ignore
main = do foo x; return 3; bar z --
main = void $ forM_ f xs -- forM_ f xs
main = void (forM_ f xs) -- forM_ f xs
main = void $ forM f xs -- forM_ f xs
main = void (forM f xs) -- forM_ f xs
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
bar = 1 * do {\x -> x+x} + y
issue978 = do \
   print "x" \
   if False then main else do \
   return ()
</TEST>
-}


module Hint.Monad(monadHint) where

import Hint.Type

import GHC.Hs hiding (Warning)
import GHC.Types.Fixity
import GHC.Types.SrcLoc
import GHC.Types.Basic
import GHC.Types.Name.Reader
import GHC.Types.Name.Occurrence
import GHC.Data.Bag
import GHC.Data.Strict qualified

import Language.Haskell.GhclibParserEx.GHC.Hs.Pat
import Language.Haskell.GhclibParserEx.GHC.Hs.Expr
import Language.Haskell.GhclibParserEx.GHC.Utils.Outputable
import Language.Haskell.GhclibParserEx.GHC.Types.Name.Reader
import GHC.Util

import Data.Generics.Uniplate.DataOnly
import Data.Tuple.Extra
import Data.Maybe
import Data.List.Extra
import Refact.Types hiding (Match)
import Refact.Types qualified as R


badFuncs :: [String]
badFuncs :: [String]
badFuncs = [String
"mapM",String
"foldM",String
"forM",String
"replicateM",String
"sequence",String
"zipWithM",String
"traverse",String
"for",String
"sequenceA"]
unitFuncs :: [String]
unitFuncs :: [String]
unitFuncs = [String
"when",String
"unless",String
"void"]

monadHint :: DeclHint
monadHint :: DeclHint
monadHint Scope
_ ModuleEx
_ LHsDecl GhcPs
d = (GenLocated SrcSpanAnnA (HsExpr GhcPs) -> [Idea])
-> [GenLocated SrcSpanAnnA (HsExpr GhcPs)] -> [Idea]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> Maybe (Int, GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> [Idea]
f Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall a. Maybe a
Nothing Maybe (Int, GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall a. Maybe a
Nothing) ([GenLocated SrcSpanAnnA (HsExpr GhcPs)] -> [Idea])
-> [GenLocated SrcSpanAnnA (HsExpr GhcPs)] -> [Idea]
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpanAnnA (HsDecl GhcPs)
-> [GenLocated SrcSpanAnnA (HsExpr GhcPs)]
forall from to. Biplate from to => from -> [to]
childrenBi LHsDecl GhcPs
GenLocated SrcSpanAnnA (HsDecl GhcPs)
d
    where
        decl :: Maybe String
decl = LHsDecl GhcPs -> Maybe String
declName LHsDecl GhcPs
d
        f :: Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> Maybe (Int, GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> [Idea]
f Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs))
parentDo Maybe (Int, GenLocated SrcSpanAnnA (HsExpr GhcPs))
parentExpr GenLocated SrcSpanAnnA (HsExpr GhcPs)
x =
            Maybe String
-> Maybe (LHsExpr GhcPs)
-> Maybe (Int, LHsExpr GhcPs)
-> LHsExpr GhcPs
-> [Idea]
monadExp Maybe String
decl Maybe (LHsExpr GhcPs)
Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs))
parentDo Maybe (Int, LHsExpr GhcPs)
Maybe (Int, GenLocated SrcSpanAnnA (HsExpr GhcPs))
parentExpr LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
x [Idea] -> [Idea] -> [Idea]
forall a. [a] -> [a] -> [a]
++
            [[Idea]] -> [Idea]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> Maybe (Int, GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> [Idea]
f (if GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Bool
forall {l} {p}. GenLocated l (HsExpr p) -> Bool
isHsDo GenLocated SrcSpanAnnA (HsExpr GhcPs)
x then GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall a. a -> Maybe a
Just GenLocated SrcSpanAnnA (HsExpr GhcPs)
x else Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs))
parentDo) ((Int, GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> Maybe (Int, GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall a. a -> Maybe a
Just (Int
i, GenLocated SrcSpanAnnA (HsExpr GhcPs)
x)) GenLocated SrcSpanAnnA (HsExpr GhcPs)
c | (Int
i, GenLocated SrcSpanAnnA (HsExpr GhcPs)
c) <- Int
-> [GenLocated SrcSpanAnnA (HsExpr GhcPs)]
-> [(Int, GenLocated SrcSpanAnnA (HsExpr GhcPs))]
forall a b. Enum a => a -> [b] -> [(a, b)]
zipFrom Int
0 ([GenLocated SrcSpanAnnA (HsExpr GhcPs)]
 -> [(Int, GenLocated SrcSpanAnnA (HsExpr GhcPs))])
-> [GenLocated SrcSpanAnnA (HsExpr GhcPs)]
-> [(Int, GenLocated SrcSpanAnnA (HsExpr GhcPs))]
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> [GenLocated SrcSpanAnnA (HsExpr GhcPs)]
forall on. Uniplate on => on -> [on]
children GenLocated SrcSpanAnnA (HsExpr GhcPs)
x]

        isHsDo :: GenLocated l (HsExpr p) -> Bool
isHsDo (L l
_ HsDo{}) = Bool
True
        isHsDo GenLocated l (HsExpr p)
_ = Bool
False


-- | Call with the name of the declaration,
--   the nearest enclosing `do` expression
--   the nearest enclosing expression
--   the expression of interest
monadExp :: Maybe String -> Maybe (LHsExpr GhcPs) -> Maybe (Int, LHsExpr GhcPs) -> LHsExpr GhcPs -> [Idea]
monadExp :: Maybe String
-> Maybe (LHsExpr GhcPs)
-> Maybe (Int, LHsExpr GhcPs)
-> LHsExpr GhcPs
-> [Idea]
monadExp Maybe String
decl Maybe (LHsExpr GhcPs)
parentDo Maybe (Int, LHsExpr GhcPs)
parentExpr LHsExpr GhcPs
x =
  case LHsExpr GhcPs
x of
    (LHsExpr GhcPs -> App2
GenLocated SrcSpanAnnA (HsExpr GhcPs) -> App2
forall a b. View a b => a -> b
view -> App2 GenLocated SrcSpanAnnA (HsExpr GhcPs)
op GenLocated SrcSpanAnnA (HsExpr GhcPs)
x1 GenLocated SrcSpanAnnA (HsExpr GhcPs)
x2) | String -> LHsExpr GhcPs -> Bool
isTag String
">>" LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
op -> GenLocated SrcSpanAnnA (HsExpr GhcPs) -> [Idea]
f GenLocated SrcSpanAnnA (HsExpr GhcPs)
x1
    (LHsExpr GhcPs -> App2
GenLocated SrcSpanAnnA (HsExpr GhcPs) -> App2
forall a b. View a b => a -> b
view -> App2 GenLocated SrcSpanAnnA (HsExpr GhcPs)
op GenLocated SrcSpanAnnA (HsExpr GhcPs)
x1 (GenLocated SrcSpanAnnA (HsExpr GhcPs) -> LamConst1
forall a b. View a b => a -> b
view -> LamConst1 GenLocated SrcSpanAnnA (HsExpr GhcPs)
_)) | String -> LHsExpr GhcPs -> Bool
isTag String
">>=" LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
op -> GenLocated SrcSpanAnnA (HsExpr GhcPs) -> [Idea]
f GenLocated SrcSpanAnnA (HsExpr GhcPs)
x1
    (L SrcSpanAnnA
l (HsApp XApp GhcPs
_ LHsExpr GhcPs
op LHsExpr GhcPs
x)) | String -> LHsExpr GhcPs -> Bool
isTag String
"void" LHsExpr GhcPs
op -> (GenLocated SrcSpanAnnA (HsExpr GhcPs)
 -> GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> GenLocated SrcSpanAnnA (HsExpr GhcPs) -> [Idea]
forall {e} {a}.
Outputable e =>
(GenLocated SrcSpanAnnA (HsExpr GhcPs) -> LocatedAn a e)
-> GenLocated SrcSpanAnnA (HsExpr GhcPs) -> [Idea]
seenVoid (SrcSpanAnnA
-> HsExpr GhcPs -> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l (HsExpr GhcPs -> GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> (GenLocated SrcSpanAnnA (HsExpr GhcPs) -> HsExpr GhcPs)
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XApp GhcPs -> LHsExpr GhcPs -> LHsExpr GhcPs -> HsExpr GhcPs
forall p. XApp p -> LHsExpr p -> LHsExpr p -> HsExpr p
HsApp XApp GhcPs
EpAnn NoEpAnns
forall ann. EpAnn ann
EpAnnNotUsed LHsExpr GhcPs
op) LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
x
    (L SrcSpanAnnA
l (OpApp XOpApp GhcPs
_ LHsExpr GhcPs
op LHsExpr GhcPs
dol LHsExpr GhcPs
x)) | String -> LHsExpr GhcPs -> Bool
isTag String
"void" LHsExpr GhcPs
op, LHsExpr GhcPs -> Bool
isDol LHsExpr GhcPs
dol -> (GenLocated SrcSpanAnnA (HsExpr GhcPs)
 -> GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> GenLocated SrcSpanAnnA (HsExpr GhcPs) -> [Idea]
forall {e} {a}.
Outputable e =>
(GenLocated SrcSpanAnnA (HsExpr GhcPs) -> LocatedAn a e)
-> GenLocated SrcSpanAnnA (HsExpr GhcPs) -> [Idea]
seenVoid (SrcSpanAnnA
-> HsExpr GhcPs -> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l (HsExpr GhcPs -> GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> (GenLocated SrcSpanAnnA (HsExpr GhcPs) -> HsExpr GhcPs)
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XOpApp GhcPs
-> LHsExpr GhcPs -> LHsExpr GhcPs -> LHsExpr GhcPs -> HsExpr GhcPs
forall p.
XOpApp p -> LHsExpr p -> LHsExpr p -> LHsExpr p -> HsExpr p
OpApp XOpApp GhcPs
EpAnn [AddEpAnn]
forall ann. EpAnn ann
EpAnnNotUsed LHsExpr GhcPs
op LHsExpr GhcPs
dol) LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
x
    (L SrcSpanAnnA
loc (HsDo XDo GhcPs
_ HsDoFlavour
ctx (L SrcSpanAnnL
loc2 [L SrcSpanAnnA
loc3 (BodyStmt XBodyStmt GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
_ GenLocated SrcSpanAnnA (HsExpr GhcPs)
y SyntaxExpr GhcPs
_ SyntaxExpr GhcPs
_ )]))) ->
      let doOrMDo :: String
doOrMDo = case HsDoFlavour
ctx of MDoExpr Maybe ModuleName
_ -> String
"mdo"; HsDoFlavour
_ -> String
"do"
       in [ Severity
-> String -> SrcSpan -> String -> [Refactoring SrcSpan] -> Idea
ideaRemove Severity
Ignore (String
"Redundant " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
doOrMDo) (String -> SrcSpan -> SrcSpan
forall {t :: * -> *} {a}. Foldable t => t a -> SrcSpan -> SrcSpan
doSpan String
doOrMDo (SrcSpanAnnA -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
loc)) String
doOrMDo [RType
-> SrcSpan -> [(String, SrcSpan)] -> String -> Refactoring SrcSpan
forall a. RType -> a -> [(String, a)] -> String -> Refactoring a
Replace RType
Expr (GenLocated SrcSpanAnnA (HsExpr GhcPs) -> SrcSpan
forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
toSSA LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
x) [(String
"y", GenLocated SrcSpanAnnA (HsExpr GhcPs) -> SrcSpan
forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
toSSA GenLocated SrcSpanAnnA (HsExpr GhcPs)
y)] String
"y"]
          | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Maybe (Int, LHsExpr GhcPs) -> LHsExpr GhcPs -> Bool
doAsBrackets Maybe (Int, LHsExpr GhcPs)
parentExpr LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
y
          , Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Maybe (LHsExpr GhcPs) -> LHsExpr GhcPs -> Bool
doAsAvoidingIndentation Maybe (LHsExpr GhcPs)
parentDo LHsExpr GhcPs
x
          ]
    (L SrcSpanAnnA
loc (HsDo XDo GhcPs
_ (DoExpr Maybe ModuleName
mm) (L SrcSpanAnnL
_ [GenLocated
   SrcSpanAnnA
   (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
xs))) ->
      ([ExprLStmt GhcPs] -> LHsExpr GhcPs) -> [ExprLStmt GhcPs] -> [Idea]
monadSteps (SrcSpanAnnA
-> HsExpr GhcPs -> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
loc (HsExpr GhcPs -> GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> ([GenLocated
       SrcSpanAnnA
       (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
    -> HsExpr GhcPs)
-> [GenLocated
      SrcSpanAnnA
      (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XDo GhcPs
-> HsDoFlavour -> XRec GhcPs [ExprLStmt GhcPs] -> HsExpr GhcPs
forall p. XDo p -> HsDoFlavour -> XRec p [ExprLStmt p] -> HsExpr p
HsDo XDo GhcPs
EpAnn AnnList
forall ann. EpAnn ann
EpAnnNotUsed (Maybe ModuleName -> HsDoFlavour
DoExpr Maybe ModuleName
mm) (GenLocated
   SrcSpanAnnL
   [GenLocated
      SrcSpanAnnA
      (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
 -> HsExpr GhcPs)
-> ([GenLocated
       SrcSpanAnnA
       (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
    -> GenLocated
         SrcSpanAnnL
         [GenLocated
            SrcSpanAnnA
            (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))])
-> [GenLocated
      SrcSpanAnnA
      (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> HsExpr GhcPs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [GenLocated
   SrcSpanAnnA
   (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> GenLocated
     SrcSpanAnnL
     [GenLocated
        SrcSpanAnnA
        (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
forall a an. a -> LocatedAn an a
noLocA) [ExprLStmt GhcPs]
[GenLocated
   SrcSpanAnnA
   (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
xs [Idea] -> [Idea] -> [Idea]
forall a. [a] -> [a] -> [a]
++
      [String
-> Located
     (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> Located
     (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> [Refactoring SrcSpan]
-> Idea
forall a b.
(Outputable a, Outputable b) =>
String -> Located a -> Located b -> [Refactoring SrcSpan] -> Idea
suggest String
"Use let" (GenLocated
  SrcSpanAnnA
  (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> Located
     (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
forall a e. LocatedAn a e -> Located e
reLoc GenLocated
  SrcSpanAnnA
  (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
from) (GenLocated
  SrcSpanAnnA
  (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> Located
     (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
forall a e. LocatedAn a e -> Located e
reLoc GenLocated
  SrcSpanAnnA
  (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
to) [Refactoring SrcSpan
r] | (GenLocated
  SrcSpanAnnA
  (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
from, GenLocated
  SrcSpanAnnA
  (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
to, Refactoring SrcSpan
r) <- [ExprLStmt GhcPs]
-> [(ExprLStmt GhcPs, ExprLStmt GhcPs, Refactoring SrcSpan)]
monadLet [ExprLStmt GhcPs]
[GenLocated
   SrcSpanAnnA
   (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
xs] [Idea] -> [Idea] -> [Idea]
forall a. [a] -> [a] -> [a]
++
      [[Idea]] -> [Idea]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [GenLocated SrcSpanAnnA (HsExpr GhcPs) -> [Idea]
f GenLocated SrcSpanAnnA (HsExpr GhcPs)
x | (L SrcSpanAnnA
_ (BodyStmt XBodyStmt GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
_ GenLocated SrcSpanAnnA (HsExpr GhcPs)
x SyntaxExpr GhcPs
_ SyntaxExpr GhcPs
_)) <- [GenLocated
   SrcSpanAnnA
   (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> [GenLocated
      SrcSpanAnnA
      (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
forall a. [a] -> [a]
dropEnd1 [GenLocated
   SrcSpanAnnA
   (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
xs] [Idea] -> [Idea] -> [Idea]
forall a. [a] -> [a] -> [a]
++
      [[Idea]] -> [Idea]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [GenLocated SrcSpanAnnA (HsExpr GhcPs) -> [Idea]
f GenLocated SrcSpanAnnA (HsExpr GhcPs)
x | (L SrcSpanAnnA
_ (BindStmt XBindStmt GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
_ (L SrcSpanAnnA
_ WildPat{}) GenLocated SrcSpanAnnA (HsExpr GhcPs)
x)) <- [GenLocated
   SrcSpanAnnA
   (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> [GenLocated
      SrcSpanAnnA
      (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
forall a. [a] -> [a]
dropEnd1 [GenLocated
   SrcSpanAnnA
   (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
xs]
    LHsExpr GhcPs
_ -> []
  where
    f :: LHsExpr GhcPs -> [Idea]
f = String
-> (LHsExpr GhcPs -> LHsExpr GhcPs) -> LHsExpr GhcPs -> [Idea]
monadNoResult (String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
"" Maybe String
decl) LHsExpr GhcPs -> LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall a. a -> a
id
    seenVoid :: (GenLocated SrcSpanAnnA (HsExpr GhcPs) -> LocatedAn a e)
-> GenLocated SrcSpanAnnA (HsExpr GhcPs) -> [Idea]
seenVoid GenLocated SrcSpanAnnA (HsExpr GhcPs) -> LocatedAn a e
wrap (L SrcSpanAnnA
l (HsPar XPar GhcPs
x LHsToken "(" GhcPs
p LHsExpr GhcPs
y LHsToken ")" GhcPs
q)) = (GenLocated SrcSpanAnnA (HsExpr GhcPs) -> LocatedAn a e)
-> GenLocated SrcSpanAnnA (HsExpr GhcPs) -> [Idea]
seenVoid (GenLocated SrcSpanAnnA (HsExpr GhcPs) -> LocatedAn a e
wrap (GenLocated SrcSpanAnnA (HsExpr GhcPs) -> LocatedAn a e)
-> (GenLocated SrcSpanAnnA (HsExpr GhcPs)
    -> GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> LocatedAn a e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SrcSpanAnnA
-> HsExpr GhcPs -> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l (HsExpr GhcPs -> GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> (GenLocated SrcSpanAnnA (HsExpr GhcPs) -> HsExpr GhcPs)
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \GenLocated SrcSpanAnnA (HsExpr GhcPs)
y -> XPar GhcPs
-> LHsToken "(" GhcPs
-> LHsExpr GhcPs
-> LHsToken ")" GhcPs
-> HsExpr GhcPs
forall p.
XPar p -> LHsToken "(" p -> LHsExpr p -> LHsToken ")" p -> HsExpr p
HsPar XPar GhcPs
x LHsToken "(" GhcPs
p LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
y LHsToken ")" GhcPs
q) LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
y
    seenVoid GenLocated SrcSpanAnnA (HsExpr GhcPs) -> LocatedAn a e
wrap GenLocated SrcSpanAnnA (HsExpr GhcPs)
x =
      -- Suggest `traverse_ f x` given `void $ traverse_ f x`
      [String
-> Located e
-> Located (HsExpr GhcPs)
-> [Refactoring SrcSpan]
-> Idea
forall a b.
(Outputable a, Outputable b) =>
String -> Located a -> Located b -> [Refactoring SrcSpan] -> Idea
warn String
"Redundant void" (LocatedAn a e -> Located e
forall a e. LocatedAn a e -> Located e
reLoc (GenLocated SrcSpanAnnA (HsExpr GhcPs) -> LocatedAn a e
wrap GenLocated SrcSpanAnnA (HsExpr GhcPs)
x)) (GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Located (HsExpr GhcPs)
forall a e. LocatedAn a e -> Located e
reLoc GenLocated SrcSpanAnnA (HsExpr GhcPs)
x) [RType
-> SrcSpan -> [(String, SrcSpan)] -> String -> Refactoring SrcSpan
forall a. RType -> a -> [(String, a)] -> String -> Refactoring a
Replace RType
Expr (LocatedAn a e -> SrcSpan
forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
toSSA (GenLocated SrcSpanAnnA (HsExpr GhcPs) -> LocatedAn a e
wrap GenLocated SrcSpanAnnA (HsExpr GhcPs)
x)) [(String
"a", GenLocated SrcSpanAnnA (HsExpr GhcPs) -> SrcSpan
forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
toSSA GenLocated SrcSpanAnnA (HsExpr GhcPs)
x)] String
"a"] | LHsExpr GhcPs -> Bool
returnsUnit LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
x]
        -- Suggest `traverse_ f x` given `void $ traverse f x`
        [Idea] -> [Idea] -> [Idea]
forall a. [a] -> [a] -> [a]
++ ( case (LIdP GhcPs -> (LIdP GhcPs, GenLocated SrcSpanAnnN RdrName))
-> LHsExpr GhcPs
-> (LHsExpr GhcPs, Maybe (GenLocated SrcSpanAnnN RdrName))
forall a.
(LIdP GhcPs -> (LIdP GhcPs, a))
-> LHsExpr GhcPs -> (LHsExpr GhcPs, Maybe a)
modifyAppHead
               ( \fun :: LIdP GhcPs
fun@(L SrcSpanAnnN
l RdrName
name) ->
                   ( if RdrName -> String
occNameStr RdrName
name String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
badFuncs
                       then SrcSpanAnnN -> RdrName -> GenLocated SrcSpanAnnN RdrName
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnN
l (OccName -> RdrName
mkRdrUnqual (String -> OccName
mkVarOcc (RdrName -> String
occNameStr RdrName
name String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"_")))
                       else LIdP GhcPs
fun,
                     LIdP GhcPs
GenLocated SrcSpanAnnN RdrName
fun
                   )
               )
               LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
x of
               (LHsExpr GhcPs
x', Just fun :: GenLocated SrcSpanAnnN RdrName
fun@(L SrcSpanAnnN
l RdrName
name)) | RdrName -> String
occNameStr RdrName
name String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
badFuncs ->
                  let fun_ :: String
fun_ = RdrName -> String
occNameStr RdrName
name String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"_"
                   in [String
-> Located e
-> Located (HsExpr GhcPs)
-> [Refactoring SrcSpan]
-> Idea
forall a b.
(Outputable a, Outputable b) =>
String -> Located a -> Located b -> [Refactoring SrcSpan] -> Idea
warn (String
"Use " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
fun_) (LocatedAn a e -> Located e
forall a e. LocatedAn a e -> Located e
reLoc (GenLocated SrcSpanAnnA (HsExpr GhcPs) -> LocatedAn a e
wrap GenLocated SrcSpanAnnA (HsExpr GhcPs)
x)) (GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Located (HsExpr GhcPs)
forall a e. LocatedAn a e -> Located e
reLoc LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
x')
                        [RType
-> SrcSpan -> [(String, SrcSpan)] -> String -> Refactoring SrcSpan
forall a. RType -> a -> [(String, a)] -> String -> Refactoring a
Replace RType
Expr (LocatedAn a e -> SrcSpan
forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
toSSA (GenLocated SrcSpanAnnA (HsExpr GhcPs) -> LocatedAn a e
wrap GenLocated SrcSpanAnnA (HsExpr GhcPs)
x)) [(String
"a", GenLocated SrcSpanAnnA (HsExpr GhcPs) -> SrcSpan
forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
toSSA GenLocated SrcSpanAnnA (HsExpr GhcPs)
x)] String
"a",
                         RType
-> SrcSpan -> [(String, SrcSpan)] -> String -> Refactoring SrcSpan
forall a. RType -> a -> [(String, a)] -> String -> Refactoring a
Replace RType
Expr (GenLocated SrcSpanAnnN RdrName -> SrcSpan
forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
toSSA GenLocated SrcSpanAnnN RdrName
fun) [] String
fun_]]
               (LHsExpr GhcPs, Maybe (GenLocated SrcSpanAnnN RdrName))
_ -> []
           )
    doSpan :: t a -> SrcSpan -> SrcSpan
doSpan t a
doOrMDo = \case
      UnhelpfulSpan UnhelpfulSpanReason
s -> UnhelpfulSpanReason -> SrcSpan
UnhelpfulSpan UnhelpfulSpanReason
s
      RealSrcSpan RealSrcSpan
s Maybe BufSpan
_ ->
        let start :: RealSrcLoc
start = RealSrcSpan -> RealSrcLoc
realSrcSpanStart RealSrcSpan
s
            end :: RealSrcLoc
end = FastString -> Int -> Int -> RealSrcLoc
mkRealSrcLoc (RealSrcSpan -> FastString
srcSpanFile RealSrcSpan
s) (RealSrcLoc -> Int
srcLocLine RealSrcLoc
start) (RealSrcLoc -> Int
srcLocCol RealSrcLoc
start Int -> Int -> Int
forall a. Num a => a -> a -> a
+ t a -> Int
forall a. t a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length t a
doOrMDo)
         in RealSrcSpan -> Maybe BufSpan -> SrcSpan
RealSrcSpan (RealSrcLoc -> RealSrcLoc -> RealSrcSpan
mkRealSrcSpan RealSrcLoc
start RealSrcLoc
end) Maybe BufSpan
forall a. Maybe a
GHC.Data.Strict.Nothing

-- Sometimes people write 'a * do a + b', to avoid brackets,
-- or using BlockArguments they can write 'a do a b',
-- or using indentation a * do {\b -> c} * d
-- Return True if they are using do as brackets
doAsBrackets :: Maybe (Int, LHsExpr GhcPs) -> LHsExpr GhcPs -> Bool
doAsBrackets :: Maybe (Int, LHsExpr GhcPs) -> LHsExpr GhcPs -> Bool
doAsBrackets (Just (Int
2, L SrcSpanAnnA
_ (OpApp XOpApp GhcPs
_ LHsExpr GhcPs
_ LHsExpr GhcPs
op LHsExpr GhcPs
_ ))) LHsExpr GhcPs
_ | LHsExpr GhcPs -> Bool
isDol LHsExpr GhcPs
op = Bool
False -- not quite atomic, but close enough
doAsBrackets (Just (Int
i, LHsExpr GhcPs
o)) LHsExpr GhcPs
x = Int
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> Bool
forall a. Brackets a => Int -> a -> a -> Bool
needBracket Int
i LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
o LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
x
doAsBrackets Maybe (Int, LHsExpr GhcPs)
Nothing LHsExpr GhcPs
x = Bool
False


-- Sometimes people write do, to avoid indentation, see
-- https://github.com/ndmitchell/hlint/issues/978
-- Return True if they are using do as avoiding indentation
doAsAvoidingIndentation :: Maybe (LHsExpr GhcPs) -> LHsExpr GhcPs -> Bool
doAsAvoidingIndentation :: Maybe (LHsExpr GhcPs) -> LHsExpr GhcPs -> Bool
doAsAvoidingIndentation (Just (L SrcSpanAnnA
_ (HsDo XDo GhcPs
_ HsDoFlavour
_ (L SrcSpanAnnL
anna [GenLocated
   SrcSpanAnnA
   (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
_)))) (L SrcSpanAnnA
_ (HsDo XDo GhcPs
_ HsDoFlavour
_ (L SrcSpanAnnL
annb [GenLocated
   SrcSpanAnnA
   (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
_)))
  | SrcSpanAnn EpAnn AnnList
_ (RealSrcSpan RealSrcSpan
a Maybe BufSpan
_) <- SrcSpanAnnL
anna
  , SrcSpanAnn EpAnn AnnList
_ (RealSrcSpan RealSrcSpan
b Maybe BufSpan
_) <- SrcSpanAnnL
annb
    = RealSrcSpan -> Int
srcSpanStartCol RealSrcSpan
a Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== RealSrcSpan -> Int
srcSpanStartCol RealSrcSpan
b
doAsAvoidingIndentation Maybe (LHsExpr GhcPs)
parent LHsExpr GhcPs
self = Bool
False

-- Apply a function to the application head, including `head arg` and `head $ arg`, which modifies
-- the head and returns a value. Sees through parentheses.
modifyAppHead :: forall a. (LIdP GhcPs -> (LIdP GhcPs, a)) -> LHsExpr GhcPs -> (LHsExpr GhcPs, Maybe a)
modifyAppHead :: forall a.
(LIdP GhcPs -> (LIdP GhcPs, a))
-> LHsExpr GhcPs -> (LHsExpr GhcPs, Maybe a)
modifyAppHead LIdP GhcPs -> (LIdP GhcPs, a)
f = (LHsExpr GhcPs -> LHsExpr GhcPs)
-> LHsExpr GhcPs -> (LHsExpr GhcPs, Maybe a)
go LHsExpr GhcPs -> LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall a. a -> a
id
  where
    go :: (LHsExpr GhcPs -> LHsExpr GhcPs) -> LHsExpr GhcPs -> (LHsExpr GhcPs, Maybe a)
    go :: (LHsExpr GhcPs -> LHsExpr GhcPs)
-> LHsExpr GhcPs -> (LHsExpr GhcPs, Maybe a)
go LHsExpr GhcPs -> LHsExpr GhcPs
wrap (L SrcSpanAnnA
l (HsPar XPar GhcPs
_ LHsToken "(" GhcPs
p LHsExpr GhcPs
x LHsToken ")" GhcPs
q)) = (LHsExpr GhcPs -> LHsExpr GhcPs)
-> LHsExpr GhcPs -> (LHsExpr GhcPs, Maybe a)
go (LHsExpr GhcPs -> LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
wrap (GenLocated SrcSpanAnnA (HsExpr GhcPs)
 -> GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> (GenLocated SrcSpanAnnA (HsExpr GhcPs)
    -> GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SrcSpanAnnA
-> HsExpr GhcPs -> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l (HsExpr GhcPs -> GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> (GenLocated SrcSpanAnnA (HsExpr GhcPs) -> HsExpr GhcPs)
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \GenLocated SrcSpanAnnA (HsExpr GhcPs)
y -> XPar GhcPs
-> LHsToken "(" GhcPs
-> LHsExpr GhcPs
-> LHsToken ")" GhcPs
-> HsExpr GhcPs
forall p.
XPar p -> LHsToken "(" p -> LHsExpr p -> LHsToken ")" p -> HsExpr p
HsPar XPar GhcPs
EpAnn NoEpAnns
forall ann. EpAnn ann
EpAnnNotUsed LHsToken "(" GhcPs
p LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
y LHsToken ")" GhcPs
q) LHsExpr GhcPs
x
    go LHsExpr GhcPs -> LHsExpr GhcPs
wrap (L SrcSpanAnnA
l (HsApp XApp GhcPs
_ LHsExpr GhcPs
x LHsExpr GhcPs
y)) = (LHsExpr GhcPs -> LHsExpr GhcPs)
-> LHsExpr GhcPs -> (LHsExpr GhcPs, Maybe a)
go (\LHsExpr GhcPs
x -> LHsExpr GhcPs -> LHsExpr GhcPs
wrap (LHsExpr GhcPs -> LHsExpr GhcPs) -> LHsExpr GhcPs -> LHsExpr GhcPs
forall a b. (a -> b) -> a -> b
$ SrcSpanAnnA
-> HsExpr GhcPs -> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l (XApp GhcPs -> LHsExpr GhcPs -> LHsExpr GhcPs -> HsExpr GhcPs
forall p. XApp p -> LHsExpr p -> LHsExpr p -> HsExpr p
HsApp XApp GhcPs
EpAnn NoEpAnns
forall ann. EpAnn ann
EpAnnNotUsed LHsExpr GhcPs
x LHsExpr GhcPs
y)) LHsExpr GhcPs
x
    go LHsExpr GhcPs -> LHsExpr GhcPs
wrap (L SrcSpanAnnA
l (OpApp XOpApp GhcPs
_ LHsExpr GhcPs
x LHsExpr GhcPs
op LHsExpr GhcPs
y)) | LHsExpr GhcPs -> Bool
isDol LHsExpr GhcPs
op = (LHsExpr GhcPs -> LHsExpr GhcPs)
-> LHsExpr GhcPs -> (LHsExpr GhcPs, Maybe a)
go (\LHsExpr GhcPs
x -> LHsExpr GhcPs -> LHsExpr GhcPs
wrap (LHsExpr GhcPs -> LHsExpr GhcPs) -> LHsExpr GhcPs -> LHsExpr GhcPs
forall a b. (a -> b) -> a -> b
$ SrcSpanAnnA
-> HsExpr GhcPs -> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l (XOpApp GhcPs
-> LHsExpr GhcPs -> LHsExpr GhcPs -> LHsExpr GhcPs -> HsExpr GhcPs
forall p.
XOpApp p -> LHsExpr p -> LHsExpr p -> LHsExpr p -> HsExpr p
OpApp XOpApp GhcPs
EpAnn [AddEpAnn]
forall ann. EpAnn ann
EpAnnNotUsed LHsExpr GhcPs
x LHsExpr GhcPs
op LHsExpr GhcPs
y)) LHsExpr GhcPs
x
    go LHsExpr GhcPs -> LHsExpr GhcPs
wrap (L SrcSpanAnnA
l (HsVar XVar GhcPs
_ LIdP GhcPs
x)) = (LHsExpr GhcPs -> LHsExpr GhcPs
wrap (SrcSpanAnnA
-> HsExpr GhcPs -> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l (XVar GhcPs -> LIdP GhcPs -> HsExpr GhcPs
forall p. XVar p -> LIdP p -> HsExpr p
HsVar XVar GhcPs
NoExtField
NoExtField LIdP GhcPs
GenLocated SrcSpanAnnN RdrName
x')), a -> Maybe a
forall a. a -> Maybe a
Just a
a)
      where (LIdP GhcPs
x', a
a) = LIdP GhcPs -> (LIdP GhcPs, a)
f LIdP GhcPs
x
    go LHsExpr GhcPs -> LHsExpr GhcPs
_ LHsExpr GhcPs
expr = (LHsExpr GhcPs
expr, Maybe a
forall a. Maybe a
Nothing)

returnsUnit :: LHsExpr GhcPs -> Bool
returnsUnit :: LHsExpr GhcPs -> Bool
returnsUnit = Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
False
            (Maybe Bool -> Bool)
-> (GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Maybe Bool)
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GenLocated SrcSpanAnnA (HsExpr GhcPs), Maybe Bool) -> Maybe Bool
forall a b. (a, b) -> b
snd
            ((GenLocated SrcSpanAnnA (HsExpr GhcPs), Maybe Bool) -> Maybe Bool)
-> (GenLocated SrcSpanAnnA (HsExpr GhcPs)
    -> (GenLocated SrcSpanAnnA (HsExpr GhcPs), Maybe Bool))
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> Maybe Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LIdP GhcPs -> (LIdP GhcPs, Bool))
-> LHsExpr GhcPs -> (LHsExpr GhcPs, Maybe Bool)
forall a.
(LIdP GhcPs -> (LIdP GhcPs, a))
-> LHsExpr GhcPs -> (LHsExpr GhcPs, Maybe a)
modifyAppHead (\LIdP GhcPs
x -> (LIdP GhcPs
x, RdrName -> String
occNameStr (GenLocated SrcSpanAnnN RdrName -> RdrName
forall l e. GenLocated l e -> e
unLoc LIdP GhcPs
GenLocated SrcSpanAnnN RdrName
x) String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"_") [String]
badFuncs [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
unitFuncs))

-- 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 :: String
-> (LHsExpr GhcPs -> LHsExpr GhcPs) -> LHsExpr GhcPs -> [Idea]
monadNoResult String
inside LHsExpr GhcPs -> LHsExpr GhcPs
wrap (L SrcSpanAnnA
l (HsPar XPar GhcPs
_ LHsToken "(" GhcPs
_ LHsExpr GhcPs
x LHsToken ")" GhcPs
_)) = String
-> (LHsExpr GhcPs -> LHsExpr GhcPs) -> LHsExpr GhcPs -> [Idea]
monadNoResult String
inside (LHsExpr GhcPs -> LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
wrap (GenLocated SrcSpanAnnA (HsExpr GhcPs)
 -> GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> (GenLocated SrcSpanAnnA (HsExpr GhcPs)
    -> GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LHsExpr GhcPs -> LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall (id :: Pass). LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
nlHsPar) LHsExpr GhcPs
x
monadNoResult String
inside LHsExpr GhcPs -> LHsExpr GhcPs
wrap (L SrcSpanAnnA
l (HsApp XApp GhcPs
_ LHsExpr GhcPs
x LHsExpr GhcPs
y)) = String
-> (LHsExpr GhcPs -> LHsExpr GhcPs) -> LHsExpr GhcPs -> [Idea]
monadNoResult String
inside (\LHsExpr GhcPs
x -> LHsExpr GhcPs -> LHsExpr GhcPs
wrap (LHsExpr GhcPs -> LHsExpr GhcPs) -> LHsExpr GhcPs -> LHsExpr GhcPs
forall a b. (a -> b) -> a -> b
$ SrcSpanAnnA
-> HsExpr GhcPs -> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l (XApp GhcPs -> LHsExpr GhcPs -> LHsExpr GhcPs -> HsExpr GhcPs
forall p. XApp p -> LHsExpr p -> LHsExpr p -> HsExpr p
HsApp XApp GhcPs
EpAnn NoEpAnns
forall ann. EpAnn ann
EpAnnNotUsed LHsExpr GhcPs
x LHsExpr GhcPs
y)) LHsExpr GhcPs
x
monadNoResult String
inside LHsExpr GhcPs -> LHsExpr GhcPs
wrap (L SrcSpanAnnA
l (OpApp XOpApp GhcPs
_ LHsExpr GhcPs
x tag :: LHsExpr GhcPs
tag@(L SrcSpanAnnA
_ (HsVar XVar GhcPs
_ (L SrcSpanAnnN
_ RdrName
op))) LHsExpr GhcPs
y))
    | LHsExpr GhcPs -> Bool
isDol LHsExpr GhcPs
tag = String
-> (LHsExpr GhcPs -> LHsExpr GhcPs) -> LHsExpr GhcPs -> [Idea]
monadNoResult String
inside (\LHsExpr GhcPs
x -> LHsExpr GhcPs -> LHsExpr GhcPs
wrap (LHsExpr GhcPs -> LHsExpr GhcPs) -> LHsExpr GhcPs -> LHsExpr GhcPs
forall a b. (a -> b) -> a -> b
$ SrcSpanAnnA
-> HsExpr GhcPs -> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l (XOpApp GhcPs
-> LHsExpr GhcPs -> LHsExpr GhcPs -> LHsExpr GhcPs -> HsExpr GhcPs
forall p.
XOpApp p -> LHsExpr p -> LHsExpr p -> LHsExpr p -> HsExpr p
OpApp XOpApp GhcPs
EpAnn [AddEpAnn]
forall ann. EpAnn ann
EpAnnNotUsed LHsExpr GhcPs
x LHsExpr GhcPs
tag LHsExpr GhcPs
y)) LHsExpr GhcPs
x
    | RdrName -> String
occNameStr RdrName
op String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
">>=" = String
-> (LHsExpr GhcPs -> LHsExpr GhcPs) -> LHsExpr GhcPs -> [Idea]
monadNoResult String
inside (LHsExpr GhcPs -> LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
wrap (GenLocated SrcSpanAnnA (HsExpr GhcPs)
 -> GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> (GenLocated SrcSpanAnnA (HsExpr GhcPs)
    -> GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SrcSpanAnnA
-> HsExpr GhcPs -> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l (HsExpr GhcPs -> GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> (GenLocated SrcSpanAnnA (HsExpr GhcPs) -> HsExpr GhcPs)
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XOpApp GhcPs
-> LHsExpr GhcPs -> LHsExpr GhcPs -> LHsExpr GhcPs -> HsExpr GhcPs
forall p.
XOpApp p -> LHsExpr p -> LHsExpr p -> LHsExpr p -> HsExpr p
OpApp XOpApp GhcPs
EpAnn [AddEpAnn]
forall ann. EpAnn ann
EpAnnNotUsed LHsExpr GhcPs
x LHsExpr GhcPs
tag) LHsExpr GhcPs
y
monadNoResult String
inside LHsExpr GhcPs -> LHsExpr GhcPs
wrap LHsExpr GhcPs
x
    | String
x2 : [String]
_ <- (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (String -> LHsExpr GhcPs -> Bool
`isTag` LHsExpr GhcPs
x) [String]
badFuncs
    , let x3 :: String
x3 = String
x2 String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"_"
    = [String
-> Located (HsExpr GhcPs)
-> Located (HsExpr GhcPs)
-> [Refactoring SrcSpan]
-> Idea
forall a b.
(Outputable a, Outputable b) =>
String -> Located a -> Located b -> [Refactoring SrcSpan] -> Idea
warn (String
"Use " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
x3) (GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Located (HsExpr GhcPs)
forall a e. LocatedAn a e -> Located e
reLoc (LHsExpr GhcPs -> LHsExpr GhcPs
wrap LHsExpr GhcPs
x)) (GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Located (HsExpr GhcPs)
forall a e. LocatedAn a e -> Located e
reLoc (LHsExpr GhcPs -> LHsExpr GhcPs
wrap (LHsExpr GhcPs -> LHsExpr GhcPs) -> LHsExpr GhcPs -> LHsExpr GhcPs
forall a b. (a -> b) -> a -> b
$ String -> LHsExpr GhcPs
strToVar String
x3)) [RType
-> SrcSpan -> [(String, SrcSpan)] -> String -> Refactoring SrcSpan
forall a. RType -> a -> [(String, a)] -> String -> Refactoring a
Replace RType
Expr (GenLocated SrcSpanAnnA (HsExpr GhcPs) -> SrcSpan
forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
toSSA LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
x) [] String
x3] | String
inside String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
x3]
monadNoResult String
inside LHsExpr GhcPs -> LHsExpr GhcPs
wrap (LHsExpr GhcPs
-> ([LHsExpr GhcPs], [LHsExpr GhcPs] -> LHsExpr GhcPs)
replaceBranches -> ([LHsExpr GhcPs]
bs, [LHsExpr GhcPs] -> LHsExpr GhcPs
rewrap)) =
    (Idea -> Idea) -> [Idea] -> [Idea]
forall a b. (a -> b) -> [a] -> [b]
map (\Idea
x -> Idea
x{ideaNote=nubOrd $ Note "May require adding void to other branches" : ideaNote x}) ([Idea] -> [Idea]) -> [Idea] -> [Idea]
forall a b. (a -> b) -> a -> b
$ [[Idea]] -> [Idea]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
        [String
-> (LHsExpr GhcPs -> LHsExpr GhcPs) -> LHsExpr GhcPs -> [Idea]
monadNoResult String
inside LHsExpr GhcPs -> LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall a. a -> a
id LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
b | GenLocated SrcSpanAnnA (HsExpr GhcPs)
b <- [LHsExpr GhcPs]
[GenLocated SrcSpanAnnA (HsExpr GhcPs)]
bs]

monadStep :: ([ExprLStmt GhcPs] -> LHsExpr GhcPs)
           -> [ExprLStmt GhcPs] -> [Idea]

-- Rewrite 'do return x; $2' as 'do $2'.
monadStep :: ([ExprLStmt GhcPs] -> LHsExpr GhcPs) -> [ExprLStmt GhcPs] -> [Idea]
monadStep [ExprLStmt GhcPs] -> LHsExpr GhcPs
wrap (o :: ExprLStmt GhcPs
o@(L SrcSpanAnnA
_ (BodyStmt XBodyStmt GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
_ (LHsExpr GhcPs -> Maybe (String, LHsExpr GhcPs)
GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> Maybe (String, LHsExpr GhcPs)
fromRet -> Just (String
ret, LHsExpr GhcPs
_)) SyntaxExpr GhcPs
_ SyntaxExpr GhcPs
_ )) : xs :: [ExprLStmt GhcPs]
xs@(ExprLStmt GhcPs
_:[ExprLStmt GhcPs]
_))
  = [Severity
-> String -> SrcSpan -> String -> [Refactoring SrcSpan] -> Idea
ideaRemove Severity
Warning (String
"Redundant " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
ret) (SrcSpanAnnA -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA (GenLocated
  SrcSpanAnnA
  (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> SrcSpanAnnA
forall l e. GenLocated l e -> l
getLoc ExprLStmt GhcPs
GenLocated
  SrcSpanAnnA
  (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
o)) (GenLocated
  SrcSpanAnnA
  (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> String
forall a. Outputable a => a -> String
unsafePrettyPrint ExprLStmt GhcPs
GenLocated
  SrcSpanAnnA
  (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
o) [RType -> SrcSpan -> Refactoring SrcSpan
forall a. RType -> a -> Refactoring a
Delete RType
Stmt (GenLocated
  SrcSpanAnnA
  (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> SrcSpan
forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
toSSA ExprLStmt GhcPs
GenLocated
  SrcSpanAnnA
  (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
o)]]

-- Rewrite 'do a <- $1; return a' as 'do $1'.
monadStep [ExprLStmt GhcPs] -> LHsExpr GhcPs
wrap o :: [ExprLStmt GhcPs]
o@[ g :: ExprLStmt GhcPs
g@(L SrcSpanAnnA
_ (BindStmt XBindStmt GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
_ (L SrcSpanAnnA
_ (VarPat XVarPat GhcPs
_ (L SrcSpanAnnN
_ RdrName
p))) GenLocated SrcSpanAnnA (HsExpr GhcPs)
x))
                  , q :: ExprLStmt GhcPs
q@(L SrcSpanAnnA
_ (BodyStmt XBodyStmt GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
_ (LHsExpr GhcPs -> Maybe (String, LHsExpr GhcPs)
GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> Maybe (String, LHsExpr GhcPs)
fromRet -> Just (String
ret, L SrcSpanAnnA
_ (HsVar XVar GhcPs
_ (L SrcSpanAnnN
_ RdrName
v)))) SyntaxExpr GhcPs
_ SyntaxExpr GhcPs
_))]
  | RdrName -> String
occNameStr RdrName
p String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== RdrName -> String
occNameStr RdrName
v
  = [String
-> Located (HsExpr GhcPs)
-> Located (HsExpr GhcPs)
-> [Refactoring SrcSpan]
-> Idea
forall a b.
(Outputable a, Outputable b) =>
String -> Located a -> Located b -> [Refactoring SrcSpan] -> Idea
warn (String
"Redundant " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
ret) (GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Located (HsExpr GhcPs)
forall a e. LocatedAn a e -> Located e
reLoc ([ExprLStmt GhcPs] -> LHsExpr GhcPs
wrap [ExprLStmt GhcPs]
o)) (GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Located (HsExpr GhcPs)
forall a e. LocatedAn a e -> Located e
reLoc ([ExprLStmt GhcPs] -> LHsExpr GhcPs
wrap [StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> GenLocated
     SrcSpanAnnA
     (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
forall a an. a -> LocatedAn an a
noLocA (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
 -> GenLocated
      SrcSpanAnnA
      (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
-> StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> GenLocated
     SrcSpanAnnA
     (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
forall a b. (a -> b) -> a -> b
$ XBodyStmt GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> SyntaxExpr GhcPs
-> SyntaxExpr GhcPs
-> StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall idL idR body.
XBodyStmt idL idR body
-> body -> SyntaxExpr idR -> SyntaxExpr idR -> StmtLR idL idR body
BodyStmt XBodyStmt GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
NoExtField
noExtField GenLocated SrcSpanAnnA (HsExpr GhcPs)
x SyntaxExpr GhcPs
forall (p :: Pass). IsPass p => SyntaxExpr (GhcPass p)
noSyntaxExpr SyntaxExpr GhcPs
forall (p :: Pass). IsPass p => SyntaxExpr (GhcPass p)
noSyntaxExpr]))
      [RType
-> SrcSpan -> [(String, SrcSpan)] -> String -> Refactoring SrcSpan
forall a. RType -> a -> [(String, a)] -> String -> Refactoring a
Replace RType
Stmt (GenLocated
  SrcSpanAnnA
  (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> SrcSpan
forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
toSSA ExprLStmt GhcPs
GenLocated
  SrcSpanAnnA
  (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
g) [(String
"x", GenLocated SrcSpanAnnA (HsExpr GhcPs) -> SrcSpan
forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
toSSA GenLocated SrcSpanAnnA (HsExpr GhcPs)
x)] String
"x", RType -> SrcSpan -> Refactoring SrcSpan
forall a. RType -> a -> Refactoring a
Delete RType
Stmt (GenLocated
  SrcSpanAnnA
  (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> SrcSpan
forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
toSSA ExprLStmt GhcPs
GenLocated
  SrcSpanAnnA
  (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
q)]]

-- Suggest to use join. Rewrite 'do x <- $1; x; $2' as 'do join $1; $2'.
monadStep [ExprLStmt GhcPs] -> LHsExpr GhcPs
wrap o :: [ExprLStmt GhcPs]
o@(g :: ExprLStmt GhcPs
g@(L SrcSpanAnnA
_ (BindStmt XBindStmt GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
_ (LPat GhcPs -> PVar_
GenLocated SrcSpanAnnA (Pat GhcPs) -> PVar_
forall a b. View a b => a -> b
view -> PVar_ String
p) GenLocated SrcSpanAnnA (HsExpr GhcPs)
x)):q :: ExprLStmt GhcPs
q@(L SrcSpanAnnA
_ (BodyStmt XBodyStmt GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
_ (GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Var_
forall a b. View a b => a -> b
view -> Var_ String
v) SyntaxExpr GhcPs
_ SyntaxExpr GhcPs
_)):[ExprLStmt GhcPs]
xs)
  | String
p String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
v Bool -> Bool -> Bool
&& String
v String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [GenLocated
   SrcSpanAnnA
   (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> [String]
forall a. AllVars a => a -> [String]
varss [ExprLStmt GhcPs]
[GenLocated
   SrcSpanAnnA
   (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
xs
  = let app :: LocatedAn an (HsExpr GhcPs)
app = HsExpr GhcPs -> LocatedAn an (HsExpr GhcPs)
forall a an. a -> LocatedAn an a
noLocA (HsExpr GhcPs -> LocatedAn an (HsExpr GhcPs))
-> HsExpr GhcPs -> LocatedAn an (HsExpr GhcPs)
forall a b. (a -> b) -> a -> b
$ XApp GhcPs -> LHsExpr GhcPs -> LHsExpr GhcPs -> HsExpr GhcPs
forall p. XApp p -> LHsExpr p -> LHsExpr p -> HsExpr p
HsApp XApp GhcPs
EpAnn NoEpAnns
forall ann. EpAnn ann
EpAnnNotUsed (String -> LHsExpr GhcPs
strToVar String
"join") LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
x
        body :: LocatedAn
  an (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
body = StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> LocatedAn
     an (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
forall a an. a -> LocatedAn an a
noLocA (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
 -> LocatedAn
      an (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
-> StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> LocatedAn
     an (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
forall a b. (a -> b) -> a -> b
$ XBodyStmt GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> SyntaxExpr GhcPs
-> SyntaxExpr GhcPs
-> StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall idL idR body.
XBodyStmt idL idR body
-> body -> SyntaxExpr idR -> SyntaxExpr idR -> StmtLR idL idR body
BodyStmt XBodyStmt GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
NoExtField
noExtField (LHsExpr GhcPs -> LHsExpr GhcPs
rebracket1 LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall {an}. LocatedAn an (HsExpr GhcPs)
app) SyntaxExpr GhcPs
forall (p :: Pass). IsPass p => SyntaxExpr (GhcPass p)
noSyntaxExpr SyntaxExpr GhcPs
forall (p :: Pass). IsPass p => SyntaxExpr (GhcPass p)
noSyntaxExpr
        stmts :: [GenLocated
   SrcSpanAnnA
   (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
stmts = GenLocated
  SrcSpanAnnA
  (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
forall {an}.
LocatedAn
  an (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
body GenLocated
  SrcSpanAnnA
  (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> [GenLocated
      SrcSpanAnnA
      (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> [GenLocated
      SrcSpanAnnA
      (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
forall a. a -> [a] -> [a]
: [ExprLStmt GhcPs]
[GenLocated
   SrcSpanAnnA
   (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
xs
    in [String
-> Located (HsExpr GhcPs)
-> Located (HsExpr GhcPs)
-> [Refactoring SrcSpan]
-> Idea
forall a b.
(Outputable a, Outputable b) =>
String -> Located a -> Located b -> [Refactoring SrcSpan] -> Idea
warn String
"Use join" (GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Located (HsExpr GhcPs)
forall a e. LocatedAn a e -> Located e
reLoc ([ExprLStmt GhcPs] -> LHsExpr GhcPs
wrap [ExprLStmt GhcPs]
o)) (GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Located (HsExpr GhcPs)
forall a e. LocatedAn a e -> Located e
reLoc ([ExprLStmt GhcPs] -> LHsExpr GhcPs
wrap [ExprLStmt GhcPs]
[GenLocated
   SrcSpanAnnA
   (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
stmts)) [Refactoring SrcSpan]
r]
  where r :: [Refactoring SrcSpan]
r = [RType
-> SrcSpan -> [(String, SrcSpan)] -> String -> Refactoring SrcSpan
forall a. RType -> a -> [(String, a)] -> String -> Refactoring a
Replace RType
Stmt (GenLocated
  SrcSpanAnnA
  (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> SrcSpan
forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
toSSA ExprLStmt GhcPs
GenLocated
  SrcSpanAnnA
  (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
g) [(String
"x", GenLocated SrcSpanAnnA (HsExpr GhcPs) -> SrcSpan
forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
toSSA GenLocated SrcSpanAnnA (HsExpr GhcPs)
x)] String
"join x", RType -> SrcSpan -> Refactoring SrcSpan
forall a. RType -> a -> Refactoring a
Delete RType
Stmt (GenLocated
  SrcSpanAnnA
  (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> SrcSpan
forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
toSSA ExprLStmt GhcPs
GenLocated
  SrcSpanAnnA
  (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
q)]

-- Redundant variable capture. Rewrite 'do _ <- <return ()>; $1' as
-- 'do <return ()>; $1'.
monadStep [ExprLStmt GhcPs] -> LHsExpr GhcPs
wrap (o :: ExprLStmt GhcPs
o@(L SrcSpanAnnA
loc (BindStmt XBindStmt GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
_ LPat GhcPs
p GenLocated SrcSpanAnnA (HsExpr GhcPs)
x)) : [ExprLStmt GhcPs]
rest)
    | LPat GhcPs -> Bool
isPWildcard LPat GhcPs
p, LHsExpr GhcPs -> Bool
returnsUnit LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
x
    = let body :: ExprLStmt GhcPs
body = SrcSpanAnnA
-> StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> GenLocated
     SrcSpanAnnA
     (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
loc (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
 -> GenLocated
      SrcSpanAnnA
      (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
-> StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> GenLocated
     SrcSpanAnnA
     (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
forall a b. (a -> b) -> a -> b
$ XBodyStmt GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> SyntaxExpr GhcPs
-> SyntaxExpr GhcPs
-> StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall idL idR body.
XBodyStmt idL idR body
-> body -> SyntaxExpr idR -> SyntaxExpr idR -> StmtLR idL idR body
BodyStmt XBodyStmt GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
NoExtField
noExtField GenLocated SrcSpanAnnA (HsExpr GhcPs)
x SyntaxExpr GhcPs
forall (p :: Pass). IsPass p => SyntaxExpr (GhcPass p)
noSyntaxExpr SyntaxExpr GhcPs
forall (p :: Pass). IsPass p => SyntaxExpr (GhcPass p)
noSyntaxExpr :: ExprLStmt GhcPs
      in [String
-> Located
     (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> Located
     (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> [Refactoring SrcSpan]
-> Idea
forall a b.
(Outputable a, Outputable b) =>
String -> Located a -> Located b -> [Refactoring SrcSpan] -> Idea
warn String
"Redundant variable capture" (GenLocated
  SrcSpanAnnA
  (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> Located
     (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
forall a e. LocatedAn a e -> Located e
reLoc ExprLStmt GhcPs
GenLocated
  SrcSpanAnnA
  (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
o) (GenLocated
  SrcSpanAnnA
  (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> Located
     (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
forall a e. LocatedAn a e -> Located e
reLoc GenLocated
  SrcSpanAnnA
  (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
body) [RType
-> SrcSpan -> [(String, SrcSpan)] -> String -> Refactoring SrcSpan
forall a. RType -> a -> [(String, a)] -> String -> Refactoring a
Replace RType
Stmt (GenLocated
  SrcSpanAnnA
  (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> SrcSpan
forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
toSSA ExprLStmt GhcPs
GenLocated
  SrcSpanAnnA
  (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
o) [(String
"x", GenLocated SrcSpanAnnA (HsExpr GhcPs) -> SrcSpan
forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
toSSA GenLocated SrcSpanAnnA (HsExpr GhcPs)
x)] String
"x"]]

-- Redundant unit return : 'do <return ()>; return ()'.
monadStep
  [ExprLStmt GhcPs] -> LHsExpr GhcPs
wrap o :: [ExprLStmt GhcPs]
o@[ L SrcSpanAnnA
_ (BodyStmt XBodyStmt GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
_ GenLocated SrcSpanAnnA (HsExpr GhcPs)
x SyntaxExpr GhcPs
_ SyntaxExpr GhcPs
_)
         , q :: ExprLStmt GhcPs
q@(L SrcSpanAnnA
_ (BodyStmt XBodyStmt GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
_ (LHsExpr GhcPs -> Maybe (String, LHsExpr GhcPs)
GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> Maybe (String, LHsExpr GhcPs)
fromRet -> Just (String
ret, L SrcSpanAnnA
_ (HsVar XVar GhcPs
_ (L SrcSpanAnnN
_ RdrName
unit)))) SyntaxExpr GhcPs
_ SyntaxExpr GhcPs
_))]
     | LHsExpr GhcPs -> Bool
returnsUnit LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
x, RdrName -> String
occNameStr RdrName
unit String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"()"
  = [String
-> Located (HsExpr GhcPs)
-> Located (HsExpr GhcPs)
-> [Refactoring SrcSpan]
-> Idea
forall a b.
(Outputable a, Outputable b) =>
String -> Located a -> Located b -> [Refactoring SrcSpan] -> Idea
warn (String
"Redundant " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
ret) (GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Located (HsExpr GhcPs)
forall a e. LocatedAn a e -> Located e
reLoc ([ExprLStmt GhcPs] -> LHsExpr GhcPs
wrap [ExprLStmt GhcPs]
o)) (GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Located (HsExpr GhcPs)
forall a e. LocatedAn a e -> Located e
reLoc ([ExprLStmt GhcPs] -> LHsExpr GhcPs
wrap ([ExprLStmt GhcPs] -> LHsExpr GhcPs)
-> [ExprLStmt GhcPs] -> LHsExpr GhcPs
forall a b. (a -> b) -> a -> b
$ Int
-> [GenLocated
      SrcSpanAnnA
      (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> [GenLocated
      SrcSpanAnnA
      (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
forall a. Int -> [a] -> [a]
take Int
1 [ExprLStmt GhcPs]
[GenLocated
   SrcSpanAnnA
   (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
o)) [RType -> SrcSpan -> Refactoring SrcSpan
forall a. RType -> a -> Refactoring a
Delete RType
Stmt (GenLocated
  SrcSpanAnnA
  (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> SrcSpan
forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
toSSA ExprLStmt GhcPs
GenLocated
  SrcSpanAnnA
  (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
q)]]

-- Rewrite 'do x <- $1; return $ f $ g x' as 'f . g <$> x'
monadStep [ExprLStmt GhcPs] -> LHsExpr GhcPs
wrap
  o :: [ExprLStmt GhcPs]
o@[g :: ExprLStmt GhcPs
g@(L SrcSpanAnnA
_ (BindStmt XBindStmt GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
_ (LPat GhcPs -> PVar_
GenLocated SrcSpanAnnA (Pat GhcPs) -> PVar_
forall a b. View a b => a -> b
view -> PVar_ String
u) GenLocated SrcSpanAnnA (HsExpr GhcPs)
x))
    , q :: ExprLStmt GhcPs
q@(L SrcSpanAnnA
_ (BodyStmt XBodyStmt GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
_ (LHsExpr GhcPs -> ([LHsExpr GhcPs], LHsExpr GhcPs)
GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> ([LHsExpr GhcPs], LHsExpr GhcPs)
fromApplies -> (LHsExpr GhcPs
ret:LHsExpr GhcPs
f:[LHsExpr GhcPs]
fs, LHsExpr GhcPs -> Var_
GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Var_
forall a b. View a b => a -> b
view -> Var_ String
v)) SyntaxExpr GhcPs
_ SyntaxExpr GhcPs
_))]
  | LHsExpr GhcPs -> Bool
isReturn LHsExpr GhcPs
ret, LHsExpr GhcPs -> Bool
notDol LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
x, String
u String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
v, [GenLocated SrcSpanAnnA (HsExpr GhcPs)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [LHsExpr GhcPs]
[GenLocated SrcSpanAnnA (HsExpr GhcPs)]
fs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
3, (GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Bool)
-> [GenLocated SrcSpanAnnA (HsExpr GhcPs)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Bool
isSimple (LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
f GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> [GenLocated SrcSpanAnnA (HsExpr GhcPs)]
-> [GenLocated SrcSpanAnnA (HsExpr GhcPs)]
forall a. a -> [a] -> [a]
: [LHsExpr GhcPs]
[GenLocated SrcSpanAnnA (HsExpr GhcPs)]
fs), String
v String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [GenLocated SrcSpanAnnA (HsExpr GhcPs)] -> [String]
forall a. FreeVars a => a -> [String]
vars (LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
f GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> [GenLocated SrcSpanAnnA (HsExpr GhcPs)]
-> [GenLocated SrcSpanAnnA (HsExpr GhcPs)]
forall a. a -> [a] -> [a]
: [LHsExpr GhcPs]
[GenLocated SrcSpanAnnA (HsExpr GhcPs)]
fs)
  =
      [String
-> Located (HsExpr GhcPs)
-> Located (HsExpr GhcPs)
-> [Refactoring SrcSpan]
-> Idea
forall a b.
(Outputable a, Outputable b) =>
String -> Located a -> Located b -> [Refactoring SrcSpan] -> Idea
warn String
"Use <$>" (GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Located (HsExpr GhcPs)
forall a e. LocatedAn a e -> Located e
reLoc ([ExprLStmt GhcPs] -> LHsExpr GhcPs
wrap [ExprLStmt GhcPs]
o)) (GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Located (HsExpr GhcPs)
forall a e. LocatedAn a e -> Located e
reLoc ([ExprLStmt GhcPs] -> LHsExpr GhcPs
wrap [StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> GenLocated
     SrcSpanAnnA
     (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
forall a an. a -> LocatedAn an a
noLocA (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
 -> GenLocated
      SrcSpanAnnA
      (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
-> StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> GenLocated
     SrcSpanAnnA
     (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
forall a b. (a -> b) -> a -> b
$ XBodyStmt GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> SyntaxExpr GhcPs
-> SyntaxExpr GhcPs
-> StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall idL idR body.
XBodyStmt idL idR body
-> body -> SyntaxExpr idR -> SyntaxExpr idR -> StmtLR idL idR body
BodyStmt XBodyStmt GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
NoExtField
noExtField (HsExpr GhcPs -> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall a an. a -> LocatedAn an a
noLocA (HsExpr GhcPs -> GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> HsExpr GhcPs -> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall a b. (a -> b) -> a -> b
$ XOpApp GhcPs
-> LHsExpr GhcPs -> LHsExpr GhcPs -> LHsExpr GhcPs -> HsExpr GhcPs
forall p.
XOpApp p -> LHsExpr p -> LHsExpr p -> LHsExpr p -> HsExpr p
OpApp XOpApp GhcPs
EpAnn [AddEpAnn]
forall ann. EpAnn ann
EpAnnNotUsed ((GenLocated SrcSpanAnnA (HsExpr GhcPs)
 -> GenLocated SrcSpanAnnA (HsExpr GhcPs)
 -> GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> [GenLocated SrcSpanAnnA (HsExpr GhcPs)]
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\GenLocated SrcSpanAnnA (HsExpr GhcPs)
acc GenLocated SrcSpanAnnA (HsExpr GhcPs)
e -> HsExpr GhcPs -> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall a an. a -> LocatedAn an a
noLocA (HsExpr GhcPs -> GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> HsExpr GhcPs -> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall a b. (a -> b) -> a -> b
$ XOpApp GhcPs
-> LHsExpr GhcPs -> LHsExpr GhcPs -> LHsExpr GhcPs -> HsExpr GhcPs
forall p.
XOpApp p -> LHsExpr p -> LHsExpr p -> LHsExpr p -> HsExpr p
OpApp XOpApp GhcPs
EpAnn [AddEpAnn]
forall ann. EpAnn ann
EpAnnNotUsed LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
acc (String -> LHsExpr GhcPs
strToVar String
".") LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
e) LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
f [LHsExpr GhcPs]
[GenLocated SrcSpanAnnA (HsExpr GhcPs)]
fs) (String -> LHsExpr GhcPs
strToVar String
"<$>") LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
x) SyntaxExpr GhcPs
forall (p :: Pass). IsPass p => SyntaxExpr (GhcPass p)
noSyntaxExpr SyntaxExpr GhcPs
forall (p :: Pass). IsPass p => SyntaxExpr (GhcPass p)
noSyntaxExpr]))
      [RType
-> SrcSpan -> [(String, SrcSpan)] -> String -> Refactoring SrcSpan
forall a. RType -> a -> [(String, a)] -> String -> Refactoring a
Replace RType
Stmt (GenLocated
  SrcSpanAnnA
  (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> SrcSpan
forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
toSSA ExprLStmt GhcPs
GenLocated
  SrcSpanAnnA
  (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
g) ((String
"x", GenLocated SrcSpanAnnA (HsExpr GhcPs) -> SrcSpan
forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
toSSA GenLocated SrcSpanAnnA (HsExpr GhcPs)
x)(String, SrcSpan) -> [(String, SrcSpan)] -> [(String, SrcSpan)]
forall a. a -> [a] -> [a]
:[String] -> [SrcSpan] -> [(String, SrcSpan)]
forall a b. [a] -> [b] -> [(a, b)]
zip [String]
vs (GenLocated SrcSpanAnnA (HsExpr GhcPs) -> SrcSpan
forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
toSSA (GenLocated SrcSpanAnnA (HsExpr GhcPs) -> SrcSpan)
-> [GenLocated SrcSpanAnnA (HsExpr GhcPs)] -> [SrcSpan]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
fGenLocated SrcSpanAnnA (HsExpr GhcPs)
-> [GenLocated SrcSpanAnnA (HsExpr GhcPs)]
-> [GenLocated SrcSpanAnnA (HsExpr GhcPs)]
forall a. a -> [a] -> [a]
:[LHsExpr GhcPs]
[GenLocated SrcSpanAnnA (HsExpr GhcPs)]
fs)) (String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
" . " (Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
take ([GenLocated SrcSpanAnnA (HsExpr GhcPs)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [LHsExpr GhcPs]
[GenLocated SrcSpanAnnA (HsExpr GhcPs)]
fs Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) [String]
vs) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" <$> x"), RType -> SrcSpan -> Refactoring SrcSpan
forall a. RType -> a -> Refactoring a
Delete RType
Stmt (GenLocated
  SrcSpanAnnA
  (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> SrcSpan
forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
toSSA ExprLStmt GhcPs
GenLocated
  SrcSpanAnnA
  (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
q)]]
  where
    isSimple :: LHsExpr GhcPs -> Bool
isSimple (LHsExpr GhcPs -> [LHsExpr GhcPs]
fromApps -> [LHsExpr GhcPs]
xs) = (GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Bool)
-> [GenLocated SrcSpanAnnA (HsExpr GhcPs)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Bool
forall a. Brackets a => a -> Bool
isAtom (GenLocated SrcSpanAnnA (HsExpr GhcPs)
x GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> [GenLocated SrcSpanAnnA (HsExpr GhcPs)]
-> [GenLocated SrcSpanAnnA (HsExpr GhcPs)]
forall a. a -> [a] -> [a]
: [LHsExpr GhcPs]
[GenLocated SrcSpanAnnA (HsExpr GhcPs)]
xs)
    vs :: [String]
vs = (Char
'f'Char -> String -> String
forall a. a -> [a] -> [a]
:) (String -> String) -> (Integer -> String) -> Integer -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> String
forall a. Show a => a -> String
show (Integer -> String) -> [Integer] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Integer
0..]

    notDol :: LHsExpr GhcPs -> Bool
    notDol :: LHsExpr GhcPs -> Bool
notDol (L SrcSpanAnnA
_ (OpApp XOpApp GhcPs
_ LHsExpr GhcPs
_ LHsExpr GhcPs
op LHsExpr GhcPs
_)) = Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ LHsExpr GhcPs -> Bool
isDol LHsExpr GhcPs
op
    notDol LHsExpr GhcPs
_ = Bool
True
monadStep [ExprLStmt GhcPs] -> LHsExpr GhcPs
_ [ExprLStmt GhcPs]
_ = []

-- Suggest removing a return
monadSteps :: ([ExprLStmt GhcPs] -> LHsExpr GhcPs) -> [ExprLStmt GhcPs] -> [Idea]
monadSteps :: ([ExprLStmt GhcPs] -> LHsExpr GhcPs) -> [ExprLStmt GhcPs] -> [Idea]
monadSteps [ExprLStmt GhcPs] -> LHsExpr GhcPs
wrap (ExprLStmt GhcPs
x : [ExprLStmt GhcPs]
xs) = ([ExprLStmt GhcPs] -> LHsExpr GhcPs) -> [ExprLStmt GhcPs] -> [Idea]
monadStep [ExprLStmt GhcPs] -> LHsExpr GhcPs
wrap (ExprLStmt GhcPs
GenLocated
  SrcSpanAnnA
  (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
x GenLocated
  SrcSpanAnnA
  (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> [GenLocated
      SrcSpanAnnA
      (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> [GenLocated
      SrcSpanAnnA
      (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
forall a. a -> [a] -> [a]
: [ExprLStmt GhcPs]
[GenLocated
   SrcSpanAnnA
   (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
xs) [Idea] -> [Idea] -> [Idea]
forall a. [a] -> [a] -> [a]
++ ([ExprLStmt GhcPs] -> LHsExpr GhcPs) -> [ExprLStmt GhcPs] -> [Idea]
monadSteps ([ExprLStmt GhcPs] -> LHsExpr GhcPs
[GenLocated
   SrcSpanAnnA
   (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
wrap ([GenLocated
    SrcSpanAnnA
    (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
 -> GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> ([GenLocated
       SrcSpanAnnA
       (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
    -> [GenLocated
          SrcSpanAnnA
          (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))])
-> [GenLocated
      SrcSpanAnnA
      (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ExprLStmt GhcPs
GenLocated
  SrcSpanAnnA
  (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
x GenLocated
  SrcSpanAnnA
  (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> [GenLocated
      SrcSpanAnnA
      (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> [GenLocated
      SrcSpanAnnA
      (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
forall a. a -> [a] -> [a]
:)) [ExprLStmt GhcPs]
xs
monadSteps [ExprLStmt GhcPs] -> LHsExpr GhcPs
_ [ExprLStmt GhcPs]
_ = []

-- | Rewrite 'do ...; x <- return y; ...' as 'do ...; let x = y; ...'.
monadLet :: [ExprLStmt GhcPs] -> [(ExprLStmt GhcPs, ExprLStmt GhcPs, Refactoring R.SrcSpan)]
monadLet :: [ExprLStmt GhcPs]
-> [(ExprLStmt GhcPs, ExprLStmt GhcPs, Refactoring SrcSpan)]
monadLet [ExprLStmt GhcPs]
xs = (GenLocated
   SrcSpanAnnA
   (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
 -> Maybe
      (GenLocated
         SrcSpanAnnA
         (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))),
       GenLocated
         SrcSpanAnnA
         (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))),
       Refactoring SrcSpan))
-> [GenLocated
      SrcSpanAnnA
      (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> [(GenLocated
       SrcSpanAnnA
       (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))),
     GenLocated
       SrcSpanAnnA
       (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))),
     Refactoring SrcSpan)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe ExprLStmt GhcPs
-> Maybe (ExprLStmt GhcPs, ExprLStmt GhcPs, Refactoring SrcSpan)
GenLocated
  SrcSpanAnnA
  (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> Maybe
     (GenLocated
        SrcSpanAnnA
        (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))),
      GenLocated
        SrcSpanAnnA
        (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))),
      Refactoring SrcSpan)
mkLet [ExprLStmt GhcPs]
[GenLocated
   SrcSpanAnnA
   (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
xs
  where
    vs :: [String]
vs = (GenLocated SrcSpanAnnA (Pat GhcPs) -> [String])
-> [GenLocated SrcSpanAnnA (Pat GhcPs)] -> [String]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap GenLocated SrcSpanAnnA (Pat GhcPs) -> [String]
forall a. AllVars a => a -> [String]
pvars [LPat GhcPs
GenLocated SrcSpanAnnA (Pat GhcPs)
p | (L SrcSpanAnnA
_ (BindStmt XBindStmt GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
_ LPat GhcPs
p GenLocated SrcSpanAnnA (HsExpr GhcPs)
_ )) <- [ExprLStmt GhcPs]
[GenLocated
   SrcSpanAnnA
   (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
xs]

    mkLet :: ExprLStmt GhcPs -> Maybe (ExprLStmt GhcPs, ExprLStmt GhcPs, Refactoring R.SrcSpan)
    mkLet :: ExprLStmt GhcPs
-> Maybe (ExprLStmt GhcPs, ExprLStmt GhcPs, Refactoring SrcSpan)
mkLet x :: ExprLStmt GhcPs
x@(L SrcSpanAnnA
_ (BindStmt XBindStmt GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
_ v :: LPat GhcPs
v@(LPat GhcPs -> PVar_
GenLocated SrcSpanAnnA (Pat GhcPs) -> PVar_
forall a b. View a b => a -> b
view -> PVar_ String
p) (LHsExpr GhcPs -> Maybe (String, LHsExpr GhcPs)
GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> Maybe (String, LHsExpr GhcPs)
fromRet -> Just (String
_, LHsExpr GhcPs
y))))
      | String
p String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` GenLocated SrcSpanAnnA (HsExpr GhcPs) -> [String]
forall a. FreeVars a => a -> [String]
vars LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
y, String
p String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` String -> [String] -> [String]
forall a. Eq a => a -> [a] -> [a]
delete String
p [String]
vs
      = (GenLocated
   SrcSpanAnnA
   (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))),
 GenLocated
   SrcSpanAnnA
   (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))),
 Refactoring SrcSpan)
-> Maybe
     (GenLocated
        SrcSpanAnnA
        (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))),
      GenLocated
        SrcSpanAnnA
        (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))),
      Refactoring SrcSpan)
forall a. a -> Maybe a
Just (ExprLStmt GhcPs
GenLocated
  SrcSpanAnnA
  (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
x, String -> LHsExpr GhcPs -> ExprLStmt GhcPs
template String
p LHsExpr GhcPs
y, Refactoring SrcSpan
refact)
      where
        refact :: Refactoring SrcSpan
refact = RType
-> SrcSpan -> [(String, SrcSpan)] -> String -> Refactoring SrcSpan
forall a. RType -> a -> [(String, a)] -> String -> Refactoring a
Replace RType
Stmt (GenLocated
  SrcSpanAnnA
  (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> SrcSpan
forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
toSSA ExprLStmt GhcPs
GenLocated
  SrcSpanAnnA
  (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
x) [(String
"lhs", GenLocated SrcSpanAnnA (Pat GhcPs) -> SrcSpan
forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
toSSA LPat GhcPs
GenLocated SrcSpanAnnA (Pat GhcPs)
v), (String
"rhs", GenLocated SrcSpanAnnA (HsExpr GhcPs) -> SrcSpan
forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
toSSA LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
y)]
                      (ExprLStmt GhcPs -> String
forall a. Outputable a => a -> String
unsafePrettyPrint (ExprLStmt GhcPs -> String) -> ExprLStmt GhcPs -> String
forall a b. (a -> b) -> a -> b
$ String -> LHsExpr GhcPs -> ExprLStmt GhcPs
template String
"lhs" (String -> LHsExpr GhcPs
strToVar String
"rhs"))
    mkLet ExprLStmt GhcPs
_ = Maybe (ExprLStmt GhcPs, ExprLStmt GhcPs, Refactoring SrcSpan)
Maybe
  (GenLocated
     SrcSpanAnnA
     (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))),
   GenLocated
     SrcSpanAnnA
     (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))),
   Refactoring SrcSpan)
forall a. Maybe a
Nothing

    template :: String -> LHsExpr GhcPs -> ExprLStmt GhcPs
    template :: String -> LHsExpr GhcPs -> ExprLStmt GhcPs
template String
lhs LHsExpr GhcPs
rhs =
        let p :: LocatedAn an RdrName
p = RdrName -> LocatedAn an RdrName
forall a an. a -> LocatedAn an a
noLocA (RdrName -> LocatedAn an RdrName)
-> RdrName -> LocatedAn an RdrName
forall a b. (a -> b) -> a -> b
$ OccName -> RdrName
mkRdrUnqual (String -> OccName
mkVarOcc String
lhs)
            grhs :: LocatedAn an (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
grhs = GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> LocatedAn
     an (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
forall a an. a -> LocatedAn an a
noLocA (XCGRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> [ExprLStmt GhcPs]
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall p body.
XCGRHS p body -> [GuardLStmt p] -> body -> GRHS p body
GRHS XCGRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
EpAnn GrhsAnn
forall ann. EpAnn ann
EpAnnNotUsed [] LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
rhs)
            grhss :: GRHSs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
grhss = XCGRHSs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> [LGRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
-> HsLocalBinds GhcPs
-> GRHSs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall p body.
XCGRHSs p body -> [LGRHS p body] -> HsLocalBinds p -> GRHSs p body
GRHSs XCGRHSs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
EpAnnComments
emptyComments [LGRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
LocatedAn
  NoEpAnns (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
forall {an}.
LocatedAn an (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
grhs] (XEmptyLocalBinds GhcPs GhcPs -> HsLocalBinds GhcPs
forall idL idR. XEmptyLocalBinds idL idR -> HsLocalBindsLR idL idR
EmptyLocalBinds XEmptyLocalBinds GhcPs GhcPs
NoExtField
noExtField)
            match :: LocatedAn an (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
match = Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> LocatedAn
     an (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
forall a an. a -> LocatedAn an a
noLocA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
 -> LocatedAn
      an (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
-> Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> LocatedAn
     an (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
forall a b. (a -> b) -> a -> b
$ XCMatch GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> HsMatchContext GhcPs
-> [LPat GhcPs]
-> GRHSs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall p body.
XCMatch p body
-> HsMatchContext p -> [LPat p] -> GRHSs p body -> Match p body
Match XCMatch GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
EpAnn [AddEpAnn]
forall ann. EpAnn ann
EpAnnNotUsed (LIdP (NoGhcTc GhcPs)
-> LexicalFixity -> SrcStrictness -> HsMatchContext GhcPs
forall p.
LIdP (NoGhcTc p)
-> LexicalFixity -> SrcStrictness -> HsMatchContext p
FunRhs LIdP (NoGhcTc GhcPs)
GenLocated SrcSpanAnnN RdrName
forall {an}. LocatedAn an RdrName
p LexicalFixity
Prefix SrcStrictness
NoSrcStrict) [] GRHSs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
grhss
            fb :: LocatedAn an (HsBindLR GhcPs GhcPs)
fb = HsBindLR GhcPs GhcPs -> LocatedAn an (HsBindLR GhcPs GhcPs)
forall a an. a -> LocatedAn an a
noLocA (HsBindLR GhcPs GhcPs -> LocatedAn an (HsBindLR GhcPs GhcPs))
-> HsBindLR GhcPs GhcPs -> LocatedAn an (HsBindLR GhcPs GhcPs)
forall a b. (a -> b) -> a -> b
$ XFunBind GhcPs GhcPs
-> LIdP GhcPs
-> MatchGroup GhcPs (LHsExpr GhcPs)
-> HsBindLR GhcPs GhcPs
forall idL idR.
XFunBind idL idR
-> LIdP idL -> MatchGroup idR (LHsExpr idR) -> HsBindLR idL idR
FunBind XFunBind GhcPs GhcPs
NoExtField
noExtField LIdP GhcPs
GenLocated SrcSpanAnnN RdrName
forall {an}. LocatedAn an RdrName
p (XMG GhcPs (LHsExpr GhcPs)
-> XRec GhcPs [LMatch GhcPs (LHsExpr GhcPs)]
-> MatchGroup GhcPs (LHsExpr GhcPs)
forall p body.
XMG p body -> XRec p [LMatch p body] -> MatchGroup p body
MG (DoPmc -> Origin
Generated DoPmc
DoPmc) ([LocatedAn
   AnnListItem (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> LocatedAn
     AnnList
     [LocatedAn
        AnnListItem (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
forall a an. a -> LocatedAn an a
noLocA [LocatedAn
  AnnListItem (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
forall {an}.
LocatedAn an (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
match]))
            binds :: Bag (LocatedAn an (HsBindLR GhcPs GhcPs))
binds = LocatedAn an (HsBindLR GhcPs GhcPs)
-> Bag (LocatedAn an (HsBindLR GhcPs GhcPs))
forall a. a -> Bag a
unitBag LocatedAn an (HsBindLR GhcPs GhcPs)
forall {an}. LocatedAn an (HsBindLR GhcPs GhcPs)
fb
            valBinds :: HsValBindsLR GhcPs GhcPs
valBinds = XValBinds GhcPs GhcPs
-> LHsBindsLR GhcPs GhcPs
-> [LSig GhcPs]
-> HsValBindsLR GhcPs GhcPs
forall idL idR.
XValBinds idL idR
-> LHsBindsLR idL idR -> [LSig idR] -> HsValBindsLR idL idR
ValBinds XValBinds GhcPs GhcPs
AnnSortKey
NoAnnSortKey LHsBindsLR GhcPs GhcPs
Bag (LocatedAn AnnListItem (HsBindLR GhcPs GhcPs))
forall {an}. Bag (LocatedAn an (HsBindLR GhcPs GhcPs))
binds []
            localBinds :: HsLocalBinds GhcPs
localBinds = XHsValBinds GhcPs GhcPs
-> HsValBindsLR GhcPs GhcPs -> HsLocalBinds GhcPs
forall idL idR.
XHsValBinds idL idR
-> HsValBindsLR idL idR -> HsLocalBindsLR idL idR
HsValBinds XHsValBinds GhcPs GhcPs
EpAnn AnnList
forall ann. EpAnn ann
EpAnnNotUsed HsValBindsLR GhcPs GhcPs
valBinds
         in StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> GenLocated
     SrcSpanAnnA
     (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
forall a an. a -> LocatedAn an a
noLocA (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
 -> GenLocated
      SrcSpanAnnA
      (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
-> StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> GenLocated
     SrcSpanAnnA
     (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
forall a b. (a -> b) -> a -> b
$ XLetStmt GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> HsLocalBinds GhcPs
-> StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall idL idR body.
XLetStmt idL idR body
-> HsLocalBindsLR idL idR -> StmtLR idL idR body
LetStmt XLetStmt GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
EpAnn [AddEpAnn]
forall ann. EpAnn ann
EpAnnNotUsed HsLocalBinds GhcPs
localBinds

fromApplies :: LHsExpr GhcPs -> ([LHsExpr GhcPs], LHsExpr GhcPs)
fromApplies :: LHsExpr GhcPs -> ([LHsExpr GhcPs], LHsExpr GhcPs)
fromApplies (L SrcSpanAnnA
_ (HsApp XApp GhcPs
_ LHsExpr GhcPs
f LHsExpr GhcPs
x)) = ([LHsExpr GhcPs] -> [LHsExpr GhcPs])
-> ([LHsExpr GhcPs], LHsExpr GhcPs)
-> ([LHsExpr GhcPs], LHsExpr GhcPs)
forall a a' b. (a -> a') -> (a, b) -> (a', b)
first (LHsExpr GhcPs
fLHsExpr GhcPs -> [LHsExpr GhcPs] -> [LHsExpr GhcPs]
forall a. a -> [a] -> [a]
:) (([LHsExpr GhcPs], LHsExpr GhcPs)
 -> ([LHsExpr GhcPs], LHsExpr GhcPs))
-> ([LHsExpr GhcPs], LHsExpr GhcPs)
-> ([LHsExpr GhcPs], LHsExpr GhcPs)
forall a b. (a -> b) -> a -> b
$ LHsExpr GhcPs -> ([LHsExpr GhcPs], LHsExpr GhcPs)
fromApplies (GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
fromParen LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
x)
fromApplies (L SrcSpanAnnA
_ (OpApp XOpApp GhcPs
_ LHsExpr GhcPs
f (LHsExpr GhcPs -> Bool
isDol -> Bool
True) LHsExpr GhcPs
x)) = ([LHsExpr GhcPs] -> [LHsExpr GhcPs])
-> ([LHsExpr GhcPs], LHsExpr GhcPs)
-> ([LHsExpr GhcPs], LHsExpr GhcPs)
forall a a' b. (a -> a') -> (a, b) -> (a', b)
first (LHsExpr GhcPs
fLHsExpr GhcPs -> [LHsExpr GhcPs] -> [LHsExpr GhcPs]
forall a. a -> [a] -> [a]
:) (([LHsExpr GhcPs], LHsExpr GhcPs)
 -> ([LHsExpr GhcPs], LHsExpr GhcPs))
-> ([LHsExpr GhcPs], LHsExpr GhcPs)
-> ([LHsExpr GhcPs], LHsExpr GhcPs)
forall a b. (a -> b) -> a -> b
$ LHsExpr GhcPs -> ([LHsExpr GhcPs], LHsExpr GhcPs)
fromApplies LHsExpr GhcPs
x
fromApplies LHsExpr GhcPs
x = ([], LHsExpr GhcPs
x)

fromRet :: LHsExpr GhcPs -> Maybe (String, LHsExpr GhcPs)
fromRet :: LHsExpr GhcPs -> Maybe (String, LHsExpr GhcPs)
fromRet (L SrcSpanAnnA
_ (HsPar XPar GhcPs
_ LHsToken "(" GhcPs
_ LHsExpr GhcPs
x LHsToken ")" GhcPs
_)) = LHsExpr GhcPs -> Maybe (String, LHsExpr GhcPs)
fromRet LHsExpr GhcPs
x
fromRet (L SrcSpanAnnA
_ (OpApp XOpApp GhcPs
_ LHsExpr GhcPs
x (L SrcSpanAnnA
_ (HsVar XVar GhcPs
_ (L SrcSpanAnnN
_ RdrName
y))) LHsExpr GhcPs
z)) | RdrName -> String
occNameStr RdrName
y String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"$" = LHsExpr GhcPs -> Maybe (String, LHsExpr GhcPs)
fromRet (LHsExpr GhcPs -> Maybe (String, LHsExpr GhcPs))
-> LHsExpr GhcPs -> Maybe (String, LHsExpr GhcPs)
forall a b. (a -> b) -> a -> b
$ HsExpr GhcPs -> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall a an. a -> LocatedAn an a
noLocA (XApp GhcPs -> LHsExpr GhcPs -> LHsExpr GhcPs -> HsExpr GhcPs
forall p. XApp p -> LHsExpr p -> LHsExpr p -> HsExpr p
HsApp XApp GhcPs
EpAnn NoEpAnns
forall ann. EpAnn ann
EpAnnNotUsed LHsExpr GhcPs
x LHsExpr GhcPs
z)
fromRet (L SrcSpanAnnA
_ (HsApp XApp GhcPs
_ LHsExpr GhcPs
x LHsExpr GhcPs
y)) | LHsExpr GhcPs -> Bool
isReturn LHsExpr GhcPs
x = (String, GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> Maybe (String, GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall a. a -> Maybe a
Just (GenLocated SrcSpanAnnA (HsExpr GhcPs) -> String
forall a. Outputable a => a -> String
unsafePrettyPrint LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
x, LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
y)
fromRet LHsExpr GhcPs
_ = Maybe (String, LHsExpr GhcPs)
Maybe (String, GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall a. Maybe a
Nothing