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

{-
    Find and match:

<TEST>
yes = 1:2:[] -- [1,2]
yes = ['h','e','l','l','o']
yes (1:2:[]) = 1 -- [1,2]
yes ['h','e'] = 1

-- [a]++b -> a : b, but only if not in a chain of ++'s
yes = [x] ++ xs -- x : xs
no = "x" ++ xs
no = [x] ++ xs ++ ys
no = xs ++ [x] ++ ys
yes = [if a then b else c] ++ xs -- (if a then b else c) : xs
yes = [1] : [2] : [3] : [4] : [5] : [] -- [[1], [2], [3], [4], [5]]
yes = if x == e then l2 ++ xs else [x] ++ check_elem xs -- x : check_elem xs
data Yes = Yes (Maybe [Char]) -- Maybe String
yes = y :: [Char] -> a -- String -> a
instance C [Char]
foo = [a b] ++ xs -- a b : xs
foo = [myexpr | True, a] -- [myexpr | a]
foo = [myexpr | False] -- []
foo = map f [x + 1 | x <- [1..10]] -- [f (x + 1) | x <- [1..10]]
foo = [x + 1 | x <- [1..10], feature] -- [x + 1 | feature, x <- [1..10]]
foo = [x + 1 | x <- [1..10], even x]
foo = [x + 1 | x <- [1..10], even x, dont_reoder_guards]
foo = [x + 1 | x <- [1..10], let y = even x, y]
foo = [x + 1 | x <- [1..10], let q = even 1, q] -- [x + 1 | let q = even 1, q, x <- [1..10]]
foo = [fooValue | Foo{..} <- y, fooField]
issue619 = [pkgJobs | Pkg{pkgGpd, pkgJobs} <- pkgs, not $ null $ C.condTestSuites pkgGpd]
</TEST>
-}

module Hint.List(listHint) where

import Control.Applicative
import Hint.Type
import Data.List.Extra
import Data.Maybe
import Prelude
import Refact.Types hiding (SrcSpan)
import qualified Refact.Types as R


listHint :: DeclHint
listHint :: DeclHint
listHint _ _ = Decl_ -> [Idea]
listDecl

listDecl :: Decl_ -> [Idea]
listDecl :: Decl_ -> [Idea]
listDecl x :: Decl_
x =
    (Exp_ -> [Idea]) -> [Exp_] -> [Idea]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Bool -> Exp_ -> [Idea]
listExp Bool
False) (Decl_ -> [Exp_]
forall from to. Biplate from to => from -> [to]
childrenBi Decl_
x) [Idea] -> [Idea] -> [Idea]
forall a. [a] -> [a] -> [a]
++
    Decl_ -> [Idea]
stringType Decl_
x [Idea] -> [Idea] -> [Idea]
forall a. [a] -> [a] -> [a]
++
    (Pat_ -> [Idea]) -> [Pat_] -> [Idea]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Pat_ -> [Idea]
listPat (Decl_ -> [Pat_]
forall from to. Biplate from to => from -> [to]
childrenBi Decl_
x) [Idea] -> [Idea] -> [Idea]
forall a. [a] -> [a] -> [a]
++
    (Exp_ -> [Idea]) -> [Exp_] -> [Idea]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Exp_ -> [Idea]
listComp (Decl_ -> [Exp_]
forall from to. Biplate from to => from -> [to]
universeBi Decl_
x)

listComp :: Exp_ -> [Idea]
listComp :: Exp_ -> [Idea]
listComp o :: Exp_
o@(ListComp a :: S
a e :: Exp_
e xs :: [QualStmt S]
xs)
    | "False" [Char] -> [[Char]] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [[Char]]
cons = [[Char] -> Exp_ -> Exp_ -> [Refactoring SrcSpan] -> Idea
forall (ast :: * -> *) a.
(Annotated ast, Pretty a, Pretty (ast S)) =>
[Char] -> ast S -> a -> [Refactoring SrcSpan] -> Idea
suggest "Short-circuited list comprehension" Exp_
o Exp_
o' (Exp_ -> Exp_ -> [Refactoring SrcSpan]
suggestExpr Exp_
o Exp_
o')]
    | "True" [Char] -> [[Char]] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [[Char]]
cons = [[Char] -> Exp_ -> Exp_ -> [Refactoring SrcSpan] -> Idea
forall (ast :: * -> *) a.
(Annotated ast, Pretty a, Pretty (ast S)) =>
[Char] -> ast S -> a -> [Refactoring SrcSpan] -> Idea
suggest "Redundant True guards" Exp_
o Exp_
o2 (Exp_ -> Exp_ -> [Refactoring SrcSpan]
suggestExpr Exp_
o Exp_
o2)]
    | [QualStmt S]
xs [QualStmt S] -> [QualStmt S] -> Bool
forall a. Eq a => a -> a -> Bool
/= [QualStmt S]
ys = [[Char] -> Exp_ -> Exp_ -> [Refactoring SrcSpan] -> Idea
forall (ast :: * -> *) a.
(Annotated ast, Pretty a, Pretty (ast S)) =>
[Char] -> ast S -> a -> [Refactoring SrcSpan] -> Idea
suggest "Move guards forward" Exp_
o Exp_
o3 (Exp_ -> Exp_ -> [Refactoring SrcSpan]
suggestExpr Exp_
o Exp_
o3)]
    where
        ys :: [QualStmt S]
ys = [QualStmt S] -> [QualStmt S]
moveGuardsForward [QualStmt S]
xs
        o' :: Exp_
o' = S -> [Exp_] -> Exp_
forall l. l -> [Exp l] -> Exp l
List S
an []
        o2 :: Exp_
o2 = S -> Exp_ -> [QualStmt S] -> Exp_
forall l. l -> Exp l -> [QualStmt l] -> Exp l
ListComp S
a Exp_
e ([QualStmt S] -> Exp_) -> [QualStmt S] -> Exp_
forall a b. (a -> b) -> a -> b
$ (QualStmt S -> Bool) -> [QualStmt S] -> [QualStmt S]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Maybe [Char] -> Maybe [Char] -> Bool
forall a. Eq a => a -> a -> Bool
/= [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just "True") (Maybe [Char] -> Bool)
-> (QualStmt S -> Maybe [Char]) -> QualStmt S -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QualStmt S -> Maybe [Char]
forall l. Named (QName l) => QualStmt l -> Maybe [Char]
qualCon) [QualStmt S]
xs
        o3 :: Exp_
o3 = S -> Exp_ -> [QualStmt S] -> Exp_
forall l. l -> Exp l -> [QualStmt l] -> Exp l
ListComp S
a Exp_
e [QualStmt S]
ys
        cons :: [[Char]]
cons = (QualStmt S -> Maybe [Char]) -> [QualStmt S] -> [[Char]]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe QualStmt S -> Maybe [Char]
forall l. Named (QName l) => QualStmt l -> Maybe [Char]
qualCon [QualStmt S]
xs
        qualCon :: QualStmt l -> Maybe [Char]
qualCon (QualStmt _ (Qualifier _ (Con _ x :: QName l
x))) = [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just ([Char] -> Maybe [Char]) -> [Char] -> Maybe [Char]
forall a b. (a -> b) -> a -> b
$ QName l -> [Char]
forall a. Named a => a -> [Char]
fromNamed QName l
x
        qualCon _ = Maybe [Char]
forall a. Maybe a
Nothing
listComp o :: Exp_
o@(Exp_ -> App2
forall a b. View a b => a -> b
view -> App2 mp :: Exp_
mp f :: Exp_
f (ListComp a :: S
a e :: Exp_
e xs :: [QualStmt S]
xs)) | Exp_
mp Exp_ -> [Char] -> Bool
forall a. Named a => a -> [Char] -> Bool
~= "map" =
    [[Char] -> Exp_ -> Exp_ -> [Refactoring SrcSpan] -> Idea
forall (ast :: * -> *) a.
(Annotated ast, Pretty a, Pretty (ast S)) =>
[Char] -> ast S -> a -> [Refactoring SrcSpan] -> Idea
suggest "Move map inside list comprehension" Exp_
o Exp_
o2 (Exp_ -> Exp_ -> [Refactoring SrcSpan]
suggestExpr Exp_
o Exp_
o2)]
    where o2 :: Exp_
o2 = S -> Exp_ -> [QualStmt S] -> Exp_
forall l. l -> Exp l -> [QualStmt l] -> Exp l
ListComp S
a (S -> Exp_ -> Exp_ -> Exp_
forall l. l -> Exp l -> Exp l -> Exp l
App S
an (Exp_ -> Exp_
forall l. (Data l, Default l) => Exp l -> Exp l
paren Exp_
f) (Exp_ -> Exp_
forall l. (Data l, Default l) => Exp l -> Exp l
paren Exp_
e)) [QualStmt S]
xs
listComp _ = []

suggestExpr :: Exp_ -> Exp_ -> [Refactoring R.SrcSpan]
suggestExpr :: Exp_ -> Exp_ -> [Refactoring SrcSpan]
suggestExpr o :: Exp_
o o2 :: Exp_
o2 = [RType
-> SrcSpan -> [([Char], SrcSpan)] -> [Char] -> Refactoring SrcSpan
forall a. RType -> a -> [([Char], a)] -> [Char] -> Refactoring a
Replace RType
Expr (Exp_ -> SrcSpan
forall (a :: * -> *). Annotated a => a S -> SrcSpan
toSS Exp_
o) [] (Exp_ -> [Char]
forall a. Pretty a => a -> [Char]
prettyPrint Exp_
o2)]

-- Move all the list comp guards as far forward as they can go
moveGuardsForward :: [QualStmt S] -> [QualStmt S]
moveGuardsForward :: [QualStmt S] -> [QualStmt S]
moveGuardsForward = [QualStmt S] -> [QualStmt S]
forall a. [a] -> [a]
reverse ([QualStmt S] -> [QualStmt S])
-> ([QualStmt S] -> [QualStmt S]) -> [QualStmt S] -> [QualStmt S]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [QualStmt S] -> [QualStmt S] -> [QualStmt S]
forall l.
(Ord l, Data l) =>
[QualStmt l] -> [QualStmt l] -> [QualStmt l]
f [] ([QualStmt S] -> [QualStmt S])
-> ([QualStmt S] -> [QualStmt S]) -> [QualStmt S] -> [QualStmt S]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [QualStmt S] -> [QualStmt S]
forall a. [a] -> [a]
reverse
    where
        f :: [QualStmt l] -> [QualStmt l] -> [QualStmt l]
f guards :: [QualStmt l]
guards (x :: QualStmt l
x@(QualStmt _ (Generator _ p :: Pat l
p _)):xs :: [QualStmt l]
xs) = [QualStmt l] -> [QualStmt l]
forall a. [a] -> [a]
reverse [QualStmt l]
stop [QualStmt l] -> [QualStmt l] -> [QualStmt l]
forall a. [a] -> [a] -> [a]
++ QualStmt l
x QualStmt l -> [QualStmt l] -> [QualStmt l]
forall a. a -> [a] -> [a]
: [QualStmt l] -> [QualStmt l] -> [QualStmt l]
f [QualStmt l]
move [QualStmt l]
xs
            where (move :: [QualStmt l]
move, stop :: [QualStmt l]
stop) = (QualStmt l -> Bool)
-> [QualStmt l] -> ([QualStmt l], [QualStmt l])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (if (PatField S -> Bool) -> [PatField S] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any PatField S -> Bool
forall l. PatField l -> Bool
isPFieldWildcard (QualStmt l -> [PatField S]
forall x (f :: * -> *). (Data x, Data (f S)) => x -> [f S]
universeS QualStmt l
x) then Bool -> QualStmt l -> Bool
forall a b. a -> b -> a
const Bool
False else \x :: QualStmt l
x -> Pat l -> [[Char]]
forall a. AllVars a => a -> [[Char]]
pvars Pat l
p [[Char]] -> [[Char]] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`disjoint` QualStmt l -> [[Char]]
forall x. Data x => x -> [[Char]]
vars' QualStmt l
x) [QualStmt l]
guards
        f guards :: [QualStmt l]
guards (x :: QualStmt l
x@(QualStmt _ Qualifier{}):xs :: [QualStmt l]
xs) = [QualStmt l] -> [QualStmt l] -> [QualStmt l]
f (QualStmt l
xQualStmt l -> [QualStmt l] -> [QualStmt l]
forall a. a -> [a] -> [a]
:[QualStmt l]
guards) [QualStmt l]
xs
        f guards :: [QualStmt l]
guards (x :: QualStmt l
x@(QualStmt _ LetStmt{}):xs :: [QualStmt l]
xs) = [QualStmt l] -> [QualStmt l] -> [QualStmt l]
f (QualStmt l
xQualStmt l -> [QualStmt l] -> [QualStmt l]
forall a. a -> [a] -> [a]
:[QualStmt l]
guards) [QualStmt l]
xs
        f guards :: [QualStmt l]
guards xs :: [QualStmt l]
xs = [QualStmt l] -> [QualStmt l]
forall a. [a] -> [a]
reverse [QualStmt l]
guards [QualStmt l] -> [QualStmt l] -> [QualStmt l]
forall a. [a] -> [a] -> [a]
++ [QualStmt l]
xs

        -- the type QualStmt doesn't have a Var instance, so fake something that works
        vars' :: x -> [[Char]]
vars' x :: x
x = [QName S -> [Char]
forall a. Pretty a => a -> [Char]
prettyPrint QName S
a | Var _ a :: QName S
a <- x -> [Exp_]
forall x (f :: * -> *). (Data x, Data (f S)) => x -> [f S]
universeS x
x]


-- boolean = are you in a ++ chain
listExp :: Bool -> Exp_ -> [Idea]
listExp :: Bool -> Exp_ -> [Idea]
listExp b :: Bool
b (Exp_ -> Exp_
fromParen -> Exp_
x) =
        if [Idea] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Idea]
res then (Exp_ -> [Idea]) -> [Exp_] -> [Idea]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Bool -> Exp_ -> [Idea]
listExp (Bool -> Exp_ -> [Idea]) -> Bool -> Exp_ -> [Idea]
forall a b. (a -> b) -> a -> b
$ Exp_ -> Bool
forall a. View a App2 => a -> Bool
isAppend Exp_
x) ([Exp_] -> [Idea]) -> [Exp_] -> [Idea]
forall a b. (a -> b) -> a -> b
$ Exp_ -> [Exp_]
forall on. Uniplate on => on -> [on]
children Exp_
x else [[Idea] -> Idea
forall a. [a] -> a
head [Idea]
res]
    where
        res :: [Idea]
res = [[Char] -> Exp_ -> Exp_ -> [Refactoring SrcSpan] -> Idea
forall (ast :: * -> *) a.
(Annotated ast, Pretty a, Pretty (ast S)) =>
[Char] -> ast S -> a -> [Refactoring SrcSpan] -> Idea
suggest [Char]
name Exp_
x Exp_
x2 [Refactoring SrcSpan
r] | (name :: [Char]
name,f :: Bool -> Exp_ -> Maybe (Exp_, [([Char], SrcSpan)], [Char])
f) <- [([Char],
  Bool -> Exp_ -> Maybe (Exp_, [([Char], SrcSpan)], [Char]))]
checks
                                  , Just (x2 :: Exp_
x2, subts :: [([Char], SrcSpan)]
subts, temp :: [Char]
temp) <- [Bool -> Exp_ -> Maybe (Exp_, [([Char], SrcSpan)], [Char])
f Bool
b Exp_
x]
                                  , let r :: Refactoring SrcSpan
r = RType
-> SrcSpan -> [([Char], SrcSpan)] -> [Char] -> Refactoring SrcSpan
forall a. RType -> a -> [([Char], a)] -> [Char] -> Refactoring a
Replace RType
Expr (Exp_ -> SrcSpan
forall (a :: * -> *). Annotated a => a S -> SrcSpan
toSS Exp_
x) [([Char], SrcSpan)]
subts [Char]
temp ]

listPat :: Pat_ -> [Idea]
listPat :: Pat_ -> [Idea]
listPat x :: Pat_
x = if [Idea] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Idea]
res then (Pat_ -> [Idea]) -> [Pat_] -> [Idea]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Pat_ -> [Idea]
listPat ([Pat_] -> [Idea]) -> [Pat_] -> [Idea]
forall a b. (a -> b) -> a -> b
$ Pat_ -> [Pat_]
forall on. Uniplate on => on -> [on]
children Pat_
x else [[Idea] -> Idea
forall a. [a] -> a
head [Idea]
res]
    where res :: [Idea]
res = [[Char] -> Pat_ -> Pat_ -> [Refactoring SrcSpan] -> Idea
forall (ast :: * -> *) a.
(Annotated ast, Pretty a, Pretty (ast S)) =>
[Char] -> ast S -> a -> [Refactoring SrcSpan] -> Idea
suggest [Char]
name Pat_
x Pat_
x2 [Refactoring SrcSpan
r]
                  | (name :: [Char]
name,f :: Pat_ -> Maybe (Pat_, [([Char], SrcSpan)], [Char])
f) <- [([Char], Pat_ -> Maybe (Pat_, [([Char], SrcSpan)], [Char]))]
pchecks
                  , Just (x2 :: Pat_
x2, subts :: [([Char], SrcSpan)]
subts, temp :: [Char]
temp) <- [Pat_ -> Maybe (Pat_, [([Char], SrcSpan)], [Char])
f Pat_
x]
                  , let r :: Refactoring SrcSpan
r = RType
-> SrcSpan -> [([Char], SrcSpan)] -> [Char] -> Refactoring SrcSpan
forall a. RType -> a -> [([Char], a)] -> [Char] -> Refactoring a
Replace RType
Pattern (Pat_ -> SrcSpan
forall (a :: * -> *). Annotated a => a S -> SrcSpan
toSS Pat_
x) [([Char], SrcSpan)]
subts [Char]
temp ]

isAppend :: a -> Bool
isAppend (a -> App2
forall a b. View a b => a -> b
view -> App2 op :: Exp_
op _ _) = Exp_
op Exp_ -> [Char] -> Bool
forall a. Named a => a -> [Char] -> Bool
~= "++"
isAppend _ = Bool
False


checks :: [([Char],
  Bool -> Exp_ -> Maybe (Exp_, [([Char], SrcSpan)], [Char]))]
checks = let * :: a -> b -> (a, b)
(*) = (,) in Int
-> [([Char],
     Bool -> Exp_ -> Maybe (Exp_, [([Char], SrcSpan)], [Char]))]
-> [([Char],
     Bool -> Exp_ -> Maybe (Exp_, [([Char], SrcSpan)], [Char]))]
forall a. Int -> [a] -> [a]
drop 1 -- see #174
    ["Use string literal" [Char]
-> (Bool -> Exp_ -> Maybe (Exp_, [([Char], SrcSpan)], [Char]))
-> ([Char],
    Bool -> Exp_ -> Maybe (Exp_, [([Char], SrcSpan)], [Char]))
forall a b. a -> b -> (a, b)
* Bool -> Exp_ -> Maybe (Exp_, [([Char], SrcSpan)], [Char])
forall p a. p -> Exp_ -> Maybe (Exp_, [a], [Char])
useString
    ,"Use list literal" [Char]
-> (Bool -> Exp_ -> Maybe (Exp_, [([Char], SrcSpan)], [Char]))
-> ([Char],
    Bool -> Exp_ -> Maybe (Exp_, [([Char], SrcSpan)], [Char]))
forall a b. a -> b -> (a, b)
* Bool -> Exp_ -> Maybe (Exp_, [([Char], SrcSpan)], [Char])
forall p. p -> Exp_ -> Maybe (Exp_, [([Char], SrcSpan)], [Char])
useList
    ,"Use :" [Char]
-> (Bool -> Exp_ -> Maybe (Exp_, [([Char], SrcSpan)], [Char]))
-> ([Char],
    Bool -> Exp_ -> Maybe (Exp_, [([Char], SrcSpan)], [Char]))
forall a b. a -> b -> (a, b)
* Bool -> Exp_ -> Maybe (Exp_, [([Char], SrcSpan)], [Char])
forall a.
View a App2 =>
Bool -> a -> Maybe (Exp_, [([Char], SrcSpan)], [Char])
useCons
    ]

pchecks :: [([Char], Pat_ -> Maybe (Pat_, [([Char], SrcSpan)], [Char]))]
pchecks = let * :: a -> b -> (a, b)
(*) = (,) in Int
-> [([Char], Pat_ -> Maybe (Pat_, [([Char], SrcSpan)], [Char]))]
-> [([Char], Pat_ -> Maybe (Pat_, [([Char], SrcSpan)], [Char]))]
forall a. Int -> [a] -> [a]
drop 1 -- see #174
    ["Use string literal pattern" [Char]
-> (Pat_ -> Maybe (Pat_, [([Char], SrcSpan)], [Char]))
-> ([Char], Pat_ -> Maybe (Pat_, [([Char], SrcSpan)], [Char]))
forall a b. a -> b -> (a, b)
* Pat_ -> Maybe (Pat_, [([Char], SrcSpan)], [Char])
forall a. Pat_ -> Maybe (Pat_, [a], [Char])
usePString
    ,"Use list literal pattern" [Char]
-> (Pat_ -> Maybe (Pat_, [([Char], SrcSpan)], [Char]))
-> ([Char], Pat_ -> Maybe (Pat_, [([Char], SrcSpan)], [Char]))
forall a b. a -> b -> (a, b)
* Pat_ -> Maybe (Pat_, [([Char], SrcSpan)], [Char])
usePList
    ]


usePString :: Pat_ -> Maybe (Pat_, [a], [Char])
usePString (PList _ xs :: [Pat_]
xs) | [Pat_]
xs [Pat_] -> [Pat_] -> Bool
forall a. Eq a => a -> a -> Bool
/= [], Just s :: [Char]
s <- (Pat_ -> Maybe Char) -> [Pat_] -> Maybe [Char]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Pat_ -> Maybe Char
fromPChar [Pat_]
xs =
    let literal :: Pat_
literal = S -> Sign S -> Literal S -> Pat_
forall l. l -> Sign l -> Literal l -> Pat l
PLit S
an (S -> Sign S
forall l. l -> Sign l
Signless S
an) (Literal S -> Pat_) -> Literal S -> Pat_
forall a b. (a -> b) -> a -> b
$ S -> [Char] -> [Char] -> Literal S
forall l. l -> [Char] -> [Char] -> Literal l
String S
an [Char]
s ([Char] -> [Char]
forall a. Show a => a -> [Char]
show [Char]
s)
    in (Pat_, [a], [Char]) -> Maybe (Pat_, [a], [Char])
forall a. a -> Maybe a
Just (Pat_
literal, [], Pat_ -> [Char]
forall a. Pretty a => a -> [Char]
prettyPrint Pat_
literal)
usePString _ = Maybe (Pat_, [a], [Char])
forall a. Maybe a
Nothing

usePList :: Pat_ -> Maybe (Pat_, [([Char], SrcSpan)], [Char])
usePList =
        ([(Pat_, ([Char], Pat_))] -> (Pat_, [([Char], SrcSpan)], [Char]))
-> Maybe [(Pat_, ([Char], Pat_))]
-> Maybe (Pat_, [([Char], SrcSpan)], [Char])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap  ( (\(e :: [Pat_]
e, s :: [([Char], Pat_)]
s) -> (S -> [Pat_] -> Pat_
forall l. l -> [Pat l] -> Pat l
PList S
an [Pat_]
e, (([Char], Pat_) -> ([Char], SrcSpan))
-> [([Char], Pat_)] -> [([Char], SrcSpan)]
forall a b. (a -> b) -> [a] -> [b]
map ((Pat_ -> SrcSpan) -> ([Char], Pat_) -> ([Char], SrcSpan)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Pat_ -> SrcSpan
forall (a :: * -> *). Annotated a => a S -> SrcSpan
toSS) [([Char], Pat_)]
s, Pat_ -> [Char]
forall a. Pretty a => a -> [Char]
prettyPrint (S -> [Pat_] -> Pat_
forall l. l -> [Pat l] -> Pat l
PList S
an ((([Char], Pat_) -> Pat_) -> [([Char], Pat_)] -> [Pat_]
forall a b. (a -> b) -> [a] -> [b]
map ([Char], Pat_) -> Pat_
forall a b. (a, b) -> b
snd [([Char], Pat_)]
s))))
              (([Pat_], [([Char], Pat_)]) -> (Pat_, [([Char], SrcSpan)], [Char]))
-> ([(Pat_, ([Char], Pat_))] -> ([Pat_], [([Char], Pat_)]))
-> [(Pat_, ([Char], Pat_))]
-> (Pat_, [([Char], SrcSpan)], [Char])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Pat_, ([Char], Pat_))] -> ([Pat_], [([Char], Pat_)])
forall a b. [(a, b)] -> ([a], [b])
unzip
              )
        (Maybe [(Pat_, ([Char], Pat_))]
 -> Maybe (Pat_, [([Char], SrcSpan)], [Char]))
-> (Pat_ -> Maybe [(Pat_, ([Char], Pat_))])
-> Pat_
-> Maybe (Pat_, [([Char], SrcSpan)], [Char])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> [Char] -> Pat_ -> Maybe [(Pat_, ([Char], Pat_))]
f Bool
True ['a'..'z']
    where
        f :: Bool -> [Char] -> Pat_ -> Maybe [(Pat_, ([Char], Pat_))]
f first :: Bool
first _ x :: Pat_
x | Pat_
x Pat_ -> [Char] -> Bool
forall a. Named a => a -> [Char] -> Bool
~= "[]" = if Bool
first then Maybe [(Pat_, ([Char], Pat_))]
forall a. Maybe a
Nothing else [(Pat_, ([Char], Pat_))] -> Maybe [(Pat_, ([Char], Pat_))]
forall a. a -> Maybe a
Just []
        f first :: Bool
first (ident :: Char
ident: cs :: [Char]
cs) (Pat_ -> PApp_
forall a b. View a b => a -> b
view -> PApp_ ":" [a :: Pat_
a,b :: Pat_
b]) =
          ((Pat_
a, Char -> Pat_ -> ([Char], Pat_)
g Char
ident Pat_
a) (Pat_, ([Char], Pat_))
-> [(Pat_, ([Char], Pat_))] -> [(Pat_, ([Char], Pat_))]
forall a. a -> [a] -> [a]
:) ([(Pat_, ([Char], Pat_))] -> [(Pat_, ([Char], Pat_))])
-> Maybe [(Pat_, ([Char], Pat_))] -> Maybe [(Pat_, ([Char], Pat_))]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool -> [Char] -> Pat_ -> Maybe [(Pat_, ([Char], Pat_))]
f Bool
False [Char]
cs Pat_
b
        f first :: Bool
first _ _ = Maybe [(Pat_, ([Char], Pat_))]
forall a. Maybe a
Nothing

        g :: Char -> Pat_ -> (String, Pat_)
        g :: Char -> Pat_ -> ([Char], Pat_)
g c :: Char
c p :: Pat_
p = ([Char
c], S -> Name S -> Pat_
forall l. l -> Name l -> Pat l
PVar (Pat_ -> S
forall (ast :: * -> *) l. Annotated ast => ast l -> l
ann Pat_
p) ([Char] -> Name S
forall a. Named a => [Char] -> a
toNamed [Char
c]))

useString :: p -> Exp_ -> Maybe (Exp_, [a], [Char])
useString b :: p
b (List _ xs :: [Exp_]
xs) | [Exp_]
xs [Exp_] -> [Exp_] -> Bool
forall a. Eq a => a -> a -> Bool
/= [], Just s :: [Char]
s <- (Exp_ -> Maybe Char) -> [Exp_] -> Maybe [Char]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Exp_ -> Maybe Char
fromChar [Exp_]
xs =
  let literal :: Exp_
literal = S -> Literal S -> Exp_
forall l. l -> Literal l -> Exp l
Lit S
an (Literal S -> Exp_) -> Literal S -> Exp_
forall a b. (a -> b) -> a -> b
$ S -> [Char] -> [Char] -> Literal S
forall l. l -> [Char] -> [Char] -> Literal l
String S
an [Char]
s ([Char] -> [Char]
forall a. Show a => a -> [Char]
show [Char]
s)
  in (Exp_, [a], [Char]) -> Maybe (Exp_, [a], [Char])
forall a. a -> Maybe a
Just (Exp_
literal , [], Exp_ -> [Char]
forall a. Pretty a => a -> [Char]
prettyPrint Exp_
literal)
useString b :: p
b _ = Maybe (Exp_, [a], [Char])
forall a. Maybe a
Nothing

useList :: p -> Exp_ -> Maybe (Exp_, [([Char], SrcSpan)], [Char])
useList b :: p
b =
        ([(Exp_, ([Char], Exp_))] -> (Exp_, [([Char], SrcSpan)], [Char]))
-> Maybe [(Exp_, ([Char], Exp_))]
-> Maybe (Exp_, [([Char], SrcSpan)], [Char])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap  ( (\(e :: [Exp_]
e, s :: [([Char], Exp_)]
s) -> (S -> [Exp_] -> Exp_
forall l. l -> [Exp l] -> Exp l
List S
an [Exp_]
e, (([Char], Exp_) -> ([Char], SrcSpan))
-> [([Char], Exp_)] -> [([Char], SrcSpan)]
forall a b. (a -> b) -> [a] -> [b]
map ((Exp_ -> SrcSpan) -> ([Char], Exp_) -> ([Char], SrcSpan)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Exp_ -> SrcSpan
forall (a :: * -> *). Annotated a => a S -> SrcSpan
toSS) [([Char], Exp_)]
s, Exp_ -> [Char]
forall a. Pretty a => a -> [Char]
prettyPrint (S -> [Exp_] -> Exp_
forall l. l -> [Exp l] -> Exp l
List S
an ((([Char], Exp_) -> Exp_) -> [([Char], Exp_)] -> [Exp_]
forall a b. (a -> b) -> [a] -> [b]
map ([Char], Exp_) -> Exp_
forall a b. (a, b) -> b
snd [([Char], Exp_)]
s))))
              (([Exp_], [([Char], Exp_)]) -> (Exp_, [([Char], SrcSpan)], [Char]))
-> ([(Exp_, ([Char], Exp_))] -> ([Exp_], [([Char], Exp_)]))
-> [(Exp_, ([Char], Exp_))]
-> (Exp_, [([Char], SrcSpan)], [Char])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Exp_, ([Char], Exp_))] -> ([Exp_], [([Char], Exp_)])
forall a b. [(a, b)] -> ([a], [b])
unzip
              )
        (Maybe [(Exp_, ([Char], Exp_))]
 -> Maybe (Exp_, [([Char], SrcSpan)], [Char]))
-> (Exp_ -> Maybe [(Exp_, ([Char], Exp_))])
-> Exp_
-> Maybe (Exp_, [([Char], SrcSpan)], [Char])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> [Char] -> Exp_ -> Maybe [(Exp_, ([Char], Exp_))]
f Bool
True ['a'..'z']
    where
        f :: Bool -> [Char] -> Exp_ -> Maybe [(Exp_, ([Char], Exp_))]
f first :: Bool
first _ x :: Exp_
x | Exp_
x Exp_ -> [Char] -> Bool
forall a. Named a => a -> [Char] -> Bool
~= "[]" = if Bool
first then Maybe [(Exp_, ([Char], Exp_))]
forall a. Maybe a
Nothing else [(Exp_, ([Char], Exp_))] -> Maybe [(Exp_, ([Char], Exp_))]
forall a. a -> Maybe a
Just []
        f first :: Bool
first (ident :: Char
ident:cs :: [Char]
cs) (Exp_ -> App2
forall a b. View a b => a -> b
view -> App2 c :: Exp_
c a :: Exp_
a b :: Exp_
b) | Exp_
c Exp_ -> [Char] -> Bool
forall a. Named a => a -> [Char] -> Bool
~= ":" =
          ((Exp_
a, Char -> Exp_ -> ([Char], Exp_)
g Char
ident Exp_
a) (Exp_, ([Char], Exp_))
-> [(Exp_, ([Char], Exp_))] -> [(Exp_, ([Char], Exp_))]
forall a. a -> [a] -> [a]
:) ([(Exp_, ([Char], Exp_))] -> [(Exp_, ([Char], Exp_))])
-> Maybe [(Exp_, ([Char], Exp_))] -> Maybe [(Exp_, ([Char], Exp_))]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool -> [Char] -> Exp_ -> Maybe [(Exp_, ([Char], Exp_))]
f Bool
False [Char]
cs Exp_
b
        f first :: Bool
first _ _ = Maybe [(Exp_, ([Char], Exp_))]
forall a. Maybe a
Nothing

        g :: Char -> Exp_ -> (String, Exp_)
        g :: Char -> Exp_ -> ([Char], Exp_)
g c :: Char
c p :: Exp_
p = ([Char
c], [Char] -> Exp_
forall a. Named a => [Char] -> a
toNamed [Char
c])

useCons :: Bool -> a -> Maybe (Exp_, [([Char], SrcSpan)], [Char])
useCons False (a -> App2
forall a b. View a b => a -> b
view -> App2 op :: Exp_
op x :: Exp_
x y :: Exp_
y) | Exp_
op Exp_ -> [Char] -> Bool
forall a. Named a => a -> [Char] -> Bool
~= "++"
                                    , Just (x2 :: Exp_
x2, build :: Exp_ -> Exp_
build) <- Exp_ -> Maybe (Exp_, Exp_ -> Exp_)
forall l l.
(Data l, Default l) =>
Exp l -> Maybe (Exp l, Exp l -> Exp l)
f Exp_
x
                                    , Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Exp_ -> Bool
forall a. View a App2 => a -> Bool
isAppend Exp_
y =
  (Exp_, [([Char], SrcSpan)], [Char])
-> Maybe (Exp_, [([Char], SrcSpan)], [Char])
forall a. a -> Maybe a
Just (Exp_ -> Exp_ -> Exp_
gen (Exp_ -> Exp_
build Exp_
x2) Exp_
y
       , [("x", Exp_ -> SrcSpan
forall (a :: * -> *). Annotated a => a S -> SrcSpan
toSS Exp_
x2), ("xs", Exp_ -> SrcSpan
forall (a :: * -> *). Annotated a => a S -> SrcSpan
toSS Exp_
y)]
       , Exp_ -> [Char]
forall a. Pretty a => a -> [Char]
prettyPrint (Exp_ -> [Char]) -> Exp_ -> [Char]
forall a b. (a -> b) -> a -> b
$ Exp_ -> Exp_ -> Exp_
gen (Exp_ -> Exp_
build (Exp_ -> Exp_) -> Exp_ -> Exp_
forall a b. (a -> b) -> a -> b
$ [Char] -> Exp_
forall a. Named a => [Char] -> a
toNamed "x") ([Char] -> Exp_
forall a. Named a => [Char] -> a
toNamed "xs"))
    where
        f :: Exp l -> Maybe (Exp l, Exp l -> Exp l)
f (List _ [x :: Exp l
x]) = (Exp l, Exp l -> Exp l) -> Maybe (Exp l, Exp l -> Exp l)
forall a. a -> Maybe a
Just (Exp l
x, \v :: Exp l
v -> if Exp l -> Bool
forall l. Exp l -> Bool
isApp Exp l
x then Exp l
v else Exp l -> Exp l
forall l. (Data l, Default l) => Exp l -> Exp l
paren Exp l
v)
        f _ = Maybe (Exp l, Exp l -> Exp l)
forall a. Maybe a
Nothing


        gen :: Exp_ -> Exp_ -> Exp_
gen x :: Exp_
x = S -> Exp_ -> QOp S -> Exp_ -> Exp_
forall l. l -> Exp l -> QOp l -> Exp l -> Exp l
InfixApp S
an Exp_
x (S -> QName S -> QOp S
forall l. l -> QName l -> QOp l
QConOp S
an (QName S -> QOp S) -> QName S -> QOp S
forall a b. (a -> b) -> a -> b
$ S -> QName S
forall l. l -> QName l
list_cons_name S
an)
useCons _ _ = Maybe (Exp_, [([Char], SrcSpan)], [Char])
forall a. Maybe a
Nothing



typeListChar :: Type S
typeListChar = S -> Type S -> Type S
forall l. l -> Type l -> Type l
TyList S
an (S -> QName S -> Type S
forall l. l -> QName l -> Type l
TyCon S
an ([Char] -> QName S
forall a. Named a => [Char] -> a
toNamed "Char"))
typeString :: Type S
typeString = S -> QName S -> Type S
forall l. l -> QName l -> Type l
TyCon S
an ([Char] -> QName S
forall a. Named a => [Char] -> a
toNamed "String")


stringType :: Decl_ -> [Idea]
stringType :: Decl_ -> [Idea]
stringType x :: Decl_
x = case Decl_
x of
    InstDecl _ _ _ x :: Maybe [InstDecl S]
x -> Maybe [InstDecl S] -> [Idea]
forall from. Data from => from -> [Idea]
f Maybe [InstDecl S]
x
    _ -> Decl_ -> [Idea]
forall from. Data from => from -> [Idea]
f Decl_
x
    where
        f :: from -> [Idea]
f x :: from
x = (Type S -> [Idea]) -> [Type S] -> [Idea]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Type S -> [Idea]
g ([Type S] -> [Idea]) -> [Type S] -> [Idea]
forall a b. (a -> b) -> a -> b
$ from -> [Type S]
forall from to. Biplate from to => from -> [to]
childrenBi from
x

        g :: Type_ -> [Idea]
        g :: Type S -> [Idea]
g e :: Type S
e@(Type S -> Type S
forall s. Type s -> Type s
fromTyParen -> Type S
x) = [[Char] -> Type S -> Type S -> [Refactoring SrcSpan] -> Idea
forall (ast :: * -> *) a.
(Annotated ast, Pretty a, Pretty (ast S)) =>
[Char] -> ast S -> a -> [Refactoring SrcSpan] -> Idea
suggest "Use String" Type S
x ((Type S -> Type S) -> Type S -> Type S
forall on. Uniplate on => (on -> on) -> on -> on
transform Type S -> Type S
f Type S
x)
                                    [Refactoring SrcSpan]
rs | Bool -> Bool
not (Bool -> Bool)
-> ([Refactoring SrcSpan] -> Bool) -> [Refactoring SrcSpan] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Refactoring SrcSpan] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([Refactoring SrcSpan] -> Bool) -> [Refactoring SrcSpan] -> Bool
forall a b. (a -> b) -> a -> b
$ [Refactoring SrcSpan]
rs]
            where f :: Type S -> Type S
f x :: Type S
x = if Type S
x Type S -> Type S -> Bool
forall (a :: * -> *) l1 l2.
(Annotated a, Eq (a ())) =>
a l1 -> a l2 -> Bool
=~= Type S
typeListChar then Type S
typeString else Type S
x
                  rs :: [Refactoring SrcSpan]
rs = [RType
-> SrcSpan -> [([Char], SrcSpan)] -> [Char] -> Refactoring SrcSpan
forall a. RType -> a -> [([Char], a)] -> [Char] -> Refactoring a
Replace RType
Type (Type S -> SrcSpan
forall (a :: * -> *). Annotated a => a S -> SrcSpan
toSS Type S
t) [] (Type S -> [Char]
forall a. Pretty a => a -> [Char]
prettyPrint Type S
typeString) | Type S
t <- Type S -> [Type S]
forall on. Uniplate on => on -> [on]
universe Type S
x, Type S
t Type S -> Type S -> Bool
forall (a :: * -> *) l1 l2.
(Annotated a, Eq (a ())) =>
a l1 -> a l2 -> Bool
=~= Type S
typeListChar]