{-# 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 -- do foo x; bar z
main = void $ forM_ f xs -- forM_ f xs
main = void $ forM f xs -- void $ forM_ f xs
main = do _ <- forM_ f xs; bar -- 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(DeclHint,Idea(..),Severity(..),ideaNote,warn,ideaRemove,toSS,suggest,Note(Note))

import GHC.Hs
import SrcLoc
import BasicTypes
import TcEvidence
import RdrName
import OccName
import 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 -> SrcSpanLess (LHsExpr GhcPs) -> LHsExpr GhcPs
forall a. HasSrcSpan a => SrcSpan -> SrcSpanLess a -> a
cL 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 -> SrcSpanLess (LHsExpr GhcPs) -> LHsExpr GhcPs
forall a. HasSrcSpan a => SrcSpan -> SrcSpanLess a -> a
cL 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 Name
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 Name
ctx of HsStmtContext Name
MDoExpr -> String
"mdo"; HsStmtContext Name
_ -> 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. HasSrcSpan a => a -> SrcSpan
toSS LHsExpr GhcPs
x) [(String
"y", LHsExpr GhcPs -> SrcSpan
forall a. HasSrcSpan a => 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
_ HsStmtContext Name
DoExpr (L SrcSpan
_ [ExprLStmt GhcPs]
xs))) ->
      ([ExprLStmt GhcPs] -> LHsExpr GhcPs) -> [ExprLStmt GhcPs] -> [Idea]
monadSteps (SrcSpan -> SrcSpanLess (LHsExpr GhcPs) -> LHsExpr GhcPs
forall a. HasSrcSpan a => SrcSpan -> SrcSpanLess a -> a
cL 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 Name
-> GenLocated SrcSpan [ExprLStmt GhcPs]
-> HsExpr GhcPs
forall p.
XDo p -> HsStmtContext Name -> Located [ExprLStmt p] -> HsExpr p
HsDo NoExtField
XDo GhcPs
noExtField HsStmtContext Name
forall id. HsStmtContext id
DoExpr (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 a. HasSrcSpan a => SrcSpanLess a -> a
noLoc) [ExprLStmt GhcPs]
xs [Idea] -> [Idea] -> [Idea]
forall a. [a] -> [a] -> [a]
++
      [String
-> ExprLStmt GhcPs
-> ExprLStmt GhcPs
-> [Refactoring SrcSpan]
-> Idea
forall a b.
(HasSrcSpan a, Outputable a, HasSrcSpan b, Outputable b) =>
String -> a -> 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)
_ (LL _ WildPat{}) LHsExpr GhcPs
x SyntaxExpr GhcPs
_ SyntaxExpr GhcPs
_)) <- [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.
(HasSrcSpan a, Outputable a, HasSrcSpan b, Outputable b) =>
String -> a -> b -> [Refactoring SrcSpan] -> Idea
warn String
"Redundant void" (LHsExpr GhcPs -> LHsExpr GhcPs
wrap LHsExpr GhcPs
x) LHsExpr GhcPs
x [] | LHsExpr GhcPs -> Bool
returnsUnit LHsExpr GhcPs
x]
    doSpan :: t a -> SrcSpan -> SrcSpan
doSpan t a
doOrMDo = \case
      UnhelpfulSpan FastString
s -> FastString -> SrcSpan
UnhelpfulSpan FastString
s
      RealSrcSpan RealSrcSpan
s ->
        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 -> SrcSpan
RealSrcSpan (RealSrcLoc -> RealSrcLoc -> RealSrcSpan
mkRealSrcSpan RealSrcLoc
start RealSrcLoc
end)

-- 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 Name
_ (L (RealSrcSpan RealSrcSpan
a) [ExprLStmt GhcPs]
_)))) (L SrcSpan
_ (HsDo XDo GhcPs
_ HsStmtContext Name
_ (L (RealSrcSpan RealSrcSpan
b) [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 -> SrcSpanLess (LHsExpr GhcPs) -> LHsExpr GhcPs
forall a. HasSrcSpan a => SrcSpan -> SrcSpanLess a -> a
cL 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 -> SrcSpanLess (LHsExpr GhcPs) -> LHsExpr GhcPs
forall a. HasSrcSpan a => SrcSpan -> SrcSpanLess a -> a
cL 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 -> SrcSpanLess (LHsExpr GhcPs) -> LHsExpr GhcPs
forall a. HasSrcSpan a => SrcSpan -> SrcSpanLess a -> a
cL 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 -> SrcSpanLess (LHsExpr GhcPs) -> LHsExpr GhcPs
forall a. HasSrcSpan a => SrcSpan -> SrcSpanLess a -> a
cL 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.
(HasSrcSpan a, Outputable a, HasSrcSpan b, Outputable b) =>
String -> a -> 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. HasSrcSpan a => 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 os :: [ExprLStmt GhcPs]
os@(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]
_))
  = [String
-> LHsExpr GhcPs -> LHsExpr GhcPs -> [Refactoring SrcSpan] -> Idea
forall a b.
(HasSrcSpan a, Outputable a, HasSrcSpan b, Outputable b) =>
String -> a -> b -> [Refactoring SrcSpan] -> Idea
warn (String
"Redundant " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
ret) ([ExprLStmt GhcPs] -> LHsExpr GhcPs
wrap [ExprLStmt GhcPs]
os) ([ExprLStmt GhcPs] -> LHsExpr GhcPs
wrap [ExprLStmt GhcPs]
xs) [RType -> SrcSpan -> Refactoring SrcSpan
forall a. RType -> a -> Refactoring a
Delete RType
Stmt (ExprLStmt GhcPs -> SrcSpan
forall a. HasSrcSpan a => 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)
_ (LL _ (VarPat _ (L _ p))) 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
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.
(HasSrcSpan a, Outputable a, HasSrcSpan b, Outputable b) =>
String -> a -> 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 [SrcSpanLess (ExprLStmt GhcPs) -> ExprLStmt GhcPs
forall a. HasSrcSpan a => SrcSpanLess a -> a
noLoc (SrcSpanLess (ExprLStmt GhcPs) -> ExprLStmt GhcPs)
-> SrcSpanLess (ExprLStmt 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). SyntaxExpr (GhcPass p)
noSyntaxExpr SyntaxExpr GhcPs
forall (p :: Pass). 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. HasSrcSpan a => a -> SrcSpan
toSS ExprLStmt GhcPs
g) [(String
"x", LHsExpr GhcPs -> SrcSpan
forall a. HasSrcSpan a => 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. HasSrcSpan a => 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 SyntaxExpr GhcPs
_ SyntaxExpr GhcPs
_)):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 = SrcSpanLess (LHsExpr GhcPs) -> LHsExpr GhcPs
forall a. HasSrcSpan a => SrcSpanLess a -> a
noLoc (SrcSpanLess (LHsExpr GhcPs) -> LHsExpr GhcPs)
-> SrcSpanLess (LHsExpr 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 = SrcSpanLess (ExprLStmt GhcPs) -> ExprLStmt GhcPs
forall a. HasSrcSpan a => SrcSpanLess a -> a
noLoc (SrcSpanLess (ExprLStmt GhcPs) -> ExprLStmt GhcPs)
-> SrcSpanLess (ExprLStmt 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). SyntaxExpr (GhcPass p)
noSyntaxExpr SyntaxExpr GhcPs
forall (p :: Pass). 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.
(HasSrcSpan a, Outputable a, HasSrcSpan b, Outputable b) =>
String -> a -> 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. HasSrcSpan a => a -> SrcSpan
toSS ExprLStmt GhcPs
g) [(String
"x", LHsExpr GhcPs -> SrcSpan
forall a. HasSrcSpan a => 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. HasSrcSpan a => 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 SyntaxExpr GhcPs
_ SyntaxExpr GhcPs
_)) : [ExprLStmt GhcPs]
rest)
    | LPat GhcPs -> Bool
isPWildcard LPat GhcPs
p, LHsExpr GhcPs -> Bool
returnsUnit LHsExpr GhcPs
x
    = let body :: ExprLStmt GhcPs
body = SrcSpan -> SrcSpanLess (ExprLStmt GhcPs) -> ExprLStmt GhcPs
forall a. HasSrcSpan a => SrcSpan -> SrcSpanLess a -> a
cL SrcSpan
loc (SrcSpanLess (ExprLStmt GhcPs) -> ExprLStmt GhcPs)
-> SrcSpanLess (ExprLStmt 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). SyntaxExpr (GhcPass p)
noSyntaxExpr SyntaxExpr GhcPs
forall (p :: Pass). SyntaxExpr (GhcPass p)
noSyntaxExpr :: ExprLStmt GhcPs
      in [String
-> ExprLStmt GhcPs
-> ExprLStmt GhcPs
-> [Refactoring SrcSpan]
-> Idea
forall a b.
(HasSrcSpan a, Outputable a, HasSrcSpan b, Outputable b) =>
String -> a -> b -> [Refactoring SrcSpan] -> Idea
warn String
"Redundant variable capture" ExprLStmt GhcPs
o ExprLStmt GhcPs
body []]

-- 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
_)
         , 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.
(HasSrcSpan a, Outputable a, HasSrcSpan b, Outputable b) =>
String -> a -> 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) []]

-- 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 SyntaxExpr GhcPs
_ SyntaxExpr GhcPs
_))
    , 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.
(HasSrcSpan a, Outputable a, HasSrcSpan b, Outputable b) =>
String -> a -> b -> [Refactoring SrcSpan] -> Idea
warn String
"Use <$>" ([ExprLStmt GhcPs] -> LHsExpr GhcPs
wrap [ExprLStmt GhcPs]
o) ([ExprLStmt GhcPs] -> LHsExpr GhcPs
wrap [SrcSpanLess (ExprLStmt GhcPs) -> ExprLStmt GhcPs
forall a. HasSrcSpan a => SrcSpanLess a -> a
noLoc (SrcSpanLess (ExprLStmt GhcPs) -> ExprLStmt GhcPs)
-> SrcSpanLess (ExprLStmt 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 (SrcSpanLess (LHsExpr GhcPs) -> LHsExpr GhcPs
forall a. HasSrcSpan a => SrcSpanLess a -> a
noLoc (SrcSpanLess (LHsExpr GhcPs) -> LHsExpr GhcPs)
-> SrcSpanLess (LHsExpr 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 -> SrcSpanLess (LHsExpr GhcPs) -> LHsExpr GhcPs
forall a. HasSrcSpan a => SrcSpanLess a -> a
noLoc (SrcSpanLess (LHsExpr GhcPs) -> LHsExpr GhcPs)
-> SrcSpanLess (LHsExpr 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). SyntaxExpr (GhcPass p)
noSyntaxExpr SyntaxExpr GhcPs
forall (p :: Pass). 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. HasSrcSpan a => a -> SrcSpan
toSS ExprLStmt GhcPs
g) ((String
"x", LHsExpr GhcPs -> SrcSpan
forall a. HasSrcSpan a => 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. HasSrcSpan a => 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. HasSrcSpan a => 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
_ SyntaxExpr GhcPs
_ SyntaxExpr 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)) SyntaxExpr GhcPs
_ SyntaxExpr GhcPs
_ ))
      | 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. HasSrcSpan a => a -> SrcSpan
toSS ExprLStmt GhcPs
x) [(String
"lhs", Located (Pat GhcPs) -> SrcSpan
forall a. HasSrcSpan a => a -> SrcSpan
toSS LPat GhcPs
Located (Pat GhcPs)
v), (String
"rhs", LHsExpr GhcPs -> SrcSpan
forall a. HasSrcSpan a => 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 (NameOrRdrName (IdP GhcPs))
p = SrcSpanLess (Located (NameOrRdrName (IdP GhcPs)))
-> Located (NameOrRdrName (IdP GhcPs))
forall a. HasSrcSpan a => SrcSpanLess a -> a
noLoc (SrcSpanLess (Located (NameOrRdrName (IdP GhcPs)))
 -> Located (NameOrRdrName (IdP GhcPs)))
-> SrcSpanLess (Located (NameOrRdrName (IdP GhcPs)))
-> Located (NameOrRdrName (IdP GhcPs))
forall a b. (a -> b) -> a -> b
$ OccName -> RdrName
mkRdrUnqual (String -> OccName
mkVarOcc String
lhs)
            grhs :: LGRHS GhcPs (LHsExpr GhcPs)
grhs = SrcSpanLess (LGRHS GhcPs (LHsExpr GhcPs))
-> LGRHS GhcPs (LHsExpr GhcPs)
forall a. HasSrcSpan a => SrcSpanLess a -> a
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)
-> [LGRHS 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 [LGRHS GhcPs (LHsExpr GhcPs)
grhs] (SrcSpanLess (LHsLocalBinds GhcPs) -> LHsLocalBinds GhcPs
forall a. HasSrcSpan a => SrcSpanLess a -> a
noLoc (XEmptyLocalBinds GhcPs GhcPs -> HsLocalBindsLR GhcPs GhcPs
forall idL idR. XEmptyLocalBinds idL idR -> HsLocalBindsLR idL idR
EmptyLocalBinds NoExtField
XEmptyLocalBinds GhcPs GhcPs
noExtField))
            match :: LMatch GhcPs (LHsExpr GhcPs)
match = SrcSpanLess (LMatch GhcPs (LHsExpr GhcPs))
-> LMatch GhcPs (LHsExpr GhcPs)
forall a. HasSrcSpan a => SrcSpanLess a -> a
noLoc (SrcSpanLess (LMatch GhcPs (LHsExpr GhcPs))
 -> LMatch GhcPs (LHsExpr GhcPs))
-> SrcSpanLess (LMatch GhcPs (LHsExpr GhcPs))
-> LMatch GhcPs (LHsExpr GhcPs)
forall a b. (a -> b) -> a -> b
$ XCMatch GhcPs (LHsExpr GhcPs)
-> HsMatchContext (NameOrRdrName (IdP GhcPs))
-> [LPat GhcPs]
-> GRHSs GhcPs (LHsExpr GhcPs)
-> Match GhcPs (LHsExpr GhcPs)
forall p body.
XCMatch p body
-> HsMatchContext (NameOrRdrName (IdP p))
-> [LPat p]
-> GRHSs p body
-> Match p body
Match NoExtField
XCMatch GhcPs (LHsExpr GhcPs)
noExtField (Located (NameOrRdrName (IdP GhcPs))
-> LexicalFixity
-> SrcStrictness
-> HsMatchContext (NameOrRdrName (IdP GhcPs))
forall id.
Located id -> LexicalFixity -> SrcStrictness -> HsMatchContext id
FunRhs Located (NameOrRdrName (IdP GhcPs))
p LexicalFixity
Prefix SrcStrictness
NoSrcStrict) [] GRHSs GhcPs (LHsExpr GhcPs)
grhss
            fb :: LHsBindLR GhcPs GhcPs
fb = SrcSpanLess (LHsBindLR GhcPs GhcPs) -> LHsBindLR GhcPs GhcPs
forall a. HasSrcSpan a => SrcSpanLess a -> a
noLoc (SrcSpanLess (LHsBindLR GhcPs GhcPs) -> LHsBindLR GhcPs GhcPs)
-> SrcSpanLess (LHsBindLR GhcPs GhcPs) -> LHsBindLR GhcPs GhcPs
forall a b. (a -> b) -> a -> b
$ XFunBind GhcPs GhcPs
-> GenLocated SrcSpan (IdP GhcPs)
-> MatchGroup GhcPs (LHsExpr GhcPs)
-> HsWrapper
-> [Tickish Id]
-> HsBindLR GhcPs GhcPs
forall idL idR.
XFunBind idL idR
-> Located (IdP idL)
-> MatchGroup idR (LHsExpr idR)
-> HsWrapper
-> [Tickish Id]
-> HsBindLR idL idR
FunBind NoExtField
XFunBind GhcPs GhcPs
noExtField GenLocated SrcSpan (IdP GhcPs)
Located (NameOrRdrName (IdP GhcPs))
p (XMG GhcPs (LHsExpr GhcPs)
-> Located [LMatch 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 (SrcSpanLess (Located [LMatch GhcPs (LHsExpr GhcPs)])
-> Located [LMatch GhcPs (LHsExpr GhcPs)]
forall a. HasSrcSpan a => SrcSpanLess a -> a
noLoc [LMatch GhcPs (LHsExpr GhcPs)
match]) Origin
Generated) HsWrapper
WpHole []
            binds :: Bag (LHsBindLR GhcPs GhcPs)
binds = LHsBindLR GhcPs GhcPs -> Bag (LHsBindLR GhcPs GhcPs)
forall a. a -> Bag a
unitBag LHsBindLR GhcPs GhcPs
fb
            valBinds :: HsValBindsLR GhcPs GhcPs
valBinds = XValBinds GhcPs GhcPs
-> Bag (LHsBindLR 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 (LHsBindLR GhcPs GhcPs)
binds []
            localBinds :: LHsLocalBinds GhcPs
localBinds = SrcSpanLess (LHsLocalBinds GhcPs) -> LHsLocalBinds GhcPs
forall a. HasSrcSpan a => SrcSpanLess a -> a
noLoc (SrcSpanLess (LHsLocalBinds GhcPs) -> LHsLocalBinds GhcPs)
-> SrcSpanLess (LHsLocalBinds 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 SrcSpanLess (ExprLStmt GhcPs) -> ExprLStmt GhcPs
forall a. HasSrcSpan a => SrcSpanLess a -> a
noLoc (SrcSpanLess (ExprLStmt GhcPs) -> ExprLStmt GhcPs)
-> SrcSpanLess (ExprLStmt 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
$ SrcSpanLess (LHsExpr GhcPs) -> LHsExpr GhcPs
forall a. HasSrcSpan a => SrcSpanLess a -> a
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