module Language.PureScript.Ide.Matcher
( Matcher
, runMatcher
, flexMatcher
) where
import Protolude
import Control.Monad.Fail (fail)
import Data.Aeson
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 a = (Match a, Double)
newtype Matcher a = Matcher (Endo [Match a]) deriving (NonEmpty (Matcher a) -> Matcher a
Matcher a -> Matcher a -> Matcher a
forall b. Integral b => b -> Matcher a -> Matcher a
forall a. NonEmpty (Matcher a) -> Matcher a
forall a. Matcher a -> Matcher a -> Matcher a
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
forall a b. Integral b => b -> Matcher a -> Matcher a
stimes :: forall b. Integral b => b -> Matcher a -> Matcher a
$cstimes :: forall a b. Integral b => b -> Matcher a -> Matcher a
sconcat :: NonEmpty (Matcher a) -> Matcher a
$csconcat :: forall a. NonEmpty (Matcher a) -> Matcher a
<> :: Matcher a -> Matcher a -> Matcher a
$c<> :: forall a. Matcher a -> Matcher a -> Matcher a
Semigroup, Matcher a
[Matcher a] -> Matcher a
Matcher a -> Matcher a -> Matcher a
forall a. Semigroup (Matcher a)
forall a. Matcher a
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
forall a. [Matcher a] -> Matcher a
forall a. Matcher a -> Matcher a -> Matcher a
mconcat :: [Matcher a] -> Matcher a
$cmconcat :: forall a. [Matcher a] -> Matcher a
mappend :: Matcher a -> Matcher a -> Matcher a
$cmappend :: forall a. Matcher a -> Matcher a -> Matcher a
mempty :: Matcher a
$cmempty :: forall a. Matcher a
Monoid)
instance FromJSON (Matcher IdeDeclarationAnn) where
parseJSON :: Value -> Parser (Matcher IdeDeclarationAnn)
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"matcher" forall a b. (a -> b) -> a -> b
$ \Object
o -> do
(Maybe Text
matcher :: Maybe Text) <- Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"matcher"
case Maybe Text
matcher of
Just Text
"flex" -> do
Object
params <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"params"
Text -> Matcher IdeDeclarationAnn
flexMatcher forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
params forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"search"
Just Text
"distance" -> do
Object
params <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"params"
Text -> Int -> Matcher IdeDeclarationAnn
distanceMatcher
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
params forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"search"
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
params forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"maximumDistance"
Just Text
s -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"Unknown matcher: " forall a. Semigroup a => a -> a -> a
<> forall a b. (Show a, StringConv String b) => a -> b
show Text
s)
Maybe Text
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Monoid a => a
mempty
flexMatcher :: Text -> Matcher IdeDeclarationAnn
flexMatcher :: Text -> Matcher IdeDeclarationAnn
flexMatcher Text
p = forall a. ([Match a] -> [ScoredMatch a]) -> Matcher a
mkMatcher (Text
-> [Match IdeDeclarationAnn] -> [ScoredMatch IdeDeclarationAnn]
flexMatch Text
p)
distanceMatcher :: Text -> Int -> Matcher IdeDeclarationAnn
distanceMatcher :: Text -> Int -> Matcher IdeDeclarationAnn
distanceMatcher Text
q Int
maxDist = forall a. ([Match a] -> [ScoredMatch a]) -> Matcher a
mkMatcher (Text
-> Int
-> [Match IdeDeclarationAnn]
-> [ScoredMatch IdeDeclarationAnn]
distanceMatcher' Text
q Int
maxDist)
distanceMatcher' :: Text -> Int -> [Match IdeDeclarationAnn] -> [ScoredMatch IdeDeclarationAnn]
distanceMatcher' :: Text
-> Int
-> [Match IdeDeclarationAnn]
-> [ScoredMatch IdeDeclarationAnn]
distanceMatcher' Text
q Int
maxDist = forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Match IdeDeclarationAnn -> Maybe (ScoredMatch IdeDeclarationAnn)
go
where
go :: Match IdeDeclarationAnn -> Maybe (ScoredMatch IdeDeclarationAnn)
go Match IdeDeclarationAnn
m = let d :: Int
d = String -> Int
dist (Text -> String
T.unpack Text
y)
y :: Text
y = IdeDeclaration -> Text
identifierFromIdeDeclaration (IdeDeclarationAnn -> IdeDeclaration
discardAnn (forall a. Match a -> a
unwrapMatch Match IdeDeclarationAnn
m))
in if Int
d forall a. Ord a => a -> a -> Bool
<= Int
maxDist
then forall a. a -> Maybe a
Just (Match IdeDeclarationAnn
m, Double
1 forall a. Fractional a => a -> a -> a
/ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
d)
else forall a. Maybe a
Nothing
dist :: String -> Int
dist = EditCosts -> String -> String -> Int
levenshteinDistance EditCosts
defaultEditCosts (Text -> String
T.unpack Text
q)
mkMatcher :: ([Match a] -> [ScoredMatch a]) -> Matcher a
mkMatcher :: forall a. ([Match a] -> [ScoredMatch a]) -> Matcher a
mkMatcher [Match a] -> [ScoredMatch a]
matcher = forall a. Endo [Match a] -> Matcher a
Matcher forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> a) -> Endo a
Endo forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [ScoredMatch a] -> [ScoredMatch a]
sortCompletions forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Match a] -> [ScoredMatch a]
matcher
runMatcher :: Matcher a -> [Match a] -> [Match a]
runMatcher :: forall a. Matcher a -> [Match a] -> [Match a]
runMatcher (Matcher Endo [Match a]
m)= forall a. Endo a -> a -> a
appEndo Endo [Match a]
m
sortCompletions :: [ScoredMatch a] -> [ScoredMatch a]
sortCompletions :: forall a. [ScoredMatch a] -> [ScoredMatch a]
sortCompletions = forall o a. Ord o => (a -> o) -> [a] -> [a]
sortOn (forall a. a -> Down a
Down forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd)
flexMatch :: Text -> [Match IdeDeclarationAnn] -> [ScoredMatch IdeDeclarationAnn]
flexMatch :: Text
-> [Match IdeDeclarationAnn] -> [ScoredMatch IdeDeclarationAnn]
flexMatch = forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text
-> Match IdeDeclarationAnn -> Maybe (ScoredMatch IdeDeclarationAnn)
flexRate
flexRate :: Text -> Match IdeDeclarationAnn -> Maybe (ScoredMatch IdeDeclarationAnn)
flexRate :: Text
-> Match IdeDeclarationAnn -> Maybe (ScoredMatch IdeDeclarationAnn)
flexRate Text
p Match IdeDeclarationAnn
c = do
Double
score <- Text -> Text -> Maybe Double
flexScore Text
p (IdeDeclaration -> Text
identifierFromIdeDeclaration (IdeDeclarationAnn -> IdeDeclaration
discardAnn (forall a. Match a -> a
unwrapMatch Match IdeDeclarationAnn
c)))
forall (m :: * -> *) a. Monad m => a -> m a
return (Match IdeDeclarationAnn
c, Double
score)
flexScore :: Text -> Text -> Maybe Double
flexScore :: Text -> Text -> Maybe Double
flexScore Text
pat Text
str =
case Text -> Maybe (Char, Text)
T.uncons Text
pat of
Maybe (Char, Text)
Nothing -> forall a. Maybe a
Nothing
Just (Char
first', Text
p) ->
case Text -> ByteString
TE.encodeUtf8 Text
str forall source source1 target.
(RegexMaker Regex CompOption ExecOption source,
RegexContext Regex source1 target) =>
source1 -> source -> target
=~ Text -> ByteString
TE.encodeUtf8 Text
pat' :: (Int, Int) of
(-1,Int
0) -> forall a. Maybe a
Nothing
(Int
start,Int
len) -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall {a} {a}. (Fractional a, Integral a) => a -> a -> a
calcScore Int
start (Int
start forall a. Num a => a -> a -> a
+ Int
len)
where
escapedPattern :: [Text]
escapedPattern :: [Text]
escapedPattern = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map Char -> Text
escape (Text -> String
T.unpack Text
p)
escape :: Char -> Text
escape :: Char -> Text
escape Char
c = if Char
c forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` Text -> String
T.unpack Text
"[\\^$.|?*+(){}"
then String -> Text
T.pack [Char
'\\', Char
c]
else Char -> Text
T.singleton Char
c
pat' :: Text
pat' = Char -> Text
escape Char
first' forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (forall a. Semigroup a => a -> a -> a
<> Text
".*") [Text]
escapedPattern
calcScore :: a -> a -> a
calcScore a
start a
end =
a
100.0 forall a. Fractional a => a -> a -> a
/ forall a b. (Integral a, Num b) => a -> b
fromIntegral ((a
1 forall a. Num a => a -> a -> a
+ a
start) forall a. Num a => a -> a -> a
* (a
end forall a. Num a => a -> a -> a
- a
start forall a. Num a => a -> a -> a
+ a
1))