    {-# LANGUAGE ScopedTypeVariables, GeneralizedNewtypeDeriving, FlexibleInstances, TupleSections #-}
    -----------------------------------------------------------------------------
    -- |
    -- Module      :  XMonad.Actions.GridSelect
    -- Description :  Display items in a 2D grid and select from it with the keyboard or the mouse.
    -- Copyright   :  Clemens Fruhwirth <clemens@endorphin.org>
    -- License     :  BSD-style (see LICENSE)
    --
    -- Maintainer  :  Clemens Fruhwirth <clemens@endorphin.org>
    -- Stability   :  unstable
    -- Portability :  unportable
    --
    -- GridSelect displays items(e.g. the opened windows) in a 2D grid and lets
    -- the user select from it with the cursor/hjkl keys or the mouse.
    --
    -----------------------------------------------------------------------------

    module XMonad.Actions.GridSelect (
        -- * Usage
        -- $usage

        -- ** Customizing
        -- *** Using a common GSConfig
        -- $commonGSConfig

        -- *** Custom keybindings
        -- $keybindings

        -- * Configuration
        GSConfig(..),
        def,
        TwoDPosition,
        buildDefaultGSConfig,

        -- * Variations on 'gridselect'
        gridselect,
        gridselectWindow,
        withSelectedWindow,
        bringSelected,
        goToSelected,
        gridselectWorkspace,
        gridselectWorkspace',
        spawnSelected,
        runSelectedAction,

        -- * Colorizers
        HasColorizer(defaultColorizer),
        fromClassName,
        stringColorizer,
        colorRangeFromClassName,
        stringToRatio,

        -- * Navigation Mode assembly
        TwoD,
        makeXEventhandler,
        shadowWithKeymap,

        -- * Built-in Navigation Mode
        defaultNavigation,
        substringSearch,
        navNSearch,

        -- * Navigation Components
        setPos,
        move,
        moveNext, movePrev,
        select,
        cancel,
        transformSearchString,

        -- * Rearrangers
        -- $rearrangers
        Rearranger,
        noRearranger,
        searchStringRearrangerGenerator,

        -- * Screenshots
        -- $screenshots

        -- * Types
        TwoDState,
        ) where
    import Control.Arrow ((***))
    import Data.Bits
    import Data.Ord (comparing)
    import Control.Monad.State
    import Data.List as L
    import qualified Data.Map as M
    import XMonad hiding (liftX)
    import XMonad.Prelude
    import XMonad.Util.Font
    import XMonad.Prompt (mkUnmanagedWindow)
    import XMonad.StackSet as W
    import XMonad.Layout.Decoration
    import XMonad.Util.NamedWindows
    import XMonad.Actions.WindowBringer (bringWindow)
    import Text.Printf
    import System.Random (mkStdGen, randomR)
    import Data.Word (Word8)
    import qualified Data.List.NonEmpty as NE

    -- $usage
    --
    -- You can use this module with the following in your @xmonad.hs@:
    --
    -- >    import XMonad.Actions.GridSelect
    --
    -- Then add a keybinding, e.g.
    --
    -- >    , ((modm, xK_g), goToSelected def)
    --
    -- This module also supports displaying arbitrary information in a grid and letting
    -- the user select from it. E.g. to spawn an application from a given list, you
    -- can use the following:
    --
    -- >   , ((modm, xK_s), spawnSelected def ["xterm","gmplayer","gvim"])

    -- $commonGSConfig
    --
    -- It is possible to bind a @gsconfig@ at top-level in your configuration. Like so:
    --
    -- > -- the top of your config
    -- > {-# LANGUAGE NoMonomorphismRestriction #-}
    -- > import XMonad
    -- > ...
    -- > gsconfig1 = def { gs_cellheight = 30, gs_cellwidth = 100 }
    --
    -- An example where 'buildDefaultGSConfig' is used instead of 'def'
    -- in order to specify a custom colorizer is @gsconfig2@ (found in
    -- "XMonad.Actions.GridSelect#Colorizers"):
    --
    -- > gsconfig2 colorizer = (buildDefaultGSConfig colorizer) { gs_cellheight = 30, gs_cellwidth = 100 }
    --
    -- > -- | A green monochrome colorizer based on window class
    -- > greenColorizer = colorRangeFromClassName
    -- >                      black            -- lowest inactive bg
    -- >                      (0x70,0xFF,0x70) -- highest inactive bg
    -- >                      black            -- active bg
    -- >                      white            -- inactive fg
    -- >                      white            -- active fg
    -- >   where black = minBound
    -- >         white = maxBound
    --
    -- Then you can bind to:
    --
    -- >     ,((modm, xK_g), goToSelected $ gsconfig2 myWinColorizer)
    -- >     ,((modm, xK_p), spawnSelected (gsconfig2 defaultColorizer) ["xterm","gvim"])

    -- $keybindings
    --
    -- You can build you own navigation mode and submodes by combining the
    -- exported action ingredients and assembling them using 'makeXEventhandler' and 'shadowWithKeymap'.
    --
    -- > myNavigation :: TwoD a (Maybe a)
    -- > myNavigation = makeXEventhandler $ shadowWithKeymap navKeyMap navDefaultHandler
    -- >  where navKeyMap = M.fromList [
    -- >           ((0,xK_Escape), cancel)
    -- >          ,((0,xK_Return), select)
    -- >          ,((0,xK_slash) , substringSearch myNavigation)
    -- >          ,((0,xK_Left)  , move (-1,0)  >> myNavigation)
    -- >          ,((0,xK_h)     , move (-1,0)  >> myNavigation)
    -- >          ,((0,xK_Right) , move (1,0)   >> myNavigation)
    -- >          ,((0,xK_l)     , move (1,0)   >> myNavigation)
    -- >          ,((0,xK_Down)  , move (0,1)   >> myNavigation)
    -- >          ,((0,xK_j)     , move (0,1)   >> myNavigation)
    -- >          ,((0,xK_Up)    , move (0,-1)  >> myNavigation)
    -- >          ,((0,xK_y)     , move (-1,-1) >> myNavigation)
    -- >          ,((0,xK_i)     , move (1,-1)  >> myNavigation)
    -- >          ,((0,xK_n)     , move (-1,1)  >> myNavigation)
    -- >          ,((0,xK_m)     , move (1,-1)  >> myNavigation)
    -- >          ,((0,xK_space) , setPos (0,0) >> myNavigation)
    -- >          ]
    -- >        -- The navigation handler ignores unknown key symbols
    -- >        navDefaultHandler = const myNavigation
    --
    -- You can then define @gsconfig3@ which may be used in exactly the same manner as @gsconfig1@:
    --
    -- > gsconfig3 = def
    -- >    { gs_cellheight = 30
    -- >    , gs_cellwidth = 100
    -- >    , gs_navigate = myNavigation
    -- >    }

    -- $screenshots
    --
    -- Selecting a workspace:
    --
    -- <<http://haskell.org/wikiupload/a/a9/Xmonad-gridselect-workspace.png>>
    --
    -- Selecting a window by title:
    --
    -- <<http://haskell.org/wikiupload/3/35/Xmonad-gridselect-window-aavogt.png>>

    -- | The 'Default' instance gives a basic configuration for 'gridselect', with
    -- the colorizer chosen based on the type.
    --
    -- If you want to replace the 'gs_colorizer' field, use 'buildDefaultGSConfig'
    -- instead of 'def' to avoid ambiguous type variables.
    data GSConfig a = GSConfig {
          forall a. GSConfig a -> Integer
    gs_cellheight :: Integer,
          forall a. GSConfig a -> Integer
    gs_cellwidth :: Integer,
          forall a. GSConfig a -> Integer
    gs_cellpadding :: Integer,
          forall a. GSConfig a -> a -> Bool -> X (String, String)
    gs_colorizer :: a -> Bool -> X (String, String),
          forall a. GSConfig a -> String
    gs_font :: String,
          forall a. GSConfig a -> TwoD a (Maybe a)
    gs_navigate :: TwoD a (Maybe a),
          -- ^ Customize key bindings for a GridSelect
          forall a. GSConfig a -> Rearranger a
    gs_rearranger :: Rearranger a,
          forall a. GSConfig a -> Double
    gs_originFractX :: Double,
          forall a. GSConfig a -> Double
    gs_originFractY :: Double,
          forall a. GSConfig a -> String
    gs_bordercolor :: String,
          forall a. GSConfig a -> Bool
    gs_cancelOnEmptyClick :: Bool
          -- ^ When True, click on empty space will cancel GridSelect
    }

    -- | That is 'fromClassName' if you are selecting a 'Window', or
    -- 'defaultColorizer' if you are selecting a 'String'. The catch-all instance
    -- @HasColorizer a@ uses the 'focusedBorderColor' and 'normalBorderColor'
    -- colors.
    class HasColorizer a where
        defaultColorizer :: a -> Bool -> X (String, String)

    instance HasColorizer Window where
        defaultColorizer :: Word64 -> Bool -> X (String, String)
    defaultColorizer = Word64 -> Bool -> X (String, String)
    fromClassName

    instance HasColorizer String where
        defaultColorizer :: String -> Bool -> X (String, String)
    defaultColorizer = String -> Bool -> X (String, String)
    stringColorizer

    instance {-# OVERLAPPABLE #-} HasColorizer a where
        defaultColorizer :: a -> Bool -> X (String, String)
    defaultColorizer a
    _ Bool
    isFg =
            let getColor :: XConfig l -> String
    getColor = if Bool
    isFg then XConfig l -> String
    forall (l :: * -> *). XConfig l -> String
    focusedBorderColor else XConfig l -> String
    forall (l :: * -> *). XConfig l -> String
    normalBorderColor
            in (XConf -> (String, String)) -> X (String, String)
    forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
    asks ((XConf -> (String, String)) -> X (String, String))
    -> (XConf -> (String, String)) -> X (String, String)
    forall a b. (a -> b) -> a -> b
    $ (, String
    "black") (String -> (String, String))
    -> (XConf -> String) -> XConf -> (String, String)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . XConfig Layout -> String
    forall (l :: * -> *). XConfig l -> String
    getColor (XConfig Layout -> String)
    -> (XConf -> XConfig Layout) -> XConf -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . XConf -> XConfig Layout
    config

    instance HasColorizer a => Default (GSConfig a) where
        def :: GSConfig a
    def = (a -> Bool -> X (String, String)) -> GSConfig a
    forall a. (a -> Bool -> X (String, String)) -> GSConfig a
    buildDefaultGSConfig a -> Bool -> X (String, String)
    forall a. HasColorizer a => a -> Bool -> X (String, String)
    defaultColorizer

    type TwoDPosition = (Integer, Integer)

    type TwoDElementMap a = [(TwoDPosition,(String,a))]

    data TwoDState a = TwoDState { forall a. TwoDState a -> TwoDPosition
    td_curpos :: TwoDPosition
                                 , forall a. TwoDState a -> [TwoDPosition]
    td_availSlots :: [TwoDPosition]
                                 , forall a. TwoDState a -> [(String, a)]
    td_elements :: [(String,a)]
                                 , forall a. TwoDState a -> GSConfig a
    td_gsconfig :: GSConfig a
                                 , forall a. TwoDState a -> XMonadFont
    td_font :: XMonadFont
                                 , forall a. TwoDState a -> Integer
    td_paneX :: Integer
                                 , forall a. TwoDState a -> Integer
    td_paneY :: Integer
                                 , forall a. TwoDState a -> Word64
    td_drawingWin :: Window
                                 , forall a. TwoDState a -> String
    td_searchString :: String
                                 , forall a. TwoDState a -> TwoDElementMap a
    td_elementmap :: TwoDElementMap a
                                 }

    generateElementmap :: TwoDState a -> X (TwoDElementMap a)
    generateElementmap :: forall a. TwoDState a -> X (TwoDElementMap a)
    generateElementmap TwoDState a
    s = do
        rearrangedElements <- Rearranger a
    rearranger String
    searchString [(String, a)]
    sortedElements
        return $ zip positions rearrangedElements
      where
        TwoDState {td_availSlots :: forall a. TwoDState a -> [TwoDPosition]
    td_availSlots = [TwoDPosition]
    positions,
                   td_gsconfig :: forall a. TwoDState a -> GSConfig a
    td_gsconfig = GSConfig a
    gsconfig,
                   td_searchString :: forall a. TwoDState a -> String
    td_searchString = String
    searchString} = TwoDState a
    s
        GSConfig {gs_rearranger :: forall a. GSConfig a -> Rearranger a
    gs_rearranger = Rearranger a
    rearranger} = GSConfig a
    gsconfig
        -- Filter out any elements that don't contain the searchString (case insensitive)
        filteredElements :: [(String, a)]
    filteredElements = ((String, a) -> Bool) -> [(String, a)] -> [(String, a)]
    forall a. (a -> Bool) -> [a] -> [a]
    L.filter ((String
    searchString String -> String -> Bool
    `isInfixOfI`) (String -> Bool) -> ((String, a) -> String) -> (String, a) -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (String, a) -> String
    forall a b. (a, b) -> a
    fst) (TwoDState a -> [(String, a)]
    forall a. TwoDState a -> [(String, a)]
    td_elements TwoDState a
    s)
        -- Sorts the elementmap
        sortedElements :: [(String, a)]
    sortedElements = String -> [(String, a)] -> [(String, a)]
    forall a. String -> [(String, a)] -> [(String, a)]
    orderElementmap String
    searchString [(String, a)]
    filteredElements
        -- Case Insensitive version of isInfixOf
        String
    needle isInfixOfI :: String -> String -> Bool
    `isInfixOfI` String
    haystack = String -> String
    upper String
    needle String -> String -> Bool
    forall a. Eq a => [a] -> [a] -> Bool
    `isInfixOf` String -> String
    upper String
    haystack
        upper :: String -> String
    upper = (Char -> Char) -> String -> String
    forall a b. (a -> b) -> [a] -> [b]
    map Char -> Char
    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 :: forall a. String -> [(String, a)] -> [(String, a)]
    orderElementmap String
    searchString [(String, a)]
    elements = if Bool -> Bool
    not (Bool -> Bool) -> Bool -> Bool
    forall a b. (a -> b) -> a -> b
    $ String -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null String
    searchString then [(String, a)]
    sortedElements else [(String, a)]
    elements
      where
        upper :: String -> String
    upper = (Char -> Char) -> String -> String
    forall a b. (a -> b) -> [a] -> [b]
    map Char -> Char
    toUpper
        -- Calculates a (score, element) tuple where the score is the depth of the (case insensitive) needle.
        calcScore :: (String, b) -> (Int, (String, b))
    calcScore (String, b)
    element = ( [String] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length ([String] -> Int) -> [String] -> Int
    forall a b. (a -> b) -> a -> b
    $ (String -> Bool) -> [String] -> [String]
    forall a. (a -> Bool) -> [a] -> [a]
    takeWhile (Bool -> Bool
    not (Bool -> Bool) -> (String -> Bool) -> String -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> Bool
    forall a. Eq a => [a] -> [a] -> Bool
    isPrefixOf (String -> String
    upper String
    searchString)) (String -> [String]
    forall a. [a] -> [[a]]
    tails (String -> [String])
    -> ((String, b) -> String) -> (String, b) -> [String]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String
    upper (String -> String)
    -> ((String, b) -> String) -> (String, b) -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (String, b) -> String
    forall a b. (a, b) -> a
    fst ((String, b) -> [String]) -> (String, b) -> [String]
    forall a b. (a -> b) -> a -> b
    $ (String, b)
    element)
                            , (String, b)
    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 :: (Int, (String, b)) -> (Int, (String, b)) -> Ordering
    compareScore = ((Int, (String, b)) -> (Int, String))
    -> (Int, (String, b)) -> (Int, (String, b)) -> Ordering
    forall a b. Ord a => (b -> a) -> b -> b -> Ordering
    comparing (\(Int
    score, (String
    str,b
    _)) -> (Int
    score, String
    str))
        sortedElements :: [(String, a)]
    sortedElements = ((Int, (String, a)) -> (String, a))
    -> [(Int, (String, a))] -> [(String, a)]
    forall a b. (a -> b) -> [a] -> [b]
    map (Int, (String, a)) -> (String, a)
    forall a b. (a, b) -> b
    snd ([(Int, (String, a))] -> [(String, a)])
    -> ([(Int, (String, a))] -> [(Int, (String, a))])
    -> [(Int, (String, a))]
    -> [(String, a)]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ((Int, (String, a)) -> (Int, (String, a)) -> Ordering)
    -> [(Int, (String, a))] -> [(Int, (String, a))]
    forall a. (a -> a -> Ordering) -> [a] -> [a]
    sortBy (Int, (String, a)) -> (Int, (String, a)) -> Ordering
    forall {b}. (Int, (String, b)) -> (Int, (String, b)) -> Ordering
    compareScore ([(Int, (String, a))] -> [(String, a)])
    -> [(Int, (String, a))] -> [(String, a)]
    forall a b. (a -> b) -> a -> b
    $ ((String, a) -> (Int, (String, a)))
    -> [(String, a)] -> [(Int, (String, a))]
    forall a b. (a -> b) -> [a] -> [b]
    map (String, a) -> (Int, (String, a))
    forall {b}. (String, b) -> (Int, (String, b))
    calcScore [(String, a)]
    elements

    newtype TwoD a b = TwoD { forall a b. TwoD a b -> StateT (TwoDState a) X b
    unTwoD :: StateT (TwoDState a) X b }
        deriving ((forall a b. (a -> b) -> TwoD a a -> TwoD a b)
    -> (forall a b. a -> TwoD a b -> TwoD a a) -> Functor (TwoD a)
    forall a b. a -> TwoD a b -> TwoD a a
    forall a b. (a -> b) -> TwoD a a -> TwoD a b
    forall a a b. a -> TwoD a b -> TwoD a a
    forall a a b. (a -> b) -> TwoD a a -> TwoD a b
    forall (f :: * -> *).
    (forall a b. (a -> b) -> f a -> f b)
    -> (forall a b. a -> f b -> f a) -> Functor f
    $cfmap :: forall a a b. (a -> b) -> TwoD a a -> TwoD a b
    fmap :: forall a b. (a -> b) -> TwoD a a -> TwoD a b
    $c<$ :: forall a a b. a -> TwoD a b -> TwoD a a
    <$ :: forall a b. a -> TwoD a b -> TwoD a a
    Functor, Functor (TwoD a)
    Functor (TwoD a) =>
    (forall a. a -> TwoD a a)
    -> (forall a b. TwoD a (a -> b) -> TwoD a a -> TwoD a b)
    -> (forall a b c.
        (a -> b -> c) -> TwoD a a -> TwoD a b -> TwoD a c)
    -> (forall a b. TwoD a a -> TwoD a b -> TwoD a b)
    -> (forall a b. TwoD a a -> TwoD a b -> TwoD a a)
    -> Applicative (TwoD a)
    forall a. Functor (TwoD a)
    forall a. a -> TwoD a a
    forall a a. a -> TwoD a a
    forall a b. TwoD a a -> TwoD a b -> TwoD a a
    forall a b. TwoD a a -> TwoD a b -> TwoD a b
    forall a b. TwoD a (a -> b) -> TwoD a a -> TwoD a b
    forall a a b. TwoD a a -> TwoD a b -> TwoD a a
    forall a a b. TwoD a a -> TwoD a b -> TwoD a b
    forall a a b. TwoD a (a -> b) -> TwoD a a -> TwoD a b
    forall a b c. (a -> b -> c) -> TwoD a a -> TwoD a b -> TwoD a c
    forall a a b c. (a -> b -> c) -> TwoD a a -> TwoD a b -> TwoD a c
    forall (f :: * -> *).
    Functor f =>
    (forall a. a -> f a)
    -> (forall a b. f (a -> b) -> f a -> f b)
    -> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
    -> (forall a b. f a -> f b -> f b)
    -> (forall a b. f a -> f b -> f a)
    -> Applicative f
    $cpure :: forall a a. a -> TwoD a a
    pure :: forall a. a -> TwoD a a
    $c<*> :: forall a a b. TwoD a (a -> b) -> TwoD a a -> TwoD a b
    <*> :: forall a b. TwoD a (a -> b) -> TwoD a a -> TwoD a b
    $cliftA2 :: forall a a b c. (a -> b -> c) -> TwoD a a -> TwoD a b -> TwoD a c
    liftA2 :: forall a b c. (a -> b -> c) -> TwoD a a -> TwoD a b -> TwoD a c
    $c*> :: forall a a b. TwoD a a -> TwoD a b -> TwoD a b
    *> :: forall a b. TwoD a a -> TwoD a b -> TwoD a b
    $c<* :: forall a a b. TwoD a a -> TwoD a b -> TwoD a a
    <* :: forall a b. TwoD a a -> TwoD a b -> TwoD a a
    Applicative, Applicative (TwoD a)
    Applicative (TwoD a) =>
    (forall a b. TwoD a a -> (a -> TwoD a b) -> TwoD a b)
    -> (forall a b. TwoD a a -> TwoD a b -> TwoD a b)
    -> (forall a. a -> TwoD a a)
    -> Monad (TwoD a)
    forall a. Applicative (TwoD a)
    forall a. a -> TwoD a a
    forall a a. a -> TwoD a a
    forall a b. TwoD a a -> TwoD a b -> TwoD a b
    forall a b. TwoD a a -> (a -> TwoD a b) -> TwoD a b
    forall a a b. TwoD a a -> TwoD a b -> TwoD a b
    forall a a b. TwoD a a -> (a -> TwoD a b) -> TwoD a b
    forall (m :: * -> *).
    Applicative m =>
    (forall a b. m a -> (a -> m b) -> m b)
    -> (forall a b. m a -> m b -> m b)
    -> (forall a. a -> m a)
    -> Monad m
    $c>>= :: forall a a b. TwoD a a -> (a -> TwoD a b) -> TwoD a b
    >>= :: forall a b. TwoD a a -> (a -> TwoD a b) -> TwoD a b
    $c>> :: forall a a b. TwoD a a -> TwoD a b -> TwoD a b
    >> :: forall a b. TwoD a a -> TwoD a b -> TwoD a b
    $creturn :: forall a a. a -> TwoD a a
    return :: forall a. a -> TwoD a a
    Monad, MonadState (TwoDState a))

    liftX ::  X a1 -> TwoD a a1
    liftX :: forall a1 a. X a1 -> TwoD a a1
    liftX = StateT (TwoDState a) X a1 -> TwoD a a1
    forall a b. StateT (TwoDState a) X b -> TwoD a b
    TwoD (StateT (TwoDState a) X a1 -> TwoD a a1)
    -> (X a1 -> StateT (TwoDState a) X a1) -> X a1 -> TwoD a a1
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . X a1 -> StateT (TwoDState a) X a1
    forall (m :: * -> *) a. Monad m => m a -> StateT (TwoDState a) m a
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift

    evalTwoD ::  TwoD a1 a -> TwoDState a1 -> X a
    evalTwoD :: forall a1 a. TwoD a1 a -> TwoDState a1 -> X a
    evalTwoD TwoD a1 a
    m TwoDState a1
    s = (StateT (TwoDState a1) X a -> TwoDState a1 -> X a)
    -> TwoDState a1 -> StateT (TwoDState a1) X a -> X a
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip StateT (TwoDState a1) X a -> TwoDState a1 -> X a
    forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
    evalStateT TwoDState a1
    s (StateT (TwoDState a1) X a -> X a)
    -> StateT (TwoDState a1) X a -> X a
    forall a b. (a -> b) -> a -> b
    $ TwoD a1 a -> StateT (TwoDState a1) X a
    forall a b. TwoD a b -> StateT (TwoDState a) X b
    unTwoD TwoD a1 a
    m

    diamondLayer :: (Enum a, Num a, Eq a) => a -> [(a, a)]
    diamondLayer :: forall a. (Enum a, Num a, Eq a) => a -> [(a, a)]
    diamondLayer a
    0 = [(a
    0,a
    0)]
    diamondLayer a
    n =
      -- tr = top right
      --  r = ur ++ 90 degree clock-wise rotation of ur
      let tr :: [(a, a)]
    tr = [ (a
    x,a
    na -> a -> a
    forall a. Num a => a -> a -> a
    -a
    x) | a
    x <- [a
    0..a
    na -> a -> a
    forall a. Num a => a -> a -> a
    -a
    1] ]
          r :: [(a, a)]
    r  = [(a, a)]
    tr [(a, a)] -> [(a, a)] -> [(a, a)]
    forall a. [a] -> [a] -> [a]
    ++ ((a, a) -> (a, a)) -> [(a, a)] -> [(a, a)]
    forall a b. (a -> b) -> [a] -> [b]
    map (\(a
    x,a
    y) -> (a
    y,-a
    x)) [(a, a)]
    tr
      in [(a, a)]
    r [(a, a)] -> [(a, a)] -> [(a, a)]
    forall a. [a] -> [a] -> [a]
    ++ ((a, a) -> (a, a)) -> [(a, a)] -> [(a, a)]
    forall a b. (a -> b) -> [a] -> [b]
    map (a -> a
    forall a. Num a => a -> a
    negate (a -> a) -> (a -> a) -> (a, a) -> (a, a)
    forall b c b' c'. (b -> c) -> (b' -> c') -> (b, b') -> (c, c')
    forall (a :: * -> * -> *) b c b' c'.
    Arrow a =>
    a b c -> a b' c' -> a (b, b') (c, c')
    *** a -> a
    forall a. Num a => a -> a
    negate) [(a, a)]
    r

    diamond :: (Enum a, Num a, Eq a) => Stream (a, a)
    diamond :: forall a. (Enum a, Num a, Eq a) => Stream (a, a)
    diamond = [Item (Stream (a, a))] -> Stream (a, a)
    forall l. IsList l => [Item l] -> l
    fromList ([Item (Stream (a, a))] -> Stream (a, a))
    -> [Item (Stream (a, a))] -> Stream (a, a)
    forall a b. (a -> b) -> a -> b
    $ (a -> [(a, a)]) -> [a] -> [(a, a)]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap a -> [(a, a)]
    forall a. (Enum a, Num a, Eq a) => a -> [(a, a)]
    diamondLayer [a
    0..]

    diamondRestrict :: Integer -> Integer -> Integer -> Integer -> [(Integer, Integer)]
    diamondRestrict :: Integer -> Integer -> Integer -> Integer -> [TwoDPosition]
    diamondRestrict Integer
    x Integer
    y Integer
    originX Integer
    originY =
      (TwoDPosition -> Bool) -> [TwoDPosition] -> [TwoDPosition]
    forall a. (a -> Bool) -> [a] -> [a]
    L.filter (\(Integer
    x',Integer
    y') -> Integer -> Integer
    forall a. Num a => a -> a
    abs Integer
    x' Integer -> Integer -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Integer
    x Bool -> Bool -> Bool
    && Integer -> Integer
    forall a. Num a => a -> a
    abs Integer
    y' Integer -> Integer -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Integer
    y) ([TwoDPosition] -> [TwoDPosition])
    -> (Stream TwoDPosition -> [TwoDPosition])
    -> Stream TwoDPosition
    -> [TwoDPosition]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .
      (TwoDPosition -> TwoDPosition) -> [TwoDPosition] -> [TwoDPosition]
    forall a b. (a -> b) -> [a] -> [b]
    map (\(Integer
    x', Integer
    y') -> (Integer
    x' Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    + Integer -> Integer
    forall a. Num a => Integer -> a
    fromInteger Integer
    originX, Integer
    y' Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    + Integer -> Integer
    forall a. Num a => Integer -> a
    fromInteger Integer
    originY)) ([TwoDPosition] -> [TwoDPosition])
    -> (Stream TwoDPosition -> [TwoDPosition])
    -> Stream TwoDPosition
    -> [TwoDPosition]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .
      Int -> Stream TwoDPosition -> [TwoDPosition]
    forall a. Int -> Stream a -> [a]
    takeS Int
    1000 (Stream TwoDPosition -> [TwoDPosition])
    -> Stream TwoDPosition -> [TwoDPosition]
    forall a b. (a -> b) -> a -> b
    $ Stream TwoDPosition
    forall a. (Enum a, Num a, Eq a) => Stream (a, a)
    diamond

    findInElementMap :: (Eq a) => a -> [(a, b)] -> Maybe (a, b)
    findInElementMap :: forall a b. Eq a => a -> [(a, b)] -> Maybe (a, b)
    findInElementMap a
    pos = ((a, b) -> Bool) -> [(a, b)] -> Maybe (a, b)
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
    find ((a -> a -> Bool
    forall a. Eq a => a -> a -> Bool
    == a
    pos) (a -> Bool) -> ((a, b) -> a) -> (a, b) -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (a, b) -> a
    forall a b. (a, b) -> a
    fst)

    drawWinBox :: Window -> XMonadFont -> (String, String) -> String -> Integer -> Integer -> String -> Integer -> Integer -> Integer -> X ()
    drawWinBox :: Word64
    -> XMonadFont
    -> (String, String)
    -> String
    -> Integer
    -> Integer
    -> String
    -> Integer
    -> Integer
    -> Integer
    -> X ()
    drawWinBox Word64
    win XMonadFont
    font (String
    fg,String
    bg) String
    bc Integer
    ch Integer
    cw String
    text Integer
    x Integer
    y Integer
    cp =
      (Display -> X ()) -> X ()
    forall a. (Display -> X a) -> X a
    withDisplay ((Display -> X ()) -> X ()) -> (Display -> X ()) -> X ()
    forall a b. (a -> b) -> a -> b
    $ \Display
    dpy -> do
      gc <- IO GC -> X GC
    forall a. IO a -> X a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO GC -> X GC) -> IO GC -> X GC
    forall a b. (a -> b) -> a -> b
    $ Display -> Word64 -> IO GC
    createGC Display
    dpy Word64
    win
      bordergc <- liftIO $ createGC dpy win
      liftIO $ do
        Just fgcolor <- initColor dpy fg
        Just bgcolor <- initColor dpy bg
        Just bordercolor <- initColor dpy bc
        setForeground dpy gc fgcolor
        setBackground dpy gc bgcolor
        setForeground dpy bordergc bordercolor
        fillRectangle dpy win gc (fromInteger x) (fromInteger y) (fromInteger cw) (fromInteger ch)
        drawRectangle dpy win bordergc (fromInteger x) (fromInteger y) (fromInteger cw) (fromInteger ch)
      stext <- shrinkWhile (shrinkIt shrinkText)
               (\String
    n -> do size <- IO Int -> X Int
    forall a. IO a -> X a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO Int -> X Int) -> IO Int -> X Int
    forall a b. (a -> b) -> a -> b
    $ Display -> XMonadFont -> String -> IO Int
    forall (m :: * -> *).
    MonadIO m =>
    Display -> XMonadFont -> String -> m Int
    textWidthXMF Display
    dpy XMonadFont
    font String
    n
                         return $ size > fromInteger (cw-(2*cp)))
               text
      -- calculate the offset to vertically centre the text based on the ascender and descender
      (asc,desc) <- liftIO $ textExtentsXMF font stext
      let offset = ((Integer
    ch Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    - Position -> Integer
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Position
    asc Position -> Position -> Position
    forall a. Num a => a -> a -> a
    + Position
    desc)) Integer -> Integer -> Integer
    forall a. Integral a => a -> a -> a
    `div` Integer
    2) Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    + Position -> Integer
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Position
    asc
      printStringXMF dpy win font gc bg fg (fromInteger (x+cp)) (fromInteger (y+offset)) stext
      liftIO $ freeGC dpy gc
      liftIO $ freeGC dpy bordergc

    updateAllElements :: TwoD a ()
    updateAllElements :: forall a. TwoD a ()
    updateAllElements =
        do
          s <- TwoD a (TwoDState a)
    forall s (m :: * -> *). MonadState s m => m s
    get
          updateElements (td_elementmap s)

    grayoutElements :: Int -> TwoD a ()
    grayoutElements :: forall a. Int -> TwoD a ()
    grayoutElements Int
    skip =
        do
          s <- TwoD a (TwoDState a)
    forall s (m :: * -> *). MonadState s m => m s
    get
          updateElementsWithColorizer grayOnly $ drop skip (td_elementmap s)
        where grayOnly :: p -> p -> m (String, String)
    grayOnly p
    _ p
    _ = (String, String) -> m (String, String)
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (String
    "#808080", String
    "#808080")

    updateElements :: TwoDElementMap a -> TwoD a ()
    updateElements :: forall a. TwoDElementMap a -> TwoD a ()
    updateElements TwoDElementMap a
    elementmap = do
          s <- TwoD a (TwoDState a)
    forall s (m :: * -> *). MonadState s m => m s
    get
          updateElementsWithColorizer (gs_colorizer (td_gsconfig s)) elementmap

    updateElementsWithColorizer :: (a -> Bool -> X (String, String)) -> TwoDElementMap a -> TwoD a ()
    updateElementsWithColorizer :: forall a.
    (a -> Bool -> X (String, String)) -> TwoDElementMap a -> TwoD a ()
    updateElementsWithColorizer a -> Bool -> X (String, String)
    colorizer TwoDElementMap a
    elementmap = do
        TwoDState { td_curpos = curpos,
                    td_drawingWin = win,
                    td_gsconfig = gsconfig,
                    td_font = font,
                    td_paneX = paneX,
                    td_paneY = paneY} <- TwoD a (TwoDState a)
    forall s (m :: * -> *). MonadState s m => m s
    get
        let cellwidth = GSConfig a -> Integer
    forall a. GSConfig a -> Integer
    gs_cellwidth GSConfig a
    gsconfig
            cellheight = GSConfig a -> Integer
    forall a. GSConfig a -> Integer
    gs_cellheight GSConfig a
    gsconfig
            paneX' = Integer -> Integer -> Integer
    forall a. Integral a => a -> a -> a
    div (Integer
    paneXInteger -> Integer -> Integer
    forall a. Num a => a -> a -> a
    -Integer
    cellwidth) Integer
    2
            paneY' = Integer -> Integer -> Integer
    forall a. Integral a => a -> a -> a
    div (Integer
    paneYInteger -> Integer -> Integer
    forall a. Num a => a -> a -> a
    -Integer
    cellheight) Integer
    2
            updateElement (pos :: TwoDPosition
    pos@(Integer
    x,Integer
    y),(String
    text, a
    element)) = X () -> TwoD a ()
    forall a1 a. X a1 -> TwoD a a1
    liftX (X () -> TwoD a ()) -> X () -> TwoD a ()
    forall a b. (a -> b) -> a -> b
    $ do
                colors <- a -> Bool -> X (String, String)
    colorizer a
    element (TwoDPosition
    pos TwoDPosition -> TwoDPosition -> Bool
    forall a. Eq a => a -> a -> Bool
    == TwoDPosition
    curpos)
                drawWinBox win font
                           colors
                           (gs_bordercolor gsconfig)
                           cellheight
                           cellwidth
                           text
                           (paneX'+x*cellwidth)
                           (paneY'+y*cellheight)
                           (gs_cellpadding gsconfig)
        mapM_ updateElement elementmap

    stdHandle :: Event -> TwoD a (Maybe a) -> TwoD a (Maybe a)
    stdHandle :: forall a. Event -> TwoD a (Maybe a) -> TwoD a (Maybe a)
    stdHandle ButtonEvent{ ev_event_type :: Event -> Dimension
    ev_event_type = Dimension
    t, ev_x :: Event -> CInt
    ev_x = CInt
    x, ev_y :: Event -> CInt
    ev_y = CInt
    y } TwoD a (Maybe a)
    contEventloop
        | Dimension
    t Dimension -> Dimension -> Bool
    forall a. Eq a => a -> a -> Bool
    == Dimension
    buttonRelease = do
            s@TwoDState{ td_paneX = px
                       , td_paneY = py
                       , td_gsconfig = GSConfig{ gs_cellheight = ch
                                               , gs_cellwidth = cw
                                               , gs_cancelOnEmptyClick = cancelOnEmptyClick
                                               }
                       } <- TwoD a (TwoDState a)
    forall s (m :: * -> *). MonadState s m => m s
    get
            let gridX = (CInt -> Integer
    forall a b. (Integral a, Num b) => a -> b
    fi CInt
    x Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    - (Integer
    px Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    - Integer
    cw) Integer -> Integer -> Integer
    forall a. Integral a => a -> a -> a
    `div` Integer
    2) Integer -> Integer -> Integer
    forall a. Integral a => a -> a -> a
    `div` Integer
    cw
                gridY = (CInt -> Integer
    forall a b. (Integral a, Num b) => a -> b
    fi CInt
    y Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    - (Integer
    py Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    - Integer
    ch) Integer -> Integer -> Integer
    forall a. Integral a => a -> a -> a
    `div` Integer
    2) Integer -> Integer -> Integer
    forall a. Integral a => a -> a -> a
    `div` Integer
    ch
            case lookup (gridX,gridY) (td_elementmap s) of
                 Just (String
    _,a
    el) -> Maybe a -> TwoD a (Maybe a)
    forall a. a -> TwoD a a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (a -> Maybe a
    forall a. a -> Maybe a
    Just a
    el)
                 Maybe (String, a)
    Nothing     -> if Bool
    cancelOnEmptyClick
                                then Maybe a -> TwoD a (Maybe a)
    forall a. a -> TwoD a a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe a
    forall a. Maybe a
    Nothing
                                else TwoD a (Maybe a)
    contEventloop
        | Bool
    otherwise = TwoD a (Maybe a)
    contEventloop

    stdHandle ExposeEvent{} TwoD a (Maybe a)
    contEventloop = TwoD a ()
    forall a. TwoD a ()
    updateAllElements TwoD a () -> TwoD a (Maybe a) -> TwoD a (Maybe a)
    forall a b. TwoD a a -> TwoD a b -> TwoD a b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> TwoD a (Maybe a)
    contEventloop

    stdHandle Event
    _ TwoD a (Maybe a)
    contEventloop = TwoD a (Maybe a)
    contEventloop

    -- | Embeds a key handler into the X event handler that dispatches key
    -- events to the key handler, while non-key event go to the standard
    -- handler.
    makeXEventhandler :: ((KeySym, String, KeyMask) -> TwoD a (Maybe a)) -> TwoD a (Maybe a)
    makeXEventhandler :: forall a.
    ((Word64, String, KeyMask) -> TwoD a (Maybe a)) -> TwoD a (Maybe a)
    makeXEventhandler (Word64, String, KeyMask) -> TwoD a (Maybe a)
    keyhandler = (TwoD a (Maybe a) -> TwoD a (Maybe a)) -> TwoD a (Maybe a)
    forall a. (a -> a) -> a
    fix ((TwoD a (Maybe a) -> TwoD a (Maybe a)) -> TwoD a (Maybe a))
    -> (TwoD a (Maybe a) -> TwoD a (Maybe a)) -> TwoD a (Maybe a)
    forall a b. (a -> b) -> a -> b
    $ \TwoD a (Maybe a)
    me -> TwoD a (TwoD a (Maybe a)) -> TwoD a (Maybe a)
    forall (m :: * -> *) a. Monad m => m (m a) -> m a
    join (TwoD a (TwoD a (Maybe a)) -> TwoD a (Maybe a))
    -> TwoD a (TwoD a (Maybe a)) -> TwoD a (Maybe a)
    forall a b. (a -> b) -> a -> b
    $ X (TwoD a (Maybe a)) -> TwoD a (TwoD a (Maybe a))
    forall a1 a. X a1 -> TwoD a a1
    liftX (X (TwoD a (Maybe a)) -> TwoD a (TwoD a (Maybe a)))
    -> X (TwoD a (Maybe a)) -> TwoD a (TwoD a (Maybe a))
    forall a b. (a -> b) -> a -> b
    $ (Display -> X (TwoD a (Maybe a))) -> X (TwoD a (Maybe a))
    forall a. (Display -> X a) -> X a
    withDisplay ((Display -> X (TwoD a (Maybe a))) -> X (TwoD a (Maybe a)))
    -> (Display -> X (TwoD a (Maybe a))) -> X (TwoD a (Maybe a))
    forall a b. (a -> b) -> a -> b
    $ \Display
    d -> IO (TwoD a (Maybe a)) -> X (TwoD a (Maybe a))
    forall a. IO a -> X a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO (TwoD a (Maybe a)) -> X (TwoD a (Maybe a)))
    -> IO (TwoD a (Maybe a)) -> X (TwoD a (Maybe a))
    forall a b. (a -> b) -> a -> b
    $ (XEventPtr -> IO (TwoD a (Maybe a))) -> IO (TwoD a (Maybe a))
    forall a. (XEventPtr -> IO a) -> IO a
    allocaXEvent ((XEventPtr -> IO (TwoD a (Maybe a))) -> IO (TwoD a (Maybe a)))
    -> (XEventPtr -> IO (TwoD a (Maybe a))) -> IO (TwoD a (Maybe a))
    forall a b. (a -> b) -> a -> b
    $ \XEventPtr
    e -> do
                                 Display -> Word64 -> XEventPtr -> IO ()
    maskEvent Display
    d (Word64
    exposureMask Word64 -> Word64 -> Word64
    forall a. Bits a => a -> a -> a
    .|. Word64
    keyPressMask Word64 -> Word64 -> Word64
    forall a. Bits a => a -> a -> a
    .|. Word64
    buttonReleaseMask) XEventPtr
    e
                                 ev <- XEventPtr -> IO Event
    getEvent XEventPtr
    e
                                 if ev_event_type ev == keyPress
                                   then do
                                      (_, s) <- lookupString $ asKeyEvent e
                                      ks <- keycodeToKeysym d (ev_keycode ev) 0
                                      return $ do
                                          mask <- liftX $ cleanKeyMask <*> pure (ev_state ev)
                                          keyhandler (ks, s, mask)
                                   else
                                      return $ stdHandle ev me

    -- | When the map contains (KeySym,KeyMask) tuple for the given event,
    -- the associated action in the map associated shadows the default key
    -- handler
    shadowWithKeymap :: M.Map (KeyMask, KeySym) a -> ((KeySym, String, KeyMask) -> a) -> (KeySym, String, KeyMask) -> a
    shadowWithKeymap :: forall a.
    Map (KeyMask, Word64) a
    -> ((Word64, String, KeyMask) -> a)
    -> (Word64, String, KeyMask)
    -> a
    shadowWithKeymap Map (KeyMask, Word64) a
    keymap (Word64, String, KeyMask) -> a
    dflt keyEvent :: (Word64, String, KeyMask)
    keyEvent@(Word64
    ks,String
    _,KeyMask
    m') = a -> Maybe a -> a
    forall a. a -> Maybe a -> a
    fromMaybe ((Word64, String, KeyMask) -> a
    dflt (Word64, String, KeyMask)
    keyEvent) ((KeyMask, Word64) -> Map (KeyMask, Word64) a -> Maybe a
    forall k a. Ord k => k -> Map k a -> Maybe a
    M.lookup (KeyMask
    m',Word64
    ks) Map (KeyMask, Word64) a
    keymap)

    -- Helper functions to use for key handler functions

    -- | Closes gridselect returning the element under the cursor
    select :: TwoD a (Maybe a)
    select :: forall a. TwoD a (Maybe a)
    select = do
      s <- TwoD a (TwoDState a)
    forall s (m :: * -> *). MonadState s m => m s
    get
      return $ snd . snd <$> findInElementMap (td_curpos s) (td_elementmap s)

    -- | Closes gridselect returning no element.
    cancel :: TwoD a (Maybe a)
    cancel :: forall a. TwoD a (Maybe a)
    cancel = Maybe a -> TwoD a (Maybe a)
    forall a. a -> TwoD a a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe a
    forall a. Maybe a
    Nothing

    -- | Sets the absolute position of the cursor.
    setPos :: (Integer, Integer) -> TwoD a ()
    setPos :: forall a. TwoDPosition -> TwoD a ()
    setPos TwoDPosition
    newPos = do
      s <- TwoD a (TwoDState a)
    forall s (m :: * -> *). MonadState s m => m s
    get
      let elmap = TwoDState a -> TwoDElementMap a
    forall a. TwoDState a -> TwoDElementMap a
    td_elementmap TwoDState a
    s
          newSelectedEl = TwoDPosition
    -> TwoDElementMap a -> Maybe (TwoDPosition, (String, a))
    forall a b. Eq a => a -> [(a, b)] -> Maybe (a, b)
    findInElementMap TwoDPosition
    newPos (TwoDState a -> TwoDElementMap a
    forall a. TwoDState a -> TwoDElementMap a
    td_elementmap TwoDState a
    s)
          oldPos = TwoDState a -> TwoDPosition
    forall a. TwoDState a -> TwoDPosition
    td_curpos TwoDState a
    s
      when (isJust newSelectedEl && newPos /= oldPos) $ do
        put s { td_curpos = newPos }
        updateElements (catMaybes [findInElementMap oldPos elmap, newSelectedEl])

    -- | Moves the cursor by the offsets specified
    move :: (Integer, Integer) -> TwoD a ()
    move :: forall a. TwoDPosition -> TwoD a ()
    move (Integer
    dx,Integer
    dy) = do
      s <- TwoD a (TwoDState a)
    forall s (m :: * -> *). MonadState s m => m s
    get
      let (x,y) = td_curpos s
          newPos = (Integer
    xInteger -> Integer -> Integer
    forall a. Num a => a -> a -> a
    +Integer
    dx,Integer
    yInteger -> Integer -> Integer
    forall a. Num a => a -> a -> a
    +Integer
    dy)
      setPos newPos

    moveNext :: TwoD a ()
    moveNext :: forall a. TwoD a ()
    moveNext = do
      position <- (TwoDState a -> TwoDPosition) -> TwoD a TwoDPosition
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets TwoDState a -> TwoDPosition
    forall a. TwoDState a -> TwoDPosition
    td_curpos
      elems <- gets td_elementmap
      let n = TwoDElementMap a -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length TwoDElementMap a
    elems
          m = case ((TwoDPosition, (String, a)) -> Bool)
    -> TwoDElementMap a -> Maybe Int
    forall a. (a -> Bool) -> [a] -> Maybe Int
    findIndex (\(TwoDPosition, (String, a))
    p -> (TwoDPosition, (String, a)) -> TwoDPosition
    forall a b. (a, b) -> a
    fst (TwoDPosition, (String, a))
    p TwoDPosition -> TwoDPosition -> Bool
    forall a. Eq a => a -> a -> Bool
    == TwoDPosition
    position) TwoDElementMap a
    elems of
                   Maybe Int
    Nothing -> Maybe Int
    forall a. Maybe a
    Nothing
                   Just Int
    k | Int
    k Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    nInt -> Int -> Int
    forall a. Num a => a -> a -> a
    -Int
    1 -> Int -> Maybe Int
    forall a. a -> Maybe a
    Just Int
    0
                          | Bool
    otherwise -> Int -> Maybe Int
    forall a. a -> Maybe a
    Just (Int
    kInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    1)
      whenJust m $ \Int
    i ->
          TwoDPosition -> TwoD a ()
    forall a. TwoDPosition -> TwoD a ()
    setPos ((TwoDPosition, (String, a)) -> TwoDPosition
    forall a b. (a, b) -> a
    fst ((TwoDPosition, (String, a)) -> TwoDPosition)
    -> (TwoDPosition, (String, a)) -> TwoDPosition
    forall a b. (a -> b) -> a -> b
    $ TwoDElementMap a
    elems TwoDElementMap a -> Int -> (TwoDPosition, (String, a))
    forall a. HasCallStack => [a] -> Int -> a
    !! Int
    i)

    movePrev :: TwoD a ()
    movePrev :: forall a. TwoD a ()
    movePrev = do
      position <- (TwoDState a -> TwoDPosition) -> TwoD a TwoDPosition
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets TwoDState a -> TwoDPosition
    forall a. TwoDState a -> TwoDPosition
    td_curpos
      elems <- gets td_elementmap
      let n = TwoDElementMap a -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length TwoDElementMap a
    elems
          m = case ((TwoDPosition, (String, a)) -> Bool)
    -> TwoDElementMap a -> Maybe Int
    forall a. (a -> Bool) -> [a] -> Maybe Int
    findIndex (\(TwoDPosition, (String, a))
    p -> (TwoDPosition, (String, a)) -> TwoDPosition
    forall a b. (a, b) -> a
    fst (TwoDPosition, (String, a))
    p TwoDPosition -> TwoDPosition -> Bool
    forall a. Eq a => a -> a -> Bool
    == TwoDPosition
    position) TwoDElementMap a
    elems of
                   Maybe Int
    Nothing -> Maybe Int
    forall a. Maybe a
    Nothing
                   Just Int
    0  -> Int -> Maybe Int
    forall a. a -> Maybe a
    Just (Int
    nInt -> Int -> Int
    forall a. Num a => a -> a -> a
    -Int
    1)
                   Just Int
    k  -> Int -> Maybe Int
    forall a. a -> Maybe a
    Just (Int
    kInt -> Int -> Int
    forall a. Num a => a -> a -> a
    -Int
    1)
      whenJust m $ \Int
    i ->
          TwoDPosition -> TwoD a ()
    forall a. TwoDPosition -> TwoD a ()
    setPos ((TwoDPosition, (String, a)) -> TwoDPosition
    forall a b. (a, b) -> a
    fst ((TwoDPosition, (String, a)) -> TwoDPosition)
    -> (TwoDPosition, (String, a)) -> TwoDPosition
    forall a b. (a -> b) -> a -> b
    $ TwoDElementMap a
    elems TwoDElementMap a -> Int -> (TwoDPosition, (String, a))
    forall a. HasCallStack => [a] -> Int -> a
    !! Int
    i)

    -- | Apply a transformation function the current search string
    transformSearchString :: (String -> String) -> TwoD a ()
    transformSearchString :: forall a. (String -> String) -> TwoD a ()
    transformSearchString String -> String
    f = do
              s <- TwoD a (TwoDState a)
    forall s (m :: * -> *). MonadState s m => m s
    get
              let oldSearchString = TwoDState a -> String
    forall a. TwoDState a -> String
    td_searchString TwoDState a
    s
                  newSearchString = String -> String
    f String
    oldSearchString
              when (newSearchString /= oldSearchString) $ do
                -- FIXME curpos might end up outside new bounds
                let s' = TwoDState a
    s { td_searchString = newSearchString }
                m <- liftX $ generateElementmap s'
                let s'' = TwoDState a
    s' { td_elementmap = m }
                    oldLen = TwoDElementMap a -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length (TwoDElementMap a -> Int) -> TwoDElementMap a -> Int
    forall a b. (a -> b) -> a -> b
    $ TwoDState a -> TwoDElementMap a
    forall a. TwoDState a -> TwoDElementMap a
    td_elementmap TwoDState a
    s
                    newLen = TwoDElementMap a -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length (TwoDElementMap a -> Int) -> TwoDElementMap a -> Int
    forall a b. (a -> b) -> a -> b
    $ TwoDState a -> TwoDElementMap a
    forall a. TwoDState a -> TwoDElementMap a
    td_elementmap TwoDState a
    s''
                -- All the elements in the previous element map should be
                -- grayed out, except for those which will be covered by
                -- elements in the new element map.
                when (newLen < oldLen) $ grayoutElements newLen
                put s''
                updateAllElements

    -- | By default gridselect used the defaultNavigation action, which
    -- binds left,right,up,down and vi-style h,l,j,k navigation. Return
    -- quits gridselect, returning the selected element, while Escape
    -- cancels the selection. Slash enters the substring search mode. In
    -- substring search mode, every string-associated keystroke is
    -- added to a search string, which narrows down the object
    -- selection. Substring search mode comes back to regular navigation
    -- via Return, while Escape cancels the search. If you want that
    -- navigation style, add 'defaultNavigation' as 'gs_navigate' to your
    -- 'GSConfig' object. This is done by 'buildDefaultGSConfig' automatically.
    defaultNavigation :: TwoD a (Maybe a)
    defaultNavigation :: forall a. TwoD a (Maybe a)
    defaultNavigation = ((Word64, String, KeyMask) -> TwoD a (Maybe a)) -> TwoD a (Maybe a)
    forall a.
    ((Word64, String, KeyMask) -> TwoD a (Maybe a)) -> TwoD a (Maybe a)
    makeXEventhandler (((Word64, String, KeyMask) -> TwoD a (Maybe a))
     -> TwoD a (Maybe a))
    -> ((Word64, String, KeyMask) -> TwoD a (Maybe a))
    -> TwoD a (Maybe a)
    forall a b. (a -> b) -> a -> b
    $ Map (KeyMask, Word64) (TwoD a (Maybe a))
    -> ((Word64, String, KeyMask) -> TwoD a (Maybe a))
    -> (Word64, String, KeyMask)
    -> TwoD a (Maybe a)
    forall a.
    Map (KeyMask, Word64) a
    -> ((Word64, String, KeyMask) -> a)
    -> (Word64, String, KeyMask)
    -> a
    shadowWithKeymap Map (KeyMask, Word64) (TwoD a (Maybe a))
    forall {a}. Map (KeyMask, Word64) (TwoD a (Maybe a))
    navKeyMap (Word64, String, KeyMask) -> TwoD a (Maybe a)
    forall {b} {a}. b -> TwoD a (Maybe a)
    navDefaultHandler
      where navKeyMap :: Map (KeyMask, Word64) (TwoD a (Maybe a))
    navKeyMap = [((KeyMask, Word64), TwoD a (Maybe a))]
    -> Map (KeyMask, Word64) (TwoD a (Maybe a))
    forall k a. Ord k => [(k, a)] -> Map k a
    M.fromList [
               ((KeyMask
    0,Word64
    xK_Escape)     , TwoD a (Maybe a)
    forall a. TwoD a (Maybe a)
    cancel)
              ,((KeyMask
    0,Word64
    xK_Return)     , TwoD a (Maybe a)
    forall a. TwoD a (Maybe a)
    select)
              ,((KeyMask
    0,Word64
    xK_slash)      , TwoD a (Maybe a) -> TwoD a (Maybe a)
    forall a. TwoD a (Maybe a) -> TwoD a (Maybe a)
    substringSearch TwoD a (Maybe a)
    forall a. TwoD a (Maybe a)
    defaultNavigation)
              ,((KeyMask
    0,Word64
    xK_Left)       , TwoDPosition -> TwoD a ()
    forall a. TwoDPosition -> TwoD a ()
    move (-Integer
    1,Integer
    0) TwoD a () -> TwoD a (Maybe a) -> TwoD a (Maybe a)
    forall a b. TwoD a a -> TwoD a b -> TwoD a b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> TwoD a (Maybe a)
    forall a. TwoD a (Maybe a)
    defaultNavigation)
              ,((KeyMask
    0,Word64
    xK_h)          , TwoDPosition -> TwoD a ()
    forall a. TwoDPosition -> TwoD a ()
    move (-Integer
    1,Integer
    0) TwoD a () -> TwoD a (Maybe a) -> TwoD a (Maybe a)
    forall a b. TwoD a a -> TwoD a b -> TwoD a b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> TwoD a (Maybe a)
    forall a. TwoD a (Maybe a)
    defaultNavigation)
              ,((KeyMask
    0,Word64
    xK_Right)      , TwoDPosition -> TwoD a ()
    forall a. TwoDPosition -> TwoD a ()
    move (Integer
    1,Integer
    0) TwoD a () -> TwoD a (Maybe a) -> TwoD a (Maybe a)
    forall a b. TwoD a a -> TwoD a b -> TwoD a b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> TwoD a (Maybe a)
    forall a. TwoD a (Maybe a)
    defaultNavigation)
              ,((KeyMask
    0,Word64
    xK_l)          , TwoDPosition -> TwoD a ()
    forall a. TwoDPosition -> TwoD a ()
    move (Integer
    1,Integer
    0) TwoD a () -> TwoD a (Maybe a) -> TwoD a (Maybe a)
    forall a b. TwoD a a -> TwoD a b -> TwoD a b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> TwoD a (Maybe a)
    forall a. TwoD a (Maybe a)
    defaultNavigation)
              ,((KeyMask
    0,Word64
    xK_Down)       , TwoDPosition -> TwoD a ()
    forall a. TwoDPosition -> TwoD a ()
    move (Integer
    0,Integer
    1) TwoD a () -> TwoD a (Maybe a) -> TwoD a (Maybe a)
    forall a b. TwoD a a -> TwoD a b -> TwoD a b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> TwoD a (Maybe a)
    forall a. TwoD a (Maybe a)
    defaultNavigation)
              ,((KeyMask
    0,Word64
    xK_j)          , TwoDPosition -> TwoD a ()
    forall a. TwoDPosition -> TwoD a ()
    move (Integer
    0,Integer
    1) TwoD a () -> TwoD a (Maybe a) -> TwoD a (Maybe a)
    forall a b. TwoD a a -> TwoD a b -> TwoD a b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> TwoD a (Maybe a)
    forall a. TwoD a (Maybe a)
    defaultNavigation)
              ,((KeyMask
    0,Word64
    xK_Up)         , TwoDPosition -> TwoD a ()
    forall a. TwoDPosition -> TwoD a ()
    move (Integer
    0,-Integer
    1) TwoD a () -> TwoD a (Maybe a) -> TwoD a (Maybe a)
    forall a b. TwoD a a -> TwoD a b -> TwoD a b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> TwoD a (Maybe a)
    forall a. TwoD a (Maybe a)
    defaultNavigation)
              ,((KeyMask
    0,Word64
    xK_k)          , TwoDPosition -> TwoD a ()
    forall a. TwoDPosition -> TwoD a ()
    move (Integer
    0,-Integer
    1) TwoD a () -> TwoD a (Maybe a) -> TwoD a (Maybe a)
    forall a b. TwoD a a -> TwoD a b -> TwoD a b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> TwoD a (Maybe a)
    forall a. TwoD a (Maybe a)
    defaultNavigation)
              ,((KeyMask
    0,Word64
    xK_Tab)        , TwoD a ()
    forall a. TwoD a ()
    moveNext TwoD a () -> TwoD a (Maybe a) -> TwoD a (Maybe a)
    forall a b. TwoD a a -> TwoD a b -> TwoD a b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> TwoD a (Maybe a)
    forall a. TwoD a (Maybe a)
    defaultNavigation)
              ,((KeyMask
    0,Word64
    xK_n)          , TwoD a ()
    forall a. TwoD a ()
    moveNext TwoD a () -> TwoD a (Maybe a) -> TwoD a (Maybe a)
    forall a b. TwoD a a -> TwoD a b -> TwoD a b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> TwoD a (Maybe a)
    forall a. TwoD a (Maybe a)
    defaultNavigation)
              ,((KeyMask
    shiftMask,Word64
    xK_Tab), TwoD a ()
    forall a. TwoD a ()
    movePrev TwoD a () -> TwoD a (Maybe a) -> TwoD a (Maybe a)
    forall a b. TwoD a a -> TwoD a b -> TwoD a b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> TwoD a (Maybe a)
    forall a. TwoD a (Maybe a)
    defaultNavigation)
              ,((KeyMask
    0,Word64
    xK_p)          , TwoD a ()
    forall a. TwoD a ()
    movePrev TwoD a () -> TwoD a (Maybe a) -> TwoD a (Maybe a)
    forall a b. TwoD a a -> TwoD a b -> TwoD a b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> TwoD a (Maybe a)
    forall a. TwoD a (Maybe a)
    defaultNavigation)
              ]
            -- The navigation handler ignores unknown key symbols, therefore we const
            navDefaultHandler :: b -> TwoD a (Maybe a)
    navDefaultHandler = TwoD a (Maybe a) -> b -> TwoD a (Maybe a)
    forall a b. a -> b -> a
    const TwoD a (Maybe a)
    forall a. TwoD a (Maybe a)
    defaultNavigation

    -- | This navigation style combines navigation and search into one mode at the cost of losing vi style
    -- navigation. With this style, there is no substring search submode,
    -- but every typed character is added to the substring search.
    navNSearch :: TwoD a (Maybe a)
    navNSearch :: forall a. TwoD a (Maybe a)
    navNSearch = ((Word64, String, KeyMask) -> TwoD a (Maybe a)) -> TwoD a (Maybe a)
    forall a.
    ((Word64, String, KeyMask) -> TwoD a (Maybe a)) -> TwoD a (Maybe a)
    makeXEventhandler (((Word64, String, KeyMask) -> TwoD a (Maybe a))
     -> TwoD a (Maybe a))
    -> ((Word64, String, KeyMask) -> TwoD a (Maybe a))
    -> TwoD a (Maybe a)
    forall a b. (a -> b) -> a -> b
    $ Map (KeyMask, Word64) (TwoD a (Maybe a))
    -> ((Word64, String, KeyMask) -> TwoD a (Maybe a))
    -> (Word64, String, KeyMask)
    -> TwoD a (Maybe a)
    forall a.
    Map (KeyMask, Word64) a
    -> ((Word64, String, KeyMask) -> a)
    -> (Word64, String, KeyMask)
    -> a
    shadowWithKeymap Map (KeyMask, Word64) (TwoD a (Maybe a))
    forall {a}. Map (KeyMask, Word64) (TwoD a (Maybe a))
    navNSearchKeyMap (Word64, String, KeyMask) -> TwoD a (Maybe a)
    forall {a} {c} {a}. (a, String, c) -> TwoD a (Maybe a)
    navNSearchDefaultHandler
      where navNSearchKeyMap :: Map (KeyMask, Word64) (TwoD a (Maybe a))
    navNSearchKeyMap = [((KeyMask, Word64), TwoD a (Maybe a))]
    -> Map (KeyMask, Word64) (TwoD a (Maybe a))
    forall k a. Ord k => [(k, a)] -> Map k a
    M.fromList [
               ((KeyMask
    0,Word64
    xK_Escape)     , TwoD a (Maybe a)
    forall a. TwoD a (Maybe a)
    cancel)
              ,((KeyMask
    0,Word64
    xK_Return)     , TwoD a (Maybe a)
    forall a. TwoD a (Maybe a)
    select)
              ,((KeyMask
    0,Word64
    xK_Left)       , TwoDPosition -> TwoD a ()
    forall a. TwoDPosition -> TwoD a ()
    move (-Integer
    1,Integer
    0) TwoD a () -> TwoD a (Maybe a) -> TwoD a (Maybe a)
    forall a b. TwoD a a -> TwoD a b -> TwoD a b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> TwoD a (Maybe a)
    forall a. TwoD a (Maybe a)
    navNSearch)
              ,((KeyMask
    0,Word64
    xK_Right)      , TwoDPosition -> TwoD a ()
    forall a. TwoDPosition -> TwoD a ()
    move (Integer
    1,Integer
    0) TwoD a () -> TwoD a (Maybe a) -> TwoD a (Maybe a)
    forall a b. TwoD a a -> TwoD a b -> TwoD a b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> TwoD a (Maybe a)
    forall a. TwoD a (Maybe a)
    navNSearch)
              ,((KeyMask
    0,Word64
    xK_Down)       , TwoDPosition -> TwoD a ()
    forall a. TwoDPosition -> TwoD a ()
    move (Integer
    0,Integer
    1) TwoD a () -> TwoD a (Maybe a) -> TwoD a (Maybe a)
    forall a b. TwoD a a -> TwoD a b -> TwoD a b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> TwoD a (Maybe a)
    forall a. TwoD a (Maybe a)
    navNSearch)
              ,((KeyMask
    0,Word64
    xK_Up)         , TwoDPosition -> TwoD a ()
    forall a. TwoDPosition -> TwoD a ()
    move (Integer
    0,-Integer
    1) TwoD a () -> TwoD a (Maybe a) -> TwoD a (Maybe a)
    forall a b. TwoD a a -> TwoD a b -> TwoD a b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> TwoD a (Maybe a)
    forall a. TwoD a (Maybe a)
    navNSearch)
              ,((KeyMask
    0,Word64
    xK_Tab)        , TwoD a ()
    forall a. TwoD a ()
    moveNext TwoD a () -> TwoD a (Maybe a) -> TwoD a (Maybe a)
    forall a b. TwoD a a -> TwoD a b -> TwoD a b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> TwoD a (Maybe a)
    forall a. TwoD a (Maybe a)
    navNSearch)
              ,((KeyMask
    shiftMask,Word64
    xK_Tab), TwoD a ()
    forall a. TwoD a ()
    movePrev TwoD a () -> TwoD a (Maybe a) -> TwoD a (Maybe a)
    forall a b. TwoD a a -> TwoD a b -> TwoD a b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> TwoD a (Maybe a)
    forall a. TwoD a (Maybe a)
    navNSearch)
              ,((KeyMask
    0,Word64
    xK_BackSpace), (String -> String) -> TwoD a ()
    forall a. (String -> String) -> TwoD a ()
    transformSearchString (\String
    s -> if String
    s String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    == String
    "" then String
    "" else String -> String
    forall a. HasCallStack => [a] -> [a]
    init String
    s) TwoD a () -> TwoD a (Maybe a) -> TwoD a (Maybe a)
    forall a b. TwoD a a -> TwoD a b -> TwoD a b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> TwoD a (Maybe a)
    forall a. TwoD a (Maybe a)
    navNSearch)
              ]
            -- The navigation handler ignores unknown key symbols, therefore we const
            navNSearchDefaultHandler :: (a, String, c) -> TwoD a (Maybe a)
    navNSearchDefaultHandler (a
    _,String
    s,c
    _) = do
              (String -> String) -> TwoD a ()
    forall a. (String -> String) -> TwoD a ()
    transformSearchString (String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    s)
              TwoD a (Maybe a)
    forall a. TwoD a (Maybe a)
    navNSearch

    -- | Navigation submode used for substring search. It returns to the
    -- first argument navigation style when the user hits Return.
    substringSearch :: TwoD a (Maybe a) -> TwoD a (Maybe a)
    substringSearch :: forall a. TwoD a (Maybe a) -> TwoD a (Maybe a)
    substringSearch TwoD a (Maybe a)
    returnNavigation = (TwoD a (Maybe a) -> TwoD a (Maybe a)) -> TwoD a (Maybe a)
    forall a. (a -> a) -> a
    fix ((TwoD a (Maybe a) -> TwoD a (Maybe a)) -> TwoD a (Maybe a))
    -> (TwoD a (Maybe a) -> TwoD a (Maybe a)) -> TwoD a (Maybe a)
    forall a b. (a -> b) -> a -> b
    $ \TwoD a (Maybe a)
    me ->
      let searchKeyMap :: Map (KeyMask, Word64) (TwoD a (Maybe a))
    searchKeyMap = [((KeyMask, Word64), TwoD a (Maybe a))]
    -> Map (KeyMask, Word64) (TwoD a (Maybe a))
    forall k a. Ord k => [(k, a)] -> Map k a
    M.fromList [
               ((KeyMask
    0,Word64
    xK_Escape)   , (String -> String) -> TwoD a ()
    forall a. (String -> String) -> TwoD a ()
    transformSearchString (String -> String -> String
    forall a b. a -> b -> a
    const String
    "") TwoD a () -> TwoD a (Maybe a) -> TwoD a (Maybe a)
    forall a b. TwoD a a -> TwoD a b -> TwoD a b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> TwoD a (Maybe a)
    returnNavigation)
              ,((KeyMask
    0,Word64
    xK_Return)   , TwoD a (Maybe a)
    returnNavigation)
              ,((KeyMask
    0,Word64
    xK_BackSpace), (String -> String) -> TwoD a ()
    forall a. (String -> String) -> TwoD a ()
    transformSearchString (\String
    s -> if String
    s String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    == String
    "" then String
    "" else String -> String
    forall a. HasCallStack => [a] -> [a]
    init String
    s) TwoD a () -> TwoD a (Maybe a) -> TwoD a (Maybe a)
    forall a b. TwoD a a -> TwoD a b -> TwoD a b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> TwoD a (Maybe a)
    me)
              ]
          searchDefaultHandler :: (a, String, c) -> TwoD a (Maybe a)
    searchDefaultHandler (a
    _,String
    s,c
    _) = do
              (String -> String) -> TwoD a ()
    forall a. (String -> String) -> TwoD a ()
    transformSearchString (String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    s)
              TwoD a (Maybe a)
    me
      in ((Word64, String, KeyMask) -> TwoD a (Maybe a)) -> TwoD a (Maybe a)
    forall a.
    ((Word64, String, KeyMask) -> TwoD a (Maybe a)) -> TwoD a (Maybe a)
    makeXEventhandler (((Word64, String, KeyMask) -> TwoD a (Maybe a))
     -> TwoD a (Maybe a))
    -> ((Word64, String, KeyMask) -> TwoD a (Maybe a))
    -> TwoD a (Maybe a)
    forall a b. (a -> b) -> a -> b
    $ Map (KeyMask, Word64) (TwoD a (Maybe a))
    -> ((Word64, String, KeyMask) -> TwoD a (Maybe a))
    -> (Word64, String, KeyMask)
    -> TwoD a (Maybe a)
    forall a.
    Map (KeyMask, Word64) a
    -> ((Word64, String, KeyMask) -> a)
    -> (Word64, String, KeyMask)
    -> a
    shadowWithKeymap Map (KeyMask, Word64) (TwoD a (Maybe a))
    searchKeyMap (Word64, String, KeyMask) -> TwoD a (Maybe a)
    forall {a} {c}. (a, String, c) -> TwoD a (Maybe a)
    searchDefaultHandler

    -- FIXME probably move that into Utils?
    -- Conversion scheme as in http://en.wikipedia.org/wiki/HSV_color_space
    hsv2rgb :: Fractional a => (Integer,a,a) -> (a,a,a)
    hsv2rgb :: forall a. Fractional a => (Integer, a, a) -> (a, a, a)
    hsv2rgb (Integer
    h,a
    s,a
    v) =
        let hi :: Integer
    hi = Integer -> Integer -> Integer
    forall a. Integral a => a -> a -> a
    div Integer
    h Integer
    60 Integer -> Integer -> Integer
    forall a. Integral a => a -> a -> a
    `mod` Integer
    6 :: Integer
            f :: a
    f = ((Integer -> a
    forall a. Num a => Integer -> a
    fromInteger Integer
    ha -> a -> a
    forall a. Fractional a => a -> a -> a
    /a
    60) a -> a -> a
    forall a. Num a => a -> a -> a
    - Integer -> a
    forall a. Num a => Integer -> a
    fromInteger Integer
    hi) :: Fractional a => a
            q :: a
    q = a
    v a -> a -> a
    forall a. Num a => a -> a -> a
    * (a
    1a -> a -> a
    forall a. Num a => a -> a -> a
    -a
    f)
            p :: a
    p = a
    v a -> a -> a
    forall a. Num a => a -> a -> a
    * (a
    1a -> a -> a
    forall a. Num a => a -> a -> a
    -a
    s)
            t :: a
    t = a
    v a -> a -> a
    forall a. Num a => a -> a -> a
    * (a
    1a -> a -> a
    forall a. Num a => a -> a -> a
    -(a
    1a -> a -> a
    forall a. Num a => a -> a -> a
    -a
    f)a -> a -> a
    forall a. Num a => a -> a -> a
    *a
    s)
        in case Integer
    hi of
             Integer
    0 -> (a
    v,a
    t,a
    p)
             Integer
    1 -> (a
    q,a
    v,a
    p)
             Integer
    2 -> (a
    p,a
    v,a
    t)
             Integer
    3 -> (a
    p,a
    q,a
    v)
             Integer
    4 -> (a
    t,a
    p,a
    v)
             Integer
    5 -> (a
    v,a
    p,a
    q)
             Integer
    _ -> String -> (a, a, a)
    forall a. HasCallStack => String -> a
    error String
    "The world is ending. x mod a >= a."

    -- | Default colorizer for Strings
    stringColorizer :: String -> Bool -> X (String, String)
    stringColorizer :: String -> Bool -> X (String, String)
    stringColorizer String
    s Bool
    active =
        let seed :: Int -> Integer
    seed Int
    x = Int -> Integer
    forall a. Integral a => a -> Integer
    toInteger ([Int] -> Int
    forall a. Num a => [a] -> a
    forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
    sum ([Int] -> Int) -> [Int] -> Int
    forall a b. (a -> b) -> a -> b
    $ (Char -> Int) -> String -> [Int]
    forall a b. (a -> b) -> [a] -> [b]
    map ((Int -> Int -> Int
    forall a. Num a => a -> a -> a
    *Int
    x)(Int -> Int) -> (Char -> Int) -> Char -> Int
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .Char -> Int
    forall a. Enum a => a -> Int
    fromEnum) String
    s) :: Integer
            (Double
    r,Double
    g,Double
    b) = (Integer, Double, Double) -> (Double, Double, Double)
    forall a. Fractional a => (Integer, a, a) -> (a, a, a)
    hsv2rgb (Int -> Integer
    seed Int
    83 Integer -> Integer -> Integer
    forall a. Integral a => a -> a -> a
    `mod` Integer
    360,
                               Integer -> Double
    forall a. Num a => Integer -> a
    fromInteger (Int -> Integer
    seed Int
    191 Integer -> Integer -> Integer
    forall a. Integral a => a -> a -> a
    `mod` Integer
    1000)Double -> Double -> Double
    forall a. Fractional a => a -> a -> a
    /Double
    2500Double -> Double -> Double
    forall a. Num a => a -> a -> a
    +Double
    0.4,
                               Integer -> Double
    forall a. Num a => Integer -> a
    fromInteger (Int -> Integer
    seed Int
    121 Integer -> Integer -> Integer
    forall a. Integral a => a -> a -> a
    `mod` Integer
    1000)Double -> Double -> Double
    forall a. Fractional a => a -> a -> a
    /Double
    2500Double -> Double -> Double
    forall a. Num a => a -> a -> a
    +Double
    0.4)
        in if Bool
    active
             then (String, String) -> X (String, String)
    forall a. a -> X a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (String
    "#faff69", String
    "black")
             else (String, String) -> X (String, String)
    forall a. a -> X a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (String
    "#" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ (Double -> String) -> [Double] -> String
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap (Word8 -> String
    twodigitHex(Word8 -> String) -> (Double -> Word8) -> Double -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .(Double -> Word8
    forall b. Integral b => Double -> b
    forall a b. (RealFrac a, Integral b) => a -> b
    round :: Double -> Word8)(Double -> Word8) -> (Double -> Double) -> Double -> Word8
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .(Double -> Double -> Double
    forall a. Num a => a -> a -> a
    *Double
    256)) [Double
    r, Double
    g, Double
    b], String
    "white")

    -- | Colorize a window depending on it's className.
    fromClassName :: Window -> Bool -> X (String, String)
    fromClassName :: Word64 -> Bool -> X (String, String)
    fromClassName Word64
    w Bool
    active = Query String -> Word64 -> X String
    forall a. Query a -> Word64 -> X a
    runQuery Query String
    className Word64
    w X String -> (String -> X (String, String)) -> X (String, String)
    forall a b. X a -> (a -> X b) -> X b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= (String -> Bool -> X (String, String))
    -> Bool -> String -> X (String, String)
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip String -> Bool -> X (String, String)
    forall a. HasColorizer a => a -> Bool -> X (String, String)
    defaultColorizer Bool
    active

    twodigitHex :: Word8 -> String
    twodigitHex :: Word8 -> String
    twodigitHex = String -> Word8 -> String
    forall r. PrintfType r => String -> r
    printf String
    "%02x"

    -- | A colorizer that picks a color inside a range,
    -- and depending on the window's class.
    colorRangeFromClassName :: (Word8, Word8, Word8) -- ^ Beginning of the color range
                            -> (Word8, Word8, Word8) -- ^ End of the color range
                            -> (Word8, Word8, Word8) -- ^ Background of the active window
                            -> (Word8, Word8, Word8) -- ^ Inactive text color
                            -> (Word8, Word8, Word8) -- ^ Active text color
                            -> Window -> Bool -> X (String, String)
    colorRangeFromClassName :: (Word8, Word8, Word8)
    -> (Word8, Word8, Word8)
    -> (Word8, Word8, Word8)
    -> (Word8, Word8, Word8)
    -> (Word8, Word8, Word8)
    -> Word64
    -> Bool
    -> X (String, String)
    colorRangeFromClassName (Word8, Word8, Word8)
    startC (Word8, Word8, Word8)
    endC (Word8, Word8, Word8)
    activeC (Word8, Word8, Word8)
    inactiveT (Word8, Word8, Word8)
    activeT Word64
    w Bool
    active =
        do classname <- Query String -> Word64 -> X String
    forall a. Query a -> Word64 -> X a
    runQuery Query String
    className Word64
    w
           if active
             then return (rgbToHex activeC, rgbToHex activeT)
             else return (rgbToHex $ mix startC endC
                      $ stringToRatio classname, rgbToHex inactiveT)
        where rgbToHex :: (Word8, Word8, Word8) -> String
              rgbToHex :: (Word8, Word8, Word8) -> String
    rgbToHex (Word8
    r, Word8
    g, Word8
    b) = Char
    '#'Char -> String -> String
    forall a. a -> [a] -> [a]
    :Word8 -> String
    twodigitHex Word8
    r
                                   String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++Word8 -> String
    twodigitHex Word8
    gString -> String -> String
    forall a. [a] -> [a] -> [a]
    ++Word8 -> String
    twodigitHex Word8
    b

    -- | Creates a mix of two colors according to a ratio
    -- (1 -> first color, 0 -> second color).
    mix :: (Word8, Word8, Word8) -> (Word8, Word8, Word8)
            -> Double -> (Word8, Word8, Word8)
    mix :: (Word8, Word8, Word8)
    -> (Word8, Word8, Word8) -> Double -> (Word8, Word8, Word8)
    mix (Word8
    r1, Word8
    g1, Word8
    b1) (Word8
    r2, Word8
    g2, Word8
    b2) Double
    r = (Word8 -> Word8 -> Word8
    forall {b} {a} {a}.
    (Integral b, Integral a, Integral a) =>
    a -> a -> b
    mix' Word8
    r1 Word8
    r2, Word8 -> Word8 -> Word8
    forall {b} {a} {a}.
    (Integral b, Integral a, Integral a) =>
    a -> a -> b
    mix' Word8
    g1 Word8
    g2, Word8 -> Word8 -> Word8
    forall {b} {a} {a}.
    (Integral b, Integral a, Integral a) =>
    a -> a -> b
    mix' Word8
    b1 Word8
    b2)
        where  mix' :: a -> a -> b
    mix' a
    a a
    b = Double -> b
    forall b. Integral b => Double -> b
    forall a b. (RealFrac a, Integral b) => a -> b
    truncate (Double -> b) -> Double -> b
    forall a b. (a -> b) -> a -> b
    $ (a -> Double
    forall a b. (Integral a, Num b) => a -> b
    fi a
    a Double -> Double -> Double
    forall a. Num a => a -> a -> a
    * Double
    r) Double -> Double -> Double
    forall a. Num a => a -> a -> a
    + (a -> Double
    forall a b. (Integral a, Num b) => a -> b
    fi a
    b Double -> Double -> Double
    forall a. Num a => a -> a -> a
    * (Double
    1 Double -> Double -> Double
    forall a. Num a => a -> a -> a
    - Double
    r))

    -- | Generates a Double from a string, trying to
    -- achieve a random distribution.
    -- We create a random seed from the hash of all characters
    -- in the string, and use it to generate a ratio between 0 and 1
    stringToRatio :: String -> Double
    stringToRatio :: String -> Double
    stringToRatio String
    "" = Double
    0
    stringToRatio String
    s = let gen :: StdGen
    gen = Int -> StdGen
    mkStdGen (Int -> StdGen) -> Int -> StdGen
    forall a b. (a -> b) -> a -> b
    $ (Int -> Char -> Int) -> Int -> String -> 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
    t Char
    c -> Int
    t Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    31 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Char -> Int
    forall a. Enum a => a -> Int
    fromEnum Char
    c) Int
    0 String
    s
                      in (Double, StdGen) -> Double
    forall a b. (a, b) -> a
    fst ((Double, StdGen) -> Double) -> (Double, StdGen) -> Double
    forall a b. (a -> b) -> a -> b
    $ (Double, Double) -> StdGen -> (Double, StdGen)
    forall g. RandomGen g => (Double, Double) -> g -> (Double, g)
    forall a g. (Random a, RandomGen g) => (a, a) -> g -> (a, g)
    randomR (Double
    0, Double
    1) StdGen
    gen

    -- | Brings up a 2D grid of elements in the center of the screen, and one can
    -- select an element with cursors keys. The selected element is returned.
    gridselect :: GSConfig a -> [(String,a)] -> X (Maybe a)
    gridselect :: forall a. GSConfig a -> [(String, a)] -> X (Maybe a)
    gridselect GSConfig a
    _ [] = Maybe a -> X (Maybe a)
    forall a. a -> X a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe a
    forall a. Maybe a
    Nothing
    gridselect GSConfig a
    gsconfig [(String, a)]
    elements =
     (Display -> X (Maybe a)) -> X (Maybe a)
    forall a. (Display -> X a) -> X a
    withDisplay ((Display -> X (Maybe a)) -> X (Maybe a))
    -> (Display -> X (Maybe a)) -> X (Maybe a)
    forall a b. (a -> b) -> a -> b
    $ \Display
    dpy -> do
        rootw <- (XConf -> Word64) -> X Word64
    forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
    asks XConf -> Word64
    theRoot
        scr <- gets $ screenRect . W.screenDetail . W.current . windowset
        win <- liftIO $ mkUnmanagedWindow dpy (defaultScreenOfDisplay dpy) rootw
                        (rect_x scr) (rect_y scr) (rect_width scr) (rect_height scr)
        liftIO $ mapWindow dpy win
        liftIO $ selectInput dpy win (exposureMask .|. keyPressMask .|. buttonReleaseMask)
        status <- io $ grabKeyboard dpy win True grabModeAsync grabModeAsync currentTime
        void $ io $ grabPointer dpy win True buttonReleaseMask grabModeAsync grabModeAsync none none currentTime
        font <- initXMF (gs_font gsconfig)
        let screenWidth = Dimension -> Integer
    forall a. Integral a => a -> Integer
    toInteger (Dimension -> Integer) -> Dimension -> Integer
    forall a b. (a -> b) -> a -> b
    $ Rectangle -> Dimension
    rect_width Rectangle
    scr
            screenHeight = Dimension -> Integer
    forall a. Integral a => a -> Integer
    toInteger (Dimension -> Integer) -> Dimension -> Integer
    forall a b. (a -> b) -> a -> b
    $ Rectangle -> Dimension
    rect_height Rectangle
    scr
        selectedElement <- if status == grabSuccess then do
                                let restriction Integer
    ss GSConfig a -> Integer
    cs = (Integer -> Double
    forall a. Num a => Integer -> a
    fromInteger Integer
    ssDouble -> Double -> Double
    forall a. Fractional a => a -> a -> a
    /Integer -> Double
    forall a. Num a => Integer -> a
    fromInteger (GSConfig a -> Integer
    cs GSConfig a
    gsconfig)Double -> Double -> Double
    forall a. Num a => a -> a -> a
    -Double
    1)Double -> Double -> Double
    forall a. Fractional a => a -> a -> a
    /Double
    2 :: Double
                                    restrictX = Double -> Integer
    forall b. Integral b => Double -> b
    forall a b. (RealFrac a, Integral b) => a -> b
    floor (Double -> Integer) -> Double -> Integer
    forall a b. (a -> b) -> a -> b
    $ Integer -> (GSConfig a -> Integer) -> Double
    restriction Integer
    screenWidth GSConfig a -> Integer
    forall a. GSConfig a -> Integer
    gs_cellwidth
                                    restrictY = Double -> Integer
    forall b. Integral b => Double -> b
    forall a b. (RealFrac a, Integral b) => a -> b
    floor (Double -> Integer) -> Double -> Integer
    forall a b. (a -> b) -> a -> b
    $ Integer -> (GSConfig a -> Integer) -> Double
    restriction Integer
    screenHeight GSConfig a -> Integer
    forall a. GSConfig a -> Integer
    gs_cellheight
                                    originPosX = Double -> Integer
    forall b. Integral b => Double -> b
    forall a b. (RealFrac a, Integral b) => a -> b
    floor (Double -> Integer) -> Double -> Integer
    forall a b. (a -> b) -> a -> b
    $ (GSConfig a -> Double
    forall a. GSConfig a -> Double
    gs_originFractX GSConfig a
    gsconfig Double -> Double -> Double
    forall a. Num a => a -> a -> a
    - (Double
    1Double -> Double -> Double
    forall a. Fractional a => a -> a -> a
    /Double
    2)) Double -> Double -> Double
    forall a. Num a => a -> a -> a
    * Double
    2 Double -> Double -> Double
    forall a. Num a => a -> a -> a
    * Integer -> Double
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Integer
    restrictX
                                    originPosY = Double -> Integer
    forall b. Integral b => Double -> b
    forall a b. (RealFrac a, Integral b) => a -> b
    floor (Double -> Integer) -> Double -> Integer
    forall a b. (a -> b) -> a -> b
    $ (GSConfig a -> Double
    forall a. GSConfig a -> Double
    gs_originFractY GSConfig a
    gsconfig Double -> Double -> Double
    forall a. Num a => a -> a -> a
    - (Double
    1Double -> Double -> Double
    forall a. Fractional a => a -> a -> a
    /Double
    2)) Double -> Double -> Double
    forall a. Num a => a -> a -> a
    * Double
    2 Double -> Double -> Double
    forall a. Num a => a -> a -> a
    * Integer -> Double
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Integer
    restrictY
                                    coords = Integer -> Integer -> Integer -> Integer -> [TwoDPosition]
    diamondRestrict Integer
    restrictX Integer
    restrictY Integer
    originPosX Integer
    originPosY
                                    s = TwoDState { td_curpos :: TwoDPosition
    td_curpos = NonEmpty TwoDPosition -> TwoDPosition
    forall a. NonEmpty a -> a
    NE.head ([TwoDPosition] -> NonEmpty TwoDPosition
    forall a. HasCallStack => [a] -> NonEmpty a
    notEmpty [TwoDPosition]
    coords),
                                                    td_availSlots :: [TwoDPosition]
    td_availSlots = [TwoDPosition]
    coords,
                                                    td_elements :: [(String, a)]
    td_elements = [(String, a)]
    elements,
                                                    td_gsconfig :: GSConfig a
    td_gsconfig = GSConfig a
    gsconfig,
                                                    td_font :: XMonadFont
    td_font = XMonadFont
    font,
                                                    td_paneX :: Integer
    td_paneX = Integer
    screenWidth,
                                                    td_paneY :: Integer
    td_paneY = Integer
    screenHeight,
                                                    td_drawingWin :: Word64
    td_drawingWin = Word64
    win,
                                                    td_searchString :: String
    td_searchString = String
    "",
                                                    td_elementmap :: TwoDElementMap a
    td_elementmap = [] }
                                m <- generateElementmap s
                                evalTwoD (updateAllElements >> gs_navigate gsconfig)
                                         (s { td_elementmap = m })
                          else
                              return Nothing
        liftIO $ do
          unmapWindow dpy win
          destroyWindow dpy win
          ungrabPointer dpy currentTime
          sync dpy False
        releaseXMF font
        return selectedElement

    -- | Like `gridSelect' but with the current windows and their titles as elements
    gridselectWindow :: GSConfig Window -> X (Maybe Window)
    gridselectWindow :: GSConfig Word64 -> X (Maybe Word64)
    gridselectWindow GSConfig Word64
    gsconf = X [(String, Word64)]
    windowMap X [(String, Word64)]
    -> ([(String, Word64)] -> X (Maybe Word64)) -> X (Maybe Word64)
    forall a b. X a -> (a -> X b) -> X b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= GSConfig Word64 -> [(String, Word64)] -> X (Maybe Word64)
    forall a. GSConfig a -> [(String, a)] -> X (Maybe a)
    gridselect GSConfig Word64
    gsconf

    -- | Brings up a 2D grid of windows in the center of the screen, and one can
    -- select a window with cursors keys. The selected window is then passed to
    -- a callback function.
    withSelectedWindow :: (Window -> X ()) -> GSConfig Window -> X ()
    withSelectedWindow :: (Word64 -> X ()) -> GSConfig Word64 -> X ()
    withSelectedWindow Word64 -> X ()
    callback GSConfig Word64
    conf = do
        mbWindow <- GSConfig Word64 -> X (Maybe Word64)
    gridselectWindow GSConfig Word64
    conf
        for_ mbWindow callback

    windowMap :: X [(String,Window)]
    windowMap :: X [(String, Word64)]
    windowMap = do
        ws <- (XState
     -> StackSet String (Layout Word64) Word64 ScreenId ScreenDetail)
    -> X (StackSet String (Layout Word64) Word64 ScreenId ScreenDetail)
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets XState
    -> StackSet String (Layout Word64) Word64 ScreenId ScreenDetail
    windowset
        mapM keyValuePair (W.allWindows ws)
     where keyValuePair :: Word64 -> X (String, Word64)
    keyValuePair Word64
    w = (, Word64
    w) (String -> (String, Word64)) -> X String -> X (String, Word64)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Word64 -> X String
    decorateName' Word64
    w

    decorateName' :: Window -> X String
    decorateName' :: Word64 -> X String
    decorateName' Word64
    w = do
      NamedWindow -> String
    forall a. Show a => a -> String
    show (NamedWindow -> String) -> X NamedWindow -> X String
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Word64 -> X NamedWindow
    getName Word64
    w

    -- | Builds a default gs config from a colorizer function.
    buildDefaultGSConfig :: (a -> Bool -> X (String,String)) -> GSConfig a
    buildDefaultGSConfig :: forall a. (a -> Bool -> X (String, String)) -> GSConfig a
    buildDefaultGSConfig a -> Bool -> X (String, String)
    col = Integer
    -> Integer
    -> Integer
    -> (a -> Bool -> X (String, String))
    -> String
    -> TwoD a (Maybe a)
    -> Rearranger a
    -> Double
    -> Double
    -> String
    -> Bool
    -> GSConfig a
    forall a.
    Integer
    -> Integer
    -> Integer
    -> (a -> Bool -> X (String, String))
    -> String
    -> TwoD a (Maybe a)
    -> Rearranger a
    -> Double
    -> Double
    -> String
    -> Bool
    -> GSConfig a
    GSConfig Integer
    50 Integer
    130 Integer
    10 a -> Bool -> X (String, String)
    col String
    "xft:Sans-8" TwoD a (Maybe a)
    forall a. TwoD a (Maybe a)
    defaultNavigation Rearranger a
    forall a. Rearranger a
    noRearranger (Double
    1Double -> Double -> Double
    forall a. Fractional a => a -> a -> a
    /Double
    2) (Double
    1Double -> Double -> Double
    forall a. Fractional a => a -> a -> a
    /Double
    2) String
    "white" Bool
    True

    -- | Brings selected window to the current workspace.
    bringSelected :: GSConfig Window -> X ()
    bringSelected :: GSConfig Word64 -> X ()
    bringSelected = (Word64 -> X ()) -> GSConfig Word64 -> X ()
    withSelectedWindow ((Word64 -> X ()) -> GSConfig Word64 -> X ())
    -> (Word64 -> X ()) -> GSConfig Word64 -> X ()
    forall a b. (a -> b) -> a -> b
    $ \Word64
    w -> do
        (StackSet String (Layout Word64) Word64 ScreenId ScreenDetail
     -> StackSet String (Layout Word64) Word64 ScreenId ScreenDetail)
    -> X ()
    windows (Word64
    -> StackSet String (Layout Word64) Word64 ScreenId ScreenDetail
    -> StackSet String (Layout Word64) Word64 ScreenId ScreenDetail
    bringWindow Word64
    w)
        Word64 -> X ()
    XMonad.focus Word64
    w
        (StackSet String (Layout Word64) Word64 ScreenId ScreenDetail
     -> StackSet String (Layout Word64) Word64 ScreenId ScreenDetail)
    -> X ()
    windows StackSet String (Layout Word64) Word64 ScreenId ScreenDetail
    -> StackSet String (Layout Word64) Word64 ScreenId ScreenDetail
    forall i l a s sd. StackSet i l a s sd -> StackSet i l a s sd
    W.shiftMaster

    -- | Switches to selected window's workspace and focuses that window.
    goToSelected :: GSConfig Window -> X ()
    goToSelected :: GSConfig Word64 -> X ()
    goToSelected = (Word64 -> X ()) -> GSConfig Word64 -> X ()
    withSelectedWindow ((Word64 -> X ()) -> GSConfig Word64 -> X ())
    -> (Word64 -> X ()) -> GSConfig Word64 -> X ()
    forall a b. (a -> b) -> a -> b
    $ (StackSet String (Layout Word64) Word64 ScreenId ScreenDetail
     -> StackSet String (Layout Word64) Word64 ScreenId ScreenDetail)
    -> X ()
    windows ((StackSet String (Layout Word64) Word64 ScreenId ScreenDetail
      -> StackSet String (Layout Word64) Word64 ScreenId ScreenDetail)
     -> X ())
    -> (Word64
        -> StackSet String (Layout Word64) Word64 ScreenId ScreenDetail
        -> StackSet String (Layout Word64) Word64 ScreenId ScreenDetail)
    -> Word64
    -> X ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Word64
    -> StackSet String (Layout Word64) Word64 ScreenId ScreenDetail
    -> StackSet String (Layout Word64) Word64 ScreenId ScreenDetail
    forall s a i l sd.
    (Eq s, Eq a, Eq i) =>
    a -> StackSet i l a s sd -> StackSet i l a s sd
    W.focusWindow

    -- | Select an application to spawn from a given list
    spawnSelected :: GSConfig String -> [String] -> X ()
    spawnSelected :: GSConfig String -> [String] -> X ()
    spawnSelected GSConfig String
    conf [String]
    lst = GSConfig String -> [(String, String)] -> X (Maybe String)
    forall a. GSConfig a -> [(String, a)] -> X (Maybe a)
    gridselect GSConfig String
    conf ([String] -> [String] -> [(String, String)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [String]
    lst [String]
    lst) X (Maybe String) -> (Maybe String -> X ()) -> X ()
    forall a b. X a -> (a -> X b) -> X b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= (Maybe String -> (String -> X ()) -> X ())
    -> (String -> X ()) -> Maybe String -> X ()
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip Maybe String -> (String -> X ()) -> X ()
    forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
    whenJust String -> X ()
    forall (m :: * -> *). MonadIO m => String -> m ()
    spawn

    -- | Select an action and run it in the X monad
    runSelectedAction :: GSConfig (X ()) -> [(String, X ())] -> X ()
    runSelectedAction :: GSConfig (X ()) -> [(String, X ())] -> X ()
    runSelectedAction GSConfig (X ())
    conf [(String, X ())]
    actions = do
        selectedActionM <- GSConfig (X ()) -> [(String, X ())] -> X (Maybe (X ()))
    forall a. GSConfig a -> [(String, a)] -> X (Maybe a)
    gridselect GSConfig (X ())
    conf [(String, X ())]
    actions
        case selectedActionM of
            Just X ()
    selectedAction -> X ()
    selectedAction
            Maybe (X ())
    Nothing -> () -> X ()
    forall a. a -> X a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()

    -- | Select a workspace and view it using the given function
    -- (normally 'W.view' or 'W.greedyView')
    --
    -- Another option is to shift the current window to the selected workspace:
    --
    -- > gridselectWorkspace (\ws -> W.greedyView ws . W.shift ws)
    gridselectWorkspace :: GSConfig WorkspaceId ->
                              (WorkspaceId -> WindowSet -> WindowSet) -> X ()
    gridselectWorkspace :: GSConfig String
    -> (String
        -> StackSet String (Layout Word64) Word64 ScreenId ScreenDetail
        -> StackSet String (Layout Word64) Word64 ScreenId ScreenDetail)
    -> X ()
    gridselectWorkspace GSConfig String
    conf String
    -> StackSet String (Layout Word64) Word64 ScreenId ScreenDetail
    -> StackSet String (Layout Word64) Word64 ScreenId ScreenDetail
    viewFunc = GSConfig String -> (String -> X ()) -> X ()
    gridselectWorkspace' GSConfig String
    conf ((StackSet String (Layout Word64) Word64 ScreenId ScreenDetail
     -> StackSet String (Layout Word64) Word64 ScreenId ScreenDetail)
    -> X ()
    windows ((StackSet String (Layout Word64) Word64 ScreenId ScreenDetail
      -> StackSet String (Layout Word64) Word64 ScreenId ScreenDetail)
     -> X ())
    -> (String
        -> StackSet String (Layout Word64) Word64 ScreenId ScreenDetail
        -> StackSet String (Layout Word64) Word64 ScreenId ScreenDetail)
    -> String
    -> X ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String
    -> StackSet String (Layout Word64) Word64 ScreenId ScreenDetail
    -> StackSet String (Layout Word64) Word64 ScreenId ScreenDetail
    viewFunc)

    -- | Select a workspace and run an arbitrary action on it.
    gridselectWorkspace' :: GSConfig WorkspaceId -> (WorkspaceId -> X ()) -> X ()
    gridselectWorkspace' :: GSConfig String -> (String -> X ()) -> X ()
    gridselectWorkspace' GSConfig String
    conf String -> X ()
    func = (StackSet String (Layout Word64) Word64 ScreenId ScreenDetail
     -> X ())
    -> X ()
    forall a.
    (StackSet String (Layout Word64) Word64 ScreenId ScreenDetail
     -> X a)
    -> X a
    withWindowSet ((StackSet String (Layout Word64) Word64 ScreenId ScreenDetail
      -> X ())
     -> X ())
    -> (StackSet String (Layout Word64) Word64 ScreenId ScreenDetail
        -> X ())
    -> X ()
    forall a b. (a -> b) -> a -> b
    $ \StackSet String (Layout Word64) Word64 ScreenId ScreenDetail
    ws -> do
        let wss :: [String]
    wss = (Workspace String (Layout Word64) Word64 -> String)
    -> [Workspace String (Layout Word64) Word64] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map Workspace String (Layout Word64) Word64 -> String
    forall i l a. Workspace i l a -> i
    W.tag ([Workspace String (Layout Word64) Word64] -> [String])
    -> [Workspace String (Layout Word64) Word64] -> [String]
    forall a b. (a -> b) -> a -> b
    $ StackSet String (Layout Word64) Word64 ScreenId ScreenDetail
    -> [Workspace String (Layout Word64) Word64]
    forall i l a sid sd. StackSet i l a sid sd -> [Workspace i l a]
    W.hidden StackSet String (Layout Word64) Word64 ScreenId ScreenDetail
    ws [Workspace String (Layout Word64) Word64]
    -> [Workspace String (Layout Word64) Word64]
    -> [Workspace String (Layout Word64) Word64]
    forall a. [a] -> [a] -> [a]
    ++ (Screen String (Layout Word64) Word64 ScreenId ScreenDetail
     -> Workspace String (Layout Word64) Word64)
    -> [Screen String (Layout Word64) Word64 ScreenId ScreenDetail]
    -> [Workspace String (Layout Word64) Word64]
    forall a b. (a -> b) -> [a] -> [b]
    map Screen String (Layout Word64) Word64 ScreenId ScreenDetail
    -> Workspace String (Layout Word64) Word64
    forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
    W.workspace (StackSet String (Layout Word64) Word64 ScreenId ScreenDetail
    -> Screen String (Layout Word64) Word64 ScreenId ScreenDetail
    forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
    W.current StackSet String (Layout Word64) Word64 ScreenId ScreenDetail
    ws Screen String (Layout Word64) Word64 ScreenId ScreenDetail
    -> [Screen String (Layout Word64) Word64 ScreenId ScreenDetail]
    -> [Screen String (Layout Word64) Word64 ScreenId ScreenDetail]
    forall a. a -> [a] -> [a]
    : StackSet String (Layout Word64) Word64 ScreenId ScreenDetail
    -> [Screen String (Layout Word64) Word64 ScreenId ScreenDetail]
    forall i l a sid sd. StackSet i l a sid sd -> [Screen i l a sid sd]
    W.visible StackSet String (Layout Word64) Word64 ScreenId ScreenDetail
    ws)
        GSConfig String -> [(String, String)] -> X (Maybe String)
    forall a. GSConfig a -> [(String, a)] -> X (Maybe a)
    gridselect GSConfig String
    conf ([String] -> [String] -> [(String, String)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [String]
    wss [String]
    wss) X (Maybe String) -> (Maybe String -> X ()) -> X ()
    forall a b. X a -> (a -> X b) -> X b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= (Maybe String -> (String -> X ()) -> X ())
    -> (String -> X ()) -> Maybe String -> X ()
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip Maybe String -> (String -> X ()) -> X ()
    forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
    whenJust String -> X ()
    func

    -- $rearrangers
    --
    -- Rearrangers allow for arbitrary post-filter rearranging of the grid
    -- elements.
    --
    -- For example, to be able to switch to a new dynamic workspace by typing
    -- in its name, you can use the following keybinding action:
    --
    -- > import XMonad.Actions.DynamicWorkspaces (addWorkspace)
    -- >
    -- > gridselectWorkspace' def
    -- >                          { gs_navigate   = navNSearch
    -- >                          , gs_rearranger = searchStringRearrangerGenerator id
    -- >                          }
    -- >                      addWorkspace

    -- | A function taking the search string and a list of elements, and
    -- returning a potentially rearranged list of elements.
    type Rearranger a = String -> [(String, a)] -> X [(String, a)]

    -- | A rearranger that leaves the elements unmodified.
    noRearranger :: Rearranger a
    noRearranger :: forall a. Rearranger a
    noRearranger String
    _ = [(String, a)] -> X [(String, a)]
    forall a. a -> X a
    forall (m :: * -> *) a. Monad m => a -> m a
    return

    -- | A generator for rearrangers that append a single element based on the
    -- search string, if doing so would not be redundant (empty string or value
    -- already present).
    searchStringRearrangerGenerator :: (String -> a) -> Rearranger a
    searchStringRearrangerGenerator :: forall a. (String -> a) -> Rearranger a
    searchStringRearrangerGenerator String -> a
    f =
        let r :: String -> [(String, a)] -> m [(String, a)]
    r String
    "" [(String, a)]
    xs                       = [(String, a)] -> m [(String, a)]
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return [(String, a)]
    xs
            r String
    s  [(String, a)]
    xs | String
    s String -> [String] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` ((String, a) -> String) -> [(String, a)] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map (String, a) -> String
    forall a b. (a, b) -> a
    fst [(String, a)]
    xs = [(String, a)] -> m [(String, a)]
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return [(String, a)]
    xs
                    | Bool
    otherwise           = [(String, a)] -> m [(String, a)]
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([(String, a)] -> m [(String, a)])
    -> [(String, a)] -> m [(String, a)]
    forall a b. (a -> b) -> a -> b
    $ [(String, a)]
    xs [(String, a)] -> [(String, a)] -> [(String, a)]
    forall a. [a] -> [a] -> [a]
    ++ [(String
    s, String -> a
    f String
    s)]
        in String -> [(String, a)] -> X [(String, a)]
    forall {m :: * -> *}.
    Monad m =>
    String -> [(String, a)] -> m [(String, a)]
    r