<commit_before>{-# LANGUAGE ViewPatterns, PatternGuards #-}

{-
    Suggest the use of camelCase

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

    Apply this to things that would get exported by default only

<TEST>
data Yes = Foo | Bar'Test
data Yes = Bar | Test_Bar
data No = a :::: b
data Yes = Foo {bar_cap :: Int}
data No = FOO | BarBAR | BarBBar
yes_foo = yes_foo + yes_foo where res = "yesFoo = ..."
no = 1 where yes_foo = 2
a -== b = 1
</TEST>
-}


module Hint.Naming where

import HSE.All
import Type
import Data.List
import Data.Char
import Data.Maybe


namingHint :: Hint
namingHint x = [warn "Use camelCase" (declSrcLoc x) x2 (replaceNames res x2) | not $ null res]
    where res = [(n,y) | n <- nub $ getNames x, Just y <- [suggestName n]]
          x2 = shorten x


shorten :: Decl -> Decl
shorten x = case x of
    FunBind (Match a b c d e _:_) -> FunBind [f (Match a b c d) e]
    PatBind a b c d _ -> f (PatBind a b c) d
    x -> x
    where
        dots = Var $ UnQual $ Ident "..."
        f cont (UnGuardedRhs _) = cont (UnGuardedRhs dots) (BDecls [])
        f cont (GuardedRhss _) = cont (GuardedRhss [GuardedRhs nullSrcLoc [Qualifier dots] dots]) (BDecls [])


getNames :: Decl -> [String]
getNames x = case x of
    FunBind{} -> name
    PatBind{} -> name
    TypeDecl{} -> names
    DataDecl{} -> names
    GDataDecl{} -> names
    TypeFamDecl{} -> names
    DataFamDecl{} -> names
    ClassDecl{} -> names
    _ -> []
    where
        name = [fromNamed x]
        names = map fromNamed (universeBi x :: [Name])


suggestName :: String -> Maybe String
suggestName x = listToMaybe [f x | not $ isSym x || good]
    where
        good = all isAlphaNum $ drp '_' $ drp '\'' $ reverse $ drp '_' x
        drp x ys = if [x] `isPrefixOf` ys then tail ys else ys

        f ('_':xs) = '_' : g xs
        f xs = g xs

        g x | x `elem` ["_","'","_'"] = x
        g ('_':x:xs) | isAlphaNum x = toUpper x : g xs
        g (x:xs) | isAlphaNum x = x : g xs
                 | otherwise = g xs
        g [] = []


replaceNames :: Data a => [(String,String)] -> a -> a
replaceNames rep = descendBi f
    where f x = fromMaybe x $ lookup x rep
<commit_msg>Be much more picky about what names are defined where<commit_after>{-# LANGUAGE ViewPatterns, PatternGuards #-}

{-
    Suggest the use of camelCase

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

    Apply this to things that would get exported by default only

<TEST>
data Yes = Foo | Bar'Test
data Yes = Bar | Test_Bar
data No = a :::: b
data Yes = Foo {bar_cap :: Int}
data No = FOO | BarBAR | BarBBar
yes_foo = yes_foo + yes_foo where res = "yesFoo = ..."
no = 1 where yes_foo = 2
a -== b = 1
</TEST>
-}


module Hint.Naming where

import HSE.All
import Type
import Data.List
import Data.Char
import Data.Maybe


namingHint :: Hint
namingHint x = [warn "Use camelCase" (declSrcLoc x) x2 (replaceNames res x2) | not $ null res]
    where res = [(n,y) | n <- nub $ getNames x, Just y <- [suggestName n]]
          x2 = shorten x


shorten :: Decl -> Decl
shorten x = case x of
    FunBind (Match a b c d e _:_) -> FunBind [f (Match a b c d) e]
    PatBind a b c d _ -> f (PatBind a b c) d
    x -> x
    where
        dots = Var $ UnQual $ Ident "..."
        f cont (UnGuardedRhs _) = cont (UnGuardedRhs dots) (BDecls [])
        f cont (GuardedRhss _) = cont (GuardedRhss [GuardedRhs nullSrcLoc [Qualifier dots] dots]) (BDecls [])


getNames :: Decl -> [String]
getNames x = case x of
    FunBind{} -> name
    PatBind{} -> name
    TypeDecl{} -> name
    DataDecl _ _ _ _ _ cons _ -> name ++ [fromNamed x | QualConDecl _ _ _ x <- cons, x <- f x]
    GDataDecl _ _ _ _ _ _ cons _ -> name ++ [fromNamed x | GadtDecl _ x _ <- cons]
    TypeFamDecl{} -> name
    DataFamDecl{} -> name
    ClassDecl{} -> name
    _ -> []
    where
        name = [fromNamed x]
        names = map fromNamed (universeBi x :: [Name])

        f (ConDecl x _) = [x]
        f (RecDecl x ys) = x : concatMap fst ys


suggestName :: String -> Maybe String
suggestName x = listToMaybe [f x | not $ isSym x || good]
    where
        good = all isAlphaNum $ drp '_' $ drp '\'' $ reverse $ drp '_' x
        drp x ys = if [x] `isPrefixOf` ys then tail ys else ys

        f ('_':xs) = '_' : g xs
        f xs = g xs

        g x | x `elem` ["_","'","_'"] = x
        g ('_':x:xs) | isAlphaNum x = toUpper x : g xs
        g (x:xs) | isAlphaNum x = x : g xs
                 | otherwise = g xs
        g [] = []


replaceNames :: Data a => [(String,String)] -> a -> a
replaceNames rep = descendBi f
    where f x = fromMaybe x $ lookup x rep

{'fraction_non_alphanumeric': 0.1324879755137735, 'fraction_numerical': 0.0026235242675994755, 'mean_word_length': 2.24468085106383, 'pattern_counts': {'":': 0, '<': 14, '<?xml version=': 0, '>': 43, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '873480', 'n_tokens_mistral': 1695, 'n_tokens_neox': 1608, 'n_words': 598}