{-# LANGUAGE FlexibleContexts #-}
{-
    Suggest the use of camelCase

    Only permit:
    _*[A-Za-z]*_*#*'*

    Apply this to things that would get exported by default only
    Also allow prop_ as it's a standard QuickCheck idiom
    Also allow case_ as it's a standard test-framework-th idiom
    Also allow test_ as it's a standard tasty-th idiom
    Also allow numbers separated by _
    Also don't suggest anything mentioned elsewhere in the module

<TEST>
data Yes = Foo | Bar'Test -- data Yes = Foo | BarTest
data Yes = Bar | Test_Bar -- data Yes = Bar | TestBar
data No = a :::: b
data Yes = Foo {bar_cap :: Int}
data No = FOO | BarBAR | BarBBar
yes_foo = yes_foo + yes_foo -- yesFoo = ...
no = 1 where yes_foo = 2
a -== b = 1
myTest = 1; my_test = 1
semiring'laws = 1 -- semiringLaws = ...
data Yes = FOO_A | Foo_B -- data Yes = FOO_A | FooB
case_foo = 1
test_foo = 1
cast_foo = 1 -- castFoo = ...
replicateM_ = 1
_foo__ = 1
section_1_1 = 1
runMutator# = 1
</TEST>
-}


module Hint.Naming(namingHint) where

import Hint.Type
import Data.List.Extra
import Data.Data
import Data.Char
import Data.Maybe
import Refact.Types hiding (RType(Match))
import qualified Data.Set as Set


namingHint :: DeclHint
namingHint :: DeclHint
namingHint _ modu :: Module_
modu = Set String -> Decl_ -> [Idea]
naming (Set String -> Decl_ -> [Idea]) -> Set String -> Decl_ -> [Idea]
forall a b. (a -> b) -> a -> b
$ [String] -> Set String
forall a. Ord a => [a] -> Set a
Set.fromList ([String] -> Set String) -> [String] -> Set String
forall a b. (a -> b) -> a -> b
$ (Decl_ -> [String]) -> [Decl_] -> [String]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Decl_ -> [String]
getNames ([Decl_] -> [String]) -> [Decl_] -> [String]
forall a b. (a -> b) -> a -> b
$ Module_ -> [Decl_]
moduleDecls Module_
modu

naming :: Set.Set String -> Decl_ -> [Idea]
naming :: Set String -> Decl_ -> [Idea]
naming seen :: Set String
seen x :: Decl_
x = [String -> Decl_ -> Decl_ -> [Refactoring SrcSpan] -> Idea
forall (ast :: * -> *) a.
(Annotated ast, Pretty a, Pretty (ast SrcSpanInfo)) =>
String -> ast SrcSpanInfo -> a -> [Refactoring SrcSpan] -> Idea
suggest "Use camelCase" Decl_
x' Decl_
x2' [RType
-> SrcSpan -> [(String, SrcSpan)] -> String -> Refactoring SrcSpan
forall a. RType -> a -> [(String, a)] -> String -> Refactoring a
Replace RType
Bind (Decl_ -> SrcSpan
forall (a :: * -> *). Annotated a => a SrcSpanInfo -> SrcSpan
toSS Decl_
x) [] (Decl_ -> String
forall a. Pretty a => a -> String
prettyPrint Decl_
x2)] | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [(String, String)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(String, String)]
res]
    where res :: [(String, String)]
res = [(String
n,String
y) | String
n <- [String] -> [String]
forall a. Ord a => [a] -> [a]
nubOrd ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ Decl_ -> [String]
getNames Decl_
x, Just y :: String
y <- [String -> Maybe String
suggestName String
n], Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ String
y String -> Set String -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set String
seen]
          x2 :: Decl_
x2 = [(String, String)] -> Decl_ -> Decl_
forall a. Data a => [(String, String)] -> a -> a
replaceNames [(String, String)]
res Decl_
x
          x' :: Decl_
x' = Decl_ -> Decl_
shorten Decl_
x
          x2' :: Decl_
x2' = Decl_ -> Decl_
shorten Decl_
x2


shorten :: Decl_ -> Decl_
shorten :: Decl_ -> Decl_
shorten x :: Decl_
x = case Decl_
x of
    FunBind sl :: SrcSpanInfo
sl (Match a :: SrcSpanInfo
a b :: Name SrcSpanInfo
b c :: [Pat SrcSpanInfo]
c d :: Rhs SrcSpanInfo
d _:_) -> SrcSpanInfo -> [Match SrcSpanInfo] -> Decl_
forall l. l -> [Match l] -> Decl l
FunBind SrcSpanInfo
sl [(Rhs SrcSpanInfo -> Maybe (Binds SrcSpanInfo) -> Match SrcSpanInfo)
-> Rhs SrcSpanInfo -> Match SrcSpanInfo
forall a p l. (Rhs SrcSpanInfo -> Maybe a -> p) -> Rhs l -> p
f (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
a Name SrcSpanInfo
b [Pat SrcSpanInfo]
c) Rhs SrcSpanInfo
d]
    PatBind a :: SrcSpanInfo
a b :: Pat SrcSpanInfo
b c :: Rhs SrcSpanInfo
c _ -> (Rhs SrcSpanInfo -> Maybe (Binds SrcSpanInfo) -> Decl_)
-> Rhs SrcSpanInfo -> Decl_
forall a p l. (Rhs SrcSpanInfo -> Maybe a -> p) -> Rhs l -> p
f (SrcSpanInfo
-> Pat SrcSpanInfo
-> Rhs SrcSpanInfo
-> Maybe (Binds SrcSpanInfo)
-> Decl_
forall l. l -> Pat l -> Rhs l -> Maybe (Binds l) -> Decl l
PatBind SrcSpanInfo
a Pat SrcSpanInfo
b) Rhs SrcSpanInfo
c
    x :: Decl_
x -> Decl_
x
    where
        dots :: Exp SrcSpanInfo
dots = SrcSpanInfo -> QName SrcSpanInfo -> Exp SrcSpanInfo
forall l. l -> QName l -> Exp l
Var SrcSpanInfo
an QName SrcSpanInfo
ellipses
        f :: (Rhs SrcSpanInfo -> Maybe a -> p) -> Rhs l -> p
f cont :: Rhs SrcSpanInfo -> Maybe a -> p
cont (UnGuardedRhs _ _) = Rhs SrcSpanInfo -> Maybe a -> p
cont (SrcSpanInfo -> Exp SrcSpanInfo -> Rhs SrcSpanInfo
forall l. l -> Exp l -> Rhs l
UnGuardedRhs SrcSpanInfo
an Exp SrcSpanInfo
dots) Maybe a
forall a. Maybe a
Nothing
        f cont :: Rhs SrcSpanInfo -> Maybe a -> p
cont (GuardedRhss _ _) = Rhs SrcSpanInfo -> Maybe a -> p
cont (SrcSpanInfo -> [GuardedRhs SrcSpanInfo] -> Rhs SrcSpanInfo
forall l. l -> [GuardedRhs l] -> Rhs l
GuardedRhss SrcSpanInfo
an [SrcSpanInfo
-> [Stmt SrcSpanInfo] -> Exp SrcSpanInfo -> GuardedRhs SrcSpanInfo
forall l. l -> [Stmt l] -> Exp l -> GuardedRhs l
GuardedRhs SrcSpanInfo
an [SrcSpanInfo -> Exp SrcSpanInfo -> Stmt SrcSpanInfo
forall l. l -> Exp l -> Stmt l
Qualifier SrcSpanInfo
an Exp SrcSpanInfo
dots] Exp SrcSpanInfo
dots]) Maybe a
forall a. Maybe a
Nothing


getNames :: Decl_ -> [String]
getNames :: Decl_ -> [String]
getNames x :: Decl_
x = case Decl_
x of
    FunBind{} -> [String]
name
    PatBind{} -> [String]
name
    TypeDecl{} -> [String]
name
    DataDecl _ _ _ _ cons :: [QualConDecl SrcSpanInfo]
cons _ -> [String]
name [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [Name SrcSpanInfo -> String
forall a. Named a => a -> String
fromNamed Name SrcSpanInfo
x | QualConDecl _ _ _ x :: ConDecl SrcSpanInfo
x <- [QualConDecl SrcSpanInfo]
cons, Name SrcSpanInfo
x <- ConDecl SrcSpanInfo -> [Name SrcSpanInfo]
forall l. ConDecl l -> [Name l]
f ConDecl SrcSpanInfo
x]
    GDataDecl _ _ _ _ _ cons :: [GadtDecl SrcSpanInfo]
cons _ -> [String]
name [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [Name SrcSpanInfo -> String
forall a. Named a => a -> String
fromNamed Name SrcSpanInfo
x | GadtDecl _ x :: Name SrcSpanInfo
x _ _ _ _ <- [GadtDecl SrcSpanInfo]
cons]
    TypeFamDecl{} -> [String]
name
    DataFamDecl{} -> [String]
name
    ClassDecl{} -> [String]
name
    _ -> []
    where
        name :: [String]
name = [Decl_ -> String
forall a. Named a => a -> String
fromNamed Decl_
x]

        f :: ConDecl l -> [Name l]
f (ConDecl _ x :: Name l
x _) = [Name l
x]
        f (InfixConDecl _ _ x :: Name l
x _) = [Name l
x]
        f (RecDecl _ x :: Name l
x _) = [Name l
x]


suggestName :: String -> Maybe String
suggestName :: String -> Maybe String
suggestName x :: String
x
    | String -> Bool
isSym String
x Bool -> Bool -> Bool
|| Bool
good Bool -> Bool -> Bool
|| Bool -> Bool
not ((Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Char -> Bool
isLower String
x) Bool -> Bool -> Bool
|| (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Char -> Bool
isDigit String
x Bool -> Bool -> Bool
||
        (String -> Bool) -> [String] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
x) ["prop_","case_","unit_","test_","spec_","scprop_","hprop_"] = Maybe String
forall a. Maybe a
Nothing
    | Bool
otherwise = String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ String -> String
f String
x
    where
        good :: Bool
good = (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isAlphaNum (String -> Bool) -> String -> Bool
forall a b. (a -> b) -> a -> b
$ Char -> String -> String
forall a. Eq a => a -> [a] -> [a]
drp '_' (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ Char -> String -> String
forall a. Eq a => a -> [a] -> [a]
drp '#' (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ Char -> String -> String
forall a. Eq a => a -> [a] -> [a]
drp '\'' (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String -> String
forall a. [a] -> [a]
reverse (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ Char -> String -> String
forall a. Eq a => a -> [a] -> [a]
drp '_' String
x
        drp :: a -> [a] -> [a]
drp x :: a
x = (a -> Bool) -> [a] -> [a]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
x)

        f :: String -> String
f xs :: String
xs = String
us String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
g String
ys
            where (us :: String
us,ys :: String
ys) = (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '_') String
xs

        g :: String -> String
g x :: String
x | String
x String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ["_","'","_'"] = String
x
        g (a :: Char
a:x :: Char
x:xs :: String
xs) | Char
a Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` "_'" Bool -> Bool -> Bool
&& Char -> Bool
isAlphaNum Char
x = Char -> Char
toUpper Char
x Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
g String
xs
        g (x :: Char
x:xs :: String
xs) | Char -> Bool
isAlphaNum Char
x = Char
x Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
g String
xs
                 | Bool
otherwise = String -> String
g String
xs
        g [] = []


replaceNames :: Data a => [(String,String)] -> a -> a
replaceNames :: [(String, String)] -> a -> a
replaceNames rep :: [(String, String)]
rep = (Name SrcSpanInfo -> Name SrcSpanInfo) -> a -> a
forall from to. Biplate from to => (to -> to) -> from -> from
transformBi Name SrcSpanInfo -> Name SrcSpanInfo
f
    where f :: Name SrcSpanInfo -> Name SrcSpanInfo
f (Ident _ x :: String
x) = SrcSpanInfo -> String -> Name SrcSpanInfo
forall l. l -> String -> Name l
Ident SrcSpanInfo
an (String -> Name SrcSpanInfo) -> String -> Name SrcSpanInfo
forall a b. (a -> b) -> a -> b
$ String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
x (Maybe String -> String) -> Maybe String -> String
forall a b. (a -> b) -> a -> b
$ String -> [(String, String)] -> Maybe String
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
x [(String, String)]
rep
          f x :: Name SrcSpanInfo
x = Name SrcSpanInfo
x