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

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


-- | Call with the name of the declaration,
--   the nearest enclosing `do` expression
--   the nearest enclosing expression
--   the expression of interest
monadExp :: Maybe String -> Maybe (LHsExpr GhcPs) -> Maybe (Int, LHsExpr GhcPs) -> LHsExpr GhcPs -> [Idea]
monadExp :: Maybe String
-> Maybe (LHsExpr GhcPs)
-> Maybe (Int, LHsExpr GhcPs)
-> LHsExpr GhcPs
-> [Idea]
monadExp Maybe String
decl Maybe (LHsExpr GhcPs)
parentDo Maybe (Int, LHsExpr GhcPs)
parentExpr LHsExpr GhcPs
x =
  case LHsExpr GhcPs
x of
    (LHsExpr GhcPs -> App2
forall a b. View a b => a -> b
view -> App2 GenLocated SrcSpanAnnA (HsExpr GhcPs)
op GenLocated SrcSpanAnnA (HsExpr GhcPs)
x1 GenLocated SrcSpanAnnA (HsExpr GhcPs)
x2) | String -> LHsExpr GhcPs -> Bool
isTag String
">>" LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
op -> GenLocated SrcSpanAnnA (HsExpr GhcPs) -> [Idea]
f GenLocated SrcSpanAnnA (HsExpr GhcPs)
x1
    (LHsExpr GhcPs -> App2
forall a b. View a b => a -> b
view -> App2 GenLocated SrcSpanAnnA (HsExpr GhcPs)
op GenLocated SrcSpanAnnA (HsExpr GhcPs)
x1 (GenLocated SrcSpanAnnA (HsExpr GhcPs) -> LamConst1
forall a b. View a b => a -> b
view -> LamConst1 GenLocated SrcSpanAnnA (HsExpr GhcPs)
_)) | String -> LHsExpr GhcPs -> Bool
isTag String
">>=" LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
op -> GenLocated SrcSpanAnnA (HsExpr GhcPs) -> [Idea]
f GenLocated SrcSpanAnnA (HsExpr GhcPs)
x1
    (L l (HsApp _ op x)) | String -> LHsExpr GhcPs -> Bool
isTag String
"void" LHsExpr GhcPs
op -> (GenLocated SrcSpanAnnA (HsExpr GhcPs)
 -> GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> GenLocated SrcSpanAnnA (HsExpr GhcPs) -> [Idea]
seenVoid (SrcSpanAnnA
-> HsExpr GhcPs -> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l (HsExpr GhcPs -> GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> (GenLocated SrcSpanAnnA (HsExpr GhcPs) -> HsExpr GhcPs)
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XApp GhcPs -> LHsExpr GhcPs -> LHsExpr GhcPs -> HsExpr GhcPs
forall p. XApp p -> LHsExpr p -> LHsExpr p -> HsExpr p
HsApp XApp GhcPs
forall ann. EpAnn ann
EpAnnNotUsed LHsExpr GhcPs
op) LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
x
    (L l (OpApp _ op dol x)) | String -> LHsExpr GhcPs -> Bool
isTag String
"void" LHsExpr GhcPs
op, LHsExpr GhcPs -> Bool
isDol LHsExpr GhcPs
dol -> (GenLocated SrcSpanAnnA (HsExpr GhcPs)
 -> GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> GenLocated SrcSpanAnnA (HsExpr GhcPs) -> [Idea]
seenVoid (SrcSpanAnnA
-> HsExpr GhcPs -> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l (HsExpr GhcPs -> GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> (GenLocated SrcSpanAnnA (HsExpr GhcPs) -> HsExpr GhcPs)
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XOpApp GhcPs
-> LHsExpr GhcPs -> LHsExpr GhcPs -> LHsExpr GhcPs -> HsExpr GhcPs
forall p.
XOpApp p -> LHsExpr p -> LHsExpr p -> LHsExpr p -> HsExpr p
OpApp XOpApp GhcPs
forall ann. EpAnn ann
EpAnnNotUsed LHsExpr GhcPs
op LHsExpr GhcPs
dol) LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
x
    (L loc (HsDo _ ctx (L loc2 [L loc3 (BodyStmt _ y _ _ )]))) ->
      let doOrMDo :: String
doOrMDo = case HsStmtContext (HsDoRn GhcPs)
ctx of MDoExpr Maybe ModuleName
_ -> String
"mdo"; HsStmtContext (HsDoRn GhcPs)
_ -> String
"do"
       in [ Severity
-> String -> SrcSpan -> String -> [Refactoring SrcSpan] -> Idea
ideaRemove Severity
Ignore (String
"Redundant " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
doOrMDo) (String -> SrcSpan -> SrcSpan
forall (t :: * -> *) a. Foldable t => t a -> SrcSpan -> SrcSpan
doSpan String
doOrMDo (SrcSpanAnnA -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
loc)) String
doOrMDo [RType
-> SrcSpan -> [(String, SrcSpan)] -> String -> Refactoring SrcSpan
forall a. RType -> a -> [(String, a)] -> String -> Refactoring a
Replace RType
Expr (GenLocated SrcSpanAnnA (HsExpr GhcPs) -> SrcSpan
forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
toSSA LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
x) [(String
"y", GenLocated SrcSpanAnnA (HsExpr GhcPs) -> SrcSpan
forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
toSSA GenLocated SrcSpanAnnA (HsExpr GhcPs)
y)] String
"y"]
          | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Maybe (Int, LHsExpr GhcPs) -> LHsExpr GhcPs -> Bool
doAsBrackets Maybe (Int, LHsExpr GhcPs)
parentExpr LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
y
          , Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Maybe (LHsExpr GhcPs) -> LHsExpr GhcPs -> Bool
doAsAvoidingIndentation Maybe (LHsExpr GhcPs)
parentDo LHsExpr GhcPs
x
          ]
    (L loc (HsDo _ (DoExpr mm) (L _ xs))) ->
      ([ExprLStmt GhcPs] -> LHsExpr GhcPs) -> [ExprLStmt GhcPs] -> [Idea]
monadSteps (SrcSpanAnnA
-> HsExpr GhcPs -> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
loc (HsExpr GhcPs -> GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> ([GenLocated
       SrcSpanAnnA
       (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
    -> HsExpr GhcPs)
-> [GenLocated
      SrcSpanAnnA
      (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XDo GhcPs
-> HsStmtContext (HsDoRn GhcPs)
-> XRec GhcPs [ExprLStmt GhcPs]
-> HsExpr GhcPs
forall p.
XDo p
-> HsStmtContext (HsDoRn p) -> XRec p [ExprLStmt p] -> HsExpr p
HsDo XDo GhcPs
forall ann. EpAnn ann
EpAnnNotUsed (Maybe ModuleName -> HsStmtContext GhcRn
forall p. Maybe ModuleName -> HsStmtContext p
DoExpr Maybe ModuleName
mm) (GenLocated
   SrcSpanAnnL
   [GenLocated
      SrcSpanAnnA
      (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
 -> HsExpr GhcPs)
-> ([GenLocated
       SrcSpanAnnA
       (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
    -> GenLocated
         SrcSpanAnnL
         [GenLocated
            SrcSpanAnnA
            (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))])
-> [GenLocated
      SrcSpanAnnA
      (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> HsExpr GhcPs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [GenLocated
   SrcSpanAnnA
   (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> GenLocated
     SrcSpanAnnL
     [GenLocated
        SrcSpanAnnA
        (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
forall a an. a -> LocatedAn an a
noLocA) [ExprLStmt GhcPs]
[GenLocated
   SrcSpanAnnA
   (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
xs [Idea] -> [Idea] -> [Idea]
forall a. [a] -> [a] -> [a]
++
      [String
-> Located
     (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> Located
     (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> [Refactoring SrcSpan]
-> Idea
forall a b.
(Outputable a, Outputable b) =>
String -> Located a -> Located b -> [Refactoring SrcSpan] -> Idea
suggest String
"Use let" (GenLocated
  SrcSpanAnnA
  (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> Located
     (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
forall a e. LocatedAn a e -> Located e
reLoc GenLocated
  SrcSpanAnnA
  (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
from) (GenLocated
  SrcSpanAnnA
  (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> Located
     (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
forall a e. LocatedAn a e -> Located e
reLoc GenLocated
  SrcSpanAnnA
  (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
to) [Refactoring SrcSpan
r] | (GenLocated
  SrcSpanAnnA
  (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
from, GenLocated
  SrcSpanAnnA
  (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
to, Refactoring SrcSpan
r) <- [ExprLStmt GhcPs]
-> [(ExprLStmt GhcPs, ExprLStmt GhcPs, Refactoring SrcSpan)]
monadLet [ExprLStmt GhcPs]
[GenLocated
   SrcSpanAnnA
   (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
xs] [Idea] -> [Idea] -> [Idea]
forall a. [a] -> [a] -> [a]
++
      [[Idea]] -> [Idea]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [GenLocated SrcSpanAnnA (HsExpr GhcPs) -> [Idea]
f GenLocated SrcSpanAnnA (HsExpr GhcPs)
x | (L SrcSpanAnnA
_ (BodyStmt XBodyStmt GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
_ GenLocated SrcSpanAnnA (HsExpr GhcPs)
x SyntaxExpr GhcPs
_ SyntaxExpr GhcPs
_)) <- [GenLocated
   SrcSpanAnnA
   (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> [GenLocated
      SrcSpanAnnA
      (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
forall a. [a] -> [a]
dropEnd1 [GenLocated
   SrcSpanAnnA
   (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
xs] [Idea] -> [Idea] -> [Idea]
forall a. [a] -> [a] -> [a]
++
      [[Idea]] -> [Idea]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [GenLocated SrcSpanAnnA (HsExpr GhcPs) -> [Idea]
f GenLocated SrcSpanAnnA (HsExpr GhcPs)
x | (L SrcSpanAnnA
_ (BindStmt XBindStmt GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
_ (L _ WildPat{}) GenLocated SrcSpanAnnA (HsExpr GhcPs)
x)) <- [GenLocated
   SrcSpanAnnA
   (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> [GenLocated
      SrcSpanAnnA
      (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
forall a. [a] -> [a]
dropEnd1 [GenLocated
   SrcSpanAnnA
   (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
xs]
    LHsExpr GhcPs
_ -> []
  where
    f :: LHsExpr GhcPs -> [Idea]
f = String
-> (LHsExpr GhcPs -> LHsExpr GhcPs) -> LHsExpr GhcPs -> [Idea]
monadNoResult (String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
"" Maybe String
decl) LHsExpr GhcPs -> LHsExpr GhcPs
forall a. a -> a
id
    seenVoid :: (GenLocated SrcSpanAnnA (HsExpr GhcPs)
 -> GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> GenLocated SrcSpanAnnA (HsExpr GhcPs) -> [Idea]
seenVoid GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
wrap GenLocated SrcSpanAnnA (HsExpr 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
GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
wrap LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
x
      [Idea] -> [Idea] -> [Idea]
forall a. [a] -> [a] -> [a]
++ [String
-> Located (HsExpr GhcPs)
-> Located (HsExpr GhcPs)
-> [Refactoring SrcSpan]
-> Idea
forall a b.
(Outputable a, Outputable b) =>
String -> Located a -> Located b -> [Refactoring SrcSpan] -> Idea
warn String
"Redundant void" (GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Located (HsExpr GhcPs)
forall a e. LocatedAn a e -> Located e
reLoc (GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
wrap GenLocated SrcSpanAnnA (HsExpr GhcPs)
x)) (GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Located (HsExpr GhcPs)
forall a e. LocatedAn a e -> Located e
reLoc GenLocated SrcSpanAnnA (HsExpr GhcPs)
x) [RType
-> SrcSpan -> [(String, SrcSpan)] -> String -> Refactoring SrcSpan
forall a. RType -> a -> [(String, a)] -> String -> Refactoring a
Replace RType
Expr (GenLocated SrcSpanAnnA (HsExpr GhcPs) -> SrcSpan
forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
toSSA (GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
wrap GenLocated SrcSpanAnnA (HsExpr GhcPs)
x)) [(String
"a", GenLocated SrcSpanAnnA (HsExpr GhcPs) -> SrcSpan
forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
toSSA GenLocated SrcSpanAnnA (HsExpr GhcPs)
x)] String
"a"] | LHsExpr GhcPs -> Bool
returnsUnit LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
x]
    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 _ (OpApp _ _ op _ ))) LHsExpr GhcPs
_ | LHsExpr GhcPs -> Bool
isDol LHsExpr GhcPs
op = Bool
False -- not quite atomic, but close enough
doAsBrackets (Just (Int
i, LHsExpr GhcPs
o)) LHsExpr GhcPs
x = Int
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> Bool
forall a. Brackets a => Int -> a -> a -> Bool
needBracket Int
i LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
o LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
x
doAsBrackets Maybe (Int, LHsExpr GhcPs)
Nothing LHsExpr GhcPs
x = Bool
False


-- Sometimes people write do, to avoid 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 _ (HsDo _ _ (L anna _)))) (L _ (HsDo _ _ (L annb _)))
  | SrcSpanAnn EpAnn AnnList
_ (RealSrcSpan RealSrcSpan
a Maybe BufSpan
_) <- SrcSpanAnnL
anna
  , SrcSpanAnn EpAnn AnnList
_ (RealSrcSpan RealSrcSpan
b Maybe BufSpan
_) <- SrcSpanAnnL
annb
    = RealSrcSpan -> Int
srcSpanStartCol RealSrcSpan
a Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== RealSrcSpan -> Int
srcSpanStartCol RealSrcSpan
b
doAsAvoidingIndentation Maybe (LHsExpr GhcPs)
parent LHsExpr GhcPs
self = Bool
False


returnsUnit :: LHsExpr GhcPs -> Bool
returnsUnit :: LHsExpr GhcPs -> Bool
returnsUnit (L _ (HsPar _ x)) = LHsExpr GhcPs -> Bool
returnsUnit LHsExpr GhcPs
x
returnsUnit (L _ (HsApp _ x _)) = LHsExpr GhcPs -> Bool
returnsUnit LHsExpr GhcPs
x
returnsUnit (L _ (OpApp _ x op _)) | LHsExpr GhcPs -> Bool
isDol LHsExpr GhcPs
op = LHsExpr GhcPs -> Bool
returnsUnit LHsExpr GhcPs
x
returnsUnit (L _ (HsVar _ (L _ x))) = RdrName -> String
occNameStr 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 l (HsPar _ x)) = String
-> (LHsExpr GhcPs -> LHsExpr GhcPs) -> LHsExpr GhcPs -> [Idea]
monadNoResult String
inside (LHsExpr GhcPs -> LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
wrap (GenLocated SrcSpanAnnA (HsExpr GhcPs)
 -> GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> (GenLocated SrcSpanAnnA (HsExpr GhcPs)
    -> GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SrcSpanAnnA
-> HsExpr GhcPs -> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l (HsExpr GhcPs -> GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> (GenLocated SrcSpanAnnA (HsExpr GhcPs) -> HsExpr GhcPs)
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XPar GhcPs -> LHsExpr GhcPs -> HsExpr GhcPs
forall p. XPar p -> LHsExpr p -> HsExpr p
HsPar XPar GhcPs
forall ann. EpAnn ann
EpAnnNotUsed) LHsExpr GhcPs
x
monadNoResult String
inside LHsExpr GhcPs -> LHsExpr GhcPs
wrap (L l (HsApp _ x y)) = String
-> (LHsExpr GhcPs -> LHsExpr GhcPs) -> LHsExpr GhcPs -> [Idea]
monadNoResult String
inside (\LHsExpr GhcPs
x -> LHsExpr GhcPs -> LHsExpr GhcPs
wrap (LHsExpr GhcPs -> LHsExpr GhcPs) -> LHsExpr GhcPs -> LHsExpr GhcPs
forall a b. (a -> b) -> a -> b
$ SrcSpanAnnA
-> HsExpr GhcPs -> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l (XApp GhcPs -> LHsExpr GhcPs -> LHsExpr GhcPs -> HsExpr GhcPs
forall p. XApp p -> LHsExpr p -> LHsExpr p -> HsExpr p
HsApp XApp GhcPs
forall ann. EpAnn ann
EpAnnNotUsed LHsExpr GhcPs
x LHsExpr GhcPs
y)) LHsExpr GhcPs
x
monadNoResult String
inside LHsExpr GhcPs -> LHsExpr GhcPs
wrap (L l (OpApp _ x tag@(L _ (HsVar _ (L _ op))) y))
    | LHsExpr GhcPs -> Bool
isDol LHsExpr GhcPs
tag = String
-> (LHsExpr GhcPs -> LHsExpr GhcPs) -> LHsExpr GhcPs -> [Idea]
monadNoResult String
inside (\LHsExpr GhcPs
x -> LHsExpr GhcPs -> LHsExpr GhcPs
wrap (LHsExpr GhcPs -> LHsExpr GhcPs) -> LHsExpr GhcPs -> LHsExpr GhcPs
forall a b. (a -> b) -> a -> b
$ SrcSpanAnnA
-> HsExpr GhcPs -> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l (XOpApp GhcPs
-> LHsExpr GhcPs -> LHsExpr GhcPs -> LHsExpr GhcPs -> HsExpr GhcPs
forall p.
XOpApp p -> LHsExpr p -> LHsExpr p -> LHsExpr p -> HsExpr p
OpApp XOpApp GhcPs
forall ann. EpAnn ann
EpAnnNotUsed LHsExpr GhcPs
x LHsExpr GhcPs
tag LHsExpr GhcPs
y)) LHsExpr GhcPs
x
    | RdrName -> String
occNameStr RdrName
op String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
">>=" = String
-> (LHsExpr GhcPs -> LHsExpr GhcPs) -> LHsExpr GhcPs -> [Idea]
monadNoResult String
inside (LHsExpr GhcPs -> LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
wrap (GenLocated SrcSpanAnnA (HsExpr GhcPs)
 -> GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> (GenLocated SrcSpanAnnA (HsExpr GhcPs)
    -> GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SrcSpanAnnA
-> HsExpr GhcPs -> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l (HsExpr GhcPs -> GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> (GenLocated SrcSpanAnnA (HsExpr GhcPs) -> HsExpr GhcPs)
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XOpApp GhcPs
-> LHsExpr GhcPs -> LHsExpr GhcPs -> LHsExpr GhcPs -> HsExpr GhcPs
forall p.
XOpApp p -> LHsExpr p -> LHsExpr p -> LHsExpr p -> HsExpr p
OpApp XOpApp GhcPs
forall ann. EpAnn ann
EpAnnNotUsed LHsExpr GhcPs
x LHsExpr GhcPs
tag) LHsExpr GhcPs
y
monadNoResult String
inside LHsExpr GhcPs -> LHsExpr GhcPs
wrap LHsExpr GhcPs
x
    | String
x2 : [String]
_ <- (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (String -> LHsExpr GhcPs -> Bool
`isTag` LHsExpr GhcPs
x) [String]
badFuncs
    , let x3 :: String
x3 = String
x2 String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"_"
    = [String
-> Located (HsExpr GhcPs)
-> Located (HsExpr GhcPs)
-> [Refactoring SrcSpan]
-> Idea
forall a b.
(Outputable a, Outputable b) =>
String -> Located a -> Located b -> [Refactoring SrcSpan] -> Idea
warn (String
"Use " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
x3) (GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Located (HsExpr GhcPs)
forall a e. LocatedAn a e -> Located e
reLoc (LHsExpr GhcPs -> LHsExpr GhcPs
wrap LHsExpr GhcPs
x)) (GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Located (HsExpr GhcPs)
forall a e. LocatedAn a e -> Located e
reLoc (LHsExpr GhcPs -> LHsExpr GhcPs
wrap (LHsExpr GhcPs -> LHsExpr GhcPs) -> LHsExpr GhcPs -> LHsExpr GhcPs
forall a b. (a -> b) -> a -> b
$ String -> LHsExpr GhcPs
strToVar String
x3)) [RType
-> SrcSpan -> [(String, SrcSpan)] -> String -> Refactoring SrcSpan
forall a. RType -> a -> [(String, a)] -> String -> Refactoring a
Replace RType
Expr (GenLocated SrcSpanAnnA (HsExpr GhcPs) -> SrcSpan
forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
toSSA LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
x) [] String
x3] | String
inside String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
x3]
monadNoResult String
inside LHsExpr GhcPs -> LHsExpr GhcPs
wrap (LHsExpr GhcPs
-> ([LHsExpr GhcPs], [LHsExpr GhcPs] -> LHsExpr GhcPs)
replaceBranches -> ([LHsExpr GhcPs]
bs, [LHsExpr GhcPs] -> LHsExpr GhcPs
rewrap)) =
    (Idea -> Idea) -> [Idea] -> [Idea]
forall a b. (a -> b) -> [a] -> [b]
map (\Idea
x -> Idea
x{ideaNote :: [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
GenLocated SrcSpanAnnA (HsExpr GhcPs)
b | GenLocated SrcSpanAnnA (HsExpr GhcPs)
b <- [LHsExpr GhcPs]
[GenLocated SrcSpanAnnA (HsExpr GhcPs)]
bs]

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

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

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

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

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

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

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

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

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

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

    mkLet :: ExprLStmt GhcPs -> Maybe (ExprLStmt GhcPs, ExprLStmt GhcPs, Refactoring R.SrcSpan)
    mkLet :: ExprLStmt GhcPs
-> Maybe (ExprLStmt GhcPs, ExprLStmt GhcPs, Refactoring SrcSpan)
mkLet x :: ExprLStmt GhcPs
x@(L _ (BindStmt _ v@(view -> PVar_ p) (fromRet -> Just (_, y))))
      | String
p String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` GenLocated SrcSpanAnnA (HsExpr GhcPs) -> [String]
forall a. FreeVars a => a -> [String]
vars LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
y, String
p String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` String -> [String] -> [String]
forall a. Eq a => a -> [a] -> [a]
delete String
p [String]
vs
      = (GenLocated
   SrcSpanAnnA
   (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))),
 GenLocated
   SrcSpanAnnA
   (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))),
 Refactoring SrcSpan)
-> Maybe
     (GenLocated
        SrcSpanAnnA
        (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))),
      GenLocated
        SrcSpanAnnA
        (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))),
      Refactoring SrcSpan)
forall a. a -> Maybe a
Just (ExprLStmt GhcPs
GenLocated
  SrcSpanAnnA
  (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
x, String -> LHsExpr GhcPs -> ExprLStmt GhcPs
template String
p LHsExpr GhcPs
y, Refactoring SrcSpan
refact)
      where
        refact :: Refactoring SrcSpan
refact = RType
-> SrcSpan -> [(String, SrcSpan)] -> String -> Refactoring SrcSpan
forall a. RType -> a -> [(String, a)] -> String -> Refactoring a
Replace RType
Stmt (GenLocated
  SrcSpanAnnA
  (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> SrcSpan
forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
toSSA ExprLStmt GhcPs
GenLocated
  SrcSpanAnnA
  (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
x) [(String
"lhs", GenLocated SrcSpanAnnA (Pat GhcPs) -> SrcSpan
forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
toSSA LPat GhcPs
GenLocated SrcSpanAnnA (Pat GhcPs)
v), (String
"rhs", GenLocated SrcSpanAnnA (HsExpr GhcPs) -> SrcSpan
forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
toSSA LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
y)]
                      (GenLocated
  SrcSpanAnnA
  (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> String
forall a. Outputable a => a -> String
unsafePrettyPrint (GenLocated
   SrcSpanAnnA
   (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
 -> String)
-> GenLocated
     SrcSpanAnnA
     (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr 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 :: LocatedAn an RdrName
p = RdrName -> LocatedAn an RdrName
forall a an. a -> LocatedAn an a
noLocA (RdrName -> LocatedAn an RdrName)
-> RdrName -> LocatedAn an RdrName
forall a b. (a -> b) -> a -> b
$ OccName -> RdrName
mkRdrUnqual (String -> OccName
mkVarOcc String
lhs)
            grhs :: Located (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
grhs = GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> Located (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
forall e. e -> Located e
noLoc (XCGRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> [ExprLStmt GhcPs]
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall p body.
XCGRHS p body -> [GuardLStmt p] -> body -> GRHS p body
GRHS XCGRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall ann. EpAnn ann
EpAnnNotUsed [] LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
rhs)
            grhss :: GRHSs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
grhss = XCGRHSs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> [LGRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
-> HsLocalBinds GhcPs
-> GRHSs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall p body.
XCGRHSs p body -> [LGRHS p body] -> HsLocalBinds p -> GRHSs p body
GRHSs XCGRHSs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
EpAnnComments
emptyComments [LGRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
Located (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
grhs] (XEmptyLocalBinds GhcPs GhcPs -> HsLocalBinds GhcPs
forall idL idR. XEmptyLocalBinds idL idR -> HsLocalBindsLR idL idR
EmptyLocalBinds NoExtField
XEmptyLocalBinds GhcPs GhcPs
noExtField)
            match :: LocatedAn an (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
match = Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> LocatedAn
     an (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
forall a an. a -> LocatedAn an a
noLocA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
 -> LocatedAn
      an (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
-> Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> LocatedAn
     an (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
forall a b. (a -> b) -> a -> b
$ XCMatch GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> HsMatchContext (NoGhcTc GhcPs)
-> [LPat GhcPs]
-> GRHSs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall p body.
XCMatch p body
-> HsMatchContext (NoGhcTc p)
-> [LPat p]
-> GRHSs p body
-> Match p body
Match XCMatch GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall ann. EpAnn ann
EpAnnNotUsed (LIdP (NoGhcTc GhcPs)
-> LexicalFixity -> SrcStrictness -> HsMatchContext (NoGhcTc GhcPs)
forall p.
LIdP p -> LexicalFixity -> SrcStrictness -> HsMatchContext p
FunRhs LIdP (NoGhcTc GhcPs)
forall an. LocatedAn an RdrName
p LexicalFixity
Prefix SrcStrictness
NoSrcStrict) [] GRHSs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
grhss
            fb :: LocatedAn an (HsBindLR GhcPs GhcPs)
fb = HsBindLR GhcPs GhcPs -> LocatedAn an (HsBindLR GhcPs GhcPs)
forall a an. a -> LocatedAn an a
noLocA (HsBindLR GhcPs GhcPs -> LocatedAn an (HsBindLR GhcPs GhcPs))
-> HsBindLR GhcPs GhcPs -> LocatedAn an (HsBindLR GhcPs GhcPs)
forall a b. (a -> b) -> a -> b
$ XFunBind GhcPs GhcPs
-> LIdP GhcPs
-> MatchGroup GhcPs (LHsExpr GhcPs)
-> [CoreTickish]
-> HsBindLR GhcPs GhcPs
forall idL idR.
XFunBind idL idR
-> LIdP idL
-> MatchGroup idR (LHsExpr idR)
-> [CoreTickish]
-> HsBindLR idL idR
FunBind NoExtField
XFunBind GhcPs GhcPs
noExtField LIdP GhcPs
forall an. LocatedAn an RdrName
p (XMG GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> XRec
     GhcPs [LMatch GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
-> Origin
-> MatchGroup GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall p body.
XMG p body -> XRec p [LMatch p body] -> Origin -> MatchGroup p body
MG NoExtField
XMG GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
noExtField ([LocatedAn
   AnnListItem (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> LocatedAn
     AnnList
     [LocatedAn
        AnnListItem (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
forall a an. a -> LocatedAn an a
noLocA [LocatedAn
  AnnListItem (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
forall an.
LocatedAn an (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
match]) Origin
Generated) []
            binds :: Bag (LocatedAn an (HsBindLR GhcPs GhcPs))
binds = LocatedAn an (HsBindLR GhcPs GhcPs)
-> Bag (LocatedAn an (HsBindLR GhcPs GhcPs))
forall a. a -> Bag a
unitBag LocatedAn an (HsBindLR GhcPs GhcPs)
forall an. LocatedAn an (HsBindLR GhcPs GhcPs)
fb
            valBinds :: HsValBindsLR GhcPs GhcPs
valBinds = XValBinds GhcPs GhcPs
-> LHsBindsLR GhcPs GhcPs
-> [LSig GhcPs]
-> HsValBindsLR GhcPs GhcPs
forall idL idR.
XValBinds idL idR
-> LHsBindsLR idL idR -> [LSig idR] -> HsValBindsLR idL idR
ValBinds XValBinds GhcPs GhcPs
AnnSortKey
NoAnnSortKey LHsBindsLR GhcPs GhcPs
forall an. Bag (LocatedAn an (HsBindLR GhcPs GhcPs))
binds []
            localBinds :: HsLocalBinds GhcPs
localBinds = XHsValBinds GhcPs GhcPs
-> HsValBindsLR GhcPs GhcPs -> HsLocalBinds GhcPs
forall idL idR.
XHsValBinds idL idR
-> HsValBindsLR idL idR -> HsLocalBindsLR idL idR
HsValBinds XHsValBinds GhcPs GhcPs
forall ann. EpAnn ann
EpAnnNotUsed HsValBindsLR GhcPs GhcPs
valBinds
         in StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> GenLocated
     SrcSpanAnnA
     (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
forall a an. a -> LocatedAn an a
noLocA (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
 -> GenLocated
      SrcSpanAnnA
      (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
-> StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> GenLocated
     SrcSpanAnnA
     (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
forall a b. (a -> b) -> a -> b
$ XLetStmt GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> HsLocalBinds GhcPs
-> StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall idL idR body.
XLetStmt idL idR body
-> HsLocalBindsLR idL idR -> StmtLR idL idR body
LetStmt XLetStmt GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall ann. EpAnn ann
EpAnnNotUsed HsLocalBinds GhcPs
localBinds

fromApplies :: LHsExpr GhcPs -> ([LHsExpr GhcPs], LHsExpr GhcPs)
fromApplies :: LHsExpr GhcPs -> ([LHsExpr GhcPs], LHsExpr GhcPs)
fromApplies (L _ (HsApp _ f x)) = ([GenLocated SrcSpanAnnA (HsExpr GhcPs)]
 -> [GenLocated SrcSpanAnnA (HsExpr GhcPs)])
-> ([GenLocated SrcSpanAnnA (HsExpr GhcPs)],
    GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> ([GenLocated SrcSpanAnnA (HsExpr GhcPs)],
    GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall a a' b. (a -> a') -> (a, b) -> (a', b)
first (LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
fGenLocated SrcSpanAnnA (HsExpr GhcPs)
-> [GenLocated SrcSpanAnnA (HsExpr GhcPs)]
-> [GenLocated SrcSpanAnnA (HsExpr GhcPs)]
forall a. a -> [a] -> [a]
:) (([GenLocated SrcSpanAnnA (HsExpr GhcPs)],
  GenLocated SrcSpanAnnA (HsExpr GhcPs))
 -> ([GenLocated SrcSpanAnnA (HsExpr GhcPs)],
     GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> ([GenLocated SrcSpanAnnA (HsExpr GhcPs)],
    GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> ([GenLocated SrcSpanAnnA (HsExpr GhcPs)],
    GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall a b. (a -> b) -> a -> b
$ LHsExpr GhcPs -> ([LHsExpr GhcPs], LHsExpr GhcPs)
fromApplies (GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
fromParen LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
x)
fromApplies (L _ (OpApp _ f (isDol -> True) x)) = ([GenLocated SrcSpanAnnA (HsExpr GhcPs)]
 -> [GenLocated SrcSpanAnnA (HsExpr GhcPs)])
-> ([GenLocated SrcSpanAnnA (HsExpr GhcPs)],
    GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> ([GenLocated SrcSpanAnnA (HsExpr GhcPs)],
    GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall a a' b. (a -> a') -> (a, b) -> (a', b)
first (LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
fGenLocated SrcSpanAnnA (HsExpr GhcPs)
-> [GenLocated SrcSpanAnnA (HsExpr GhcPs)]
-> [GenLocated SrcSpanAnnA (HsExpr GhcPs)]
forall a. a -> [a] -> [a]
:) (([GenLocated SrcSpanAnnA (HsExpr GhcPs)],
  GenLocated SrcSpanAnnA (HsExpr GhcPs))
 -> ([GenLocated SrcSpanAnnA (HsExpr GhcPs)],
     GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> ([GenLocated SrcSpanAnnA (HsExpr GhcPs)],
    GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> ([GenLocated SrcSpanAnnA (HsExpr GhcPs)],
    GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall 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 _ (HsPar _ x)) = LHsExpr GhcPs -> Maybe (String, LHsExpr GhcPs)
fromRet LHsExpr GhcPs
x
fromRet (L _ (OpApp _ x (L _ (HsVar _ (L _ y))) z)) | RdrName -> String
occNameStr RdrName
y String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"$" = LHsExpr GhcPs -> Maybe (String, LHsExpr GhcPs)
fromRet (LHsExpr GhcPs -> Maybe (String, LHsExpr GhcPs))
-> LHsExpr GhcPs -> Maybe (String, LHsExpr GhcPs)
forall a b. (a -> b) -> a -> b
$ HsExpr GhcPs -> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall a an. a -> LocatedAn an a
noLocA (XApp GhcPs -> LHsExpr GhcPs -> LHsExpr GhcPs -> HsExpr GhcPs
forall p. XApp p -> LHsExpr p -> LHsExpr p -> HsExpr p
HsApp XApp GhcPs
forall ann. EpAnn ann
EpAnnNotUsed LHsExpr GhcPs
x LHsExpr GhcPs
z)
fromRet (L _ (HsApp _ x y)) | LHsExpr GhcPs -> Bool
isReturn LHsExpr GhcPs
x = (String, GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> Maybe (String, GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall a. a -> Maybe a
Just (GenLocated SrcSpanAnnA (HsExpr GhcPs) -> String
forall a. Outputable a => a -> String
unsafePrettyPrint LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
x, LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
y)
fromRet LHsExpr GhcPs
_ = Maybe (String, LHsExpr GhcPs)
forall a. Maybe a
Nothing