-------------------------------------------------------------------------------- -- | -- Module : XMonad.Prompt.FuzzyMatch -- Description : A prompt for fuzzy completion matching in prompts akin to Emacs ido-mode. -- Copyright : (C) 2015 Norbert Zeh -- License : GPL -- -- Maintainer : Norbert Zeh <norbert.zeh@gmail.com> -- Stability : unstable -- Portability : unportable -- -- A module for fuzzy completion matching in prompts akin to emacs ido mode. -- -------------------------------------------------------------------------------- module XMonad.Prompt.FuzzyMatch ( -- * Usage -- $usage fuzzyMatch , fuzzySort ) where import XMonad.Prelude import qualified Data.List.NonEmpty as NE -- $usage -- -- This module offers two aspects of fuzzy matching of completions offered by -- XMonad.Prompt. -- -- 'fuzzyMatch' can be used as the searchPredicate in the XPConfig. The effect -- is that any completion that contains the currently typed characters as a -- subsequence is a valid completion; matching is case insensitive. This means -- that the sequence of typed characters can be obtained from the completion by -- deleting an appropriate subset of its characters. Example: "spr" matches -- "FastSPR" but also "SuccinctParallelTrees" because it's a subsequence of the -- latter: "S.......P.r..........". -- -- While this type of inclusiveness is helpful most of the time, it sometimes -- also produces surprising matches. 'fuzzySort' helps sorting matches by -- relevance, using a simple heuristic for measuring relevance. The matches are -- sorted primarily by the length of the substring that contains the query -- characters and secondarily the starting position of the match. So, if the -- search string is "spr" and the matches are "FastSPR", "FasterSPR", and -- "SuccinctParallelTrees", then the order is "FastSPR", "FasterSPR", -- "SuccinctParallelTrees" because both "FastSPR" and "FasterSPR" contain "spr" -- within a substring of length 3 ("SPR") while the shortest substring of -- "SuccinctParallelTrees" that matches "spr" is "SuccinctPar", which has length -- 11. "FastSPR" is ranked before "FasterSPR" because its match starts at -- position 5 while the match in "FasterSPR" starts at position 7. -- -- To use these functions in an XPrompt, for example, for windowPrompt: -- -- > import XMonad.Prompt -- > import XMonad.Prompt.Window ( windowPrompt ) -- > import XMonad.Prompt.FuzzyMatch -- > -- > myXPConfig = def { searchPredicate = fuzzyMatch -- > , sorter = fuzzySort -- > } -- -- then add this to your keys definition: -- -- > , ((modm .|. shiftMask, xK_g), windowPrompt myXPConfig Goto allWindows) -- -- For detailed instructions on editing the key bindings, see -- "XMonad.Doc.Extending#Editing_key_bindings". -- | Returns True if the first argument is a subsequence of the second argument, -- that is, it can be obtained from the second sequence by deleting elements. fuzzyMatch :: String -> String -> Bool fuzzyMatch :: String -> String -> Bool fuzzyMatch [] String _ = Bool True fuzzyMatch String _ [] = Bool False fuzzyMatch xxs :: String xxs@(Char x:String xs) (Char y:String ys) | Char -> Char toLower Char x Char -> Char -> Bool forall a. Eq a => a -> a -> Bool == Char -> Char toLower Char y = String -> String -> Bool fuzzyMatch String xs String ys | Bool otherwise = String -> String -> Bool fuzzyMatch String xxs String ys -- | Sort the given set of strings by how well they match. Match quality is -- measured first by the length of the substring containing the match and second -- by the positions of the matching characters in the string. fuzzySort :: String -> [String] -> [String] fuzzySort :: String -> [String] -> [String] fuzzySort String q = (((Int, Int), String) -> String) -> [((Int, Int), String)] -> [String] forall a b. (a -> b) -> [a] -> [b] map ((Int, Int), String) -> String forall a b. (a, b) -> b snd ([((Int, Int), String)] -> [String]) -> ([String] -> [((Int, Int), String)]) -> [String] -> [String] forall b c a. (b -> c) -> (a -> b) -> a -> c . [((Int, Int), String)] -> [((Int, Int), String)] forall a. Ord a => [a] -> [a] sort ([((Int, Int), String)] -> [((Int, Int), String)]) -> ([String] -> [((Int, Int), String)]) -> [String] -> [((Int, Int), String)] forall b c a. (b -> c) -> (a -> b) -> a -> c . (String -> ((Int, Int), String)) -> [String] -> [((Int, Int), String)] forall a b. (a -> b) -> [a] -> [b] map (String -> String -> ((Int, Int), String) rankMatch String q) rankMatch :: String -> String -> ((Int, Int), String) rankMatch :: String -> String -> ((Int, Int), String) rankMatch String q String s = (if [(Int, Int)] -> Bool forall (t :: * -> *) a. Foldable t => t a -> Bool null [(Int, Int)] matches then (Int forall a. Bounded a => a maxBound, Int forall a. Bounded a => a maxBound) else [(Int, Int)] -> (Int, Int) forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a minimum [(Int, Int)] matches, String s) where matches :: [(Int, Int)] matches = String -> String -> [(Int, Int)] rankMatches String q String s rankMatches :: String -> String -> [(Int, Int)] rankMatches :: String -> String -> [(Int, Int)] rankMatches [] String _ = [(Int 0, Int 0)] rankMatches (Char q:String qs) String s = ((Int, Int) -> (Int, Int)) -> [(Int, Int)] -> [(Int, Int)] forall a b. (a -> b) -> [a] -> [b] map (\(Int l, Int r) -> (Int r Int -> Int -> Int forall a. Num a => a -> a -> a - Int l, Int l)) ([(Int, Int)] -> [(Int, Int)]) -> [(Int, Int)] -> [(Int, Int)] forall a b. (a -> b) -> a -> b $ NonEmpty Char -> String -> [(Int, Int)] findShortestMatches (Char q Char -> String -> NonEmpty Char forall a. a -> [a] -> NonEmpty a :| String qs) String s findShortestMatches :: NonEmpty Char -> String -> [(Int, Int)] findShortestMatches :: NonEmpty Char -> String -> [(Int, Int)] findShortestMatches NonEmpty Char q String s = ([(Int, Int)] -> [Int] -> [(Int, Int)]) -> [(Int, Int)] -> [[Int]] -> [(Int, Int)] forall (t :: * -> *) b a. Foldable t => (b -> a -> b) -> b -> t a -> b foldl' [(Int, Int)] -> [Int] -> [(Int, Int)] extendMatches [(Int, Int)] spans [[Int]] oss where ([Int] os :| [[Int]] oss) = (Char -> [Int]) -> NonEmpty Char -> NonEmpty [Int] forall a b. (a -> b) -> NonEmpty a -> NonEmpty b NE.map (String -> Char -> [Int] findOccurrences String s) NonEmpty Char q spans :: [(Int, Int)] spans = [(Int o, Int o) | Int o <- [Int] os] findOccurrences :: String -> Char -> [Int] findOccurrences :: String -> Char -> [Int] findOccurrences String s Char c = ((Char, Int) -> Int) -> [(Char, Int)] -> [Int] forall a b. (a -> b) -> [a] -> [b] map (Char, Int) -> Int forall a b. (a, b) -> b snd ([(Char, Int)] -> [Int]) -> [(Char, Int)] -> [Int] forall a b. (a -> b) -> a -> b $ ((Char, Int) -> Bool) -> [(Char, Int)] -> [(Char, Int)] forall a. (a -> Bool) -> [a] -> [a] filter ((Char -> Char toLower Char c Char -> Char -> Bool forall a. Eq a => a -> a -> Bool ==) (Char -> Bool) -> ((Char, Int) -> Char) -> (Char, Int) -> Bool forall b c a. (b -> c) -> (a -> b) -> a -> c . Char -> Char toLower (Char -> Char) -> ((Char, Int) -> Char) -> (Char, Int) -> Char forall b c a. (b -> c) -> (a -> b) -> a -> c . (Char, Int) -> Char forall a b. (a, b) -> a fst) ([(Char, Int)] -> [(Char, Int)]) -> [(Char, Int)] -> [(Char, Int)] forall a b. (a -> b) -> a -> b $ String -> [Int] -> [(Char, Int)] forall a b. [a] -> [b] -> [(a, b)] zip String s [Int 0..] extendMatches :: [(Int, Int)] -> [Int] -> [(Int, Int)] extendMatches :: [(Int, Int)] -> [Int] -> [(Int, Int)] extendMatches [(Int, Int)] spans = ([(Int, Int)] -> (Int, Int)) -> [[(Int, Int)]] -> [(Int, Int)] forall a b. (a -> b) -> [a] -> [b] map [(Int, Int)] -> (Int, Int) forall a. [a] -> a last ([[(Int, Int)]] -> [(Int, Int)]) -> ([Int] -> [[(Int, Int)]]) -> [Int] -> [(Int, Int)] forall b c a. (b -> c) -> (a -> b) -> a -> c . ((Int, Int) -> (Int, Int) -> Bool) -> [(Int, Int)] -> [[(Int, Int)]] forall a. (a -> a -> Bool) -> [a] -> [[a]] groupBy (Int -> Int -> Bool forall a. Eq a => a -> a -> Bool (==) (Int -> Int -> Bool) -> ((Int, Int) -> Int) -> (Int, Int) -> (Int, Int) -> Bool forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c `on` (Int, Int) -> Int forall a b. (a, b) -> b snd) ([(Int, Int)] -> [[(Int, Int)]]) -> ([Int] -> [(Int, Int)]) -> [Int] -> [[(Int, Int)]] forall b c a. (b -> c) -> (a -> b) -> a -> c . [(Int, Int)] -> [Int] -> [(Int, Int)] extendMatches' [(Int, Int)] spans extendMatches' :: [(Int, Int)] -> [Int] -> [(Int, Int)] extendMatches' :: [(Int, Int)] -> [Int] -> [(Int, Int)] extendMatches' [] [Int] _ = [] extendMatches' [(Int, Int)] _ [] = [] extendMatches' spans :: [(Int, Int)] spans@((Int l, Int r):[(Int, Int)] spans') xs :: [Int] xs@(Int x:[Int] xs') | Int r Int -> Int -> Bool forall a. Ord a => a -> a -> Bool < Int x = (Int l, Int x) (Int, Int) -> [(Int, Int)] -> [(Int, Int)] forall a. a -> [a] -> [a] : [(Int, Int)] -> [Int] -> [(Int, Int)] extendMatches' [(Int, Int)] spans' [Int] xs | Bool otherwise = [(Int, Int)] -> [Int] -> [(Int, Int)] extendMatches' [(Int, Int)] spans [Int] xs'