    --------------------------------------------------------------------------------
    -- |
    -- 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
    a String
    b = String -> String -> Bool
    forall a. Eq a => [a] -> [a] -> Bool
    isSubsequenceOf ((Char -> Char) -> String -> String
    forall a b. (a -> b) -> [a] -> [b]
    map Char -> Char
    toLower String
    a) ((Char -> Char) -> String -> String
    forall a b. (a -> b) -> [a] -> [b]
    map Char -> Char
    toLower String
    b)

    -- | 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 a. [a] -> 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 a. Ord a => [a] -> a
    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 b a. (b -> a -> b) -> b -> [a] -> b
    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. HasCallStack => [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'