Fixed X.A.GridSelect to be consistent in the way it (now) sorts the shown

Ignore-this: 1d0991f9fb44e42f5d1c5a4f427ea661
elements when modifying the searchString.

The implemented ordering sorts based on how "deep the needle is in the
haystack", meaning that searching for "st" in the elements "Install" and "Study"
will order them as "Study" and "Install". Previously there was no ordering and
when using GridSelect to select workspaces, the ordering was not consistent, as
the list of workspaces (if not modified manually) is ordered by last used. In
this case either "Study" or "Install" would come first depending on which
workspace was last visited.

darcs-hash:20120501180415-abfbf-31b5c20e65c1ddb5835c61259d363fd3f67f471b.gz

1 files changed, 34 insertions, 6 deletions

diff --git a/XMonad/Actions/GridSelect.hs b/XMonad/Actions/GridSelect.hs
index 94432a0..e7ba0b7 100644
--- a/XMonad/Actions/GridSelect.hs
+++ b/XMonad/Actions/GridSelect.hs
@@ -74,6 +74,7 @@ module XMonad.Actions.GridSelect (
 import Data.Maybe
 import Data.Bits
 import Data.Char
+import Data.Ord (comparing)
 import Control.Applicative
 import Control.Monad.State
 import Control.Arrow
@@ -234,12 +235,39 @@ data TwoDState a = TwoDState { td_curpos :: TwoDPosition
                              }
 
 td_elementmap :: TwoDState a -> [(TwoDPosition,(String,a))]
-td_elementmap s =
-  let positions = td_availSlots s
-      elements = L.filter (((td_searchString s) `isSubstringOf`) . fst) (td_elements s)
-  in zipWith (,) positions elements
-  where sub `isSubstringOf` string = or [ (upper sub) `isPrefixOf` t | t <- tails (upper string) ]
-        upper = map toUpper
+td_elementmap s = zipWith (,) positions sortedElements
+  where
+    TwoDState {td_availSlots = positions,
+               td_searchString = searchString} = s
+    -- Filter out any elements that don't contain the searchString (case insensitive)
+    filteredElements = L.filter ((searchString `isInfixOfI`) . fst) (td_elements s)
+    -- Sorts the elementmap
+    sortedElements = orderElementmap searchString filteredElements
+    -- Case Insensitive version of isInfixOf
+    needle `isInfixOfI` haystack = (upper needle) `isInfixOf` (upper haystack)
+    upper = map toUpper
+
+
+-- | We enforce an ordering such that we will always get the same result. If the
+-- elements position changes from call to call of gridselect, then the shown
+-- positions will also change when you search for the same string. This is
+-- especially the case when using gridselect for showing and switching between
+-- workspaces, as workspaces are usually shown in order of last visited.  The
+-- chosen ordering is "how deep in the haystack the needle is" (number of
+-- characters from the beginning of the string and the needle).
+orderElementmap :: String  -> [(String,a)] -> [(String,a)]
+orderElementmap searchString elements = if not $ null searchString then sortedElements else elements
+  where
+    upper = map toUpper
+    -- Calculates a (score, element) tuple where the score is the depth of the (case insensitive) needle.
+    calcScore element = ( length $ takeWhile (not . isPrefixOf (upper searchString)) (tails . upper . fst $ element)
+                        , element)
+    -- Use the score and then the string as the parameters for comparing, making
+    -- it consistent even when two strings that score the same, as it will then be
+    -- sorted by the strings, making it consistent.
+    compareScore = comparing (\(score, (str,_)) -> (score, str))
+    sortedElements = map snd . sortBy compareScore $ map calcScore elements
+
 
 newtype TwoD a b = TwoD { unTwoD :: StateT (TwoDState a) X b }
     deriving (Monad,Functor,MonadState (TwoDState a))