{-# LANGUAGE PatternGuards, ViewPatterns #-}
{-# LANGUAGE RecordWildCards #-}
module Hint.ListRec(listRecHint) where
import Hint.Type (DeclHint, Severity(Suggestion, Warning), idea, toSS)
import Data.Generics.Uniplate.DataOnly
import Data.List.Extra
import Data.Maybe
import Data.Either.Extra
import Control.Monad
import Refact.Types hiding (RType(Match))
import GHC.Types.SrcLoc
import GHC.Hs.Extension
import GHC.Hs.Pat
import GHC.Builtin.Types
import GHC.Hs.Type
import GHC.Types.Name.Reader
import GHC.Hs.Binds
import GHC.Hs.Expr
import GHC.Hs.Decls
import GHC.Types.Basic
import GHC.Util
import Language.Haskell.GhclibParserEx.GHC.Hs.Pat
import Language.Haskell.GhclibParserEx.GHC.Hs.Expr
import Language.Haskell.GhclibParserEx.GHC.Hs.ExtendInstances
import Language.Haskell.GhclibParserEx.GHC.Utils.Outputable
import Language.Haskell.GhclibParserEx.GHC.Types.Name.Reader
listRecHint :: DeclHint
listRecHint :: DeclHint
listRecHint Scope
_ ModuleEx
_ = (LHsDecl (GhcPass 'Parsed) -> [Idea])
-> [LHsDecl (GhcPass 'Parsed)] -> [Idea]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap LHsDecl (GhcPass 'Parsed) -> [Idea]
f ([LHsDecl (GhcPass 'Parsed)] -> [Idea])
-> (LHsDecl (GhcPass 'Parsed) -> [LHsDecl (GhcPass 'Parsed)])
-> LHsDecl (GhcPass 'Parsed)
-> [Idea]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LHsDecl (GhcPass 'Parsed) -> [LHsDecl (GhcPass 'Parsed)]
forall on. Uniplate on => on -> [on]
universe
where
f :: LHsDecl (GhcPass 'Parsed) -> [Idea]
f LHsDecl (GhcPass 'Parsed)
o = Maybe Idea -> [Idea]
forall a. Maybe a -> [a]
maybeToList (Maybe Idea -> [Idea]) -> Maybe Idea -> [Idea]
forall a b. (a -> b) -> a -> b
$ do
let x :: LHsDecl (GhcPass 'Parsed)
x = LHsDecl (GhcPass 'Parsed)
o
(ListCase
x, LHsExpr (GhcPass 'Parsed) -> LHsDecl (GhcPass 'Parsed)
addCase) <- LHsDecl (GhcPass 'Parsed)
-> Maybe
(ListCase, LHsExpr (GhcPass 'Parsed) -> LHsDecl (GhcPass 'Parsed))
findCase LHsDecl (GhcPass 'Parsed)
x
(String
use,Severity
severity,LHsExpr (GhcPass 'Parsed)
x) <- ListCase -> Maybe (String, Severity, LHsExpr (GhcPass 'Parsed))
matchListRec ListCase
x
let y :: LHsDecl (GhcPass 'Parsed)
y = LHsExpr (GhcPass 'Parsed) -> LHsDecl (GhcPass 'Parsed)
addCase LHsExpr (GhcPass 'Parsed)
x
Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ String
recursiveStr String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` LHsDecl (GhcPass 'Parsed) -> [String]
forall a. AllVars a => a -> [String]
varss LHsDecl (GhcPass 'Parsed)
y
Idea -> Maybe Idea
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Idea -> Maybe Idea) -> Idea -> Maybe Idea
forall a b. (a -> b) -> a -> b
$ Severity
-> String
-> LHsDecl (GhcPass 'Parsed)
-> LHsDecl (GhcPass 'Parsed)
-> [Refactoring SrcSpan]
-> Idea
forall a b.
(Outputable a, Outputable b) =>
Severity
-> String
-> Located a
-> Located b
-> [Refactoring SrcSpan]
-> Idea
idea Severity
severity (String
"Use " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
use) LHsDecl (GhcPass 'Parsed)
o LHsDecl (GhcPass 'Parsed)
y [RType
-> SrcSpan -> [(String, SrcSpan)] -> String -> Refactoring SrcSpan
forall a. RType -> a -> [(String, a)] -> String -> Refactoring a
Replace RType
Decl (LHsDecl (GhcPass 'Parsed) -> SrcSpan
forall a. Located a -> SrcSpan
toSS LHsDecl (GhcPass 'Parsed)
o) [] (LHsDecl (GhcPass 'Parsed) -> String
forall a. Outputable a => a -> String
unsafePrettyPrint LHsDecl (GhcPass 'Parsed)
y)]
recursiveStr :: String
recursiveStr :: String
recursiveStr = String
"_recursive_"
recursive :: LHsExpr (GhcPass 'Parsed)
recursive = String -> LHsExpr (GhcPass 'Parsed)
strToVar String
recursiveStr
data ListCase =
ListCase
[String]
(LHsExpr GhcPs)
(String, String, LHsExpr GhcPs)
data BList = BNil | BCons String String
deriving (BList -> BList -> Bool
(BList -> BList -> Bool) -> (BList -> BList -> Bool) -> Eq BList
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BList -> BList -> Bool
$c/= :: BList -> BList -> Bool
== :: BList -> BList -> Bool
$c== :: BList -> BList -> Bool
Eq, Eq BList
Eq BList
-> (BList -> BList -> Ordering)
-> (BList -> BList -> Bool)
-> (BList -> BList -> Bool)
-> (BList -> BList -> Bool)
-> (BList -> BList -> Bool)
-> (BList -> BList -> BList)
-> (BList -> BList -> BList)
-> Ord BList
BList -> BList -> Bool
BList -> BList -> Ordering
BList -> BList -> BList
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: BList -> BList -> BList
$cmin :: BList -> BList -> BList
max :: BList -> BList -> BList
$cmax :: BList -> BList -> BList
>= :: BList -> BList -> Bool
$c>= :: BList -> BList -> Bool
> :: BList -> BList -> Bool
$c> :: BList -> BList -> Bool
<= :: BList -> BList -> Bool
$c<= :: BList -> BList -> Bool
< :: BList -> BList -> Bool
$c< :: BList -> BList -> Bool
compare :: BList -> BList -> Ordering
$ccompare :: BList -> BList -> Ordering
Ord, Int -> BList -> String -> String
[BList] -> String -> String
BList -> String
(Int -> BList -> String -> String)
-> (BList -> String) -> ([BList] -> String -> String) -> Show BList
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [BList] -> String -> String
$cshowList :: [BList] -> String -> String
show :: BList -> String
$cshow :: BList -> String
showsPrec :: Int -> BList -> String -> String
$cshowsPrec :: Int -> BList -> String -> String
Show)
data Branch =
Branch
String
[String]
Int
BList (LHsExpr GhcPs)
matchListRec :: ListCase -> Maybe (String, Severity, LHsExpr GhcPs)
matchListRec :: ListCase -> Maybe (String, Severity, LHsExpr (GhcPass 'Parsed))
matchListRec o :: ListCase
o@(ListCase [String]
vs LHsExpr (GhcPass 'Parsed)
nil (String
x, String
xs, LHsExpr (GhcPass 'Parsed)
cons))
| [] <- [String]
vs, LHsExpr (GhcPass 'Parsed) -> String
varToStr LHsExpr (GhcPass 'Parsed)
nil String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"[]", (L SrcSpan
_ (OpApp XOpApp (GhcPass 'Parsed)
_ LHsExpr (GhcPass 'Parsed)
lhs LHsExpr (GhcPass 'Parsed)
c LHsExpr (GhcPass 'Parsed)
rhs)) <- LHsExpr (GhcPass 'Parsed)
cons, LHsExpr (GhcPass 'Parsed) -> String
varToStr LHsExpr (GhcPass 'Parsed)
c String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
":"
, LHsExpr (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed) -> Bool
forall a. Data a => a -> a -> Bool
astEq (LHsExpr (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
fromParen LHsExpr (GhcPass 'Parsed)
rhs) LHsExpr (GhcPass 'Parsed)
recursive, String
xs String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` LHsExpr (GhcPass 'Parsed) -> [String]
forall a. FreeVars a => a -> [String]
vars LHsExpr (GhcPass 'Parsed)
lhs
= (String, Severity, LHsExpr (GhcPass 'Parsed))
-> Maybe (String, Severity, LHsExpr (GhcPass 'Parsed))
forall a. a -> Maybe a
Just ((String, Severity, LHsExpr (GhcPass 'Parsed))
-> Maybe (String, Severity, LHsExpr (GhcPass 'Parsed)))
-> (String, Severity, LHsExpr (GhcPass 'Parsed))
-> Maybe (String, Severity, LHsExpr (GhcPass 'Parsed))
forall a b. (a -> b) -> a -> b
$ (,,) String
"map" Severity
Hint.Type.Warning (LHsExpr (GhcPass 'Parsed)
-> (String, Severity, LHsExpr (GhcPass 'Parsed)))
-> LHsExpr (GhcPass 'Parsed)
-> (String, Severity, LHsExpr (GhcPass 'Parsed))
forall a b. (a -> b) -> a -> b
$
[LHsExpr (GhcPass 'Parsed)] -> LHsExpr (GhcPass 'Parsed)
appsBracket [ String -> LHsExpr (GhcPass 'Parsed)
strToVar String
"map", [String] -> LHsExpr (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
niceLambda [String
x] LHsExpr (GhcPass 'Parsed)
lhs, String -> LHsExpr (GhcPass 'Parsed)
strToVar String
xs]
| [] <- [String]
vs, App2 LHsExpr (GhcPass 'Parsed)
op LHsExpr (GhcPass 'Parsed)
lhs LHsExpr (GhcPass 'Parsed)
rhs <- LHsExpr (GhcPass 'Parsed) -> App2
forall a b. View a b => a -> b
view LHsExpr (GhcPass 'Parsed)
cons
, String
xs String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` (LHsExpr (GhcPass 'Parsed) -> [String]
forall a. FreeVars a => a -> [String]
vars LHsExpr (GhcPass 'Parsed)
op [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ LHsExpr (GhcPass 'Parsed) -> [String]
forall a. FreeVars a => a -> [String]
vars LHsExpr (GhcPass 'Parsed)
lhs)
, LHsExpr (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed) -> Bool
forall a. Data a => a -> a -> Bool
astEq (LHsExpr (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
fromParen LHsExpr (GhcPass 'Parsed)
rhs) LHsExpr (GhcPass 'Parsed)
recursive
= (String, Severity, LHsExpr (GhcPass 'Parsed))
-> Maybe (String, Severity, LHsExpr (GhcPass 'Parsed))
forall a. a -> Maybe a
Just ((String, Severity, LHsExpr (GhcPass 'Parsed))
-> Maybe (String, Severity, LHsExpr (GhcPass 'Parsed)))
-> (String, Severity, LHsExpr (GhcPass 'Parsed))
-> Maybe (String, Severity, LHsExpr (GhcPass 'Parsed))
forall a b. (a -> b) -> a -> b
$ (,,) String
"foldr" Severity
Suggestion (LHsExpr (GhcPass 'Parsed)
-> (String, Severity, LHsExpr (GhcPass 'Parsed)))
-> LHsExpr (GhcPass 'Parsed)
-> (String, Severity, LHsExpr (GhcPass 'Parsed))
forall a b. (a -> b) -> a -> b
$
[LHsExpr (GhcPass 'Parsed)] -> LHsExpr (GhcPass 'Parsed)
appsBracket [ String -> LHsExpr (GhcPass 'Parsed)
strToVar String
"foldr", [String] -> LHsExpr (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
niceLambda [String
x] (LHsExpr (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed))
-> LHsExpr (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
forall a b. (a -> b) -> a -> b
$ [LHsExpr (GhcPass 'Parsed)] -> LHsExpr (GhcPass 'Parsed)
appsBracket [LHsExpr (GhcPass 'Parsed)
op,LHsExpr (GhcPass 'Parsed)
lhs], LHsExpr (GhcPass 'Parsed)
nil, String -> LHsExpr (GhcPass 'Parsed)
strToVar String
xs]
| [String
v] <- [String]
vs, LHsExpr (GhcPass 'Parsed) -> Var_
forall a b. View a b => a -> b
view LHsExpr (GhcPass 'Parsed)
nil Var_ -> Var_ -> Bool
forall a. Eq a => a -> a -> Bool
== String -> Var_
Var_ String
v, (L SrcSpan
_ (HsApp XApp (GhcPass 'Parsed)
_ LHsExpr (GhcPass 'Parsed)
r LHsExpr (GhcPass 'Parsed)
lhs)) <- LHsExpr (GhcPass 'Parsed)
cons
, LHsExpr (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed) -> Bool
forall a. Data a => a -> a -> Bool
astEq (LHsExpr (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
fromParen LHsExpr (GhcPass 'Parsed)
r) LHsExpr (GhcPass 'Parsed)
recursive
, String
xs String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` LHsExpr (GhcPass 'Parsed) -> [String]
forall a. FreeVars a => a -> [String]
vars LHsExpr (GhcPass 'Parsed)
lhs
= (String, Severity, LHsExpr (GhcPass 'Parsed))
-> Maybe (String, Severity, LHsExpr (GhcPass 'Parsed))
forall a. a -> Maybe a
Just ((String, Severity, LHsExpr (GhcPass 'Parsed))
-> Maybe (String, Severity, LHsExpr (GhcPass 'Parsed)))
-> (String, Severity, LHsExpr (GhcPass 'Parsed))
-> Maybe (String, Severity, LHsExpr (GhcPass 'Parsed))
forall a b. (a -> b) -> a -> b
$ (,,) String
"foldl" Severity
Suggestion (LHsExpr (GhcPass 'Parsed)
-> (String, Severity, LHsExpr (GhcPass 'Parsed)))
-> LHsExpr (GhcPass 'Parsed)
-> (String, Severity, LHsExpr (GhcPass 'Parsed))
forall a b. (a -> b) -> a -> b
$
[LHsExpr (GhcPass 'Parsed)] -> LHsExpr (GhcPass 'Parsed)
appsBracket [ String -> LHsExpr (GhcPass 'Parsed)
strToVar String
"foldl", [String] -> LHsExpr (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
niceLambda [String
v,String
x] LHsExpr (GhcPass 'Parsed)
lhs, String -> LHsExpr (GhcPass 'Parsed)
strToVar String
v, String -> LHsExpr (GhcPass 'Parsed)
strToVar String
xs]
| [String
v] <- [String]
vs, (L SrcSpan
_ (HsApp XApp (GhcPass 'Parsed)
_ LHsExpr (GhcPass 'Parsed)
ret LHsExpr (GhcPass 'Parsed)
res)) <- LHsExpr (GhcPass 'Parsed)
nil, LHsExpr (GhcPass 'Parsed) -> Bool
isReturn LHsExpr (GhcPass 'Parsed)
ret, LHsExpr (GhcPass 'Parsed) -> String
varToStr LHsExpr (GhcPass 'Parsed)
res String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"()" Bool -> Bool -> Bool
|| LHsExpr (GhcPass 'Parsed) -> Var_
forall a b. View a b => a -> b
view LHsExpr (GhcPass 'Parsed)
res Var_ -> Var_ -> Bool
forall a. Eq a => a -> a -> Bool
== String -> Var_
Var_ String
v
, [L SrcSpan
_ (BindStmt XBindStmt
(GhcPass 'Parsed) (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
_ (LPat (GhcPass 'Parsed) -> PVar_
forall a b. View a b => a -> b
view -> PVar_ String
b1) LHsExpr (GhcPass 'Parsed)
e), L SrcSpan
_ (BodyStmt XBodyStmt
(GhcPass 'Parsed) (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
_ (LHsExpr (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
fromParen -> (L SrcSpan
_ (HsApp XApp (GhcPass 'Parsed)
_ LHsExpr (GhcPass 'Parsed)
r (LHsExpr (GhcPass 'Parsed) -> Var_
forall a b. View a b => a -> b
view -> Var_ String
b2)))) SyntaxExpr (GhcPass 'Parsed)
_ SyntaxExpr (GhcPass 'Parsed)
_)] <- LHsExpr (GhcPass 'Parsed)
-> [LStmt (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))]
asDo LHsExpr (GhcPass 'Parsed)
cons
, String
b1 String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
b2, LHsExpr (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed) -> Bool
forall a. Data a => a -> a -> Bool
astEq LHsExpr (GhcPass 'Parsed)
r LHsExpr (GhcPass 'Parsed)
recursive, String
xs String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` LHsExpr (GhcPass 'Parsed) -> [String]
forall a. FreeVars a => a -> [String]
vars LHsExpr (GhcPass 'Parsed)
e
, String
name <- String
"foldM" String -> String -> String
forall a. [a] -> [a] -> [a]
++ [Char
'_' | LHsExpr (GhcPass 'Parsed) -> String
varToStr LHsExpr (GhcPass 'Parsed)
res String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"()"]
= (String, Severity, LHsExpr (GhcPass 'Parsed))
-> Maybe (String, Severity, LHsExpr (GhcPass 'Parsed))
forall a. a -> Maybe a
Just ((String, Severity, LHsExpr (GhcPass 'Parsed))
-> Maybe (String, Severity, LHsExpr (GhcPass 'Parsed)))
-> (String, Severity, LHsExpr (GhcPass 'Parsed))
-> Maybe (String, Severity, LHsExpr (GhcPass 'Parsed))
forall a b. (a -> b) -> a -> b
$ (,,) String
name Severity
Suggestion (LHsExpr (GhcPass 'Parsed)
-> (String, Severity, LHsExpr (GhcPass 'Parsed)))
-> LHsExpr (GhcPass 'Parsed)
-> (String, Severity, LHsExpr (GhcPass 'Parsed))
forall a b. (a -> b) -> a -> b
$
[LHsExpr (GhcPass 'Parsed)] -> LHsExpr (GhcPass 'Parsed)
appsBracket [String -> LHsExpr (GhcPass 'Parsed)
strToVar String
name, [String] -> LHsExpr (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
niceLambda [String
v,String
x] LHsExpr (GhcPass 'Parsed)
e, String -> LHsExpr (GhcPass 'Parsed)
strToVar String
v, String -> LHsExpr (GhcPass 'Parsed)
strToVar String
xs]
| Bool
otherwise = Maybe (String, Severity, LHsExpr (GhcPass 'Parsed))
forall a. Maybe a
Nothing
asDo :: LHsExpr GhcPs -> [LStmt GhcPs (LHsExpr GhcPs)]
asDo :: LHsExpr (GhcPass 'Parsed)
-> [LStmt (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))]
asDo (LHsExpr (GhcPass 'Parsed) -> App2
forall a b. View a b => a -> b
view ->
App2 LHsExpr (GhcPass 'Parsed)
bind LHsExpr (GhcPass 'Parsed)
lhs
(L SrcSpan
_ (HsLam XLam (GhcPass 'Parsed)
_ MG {
mg_origin :: forall p body. MatchGroup p body -> Origin
mg_origin=Origin
FromSource
, mg_alts :: forall p body. MatchGroup p body -> Located [LMatch p body]
mg_alts=L SrcSpan
_ [
L SrcSpan
_ Match { m_ctxt :: forall p body. Match p body -> HsMatchContext (NoGhcTc p)
m_ctxt=HsMatchContext (NoGhcTc (GhcPass 'Parsed))
LambdaExpr
, m_pats :: forall p body. Match p body -> [LPat p]
m_pats=[v :: LPat (GhcPass 'Parsed)
v@(L SrcSpan
_ VarPat{})]
, m_grhss :: forall p body. Match p body -> GRHSs p body
m_grhss=GRHSs XCGRHSs (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
_
[L SrcSpan
_ (GRHS XCGRHS (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
_ [] LHsExpr (GhcPass 'Parsed)
rhs)]
(L SrcSpan
_ (EmptyLocalBinds XEmptyLocalBinds (GhcPass 'Parsed) (GhcPass 'Parsed)
_))}]}))
) =
[ StmtLR
(GhcPass 'Parsed) (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
-> LStmt (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
forall e. e -> Located e
noLoc (StmtLR
(GhcPass 'Parsed) (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
-> LStmt (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed)))
-> StmtLR
(GhcPass 'Parsed) (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
-> LStmt (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
forall a b. (a -> b) -> a -> b
$ XBindStmt
(GhcPass 'Parsed) (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
-> LPat (GhcPass 'Parsed)
-> LHsExpr (GhcPass 'Parsed)
-> StmtLR
(GhcPass 'Parsed) (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
forall idL idR body.
XBindStmt idL idR body -> LPat idL -> body -> StmtLR idL idR body
BindStmt XBindStmt
(GhcPass 'Parsed) (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
NoExtField
noExtField LPat (GhcPass 'Parsed)
v LHsExpr (GhcPass 'Parsed)
lhs
, StmtLR
(GhcPass 'Parsed) (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
-> LStmt (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
forall e. e -> Located e
noLoc (StmtLR
(GhcPass 'Parsed) (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
-> LStmt (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed)))
-> StmtLR
(GhcPass 'Parsed) (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
-> LStmt (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
forall a b. (a -> b) -> a -> b
$ XBodyStmt
(GhcPass 'Parsed) (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
-> LHsExpr (GhcPass 'Parsed)
-> SyntaxExpr (GhcPass 'Parsed)
-> SyntaxExpr (GhcPass 'Parsed)
-> StmtLR
(GhcPass 'Parsed) (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
forall idL idR body.
XBodyStmt idL idR body
-> body -> SyntaxExpr idR -> SyntaxExpr idR -> StmtLR idL idR body
BodyStmt XBodyStmt
(GhcPass 'Parsed) (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
NoExtField
noExtField LHsExpr (GhcPass 'Parsed)
rhs SyntaxExpr (GhcPass 'Parsed)
forall (p :: Pass). IsPass p => SyntaxExpr (GhcPass p)
noSyntaxExpr SyntaxExpr (GhcPass 'Parsed)
forall (p :: Pass). IsPass p => SyntaxExpr (GhcPass p)
noSyntaxExpr ]
asDo (L SrcSpan
_ (HsDo XDo (GhcPass 'Parsed)
_ (DoExpr Maybe ModuleName
_) (L SrcSpan
_ [LStmt (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))]
stmts))) = [LStmt (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))]
stmts
asDo LHsExpr (GhcPass 'Parsed)
x = [StmtLR
(GhcPass 'Parsed) (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
-> LStmt (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
forall e. e -> Located e
noLoc (StmtLR
(GhcPass 'Parsed) (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
-> LStmt (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed)))
-> StmtLR
(GhcPass 'Parsed) (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
-> LStmt (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
forall a b. (a -> b) -> a -> b
$ XBodyStmt
(GhcPass 'Parsed) (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
-> LHsExpr (GhcPass 'Parsed)
-> SyntaxExpr (GhcPass 'Parsed)
-> SyntaxExpr (GhcPass 'Parsed)
-> StmtLR
(GhcPass 'Parsed) (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
forall idL idR body.
XBodyStmt idL idR body
-> body -> SyntaxExpr idR -> SyntaxExpr idR -> StmtLR idL idR body
BodyStmt XBodyStmt
(GhcPass 'Parsed) (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
NoExtField
noExtField LHsExpr (GhcPass 'Parsed)
x SyntaxExpr (GhcPass 'Parsed)
forall (p :: Pass). IsPass p => SyntaxExpr (GhcPass p)
noSyntaxExpr SyntaxExpr (GhcPass 'Parsed)
forall (p :: Pass). IsPass p => SyntaxExpr (GhcPass p)
noSyntaxExpr]
findCase :: LHsDecl GhcPs -> Maybe (ListCase, LHsExpr GhcPs -> LHsDecl GhcPs)
findCase :: LHsDecl (GhcPass 'Parsed)
-> Maybe
(ListCase, LHsExpr (GhcPass 'Parsed) -> LHsDecl (GhcPass 'Parsed))
findCase LHsDecl (GhcPass 'Parsed)
x = do
(L SrcSpan
_ (ValD XValD (GhcPass 'Parsed)
_ FunBind {fun_matches :: forall idL idR. HsBindLR idL idR -> MatchGroup idR (LHsExpr idR)
fun_matches=
MG{mg_origin :: forall p body. MatchGroup p body -> Origin
mg_origin=Origin
FromSource, mg_alts :: forall p body. MatchGroup p body -> Located [LMatch p body]
mg_alts=
(L SrcSpan
_
[ x1 :: LMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
x1@(L SrcSpan
_ Match{[LPat (GhcPass 'Parsed)]
HsMatchContext (NoGhcTc (GhcPass 'Parsed))
GRHSs (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
XCMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
m_ext :: forall p body. Match p body -> XCMatch p body
m_grhss :: GRHSs (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
m_pats :: [LPat (GhcPass 'Parsed)]
m_ctxt :: HsMatchContext (NoGhcTc (GhcPass 'Parsed))
m_ext :: XCMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
m_grhss :: forall p body. Match p body -> GRHSs p body
m_pats :: forall p body. Match p body -> [LPat p]
m_ctxt :: forall p body. Match p body -> HsMatchContext (NoGhcTc p)
..})
, LMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
x2]), XMG (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
mg_ext :: forall p body. MatchGroup p body -> XMG p body
mg_ext :: XMG (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
..}
, [Tickish Id]
XFunBind (GhcPass 'Parsed) (GhcPass 'Parsed)
Located (IdP (GhcPass 'Parsed))
fun_ext :: forall idL idR. HsBindLR idL idR -> XFunBind idL idR
fun_id :: forall idL idR. HsBindLR idL idR -> Located (IdP idL)
fun_tick :: forall idL idR. HsBindLR idL idR -> [Tickish Id]
fun_tick :: [Tickish Id]
fun_id :: Located (IdP (GhcPass 'Parsed))
fun_ext :: XFunBind (GhcPass 'Parsed) (GhcPass 'Parsed)
..}
)) <- LHsDecl (GhcPass 'Parsed) -> Maybe (LHsDecl (GhcPass 'Parsed))
forall (f :: * -> *) a. Applicative f => a -> f a
pure LHsDecl (GhcPass 'Parsed)
x
Branch String
name1 [String]
ps1 Int
p1 BList
c1 LHsExpr (GhcPass 'Parsed)
b1 <- LMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
-> Maybe Branch
findBranch LMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
x1
Branch String
name2 [String]
ps2 Int
p2 BList
c2 LHsExpr (GhcPass 'Parsed)
b2 <- LMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
-> Maybe Branch
findBranch LMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
x2
Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (String
name1 String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
name2 Bool -> Bool -> Bool
&& [String]
ps1 [String] -> [String] -> Bool
forall a. Eq a => a -> a -> Bool
== [String]
ps2 Bool -> Bool -> Bool
&& Int
p1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
p2)
[(BList
BNil, LHsExpr (GhcPass 'Parsed)
b1), (BCons String
x String
xs, LHsExpr (GhcPass 'Parsed)
b2)] <- [(BList, LHsExpr (GhcPass 'Parsed))]
-> Maybe [(BList, LHsExpr (GhcPass 'Parsed))]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([(BList, LHsExpr (GhcPass 'Parsed))]
-> Maybe [(BList, LHsExpr (GhcPass 'Parsed))])
-> [(BList, LHsExpr (GhcPass 'Parsed))]
-> Maybe [(BList, LHsExpr (GhcPass 'Parsed))]
forall a b. (a -> b) -> a -> b
$ ((BList, LHsExpr (GhcPass 'Parsed)) -> BList)
-> [(BList, LHsExpr (GhcPass 'Parsed))]
-> [(BList, LHsExpr (GhcPass 'Parsed))]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (BList, LHsExpr (GhcPass 'Parsed)) -> BList
forall a b. (a, b) -> a
fst [(BList
c1, LHsExpr (GhcPass 'Parsed)
b1), (BList
c2, LHsExpr (GhcPass 'Parsed)
b2)]
LHsExpr (GhcPass 'Parsed)
b2 <- (LHsExpr (GhcPass 'Parsed) -> Maybe (LHsExpr (GhcPass 'Parsed)))
-> LHsExpr (GhcPass 'Parsed) -> Maybe (LHsExpr (GhcPass 'Parsed))
forall (m :: * -> *).
Monad m =>
(LHsExpr (GhcPass 'Parsed) -> m (LHsExpr (GhcPass 'Parsed)))
-> LHsExpr (GhcPass 'Parsed) -> m (LHsExpr (GhcPass 'Parsed))
transformAppsM (String
-> Int
-> String
-> LHsExpr (GhcPass 'Parsed)
-> Maybe (LHsExpr (GhcPass 'Parsed))
delCons String
name1 Int
p1 String
xs) LHsExpr (GhcPass 'Parsed)
b2
([String]
ps, LHsExpr (GhcPass 'Parsed)
b2) <- ([String], LHsExpr (GhcPass 'Parsed))
-> Maybe ([String], LHsExpr (GhcPass 'Parsed))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (([String], LHsExpr (GhcPass 'Parsed))
-> Maybe ([String], LHsExpr (GhcPass 'Parsed)))
-> ([String], LHsExpr (GhcPass 'Parsed))
-> Maybe ([String], LHsExpr (GhcPass 'Parsed))
forall a b. (a -> b) -> a -> b
$ [String]
-> LHsExpr (GhcPass 'Parsed)
-> ([String], LHsExpr (GhcPass 'Parsed))
eliminateArgs [String]
ps1 LHsExpr (GhcPass 'Parsed)
b2
let ps12 :: [Located (Pat (GhcPass 'Parsed))]
ps12 = let ([String]
a, [String]
b) = Int -> [String] -> ([String], [String])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
p1 [String]
ps1 in (String -> Located (Pat (GhcPass 'Parsed)))
-> [String] -> [Located (Pat (GhcPass 'Parsed))]
forall a b. (a -> b) -> [a] -> [b]
map String -> LPat (GhcPass 'Parsed)
String -> Located (Pat (GhcPass 'Parsed))
strToPat ([String]
a [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ String
xs String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
b)
emptyLocalBinds :: GenLocated SrcSpan (HsLocalBinds (GhcPass 'Parsed))
emptyLocalBinds = HsLocalBinds (GhcPass 'Parsed)
-> GenLocated SrcSpan (HsLocalBinds (GhcPass 'Parsed))
forall e. e -> Located e
noLoc (HsLocalBinds (GhcPass 'Parsed)
-> GenLocated SrcSpan (HsLocalBinds (GhcPass 'Parsed)))
-> HsLocalBinds (GhcPass 'Parsed)
-> GenLocated SrcSpan (HsLocalBinds (GhcPass 'Parsed))
forall a b. (a -> b) -> a -> b
$ XEmptyLocalBinds (GhcPass 'Parsed) (GhcPass 'Parsed)
-> HsLocalBinds (GhcPass 'Parsed)
forall idL idR. XEmptyLocalBinds idL idR -> HsLocalBindsLR idL idR
EmptyLocalBinds XEmptyLocalBinds (GhcPass 'Parsed) (GhcPass 'Parsed)
NoExtField
noExtField
gRHS :: LHsExpr (GhcPass 'Parsed)
-> LGRHS (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
gRHS LHsExpr (GhcPass 'Parsed)
e = GRHS (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
-> LGRHS (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
forall e. e -> Located e
noLoc (GRHS (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
-> LGRHS (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed)))
-> GRHS (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
-> LGRHS (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
forall a b. (a -> b) -> a -> b
$ XCGRHS (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
-> [LStmt (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))]
-> LHsExpr (GhcPass 'Parsed)
-> GRHS (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
forall p body.
XCGRHS p body -> [GuardLStmt p] -> body -> GRHS p body
GRHS XCGRHS (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
NoExtField
noExtField [] LHsExpr (GhcPass 'Parsed)
e :: LGRHS GhcPs (LHsExpr GhcPs)
gRHSSs :: LHsExpr (GhcPass 'Parsed)
-> GRHSs (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
gRHSSs LHsExpr (GhcPass 'Parsed)
e = XCGRHSs (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
-> [LGRHS (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))]
-> GenLocated SrcSpan (HsLocalBinds (GhcPass 'Parsed))
-> GRHSs (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
forall p body.
XCGRHSs p body -> [LGRHS p body] -> LHsLocalBinds p -> GRHSs p body
GRHSs XCGRHSs (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
NoExtField
noExtField [LHsExpr (GhcPass 'Parsed)
-> LGRHS (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
gRHS LHsExpr (GhcPass 'Parsed)
e] GenLocated SrcSpan (HsLocalBinds (GhcPass 'Parsed))
emptyLocalBinds
match :: LHsExpr (GhcPass 'Parsed)
-> Match (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
match LHsExpr (GhcPass 'Parsed)
e = Match :: forall p body.
XCMatch p body
-> HsMatchContext (NoGhcTc p)
-> [LPat p]
-> GRHSs p body
-> Match p body
Match{m_ext :: XCMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
m_ext=XCMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
NoExtField
noExtField,m_pats :: [LPat (GhcPass 'Parsed)]
m_pats=[LPat (GhcPass 'Parsed)]
[Located (Pat (GhcPass 'Parsed))]
ps12, m_grhss :: GRHSs (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
m_grhss=LHsExpr (GhcPass 'Parsed)
-> GRHSs (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
gRHSSs LHsExpr (GhcPass 'Parsed)
e, HsMatchContext (NoGhcTc (GhcPass 'Parsed))
m_ctxt :: HsMatchContext (NoGhcTc (GhcPass 'Parsed))
m_ctxt :: HsMatchContext (NoGhcTc (GhcPass 'Parsed))
..}
matchGroup :: LHsExpr (GhcPass 'Parsed)
-> MatchGroup (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
matchGroup LHsExpr (GhcPass 'Parsed)
e = MG :: forall p body.
XMG p body
-> Located [LMatch p body] -> Origin -> MatchGroup p body
MG{mg_alts :: GenLocated
SrcSpan [LMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))]
mg_alts=[LMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))]
-> GenLocated
SrcSpan [LMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))]
forall e. e -> Located e
noLoc [Match (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
-> LMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
forall e. e -> Located e
noLoc (Match (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
-> LMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed)))
-> Match (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
-> LMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
forall a b. (a -> b) -> a -> b
$ LHsExpr (GhcPass 'Parsed)
-> Match (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
match LHsExpr (GhcPass 'Parsed)
e], mg_origin :: Origin
mg_origin=Origin
Generated, XMG (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
mg_ext :: XMG (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
mg_ext :: XMG (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
..}
funBind :: LHsExpr (GhcPass 'Parsed)
-> HsBindLR (GhcPass 'Parsed) (GhcPass 'Parsed)
funBind LHsExpr (GhcPass 'Parsed)
e = FunBind :: forall idL idR.
XFunBind idL idR
-> Located (IdP idL)
-> MatchGroup idR (LHsExpr idR)
-> [Tickish Id]
-> HsBindLR idL idR
FunBind {fun_matches :: MatchGroup (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
fun_matches=LHsExpr (GhcPass 'Parsed)
-> MatchGroup (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
matchGroup LHsExpr (GhcPass 'Parsed)
e, [Tickish Id]
XFunBind (GhcPass 'Parsed) (GhcPass 'Parsed)
Located (IdP (GhcPass 'Parsed))
fun_ext :: XFunBind (GhcPass 'Parsed) (GhcPass 'Parsed)
fun_id :: Located (IdP (GhcPass 'Parsed))
fun_tick :: [Tickish Id]
fun_tick :: [Tickish Id]
fun_id :: Located (IdP (GhcPass 'Parsed))
fun_ext :: XFunBind (GhcPass 'Parsed) (GhcPass 'Parsed)
..} :: HsBindLR GhcPs GhcPs
(ListCase, LHsExpr (GhcPass 'Parsed) -> LHsDecl (GhcPass 'Parsed))
-> Maybe
(ListCase, LHsExpr (GhcPass 'Parsed) -> LHsDecl (GhcPass 'Parsed))
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([String]
-> LHsExpr (GhcPass 'Parsed)
-> (String, String, LHsExpr (GhcPass 'Parsed))
-> ListCase
ListCase [String]
ps LHsExpr (GhcPass 'Parsed)
b1 (String
x, String
xs, LHsExpr (GhcPass 'Parsed)
b2), HsDecl (GhcPass 'Parsed) -> LHsDecl (GhcPass 'Parsed)
forall e. e -> Located e
noLoc (HsDecl (GhcPass 'Parsed) -> LHsDecl (GhcPass 'Parsed))
-> (LHsExpr (GhcPass 'Parsed) -> HsDecl (GhcPass 'Parsed))
-> LHsExpr (GhcPass 'Parsed)
-> LHsDecl (GhcPass 'Parsed)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XValD (GhcPass 'Parsed)
-> HsBindLR (GhcPass 'Parsed) (GhcPass 'Parsed)
-> HsDecl (GhcPass 'Parsed)
forall p. XValD p -> HsBind p -> HsDecl p
ValD XValD (GhcPass 'Parsed)
NoExtField
noExtField (HsBindLR (GhcPass 'Parsed) (GhcPass 'Parsed)
-> HsDecl (GhcPass 'Parsed))
-> (LHsExpr (GhcPass 'Parsed)
-> HsBindLR (GhcPass 'Parsed) (GhcPass 'Parsed))
-> LHsExpr (GhcPass 'Parsed)
-> HsDecl (GhcPass 'Parsed)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LHsExpr (GhcPass 'Parsed)
-> HsBindLR (GhcPass 'Parsed) (GhcPass 'Parsed)
funBind)
delCons :: String -> Int -> String -> LHsExpr GhcPs -> Maybe (LHsExpr GhcPs)
delCons :: String
-> Int
-> String
-> LHsExpr (GhcPass 'Parsed)
-> Maybe (LHsExpr (GhcPass 'Parsed))
delCons String
func Int
pos String
var (LHsExpr (GhcPass 'Parsed) -> [LHsExpr (GhcPass 'Parsed)]
fromApps -> (LHsExpr (GhcPass 'Parsed) -> Var_
forall a b. View a b => a -> b
view -> Var_ String
x) : [LHsExpr (GhcPass 'Parsed)]
xs) | String
func String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
x = do
([LHsExpr (GhcPass 'Parsed)]
pre, (LHsExpr (GhcPass 'Parsed) -> Var_
forall a b. View a b => a -> b
view -> Var_ String
v) : [LHsExpr (GhcPass 'Parsed)]
post) <- ([LHsExpr (GhcPass 'Parsed)], [LHsExpr (GhcPass 'Parsed)])
-> Maybe ([LHsExpr (GhcPass 'Parsed)], [LHsExpr (GhcPass 'Parsed)])
forall (f :: * -> *) a. Applicative f => a -> f a
pure (([LHsExpr (GhcPass 'Parsed)], [LHsExpr (GhcPass 'Parsed)])
-> Maybe
([LHsExpr (GhcPass 'Parsed)], [LHsExpr (GhcPass 'Parsed)]))
-> ([LHsExpr (GhcPass 'Parsed)], [LHsExpr (GhcPass 'Parsed)])
-> Maybe ([LHsExpr (GhcPass 'Parsed)], [LHsExpr (GhcPass 'Parsed)])
forall a b. (a -> b) -> a -> b
$ Int
-> [LHsExpr (GhcPass 'Parsed)]
-> ([LHsExpr (GhcPass 'Parsed)], [LHsExpr (GhcPass 'Parsed)])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
pos [LHsExpr (GhcPass 'Parsed)]
xs
Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ String
v String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
var
LHsExpr (GhcPass 'Parsed) -> Maybe (LHsExpr (GhcPass 'Parsed))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (LHsExpr (GhcPass 'Parsed) -> Maybe (LHsExpr (GhcPass 'Parsed)))
-> LHsExpr (GhcPass 'Parsed) -> Maybe (LHsExpr (GhcPass 'Parsed))
forall a b. (a -> b) -> a -> b
$ [LHsExpr (GhcPass 'Parsed)] -> LHsExpr (GhcPass 'Parsed)
apps ([LHsExpr (GhcPass 'Parsed)] -> LHsExpr (GhcPass 'Parsed))
-> [LHsExpr (GhcPass 'Parsed)] -> LHsExpr (GhcPass 'Parsed)
forall a b. (a -> b) -> a -> b
$ LHsExpr (GhcPass 'Parsed)
recursive LHsExpr (GhcPass 'Parsed)
-> [LHsExpr (GhcPass 'Parsed)] -> [LHsExpr (GhcPass 'Parsed)]
forall a. a -> [a] -> [a]
: [LHsExpr (GhcPass 'Parsed)]
pre [LHsExpr (GhcPass 'Parsed)]
-> [LHsExpr (GhcPass 'Parsed)] -> [LHsExpr (GhcPass 'Parsed)]
forall a. [a] -> [a] -> [a]
++ [LHsExpr (GhcPass 'Parsed)]
post
delCons String
_ Int
_ String
_ LHsExpr (GhcPass 'Parsed)
x = LHsExpr (GhcPass 'Parsed) -> Maybe (LHsExpr (GhcPass 'Parsed))
forall (f :: * -> *) a. Applicative f => a -> f a
pure LHsExpr (GhcPass 'Parsed)
x
eliminateArgs :: [String] -> LHsExpr GhcPs -> ([String], LHsExpr GhcPs)
eliminateArgs :: [String]
-> LHsExpr (GhcPass 'Parsed)
-> ([String], LHsExpr (GhcPass 'Parsed))
eliminateArgs [String]
ps LHsExpr (GhcPass 'Parsed)
cons = ([String] -> [String]
forall {a}. [a] -> [a]
remove [String]
ps, (LHsExpr (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed))
-> LHsExpr (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
forall on. Uniplate on => (on -> on) -> on -> on
transform LHsExpr (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
f LHsExpr (GhcPass 'Parsed)
cons)
where
args :: [[LHsExpr (GhcPass 'Parsed)]]
args = [[LHsExpr (GhcPass 'Parsed)]
zs | LHsExpr (GhcPass 'Parsed)
z : [LHsExpr (GhcPass 'Parsed)]
zs <- (LHsExpr (GhcPass 'Parsed) -> [LHsExpr (GhcPass 'Parsed)])
-> [LHsExpr (GhcPass 'Parsed)] -> [[LHsExpr (GhcPass 'Parsed)]]
forall a b. (a -> b) -> [a] -> [b]
map LHsExpr (GhcPass 'Parsed) -> [LHsExpr (GhcPass 'Parsed)]
fromApps ([LHsExpr (GhcPass 'Parsed)] -> [[LHsExpr (GhcPass 'Parsed)]])
-> [LHsExpr (GhcPass 'Parsed)] -> [[LHsExpr (GhcPass 'Parsed)]]
forall a b. (a -> b) -> a -> b
$ LHsExpr (GhcPass 'Parsed) -> [LHsExpr (GhcPass 'Parsed)]
universeApps LHsExpr (GhcPass 'Parsed)
cons, LHsExpr (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed) -> Bool
forall a. Data a => a -> a -> Bool
astEq LHsExpr (GhcPass 'Parsed)
z LHsExpr (GhcPass 'Parsed)
recursive]
elim :: [Bool]
elim = [([LHsExpr (GhcPass 'Parsed)] -> Bool)
-> [[LHsExpr (GhcPass 'Parsed)]] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\[LHsExpr (GhcPass 'Parsed)]
xs -> [LHsExpr (GhcPass 'Parsed)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [LHsExpr (GhcPass 'Parsed)]
xs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
i Bool -> Bool -> Bool
&& LHsExpr (GhcPass 'Parsed) -> Var_
forall a b. View a b => a -> b
view ([LHsExpr (GhcPass 'Parsed)]
xs [LHsExpr (GhcPass 'Parsed)] -> Int -> LHsExpr (GhcPass 'Parsed)
forall a. [a] -> Int -> a
!! Int
i) Var_ -> Var_ -> Bool
forall a. Eq a => a -> a -> Bool
== String -> Var_
Var_ String
p) [[LHsExpr (GhcPass 'Parsed)]]
args | (Int
i, String
p) <- Int -> [String] -> [(Int, String)]
forall a b. Enum a => a -> [b] -> [(a, b)]
zipFrom Int
0 [String]
ps] [Bool] -> [Bool] -> [Bool]
forall a. [a] -> [a] -> [a]
++ Bool -> [Bool]
forall a. a -> [a]
repeat Bool
False
remove :: [a] -> [a]
remove = [[a]] -> [a]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[a]] -> [a]) -> ([a] -> [[a]]) -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> a -> [a]) -> [Bool] -> [a] -> [[a]]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Bool
b a
x -> [a
x | Bool -> Bool
not Bool
b]) [Bool]
elim
f :: LHsExpr (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
f (LHsExpr (GhcPass 'Parsed) -> [LHsExpr (GhcPass 'Parsed)]
fromApps -> LHsExpr (GhcPass 'Parsed)
x : [LHsExpr (GhcPass 'Parsed)]
xs) | LHsExpr (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed) -> Bool
forall a. Data a => a -> a -> Bool
astEq LHsExpr (GhcPass 'Parsed)
x LHsExpr (GhcPass 'Parsed)
recursive = [LHsExpr (GhcPass 'Parsed)] -> LHsExpr (GhcPass 'Parsed)
apps ([LHsExpr (GhcPass 'Parsed)] -> LHsExpr (GhcPass 'Parsed))
-> [LHsExpr (GhcPass 'Parsed)] -> LHsExpr (GhcPass 'Parsed)
forall a b. (a -> b) -> a -> b
$ LHsExpr (GhcPass 'Parsed)
x LHsExpr (GhcPass 'Parsed)
-> [LHsExpr (GhcPass 'Parsed)] -> [LHsExpr (GhcPass 'Parsed)]
forall a. a -> [a] -> [a]
: [LHsExpr (GhcPass 'Parsed)] -> [LHsExpr (GhcPass 'Parsed)]
forall {a}. [a] -> [a]
remove [LHsExpr (GhcPass 'Parsed)]
xs
f LHsExpr (GhcPass 'Parsed)
x = LHsExpr (GhcPass 'Parsed)
x
findBranch :: LMatch GhcPs (LHsExpr GhcPs) -> Maybe Branch
findBranch :: LMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
-> Maybe Branch
findBranch (L SrcSpan
_ Match (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
x) = do
Match { m_ctxt :: forall p body. Match p body -> HsMatchContext (NoGhcTc p)
m_ctxt = FunRhs {mc_fun :: forall p. HsMatchContext p -> LIdP p
mc_fun=(L SrcSpan
_ IdP (NoGhcTc (GhcPass 'Parsed))
name)}
, m_pats :: forall p body. Match p body -> [LPat p]
m_pats = [LPat (GhcPass 'Parsed)]
ps
, m_grhss :: forall p body. Match p body -> GRHSs p body
m_grhss =
GRHSs {grhssGRHSs :: forall p body. GRHSs p body -> [LGRHS p body]
grhssGRHSs=[L SrcSpan
l (GRHS XCGRHS (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
_ [] LHsExpr (GhcPass 'Parsed)
body)]
, grhssLocalBinds :: forall p body. GRHSs p body -> LHsLocalBinds p
grhssLocalBinds=L SrcSpan
_ (EmptyLocalBinds XEmptyLocalBinds (GhcPass 'Parsed) (GhcPass 'Parsed)
_)
}
} <- Match (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
-> Maybe (Match (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed)))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Match (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
x
([String]
a, Int
b, BList
c) <- [LPat (GhcPass 'Parsed)] -> Maybe ([String], Int, BList)
findPat [LPat (GhcPass 'Parsed)]
ps
Branch -> Maybe Branch
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Branch -> Maybe Branch) -> Branch -> Maybe Branch
forall a b. (a -> b) -> a -> b
$ String
-> [String] -> Int -> BList -> LHsExpr (GhcPass 'Parsed) -> Branch
Branch (RdrName -> String
occNameStr IdP (NoGhcTc (GhcPass 'Parsed))
RdrName
name) [String]
a Int
b BList
c (LHsExpr (GhcPass 'Parsed) -> Branch)
-> LHsExpr (GhcPass 'Parsed) -> Branch
forall a b. (a -> b) -> a -> b
$ LHsExpr (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
simplifyExp LHsExpr (GhcPass 'Parsed)
body
findPat :: [LPat GhcPs] -> Maybe ([String], Int, BList)
findPat :: [LPat (GhcPass 'Parsed)] -> Maybe ([String], Int, BList)
findPat [LPat (GhcPass 'Parsed)]
ps = do
[Either String BList]
ps <- (Located (Pat (GhcPass 'Parsed)) -> Maybe (Either String BList))
-> [Located (Pat (GhcPass 'Parsed))] -> Maybe [Either String BList]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM LPat (GhcPass 'Parsed) -> Maybe (Either String BList)
Located (Pat (GhcPass 'Parsed)) -> Maybe (Either String BList)
readPat [LPat (GhcPass 'Parsed)]
[Located (Pat (GhcPass 'Parsed))]
ps
[Int
i] <- [Int] -> Maybe [Int]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Int] -> Maybe [Int]) -> [Int] -> Maybe [Int]
forall a b. (a -> b) -> a -> b
$ (Either String BList -> Bool) -> [Either String BList] -> [Int]
forall a. (a -> Bool) -> [a] -> [Int]
findIndices Either String BList -> Bool
forall a b. Either a b -> Bool
isRight [Either String BList]
ps
let ([String]
left, [BList
right]) = [Either String BList] -> ([String], [BList])
forall a b. [Either a b] -> ([a], [b])
partitionEithers [Either String BList]
ps
([String], Int, BList) -> Maybe ([String], Int, BList)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([String]
left, Int
i, BList
right)
readPat :: LPat GhcPs -> Maybe (Either String BList)
readPat :: LPat (GhcPass 'Parsed) -> Maybe (Either String BList)
readPat (LPat (GhcPass 'Parsed) -> PVar_
forall a b. View a b => a -> b
view -> PVar_ String
x) = Either String BList -> Maybe (Either String BList)
forall a. a -> Maybe a
Just (Either String BList -> Maybe (Either String BList))
-> Either String BList -> Maybe (Either String BList)
forall a b. (a -> b) -> a -> b
$ String -> Either String BList
forall a b. a -> Either a b
Left String
x
readPat (L SrcSpan
_ (ParPat XParPat (GhcPass 'Parsed)
_ (L SrcSpan
_ (ConPat XConPat (GhcPass 'Parsed)
_ (L SrcSpan
_ ConLikeP (GhcPass 'Parsed)
n) (InfixCon (LPat (GhcPass 'Parsed) -> PVar_
forall a b. View a b => a -> b
view -> PVar_ String
x) (LPat (GhcPass 'Parsed) -> PVar_
forall a b. View a b => a -> b
view -> PVar_ String
xs))))))
| ConLikeP (GhcPass 'Parsed)
RdrName
n RdrName -> RdrName -> Bool
forall a. Eq a => a -> a -> Bool
== RdrName
consDataCon_RDR = Either String BList -> Maybe (Either String BList)
forall a. a -> Maybe a
Just (Either String BList -> Maybe (Either String BList))
-> Either String BList -> Maybe (Either String BList)
forall a b. (a -> b) -> a -> b
$ BList -> Either String BList
forall a b. b -> Either a b
Right (BList -> Either String BList) -> BList -> Either String BList
forall a b. (a -> b) -> a -> b
$ String -> String -> BList
BCons String
x String
xs
readPat (L SrcSpan
_ (ConPat XConPat (GhcPass 'Parsed)
_ (L SrcSpan
_ ConLikeP (GhcPass 'Parsed)
n) (PrefixCon [])))
| ConLikeP (GhcPass 'Parsed)
RdrName
n RdrName -> RdrName -> Bool
forall a. Eq a => a -> a -> Bool
== Name -> RdrName
nameRdrName Name
nilDataConName = Either String BList -> Maybe (Either String BList)
forall a. a -> Maybe a
Just (Either String BList -> Maybe (Either String BList))
-> Either String BList -> Maybe (Either String BList)
forall a b. (a -> b) -> a -> b
$ BList -> Either String BList
forall a b. b -> Either a b
Right BList
BNil
readPat LPat (GhcPass 'Parsed)
_ = Maybe (Either String BList)
forall a. Maybe a
Nothing