{-# LANGUAGE LambdaCase, ViewPatterns, PatternGuards, FlexibleContexts #-}
{-
    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 -- void $ 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.SrcLoc
import GHC.Types.Basic
import GHC.Types.Name.Reader
import GHC.Types.Name.Occurrence
import GHC.Data.Bag
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 qualified Refact.Types 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 = (LHsExpr GhcPs -> [Idea]) -> [LHsExpr GhcPs] -> [Idea]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Maybe (LHsExpr GhcPs)
-> Maybe (Int, LHsExpr GhcPs) -> LHsExpr GhcPs -> [Idea]
f Maybe (LHsExpr GhcPs)
forall a. Maybe a
Nothing Maybe (Int, LHsExpr GhcPs)
forall a. Maybe a
Nothing) ([LHsExpr GhcPs] -> [Idea]) -> [LHsExpr GhcPs] -> [Idea]
forall a b. (a -> b) -> a -> b
$ LHsDecl GhcPs -> [LHsExpr GhcPs]
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 (LHsExpr GhcPs)
-> Maybe (Int, LHsExpr GhcPs) -> LHsExpr GhcPs -> [Idea]
f Maybe (LHsExpr GhcPs)
parentDo Maybe (Int, LHsExpr GhcPs)
parentExpr LHsExpr GhcPs
x =
            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 [Idea] -> [Idea] -> [Idea]
forall a. [a] -> [a] -> [a]
++
            [[Idea]] -> [Idea]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [Maybe (LHsExpr GhcPs)
-> Maybe (Int, LHsExpr GhcPs) -> LHsExpr GhcPs -> [Idea]
f (if LHsExpr GhcPs -> Bool
forall l p. GenLocated l (HsExpr p) -> Bool
isHsDo LHsExpr GhcPs
x then LHsExpr GhcPs -> Maybe (LHsExpr GhcPs)
forall a. a -> Maybe a
Just LHsExpr GhcPs
x else Maybe (LHsExpr GhcPs)
parentDo) ((Int, LHsExpr GhcPs) -> Maybe (Int, LHsExpr GhcPs)
forall a. a -> Maybe a
Just (Int
i, LHsExpr GhcPs
x)) LHsExpr GhcPs
c | (Int
i, LHsExpr GhcPs
c) <- Int -> [LHsExpr GhcPs] -> [(Int, LHsExpr GhcPs)]
forall a b. Enum a => a -> [b] -> [(a, b)]
zipFrom Int
0 ([LHsExpr GhcPs] -> [(Int, LHsExpr GhcPs)])
-> [LHsExpr GhcPs] -> [(Int, LHsExpr GhcPs)]
forall a b. (a -> b) -> a -> b
$ LHsExpr GhcPs -> [LHsExpr GhcPs]
forall on. Uniplate on => on -> [on]
children LHsExpr 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
forall a b. View a b => a -> b
view -> App2 LHsExpr GhcPs
op LHsExpr GhcPs
x1 LHsExpr GhcPs
x2) | String -> LHsExpr GhcPs -> Bool
isTag String
">>" LHsExpr GhcPs
op -> LHsExpr GhcPs -> [Idea]
f LHsExpr GhcPs
x1
    (LHsExpr GhcPs -> App2
forall a b. View a b => a -> b
view -> App2 LHsExpr GhcPs
op LHsExpr GhcPs
x1 (LHsExpr GhcPs -> LamConst1
forall a b. View a b => a -> b
view -> LamConst1 LHsExpr GhcPs
_)) | String -> LHsExpr GhcPs -> Bool
isTag String
">>=" LHsExpr GhcPs
op -> LHsExpr GhcPs -> [Idea]
f LHsExpr GhcPs
x1
    (L SrcSpan
l (HsApp XApp GhcPs
_ LHsExpr GhcPs
op LHsExpr GhcPs
x)) | String -> LHsExpr GhcPs -> Bool
isTag String
"void" LHsExpr GhcPs
op -> (LHsExpr GhcPs -> LHsExpr GhcPs) -> LHsExpr GhcPs -> [Idea]
seenVoid (SrcSpan -> HsExpr GhcPs -> LHsExpr GhcPs
forall l e. l -> e -> GenLocated l e
L SrcSpan
l (HsExpr GhcPs -> LHsExpr GhcPs)
-> (LHsExpr GhcPs -> HsExpr GhcPs)
-> LHsExpr GhcPs
-> LHsExpr 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 NoExtField
XApp GhcPs
noExtField LHsExpr GhcPs
op) LHsExpr GhcPs
x
    (L SrcSpan
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 -> (LHsExpr GhcPs -> LHsExpr GhcPs) -> LHsExpr GhcPs -> [Idea]
seenVoid (SrcSpan -> HsExpr GhcPs -> LHsExpr GhcPs
forall l e. l -> e -> GenLocated l e
L SrcSpan
l (HsExpr GhcPs -> LHsExpr GhcPs)
-> (LHsExpr GhcPs -> HsExpr GhcPs)
-> LHsExpr GhcPs
-> LHsExpr 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 NoExtField
XOpApp GhcPs
noExtField LHsExpr GhcPs
op LHsExpr GhcPs
dol) LHsExpr GhcPs
x
    (L SrcSpan
loc (HsDo XDo GhcPs
_ HsStmtContext GhcRn
ctx (L SrcSpan
loc2 [L SrcSpan
loc3 (BodyStmt XBodyStmt GhcPs GhcPs (LHsExpr GhcPs)
_ LHsExpr GhcPs
y SyntaxExpr GhcPs
_ SyntaxExpr GhcPs
_ )]))) ->
      let doOrMDo :: String
doOrMDo = case HsStmtContext GhcRn
ctx of MDoExpr Maybe ModuleName
_ -> String
"mdo"; HsStmtContext GhcRn
_ -> 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 SrcSpan
loc) String
doOrMDo [RType
-> SrcSpan -> [(String, SrcSpan)] -> String -> Refactoring SrcSpan
forall a. RType -> a -> [(String, a)] -> String -> Refactoring a
Replace RType
Expr (LHsExpr GhcPs -> SrcSpan
forall a. Located a -> SrcSpan
toSS LHsExpr GhcPs
x) [(String
"y", LHsExpr GhcPs -> SrcSpan
forall a. Located a -> SrcSpan
toSS LHsExpr 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
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 SrcSpan
loc (HsDo XDo GhcPs
_ (DoExpr Maybe ModuleName
mm) (L SrcSpan
_ [ExprLStmt GhcPs]
xs))) ->
      ([ExprLStmt GhcPs] -> LHsExpr GhcPs) -> [ExprLStmt GhcPs] -> [Idea]
monadSteps (SrcSpan -> HsExpr GhcPs -> LHsExpr GhcPs
forall l e. l -> e -> GenLocated l e
L SrcSpan
loc (HsExpr GhcPs -> LHsExpr GhcPs)
-> ([ExprLStmt GhcPs] -> HsExpr GhcPs)
-> [ExprLStmt GhcPs]
-> LHsExpr GhcPs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XDo GhcPs
-> HsStmtContext GhcRn
-> GenLocated SrcSpan [ExprLStmt GhcPs]
-> HsExpr GhcPs
forall p.
XDo p -> HsStmtContext GhcRn -> Located [ExprLStmt p] -> HsExpr p
HsDo NoExtField
XDo GhcPs
noExtField (Maybe ModuleName -> HsStmtContext GhcRn
forall p. Maybe ModuleName -> HsStmtContext p
DoExpr Maybe ModuleName
mm) (GenLocated SrcSpan [ExprLStmt GhcPs] -> HsExpr GhcPs)
-> ([ExprLStmt GhcPs] -> GenLocated SrcSpan [ExprLStmt GhcPs])
-> [ExprLStmt GhcPs]
-> HsExpr GhcPs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ExprLStmt GhcPs] -> GenLocated SrcSpan [ExprLStmt GhcPs]
forall e. e -> Located e
noLoc) [ExprLStmt GhcPs]
xs [Idea] -> [Idea] -> [Idea]
forall a. [a] -> [a] -> [a]
++
      [String
-> ExprLStmt GhcPs
-> ExprLStmt GhcPs
-> [Refactoring SrcSpan]
-> Idea
forall a b.
(Outputable a, Outputable b) =>
String -> Located a -> Located b -> [Refactoring SrcSpan] -> Idea
suggest String
"Use let" ExprLStmt GhcPs
from ExprLStmt GhcPs
to [Refactoring SrcSpan
r] | (ExprLStmt GhcPs
from, ExprLStmt GhcPs
to, Refactoring SrcSpan
r) <- [ExprLStmt GhcPs]
-> [(ExprLStmt GhcPs, ExprLStmt GhcPs, Refactoring SrcSpan)]
monadLet [ExprLStmt GhcPs]
xs] [Idea] -> [Idea] -> [Idea]
forall a. [a] -> [a] -> [a]
++
      [[Idea]] -> [Idea]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [LHsExpr GhcPs -> [Idea]
f LHsExpr GhcPs
x | (L SrcSpan
_ (BodyStmt XBodyStmt GhcPs GhcPs (LHsExpr GhcPs)
_ LHsExpr GhcPs
x SyntaxExpr GhcPs
_ SyntaxExpr GhcPs
_)) <- [ExprLStmt GhcPs] -> [ExprLStmt GhcPs]
forall a. [a] -> [a]
dropEnd1 [ExprLStmt GhcPs]
xs] [Idea] -> [Idea] -> [Idea]
forall a. [a] -> [a] -> [a]
++
      [[Idea]] -> [Idea]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [LHsExpr GhcPs -> [Idea]
f LHsExpr GhcPs
x | (L SrcSpan
_ (BindStmt XBindStmt GhcPs GhcPs (LHsExpr GhcPs)
_ (L _ WildPat{}) LHsExpr GhcPs
x)) <- [ExprLStmt GhcPs] -> [ExprLStmt GhcPs]
forall a. [a] -> [a]
dropEnd1 [ExprLStmt 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
forall a. a -> a
id
    seenVoid :: (LHsExpr GhcPs -> LHsExpr GhcPs) -> LHsExpr GhcPs -> [Idea]
seenVoid LHsExpr GhcPs -> LHsExpr GhcPs
wrap LHsExpr GhcPs
x = 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
wrap LHsExpr GhcPs
x
      [Idea] -> [Idea] -> [Idea]
forall a. [a] -> [a] -> [a]
++ [String
-> LHsExpr GhcPs -> LHsExpr GhcPs -> [Refactoring SrcSpan] -> Idea
forall a b.
(Outputable a, Outputable b) =>
String -> Located a -> Located b -> [Refactoring SrcSpan] -> Idea
warn String
"Redundant void" (LHsExpr GhcPs -> LHsExpr GhcPs
wrap LHsExpr GhcPs
x) LHsExpr GhcPs
x [RType
-> SrcSpan -> [(String, SrcSpan)] -> String -> Refactoring SrcSpan
forall a. RType -> a -> [(String, a)] -> String -> Refactoring a
Replace RType
Expr (LHsExpr GhcPs -> SrcSpan
forall a. Located a -> SrcSpan
toSS (LHsExpr GhcPs -> LHsExpr GhcPs
wrap LHsExpr GhcPs
x)) [(String
"a", LHsExpr GhcPs -> SrcSpan
forall a. Located a -> SrcSpan
toSS LHsExpr GhcPs
x)] String
"a"] | LHsExpr GhcPs -> Bool
returnsUnit LHsExpr GhcPs
x]
    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 (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
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 SrcSpan
_ (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 -> LHsExpr GhcPs -> LHsExpr GhcPs -> Bool
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


-- Sometimes people write do, to avoid identation, see
-- https://github.com/ndmitchell/hlint/issues/978
-- Return True if they are using do as avoiding identation
doAsAvoidingIndentation :: Maybe (LHsExpr GhcPs) -> LHsExpr GhcPs -> Bool
doAsAvoidingIndentation :: Maybe (LHsExpr GhcPs) -> LHsExpr GhcPs -> Bool
doAsAvoidingIndentation (Just (L SrcSpan
_ (HsDo XDo GhcPs
_ HsStmtContext GhcRn
_ (L (RealSrcSpan RealSrcSpan
a Maybe BufSpan
_) [ExprLStmt GhcPs]
_)))) (L SrcSpan
_ (HsDo XDo GhcPs
_ HsStmtContext GhcRn
_ (L (RealSrcSpan RealSrcSpan
b Maybe BufSpan
_) [ExprLStmt GhcPs]
_)))
    = 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


returnsUnit :: LHsExpr GhcPs -> Bool
returnsUnit :: LHsExpr GhcPs -> Bool
returnsUnit (L SrcSpan
_ (HsPar XPar GhcPs
_ LHsExpr GhcPs
x)) = LHsExpr GhcPs -> Bool
returnsUnit LHsExpr GhcPs
x
returnsUnit (L SrcSpan
_ (HsApp XApp GhcPs
_ LHsExpr GhcPs
x LHsExpr GhcPs
_)) = LHsExpr GhcPs -> Bool
returnsUnit LHsExpr GhcPs
x
returnsUnit (L SrcSpan
_ (OpApp XOpApp GhcPs
_ LHsExpr GhcPs
x LHsExpr GhcPs
op LHsExpr GhcPs
_)) | LHsExpr GhcPs -> Bool
isDol LHsExpr GhcPs
op = LHsExpr GhcPs -> Bool
returnsUnit LHsExpr GhcPs
x
returnsUnit (L SrcSpan
_ (HsVar XVar GhcPs
_ (L SrcSpan
_ IdP GhcPs
x))) = RdrName -> String
occNameStr IdP GhcPs
RdrName
x String -> [String] -> 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
returnsUnit LHsExpr GhcPs
_ = Bool
False

-- 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 SrcSpan
l (HsPar XPar GhcPs
_ LHsExpr GhcPs
x)) = String
-> (LHsExpr GhcPs -> LHsExpr GhcPs) -> LHsExpr GhcPs -> [Idea]
monadNoResult String
inside (LHsExpr GhcPs -> LHsExpr GhcPs
wrap (LHsExpr GhcPs -> LHsExpr GhcPs)
-> (LHsExpr GhcPs -> LHsExpr GhcPs)
-> LHsExpr GhcPs
-> LHsExpr GhcPs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SrcSpan -> HsExpr GhcPs -> LHsExpr GhcPs
forall l e. l -> e -> GenLocated l e
L SrcSpan
l (HsExpr GhcPs -> LHsExpr GhcPs)
-> (LHsExpr GhcPs -> HsExpr GhcPs)
-> LHsExpr GhcPs
-> LHsExpr GhcPs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XPar GhcPs -> LHsExpr GhcPs -> HsExpr GhcPs
forall p. XPar p -> LHsExpr p -> HsExpr p
HsPar NoExtField
XPar GhcPs
noExtField) LHsExpr GhcPs
x
monadNoResult String
inside LHsExpr GhcPs -> LHsExpr GhcPs
wrap (L SrcSpan
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
$ SrcSpan -> HsExpr GhcPs -> LHsExpr GhcPs
forall l e. l -> e -> GenLocated l e
L SrcSpan
l (XApp GhcPs -> LHsExpr GhcPs -> LHsExpr GhcPs -> HsExpr GhcPs
forall p. XApp p -> LHsExpr p -> LHsExpr p -> HsExpr p
HsApp NoExtField
XApp GhcPs
noExtField LHsExpr GhcPs
x LHsExpr GhcPs
y)) LHsExpr GhcPs
x
monadNoResult String
inside LHsExpr GhcPs -> LHsExpr GhcPs
wrap (L SrcSpan
l (OpApp XOpApp GhcPs
_ LHsExpr GhcPs
x tag :: LHsExpr GhcPs
tag@(L SrcSpan
_ (HsVar XVar GhcPs
_ (L SrcSpan
_ IdP GhcPs
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
$ SrcSpan -> HsExpr GhcPs -> LHsExpr GhcPs
forall l e. l -> e -> GenLocated l e
L SrcSpan
l (XOpApp GhcPs
-> LHsExpr GhcPs -> LHsExpr GhcPs -> LHsExpr GhcPs -> HsExpr GhcPs
forall p.
XOpApp p -> LHsExpr p -> LHsExpr p -> LHsExpr p -> HsExpr p
OpApp NoExtField
XOpApp GhcPs
noExtField LHsExpr GhcPs
x LHsExpr GhcPs
tag LHsExpr GhcPs
y)) LHsExpr GhcPs
x
    | RdrName -> String
occNameStr IdP GhcPs
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
wrap (LHsExpr GhcPs -> LHsExpr GhcPs)
-> (LHsExpr GhcPs -> LHsExpr GhcPs)
-> LHsExpr GhcPs
-> LHsExpr GhcPs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SrcSpan -> HsExpr GhcPs -> LHsExpr GhcPs
forall l e. l -> e -> GenLocated l e
L SrcSpan
l (HsExpr GhcPs -> LHsExpr GhcPs)
-> (LHsExpr GhcPs -> HsExpr GhcPs)
-> LHsExpr GhcPs
-> LHsExpr 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 NoExtField
XOpApp GhcPs
noExtField 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
-> LHsExpr GhcPs -> LHsExpr 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) (LHsExpr GhcPs -> LHsExpr GhcPs
wrap LHsExpr GhcPs
x) (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 (LHsExpr GhcPs -> SrcSpan
forall a. Located a -> SrcSpan
toSS LHsExpr 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 :: [Note]
ideaNote=[Note] -> [Note]
forall a. Ord a => [a] -> [a]
nubOrd ([Note] -> [Note]) -> [Note] -> [Note]
forall a b. (a -> b) -> a -> b
$ String -> Note
Note String
"May require adding void to other branches" Note -> [Note] -> [Note]
forall a. a -> [a] -> [a]
: Idea -> [Note]
ideaNote Idea
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
forall a. a -> a
id LHsExpr GhcPs
b | LHsExpr GhcPs
b <- [LHsExpr 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 SrcSpan
_ (BodyStmt XBodyStmt GhcPs GhcPs (LHsExpr 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 " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
ret) (ExprLStmt GhcPs -> SrcSpan
forall l e. GenLocated l e -> l
getLoc ExprLStmt GhcPs
o) (ExprLStmt GhcPs -> String
forall a. Outputable a => a -> String
unsafePrettyPrint ExprLStmt GhcPs
o) [RType -> SrcSpan -> Refactoring SrcSpan
forall a. RType -> a -> Refactoring a
Delete RType
Stmt (ExprLStmt GhcPs -> SrcSpan
forall a. Located a -> SrcSpan
toSS ExprLStmt 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 SrcSpan
_ (BindStmt XBindStmt GhcPs GhcPs (LHsExpr GhcPs)
_ (L _ (VarPat _ (L _ p))) LHsExpr GhcPs
x))
                  , q :: ExprLStmt GhcPs
q@(L SrcSpan
_ (BodyStmt XBodyStmt GhcPs GhcPs (LHsExpr GhcPs)
_ (LHsExpr GhcPs -> Maybe (String, LHsExpr GhcPs)
fromRet -> Just (String
ret, L SrcSpan
_ (HsVar XVar GhcPs
_ (L SrcSpan
_ IdP GhcPs
v)))) SyntaxExpr GhcPs
_ SyntaxExpr GhcPs
_))]
  | RdrName -> String
occNameStr IdP GhcPs
RdrName
p String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== RdrName -> String
occNameStr IdP GhcPs
RdrName
v
  = [String
-> LHsExpr GhcPs -> LHsExpr 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) ([ExprLStmt GhcPs] -> LHsExpr GhcPs
wrap [ExprLStmt GhcPs]
o) ([ExprLStmt GhcPs] -> LHsExpr GhcPs
wrap [StmtLR GhcPs GhcPs (LHsExpr GhcPs) -> ExprLStmt GhcPs
forall e. e -> Located e
noLoc (StmtLR GhcPs GhcPs (LHsExpr GhcPs) -> ExprLStmt GhcPs)
-> StmtLR GhcPs GhcPs (LHsExpr GhcPs) -> ExprLStmt GhcPs
forall a b. (a -> b) -> a -> b
$ XBodyStmt GhcPs GhcPs (LHsExpr GhcPs)
-> LHsExpr GhcPs
-> SyntaxExpr GhcPs
-> SyntaxExpr GhcPs
-> StmtLR GhcPs GhcPs (LHsExpr GhcPs)
forall idL idR body.
XBodyStmt idL idR body
-> body -> SyntaxExpr idR -> SyntaxExpr idR -> StmtLR idL idR body
BodyStmt NoExtField
XBodyStmt GhcPs GhcPs (LHsExpr GhcPs)
noExtField LHsExpr 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 (ExprLStmt GhcPs -> SrcSpan
forall a. Located a -> SrcSpan
toSS ExprLStmt GhcPs
g) [(String
"x", LHsExpr GhcPs -> SrcSpan
forall a. Located a -> SrcSpan
toSS LHsExpr GhcPs
x)] String
"x", RType -> SrcSpan -> Refactoring SrcSpan
forall a. RType -> a -> Refactoring a
Delete RType
Stmt (ExprLStmt GhcPs -> SrcSpan
forall a. Located a -> SrcSpan
toSS ExprLStmt 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 SrcSpan
_ (BindStmt XBindStmt GhcPs GhcPs (LHsExpr GhcPs)
_ (LPat GhcPs -> PVar_
forall a b. View a b => a -> b
view -> PVar_ String
p) LHsExpr GhcPs
x)):q :: ExprLStmt GhcPs
q@(L SrcSpan
_ (BodyStmt XBodyStmt GhcPs GhcPs (LHsExpr GhcPs)
_ (LHsExpr 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` [ExprLStmt GhcPs] -> [String]
forall a. AllVars a => a -> [String]
varss [ExprLStmt GhcPs]
xs
  = let app :: LHsExpr GhcPs
app = HsExpr GhcPs -> LHsExpr GhcPs
forall e. e -> Located e
noLoc (HsExpr GhcPs -> LHsExpr GhcPs) -> HsExpr GhcPs -> LHsExpr 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 NoExtField
XApp GhcPs
noExtField (String -> LHsExpr GhcPs
strToVar String
"join") LHsExpr GhcPs
x
        body :: ExprLStmt GhcPs
body = StmtLR GhcPs GhcPs (LHsExpr GhcPs) -> ExprLStmt GhcPs
forall e. e -> Located e
noLoc (StmtLR GhcPs GhcPs (LHsExpr GhcPs) -> ExprLStmt GhcPs)
-> StmtLR GhcPs GhcPs (LHsExpr GhcPs) -> ExprLStmt GhcPs
forall a b. (a -> b) -> a -> b
$ XBodyStmt GhcPs GhcPs (LHsExpr GhcPs)
-> LHsExpr GhcPs
-> SyntaxExpr GhcPs
-> SyntaxExpr GhcPs
-> StmtLR GhcPs GhcPs (LHsExpr GhcPs)
forall idL idR body.
XBodyStmt idL idR body
-> body -> SyntaxExpr idR -> SyntaxExpr idR -> StmtLR idL idR body
BodyStmt NoExtField
XBodyStmt GhcPs GhcPs (LHsExpr GhcPs)
noExtField (LHsExpr GhcPs -> LHsExpr GhcPs
rebracket1 LHsExpr 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 :: [ExprLStmt GhcPs]
stmts = ExprLStmt GhcPs
body ExprLStmt GhcPs -> [ExprLStmt GhcPs] -> [ExprLStmt GhcPs]
forall a. a -> [a] -> [a]
: [ExprLStmt GhcPs]
xs
    in [String
-> LHsExpr GhcPs -> LHsExpr GhcPs -> [Refactoring SrcSpan] -> Idea
forall a b.
(Outputable a, Outputable b) =>
String -> Located a -> Located b -> [Refactoring SrcSpan] -> Idea
warn String
"Use join" ([ExprLStmt GhcPs] -> LHsExpr GhcPs
wrap [ExprLStmt GhcPs]
o) ([ExprLStmt GhcPs] -> LHsExpr GhcPs
wrap [ExprLStmt 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 (ExprLStmt GhcPs -> SrcSpan
forall a. Located a -> SrcSpan
toSS ExprLStmt GhcPs
g) [(String
"x", LHsExpr GhcPs -> SrcSpan
forall a. Located a -> SrcSpan
toSS LHsExpr GhcPs
x)] String
"join x", RType -> SrcSpan -> Refactoring SrcSpan
forall a. RType -> a -> Refactoring a
Delete RType
Stmt (ExprLStmt GhcPs -> SrcSpan
forall a. Located a -> SrcSpan
toSS ExprLStmt GhcPs
q)]

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

-- Redundant unit return : 'do <return ()>; return ()'.
monadStep
  [ExprLStmt GhcPs] -> LHsExpr GhcPs
wrap o :: [ExprLStmt GhcPs]
o@[ L SrcSpan
_ (BodyStmt XBodyStmt GhcPs GhcPs (LHsExpr GhcPs)
_ LHsExpr GhcPs
x SyntaxExpr GhcPs
_ SyntaxExpr GhcPs
_)
         , q :: ExprLStmt GhcPs
q@(L SrcSpan
_ (BodyStmt XBodyStmt GhcPs GhcPs (LHsExpr GhcPs)
_ (LHsExpr GhcPs -> Maybe (String, LHsExpr GhcPs)
fromRet -> Just (String
ret, L SrcSpan
_ (HsVar XVar GhcPs
_ (L SrcSpan
_ IdP GhcPs
unit)))) SyntaxExpr GhcPs
_ SyntaxExpr GhcPs
_))]
     | LHsExpr GhcPs -> Bool
returnsUnit LHsExpr GhcPs
x, RdrName -> String
occNameStr IdP GhcPs
RdrName
unit String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"()"
  = [String
-> LHsExpr GhcPs -> LHsExpr 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) ([ExprLStmt GhcPs] -> LHsExpr GhcPs
wrap [ExprLStmt GhcPs]
o) ([ExprLStmt GhcPs] -> LHsExpr GhcPs
wrap ([ExprLStmt GhcPs] -> LHsExpr GhcPs)
-> [ExprLStmt GhcPs] -> LHsExpr GhcPs
forall a b. (a -> b) -> a -> b
$ Int -> [ExprLStmt GhcPs] -> [ExprLStmt GhcPs]
forall a. Int -> [a] -> [a]
take Int
1 [ExprLStmt GhcPs]
o) [RType -> SrcSpan -> Refactoring SrcSpan
forall a. RType -> a -> Refactoring a
Delete RType
Stmt (ExprLStmt GhcPs -> SrcSpan
forall a. Located a -> SrcSpan
toSS ExprLStmt 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 SrcSpan
_ (BindStmt XBindStmt GhcPs GhcPs (LHsExpr GhcPs)
_ (LPat GhcPs -> PVar_
forall a b. View a b => a -> b
view -> PVar_ String
u) LHsExpr GhcPs
x))
    , q :: ExprLStmt GhcPs
q@(L SrcSpan
_ (BodyStmt XBodyStmt GhcPs GhcPs (LHsExpr GhcPs)
_ (LHsExpr GhcPs -> ([LHsExpr GhcPs], LHsExpr GhcPs)
fromApplies -> (LHsExpr GhcPs
ret:LHsExpr GhcPs
f:[LHsExpr GhcPs]
fs, LHsExpr 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
x, String
u String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
v, [LHsExpr GhcPs] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [LHsExpr GhcPs]
fs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
3, (LHsExpr GhcPs -> Bool) -> [LHsExpr GhcPs] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all LHsExpr GhcPs -> Bool
isSimple (LHsExpr GhcPs
f LHsExpr GhcPs -> [LHsExpr GhcPs] -> [LHsExpr GhcPs]
forall a. a -> [a] -> [a]
: [LHsExpr GhcPs]
fs), String
v String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [LHsExpr GhcPs] -> [String]
forall a. FreeVars a => a -> [String]
vars (LHsExpr GhcPs
f LHsExpr GhcPs -> [LHsExpr GhcPs] -> [LHsExpr GhcPs]
forall a. a -> [a] -> [a]
: [LHsExpr GhcPs]
fs)
  =
      [String
-> LHsExpr GhcPs -> LHsExpr GhcPs -> [Refactoring SrcSpan] -> Idea
forall a b.
(Outputable a, Outputable b) =>
String -> Located a -> Located b -> [Refactoring SrcSpan] -> Idea
warn String
"Use <$>" ([ExprLStmt GhcPs] -> LHsExpr GhcPs
wrap [ExprLStmt GhcPs]
o) ([ExprLStmt GhcPs] -> LHsExpr GhcPs
wrap [StmtLR GhcPs GhcPs (LHsExpr GhcPs) -> ExprLStmt GhcPs
forall e. e -> Located e
noLoc (StmtLR GhcPs GhcPs (LHsExpr GhcPs) -> ExprLStmt GhcPs)
-> StmtLR GhcPs GhcPs (LHsExpr GhcPs) -> ExprLStmt GhcPs
forall a b. (a -> b) -> a -> b
$ XBodyStmt GhcPs GhcPs (LHsExpr GhcPs)
-> LHsExpr GhcPs
-> SyntaxExpr GhcPs
-> SyntaxExpr GhcPs
-> StmtLR GhcPs GhcPs (LHsExpr GhcPs)
forall idL idR body.
XBodyStmt idL idR body
-> body -> SyntaxExpr idR -> SyntaxExpr idR -> StmtLR idL idR body
BodyStmt NoExtField
XBodyStmt GhcPs GhcPs (LHsExpr GhcPs)
noExtField (HsExpr GhcPs -> LHsExpr GhcPs
forall e. e -> Located e
noLoc (HsExpr GhcPs -> LHsExpr GhcPs) -> HsExpr GhcPs -> LHsExpr 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 NoExtField
XOpApp GhcPs
noExtField ((LHsExpr GhcPs -> LHsExpr GhcPs -> LHsExpr GhcPs)
-> LHsExpr GhcPs -> [LHsExpr GhcPs] -> LHsExpr GhcPs
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\LHsExpr GhcPs
acc LHsExpr GhcPs
e -> HsExpr GhcPs -> LHsExpr GhcPs
forall e. e -> Located e
noLoc (HsExpr GhcPs -> LHsExpr GhcPs) -> HsExpr GhcPs -> LHsExpr 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 NoExtField
XOpApp GhcPs
noExtField LHsExpr GhcPs
acc (String -> LHsExpr GhcPs
strToVar String
".") LHsExpr GhcPs
e) LHsExpr GhcPs
f [LHsExpr GhcPs]
fs) (String -> LHsExpr GhcPs
strToVar String
"<$>") LHsExpr 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 (ExprLStmt GhcPs -> SrcSpan
forall a. Located a -> SrcSpan
toSS ExprLStmt GhcPs
g) ((String
"x", LHsExpr GhcPs -> SrcSpan
forall a. Located a -> SrcSpan
toSS LHsExpr 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 (LHsExpr GhcPs -> SrcSpan
forall a. Located a -> SrcSpan
toSS (LHsExpr GhcPs -> SrcSpan) -> [LHsExpr GhcPs] -> [SrcSpan]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LHsExpr GhcPs
fLHsExpr GhcPs -> [LHsExpr GhcPs] -> [LHsExpr GhcPs]
forall a. a -> [a] -> [a]
:[LHsExpr GhcPs]
fs)) (String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
" . " (Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
take ([LHsExpr GhcPs] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [LHsExpr 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 (ExprLStmt GhcPs -> SrcSpan
forall a. Located a -> SrcSpan
toSS ExprLStmt GhcPs
q)]]
  where
    isSimple :: LHsExpr GhcPs -> Bool
isSimple (LHsExpr GhcPs -> [LHsExpr GhcPs]
fromApps -> [LHsExpr GhcPs]
xs) = (LHsExpr GhcPs -> Bool) -> [LHsExpr GhcPs] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all LHsExpr GhcPs -> Bool
forall a. Brackets a => a -> Bool
isAtom (LHsExpr GhcPs
x LHsExpr GhcPs -> [LHsExpr GhcPs] -> [LHsExpr GhcPs]
forall a. a -> [a] -> [a]
: [LHsExpr 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 SrcSpan
_ (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
x ExprLStmt GhcPs -> [ExprLStmt GhcPs] -> [ExprLStmt GhcPs]
forall a. a -> [a] -> [a]
: [ExprLStmt GhcPs]
xs) [Idea] -> [Idea] -> [Idea]
forall a. [a] -> [a] -> [a]
++ ([ExprLStmt GhcPs] -> LHsExpr GhcPs) -> [ExprLStmt GhcPs] -> [Idea]
monadSteps ([ExprLStmt GhcPs] -> LHsExpr GhcPs
wrap ([ExprLStmt GhcPs] -> LHsExpr GhcPs)
-> ([ExprLStmt GhcPs] -> [ExprLStmt GhcPs])
-> [ExprLStmt GhcPs]
-> LHsExpr GhcPs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ExprLStmt GhcPs
x ExprLStmt GhcPs -> [ExprLStmt GhcPs] -> [ExprLStmt 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 = (ExprLStmt GhcPs
 -> Maybe (ExprLStmt GhcPs, ExprLStmt GhcPs, Refactoring SrcSpan))
-> [ExprLStmt GhcPs]
-> [(ExprLStmt GhcPs, ExprLStmt GhcPs, Refactoring SrcSpan)]
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 = (Located (Pat GhcPs) -> [String])
-> [Located (Pat GhcPs)] -> [String]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Located (Pat GhcPs) -> [String]
forall a. AllVars a => a -> [String]
pvars [LPat GhcPs
Located (Pat GhcPs)
p | (L SrcSpan
_ (BindStmt XBindStmt GhcPs GhcPs (LHsExpr GhcPs)
_ LPat GhcPs
p LHsExpr 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 SrcSpan
_ (BindStmt XBindStmt GhcPs GhcPs (LHsExpr GhcPs)
_ v :: LPat GhcPs
v@(LPat GhcPs -> PVar_
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 String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` LHsExpr GhcPs -> [String]
forall a. FreeVars a => a -> [String]
vars LHsExpr 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
      = (ExprLStmt GhcPs, ExprLStmt GhcPs, Refactoring SrcSpan)
-> Maybe (ExprLStmt GhcPs, ExprLStmt GhcPs, Refactoring SrcSpan)
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 = RType
-> SrcSpan -> [(String, SrcSpan)] -> String -> Refactoring SrcSpan
forall a. RType -> a -> [(String, a)] -> String -> Refactoring a
Replace RType
Stmt (ExprLStmt GhcPs -> SrcSpan
forall a. Located a -> SrcSpan
toSS ExprLStmt GhcPs
x) [(String
"lhs", Located (Pat GhcPs) -> SrcSpan
forall a. Located a -> SrcSpan
toSS LPat GhcPs
Located (Pat GhcPs)
v), (String
"rhs", LHsExpr GhcPs -> SrcSpan
forall a. Located a -> SrcSpan
toSS LHsExpr 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)
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 :: Located RdrName
p = RdrName -> Located RdrName
forall e. e -> Located e
noLoc (RdrName -> Located RdrName) -> RdrName -> Located RdrName
forall a b. (a -> b) -> a -> b
$ OccName -> RdrName
mkRdrUnqual (String -> OccName
mkVarOcc String
lhs)
            grhs :: Located (GRHS GhcPs (LHsExpr GhcPs))
grhs = GRHS GhcPs (LHsExpr GhcPs) -> Located (GRHS GhcPs (LHsExpr GhcPs))
forall e. e -> Located e
noLoc (XCGRHS GhcPs (LHsExpr GhcPs)
-> [ExprLStmt GhcPs] -> LHsExpr GhcPs -> GRHS GhcPs (LHsExpr GhcPs)
forall p body.
XCGRHS p body -> [GuardLStmt p] -> body -> GRHS p body
GRHS NoExtField
XCGRHS GhcPs (LHsExpr GhcPs)
noExtField [] LHsExpr GhcPs
rhs)
            grhss :: GRHSs GhcPs (LHsExpr GhcPs)
grhss = XCGRHSs GhcPs (LHsExpr GhcPs)
-> [Located (GRHS GhcPs (LHsExpr GhcPs))]
-> LHsLocalBinds GhcPs
-> GRHSs GhcPs (LHsExpr GhcPs)
forall p body.
XCGRHSs p body -> [LGRHS p body] -> LHsLocalBinds p -> GRHSs p body
GRHSs NoExtField
XCGRHSs GhcPs (LHsExpr GhcPs)
noExtField [Located (GRHS GhcPs (LHsExpr GhcPs))
grhs] (HsLocalBindsLR GhcPs GhcPs -> LHsLocalBinds GhcPs
forall e. e -> Located e
noLoc (XEmptyLocalBinds GhcPs GhcPs -> HsLocalBindsLR GhcPs GhcPs
forall idL idR. XEmptyLocalBinds idL idR -> HsLocalBindsLR idL idR
EmptyLocalBinds NoExtField
XEmptyLocalBinds GhcPs GhcPs
noExtField))
            match :: Located (Match GhcPs (LHsExpr GhcPs))
match = Match GhcPs (LHsExpr GhcPs)
-> Located (Match GhcPs (LHsExpr GhcPs))
forall e. e -> Located e
noLoc (Match GhcPs (LHsExpr GhcPs)
 -> Located (Match GhcPs (LHsExpr GhcPs)))
-> Match GhcPs (LHsExpr GhcPs)
-> Located (Match GhcPs (LHsExpr GhcPs))
forall a b. (a -> b) -> a -> b
$ XCMatch GhcPs (LHsExpr GhcPs)
-> HsMatchContext (NoGhcTc GhcPs)
-> [LPat GhcPs]
-> GRHSs GhcPs (LHsExpr GhcPs)
-> Match GhcPs (LHsExpr GhcPs)
forall p body.
XCMatch p body
-> HsMatchContext (NoGhcTc p)
-> [LPat p]
-> GRHSs p body
-> Match p body
Match NoExtField
XCMatch GhcPs (LHsExpr GhcPs)
noExtField (LIdP (NoGhcTc GhcPs)
-> LexicalFixity -> SrcStrictness -> HsMatchContext (NoGhcTc GhcPs)
forall p.
LIdP p -> LexicalFixity -> SrcStrictness -> HsMatchContext p
FunRhs LIdP (NoGhcTc GhcPs)
Located RdrName
p LexicalFixity
Prefix SrcStrictness
NoSrcStrict) [] GRHSs GhcPs (LHsExpr GhcPs)
grhss
            fb :: Located (HsBindLR GhcPs GhcPs)
fb = HsBindLR GhcPs GhcPs -> Located (HsBindLR GhcPs GhcPs)
forall e. e -> Located e
noLoc (HsBindLR GhcPs GhcPs -> Located (HsBindLR GhcPs GhcPs))
-> HsBindLR GhcPs GhcPs -> Located (HsBindLR GhcPs GhcPs)
forall a b. (a -> b) -> a -> b
$ XFunBind GhcPs GhcPs
-> GenLocated SrcSpan (IdP GhcPs)
-> MatchGroup GhcPs (LHsExpr GhcPs)
-> [Tickish Id]
-> HsBindLR GhcPs GhcPs
forall idL idR.
XFunBind idL idR
-> Located (IdP idL)
-> MatchGroup idR (LHsExpr idR)
-> [Tickish Id]
-> HsBindLR idL idR
FunBind NoExtField
XFunBind GhcPs GhcPs
noExtField GenLocated SrcSpan (IdP GhcPs)
Located RdrName
p (XMG GhcPs (LHsExpr GhcPs)
-> Located [Located (Match GhcPs (LHsExpr GhcPs))]
-> Origin
-> MatchGroup GhcPs (LHsExpr GhcPs)
forall p body.
XMG p body
-> Located [LMatch p body] -> Origin -> MatchGroup p body
MG NoExtField
XMG GhcPs (LHsExpr GhcPs)
noExtField ([Located (Match GhcPs (LHsExpr GhcPs))]
-> Located [Located (Match GhcPs (LHsExpr GhcPs))]
forall e. e -> Located e
noLoc [Located (Match GhcPs (LHsExpr GhcPs))
match]) Origin
Generated) []
            binds :: Bag (Located (HsBindLR GhcPs GhcPs))
binds = Located (HsBindLR GhcPs GhcPs)
-> Bag (Located (HsBindLR GhcPs GhcPs))
forall a. a -> Bag a
unitBag Located (HsBindLR GhcPs GhcPs)
fb
            valBinds :: HsValBindsLR GhcPs GhcPs
valBinds = XValBinds GhcPs GhcPs
-> Bag (Located (HsBindLR GhcPs GhcPs))
-> [LSig GhcPs]
-> HsValBindsLR GhcPs GhcPs
forall idL idR.
XValBinds idL idR
-> LHsBindsLR idL idR -> [LSig idR] -> HsValBindsLR idL idR
ValBinds NoExtField
XValBinds GhcPs GhcPs
noExtField Bag (Located (HsBindLR GhcPs GhcPs))
binds []
            localBinds :: LHsLocalBinds GhcPs
localBinds = HsLocalBindsLR GhcPs GhcPs -> LHsLocalBinds GhcPs
forall e. e -> Located e
noLoc (HsLocalBindsLR GhcPs GhcPs -> LHsLocalBinds GhcPs)
-> HsLocalBindsLR GhcPs GhcPs -> LHsLocalBinds GhcPs
forall a b. (a -> b) -> a -> b
$ XHsValBinds GhcPs GhcPs
-> HsValBindsLR GhcPs GhcPs -> HsLocalBindsLR GhcPs GhcPs
forall idL idR.
XHsValBinds idL idR
-> HsValBindsLR idL idR -> HsLocalBindsLR idL idR
HsValBinds NoExtField
XHsValBinds GhcPs GhcPs
noExtField HsValBindsLR GhcPs GhcPs
valBinds
         in StmtLR GhcPs GhcPs (LHsExpr GhcPs) -> ExprLStmt GhcPs
forall e. e -> Located e
noLoc (StmtLR GhcPs GhcPs (LHsExpr GhcPs) -> ExprLStmt GhcPs)
-> StmtLR GhcPs GhcPs (LHsExpr GhcPs) -> ExprLStmt GhcPs
forall a b. (a -> b) -> a -> b
$ XLetStmt GhcPs GhcPs (LHsExpr GhcPs)
-> LHsLocalBinds GhcPs -> StmtLR GhcPs GhcPs (LHsExpr GhcPs)
forall idL idR body.
XLetStmt idL idR body
-> LHsLocalBindsLR idL idR -> StmtLR idL idR body
LetStmt NoExtField
XLetStmt GhcPs GhcPs (LHsExpr GhcPs)
noExtField LHsLocalBinds GhcPs
localBinds

fromApplies :: LHsExpr GhcPs -> ([LHsExpr GhcPs], LHsExpr GhcPs)
fromApplies :: LHsExpr GhcPs -> ([LHsExpr GhcPs], LHsExpr GhcPs)
fromApplies (L SrcSpan
_ (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 (LHsExpr GhcPs -> LHsExpr GhcPs
fromParen LHsExpr GhcPs
x)
fromApplies (L SrcSpan
_ (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 SrcSpan
_ (HsPar XPar GhcPs
_ LHsExpr GhcPs
x)) = LHsExpr GhcPs -> Maybe (String, LHsExpr GhcPs)
fromRet LHsExpr GhcPs
x
fromRet (L SrcSpan
_ (OpApp XOpApp GhcPs
_ LHsExpr GhcPs
x (L SrcSpan
_ (HsVar XVar GhcPs
_ (L SrcSpan
_ IdP GhcPs
y))) LHsExpr GhcPs
z)) | RdrName -> String
occNameStr IdP GhcPs
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 -> LHsExpr GhcPs
forall e. e -> Located e
noLoc (XApp GhcPs -> LHsExpr GhcPs -> LHsExpr GhcPs -> HsExpr GhcPs
forall p. XApp p -> LHsExpr p -> LHsExpr p -> HsExpr p
HsApp NoExtField
XApp GhcPs
noExtField LHsExpr GhcPs
x LHsExpr GhcPs
z)
fromRet (L SrcSpan
_ (HsApp XApp GhcPs
_ LHsExpr GhcPs
x LHsExpr GhcPs
y)) | LHsExpr GhcPs -> Bool
isReturn LHsExpr GhcPs
x = (String, LHsExpr GhcPs) -> Maybe (String, LHsExpr GhcPs)
forall a. a -> Maybe a
Just (LHsExpr GhcPs -> String
forall a. Outputable a => a -> String
unsafePrettyPrint LHsExpr GhcPs
x, LHsExpr GhcPs
y)
fromRet LHsExpr GhcPs
_ = Maybe (String, LHsExpr GhcPs)
forall a. Maybe a
Nothing