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 Text.EditDistance
import Text.Regex.TDFA ((=~))
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 pat str =
case T.uncons pat of
Nothing -> Nothing
Just (first, pattern) ->
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 pattern)
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))