{-# LANGUAGE PatternGuards, ViewPatterns #-}
{-# LANGUAGE RecordWildCards #-}

{-
map f [] = []
map f (x:xs) = f x : map f xs

foldr f z [] = z
foldr f z (x:xs) = f x (foldr f z xs)

foldl f z [] = z
foldl f z (x:xs) = foldl f (f z x) xs
-}

{-
<TEST>
f (x:xs) = negate x + f xs ; f [] = 0 -- f xs = foldr ((+) . negate) 0 xs
f (x:xs) = x + 1 : f xs ; f [] = [] -- f xs = map (+ 1) xs
f z (x:xs) = f (z*x) xs ; f z [] = z -- f z xs = foldl (*) z xs
f a (x:xs) b = x + a + b : f a xs b ; f a [] b = [] -- f a xs b = map (\ x -> x + a + b) xs
f [] a = return a ; f (x:xs) a = a + x >>= \fax -> f xs fax -- f xs a = foldM (+) a xs
f (x:xs) a = a + x >>= \fax -> f xs fax ; f [] a = pure a -- f xs a = foldM (+) a xs
foos [] x = x; foos (y:ys) x = foo y $ foos ys x -- foos ys x = foldr foo x ys
f [] y = y; f (x:xs) y = f xs $ g x y -- f xs y = foldl (flip g) y xs
f [] y = y; f (x : xs) y = let z = g x y in f xs z -- f xs y = foldl (flip g) y xs
f [] y = y; f (x:xs) y = f xs (f xs z)
fun [] = []; fun (x:xs) = f x xs ++ fun xs
</TEST>
-}


module Hint.ListRec(listRecHint) where

import Hint.Type (DeclHint, Severity(Suggestion, Warning), idea, toSSA)

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.Parser.Annotation
import Language.Haskell.Syntax.Extension

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
_ = (LocatedAn AnnListItem (HsDecl (GhcPass 'Parsed)) -> [Idea])
-> [LocatedAn AnnListItem (HsDecl (GhcPass 'Parsed))] -> [Idea]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap LocatedAn AnnListItem (HsDecl (GhcPass 'Parsed)) -> [Idea]
f ([LocatedAn AnnListItem (HsDecl (GhcPass 'Parsed))] -> [Idea])
-> (LocatedAn AnnListItem (HsDecl (GhcPass 'Parsed))
    -> [LocatedAn AnnListItem (HsDecl (GhcPass 'Parsed))])
-> LocatedAn AnnListItem (HsDecl (GhcPass 'Parsed))
-> [Idea]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LocatedAn AnnListItem (HsDecl (GhcPass 'Parsed))
-> [LocatedAn AnnListItem (HsDecl (GhcPass 'Parsed))]
forall on. Uniplate on => on -> [on]
universe
    where
        f :: LocatedAn AnnListItem (HsDecl (GhcPass 'Parsed)) -> [Idea]
f LocatedAn AnnListItem (HsDecl (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 :: LocatedAn AnnListItem (HsDecl (GhcPass 'Parsed))
x = LocatedAn AnnListItem (HsDecl (GhcPass 'Parsed))
o
            (ListCase
x, GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed))
-> LocatedAn AnnListItem (HsDecl (GhcPass 'Parsed))
addCase) <- XRec (GhcPass 'Parsed) (HsDecl (GhcPass 'Parsed))
-> Maybe
     (ListCase,
      LHsExpr (GhcPass 'Parsed)
      -> XRec (GhcPass 'Parsed) (HsDecl (GhcPass 'Parsed)))
findCase XRec (GhcPass 'Parsed) (HsDecl (GhcPass 'Parsed))
LocatedAn AnnListItem (HsDecl (GhcPass 'Parsed))
x
            ([Char]
use,Severity
severity,GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed))
x) <- ListCase -> Maybe ([Char], Severity, LHsExpr (GhcPass 'Parsed))
matchListRec ListCase
x
            let y :: LocatedAn AnnListItem (HsDecl (GhcPass 'Parsed))
y = GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed))
-> LocatedAn AnnListItem (HsDecl (GhcPass 'Parsed))
addCase GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed))
x
            Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ [Char]
recursiveStr [Char] -> [[Char]] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` LocatedAn AnnListItem (HsDecl (GhcPass 'Parsed)) -> [[Char]]
forall a. AllVars a => a -> [[Char]]
varss LocatedAn AnnListItem (HsDecl (GhcPass 'Parsed))
y
            -- Maybe we can do better here maintaining source
            -- formatting?
            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
-> [Char]
-> Located (HsDecl (GhcPass 'Parsed))
-> Located (HsDecl (GhcPass 'Parsed))
-> [Refactoring SrcSpan]
-> Idea
forall a b.
(Outputable a, Outputable b) =>
Severity
-> [Char]
-> Located a
-> Located b
-> [Refactoring SrcSpan]
-> Idea
idea Severity
severity ([Char]
"Use " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
use) (LocatedAn AnnListItem (HsDecl (GhcPass 'Parsed))
-> Located (HsDecl (GhcPass 'Parsed))
forall a e. LocatedAn a e -> Located e
reLoc LocatedAn AnnListItem (HsDecl (GhcPass 'Parsed))
o) (LocatedAn AnnListItem (HsDecl (GhcPass 'Parsed))
-> Located (HsDecl (GhcPass 'Parsed))
forall a e. LocatedAn a e -> Located e
reLoc LocatedAn AnnListItem (HsDecl (GhcPass 'Parsed))
y) [RType
-> SrcSpan -> [([Char], SrcSpan)] -> [Char] -> Refactoring SrcSpan
forall a. RType -> a -> [([Char], a)] -> [Char] -> Refactoring a
Replace RType
Decl (LocatedAn AnnListItem (HsDecl (GhcPass 'Parsed)) -> SrcSpan
forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
toSSA LocatedAn AnnListItem (HsDecl (GhcPass 'Parsed))
o) [] (LocatedAn AnnListItem (HsDecl (GhcPass 'Parsed)) -> [Char]
forall a. Outputable a => a -> [Char]
unsafePrettyPrint LocatedAn AnnListItem (HsDecl (GhcPass 'Parsed))
y)]

recursiveStr :: String
recursiveStr :: [Char]
recursiveStr = [Char]
"_recursive_"
recursive :: LHsExpr (GhcPass 'Parsed)
recursive = [Char] -> LHsExpr (GhcPass 'Parsed)
strToVar [Char]
recursiveStr

data ListCase =
  ListCase
    [String] -- recursion parameters
    (LHsExpr GhcPs)  -- nil case
    (String, String, LHsExpr GhcPs) -- cons case
-- For cons-case delete any recursive calls with 'xs' in them. Any
-- recursive calls are marked "_recursive_".

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
$cp1Ord :: Eq BList
Ord, Int -> BList -> [Char] -> [Char]
[BList] -> [Char] -> [Char]
BList -> [Char]
(Int -> BList -> [Char] -> [Char])
-> (BList -> [Char]) -> ([BList] -> [Char] -> [Char]) -> Show BList
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
showList :: [BList] -> [Char] -> [Char]
$cshowList :: [BList] -> [Char] -> [Char]
show :: BList -> [Char]
$cshow :: BList -> [Char]
showsPrec :: Int -> BList -> [Char] -> [Char]
$cshowsPrec :: Int -> BList -> [Char] -> [Char]
Show)

data Branch =
  Branch
    String  -- function name
    [String]  -- parameters
    Int -- list position
    BList (LHsExpr GhcPs) -- list type/body

---------------------------------------------------------------------
-- MATCH THE RECURSION


matchListRec :: ListCase -> Maybe (String, Severity, LHsExpr GhcPs)
matchListRec :: ListCase -> Maybe ([Char], Severity, LHsExpr (GhcPass 'Parsed))
matchListRec o :: ListCase
o@(ListCase [[Char]]
vs LHsExpr (GhcPass 'Parsed)
nil ([Char]
x, [Char]
xs, LHsExpr (GhcPass 'Parsed)
cons))
    -- Suggest 'map'?
    | [] <- [[Char]]
vs, LHsExpr (GhcPass 'Parsed) -> [Char]
varToStr LHsExpr (GhcPass 'Parsed)
nil [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
"[]", (L _ (OpApp _ lhs c rhs)) <- LHsExpr (GhcPass 'Parsed)
cons, LHsExpr (GhcPass 'Parsed) -> [Char]
varToStr LHsExpr (GhcPass 'Parsed)
c [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
":"
    , GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed))
-> GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed)) -> Bool
forall a. Data a => a -> a -> Bool
astEq (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed))
-> GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed))
fromParen LHsExpr (GhcPass 'Parsed)
GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed))
rhs) GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed))
recursive, [Char]
xs [Char] -> [[Char]] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed)) -> [[Char]]
forall a. FreeVars a => a -> [[Char]]
vars LHsExpr (GhcPass 'Parsed)
GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed))
lhs
    = ([Char], Severity,
 GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed)))
-> Maybe
     ([Char], Severity,
      GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed)))
forall a. a -> Maybe a
Just (([Char], Severity,
  GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed)))
 -> Maybe
      ([Char], Severity,
       GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed))))
-> ([Char], Severity,
    GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed)))
-> Maybe
     ([Char], Severity,
      GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed)))
forall a b. (a -> b) -> a -> b
$ (,,) [Char]
"map" Severity
Hint.Type.Warning (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed))
 -> ([Char], Severity,
     GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed))))
-> GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed))
-> ([Char], Severity,
    GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed)))
forall a b. (a -> b) -> a -> b
$
      [LHsExpr (GhcPass 'Parsed)] -> LHsExpr (GhcPass 'Parsed)
appsBracket [ [Char] -> LHsExpr (GhcPass 'Parsed)
strToVar [Char]
"map", [[Char]] -> LHsExpr (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
niceLambda [[Char]
x] LHsExpr (GhcPass 'Parsed)
lhs, [Char] -> LHsExpr (GhcPass 'Parsed)
strToVar [Char]
xs]
    -- Suggest 'foldr'?
    | [] <- [[Char]]
vs, App2 GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed))
op GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed))
lhs GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed))
rhs <- GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed)) -> App2
forall a b. View a b => a -> b
view LHsExpr (GhcPass 'Parsed)
GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed))
cons
    , [Char]
xs [Char] -> [[Char]] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed)) -> [[Char]]
forall a. FreeVars a => a -> [[Char]]
vars GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed))
op [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed)) -> [[Char]]
forall a. FreeVars a => a -> [[Char]]
vars GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed))
lhs) -- the meaning of xs changes, see #793
    , GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed))
-> GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed)) -> Bool
forall a. Data a => a -> a -> Bool
astEq (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed))
-> GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed))
fromParen GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed))
rhs) GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed))
recursive
    = ([Char], Severity,
 GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed)))
-> Maybe
     ([Char], Severity,
      GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed)))
forall a. a -> Maybe a
Just (([Char], Severity,
  GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed)))
 -> Maybe
      ([Char], Severity,
       GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed))))
-> ([Char], Severity,
    GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed)))
-> Maybe
     ([Char], Severity,
      GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed)))
forall a b. (a -> b) -> a -> b
$ (,,) [Char]
"foldr" Severity
Suggestion (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed))
 -> ([Char], Severity,
     GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed))))
-> GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed))
-> ([Char], Severity,
    GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed)))
forall a b. (a -> b) -> a -> b
$
      [LHsExpr (GhcPass 'Parsed)] -> LHsExpr (GhcPass 'Parsed)
appsBracket [ [Char] -> LHsExpr (GhcPass 'Parsed)
strToVar [Char]
"foldr", [[Char]] -> LHsExpr (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
niceLambda [[Char]
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)
GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed))
op,LHsExpr (GhcPass 'Parsed)
GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed))
lhs], LHsExpr (GhcPass 'Parsed)
nil, [Char] -> LHsExpr (GhcPass 'Parsed)
strToVar [Char]
xs]
    -- Suggest 'foldl'?
    | [[Char]
v] <- [[Char]]
vs, GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed)) -> Var_
forall a b. View a b => a -> b
view LHsExpr (GhcPass 'Parsed)
GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed))
nil Var_ -> Var_ -> Bool
forall a. Eq a => a -> a -> Bool
== [Char] -> Var_
Var_ [Char]
v, (L _ (HsApp _ r lhs)) <- LHsExpr (GhcPass 'Parsed)
cons
    , GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed))
-> GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed)) -> Bool
forall a. Data a => a -> a -> Bool
astEq (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed))
-> GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed))
fromParen LHsExpr (GhcPass 'Parsed)
GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed))
r) GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed))
recursive
    , [Char]
xs [Char] -> [[Char]] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed)) -> [[Char]]
forall a. FreeVars a => a -> [[Char]]
vars LHsExpr (GhcPass 'Parsed)
GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed))
lhs
    = ([Char], Severity,
 GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed)))
-> Maybe
     ([Char], Severity,
      GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed)))
forall a. a -> Maybe a
Just (([Char], Severity,
  GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed)))
 -> Maybe
      ([Char], Severity,
       GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed))))
-> ([Char], Severity,
    GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed)))
-> Maybe
     ([Char], Severity,
      GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed)))
forall a b. (a -> b) -> a -> b
$ (,,) [Char]
"foldl" Severity
Suggestion (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed))
 -> ([Char], Severity,
     GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed))))
-> GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed))
-> ([Char], Severity,
    GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed)))
forall a b. (a -> b) -> a -> b
$
      [LHsExpr (GhcPass 'Parsed)] -> LHsExpr (GhcPass 'Parsed)
appsBracket [ [Char] -> LHsExpr (GhcPass 'Parsed)
strToVar [Char]
"foldl", [[Char]] -> LHsExpr (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
niceLambda [[Char]
v,[Char]
x] LHsExpr (GhcPass 'Parsed)
lhs, [Char] -> LHsExpr (GhcPass 'Parsed)
strToVar [Char]
v, [Char] -> LHsExpr (GhcPass 'Parsed)
strToVar [Char]
xs]
    -- Suggest 'foldM'?
    | [[Char]
v] <- [[Char]]
vs, (L _ (HsApp _ ret res)) <- LHsExpr (GhcPass 'Parsed)
nil, LHsExpr (GhcPass 'Parsed) -> Bool
isReturn LHsExpr (GhcPass 'Parsed)
ret, LHsExpr (GhcPass 'Parsed) -> [Char]
varToStr LHsExpr (GhcPass 'Parsed)
res [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
"()" Bool -> Bool -> Bool
|| GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed)) -> Var_
forall a b. View a b => a -> b
view LHsExpr (GhcPass 'Parsed)
GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed))
res Var_ -> Var_ -> Bool
forall a. Eq a => a -> a -> Bool
== [Char] -> Var_
Var_ [Char]
v
    , [L _ (BindStmt _ (view -> PVar_ b1) e), L _ (BodyStmt _ (fromParen -> (L _ (HsApp _ r (view -> Var_ b2)))) _ _)] <- LHsExpr (GhcPass 'Parsed)
-> [LStmt (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))]
asDo LHsExpr (GhcPass 'Parsed)
cons
    , [Char]
b1 [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
b2, GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed))
-> GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed)) -> Bool
forall a. Data a => a -> a -> Bool
astEq LHsExpr (GhcPass 'Parsed)
GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed))
r GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed))
recursive, [Char]
xs [Char] -> [[Char]] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed)) -> [[Char]]
forall a. FreeVars a => a -> [[Char]]
vars GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed))
e
    , [Char]
name <- [Char]
"foldM" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char
'_' | LHsExpr (GhcPass 'Parsed) -> [Char]
varToStr LHsExpr (GhcPass 'Parsed)
res [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
"()"]
    = ([Char], Severity,
 GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed)))
-> Maybe
     ([Char], Severity,
      GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed)))
forall a. a -> Maybe a
Just (([Char], Severity,
  GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed)))
 -> Maybe
      ([Char], Severity,
       GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed))))
-> ([Char], Severity,
    GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed)))
-> Maybe
     ([Char], Severity,
      GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed)))
forall a b. (a -> b) -> a -> b
$ (,,) [Char]
name Severity
Suggestion (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed))
 -> ([Char], Severity,
     GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed))))
-> GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed))
-> ([Char], Severity,
    GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed)))
forall a b. (a -> b) -> a -> b
$
      [LHsExpr (GhcPass 'Parsed)] -> LHsExpr (GhcPass 'Parsed)
appsBracket [[Char] -> LHsExpr (GhcPass 'Parsed)
strToVar [Char]
name, [[Char]] -> LHsExpr (GhcPass 'Parsed) -> LHsExpr (GhcPass 'Parsed)
niceLambda [[Char]
v,[Char]
x] LHsExpr (GhcPass 'Parsed)
GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed))
e, [Char] -> LHsExpr (GhcPass 'Parsed)
strToVar [Char]
v, [Char] -> LHsExpr (GhcPass 'Parsed)
strToVar [Char]
xs]
    -- Nope, I got nothing ¯\_(ツ)_/¯.
    | Bool
otherwise = Maybe ([Char], Severity, LHsExpr (GhcPass 'Parsed))
forall a. Maybe a
Nothing

-- Very limited attempt to convert >>= to do, only useful for
-- 'foldM' / 'foldM_'.
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 GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed))
bind GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed))
lhs
         (L SrcSpanAnnA
_ (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 -> XRec p [LMatch p body]
mg_alts=L _ [
                 L _ Match {  m_ctxt=LambdaExpr
                            , m_pats=[v@(L _ VarPat{})]
                            , m_grhss=GRHSs _
                                        [L _ (GRHS _ [] rhs)]
                                        (EmptyLocalBinds _)}]}))
      ) =
  [ StmtLR
  (GhcPass 'Parsed)
  (GhcPass 'Parsed)
  (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed)))
-> LocatedAn
     AnnListItem
     (StmtLR
        (GhcPass 'Parsed)
        (GhcPass 'Parsed)
        (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed))))
forall a an. a -> LocatedAn an a
noLocA (StmtLR
   (GhcPass 'Parsed)
   (GhcPass 'Parsed)
   (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed)))
 -> LocatedAn
      AnnListItem
      (StmtLR
         (GhcPass 'Parsed)
         (GhcPass 'Parsed)
         (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed)))))
-> StmtLR
     (GhcPass 'Parsed)
     (GhcPass 'Parsed)
     (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed)))
-> LocatedAn
     AnnListItem
     (StmtLR
        (GhcPass 'Parsed)
        (GhcPass 'Parsed)
        (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed))))
forall a b. (a -> b) -> a -> b
$ XBindStmt
  (GhcPass 'Parsed)
  (GhcPass 'Parsed)
  (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed)))
-> LPat (GhcPass 'Parsed)
-> GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed))
-> StmtLR
     (GhcPass 'Parsed)
     (GhcPass 'Parsed)
     (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed)))
forall idL idR body.
XBindStmt idL idR body -> LPat idL -> body -> StmtLR idL idR body
BindStmt XBindStmt
  (GhcPass 'Parsed)
  (GhcPass 'Parsed)
  (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed)))
forall ann. EpAnn ann
EpAnnNotUsed LPat (GhcPass 'Parsed)
v GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed))
lhs
  , StmtLR
  (GhcPass 'Parsed)
  (GhcPass 'Parsed)
  (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed)))
-> LocatedAn
     AnnListItem
     (StmtLR
        (GhcPass 'Parsed)
        (GhcPass 'Parsed)
        (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed))))
forall a an. a -> LocatedAn an a
noLocA (StmtLR
   (GhcPass 'Parsed)
   (GhcPass 'Parsed)
   (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed)))
 -> LocatedAn
      AnnListItem
      (StmtLR
         (GhcPass 'Parsed)
         (GhcPass 'Parsed)
         (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed)))))
-> StmtLR
     (GhcPass 'Parsed)
     (GhcPass 'Parsed)
     (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed)))
-> LocatedAn
     AnnListItem
     (StmtLR
        (GhcPass 'Parsed)
        (GhcPass 'Parsed)
        (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed))))
forall a b. (a -> b) -> a -> b
$ XBodyStmt
  (GhcPass 'Parsed)
  (GhcPass 'Parsed)
  (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed)))
-> GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed))
-> SyntaxExpr (GhcPass 'Parsed)
-> SyntaxExpr (GhcPass 'Parsed)
-> StmtLR
     (GhcPass 'Parsed)
     (GhcPass 'Parsed)
     (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed)))
forall idL idR body.
XBodyStmt idL idR body
-> body -> SyntaxExpr idR -> SyntaxExpr idR -> StmtLR idL idR body
BodyStmt NoExtField
XBodyStmt
  (GhcPass 'Parsed)
  (GhcPass 'Parsed)
  (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed)))
noExtField GenLocated SrcSpanAnnA (HsExpr (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 _ (HsDo _ (DoExpr _) (L _ stmts))) = [LStmt (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))]
[LocatedAn
   AnnListItem
   (StmtLR
      (GhcPass 'Parsed)
      (GhcPass 'Parsed)
      (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed))))]
stmts
asDo LHsExpr (GhcPass 'Parsed)
x = [StmtLR
  (GhcPass 'Parsed)
  (GhcPass 'Parsed)
  (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed)))
-> LocatedAn
     AnnListItem
     (StmtLR
        (GhcPass 'Parsed)
        (GhcPass 'Parsed)
        (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed))))
forall a an. a -> LocatedAn an a
noLocA (StmtLR
   (GhcPass 'Parsed)
   (GhcPass 'Parsed)
   (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed)))
 -> LocatedAn
      AnnListItem
      (StmtLR
         (GhcPass 'Parsed)
         (GhcPass 'Parsed)
         (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed)))))
-> StmtLR
     (GhcPass 'Parsed)
     (GhcPass 'Parsed)
     (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed)))
-> LocatedAn
     AnnListItem
     (StmtLR
        (GhcPass 'Parsed)
        (GhcPass 'Parsed)
        (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed))))
forall a b. (a -> b) -> a -> b
$ XBodyStmt
  (GhcPass 'Parsed)
  (GhcPass 'Parsed)
  (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed)))
-> GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed))
-> SyntaxExpr (GhcPass 'Parsed)
-> SyntaxExpr (GhcPass 'Parsed)
-> StmtLR
     (GhcPass 'Parsed)
     (GhcPass 'Parsed)
     (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed)))
forall idL idR body.
XBodyStmt idL idR body
-> body -> SyntaxExpr idR -> SyntaxExpr idR -> StmtLR idL idR body
BodyStmt NoExtField
XBodyStmt
  (GhcPass 'Parsed)
  (GhcPass 'Parsed)
  (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed)))
noExtField LHsExpr (GhcPass 'Parsed)
GenLocated SrcSpanAnnA (HsExpr (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]


---------------------------------------------------------------------
-- FIND THE CASE ANALYSIS


findCase :: LHsDecl GhcPs -> Maybe (ListCase, LHsExpr GhcPs -> LHsDecl GhcPs)
findCase :: XRec (GhcPass 'Parsed) (HsDecl (GhcPass 'Parsed))
-> Maybe
     (ListCase,
      LHsExpr (GhcPass 'Parsed)
      -> XRec (GhcPass 'Parsed) (HsDecl (GhcPass 'Parsed)))
findCase XRec (GhcPass 'Parsed) (HsDecl (GhcPass 'Parsed))
x = do
  -- Match a function binding with two alternatives.
  (L SrcSpanAnnA
_ (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 -> XRec p [LMatch p body]
mg_alts=
                     (L _
                            [ x1@(L _ Match{..}) -- Match fields.
                            , 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))
..} -- Match group fields.
          , [CoreTickish]
LIdP (GhcPass 'Parsed)
XFunBind (GhcPass 'Parsed) (GhcPass 'Parsed)
fun_ext :: forall idL idR. HsBindLR idL idR -> XFunBind idL idR
fun_id :: forall idL idR. HsBindLR idL idR -> LIdP idL
fun_tick :: forall idL idR. HsBindLR idL idR -> [CoreTickish]
fun_tick :: [CoreTickish]
fun_id :: LIdP (GhcPass 'Parsed)
fun_ext :: XFunBind (GhcPass 'Parsed) (GhcPass 'Parsed)
..} -- Fun. bind fields.
      )) <- LocatedAn AnnListItem (HsDecl (GhcPass 'Parsed))
-> Maybe (LocatedAn AnnListItem (HsDecl (GhcPass 'Parsed)))
forall (f :: * -> *) a. Applicative f => a -> f a
pure XRec (GhcPass 'Parsed) (HsDecl (GhcPass 'Parsed))
LocatedAn AnnListItem (HsDecl (GhcPass 'Parsed))
x

  Branch [Char]
name1 [[Char]]
ps1 Int
p1 BList
c1 LHsExpr (GhcPass 'Parsed)
b1 <- LMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
-> Maybe Branch
findBranch LMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
GenLocated
  SrcSpanAnnA
  (Match
     (GhcPass 'Parsed)
     (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed))))
x1
  Branch [Char]
name2 [[Char]]
ps2 Int
p2 BList
c2 LHsExpr (GhcPass 'Parsed)
b2 <- LMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
-> Maybe Branch
findBranch LMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
GenLocated
  SrcSpanAnnA
  (Match
     (GhcPass 'Parsed)
     (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed))))
x2
  Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard ([Char]
name1 [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
name2 Bool -> Bool -> Bool
&& [[Char]]
ps1 [[Char]] -> [[Char]] -> Bool
forall a. Eq a => a -> a -> Bool
== [[Char]]
ps2 Bool -> Bool -> Bool
&& Int
p1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
p2)
  [(BList
BNil, GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed))
b1), (BCons [Char]
x [Char]
xs, GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed))
b2)] <- [(BList, GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed)))]
-> Maybe
     [(BList, GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed)))]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([(BList, GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed)))]
 -> Maybe
      [(BList, GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed)))])
-> [(BList, GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed)))]
-> Maybe
     [(BList, GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed)))]
forall a b. (a -> b) -> a -> b
$ ((BList, GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed)))
 -> BList)
-> [(BList, GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed)))]
-> [(BList, GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed)))]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (BList, GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed))) -> BList
forall a b. (a, b) -> a
fst [(BList
c1, LHsExpr (GhcPass 'Parsed)
GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed))
b1), (BList
c2, LHsExpr (GhcPass 'Parsed)
GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed))
b2)]
  GenLocated SrcSpanAnnA (HsExpr (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 ([Char]
-> Int
-> [Char]
-> LHsExpr (GhcPass 'Parsed)
-> Maybe (LHsExpr (GhcPass 'Parsed))
delCons [Char]
name1 Int
p1 [Char]
xs) LHsExpr (GhcPass 'Parsed)
GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed))
b2
  ([[Char]]
ps, GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed))
b2) <- ([[Char]], GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed)))
-> Maybe
     ([[Char]], GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed)))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (([[Char]], GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed)))
 -> Maybe
      ([[Char]], GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed))))
-> ([[Char]], GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed)))
-> Maybe
     ([[Char]], GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed)))
forall a b. (a -> b) -> a -> b
$ [[Char]]
-> LHsExpr (GhcPass 'Parsed)
-> ([[Char]], LHsExpr (GhcPass 'Parsed))
eliminateArgs [[Char]]
ps1 LHsExpr (GhcPass 'Parsed)
GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed))
b2

  let ps12 :: [GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))]
ps12 = let ([[Char]]
a, [[Char]]
b) = Int -> [[Char]] -> ([[Char]], [[Char]])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
p1 [[Char]]
ps1 in ([Char] -> GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed)))
-> [[Char]] -> [GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))]
forall a b. (a -> b) -> [a] -> [b]
map [Char] -> LPat (GhcPass 'Parsed)
[Char] -> GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))
strToPat ([[Char]]
a [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ [Char]
xs [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
: [[Char]]
b) -- Function arguments.
      emptyLocalBinds :: HsLocalBindsLR (GhcPass 'Parsed) (GhcPass 'Parsed)
emptyLocalBinds = XEmptyLocalBinds (GhcPass 'Parsed) (GhcPass 'Parsed)
-> HsLocalBindsLR (GhcPass 'Parsed) (GhcPass 'Parsed)
forall idL idR. XEmptyLocalBinds idL idR -> HsLocalBindsLR idL idR
EmptyLocalBinds NoExtField
XEmptyLocalBinds (GhcPass 'Parsed) (GhcPass 'Parsed)
noExtField :: HsLocalBindsLR GhcPs GhcPs -- Empty where clause.
      gRHS :: GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed))
-> LGRHS (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
gRHS GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed))
e = GRHS
  (GhcPass 'Parsed)
  (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed)))
-> Located
     (GRHS
        (GhcPass 'Parsed)
        (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed))))
forall e. e -> Located e
noLoc (GRHS
   (GhcPass 'Parsed)
   (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed)))
 -> Located
      (GRHS
         (GhcPass 'Parsed)
         (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed)))))
-> GRHS
     (GhcPass 'Parsed)
     (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed)))
-> Located
     (GRHS
        (GhcPass 'Parsed)
        (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed))))
forall a b. (a -> b) -> a -> b
$ XCGRHS
  (GhcPass 'Parsed)
  (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed)))
-> [LStmt (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))]
-> GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed))
-> GRHS
     (GhcPass 'Parsed)
     (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed)))
forall p body.
XCGRHS p body -> [GuardLStmt p] -> body -> GRHS p body
GRHS XCGRHS
  (GhcPass 'Parsed)
  (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed)))
forall ann. EpAnn ann
EpAnnNotUsed [] GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed))
e :: LGRHS GhcPs (LHsExpr GhcPs) -- Guarded rhs.
      gRHSSs :: GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed))
-> GRHSs
     (GhcPass 'Parsed)
     (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed)))
gRHSSs GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed))
e = XCGRHSs
  (GhcPass 'Parsed)
  (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed)))
-> [LGRHS
      (GhcPass 'Parsed)
      (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed)))]
-> HsLocalBindsLR (GhcPass 'Parsed) (GhcPass 'Parsed)
-> GRHSs
     (GhcPass 'Parsed)
     (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed)))
forall p body.
XCGRHSs p body -> [LGRHS p body] -> HsLocalBinds p -> GRHSs p body
GRHSs XCGRHSs
  (GhcPass 'Parsed)
  (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed)))
EpAnnComments
emptyComments [GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed))
-> Located
     (GRHS
        (GhcPass 'Parsed)
        (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed))))
gRHS GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed))
e] HsLocalBindsLR (GhcPass 'Parsed) (GhcPass 'Parsed)
emptyLocalBinds -- Guarded rhs set.
      match :: GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed))
-> Match
     (GhcPass 'Parsed)
     (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed)))
match GenLocated SrcSpanAnnA (HsExpr (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)
  (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed)))
m_ext=XCMatch
  (GhcPass 'Parsed)
  (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed)))
forall ann. EpAnn ann
EpAnnNotUsed,m_pats :: [LPat (GhcPass 'Parsed)]
m_pats=[LPat (GhcPass 'Parsed)]
[GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))]
ps12, m_grhss :: GRHSs
  (GhcPass 'Parsed)
  (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed)))
m_grhss=GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed))
-> GRHSs
     (GhcPass 'Parsed)
     (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed)))
gRHSSs GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed))
e, HsMatchContext (NoGhcTc (GhcPass 'Parsed))
m_ctxt :: HsMatchContext (NoGhcTc (GhcPass 'Parsed))
m_ctxt :: HsMatchContext (NoGhcTc (GhcPass 'Parsed))
..} -- Match.
      matchGroup :: GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed))
-> MatchGroup
     (GhcPass 'Parsed)
     (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed)))
matchGroup GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed))
e = MG :: forall p body.
XMG p body -> XRec p [LMatch p body] -> Origin -> MatchGroup p body
MG{mg_alts :: XRec
  (GhcPass 'Parsed)
  [LMatch
     (GhcPass 'Parsed)
     (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed)))]
mg_alts=[GenLocated
   SrcSpanAnnA
   (Match
      (GhcPass 'Parsed)
      (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed))))]
-> LocatedAn
     AnnList
     [GenLocated
        SrcSpanAnnA
        (Match
           (GhcPass 'Parsed)
           (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed))))]
forall a an. a -> LocatedAn an a
noLocA [Match
  (GhcPass 'Parsed)
  (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed)))
-> GenLocated
     SrcSpanAnnA
     (Match
        (GhcPass 'Parsed)
        (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed))))
forall a an. a -> LocatedAn an a
noLocA (Match
   (GhcPass 'Parsed)
   (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed)))
 -> GenLocated
      SrcSpanAnnA
      (Match
         (GhcPass 'Parsed)
         (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed)))))
-> Match
     (GhcPass 'Parsed)
     (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed)))
-> GenLocated
     SrcSpanAnnA
     (Match
        (GhcPass 'Parsed)
        (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed))))
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed))
-> Match
     (GhcPass 'Parsed)
     (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed)))
match GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed))
e], mg_origin :: Origin
mg_origin=Origin
Generated, XMG (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
XMG
  (GhcPass 'Parsed)
  (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed)))
mg_ext :: XMG
  (GhcPass 'Parsed)
  (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed)))
mg_ext :: XMG (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
..} -- Match group.
      funBind :: GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed))
-> HsBindLR (GhcPass 'Parsed) (GhcPass 'Parsed)
funBind GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed))
e = FunBind :: forall idL idR.
XFunBind idL idR
-> LIdP idL
-> MatchGroup idR (LHsExpr idR)
-> [CoreTickish]
-> HsBindLR idL idR
FunBind {fun_matches :: MatchGroup (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
fun_matches=GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed))
-> MatchGroup
     (GhcPass 'Parsed)
     (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed)))
matchGroup GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed))
e, [CoreTickish]
LIdP (GhcPass 'Parsed)
XFunBind (GhcPass 'Parsed) (GhcPass 'Parsed)
fun_ext :: XFunBind (GhcPass 'Parsed) (GhcPass 'Parsed)
fun_id :: LIdP (GhcPass 'Parsed)
fun_tick :: [CoreTickish]
fun_tick :: [CoreTickish]
fun_id :: LIdP (GhcPass 'Parsed)
fun_ext :: XFunBind (GhcPass 'Parsed) (GhcPass 'Parsed)
..} :: HsBindLR GhcPs GhcPs -- Fun bind.

  (ListCase,
 GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed))
 -> LocatedAn AnnListItem (HsDecl (GhcPass 'Parsed)))
-> Maybe
     (ListCase,
      GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed))
      -> LocatedAn AnnListItem (HsDecl (GhcPass 'Parsed)))
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([[Char]]
-> LHsExpr (GhcPass 'Parsed)
-> ([Char], [Char], LHsExpr (GhcPass 'Parsed))
-> ListCase
ListCase [[Char]]
ps LHsExpr (GhcPass 'Parsed)
GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed))
b1 ([Char]
x, [Char]
xs, LHsExpr (GhcPass 'Parsed)
GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed))
b2), HsDecl (GhcPass 'Parsed)
-> LocatedAn AnnListItem (HsDecl (GhcPass 'Parsed))
forall a an. a -> LocatedAn an a
noLocA (HsDecl (GhcPass 'Parsed)
 -> LocatedAn AnnListItem (HsDecl (GhcPass 'Parsed)))
-> (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed))
    -> HsDecl (GhcPass 'Parsed))
-> GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed))
-> LocatedAn AnnListItem (HsDecl (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 NoExtField
XValD (GhcPass 'Parsed)
noExtField (HsBindLR (GhcPass 'Parsed) (GhcPass 'Parsed)
 -> HsDecl (GhcPass 'Parsed))
-> (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed))
    -> HsBindLR (GhcPass 'Parsed) (GhcPass 'Parsed))
-> GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed))
-> HsDecl (GhcPass 'Parsed)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed))
-> HsBindLR (GhcPass 'Parsed) (GhcPass 'Parsed)
funBind)

delCons :: String -> Int -> String -> LHsExpr GhcPs -> Maybe (LHsExpr GhcPs)
delCons :: [Char]
-> Int
-> [Char]
-> LHsExpr (GhcPass 'Parsed)
-> Maybe (LHsExpr (GhcPass 'Parsed))
delCons [Char]
func Int
pos [Char]
var (LHsExpr (GhcPass 'Parsed) -> [LHsExpr (GhcPass 'Parsed)]
fromApps -> (LHsExpr (GhcPass 'Parsed) -> Var_
forall a b. View a b => a -> b
view -> Var_ [Char]
x) : [LHsExpr (GhcPass 'Parsed)]
xs) | [Char]
func [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
x = do
    ([GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed))]
pre, (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed)) -> Var_
forall a b. View a b => a -> b
view -> Var_ [Char]
v) : [GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed))]
post) <- ([GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed))],
 [GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed))])
-> Maybe
     ([GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed))],
      [GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed))])
forall (f :: * -> *) a. Applicative f => a -> f a
pure (([GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed))],
  [GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed))])
 -> Maybe
      ([GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed))],
       [GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed))]))
-> ([GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed))],
    [GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed))])
-> Maybe
     ([GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed))],
      [GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed))])
forall a b. (a -> b) -> a -> b
$ Int
-> [GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed))]
-> ([GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed))],
    [GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed))])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
pos [LHsExpr (GhcPass 'Parsed)]
[GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed))]
xs
    Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ [Char]
v [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
var
    GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed))
-> Maybe (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed)))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed))
 -> Maybe (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed))))
-> GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed))
-> Maybe (GenLocated SrcSpanAnnA (HsExpr (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
$ GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed))
recursive GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed))
-> [GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed))]
-> [GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed))]
forall a. a -> [a] -> [a]
: [GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed))]
pre [GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed))]
-> [GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed))]
-> [GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed))]
forall a. [a] -> [a] -> [a]
++ [GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed))]
post
delCons [Char]
_ Int
_ [Char]
_ LHsExpr (GhcPass 'Parsed)
x = GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed))
-> Maybe (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed)))
forall (f :: * -> *) a. Applicative f => a -> f a
pure LHsExpr (GhcPass 'Parsed)
GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed))
x

eliminateArgs :: [String] -> LHsExpr GhcPs -> ([String], LHsExpr GhcPs)
eliminateArgs :: [[Char]]
-> LHsExpr (GhcPass 'Parsed)
-> ([[Char]], LHsExpr (GhcPass 'Parsed))
eliminateArgs [[Char]]
ps LHsExpr (GhcPass 'Parsed)
cons = ([[Char]] -> [[Char]]
forall a. [a] -> [a]
remove [[Char]]
ps, (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed))
 -> GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed)))
-> GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed))
-> GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed))
forall on. Uniplate on => (on -> on) -> on -> on
transform GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed))
-> GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed))
f LHsExpr (GhcPass 'Parsed)
GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed))
cons)
  where
    args :: [[GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed))]]
args = [[GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed))]
zs | GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed))
z : [GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed))]
zs <- (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed))
 -> [GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed))])
-> [GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed))]
-> [[GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed))]]
forall a b. (a -> b) -> [a] -> [b]
map LHsExpr (GhcPass 'Parsed) -> [LHsExpr (GhcPass 'Parsed)]
GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed))
-> [GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed))]
fromApps ([GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed))]
 -> [[GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed))]])
-> [GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed))]
-> [[GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed))]]
forall a b. (a -> b) -> a -> b
$ LHsExpr (GhcPass 'Parsed) -> [LHsExpr (GhcPass 'Parsed)]
universeApps LHsExpr (GhcPass 'Parsed)
cons, GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed))
-> GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed)) -> Bool
forall a. Data a => a -> a -> Bool
astEq GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed))
z GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed))
recursive]
    elim :: [Bool]
elim = [([GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed))] -> Bool)
-> [[GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed))]] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\[GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed))]
xs -> [GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed))] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed))]
xs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
i Bool -> Bool -> Bool
&& GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed)) -> Var_
forall a b. View a b => a -> b
view ([GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed))]
xs [GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed))]
-> Int -> GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed))
forall a. [a] -> Int -> a
!! Int
i) Var_ -> Var_ -> Bool
forall a. Eq a => a -> a -> Bool
== [Char] -> Var_
Var_ [Char]
p) [[GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed))]]
args | (Int
i, [Char]
p) <- Int -> [[Char]] -> [(Int, [Char])]
forall a b. Enum a => a -> [b] -> [(a, b)]
zipFrom Int
0 [[Char]]
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 :: GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed))
-> GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed))
f (LHsExpr (GhcPass 'Parsed) -> [LHsExpr (GhcPass 'Parsed)]
GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed))
-> [LHsExpr (GhcPass 'Parsed)]
fromApps -> LHsExpr (GhcPass 'Parsed)
x : [LHsExpr (GhcPass 'Parsed)]
xs) | GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed))
-> GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed)) -> Bool
forall a. Data a => a -> a -> Bool
astEq LHsExpr (GhcPass 'Parsed)
GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed))
x GenLocated SrcSpanAnnA (HsExpr (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)
GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed))
x GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed))
-> [GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed))]
-> [GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed))]
forall a. a -> [a] -> [a]
: [GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed))]
-> [GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed))]
forall a. [a] -> [a]
remove [LHsExpr (GhcPass 'Parsed)]
[GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed))]
xs
    f GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed))
x = GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed))
x


---------------------------------------------------------------------
-- FIND A BRANCH


findBranch :: LMatch GhcPs (LHsExpr GhcPs) -> Maybe Branch
findBranch :: LMatch (GhcPass 'Parsed) (LHsExpr (GhcPass 'Parsed))
-> Maybe Branch
findBranch (L _ 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 _ 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 l (GRHS _ [] body)]
                        , grhssLocalBinds :: forall p body. GRHSs p body -> HsLocalBinds p
grhssLocalBinds=EmptyLocalBinds XEmptyLocalBinds (GhcPass 'Parsed) (GhcPass 'Parsed)
_
                        }
            } <- Match
  (GhcPass 'Parsed)
  (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed)))
-> Maybe
     (Match
        (GhcPass 'Parsed)
        (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed))))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Match
  (GhcPass 'Parsed)
  (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed)))
x
  ([[Char]]
a, Int
b, BList
c) <- [LPat (GhcPass 'Parsed)] -> Maybe ([[Char]], 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
$ [Char]
-> [[Char]] -> Int -> BList -> LHsExpr (GhcPass 'Parsed) -> Branch
Branch (RdrName -> [Char]
occNameStr RdrName
name) [[Char]]
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)
GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Parsed))
body

findPat :: [LPat GhcPs] -> Maybe ([String], Int, BList)
findPat :: [LPat (GhcPass 'Parsed)] -> Maybe ([[Char]], Int, BList)
findPat [LPat (GhcPass 'Parsed)]
ps = do
  [Either [Char] BList]
ps <- (GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))
 -> Maybe (Either [Char] BList))
-> [GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))]
-> Maybe [Either [Char] BList]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM LPat (GhcPass 'Parsed) -> Maybe (Either [Char] BList)
GenLocated SrcSpanAnnA (Pat (GhcPass 'Parsed))
-> Maybe (Either [Char] BList)
readPat [LPat (GhcPass 'Parsed)]
[GenLocated SrcSpanAnnA (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 [Char] BList -> Bool) -> [Either [Char] BList] -> [Int]
forall a. (a -> Bool) -> [a] -> [Int]
findIndices Either [Char] BList -> Bool
forall a b. Either a b -> Bool
isRight [Either [Char] BList]
ps
  let ([[Char]]
left, [BList
right]) = [Either [Char] BList] -> ([[Char]], [BList])
forall a b. [Either a b] -> ([a], [b])
partitionEithers [Either [Char] BList]
ps

  ([[Char]], Int, BList) -> Maybe ([[Char]], Int, BList)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([[Char]]
left, Int
i, BList
right)

readPat :: LPat GhcPs -> Maybe (Either String BList)
readPat :: LPat (GhcPass 'Parsed) -> Maybe (Either [Char] BList)
readPat (LPat (GhcPass 'Parsed) -> PVar_
forall a b. View a b => a -> b
view -> PVar_ [Char]
x) = Either [Char] BList -> Maybe (Either [Char] BList)
forall a. a -> Maybe a
Just (Either [Char] BList -> Maybe (Either [Char] BList))
-> Either [Char] BList -> Maybe (Either [Char] BList)
forall a b. (a -> b) -> a -> b
$ [Char] -> Either [Char] BList
forall a b. a -> Either a b
Left [Char]
x
readPat (L _ (ParPat _ (L _ (ConPat _ (L _ n) (InfixCon (view -> PVar_ x) (view -> PVar_ xs))))))
 | RdrName
n RdrName -> RdrName -> Bool
forall a. Eq a => a -> a -> Bool
== RdrName
consDataCon_RDR = Either [Char] BList -> Maybe (Either [Char] BList)
forall a. a -> Maybe a
Just (Either [Char] BList -> Maybe (Either [Char] BList))
-> Either [Char] BList -> Maybe (Either [Char] BList)
forall a b. (a -> b) -> a -> b
$ BList -> Either [Char] BList
forall a b. b -> Either a b
Right (BList -> Either [Char] BList) -> BList -> Either [Char] BList
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char] -> BList
BCons [Char]
x [Char]
xs
readPat (L _ (ConPat _ (L _ n) (PrefixCon [] [])))
  | RdrName
n RdrName -> RdrName -> Bool
forall a. Eq a => a -> a -> Bool
== Name -> RdrName
nameRdrName Name
nilDataConName = Either [Char] BList -> Maybe (Either [Char] BList)
forall a. a -> Maybe a
Just (Either [Char] BList -> Maybe (Either [Char] BList))
-> Either [Char] BList -> Maybe (Either [Char] BList)
forall a b. (a -> b) -> a -> b
$ BList -> Either [Char] BList
forall a b. b -> Either a b
Right BList
BNil
readPat LPat (GhcPass 'Parsed)
_ = Maybe (Either [Char] BList)
forall a. Maybe a
Nothing