module Language.PureScript.Ide.Matcher
( Matcher
, flexMatcher
, runMatcher
) where
import Prelude ()
import Prelude.Compat
import Control.Monad
import Data.Aeson
import Data.Function (on)
import Data.List (sortBy)
import Data.Maybe (mapMaybe)
import Data.Monoid
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.Encoding as TE
import Language.PureScript.Ide.Types
import Language.PureScript.Ide.Util
import Text.EditDistance
import Text.Regex.TDFA ((=~))
type ScoredMatch = (Match, Double)
newtype Matcher = Matcher (Endo [Match]) deriving(Monoid)
instance FromJSON Matcher where
parseJSON = withObject "matcher" $ \o -> do
(matcher :: Maybe String) <- o .:? "matcher"
case matcher of
Just "flex" -> do
params <- o .: "params"
search <- params .: "search"
pure $ flexMatcher search
Just "distance" -> do
params <- o .: "params"
search <- params .: "search"
maxDist <- params .: "maximumDistance"
pure $ distanceMatcher search maxDist
Just _ -> mzero
Nothing -> return mempty
flexMatcher :: Text -> Matcher
flexMatcher p = mkMatcher (flexMatch p)
distanceMatcher :: Text -> Int -> Matcher
distanceMatcher q maxDist = mkMatcher (distanceMatcher' q maxDist)
distanceMatcher' :: Text -> Int -> [Match] -> [ScoredMatch]
distanceMatcher' q maxDist = mapMaybe go
where
go m = let d = dist (T.unpack y)
y = identifierFromMatch m
in if d <= maxDist
then Just (m, 1 / fromIntegral d)
else Nothing
dist = levenshteinDistance defaultEditCosts (T.unpack q)
mkMatcher :: ([Match] -> [ScoredMatch]) -> Matcher
mkMatcher matcher = Matcher . Endo $ fmap fst . sortCompletions . matcher
runMatcher :: Matcher -> [Match] -> [Match]
runMatcher (Matcher m)= appEndo m
sortCompletions :: [ScoredMatch] -> [ScoredMatch]
sortCompletions = sortBy (flip compare `on` snd)
flexMatch :: Text -> [Match] -> [ScoredMatch]
flexMatch = mapMaybe . flexRate
flexRate :: Text -> Match -> Maybe ScoredMatch
flexRate p c = do
score <- flexScore p (identifierFromMatch c)
return (c, score)
flexScore :: Text -> DeclIdent -> Maybe Double
flexScore pat str =
case T.uncons pat of
Nothing -> Nothing
Just (first, p) ->
case TE.encodeUtf8 str =~ TE.encodeUtf8 pat' :: (Int, Int) of
(1,0) -> Nothing
(start,len) -> Just $ calcScore start (start + len)
where
escapedPattern :: [Text]
escapedPattern = map escape (T.unpack p)
escape :: Char -> Text
escape c = if c `elem` ("[\\^$.|?*+(){}" :: String)
then T.pack ['\\', c]
else T.singleton c
pat' = escape first <> foldMap (<> ".*") escapedPattern
calcScore start end =
100.0 / fromIntegral ((1 + start) * (end start + 1))