    {-# 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),
          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
    }

    -- | 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
        [(String, a)]
    rearrangedElements <- Rearranger a
    rearranger String
    searchString [(String, a)]
    sortedElements
        TwoDElementMap a -> X (TwoDElementMap a)
    forall a. a -> X a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (TwoDElementMap a -> X (TwoDElementMap a))
    -> TwoDElementMap a -> X (TwoDElementMap a)
    forall a b. (a -> b) -> a -> b
    $ [TwoDPosition] -> [(String, a)] -> TwoDElementMap a
    forall a b. [a] -> [b] -> [(a, b)]
    zip [TwoDPosition]
    positions [(String, a)]
    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
    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
      GC
    bordergc <- 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
      IO () -> X ()
    forall a. IO a -> X a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> X ()) -> IO () -> X ()
    forall a b. (a -> b) -> a -> b
    $ do
        Just Word64
    fgcolor <- Display -> String -> IO (Maybe Word64)
    initColor Display
    dpy String
    fg
        Just Word64
    bgcolor <- Display -> String -> IO (Maybe Word64)
    initColor Display
    dpy String
    bg
        Just Word64
    bordercolor <- Display -> String -> IO (Maybe Word64)
    initColor Display
    dpy String
    bc
        Display -> GC -> Word64 -> IO ()
    setForeground Display
    dpy GC
    gc Word64
    fgcolor
        Display -> GC -> Word64 -> IO ()
    setBackground Display
    dpy GC
    gc Word64
    bgcolor
        Display -> GC -> Word64 -> IO ()
    setForeground Display
    dpy GC
    bordergc Word64
    bordercolor
        Display
    -> Word64
    -> GC
    -> Position
    -> Position
    -> Dimension
    -> Dimension
    -> IO ()
    fillRectangle Display
    dpy Word64
    win GC
    gc (Integer -> Position
    forall a. Num a => Integer -> a
    fromInteger Integer
    x) (Integer -> Position
    forall a. Num a => Integer -> a
    fromInteger Integer
    y) (Integer -> Dimension
    forall a. Num a => Integer -> a
    fromInteger Integer
    cw) (Integer -> Dimension
    forall a. Num a => Integer -> a
    fromInteger Integer
    ch)
        Display
    -> Word64
    -> GC
    -> Position
    -> Position
    -> Dimension
    -> Dimension
    -> IO ()
    drawRectangle Display
    dpy Word64
    win GC
    bordergc (Integer -> Position
    forall a. Num a => Integer -> a
    fromInteger Integer
    x) (Integer -> Position
    forall a. Num a => Integer -> a
    fromInteger Integer
    y) (Integer -> Dimension
    forall a. Num a => Integer -> a
    fromInteger Integer
    cw) (Integer -> Dimension
    forall a. Num a => Integer -> a
    fromInteger Integer
    ch)
      String
    stext <- (String -> [String]) -> (String -> X Bool) -> String -> X String
    shrinkWhile (DefaultShrinker -> String -> [String]
    forall s. Shrinker s => s -> String -> [String]
    shrinkIt DefaultShrinker
    shrinkText)
               (\String
    n -> do Int
    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
                         Bool -> X Bool
    forall a. a -> X a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Bool -> X Bool) -> Bool -> X Bool
    forall a b. (a -> b) -> a -> b
    $ Int
    size Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Integer -> Int
    forall a. Num a => Integer -> a
    fromInteger (Integer
    cwInteger -> Integer -> Integer
    forall a. Num a => a -> a -> a
    -(Integer
    2Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    *Integer
    cp)))
               String
    text
      -- calculate the offset to vertically centre the text based on the ascender and descender
      (Position
    asc,Position
    desc) <- IO (Position, Position) -> X (Position, Position)
    forall a. IO a -> X a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO (Position, Position) -> X (Position, Position))
    -> IO (Position, Position) -> X (Position, Position)
    forall a b. (a -> b) -> a -> b
    $ XMonadFont -> String -> IO (Position, Position)
    forall (m :: * -> *).
    MonadIO m =>
    XMonadFont -> String -> m (Position, Position)
    textExtentsXMF XMonadFont
    font String
    stext
      let offset :: Integer
    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
      Display
    -> Word64
    -> XMonadFont
    -> GC
    -> String
    -> String
    -> Position
    -> Position
    -> String
    -> X ()
    forall (m :: * -> *).
    (Functor m, MonadIO m) =>
    Display
    -> Word64
    -> XMonadFont
    -> GC
    -> String
    -> String
    -> Position
    -> Position
    -> String
    -> m ()
    printStringXMF Display
    dpy Word64
    win XMonadFont
    font GC
    gc String
    bg String
    fg (Integer -> Position
    forall a. Num a => Integer -> a
    fromInteger (Integer
    xInteger -> Integer -> Integer
    forall a. Num a => a -> a -> a
    +Integer
    cp)) (Integer -> Position
    forall a. Num a => Integer -> a
    fromInteger (Integer
    yInteger -> Integer -> Integer
    forall a. Num a => a -> a -> a
    +Integer
    offset)) String
    stext
      IO () -> X ()
    forall a. IO a -> X a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> X ()) -> IO () -> X ()
    forall a b. (a -> b) -> a -> b
    $ Display -> GC -> IO ()
    freeGC Display
    dpy GC
    gc
      IO () -> X ()
    forall a. IO a -> X a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> X ()) -> IO () -> X ()
    forall a b. (a -> b) -> a -> b
    $ Display -> GC -> IO ()
    freeGC Display
    dpy GC
    bordergc

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

    grayoutElements :: Int -> TwoD a ()
    grayoutElements :: forall a. Int -> TwoD a ()
    grayoutElements Int
    skip =
        do
          TwoDState a
    s <- TwoD a (TwoDState a)
    forall s (m :: * -> *). MonadState s m => m s
    get
          (a -> Bool -> X (String, String)) -> TwoDElementMap a -> TwoD a ()
    forall a.
    (a -> Bool -> X (String, String)) -> TwoDElementMap a -> TwoD a ()
    updateElementsWithColorizer a -> Bool -> X (String, String)
    forall {m :: * -> *} {p} {p}.
    Monad m =>
    p -> p -> m (String, String)
    grayOnly (TwoDElementMap a -> TwoD a ()) -> TwoDElementMap a -> TwoD a ()
    forall a b. (a -> b) -> a -> b
    $ Int -> TwoDElementMap a -> TwoDElementMap a
    forall a. Int -> [a] -> [a]
    drop Int
    skip (TwoDState a -> TwoDElementMap a
    forall a. TwoDState a -> TwoDElementMap a
    td_elementmap TwoDState a
    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
          TwoDState a
    s <- TwoD a (TwoDState a)
    forall s (m :: * -> *). MonadState s m => m s
    get
          (a -> Bool -> X (String, String)) -> TwoDElementMap a -> TwoD a ()
    forall a.
    (a -> Bool -> X (String, String)) -> TwoDElementMap a -> TwoD a ()
    updateElementsWithColorizer (GSConfig a -> a -> Bool -> X (String, String)
    forall a. GSConfig a -> a -> Bool -> X (String, String)
    gs_colorizer (TwoDState a -> GSConfig a
    forall a. TwoDState a -> GSConfig a
    td_gsconfig TwoDState a
    s)) TwoDElementMap a
    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 :: forall a. TwoDState a -> TwoDPosition
    td_curpos = TwoDPosition
    curpos,
                    td_drawingWin :: forall a. TwoDState a -> Word64
    td_drawingWin = Word64
    win,
                    td_gsconfig :: forall a. TwoDState a -> GSConfig a
    td_gsconfig = GSConfig a
    gsconfig,
                    td_font :: forall a. TwoDState a -> XMonadFont
    td_font = XMonadFont
    font,
                    td_paneX :: forall a. TwoDState a -> Integer
    td_paneX = Integer
    paneX,
                    td_paneY :: forall a. TwoDState a -> Integer
    td_paneY = Integer
    paneY} <- TwoD a (TwoDState a)
    forall s (m :: * -> *). MonadState s m => m s
    get
        let cellwidth :: Integer
    cellwidth = GSConfig a -> Integer
    forall a. GSConfig a -> Integer
    gs_cellwidth GSConfig a
    gsconfig
            cellheight :: Integer
    cellheight = GSConfig a -> Integer
    forall a. GSConfig a -> Integer
    gs_cellheight GSConfig a
    gsconfig
            paneX' :: Integer
    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
    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 :: (TwoDPosition, (String, a)) -> TwoD a ()
    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
                (String, String)
    colors <- a -> Bool -> X (String, String)
    colorizer a
    element (TwoDPosition
    pos TwoDPosition -> TwoDPosition -> Bool
    forall a. Eq a => a -> a -> Bool
    == TwoDPosition
    curpos)
                Word64
    -> XMonadFont
    -> (String, String)
    -> String
    -> Integer
    -> Integer
    -> String
    -> Integer
    -> Integer
    -> Integer
    -> X ()
    drawWinBox Word64
    win XMonadFont
    font
                           (String, String)
    colors
                           (GSConfig a -> String
    forall a. GSConfig a -> String
    gs_bordercolor GSConfig a
    gsconfig)
                           Integer
    cellheight
                           Integer
    cellwidth
                           String
    text
                           (Integer
    paneX'Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    +Integer
    xInteger -> Integer -> Integer
    forall a. Num a => a -> a -> a
    *Integer
    cellwidth)
                           (Integer
    paneY'Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    +Integer
    yInteger -> Integer -> Integer
    forall a. Num a => a -> a -> a
    *Integer
    cellheight)
                           (GSConfig a -> Integer
    forall a. GSConfig a -> Integer
    gs_cellpadding GSConfig a
    gsconfig)
        ((TwoDPosition, (String, a)) -> TwoD a ())
    -> TwoDElementMap a -> TwoD a ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ (TwoDPosition, (String, a)) -> TwoD a ()
    forall {a}. (TwoDPosition, (String, a)) -> TwoD a ()
    updateElement TwoDElementMap a
    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 a
    s@TwoDState { td_paneX :: forall a. TwoDState a -> Integer
    td_paneX = Integer
    px, td_paneY :: forall a. TwoDState a -> Integer
    td_paneY = Integer
    py,
                             td_gsconfig :: forall a. TwoDState a -> GSConfig a
    td_gsconfig = (GSConfig Integer
    ch Integer
    cw Integer
    _ a -> Bool -> X (String, String)
    _ String
    _ TwoD a (Maybe a)
    _ Rearranger a
    _ Double
    _ Double
    _ String
    _) } <- TwoD a (TwoDState a)
    forall s (m :: * -> *). MonadState s m => m s
    get
            let gridX :: Integer
    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 :: Integer
    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 TwoDPosition -> [(TwoDPosition, (String, a))] -> Maybe (String, a)
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    lookup (Integer
    gridX,Integer
    gridY) (TwoDState a -> [(TwoDPosition, (String, a))]
    forall a. TwoDState a -> TwoDElementMap a
    td_elementmap TwoDState a
    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 -> 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
                                 Event
    ev <- XEventPtr -> IO Event
    getEvent XEventPtr
    e
                                 if Event -> Dimension
    ev_event_type Event
    ev Dimension -> Dimension -> Bool
    forall a. Eq a => a -> a -> Bool
    == Dimension
    keyPress
                                   then do
                                      (Maybe Word64
    _, String
    s) <- XKeyEventPtr -> IO (Maybe Word64, String)
    lookupString (XKeyEventPtr -> IO (Maybe Word64, String))
    -> XKeyEventPtr -> IO (Maybe Word64, String)
    forall a b. (a -> b) -> a -> b
    $ XEventPtr -> XKeyEventPtr
    asKeyEvent XEventPtr
    e
                                      Word64
    ks <- Display -> Word8 -> CInt -> IO Word64
    keycodeToKeysym Display
    d (Event -> Word8
    ev_keycode Event
    ev) CInt
    0
                                      TwoD a (Maybe a) -> IO (TwoD a (Maybe a))
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (TwoD a (Maybe a) -> IO (TwoD a (Maybe a)))
    -> TwoD a (Maybe a) -> IO (TwoD a (Maybe a))
    forall a b. (a -> b) -> a -> b
    $ do
                                          KeyMask
    mask <- X KeyMask -> TwoD a KeyMask
    forall a1 a. X a1 -> TwoD a a1
    liftX (X KeyMask -> TwoD a KeyMask) -> X KeyMask -> TwoD a KeyMask
    forall a b. (a -> b) -> a -> b
    $ X (KeyMask -> KeyMask)
    cleanKeyMask X (KeyMask -> KeyMask) -> X KeyMask -> X KeyMask
    forall a b. X (a -> b) -> X a -> X b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> KeyMask -> X KeyMask
    forall a. a -> X a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Event -> KeyMask
    ev_state Event
    ev)
                                          (Word64, String, KeyMask) -> TwoD a (Maybe a)
    keyhandler (Word64
    ks, String
    s, KeyMask
    mask)
                                   else
                                      TwoD a (Maybe a) -> IO (TwoD a (Maybe a))
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (TwoD a (Maybe a) -> IO (TwoD a (Maybe a)))
    -> TwoD a (Maybe a) -> IO (TwoD a (Maybe a))
    forall a b. (a -> b) -> a -> b
    $ Event -> TwoD a (Maybe a) -> TwoD a (Maybe a)
    forall a. Event -> TwoD a (Maybe a) -> TwoD a (Maybe a)
    stdHandle Event
    ev TwoD a (Maybe a)
    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
      TwoDState a
    s <- TwoD a (TwoDState a)
    forall s (m :: * -> *). MonadState s m => m s
    get
      Maybe a -> TwoD a (Maybe a)
    forall a. a -> TwoD a a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe a -> TwoD a (Maybe a)) -> Maybe a -> TwoD a (Maybe a)
    forall a b. (a -> b) -> a -> b
    $ (String, a) -> a
    forall a b. (a, b) -> b
    snd ((String, a) -> a)
    -> ((TwoDPosition, (String, a)) -> (String, a))
    -> (TwoDPosition, (String, a))
    -> a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (TwoDPosition, (String, a)) -> (String, a)
    forall a b. (a, b) -> b
    snd ((TwoDPosition, (String, a)) -> a)
    -> Maybe (TwoDPosition, (String, a)) -> Maybe a
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> TwoDPosition
    -> [(TwoDPosition, (String, a))]
    -> Maybe (TwoDPosition, (String, a))
    forall a b. Eq a => a -> [(a, b)] -> Maybe (a, b)
    findInElementMap (TwoDState a -> TwoDPosition
    forall a. TwoDState a -> TwoDPosition
    td_curpos TwoDState a
    s) (TwoDState a -> [(TwoDPosition, (String, a))]
    forall a. TwoDState a -> TwoDElementMap a
    td_elementmap TwoDState a
    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
      TwoDState a
    s <- TwoD a (TwoDState a)
    forall s (m :: * -> *). MonadState s m => m s
    get
      let elmap :: TwoDElementMap a
    elmap = TwoDState a -> TwoDElementMap a
    forall a. TwoDState a -> TwoDElementMap a
    td_elementmap TwoDState a
    s
          newSelectedEl :: Maybe (TwoDPosition, (String, a))
    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 :: TwoDPosition
    oldPos = TwoDState a -> TwoDPosition
    forall a. TwoDState a -> TwoDPosition
    td_curpos TwoDState a
    s
      Bool -> TwoD a () -> TwoD a ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Maybe (TwoDPosition, (String, a)) -> Bool
    forall a. Maybe a -> Bool
    isJust Maybe (TwoDPosition, (String, a))
    newSelectedEl Bool -> Bool -> Bool
    && TwoDPosition
    newPos TwoDPosition -> TwoDPosition -> Bool
    forall a. Eq a => a -> a -> Bool
    /= TwoDPosition
    oldPos) (TwoD a () -> TwoD a ()) -> TwoD a () -> TwoD a ()
    forall a b. (a -> b) -> a -> b
    $ do
        TwoDState a -> TwoD a ()
    forall s (m :: * -> *). MonadState s m => s -> m ()
    put TwoDState a
    s { td_curpos = newPos }
        TwoDElementMap a -> TwoD a ()
    forall a. TwoDElementMap a -> TwoD a ()
    updateElements ([Maybe (TwoDPosition, (String, a))] -> TwoDElementMap a
    forall a. [Maybe a] -> [a]
    catMaybes [TwoDPosition
    -> TwoDElementMap a -> Maybe (TwoDPosition, (String, a))
    forall a b. Eq a => a -> [(a, b)] -> Maybe (a, b)
    findInElementMap TwoDPosition
    oldPos TwoDElementMap a
    elmap, Maybe (TwoDPosition, (String, a))
    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
      TwoDState a
    s <- TwoD a (TwoDState a)
    forall s (m :: * -> *). MonadState s m => m s
    get
      let (Integer
    x,Integer
    y) = TwoDState a -> TwoDPosition
    forall a. TwoDState a -> TwoDPosition
    td_curpos TwoDState a
    s
          newPos :: TwoDPosition
    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)
      TwoDPosition -> TwoD a ()
    forall a. TwoDPosition -> TwoD a ()
    setPos TwoDPosition
    newPos

    moveNext :: TwoD a ()
    moveNext :: forall a. TwoD a ()
    moveNext = do
      TwoDPosition
    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
      TwoDElementMap a
    elems <- (TwoDState a -> TwoDElementMap a) -> TwoD a (TwoDElementMap a)
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets TwoDState a -> TwoDElementMap a
    forall a. TwoDState a -> TwoDElementMap a
    td_elementmap
      let n :: Int
    n = TwoDElementMap a -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length TwoDElementMap a
    elems
          m :: Maybe Int
    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)
      Maybe Int -> (Int -> TwoD a ()) -> TwoD a ()
    forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
    whenJust Maybe Int
    m ((Int -> TwoD a ()) -> TwoD a ())
    -> (Int -> TwoD a ()) -> TwoD a ()
    forall a b. (a -> b) -> a -> b
    $ \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
      TwoDPosition
    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
      TwoDElementMap a
    elems <- (TwoDState a -> TwoDElementMap a) -> TwoD a (TwoDElementMap a)
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets TwoDState a -> TwoDElementMap a
    forall a. TwoDState a -> TwoDElementMap a
    td_elementmap
      let n :: Int
    n = TwoDElementMap a -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length TwoDElementMap a
    elems
          m :: Maybe Int
    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)
      Maybe Int -> (Int -> TwoD a ()) -> TwoD a ()
    forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
    whenJust Maybe Int
    m ((Int -> TwoD a ()) -> TwoD a ())
    -> (Int -> TwoD a ()) -> TwoD a ()
    forall a b. (a -> b) -> a -> b
    $ \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
              TwoDState a
    s <- TwoD a (TwoDState a)
    forall s (m :: * -> *). MonadState s m => m s
    get
              let oldSearchString :: String
    oldSearchString = TwoDState a -> String
    forall a. TwoDState a -> String
    td_searchString TwoDState a
    s
                  newSearchString :: String
    newSearchString = String -> String
    f String
    oldSearchString
              Bool -> TwoD a () -> TwoD a ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (String
    newSearchString String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    /= String
    oldSearchString) (TwoD a () -> TwoD a ()) -> TwoD a () -> TwoD a ()
    forall a b. (a -> b) -> a -> b
    $ do
                -- FIXME curpos might end up outside new bounds
                let s' :: TwoDState a
    s' = TwoDState a
    s { td_searchString = newSearchString }
                TwoDElementMap a
    m <- X (TwoDElementMap a) -> TwoD a (TwoDElementMap a)
    forall a1 a. X a1 -> TwoD a a1
    liftX (X (TwoDElementMap a) -> TwoD a (TwoDElementMap a))
    -> X (TwoDElementMap a) -> TwoD a (TwoDElementMap a)
    forall a b. (a -> b) -> a -> b
    $ TwoDState a -> X (TwoDElementMap a)
    forall a. TwoDState a -> X (TwoDElementMap a)
    generateElementmap TwoDState a
    s'
                let s'' :: TwoDState a
    s'' = TwoDState a
    s' { td_elementmap = m }
                    oldLen :: Int
    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 :: Int
    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.
                Bool -> TwoD a () -> TwoD a ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Int
    newLen Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < Int
    oldLen) (TwoD a () -> TwoD a ()) -> TwoD a () -> TwoD a ()
    forall a b. (a -> b) -> a -> b
    $ Int -> TwoD a ()
    forall a. Int -> TwoD a ()
    grayoutElements Int
    newLen
                TwoDState a -> TwoD a ()
    forall s (m :: * -> *). MonadState s m => s -> m ()
    put TwoDState a
    s''
                TwoD a ()
    forall a. TwoD a ()
    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 String
    classname <- Query String -> Word64 -> X String
    forall a. Query a -> Word64 -> X a
    runQuery Query String
    className Word64
    w
           if Bool
    active
             then (String, String) -> X (String, String)
    forall a. a -> X a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ((Word8, Word8, Word8) -> String
    rgbToHex (Word8, Word8, Word8)
    activeC, (Word8, Word8, Word8) -> String
    rgbToHex (Word8, Word8, Word8)
    activeT)
             else (String, String) -> X (String, String)
    forall a. a -> X a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ((Word8, Word8, Word8) -> String
    rgbToHex ((Word8, Word8, Word8) -> String)
    -> (Word8, Word8, Word8) -> String
    forall a b. (a -> b) -> a -> b
    $ (Word8, Word8, Word8)
    -> (Word8, Word8, Word8) -> Double -> (Word8, Word8, Word8)
    mix (Word8, Word8, Word8)
    startC (Word8, Word8, Word8)
    endC
                      (Double -> (Word8, Word8, Word8))
    -> Double -> (Word8, Word8, Word8)
    forall a b. (a -> b) -> a -> b
    $ String -> Double
    stringToRatio String
    classname, (Word8, Word8, Word8) -> String
    rgbToHex (Word8, Word8, Word8)
    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
        Word64
    rootw <- (XConf -> Word64) -> X Word64
    forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
    asks XConf -> Word64
    theRoot
        Rectangle
    scr <- (XState -> Rectangle) -> X Rectangle
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets ((XState -> Rectangle) -> X Rectangle)
    -> (XState -> Rectangle) -> X Rectangle
    forall a b. (a -> b) -> a -> b
    $ ScreenDetail -> Rectangle
    screenRect (ScreenDetail -> Rectangle)
    -> (XState -> ScreenDetail) -> XState -> Rectangle
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Screen String (Layout Word64) Word64 ScreenId ScreenDetail
    -> ScreenDetail
    forall i l a sid sd. Screen i l a sid sd -> sd
    W.screenDetail (Screen String (Layout Word64) Word64 ScreenId ScreenDetail
     -> ScreenDetail)
    -> (XState
        -> Screen String (Layout Word64) Word64 ScreenId ScreenDetail)
    -> XState
    -> ScreenDetail
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . 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
     -> Screen String (Layout Word64) Word64 ScreenId ScreenDetail)
    -> (XState
        -> StackSet String (Layout Word64) Word64 ScreenId ScreenDetail)
    -> XState
    -> Screen String (Layout Word64) Word64 ScreenId ScreenDetail
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . XState
    -> StackSet String (Layout Word64) Word64 ScreenId ScreenDetail
    windowset
        Word64
    win <- IO Word64 -> X Word64
    forall a. IO a -> X a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO Word64 -> X Word64) -> IO Word64 -> X Word64
    forall a b. (a -> b) -> a -> b
    $ Display
    -> Screen
    -> Word64
    -> Position
    -> Position
    -> Dimension
    -> Dimension
    -> IO Word64
    mkUnmanagedWindow Display
    dpy (Display -> Screen
    defaultScreenOfDisplay Display
    dpy) Word64
    rootw
                        (Rectangle -> Position
    rect_x Rectangle
    scr) (Rectangle -> Position
    rect_y Rectangle
    scr) (Rectangle -> Dimension
    rect_width Rectangle
    scr) (Rectangle -> Dimension
    rect_height Rectangle
    scr)
        IO () -> X ()
    forall a. IO a -> X a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> X ()) -> IO () -> X ()
    forall a b. (a -> b) -> a -> b
    $ Display -> Word64 -> IO ()
    mapWindow Display
    dpy Word64
    win
        IO () -> X ()
    forall a. IO a -> X a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> X ()) -> IO () -> X ()
    forall a b. (a -> b) -> a -> b
    $ Display -> Word64 -> Word64 -> IO ()
    selectInput Display
    dpy Word64
    win (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)
        CInt
    status <- IO CInt -> X CInt
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    io (IO CInt -> X CInt) -> IO CInt -> X CInt
    forall a b. (a -> b) -> a -> b
    $ Display -> Word64 -> Bool -> CInt -> CInt -> Word64 -> IO CInt
    grabKeyboard Display
    dpy Word64
    win Bool
    True CInt
    grabModeAsync CInt
    grabModeAsync Word64
    currentTime
        IO CInt -> X CInt
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    io (IO CInt -> X CInt) -> IO CInt -> X CInt
    forall a b. (a -> b) -> a -> b
    $ Display
    -> Word64
    -> Bool
    -> Word64
    -> CInt
    -> CInt
    -> Word64
    -> Word64
    -> Word64
    -> IO CInt
    grabPointer Display
    dpy Word64
    win Bool
    True Word64
    buttonReleaseMask CInt
    grabModeAsync CInt
    grabModeAsync Word64
    none Word64
    none Word64
    currentTime
        XMonadFont
    font <- String -> X XMonadFont
    initXMF (GSConfig a -> String
    forall a. GSConfig a -> String
    gs_font GSConfig a
    gsconfig)
        let screenWidth :: Integer
    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 :: Integer
    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
        Maybe a
    selectedElement <- if CInt
    status CInt -> CInt -> Bool
    forall a. Eq a => a -> a -> Bool
    == CInt
    grabSuccess then do
                                let restriction :: Integer -> (GSConfig a -> Integer) -> Double
    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 :: Integer
    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 :: Integer
    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 :: Integer
    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 :: Integer
    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 :: [TwoDPosition]
    coords = Integer -> Integer -> Integer -> Integer -> [TwoDPosition]
    diamondRestrict Integer
    restrictX Integer
    restrictY Integer
    originPosX Integer
    originPosY
                                    s :: TwoDState a
    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 = [] }
                                TwoDElementMap a
    m <- TwoDState a -> X (TwoDElementMap a)
    forall a. TwoDState a -> X (TwoDElementMap a)
    generateElementmap TwoDState a
    s
                                TwoD a (Maybe a) -> TwoDState a -> X (Maybe a)
    forall a1 a. TwoD a1 a -> TwoDState a1 -> X a
    evalTwoD (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
    >> GSConfig a -> TwoD a (Maybe a)
    forall a. GSConfig a -> TwoD a (Maybe a)
    gs_navigate GSConfig a
    gsconfig)
                                         (TwoDState a
    s { td_elementmap = m })
                          else
                              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
        IO () -> X ()
    forall a. IO a -> X a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> X ()) -> IO () -> X ()
    forall a b. (a -> b) -> a -> b
    $ do
          Display -> Word64 -> IO ()
    unmapWindow Display
    dpy Word64
    win
          Display -> Word64 -> IO ()
    destroyWindow Display
    dpy Word64
    win
          Display -> Word64 -> IO ()
    ungrabPointer Display
    dpy Word64
    currentTime
          Display -> Bool -> IO ()
    sync Display
    dpy Bool
    False
        XMonadFont -> X ()
    releaseXMF XMonadFont
    font
        Maybe a -> X (Maybe a)
    forall a. a -> X a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe a
    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
        Maybe Word64
    mbWindow <- GSConfig Word64 -> X (Maybe Word64)
    gridselectWindow GSConfig Word64
    conf
        Maybe Word64 -> (Word64 -> X ()) -> X ()
    forall (t :: * -> *) (f :: * -> *) a b.
    (Foldable t, Applicative f) =>
    t a -> (a -> f b) -> f ()
    for_ Maybe Word64
    mbWindow Word64 -> X ()
    callback

    windowMap :: X [(String,Window)]
    windowMap :: X [(String, Word64)]
    windowMap = do
        StackSet String (Layout Word64) Word64 ScreenId ScreenDetail
    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
        (Word64 -> X (String, Word64)) -> [Word64] -> X [(String, Word64)]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM Word64 -> X (String, Word64)
    keyValuePair (StackSet String (Layout Word64) Word64 ScreenId ScreenDetail
    -> [Word64]
    forall a i l s sd. Eq a => StackSet i l a s sd -> [a]
    W.allWindows StackSet String (Layout Word64) Word64 ScreenId ScreenDetail
    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
    -> GSConfig a
    forall a.
    Integer
    -> Integer
    -> Integer
    -> (a -> Bool -> X (String, String))
    -> String
    -> TwoD a (Maybe a)
    -> Rearranger a
    -> Double
    -> Double
    -> String
    -> 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"

    -- | 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
        Maybe (X ())
    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 Maybe (X ())
    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