{-# LANGUAGE ImportQualifiedPost #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE PatternGuards #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE ViewPatterns #-}
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 = 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 forall a. Maybe a
Nothing forall a. Maybe a
Nothing) forall a b. (a -> b) -> a -> b
$ forall from to. Biplate from to => from -> [to]
childrenBi LHsDecl 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 (GenLocated SrcSpanAnnA (HsExpr GhcPs))
parentDo Maybe (Int, GenLocated SrcSpanAnnA (HsExpr GhcPs))
parentExpr GenLocated SrcSpanAnnA (HsExpr GhcPs)
x forall a. [a] -> [a] -> [a]
++
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 forall {l} {p}. GenLocated l (HsExpr p) -> Bool
isHsDo GenLocated SrcSpanAnnA (HsExpr GhcPs)
x then forall a. a -> Maybe a
Just GenLocated SrcSpanAnnA (HsExpr GhcPs)
x else Maybe (GenLocated SrcSpanAnnA (HsExpr GhcPs))
parentDo) (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) <- forall a b. Enum a => a -> [b] -> [(a, b)]
zipFrom Int
0 forall a b. (a -> b) -> a -> b
$ 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
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
(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
">>" GenLocated SrcSpanAnnA (HsExpr GhcPs)
op -> GenLocated SrcSpanAnnA (HsExpr GhcPs) -> [Idea]
f GenLocated SrcSpanAnnA (HsExpr GhcPs)
x1
(forall a b. View a b => a -> b
view -> App2 GenLocated SrcSpanAnnA (HsExpr GhcPs)
op GenLocated SrcSpanAnnA (HsExpr GhcPs)
x1 (forall a b. View a b => a -> b
view -> LamConst1 GenLocated SrcSpanAnnA (HsExpr GhcPs)
_)) | String -> LHsExpr GhcPs -> Bool
isTag String
">>=" 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 -> forall {e} {a}.
Outputable e =>
(GenLocated SrcSpanAnnA (HsExpr GhcPs) -> LocatedAn a e)
-> GenLocated SrcSpanAnnA (HsExpr GhcPs) -> [Idea]
seenVoid (forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall p. XApp p -> LHsExpr p -> LHsExpr p -> HsExpr p
HsApp forall ann. EpAnn ann
EpAnnNotUsed LHsExpr GhcPs
op) LHsExpr 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 -> forall {e} {a}.
Outputable e =>
(GenLocated SrcSpanAnnA (HsExpr GhcPs) -> LocatedAn a e)
-> GenLocated SrcSpanAnnA (HsExpr GhcPs) -> [Idea]
seenVoid (forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall p.
XOpApp p -> LHsExpr p -> LHsExpr p -> LHsExpr p -> HsExpr p
OpApp forall ann. EpAnn ann
EpAnnNotUsed LHsExpr GhcPs
op LHsExpr GhcPs
dol) LHsExpr 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 " forall a. [a] -> [a] -> [a]
++ String
doOrMDo) (forall {t :: * -> *} {a}. Foldable t => t a -> SrcSpan -> SrcSpan
doSpan String
doOrMDo (forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
loc)) String
doOrMDo [forall a. RType -> a -> [(String, a)] -> String -> Refactoring a
Replace RType
Expr (forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
toSSA LHsExpr GhcPs
x) [(String
"y", forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
toSSA GenLocated SrcSpanAnnA (HsExpr GhcPs)
y)] String
"y"]
| Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ Maybe (Int, LHsExpr GhcPs) -> LHsExpr GhcPs -> Bool
doAsBrackets Maybe (Int, LHsExpr GhcPs)
parentExpr GenLocated SrcSpanAnnA (HsExpr GhcPs)
y
, Bool -> Bool
not 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 (forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
loc forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall p. XDo p -> HsDoFlavour -> XRec p [ExprLStmt p] -> HsExpr p
HsDo forall ann. EpAnn ann
EpAnnNotUsed (Maybe ModuleName -> HsDoFlavour
DoExpr Maybe ModuleName
mm) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a an. a -> LocatedAn an a
noLocA) [GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
xs forall a. [a] -> [a] -> [a]
++
[forall a b.
(Outputable a, Outputable b) =>
String -> Located a -> Located b -> [Refactoring SrcSpan] -> Idea
suggest String
"Use let" (forall a e. LocatedAn a e -> Located e
reLoc GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
from) (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 [GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
xs] forall a. [a] -> [a] -> [a]
++
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
_)) <- forall a. [a] -> [a]
dropEnd1 [GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
xs] forall a. [a] -> [a] -> [a]
++
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)) <- 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 (forall a. a -> Maybe a -> a
fromMaybe String
"" Maybe String
decl) 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l forall b c a. (b -> c) -> (a -> b) -> a -> c
. \GenLocated SrcSpanAnnA (HsExpr GhcPs)
y -> forall p.
XPar p -> LHsToken "(" p -> LHsExpr p -> LHsToken ")" p -> HsExpr p
HsPar XPar GhcPs
x LHsToken "(" GhcPs
p GenLocated SrcSpanAnnA (HsExpr GhcPs)
y LHsToken ")" GhcPs
q) LHsExpr GhcPs
y
seenVoid GenLocated SrcSpanAnnA (HsExpr GhcPs) -> LocatedAn a e
wrap GenLocated SrcSpanAnnA (HsExpr GhcPs)
x =
[forall a b.
(Outputable a, Outputable b) =>
String -> Located a -> Located b -> [Refactoring SrcSpan] -> Idea
warn String
"Redundant void" (forall a e. LocatedAn a e -> Located e
reLoc (GenLocated SrcSpanAnnA (HsExpr GhcPs) -> LocatedAn a e
wrap GenLocated SrcSpanAnnA (HsExpr GhcPs)
x)) (forall a e. LocatedAn a e -> Located e
reLoc GenLocated SrcSpanAnnA (HsExpr GhcPs)
x) [forall a. RType -> a -> [(String, a)] -> String -> Refactoring a
Replace RType
Expr (forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
toSSA (GenLocated SrcSpanAnnA (HsExpr GhcPs) -> LocatedAn a e
wrap GenLocated SrcSpanAnnA (HsExpr GhcPs)
x)) [(String
"a", forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
toSSA GenLocated SrcSpanAnnA (HsExpr GhcPs)
x)] String
"a"] | LHsExpr GhcPs -> Bool
returnsUnit GenLocated SrcSpanAnnA (HsExpr GhcPs)
x]
forall a. [a] -> [a] -> [a]
++ ( case 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 forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
badFuncs
then forall l e. l -> e -> GenLocated l e
L SrcSpanAnnN
l (OccName -> RdrName
mkRdrUnqual (String -> OccName
mkVarOcc (RdrName -> String
occNameStr RdrName
name forall a. [a] -> [a] -> [a]
++ String
"_")))
else LIdP GhcPs
fun,
LIdP GhcPs
fun
)
)
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 forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
badFuncs ->
let fun_ :: String
fun_ = RdrName -> String
occNameStr RdrName
name forall a. [a] -> [a] -> [a]
++ String
"_"
in [forall a b.
(Outputable a, Outputable b) =>
String -> Located a -> Located b -> [Refactoring SrcSpan] -> Idea
warn (String
"Use " forall a. [a] -> [a] -> [a]
++ String
fun_) (forall a e. LocatedAn a e -> Located e
reLoc (GenLocated SrcSpanAnnA (HsExpr GhcPs) -> LocatedAn a e
wrap GenLocated SrcSpanAnnA (HsExpr GhcPs)
x)) (forall a e. LocatedAn a e -> Located e
reLoc LHsExpr GhcPs
x')
[forall a. RType -> a -> [(String, a)] -> String -> Refactoring a
Replace RType
Expr (forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
toSSA (GenLocated SrcSpanAnnA (HsExpr GhcPs) -> LocatedAn a e
wrap GenLocated SrcSpanAnnA (HsExpr GhcPs)
x)) [(String
"a", forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
toSSA GenLocated SrcSpanAnnA (HsExpr GhcPs)
x)] String
"a",
forall a. RType -> a -> [(String, a)] -> String -> Refactoring a
Replace RType
Expr (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 forall a. Num a => a -> a -> a
+ 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) forall a. Maybe a
GHC.Data.Strict.Nothing
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
doAsBrackets (Just (Int
i, LHsExpr GhcPs
o)) LHsExpr GhcPs
x = forall a. Brackets a => Int -> a -> a -> Bool
needBracket Int
i LHsExpr GhcPs
o LHsExpr GhcPs
x
doAsBrackets Maybe (Int, LHsExpr GhcPs)
Nothing LHsExpr GhcPs
x = Bool
False
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 forall a. Eq a => a -> a -> Bool
== RealSrcSpan -> Int
srcSpanStartCol RealSrcSpan
b
doAsAvoidingIndentation Maybe (LHsExpr GhcPs)
parent LHsExpr GhcPs
self = Bool
False
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 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
wrap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l forall b c a. (b -> c) -> (a -> b) -> a -> c
. \GenLocated SrcSpanAnnA (HsExpr GhcPs)
y -> forall p.
XPar p -> LHsToken "(" p -> LHsExpr p -> LHsToken ")" p -> HsExpr p
HsPar forall ann. EpAnn ann
EpAnnNotUsed LHsToken "(" GhcPs
p 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 forall a b. (a -> b) -> a -> b
$ forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l (forall p. XApp p -> LHsExpr p -> LHsExpr p -> HsExpr p
HsApp 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 forall a b. (a -> b) -> a -> b
$ forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l (forall p.
XOpApp p -> LHsExpr p -> LHsExpr p -> LHsExpr p -> HsExpr p
OpApp 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 (forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l (forall p. XVar p -> LIdP p -> HsExpr p
HsVar NoExtField
NoExtField GenLocated SrcSpanAnnN RdrName
x')), 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, forall a. Maybe a
Nothing)
returnsUnit :: LHsExpr GhcPs -> Bool
returnsUnit :: LHsExpr GhcPs -> Bool
returnsUnit = forall a. a -> Maybe a -> a
fromMaybe Bool
False
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a.
(LIdP GhcPs -> (LIdP GhcPs, a))
-> LHsExpr GhcPs -> (LHsExpr GhcPs, Maybe a)
modifyAppHead (\LIdP GhcPs
x -> (LIdP GhcPs
x, RdrName -> String
occNameStr (forall l e. GenLocated l e -> e
unLoc LIdP GhcPs
x) forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` forall a b. (a -> b) -> [a] -> [b]
map (forall a. [a] -> [a] -> [a]
++ String
"_") [String]
badFuncs forall a. [a] -> [a] -> [a]
++ [String]
unitFuncs))
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
wrap forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 forall a b. (a -> b) -> a -> b
$ forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l (forall p. XApp p -> LHsExpr p -> LHsExpr p -> HsExpr p
HsApp 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 forall a b. (a -> b) -> a -> b
$ forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l (forall p.
XOpApp p -> LHsExpr p -> LHsExpr p -> LHsExpr p -> HsExpr p
OpApp forall ann. EpAnn ann
EpAnnNotUsed LHsExpr GhcPs
x LHsExpr GhcPs
tag LHsExpr GhcPs
y)) LHsExpr GhcPs
x
| RdrName -> String
occNameStr RdrName
op forall a. Eq a => a -> a -> Bool
== String
">>=" = String
-> (LHsExpr GhcPs -> LHsExpr GhcPs) -> LHsExpr GhcPs -> [Idea]
monadNoResult String
inside (LHsExpr GhcPs -> LHsExpr GhcPs
wrap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall p.
XOpApp p -> LHsExpr p -> LHsExpr p -> LHsExpr p -> HsExpr p
OpApp 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]
_ <- forall a. (a -> Bool) -> [a] -> [a]
filter (String -> LHsExpr GhcPs -> Bool
`isTag` LHsExpr GhcPs
x) [String]
badFuncs
, let x3 :: String
x3 = String
x2 forall a. [a] -> [a] -> [a]
++ String
"_"
= [forall a b.
(Outputable a, Outputable b) =>
String -> Located a -> Located b -> [Refactoring SrcSpan] -> Idea
warn (String
"Use " forall a. [a] -> [a] -> [a]
++ String
x3) (forall a e. LocatedAn a e -> Located e
reLoc (LHsExpr GhcPs -> LHsExpr GhcPs
wrap LHsExpr GhcPs
x)) (forall a e. LocatedAn a e -> Located e
reLoc (LHsExpr GhcPs -> LHsExpr GhcPs
wrap forall a b. (a -> b) -> a -> b
$ String -> LHsExpr GhcPs
strToVar String
x3)) [forall a. RType -> a -> [(String, a)] -> String -> Refactoring a
Replace RType
Expr (forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
toSSA LHsExpr GhcPs
x) [] String
x3] | String
inside 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)) =
forall a b. (a -> b) -> [a] -> [b]
map (\Idea
x -> Idea
x{ideaNote :: [Note]
ideaNote=forall a. Ord a => [a] -> [a]
nubOrd forall a b. (a -> b) -> a -> b
$ String -> Note
Note String
"May require adding void to other branches" forall a. a -> [a] -> [a]
: Idea -> [Note]
ideaNote Idea
x}) forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[String
-> (LHsExpr GhcPs -> LHsExpr GhcPs) -> LHsExpr GhcPs -> [Idea]
monadNoResult String
inside forall a. a -> a
id GenLocated SrcSpanAnnA (HsExpr GhcPs)
b | GenLocated SrcSpanAnnA (HsExpr GhcPs)
b <- [LHsExpr GhcPs]
bs]
monadStep :: ([ExprLStmt GhcPs] -> LHsExpr GhcPs)
-> [ExprLStmt GhcPs] -> [Idea]
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)
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 " forall a. [a] -> [a] -> [a]
++ String
ret) (forall a. SrcSpanAnn' a -> SrcSpan
locA (forall l e. GenLocated l e -> l
getLoc ExprLStmt GhcPs
o)) (forall a. Outputable a => a -> String
unsafePrettyPrint ExprLStmt GhcPs
o) [forall a. RType -> a -> Refactoring a
Delete RType
Stmt (forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
toSSA ExprLStmt GhcPs
o)]]
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)
fromRet -> Just (String
ret, L SrcSpanAnnA
_ (HsVar XVar GhcPs
_ (L SrcSpanAnnN
_ RdrName
v)))) SyntaxExpr GhcPs
_ SyntaxExpr GhcPs
_))]
| RdrName -> String
occNameStr RdrName
p forall a. Eq a => a -> a -> Bool
== RdrName -> String
occNameStr RdrName
v
= [forall a b.
(Outputable a, Outputable b) =>
String -> Located a -> Located b -> [Refactoring SrcSpan] -> Idea
warn (String
"Redundant " forall a. [a] -> [a] -> [a]
++ String
ret) (forall a e. LocatedAn a e -> Located e
reLoc ([ExprLStmt GhcPs] -> LHsExpr GhcPs
wrap [ExprLStmt GhcPs]
o)) (forall a e. LocatedAn a e -> Located e
reLoc ([ExprLStmt GhcPs] -> LHsExpr GhcPs
wrap [forall a an. a -> LocatedAn an a
noLocA forall a b. (a -> b) -> a -> b
$ forall idL idR body.
XBodyStmt idL idR body
-> body -> SyntaxExpr idR -> SyntaxExpr idR -> StmtLR idL idR body
BodyStmt NoExtField
noExtField GenLocated SrcSpanAnnA (HsExpr GhcPs)
x forall (p :: Pass). IsPass p => SyntaxExpr (GhcPass p)
noSyntaxExpr forall (p :: Pass). IsPass p => SyntaxExpr (GhcPass p)
noSyntaxExpr]))
[forall a. RType -> a -> [(String, a)] -> String -> Refactoring a
Replace RType
Stmt (forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
toSSA ExprLStmt GhcPs
g) [(String
"x", forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
toSSA GenLocated SrcSpanAnnA (HsExpr GhcPs)
x)] String
"x", forall a. RType -> a -> Refactoring a
Delete RType
Stmt (forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
toSSA ExprLStmt GhcPs
q)]]
monadStep [ExprLStmt GhcPs] -> LHsExpr GhcPs
wrap o :: [ExprLStmt GhcPs]
o@(g :: ExprLStmt GhcPs
g@(L SrcSpanAnnA
_ (BindStmt XBindStmt GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
_ (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))
_ (forall a b. View a b => a -> b
view -> Var_ String
v) SyntaxExpr GhcPs
_ SyntaxExpr GhcPs
_)):[ExprLStmt GhcPs]
xs)
| String
p forall a. Eq a => a -> a -> Bool
== String
v Bool -> Bool -> Bool
&& String
v forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` forall a. AllVars a => a -> [String]
varss [ExprLStmt GhcPs]
xs
= let app :: LocatedAn an (HsExpr GhcPs)
app = forall a an. a -> LocatedAn an a
noLocA forall a b. (a -> b) -> a -> b
$ forall p. XApp p -> LHsExpr p -> LHsExpr p -> HsExpr p
HsApp forall ann. EpAnn ann
EpAnnNotUsed (String -> LHsExpr GhcPs
strToVar String
"join") GenLocated SrcSpanAnnA (HsExpr GhcPs)
x
body :: LocatedAn
an (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
body = forall a an. a -> LocatedAn an a
noLocA forall a b. (a -> b) -> a -> b
$ forall idL idR body.
XBodyStmt idL idR body
-> body -> SyntaxExpr idR -> SyntaxExpr idR -> StmtLR idL idR body
BodyStmt NoExtField
noExtField (LHsExpr GhcPs -> LHsExpr GhcPs
rebracket1 forall {an}. LocatedAn an (HsExpr GhcPs)
app) forall (p :: Pass). IsPass p => SyntaxExpr (GhcPass p)
noSyntaxExpr forall (p :: Pass). IsPass p => SyntaxExpr (GhcPass p)
noSyntaxExpr
stmts :: [GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
stmts = forall {an}.
LocatedAn
an (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
body forall a. a -> [a] -> [a]
: [ExprLStmt GhcPs]
xs
in [forall a b.
(Outputable a, Outputable b) =>
String -> Located a -> Located b -> [Refactoring SrcSpan] -> Idea
warn String
"Use join" (forall a e. LocatedAn a e -> Located e
reLoc ([ExprLStmt GhcPs] -> LHsExpr GhcPs
wrap [ExprLStmt GhcPs]
o)) (forall a e. LocatedAn a e -> Located e
reLoc ([ExprLStmt GhcPs] -> LHsExpr GhcPs
wrap [GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
stmts)) [Refactoring SrcSpan]
r]
where r :: [Refactoring SrcSpan]
r = [forall a. RType -> a -> [(String, a)] -> String -> Refactoring a
Replace RType
Stmt (forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
toSSA ExprLStmt GhcPs
g) [(String
"x", forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
toSSA GenLocated SrcSpanAnnA (HsExpr GhcPs)
x)] String
"join x", forall a. RType -> a -> Refactoring a
Delete RType
Stmt (forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
toSSA ExprLStmt GhcPs
q)]
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 GenLocated SrcSpanAnnA (HsExpr GhcPs)
x
= let body :: ExprLStmt GhcPs
body = forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
loc forall a b. (a -> b) -> a -> b
$ forall idL idR body.
XBodyStmt idL idR body
-> body -> SyntaxExpr idR -> SyntaxExpr idR -> StmtLR idL idR body
BodyStmt NoExtField
noExtField GenLocated SrcSpanAnnA (HsExpr GhcPs)
x forall (p :: Pass). IsPass p => SyntaxExpr (GhcPass p)
noSyntaxExpr forall (p :: Pass). IsPass p => SyntaxExpr (GhcPass p)
noSyntaxExpr :: ExprLStmt GhcPs
in [forall a b.
(Outputable a, Outputable b) =>
String -> Located a -> Located b -> [Refactoring SrcSpan] -> Idea
warn String
"Redundant variable capture" (forall a e. LocatedAn a e -> Located e
reLoc ExprLStmt GhcPs
o) (forall a e. LocatedAn a e -> Located e
reLoc GenLocated
SrcSpanAnnA
(StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
body) [forall a. RType -> a -> [(String, a)] -> String -> Refactoring a
Replace RType
Stmt (forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
toSSA ExprLStmt GhcPs
o) [(String
"x", forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
toSSA GenLocated SrcSpanAnnA (HsExpr GhcPs)
x)] String
"x"]]
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)
fromRet -> Just (String
ret, L SrcSpanAnnA
_ (HsVar XVar GhcPs
_ (L SrcSpanAnnN
_ RdrName
unit)))) SyntaxExpr GhcPs
_ SyntaxExpr GhcPs
_))]
| LHsExpr GhcPs -> Bool
returnsUnit GenLocated SrcSpanAnnA (HsExpr GhcPs)
x, RdrName -> String
occNameStr RdrName
unit forall a. Eq a => a -> a -> Bool
== String
"()"
= [forall a b.
(Outputable a, Outputable b) =>
String -> Located a -> Located b -> [Refactoring SrcSpan] -> Idea
warn (String
"Redundant " forall a. [a] -> [a] -> [a]
++ String
ret) (forall a e. LocatedAn a e -> Located e
reLoc ([ExprLStmt GhcPs] -> LHsExpr GhcPs
wrap [ExprLStmt GhcPs]
o)) (forall a e. LocatedAn a e -> Located e
reLoc ([ExprLStmt GhcPs] -> LHsExpr GhcPs
wrap forall a b. (a -> b) -> a -> b
$ forall a. Int -> [a] -> [a]
take Int
1 [ExprLStmt GhcPs]
o)) [forall a. RType -> a -> Refactoring a
Delete RType
Stmt (forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
toSSA ExprLStmt GhcPs
q)]]
monadStep [ExprLStmt GhcPs] -> LHsExpr GhcPs
wrap
o :: [ExprLStmt GhcPs]
o@[g :: ExprLStmt GhcPs
g@(L SrcSpanAnnA
_ (BindStmt XBindStmt GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
_ (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)
fromApplies -> (LHsExpr GhcPs
ret:LHsExpr GhcPs
f:[LHsExpr GhcPs]
fs, 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 GenLocated SrcSpanAnnA (HsExpr GhcPs)
x, String
u forall a. Eq a => a -> a -> Bool
== String
v, forall (t :: * -> *) a. Foldable t => t a -> Int
length [LHsExpr GhcPs]
fs forall a. Ord a => a -> a -> Bool
< Int
3, forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Bool
isSimple (LHsExpr GhcPs
f forall a. a -> [a] -> [a]
: [LHsExpr GhcPs]
fs), String
v forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` forall a. FreeVars a => a -> [String]
vars (LHsExpr GhcPs
f forall a. a -> [a] -> [a]
: [LHsExpr GhcPs]
fs)
=
[forall a b.
(Outputable a, Outputable b) =>
String -> Located a -> Located b -> [Refactoring SrcSpan] -> Idea
warn String
"Use <$>" (forall a e. LocatedAn a e -> Located e
reLoc ([ExprLStmt GhcPs] -> LHsExpr GhcPs
wrap [ExprLStmt GhcPs]
o)) (forall a e. LocatedAn a e -> Located e
reLoc ([ExprLStmt GhcPs] -> LHsExpr GhcPs
wrap [forall a an. a -> LocatedAn an a
noLocA forall a b. (a -> b) -> a -> b
$ forall idL idR body.
XBodyStmt idL idR body
-> body -> SyntaxExpr idR -> SyntaxExpr idR -> StmtLR idL idR body
BodyStmt NoExtField
noExtField (forall a an. a -> LocatedAn an a
noLocA forall a b. (a -> b) -> a -> b
$ forall p.
XOpApp p -> LHsExpr p -> LHsExpr p -> LHsExpr p -> HsExpr p
OpApp forall ann. EpAnn ann
EpAnnNotUsed (forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\GenLocated SrcSpanAnnA (HsExpr GhcPs)
acc GenLocated SrcSpanAnnA (HsExpr GhcPs)
e -> forall a an. a -> LocatedAn an a
noLocA forall a b. (a -> b) -> a -> b
$ forall p.
XOpApp p -> LHsExpr p -> LHsExpr p -> LHsExpr p -> HsExpr p
OpApp forall ann. EpAnn ann
EpAnnNotUsed GenLocated SrcSpanAnnA (HsExpr GhcPs)
acc (String -> LHsExpr GhcPs
strToVar String
".") GenLocated SrcSpanAnnA (HsExpr GhcPs)
e) LHsExpr GhcPs
f [LHsExpr GhcPs]
fs) (String -> LHsExpr GhcPs
strToVar String
"<$>") GenLocated SrcSpanAnnA (HsExpr GhcPs)
x) forall (p :: Pass). IsPass p => SyntaxExpr (GhcPass p)
noSyntaxExpr forall (p :: Pass). IsPass p => SyntaxExpr (GhcPass p)
noSyntaxExpr]))
[forall a. RType -> a -> [(String, a)] -> String -> Refactoring a
Replace RType
Stmt (forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
toSSA ExprLStmt GhcPs
g) ((String
"x", forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
toSSA GenLocated SrcSpanAnnA (HsExpr GhcPs)
x)forall a. a -> [a] -> [a]
:forall a b. [a] -> [b] -> [(a, b)]
zip [String]
vs (forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
toSSA forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LHsExpr GhcPs
fforall a. a -> [a] -> [a]
:[LHsExpr GhcPs]
fs)) (forall a. [a] -> [[a]] -> [a]
intercalate String
" . " (forall a. Int -> [a] -> [a]
take (forall (t :: * -> *) a. Foldable t => t a -> Int
length [LHsExpr GhcPs]
fs forall a. Num a => a -> a -> a
+ Int
1) [String]
vs) forall a. [a] -> [a] -> [a]
++ String
" <$> x"), forall a. RType -> a -> Refactoring a
Delete RType
Stmt (forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
toSSA ExprLStmt GhcPs
q)]]
where
isSimple :: LHsExpr GhcPs -> Bool
isSimple (LHsExpr GhcPs -> [LHsExpr GhcPs]
fromApps -> [LHsExpr GhcPs]
xs) = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all forall a. Brackets a => a -> Bool
isAtom (GenLocated SrcSpanAnnA (HsExpr GhcPs)
x forall a. a -> [a] -> [a]
: [LHsExpr GhcPs]
xs)
vs :: [String]
vs = (Char
'f'forall a. a -> [a] -> [a]
:) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show 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 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]
_ = []
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
x forall a. a -> [a] -> [a]
: [ExprLStmt GhcPs]
xs) forall a. [a] -> [a] -> [a]
++ ([ExprLStmt GhcPs] -> LHsExpr GhcPs) -> [ExprLStmt GhcPs] -> [Idea]
monadSteps ([ExprLStmt GhcPs] -> LHsExpr GhcPs
wrap forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ExprLStmt GhcPs
x forall a. a -> [a] -> [a]
:)) [ExprLStmt GhcPs]
xs
monadSteps [ExprLStmt GhcPs] -> LHsExpr GhcPs
_ [ExprLStmt GhcPs]
_ = []
monadLet :: [ExprLStmt GhcPs] -> [(ExprLStmt GhcPs, ExprLStmt GhcPs, Refactoring R.SrcSpan)]
monadLet :: [ExprLStmt GhcPs]
-> [(ExprLStmt GhcPs, ExprLStmt GhcPs, Refactoring SrcSpan)]
monadLet [ExprLStmt GhcPs]
xs = forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe ExprLStmt GhcPs
-> Maybe (ExprLStmt GhcPs, ExprLStmt GhcPs, Refactoring SrcSpan)
mkLet [ExprLStmt GhcPs]
xs
where
vs :: [String]
vs = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall a. AllVars a => a -> [String]
pvars [LPat GhcPs
p | (L SrcSpanAnnA
_ (BindStmt XBindStmt GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
_ LPat GhcPs
p GenLocated SrcSpanAnnA (HsExpr GhcPs)
_ )) <- [ExprLStmt 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@(forall a b. View a b => a -> b
view -> PVar_ String
p) (LHsExpr GhcPs -> Maybe (String, LHsExpr GhcPs)
fromRet -> Just (String
_, LHsExpr GhcPs
y))))
| String
p forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` forall a. FreeVars a => a -> [String]
vars LHsExpr GhcPs
y, String
p forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` forall a. Eq a => a -> [a] -> [a]
delete String
p [String]
vs
= forall a. a -> Maybe a
Just (ExprLStmt GhcPs
x, String -> LHsExpr GhcPs -> ExprLStmt GhcPs
template String
p LHsExpr GhcPs
y, Refactoring SrcSpan
refact)
where
refact :: Refactoring SrcSpan
refact = forall a. RType -> a -> [(String, a)] -> String -> Refactoring a
Replace RType
Stmt (forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
toSSA ExprLStmt GhcPs
x) [(String
"lhs", forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
toSSA LPat GhcPs
v), (String
"rhs", forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
toSSA LHsExpr GhcPs
y)]
(forall a. Outputable a => a -> String
unsafePrettyPrint forall a b. (a -> b) -> a -> b
$ String -> LHsExpr GhcPs -> ExprLStmt GhcPs
template String
"lhs" (String -> LHsExpr GhcPs
strToVar String
"rhs"))
mkLet ExprLStmt GhcPs
_ = 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 = forall a an. a -> LocatedAn an a
noLocA 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 = forall a an. a -> LocatedAn an a
noLocA (forall p body.
XCGRHS p body -> [GuardLStmt p] -> body -> GRHS p body
GRHS forall ann. EpAnn ann
EpAnnNotUsed [] LHsExpr GhcPs
rhs)
grhss :: GRHSs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
grhss = forall p body.
XCGRHSs p body -> [LGRHS p body] -> HsLocalBinds p -> GRHSs p body
GRHSs EpAnnComments
emptyComments [forall {an}.
LocatedAn an (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
grhs] (forall idL idR. XEmptyLocalBinds idL idR -> HsLocalBindsLR idL idR
EmptyLocalBinds NoExtField
noExtField)
match :: LocatedAn an (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
match = forall a an. a -> LocatedAn an a
noLocA forall a b. (a -> b) -> a -> b
$ forall p body.
XCMatch p body
-> HsMatchContext p -> [LPat p] -> GRHSs p body -> Match p body
Match forall ann. EpAnn ann
EpAnnNotUsed (forall p.
LIdP (NoGhcTc p)
-> LexicalFixity -> SrcStrictness -> HsMatchContext p
FunRhs forall {an}. LocatedAn an RdrName
p LexicalFixity
Prefix SrcStrictness
NoSrcStrict) [] GRHSs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
grhss
fb :: LocatedAn an (HsBindLR GhcPs GhcPs)
fb = forall a an. a -> LocatedAn an a
noLocA forall a b. (a -> b) -> a -> b
$ forall idL idR.
XFunBind idL idR
-> LIdP idL -> MatchGroup idR (LHsExpr idR) -> HsBindLR idL idR
FunBind NoExtField
noExtField forall {an}. LocatedAn an RdrName
p (forall p body.
XMG p body -> XRec p [LMatch p body] -> MatchGroup p body
MG Origin
Generated (forall a an. a -> LocatedAn an a
noLocA [forall {an}.
LocatedAn an (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
match]))
binds :: Bag (LocatedAn an (HsBindLR GhcPs GhcPs))
binds = forall a. a -> Bag a
unitBag forall {an}. LocatedAn an (HsBindLR GhcPs GhcPs)
fb
valBinds :: HsValBindsLR GhcPs GhcPs
valBinds = forall idL idR.
XValBinds idL idR
-> LHsBindsLR idL idR -> [LSig idR] -> HsValBindsLR idL idR
ValBinds AnnSortKey
NoAnnSortKey forall {an}. Bag (LocatedAn an (HsBindLR GhcPs GhcPs))
binds []
localBinds :: HsLocalBindsLR GhcPs GhcPs
localBinds = forall idL idR.
XHsValBinds idL idR
-> HsValBindsLR idL idR -> HsLocalBindsLR idL idR
HsValBinds forall ann. EpAnn ann
EpAnnNotUsed HsValBindsLR GhcPs GhcPs
valBinds
in forall a an. a -> LocatedAn an a
noLocA forall a b. (a -> b) -> a -> b
$ forall idL idR body.
XLetStmt idL idR body
-> HsLocalBindsLR idL idR -> StmtLR idL idR body
LetStmt forall ann. EpAnn ann
EpAnnNotUsed HsLocalBindsLR GhcPs 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)) = forall a a' b. (a -> a') -> (a, b) -> (a', b)
first (LHsExpr GhcPs
fforall a. a -> [a] -> [a]
:) 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
x)
fromApplies (L SrcSpanAnnA
_ (OpApp XOpApp GhcPs
_ LHsExpr GhcPs
f (LHsExpr GhcPs -> Bool
isDol -> Bool
True) LHsExpr GhcPs
x)) = forall a a' b. (a -> a') -> (a, b) -> (a', b)
first (LHsExpr GhcPs
fforall a. a -> [a] -> [a]
:) 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 forall a. Eq a => a -> a -> Bool
== String
"$" = LHsExpr GhcPs -> Maybe (String, LHsExpr GhcPs)
fromRet forall a b. (a -> b) -> a -> b
$ forall a an. a -> LocatedAn an a
noLocA (forall p. XApp p -> LHsExpr p -> LHsExpr p -> HsExpr p
HsApp 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 = forall a. a -> Maybe a
Just (forall a. Outputable a => a -> String
unsafePrettyPrint LHsExpr GhcPs
x, LHsExpr GhcPs
y)
fromRet LHsExpr GhcPs
_ = forall a. Maybe a
Nothing