{-# LANGUAGE FlexibleContexts #-}
module Hint.Naming(namingHint) where
import Hint.Type
import Data.List.Extra
import Data.Data
import Data.Char
import Data.Maybe
import qualified Data.Set as Set
namingHint :: DeclHint
namingHint _ modu = naming $ Set.fromList $ concatMap getNames $ moduleDecls modu
naming :: Set.Set String -> Decl_ -> [Idea]
naming seen x = [suggestN "Use camelCase" x2 (replaceNames res x2) | not $ null res]
where res = [(n,y) | n <- nubOrd $ getNames x, Just y <- [suggestName n], not $ y `Set.member` seen]
x2 = shorten x
shorten :: Decl_ -> Decl_
shorten x = case x of
FunBind sl (Match a b c d _:_) -> FunBind sl [f (Match a b c) d]
PatBind a b c _ -> f (PatBind a b) c
x -> x
where
dots = Var an ellipses
f cont (UnGuardedRhs _ _) = cont (UnGuardedRhs an dots) Nothing
f cont (GuardedRhss _ _) = cont (GuardedRhss an [GuardedRhs an [Qualifier an dots] dots]) Nothing
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]
f (ConDecl _ x _) = [x]
f (InfixConDecl _ _ x _) = [x]
f (RecDecl _ x _) = [x]
suggestName :: String -> Maybe String
suggestName x
| isSym x || good || not (any isLower x) || any isDigit x ||
any (`isPrefixOf` x) ["prop_","case_","unit_","test_","spec_","scprop_","hprop_"] = Nothing
| otherwise = Just $ f x
where
good = all isAlphaNum $ drp '_' $ drp '#' $ drp '\'' $ reverse $ drp '_' x
drp x = dropWhile (== x)
f xs = us ++ g ys
where (us,ys) = span (== '_') xs
g x | x `elem` ["_","'","_'"] = x
g (a:x:xs) | a `elem` "_'" && 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 (Ident _ x) = Ident an $ fromMaybe x $ lookup x rep
f x = x