module PureScript.Ide.Matcher (Matcher, flexMatcher, runMatcher) where
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 PureScript.Ide.Types
import Text.Regex.TDFA ((=~))
import Text.EditDistance
type ScoredCompletion = (Completion, Double)
newtype Matcher = Matcher (Endo [Completion]) 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 pattern = mkMatcher (flexMatch pattern)
distanceMatcher :: Text -> Int -> Matcher
distanceMatcher q maxDist = mkMatcher (distanceMatcher' q maxDist)
distanceMatcher' :: Text -> Int -> [Completion] -> [ScoredCompletion]
distanceMatcher' q maxDist = mapMaybe go
where
go c@(Completion (_, y, _)) = let d = dist (T.unpack y)
in if d <= maxDist
then Just (c, 1 / fromIntegral d)
else Nothing
dist = levenshteinDistance defaultEditCosts (T.unpack q)
mkMatcher :: ([Completion] -> [ScoredCompletion]) -> Matcher
mkMatcher matcher = Matcher . Endo $ fmap fst . sortCompletions . matcher
runMatcher :: Matcher -> [Completion] -> [Completion]
runMatcher (Matcher m)= appEndo m
sortCompletions :: [ScoredCompletion] -> [ScoredCompletion]
sortCompletions = sortBy (flip compare `on` snd)
flexMatch :: Text -> [Completion] -> [ScoredCompletion]
flexMatch pattern = mapMaybe (flexRate pattern)
flexRate :: Text -> Completion -> Maybe ScoredCompletion
flexRate pattern c@(Completion (_,ident,_)) = do
score <- flexScore pattern ident
return (c, score)
flexScore :: Text -> DeclIdent -> Maybe Double
flexScore "" _ = Nothing
flexScore pat str =
case TE.encodeUtf8 str =~ TE.encodeUtf8 pat' :: (Int, Int) of
(1,0) -> Nothing
(start,len) -> Just $ calcScore start (start + len)
where
Just (first,pattern) = T.uncons pat
pat' = first `T.cons` T.concatMap (T.snoc ".*") pattern
calcScore start end =
100.0 / fromIntegral ((1 + start) * (end start + 1))