Support projections-style transformations to reduce false-positives

Basic aliases (e.g. `admin?`/`be_admin`) can be represented easily with simple
wildcards, but more complex transformations require a different mechanism.

Instead of using `%s` to represent strings that can be replaced 1:1, this
introduces a syntax inspired by https://github.com/tpope/vim-projectionist, as
such:

    - name: Rails
      aliases:
      - from: "*Validator"
        to: "{snakecase}"

This would find `AbsoluteUriValidator` and also match `absolute_uri`, which
would be found if the validation was in use.

This currently supports the `camelcase` and `snakecase` transformations,
as well as no transformation.

Closes #18

data/config.yml

@@ -1,9 +1,11 @@
 - name: Rails
   aliases:
-  - from: "%s?"
-    to: "be_%s"
-  - from: "has_%s?"
-    to: "have_%s"
+  - from: "*?"
+    to: "be_{}"
+  - from: "has_*?"
+    to: "have_{}"
+  - from: "*Validator"
+    to: "{snakecase}"
   allowedTerms:
     # serialization
     - as_json

src/Unused/Aliases.hs

@@ -20,13 +20,13 @@ termsAndAliases [] = map OriginalTerm
 termsAndAliases as = L.nub . concatMap ((as >>=) . generateSearchTerms . T.pack)
 
 generateSearchTerms :: Text -> TermAlias -> [SearchTerm]
-generateSearchTerms term TermAlias{taFrom = from, taTo = to} =
+generateSearchTerms term TermAlias{taFrom = from, taTransform = transform} =
     toTermWithAlias $ parsePatternForMatch (T.pack from) term
   where
     toTermWithAlias (Right (Just match)) = [OriginalTerm unpackedTerm, AliasTerm unpackedTerm (aliasedResult match)]
     toTermWithAlias _ = [OriginalTerm unpackedTerm]
     unpackedTerm = T.unpack term
-    aliasedResult match = T.unpack $ T.replace wildcard match (T.pack to)
+    aliasedResult = T.unpack . transform
 
 parsePatternForMatch :: Text -> Text -> Either Text (Maybe Text)
 parsePatternForMatch aliasPattern term =
@@ -36,4 +36,4 @@ parsePatternForMatch aliasPattern term =
     findMatch _ = Left $ T.pack $ "There was a problem with the pattern: " ++ show aliasPattern
 
 wildcard :: Text
-wildcard = "%s"
+wildcard = "*"

src/Unused/Projection.hs

@@ -0,0 +1,52 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module Unused.Projection where
+
+import           Data.Monoid ((<>))
+import           Data.Text (Text)
+import qualified Data.Text as T
+import           Text.Megaparsec
+import           Text.Megaparsec.Text
+import           Unused.Projection.Transform
+
+data ParsedTransform = ParsedTransform
+    { ptPre :: Text
+    , ptTransforms :: [Transform]
+    , ptPost :: Text
+    }
+
+translate :: Text -> Either ParseError (Text -> Text)
+translate template = applyTransform <$> parseTransform template
+
+applyTransform :: ParsedTransform -> Text -> Text
+applyTransform pt t =
+    ptPre pt
+    <> runTransformations t (ptTransforms pt)
+    <> ptPost pt
+
+parseTransform :: Text -> Either ParseError ParsedTransform
+parseTransform = parse parsedTransformParser ""
+
+parsedTransformParser :: Parser ParsedTransform
+parsedTransformParser =
+    ParsedTransform
+    <$> preTransformsParser
+    <*> transformsParser
+    <*> postTransformsParser
+
+preTransformsParser :: Parser Text
+preTransformsParser = T.pack <$> manyTill anyChar (char '{')
+
+transformsParser :: Parser [Transform]
+transformsParser = transformParser `sepBy` char '|' <* char '}'
+
+postTransformsParser :: Parser Text
+postTransformsParser = T.pack <$> many anyChar
+
+transformParser :: Parser Transform
+transformParser = do
+    result <- string "camelcase" <|> string "snakecase"
+    return $ case result of
+        "camelcase" -> Camelcase
+        "snakecase" -> Snakecase
+        _ -> Noop

src/Unused/Projection/Transform.hs

@@ -0,0 +1,37 @@
+module Unused.Projection.Transform
+    ( Transform(..)
+    , runTransformations
+    ) where
+
+import           Data.Either (rights)
+import           Data.Text (Text)
+import qualified Data.Text as T
+import qualified Text.Inflections as I
+import qualified Text.Inflections.Parse.Types as I
+import qualified Unused.Util as U
+
+data Transform
+    = Camelcase
+    | Snakecase
+    | Noop
+
+runTransformations :: Text -> [Transform] -> Text
+runTransformations = foldl (flip runTransformation)
+
+runTransformation :: Transform -> Text -> Text
+runTransformation Camelcase = toCamelcase
+runTransformation Snakecase = toSnakecase
+runTransformation Noop = id
+
+toCamelcase :: Text -> Text
+toCamelcase t = maybe t (T.pack . I.camelize) $ toMaybeWords t
+
+toSnakecase :: Text -> Text
+toSnakecase t = maybe t (T.pack . I.underscore) $ toMaybeWords t
+
+toMaybeWords :: Text -> Maybe [I.Word]
+toMaybeWords t =
+    U.safeHead $ rights [asCamel, asSnake]
+  where
+    asCamel = I.parseCamelCase [] $ T.unpack t
+    asSnake = I.parseSnakeCase [] $ T.unpack t

src/Unused/ResultsClassifier/Types.hs

@@ -15,8 +15,10 @@ import qualified Control.Monad as M
 import qualified Data.HashMap.Strict as HM
 import qualified Data.List as L
 import qualified Data.Text as T
+import           Data.Text (Text)
 import           Data.Yaml (FromJSON(..), (.:), (.:?), (.!=))
 import qualified Data.Yaml as Y
+import           Unused.Projection
 
 data LanguageConfiguration = LanguageConfiguration
     { lcName :: String
@@ -34,6 +36,7 @@ data LowLikelihoodMatch = LowLikelihoodMatch
 data TermAlias = TermAlias
     { taFrom :: String
     , taTo :: String
+    , taTransform :: Text -> Text
     }
 
 data ParseConfigError = ParseConfigError
@@ -63,6 +66,7 @@ instance FromJSON TermAlias where
     parseJSON (Y.Object o) = TermAlias
         <$> o .: "from"
         <*> o .: "to"
+        <*> (either (fail . show) return =<< (translate . T.pack <$> (o .: "to")))
     parseJSON _ = M.mzero
 
 data MatchHandler a = MatchHandler

test/Unused/AliasesSpec.hs

@@ -1,5 +1,8 @@
+{-# LANGUAGE OverloadedStrings #-}
+
 module Unused.AliasesSpec where
 
+import Data.Monoid ((<>))
 import Test.Hspec
 import Unused.Aliases
 import Unused.ResultsClassifier.Types (TermAlias(..))
@@ -15,8 +18,8 @@ spec = parallel $
             termsAndAliases [] ["method_1", "method_2"] `shouldBe` [OriginalTerm "method_1", OriginalTerm "method_2"]
 
         it "adds aliases to the list of terms" $ do
-            let predicateAlias = TermAlias "%s?" "be_%s"
-            let pluralizeAlias = TermAlias "really_%s" "very_%s"
+            let predicateAlias = TermAlias "*?" "be_{}" ("be_" <>)
+            let pluralizeAlias = TermAlias "really_*" "very_{}" ("very_" <>)
 
             termsAndAliases [predicateAlias, pluralizeAlias] ["awesome?", "really_cool"]
                 `shouldBe` [OriginalTerm "awesome?", AliasTerm "awesome?" "be_awesome", OriginalTerm "really_cool", AliasTerm "really_cool" "very_cool"]

test/Unused/ProjectionSpec.hs

@@ -0,0 +1,30 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module Unused.ProjectionSpec where
+
+import Data.Text (Text)
+import Test.Hspec
+import Unused.Projection
+
+main :: IO ()
+main = hspec spec
+
+spec :: Spec
+spec = parallel $
+    describe "translate" $ do
+        it "replaces the text without transforms" $
+            translate' "foo_{}" "bar" `shouldBe` "foo_bar"
+
+        it "handles text transformations" $ do
+            translate' "{camelcase}Validator" "proper_email" `shouldBe` "ProperEmailValidator"
+            translate' "{snakecase}" "ProperEmail" `shouldBe` "proper_email"
+            translate' "{camelcase}Validator" "AlreadyCamelcase" `shouldBe` "AlreadyCamelcaseValidator"
+
+        it "handles unknown transformations" $
+            translate' "{unknown}Validator" "proper_email" `shouldBe` "proper_email"
+
+translate' :: Text -> Text -> Text
+translate' template v =
+    case translate template of
+        Right f -> f v
+        Left _ -> v

unused.cabal

@@ -25,6 +25,8 @@ library
                      , Unused.Util
                      , Unused.Regex
                      , Unused.Aliases
+                     , Unused.Projection
+                     , Unused.Projection.Transform
                      , Unused.ResponseFilter
                      , Unused.ResultsClassifier
                      , Unused.ResultsClassifier.Types
@@ -77,6 +79,8 @@ library
                      , vector
                      , mtl
                      , transformers
+                     , megaparsec
+                     , inflections
   ghc-options:         -Wall
   default-language:    Haskell2010
 
@@ -100,6 +104,7 @@ test-suite unused-test
                      , unused
                      , hspec
                      , containers
+                     , text
   other-modules:       Unused.ParserSpec
                      , Unused.ResponseFilterSpec
                      , Unused.TypesSpec