{-# LANGUAGE PatternGuards, ViewPatterns #-}

{-
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)
</TEST>
-}


module Hint.ListRec(listRecHint) where

import Hint.Type
import Hint.Util
import Data.List.Extra
import Data.Maybe
import Data.Either.Extra
import Control.Monad
import Refact.Types hiding (RType(Match))


listRecHint :: DeclHint
listRecHint :: DeclHint
listRecHint _ _ = (Decl_ -> [Idea]) -> [Decl_] -> [Idea]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Decl_ -> [Idea]
f ([Decl_] -> [Idea]) -> (Decl_ -> [Decl_]) -> Decl_ -> [Idea]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Decl_ -> [Decl_]
forall on. Uniplate on => on -> [on]
universe
    where
        f :: Decl_ -> [Idea]
f o :: Decl_
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 :: Decl_
x = Decl_
o
            (x :: ListCase
x, addCase :: Exp_ -> Decl_
addCase) <- Decl_ -> Maybe (ListCase, Exp_ -> Decl_)
findCase Decl_
x
            (use :: String
use,severity :: Severity
severity,x :: Exp_
x) <- ListCase -> Maybe (String, Severity, Exp_)
matchListRec ListCase
x
            let y :: Decl_
y = Exp_ -> Decl_
addCase Exp_
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` Decl_ -> [String]
forall a. AllVars a => a -> [String]
varss Decl_
y
            -- Maybe we can do better here maintaining source formatting?
            Idea -> Maybe Idea
forall (m :: * -> *) a. Monad m => a -> m a
return (Idea -> Maybe Idea) -> Idea -> Maybe Idea
forall a b. (a -> b) -> a -> b
$ Severity
-> String -> Decl_ -> Decl_ -> [Refactoring SrcSpan] -> Idea
forall (ast :: * -> *) a.
(Annotated ast, Pretty a, Pretty (ast SrcSpanInfo)) =>
Severity
-> String -> ast SrcSpanInfo -> a -> [Refactoring SrcSpan] -> Idea
idea Severity
severity ("Use " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
use) Decl_
o Decl_
y [RType
-> SrcSpan -> [(String, SrcSpan)] -> String -> Refactoring SrcSpan
forall a. RType -> a -> [(String, a)] -> String -> Refactoring a
Replace RType
Decl (Decl_ -> SrcSpan
forall (a :: * -> *). Annotated a => a SrcSpanInfo -> SrcSpan
toSS Decl_
o) [] (Decl_ -> String
forall a. Pretty a => a -> String
prettyPrint Decl_
y)]


recursiveStr :: String
recursiveStr = "_recursive_"
recursive :: Exp_
recursive = String -> Exp_
forall a. Named a => String -> a
toNamed String
recursiveStr

-- recursion parameters, nil-case, (x,xs,cons-case)
-- for cons-case delete any recursive calls with xs from them
-- any recursive calls are marked "_recursive_"
data ListCase = ListCase [String] Exp_ (String,String,Exp_)
                deriving Int -> ListCase -> String -> String
[ListCase] -> String -> String
ListCase -> String
(Int -> ListCase -> String -> String)
-> (ListCase -> String)
-> ([ListCase] -> String -> String)
-> Show ListCase
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [ListCase] -> String -> String
$cshowList :: [ListCase] -> String -> String
show :: ListCase -> String
$cshow :: ListCase -> String
showsPrec :: Int -> ListCase -> String -> String
$cshowsPrec :: Int -> ListCase -> String -> String
Show


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 -> 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)

-- function name, parameters, list-position, list-type, body (unmodified)
data Branch = Branch String [String] Int BList Exp_
              deriving Int -> Branch -> String -> String
[Branch] -> String -> String
Branch -> String
(Int -> Branch -> String -> String)
-> (Branch -> String)
-> ([Branch] -> String -> String)
-> Show Branch
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [Branch] -> String -> String
$cshowList :: [Branch] -> String -> String
show :: Branch -> String
$cshow :: Branch -> String
showsPrec :: Int -> Branch -> String -> String
$cshowsPrec :: Int -> Branch -> String -> String
Show



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


matchListRec :: ListCase -> Maybe (String,Severity,Exp_)
matchListRec :: ListCase -> Maybe (String, Severity, Exp_)
matchListRec o :: ListCase
o@(ListCase vs :: [String]
vs nil :: Exp_
nil (x :: String
x,xs :: String
xs,cons :: Exp_
cons))

    | [] <- [String]
vs, Exp_
nil Exp_ -> String -> Bool
forall a. Named a => a -> String -> Bool
~= "[]", InfixApp _ lhs :: Exp_
lhs c :: QOp SrcSpanInfo
c rhs :: Exp_
rhs <- Exp_
cons, QOp SrcSpanInfo -> Exp_
opExp QOp SrcSpanInfo
c Exp_ -> String -> Bool
forall a. Named a => a -> String -> Bool
~= ":"
    , Exp_ -> Exp_
fromParen Exp_
rhs Exp_ -> Exp_ -> Bool
forall (a :: * -> *) l1 l2.
(Annotated a, Eq (a ())) =>
a l1 -> a l2 -> Bool
=~= Exp_
recursive, String
xs String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` Exp_ -> [String]
forall a. FreeVars a => a -> [String]
vars Exp_
lhs
    = (String, Severity, Exp_) -> Maybe (String, Severity, Exp_)
forall a. a -> Maybe a
Just ((String, Severity, Exp_) -> Maybe (String, Severity, Exp_))
-> (String, Severity, Exp_) -> Maybe (String, Severity, Exp_)
forall a b. (a -> b) -> a -> b
$ (,,) "map" Severity
Warning (Exp_ -> (String, Severity, Exp_))
-> Exp_ -> (String, Severity, Exp_)
forall a b. (a -> b) -> a -> b
$ [Exp_] -> Exp_
forall l. (Data l, Default l) => [Exp l] -> Exp l
appsBracket
        [String -> Exp_
forall a. Named a => String -> a
toNamed "map", [String] -> Exp_ -> Exp_
niceLambda [String
x] Exp_
lhs, String -> Exp_
forall a. Named a => String -> a
toNamed String
xs]

    | [] <- [String]
vs, App2 op :: Exp_
op lhs :: Exp_
lhs rhs :: Exp_
rhs <- Exp_ -> App2
forall a b. View a b => a -> b
view Exp_
cons
    , Exp_ -> [String]
forall a. FreeVars a => a -> [String]
vars Exp_
op [String] -> [String] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`disjoint` [String
x,String
xs]
    , Exp_ -> Exp_
fromParen Exp_
rhs Exp_ -> Exp_ -> Bool
forall a. Eq a => a -> a -> Bool
== Exp_
recursive, String
xs String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` Exp_ -> [String]
forall a. FreeVars a => a -> [String]
vars Exp_
lhs
    = (String, Severity, Exp_) -> Maybe (String, Severity, Exp_)
forall a. a -> Maybe a
Just ((String, Severity, Exp_) -> Maybe (String, Severity, Exp_))
-> (String, Severity, Exp_) -> Maybe (String, Severity, Exp_)
forall a b. (a -> b) -> a -> b
$ (,,) "foldr" Severity
Suggestion (Exp_ -> (String, Severity, Exp_))
-> Exp_ -> (String, Severity, Exp_)
forall a b. (a -> b) -> a -> b
$ [Exp_] -> Exp_
forall l. (Data l, Default l) => [Exp l] -> Exp l
appsBracket
        [String -> Exp_
forall a. Named a => String -> a
toNamed "foldr", [String] -> Exp_ -> Exp_
niceLambda [String
x] (Exp_ -> Exp_) -> Exp_ -> Exp_
forall a b. (a -> b) -> a -> b
$ [Exp_] -> Exp_
forall l. (Data l, Default l) => [Exp l] -> Exp l
appsBracket [Exp_
op,Exp_
lhs], Exp_
nil, String -> Exp_
forall a. Named a => String -> a
toNamed String
xs]

    | [v :: String
v] <- [String]
vs, Exp_ -> Var_
forall a b. View a b => a -> b
view Exp_
nil Var_ -> Var_ -> Bool
forall a. Eq a => a -> a -> Bool
== String -> Var_
Var_ String
v, App _ r :: Exp_
r lhs :: Exp_
lhs <- Exp_
cons, Exp_
r Exp_ -> Exp_ -> Bool
forall (a :: * -> *) l1 l2.
(Annotated a, Eq (a ())) =>
a l1 -> a l2 -> Bool
=~= Exp_
recursive
    , String
xs String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` Exp_ -> [String]
forall a. FreeVars a => a -> [String]
vars Exp_
lhs
    = (String, Severity, Exp_) -> Maybe (String, Severity, Exp_)
forall a. a -> Maybe a
Just ((String, Severity, Exp_) -> Maybe (String, Severity, Exp_))
-> (String, Severity, Exp_) -> Maybe (String, Severity, Exp_)
forall a b. (a -> b) -> a -> b
$ (,,) "foldl" Severity
Suggestion (Exp_ -> (String, Severity, Exp_))
-> Exp_ -> (String, Severity, Exp_)
forall a b. (a -> b) -> a -> b
$ [Exp_] -> Exp_
forall l. (Data l, Default l) => [Exp l] -> Exp l
appsBracket
        [String -> Exp_
forall a. Named a => String -> a
toNamed "foldl", [String] -> Exp_ -> Exp_
niceLambda [String
v,String
x] Exp_
lhs, String -> Exp_
forall a. Named a => String -> a
toNamed String
v, String -> Exp_
forall a. Named a => String -> a
toNamed String
xs]

    | [v :: String
v] <- [String]
vs, App _ ret :: Exp_
ret res :: Exp_
res <- Exp_
nil, Exp_ -> Bool
isReturn Exp_
ret, Exp_
res Exp_ -> String -> Bool
forall a. Named a => a -> String -> Bool
~= "()" Bool -> Bool -> Bool
|| Exp_ -> Var_
forall a b. View a b => a -> b
view Exp_
res Var_ -> Var_ -> Bool
forall a. Eq a => a -> a -> Bool
== String -> Var_
Var_ String
v
    , [Generator _ (Pat SrcSpanInfo -> PVar_
forall a b. View a b => a -> b
view -> PVar_ b1 :: String
b1) e :: Exp_
e, Qualifier _ (Exp_ -> Exp_
fromParen -> App _ r :: Exp_
r (Exp_ -> Var_
forall a b. View a b => a -> b
view -> Var_ b2 :: String
b2))] <- Exp_ -> [Stmt SrcSpanInfo]
asDo Exp_
cons
    , String
b1 String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
b2, Exp_
r Exp_ -> Exp_ -> Bool
forall a. Eq a => a -> a -> Bool
== Exp_
recursive, String
xs String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` Exp_ -> [String]
forall a. FreeVars a => a -> [String]
vars Exp_
e
    , String
name <- "foldM" String -> String -> String
forall a. [a] -> [a] -> [a]
++ ['_' | Exp_
res Exp_ -> String -> Bool
forall a. Named a => a -> String -> Bool
~= "()"]
    = (String, Severity, Exp_) -> Maybe (String, Severity, Exp_)
forall a. a -> Maybe a
Just ((String, Severity, Exp_) -> Maybe (String, Severity, Exp_))
-> (String, Severity, Exp_) -> Maybe (String, Severity, Exp_)
forall a b. (a -> b) -> a -> b
$ (,,) String
name Severity
Suggestion (Exp_ -> (String, Severity, Exp_))
-> Exp_ -> (String, Severity, Exp_)
forall a b. (a -> b) -> a -> b
$ [Exp_] -> Exp_
forall l. (Data l, Default l) => [Exp l] -> Exp l
appsBracket
        [String -> Exp_
forall a. Named a => String -> a
toNamed String
name, [String] -> Exp_ -> Exp_
niceLambda [String
v,String
x] Exp_
e, String -> Exp_
forall a. Named a => String -> a
toNamed String
v, String -> Exp_
forall a. Named a => String -> a
toNamed String
xs]

    | Bool
otherwise = Maybe (String, Severity, Exp_)
forall a. Maybe a
Nothing


-- Very limited attempt to convert >>= to do, only useful for foldM/foldM_
asDo :: Exp_ -> [Stmt S]
asDo :: Exp_ -> [Stmt SrcSpanInfo]
asDo (Exp_ -> App2
forall a b. View a b => a -> b
view -> App2 bind :: Exp_
bind lhs :: Exp_
lhs (Lambda _ [v :: Pat SrcSpanInfo
v] rhs :: Exp_
rhs)) = [SrcSpanInfo -> Pat SrcSpanInfo -> Exp_ -> Stmt SrcSpanInfo
forall l. l -> Pat l -> Exp l -> Stmt l
Generator SrcSpanInfo
an Pat SrcSpanInfo
v Exp_
lhs, SrcSpanInfo -> Exp_ -> Stmt SrcSpanInfo
forall l. l -> Exp l -> Stmt l
Qualifier SrcSpanInfo
an Exp_
rhs]
asDo (Do _ x :: [Stmt SrcSpanInfo]
x) = [Stmt SrcSpanInfo]
x
asDo x :: Exp_
x = [SrcSpanInfo -> Exp_ -> Stmt SrcSpanInfo
forall l. l -> Exp l -> Stmt l
Qualifier SrcSpanInfo
an Exp_
x]

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

findCase :: Decl_ -> Maybe (ListCase, Exp_ -> Decl_)
findCase :: Decl_ -> Maybe (ListCase, Exp_ -> Decl_)
findCase x :: Decl_
x = do
    FunBind _ [x1 :: Match SrcSpanInfo
x1,x2 :: Match SrcSpanInfo
x2] <- Decl_ -> Maybe Decl_
forall (m :: * -> *) a. Monad m => a -> m a
return Decl_
x
    Branch name1 :: String
name1 ps1 :: [String]
ps1 p1 :: Int
p1 c1 :: BList
c1 b1 :: Exp_
b1 <- Match SrcSpanInfo -> Maybe Branch
findBranch Match SrcSpanInfo
x1
    Branch name2 :: String
name2 ps2 :: [String]
ps2 p2 :: Int
p2 c2 :: BList
c2 b2 :: Exp_
b2 <- Match SrcSpanInfo -> Maybe Branch
findBranch Match SrcSpanInfo
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)
    [(BNil, b1 :: Exp_
b1), (BCons x :: String
x xs :: String
xs, b2 :: Exp_
b2)] <- [(BList, Exp_)] -> Maybe [(BList, Exp_)]
forall (m :: * -> *) a. Monad m => a -> m a
return ([(BList, Exp_)] -> Maybe [(BList, Exp_)])
-> [(BList, Exp_)] -> Maybe [(BList, Exp_)]
forall a b. (a -> b) -> a -> b
$ ((BList, Exp_) -> BList) -> [(BList, Exp_)] -> [(BList, Exp_)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (BList, Exp_) -> BList
forall a b. (a, b) -> a
fst [(BList
c1,Exp_
b1), (BList
c2,Exp_
b2)]
    Exp_
b2 <- (Exp_ -> Maybe Exp_) -> Exp_ -> Maybe Exp_
forall (m :: * -> *). Monad m => (Exp_ -> m Exp_) -> Exp_ -> m Exp_
transformAppsM (String -> Int -> String -> Exp_ -> Maybe Exp_
delCons String
name1 Int
p1 String
xs) Exp_
b2
    (ps :: [String]
ps,b2 :: Exp_
b2) <- ([String], Exp_) -> Maybe ([String], Exp_)
forall (m :: * -> *) a. Monad m => a -> m a
return (([String], Exp_) -> Maybe ([String], Exp_))
-> ([String], Exp_) -> Maybe ([String], Exp_)
forall a b. (a -> b) -> a -> b
$ [String] -> Exp_ -> ([String], Exp_)
eliminateArgs [String]
ps1 Exp_
b2

    let ps12 :: [Pat SrcSpanInfo]
ps12 = let (a :: [String]
a,b :: [String]
b) = Int -> [String] -> ([String], [String])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
p1 [String]
ps1 in (String -> Pat SrcSpanInfo) -> [String] -> [Pat SrcSpanInfo]
forall a b. (a -> b) -> [a] -> [b]
map String -> Pat SrcSpanInfo
forall a. Named a => String -> a
toNamed ([String] -> [Pat SrcSpanInfo]) -> [String] -> [Pat SrcSpanInfo]
forall a b. (a -> b) -> a -> b
$ [String]
a [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ String
xs String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
b
    (ListCase, Exp_ -> Decl_) -> Maybe (ListCase, Exp_ -> Decl_)
forall (m :: * -> *) a. Monad m => a -> m a
return ([String] -> Exp_ -> (String, String, Exp_) -> ListCase
ListCase [String]
ps Exp_
b1 (String
x,String
xs,Exp_
b2)
           ,\e :: Exp_
e -> SrcSpanInfo -> [Match SrcSpanInfo] -> Decl_
forall l. l -> [Match l] -> Decl l
FunBind SrcSpanInfo
an [SrcSpanInfo
-> Name SrcSpanInfo
-> [Pat SrcSpanInfo]
-> Rhs SrcSpanInfo
-> Maybe (Binds SrcSpanInfo)
-> Match SrcSpanInfo
forall l.
l -> Name l -> [Pat l] -> Rhs l -> Maybe (Binds l) -> Match l
Match SrcSpanInfo
an (String -> Name SrcSpanInfo
forall a. Named a => String -> a
toNamed String
name1) [Pat SrcSpanInfo]
ps12 (SrcSpanInfo -> Exp_ -> Rhs SrcSpanInfo
forall l. l -> Exp l -> Rhs l
UnGuardedRhs SrcSpanInfo
an Exp_
e) Maybe (Binds SrcSpanInfo)
forall a. Maybe a
Nothing])


delCons :: String -> Int -> String -> Exp_ -> Maybe Exp_
delCons :: String -> Int -> String -> Exp_ -> Maybe Exp_
delCons func :: String
func pos :: Int
pos var :: String
var (Exp_ -> [Exp_]
fromApps -> (Exp_ -> Var_
forall a b. View a b => a -> b
view -> Var_ x :: String
x):xs :: [Exp_]
xs) | String
func String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
x = do
    (pre :: [Exp_]
pre, (Exp_ -> Var_
forall a b. View a b => a -> b
view -> Var_ v :: String
v):post :: [Exp_]
post) <- ([Exp_], [Exp_]) -> Maybe ([Exp_], [Exp_])
forall (m :: * -> *) a. Monad m => a -> m a
return (([Exp_], [Exp_]) -> Maybe ([Exp_], [Exp_]))
-> ([Exp_], [Exp_]) -> Maybe ([Exp_], [Exp_])
forall a b. (a -> b) -> a -> b
$ Int -> [Exp_] -> ([Exp_], [Exp_])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
pos [Exp_]
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
    Exp_ -> Maybe Exp_
forall (m :: * -> *) a. Monad m => a -> m a
return (Exp_ -> Maybe Exp_) -> Exp_ -> Maybe Exp_
forall a b. (a -> b) -> a -> b
$ [Exp_] -> Exp_
apps ([Exp_] -> Exp_) -> [Exp_] -> Exp_
forall a b. (a -> b) -> a -> b
$ Exp_
recursive Exp_ -> [Exp_] -> [Exp_]
forall a. a -> [a] -> [a]
: [Exp_]
pre [Exp_] -> [Exp_] -> [Exp_]
forall a. [a] -> [a] -> [a]
++ [Exp_]
post
delCons _ _ _ x :: Exp_
x = Exp_ -> Maybe Exp_
forall (m :: * -> *) a. Monad m => a -> m a
return Exp_
x


eliminateArgs :: [String] -> Exp_ -> ([String], Exp_)
eliminateArgs :: [String] -> Exp_ -> ([String], Exp_)
eliminateArgs ps :: [String]
ps cons :: Exp_
cons = ([String] -> [String]
forall a. [a] -> [a]
remove [String]
ps, (Exp_ -> Exp_) -> Exp_ -> Exp_
forall on. Uniplate on => (on -> on) -> on -> on
transform Exp_ -> Exp_
f Exp_
cons)
    where
        args :: [[Exp_]]
args = [[Exp_]
zs | z :: Exp_
z:zs :: [Exp_]
zs <- (Exp_ -> [Exp_]) -> [Exp_] -> [[Exp_]]
forall a b. (a -> b) -> [a] -> [b]
map Exp_ -> [Exp_]
fromApps ([Exp_] -> [[Exp_]]) -> [Exp_] -> [[Exp_]]
forall a b. (a -> b) -> a -> b
$ Exp_ -> [Exp_]
universeApps Exp_
cons, Exp_
z Exp_ -> Exp_ -> Bool
forall (a :: * -> *) l1 l2.
(Annotated a, Eq (a ())) =>
a l1 -> a l2 -> Bool
=~= Exp_
recursive]
        elim :: [Bool]
elim = [([Exp_] -> Bool) -> [[Exp_]] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\xs :: [Exp_]
xs -> [Exp_] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Exp_]
xs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
i Bool -> Bool -> Bool
&& Exp_ -> Var_
forall a b. View a b => a -> b
view ([Exp_]
xs [Exp_] -> Int -> Exp_
forall a. [a] -> Int -> a
!! Int
i) Var_ -> Var_ -> Bool
forall a. Eq a => a -> a -> Bool
== String -> Var_
Var_ String
p) [[Exp_]]
args | (i :: Int
i,p :: String
p) <- [Int] -> [String] -> [(Int, String)]
forall a b. [a] -> [b] -> [(a, b)]
zip [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 (\b :: Bool
b x :: a
x -> [a
x | Bool -> Bool
not Bool
b]) [Bool]
elim

        f :: Exp_ -> Exp_
f (Exp_ -> [Exp_]
fromApps -> x :: Exp_
x:xs :: [Exp_]
xs) | Exp_
x Exp_ -> Exp_ -> Bool
forall a. Eq a => a -> a -> Bool
== Exp_
recursive = [Exp_] -> Exp_
apps ([Exp_] -> Exp_) -> [Exp_] -> Exp_
forall a b. (a -> b) -> a -> b
$ Exp_
x Exp_ -> [Exp_] -> [Exp_]
forall a. a -> [a] -> [a]
: [Exp_] -> [Exp_]
forall a. [a] -> [a]
remove [Exp_]
xs
        f x :: Exp_
x = Exp_
x


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

findBranch :: Match S -> Maybe Branch
findBranch :: Match SrcSpanInfo -> Maybe Branch
findBranch x :: Match SrcSpanInfo
x = do
    Match _ name :: Name SrcSpanInfo
name ps :: [Pat SrcSpanInfo]
ps (UnGuardedRhs _ bod :: Exp_
bod) Nothing <- Match SrcSpanInfo -> Maybe (Match SrcSpanInfo)
forall (m :: * -> *) a. Monad m => a -> m a
return Match SrcSpanInfo
x
    (a :: [String]
a,b :: Int
b,c :: BList
c) <- [Pat SrcSpanInfo] -> Maybe ([String], Int, BList)
findPat [Pat SrcSpanInfo]
ps
    Branch -> Maybe Branch
forall (m :: * -> *) a. Monad m => a -> m a
return (Branch -> Maybe Branch) -> Branch -> Maybe Branch
forall a b. (a -> b) -> a -> b
$ String -> [String] -> Int -> BList -> Exp_ -> Branch
Branch (Name SrcSpanInfo -> String
forall a. Named a => a -> String
fromNamed Name SrcSpanInfo
name) [String]
a Int
b BList
c (Exp_ -> Branch) -> Exp_ -> Branch
forall a b. (a -> b) -> a -> b
$ Exp_ -> Exp_
simplifyExp Exp_
bod


findPat :: [Pat_] -> Maybe ([String], Int, BList)
findPat :: [Pat SrcSpanInfo] -> Maybe ([String], Int, BList)
findPat ps :: [Pat SrcSpanInfo]
ps = do
    [Either String BList]
ps <- (Pat SrcSpanInfo -> Maybe (Either String BList))
-> [Pat SrcSpanInfo] -> Maybe [Either String BList]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Pat SrcSpanInfo -> Maybe (Either String BList)
readPat [Pat SrcSpanInfo]
ps
    [i :: Int
i] <- [Int] -> Maybe [Int]
forall (m :: * -> *) a. Monad m => a -> m a
return ([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 (left :: [String]
left,[right :: 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 (m :: * -> *) a. Monad m => a -> m a
return ([String]
left, Int
i, BList
right)


readPat :: Pat_ -> Maybe (Either String BList)
readPat :: Pat SrcSpanInfo -> Maybe (Either String BList)
readPat (Pat SrcSpanInfo -> PVar_
forall a b. View a b => a -> b
view -> PVar_ x :: 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 (PParen _ (PInfixApp _ (Pat SrcSpanInfo -> PVar_
forall a b. View a b => a -> b
view -> PVar_ x :: String
x) (Special _ Cons{}) (Pat SrcSpanInfo -> PVar_
forall a b. View a b => a -> b
view -> PVar_ xs :: String
xs))) = 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 (PList _ []) = 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 _ = Maybe (Either String BList)
forall a. Maybe a
Nothing