{-# LANGUAGE PatternGuards #-}
{-# LANGUAGE TupleSections #-}
{-# OPTIONS_GHC -fno-warn-missing-signatures -fno-warn-orphans #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  XMonad.Config.Droundy
-- Description :  David Roundy's xmonad config.
-- Copyright   :  (c) Spencer Janssen 2007
-- License     :  BSD3-style (see LICENSE)
--
------------------------------------------------------------------------
module XMonad.Config.Droundy {-# DEPRECATED "This module contains a personal configuration, to be removed from xmonad-contrib.  If you use this module, please copy the relevant parts to your configuration or obtain a copy of it on https://xmonad.org/configurations.html and include it as a local module." #-} ( config, mytab ) where

import XMonad hiding (keys, config)
import qualified XMonad (keys)

import qualified XMonad.StackSet as W
import qualified Data.Map as M
import System.Exit ( exitSuccess )

import XMonad.Layout.Tabbed ( tabbed,
                              shrinkText, Shrinker, shrinkIt, CustomShrink(CustomShrink) )
import XMonad.Layout.Combo ( combineTwo )
import XMonad.Layout.Renamed ( Rename(Replace), renamed )
import XMonad.Layout.LayoutCombinators
import XMonad.Layout.Square ( Square(Square) )
import XMonad.Layout.WindowNavigation ( Navigate(Move,Swap,Go), Direction2D(U,D,R,L),
                                        windowNavigation )
import XMonad.Layout.BoringWindows ( boringWindows, markBoring, clearBoring,
                                     focusUp, focusDown )
import XMonad.Layout.NoBorders ( smartBorders )
import XMonad.Layout.WorkspaceDir ( changeDir, workspaceDir )
import XMonad.Layout.ToggleLayouts ( toggleLayouts, ToggleLayout(ToggleLayout) )
import XMonad.Layout.ShowWName ( showWName )
import XMonad.Layout.Magnifier ( maximizeVertical, MagnifyMsg(Toggle) )

import XMonad.Prompt ( font, height, XPConfig )
import XMonad.Prompt.Layout ( layoutPrompt )
import XMonad.Prompt.Shell ( shellPrompt )

import XMonad.Actions.CopyWindow ( kill1, copy )
import XMonad.Actions.DynamicWorkspaces ( withNthWorkspace, withWorkspace,
                                          selectWorkspace, renameWorkspace, removeWorkspace )
import XMonad.Actions.CycleWS ( moveTo, hiddenWS, emptyWS,
                                Direction1D( Prev, Next), WSType ((:&:), Not) )

import XMonad.Hooks.ManageDocks ( avoidStruts, docks )
import XMonad.Hooks.EwmhDesktops ( ewmh )

myXPConfig :: XPConfig
myXPConfig :: XPConfig
myXPConfig = XPConfig
forall a. Default a => a
def {font="-*-lucida-medium-r-*-*-14-*-*-*-*-*-*-*"
                 ,height=22}


------------------------------------------------------------------------
-- Key bindings:

-- | The xmonad key bindings. Add, modify or remove key bindings here.
--
-- (The comment formatting character is used when generating the manpage)
--
keys :: XConfig Layout -> M.Map (KeyMask, KeySym) (X ())
keys :: XConfig Layout -> Map (KeyMask, KeySym) (X ())
keys XConfig Layout
x = [((KeyMask, KeySym), X ())] -> Map (KeyMask, KeySym) (X ())
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([((KeyMask, KeySym), X ())] -> Map (KeyMask, KeySym) (X ()))
-> [((KeyMask, KeySym), X ())] -> Map (KeyMask, KeySym) (X ())
forall a b. (a -> b) -> a -> b
$
    -- launching and killing programs
    [ ((XConfig Layout -> KeyMask
forall (l :: * -> *). XConfig l -> KeyMask
modMask XConfig Layout
x KeyMask -> KeyMask -> KeyMask
forall a. Bits a => a -> a -> a
.|. KeyMask
shiftMask, KeySym
xK_c     ), X ()
kill1) -- %! Close the focused window

    , ((XConfig Layout -> KeyMask
forall (l :: * -> *). XConfig l -> KeyMask
modMask XConfig Layout
x KeyMask -> KeyMask -> KeyMask
forall a. Bits a => a -> a -> a
.|. KeyMask
shiftMask, KeySym
xK_space ), ChangeLayout -> X ()
forall a. Message a => a -> X ()
sendMessage ChangeLayout
NextLayout) -- %! Rotate through the available layout algorithms
    , ((XConfig Layout -> KeyMask
forall (l :: * -> *). XConfig l -> KeyMask
modMask XConfig Layout
x KeyMask -> KeyMask -> KeyMask
forall a. Bits a => a -> a -> a
.|. KeyMask
controlMask KeyMask -> KeyMask -> KeyMask
forall a. Bits a => a -> a -> a
.|. KeyMask
shiftMask, KeySym
xK_L ), Layout KeySym -> X ()
setLayout (Layout KeySym -> X ()) -> Layout KeySym -> X ()
forall a b. (a -> b) -> a -> b
$ XConfig Layout -> Layout KeySym
forall (l :: * -> *). XConfig l -> l KeySym
layoutHook XConfig Layout
x) -- %!  Reset the layouts on the current workspace to default

    -- move focus up or down the window stack
    , ((XConfig Layout -> KeyMask
forall (l :: * -> *). XConfig l -> KeyMask
modMask XConfig Layout
x,               KeySym
xK_Tab   ), X ()
focusDown) -- %! Move focus to the next window
    , ((XConfig Layout -> KeyMask
forall (l :: * -> *). XConfig l -> KeyMask
modMask XConfig Layout
x,               KeySym
xK_j     ), X ()
focusDown) -- %! Move focus to the next window
    , ((XConfig Layout -> KeyMask
forall (l :: * -> *). XConfig l -> KeyMask
modMask XConfig Layout
x,               KeySym
xK_k     ), X ()
focusUp  ) -- %! Move focus to the previous window

    , ((XConfig Layout -> KeyMask
forall (l :: * -> *). XConfig l -> KeyMask
modMask XConfig Layout
x KeyMask -> KeyMask -> KeyMask
forall a. Bits a => a -> a -> a
.|. KeyMask
shiftMask, KeySym
xK_j     ), (WindowSet -> WindowSet) -> X ()
windows WindowSet -> WindowSet
forall i l a s sd. StackSet i l a s sd -> StackSet i l a s sd
W.swapDown  ) -- %! Swap the focused window with the next window
    , ((XConfig Layout -> KeyMask
forall (l :: * -> *). XConfig l -> KeyMask
modMask XConfig Layout
x KeyMask -> KeyMask -> KeyMask
forall a. Bits a => a -> a -> a
.|. KeyMask
shiftMask, KeySym
xK_k     ), (WindowSet -> WindowSet) -> X ()
windows WindowSet -> WindowSet
forall i l a s sd. StackSet i l a s sd -> StackSet i l a s sd
W.swapUp    ) -- %! Swap the focused window with the previous window

    -- floating layer support
    , ((XConfig Layout -> KeyMask
forall (l :: * -> *). XConfig l -> KeyMask
modMask XConfig Layout
x,               KeySym
xK_t     ), (KeySym -> X ()) -> X ()
withFocused ((KeySym -> X ()) -> X ()) -> (KeySym -> X ()) -> X ()
forall a b. (a -> b) -> a -> b
$ (WindowSet -> WindowSet) -> X ()
windows ((WindowSet -> WindowSet) -> X ())
-> (KeySym -> WindowSet -> WindowSet) -> KeySym -> X ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KeySym -> WindowSet -> WindowSet
forall a i l s sd.
Ord a =>
a -> StackSet i l a s sd -> StackSet i l a s sd
W.sink) -- %! Push window back into tiling

    -- quit, or restart
    , ((XConfig Layout -> KeyMask
forall (l :: * -> *). XConfig l -> KeyMask
modMask XConfig Layout
x KeyMask -> KeyMask -> KeyMask
forall a. Bits a => a -> a -> a
.|. KeyMask
shiftMask, KeySym
xK_Escape), IO () -> X ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io IO ()
forall a. IO a
exitSuccess) -- %! Quit xmonad
    , ((XConfig Layout -> KeyMask
forall (l :: * -> *). XConfig l -> KeyMask
modMask XConfig Layout
x              , KeySym
xK_Escape), [Char] -> Bool -> X ()
restart [Char]
"xmonad" Bool
True) -- %! Restart xmonad

    , ((XConfig Layout -> KeyMask
forall (l :: * -> *). XConfig l -> KeyMask
modMask XConfig Layout
x KeyMask -> KeyMask -> KeyMask
forall a. Bits a => a -> a -> a
.|. KeyMask
shiftMask, KeySym
xK_Right), Direction1D -> WSType -> X ()
moveTo Direction1D
Next (WSType -> X ()) -> WSType -> X ()
forall a b. (a -> b) -> a -> b
$ WSType
hiddenWS WSType -> WSType -> WSType
:&: WSType -> WSType
Not WSType
emptyWS)
    , ((XConfig Layout -> KeyMask
forall (l :: * -> *). XConfig l -> KeyMask
modMask XConfig Layout
x KeyMask -> KeyMask -> KeyMask
forall a. Bits a => a -> a -> a
.|. KeyMask
shiftMask, KeySym
xK_Left), Direction1D -> WSType -> X ()
moveTo Direction1D
Prev (WSType -> X ()) -> WSType -> X ()
forall a b. (a -> b) -> a -> b
$ WSType
hiddenWS WSType -> WSType -> WSType
:&: WSType -> WSType
Not WSType
emptyWS)
    , ((XConfig Layout -> KeyMask
forall (l :: * -> *). XConfig l -> KeyMask
modMask XConfig Layout
x, KeySym
xK_Right), Navigate -> X ()
forall a. Message a => a -> X ()
sendMessage (Navigate -> X ()) -> Navigate -> X ()
forall a b. (a -> b) -> a -> b
$ Direction2D -> Navigate
Go Direction2D
R)
    , ((XConfig Layout -> KeyMask
forall (l :: * -> *). XConfig l -> KeyMask
modMask XConfig Layout
x, KeySym
xK_Left), Navigate -> X ()
forall a. Message a => a -> X ()
sendMessage (Navigate -> X ()) -> Navigate -> X ()
forall a b. (a -> b) -> a -> b
$ Direction2D -> Navigate
Go Direction2D
L)
    , ((XConfig Layout -> KeyMask
forall (l :: * -> *). XConfig l -> KeyMask
modMask XConfig Layout
x, KeySym
xK_Up), Navigate -> X ()
forall a. Message a => a -> X ()
sendMessage (Navigate -> X ()) -> Navigate -> X ()
forall a b. (a -> b) -> a -> b
$ Direction2D -> Navigate
Go Direction2D
U)
    , ((XConfig Layout -> KeyMask
forall (l :: * -> *). XConfig l -> KeyMask
modMask XConfig Layout
x, KeySym
xK_Down), Navigate -> X ()
forall a. Message a => a -> X ()
sendMessage (Navigate -> X ()) -> Navigate -> X ()
forall a b. (a -> b) -> a -> b
$ Direction2D -> Navigate
Go Direction2D
D)
    , ((XConfig Layout -> KeyMask
forall (l :: * -> *). XConfig l -> KeyMask
modMask XConfig Layout
x KeyMask -> KeyMask -> KeyMask
forall a. Bits a => a -> a -> a
.|. KeyMask
controlMask, KeySym
xK_Right), Navigate -> X ()
forall a. Message a => a -> X ()
sendMessage (Navigate -> X ()) -> Navigate -> X ()
forall a b. (a -> b) -> a -> b
$ Direction2D -> Navigate
Swap Direction2D
R)
    , ((XConfig Layout -> KeyMask
forall (l :: * -> *). XConfig l -> KeyMask
modMask XConfig Layout
x KeyMask -> KeyMask -> KeyMask
forall a. Bits a => a -> a -> a
.|. KeyMask
controlMask, KeySym
xK_Left), Navigate -> X ()
forall a. Message a => a -> X ()
sendMessage (Navigate -> X ()) -> Navigate -> X ()
forall a b. (a -> b) -> a -> b
$ Direction2D -> Navigate
Swap Direction2D
L)
    , ((XConfig Layout -> KeyMask
forall (l :: * -> *). XConfig l -> KeyMask
modMask XConfig Layout
x KeyMask -> KeyMask -> KeyMask
forall a. Bits a => a -> a -> a
.|. KeyMask
controlMask, KeySym
xK_Up), Navigate -> X ()
forall a. Message a => a -> X ()
sendMessage (Navigate -> X ()) -> Navigate -> X ()
forall a b. (a -> b) -> a -> b
$ Direction2D -> Navigate
Swap Direction2D
U)
    , ((XConfig Layout -> KeyMask
forall (l :: * -> *). XConfig l -> KeyMask
modMask XConfig Layout
x KeyMask -> KeyMask -> KeyMask
forall a. Bits a => a -> a -> a
.|. KeyMask
controlMask, KeySym
xK_Down), Navigate -> X ()
forall a. Message a => a -> X ()
sendMessage (Navigate -> X ()) -> Navigate -> X ()
forall a b. (a -> b) -> a -> b
$ Direction2D -> Navigate
Swap Direction2D
D)
    , ((XConfig Layout -> KeyMask
forall (l :: * -> *). XConfig l -> KeyMask
modMask XConfig Layout
x KeyMask -> KeyMask -> KeyMask
forall a. Bits a => a -> a -> a
.|. KeyMask
controlMask KeyMask -> KeyMask -> KeyMask
forall a. Bits a => a -> a -> a
.|. KeyMask
shiftMask, KeySym
xK_Right), Navigate -> X ()
forall a. Message a => a -> X ()
sendMessage (Navigate -> X ()) -> Navigate -> X ()
forall a b. (a -> b) -> a -> b
$ Direction2D -> Navigate
Move Direction2D
R)
    , ((XConfig Layout -> KeyMask
forall (l :: * -> *). XConfig l -> KeyMask
modMask XConfig Layout
x KeyMask -> KeyMask -> KeyMask
forall a. Bits a => a -> a -> a
.|. KeyMask
controlMask KeyMask -> KeyMask -> KeyMask
forall a. Bits a => a -> a -> a
.|. KeyMask
shiftMask, KeySym
xK_Left), Navigate -> X ()
forall a. Message a => a -> X ()
sendMessage (Navigate -> X ()) -> Navigate -> X ()
forall a b. (a -> b) -> a -> b
$ Direction2D -> Navigate
Move Direction2D
L)
    , ((XConfig Layout -> KeyMask
forall (l :: * -> *). XConfig l -> KeyMask
modMask XConfig Layout
x KeyMask -> KeyMask -> KeyMask
forall a. Bits a => a -> a -> a
.|. KeyMask
controlMask KeyMask -> KeyMask -> KeyMask
forall a. Bits a => a -> a -> a
.|. KeyMask
shiftMask, KeySym
xK_Up), Navigate -> X ()
forall a. Message a => a -> X ()
sendMessage (Navigate -> X ()) -> Navigate -> X ()
forall a b. (a -> b) -> a -> b
$ Direction2D -> Navigate
Move Direction2D
U)
    , ((XConfig Layout -> KeyMask
forall (l :: * -> *). XConfig l -> KeyMask
modMask XConfig Layout
x KeyMask -> KeyMask -> KeyMask
forall a. Bits a => a -> a -> a
.|. KeyMask
controlMask KeyMask -> KeyMask -> KeyMask
forall a. Bits a => a -> a -> a
.|. KeyMask
shiftMask, KeySym
xK_Down), Navigate -> X ()
forall a. Message a => a -> X ()
sendMessage (Navigate -> X ()) -> Navigate -> X ()
forall a b. (a -> b) -> a -> b
$ Direction2D -> Navigate
Move Direction2D
D)

    , ((KeyMask
0, KeySym
xK_F2  ), [Char] -> X ()
forall (m :: * -> *). MonadIO m => [Char] -> m ()
spawn [Char]
"gnome-terminal") -- %! Launch gnome-terminal
    , ((KeyMask
0, KeySym
xK_F3  ), XPConfig -> X ()
shellPrompt XPConfig
myXPConfig) -- %! Launch program
    , ((KeyMask
0, KeySym
xK_F11   ), [Char] -> X ()
forall (m :: * -> *). MonadIO m => [Char] -> m ()
spawn [Char]
"ksnapshot") -- %! Take snapshot
    , ((XConfig Layout -> KeyMask
forall (l :: * -> *). XConfig l -> KeyMask
modMask XConfig Layout
x KeyMask -> KeyMask -> KeyMask
forall a. Bits a => a -> a -> a
.|. KeyMask
shiftMask, KeySym
xK_b     ), X ()
markBoring)
    , ((KeyMask
controlMask KeyMask -> KeyMask -> KeyMask
forall a. Bits a => a -> a -> a
.|. XConfig Layout -> KeyMask
forall (l :: * -> *). XConfig l -> KeyMask
modMask XConfig Layout
x KeyMask -> KeyMask -> KeyMask
forall a. Bits a => a -> a -> a
.|. KeyMask
shiftMask, KeySym
xK_b     ), X ()
clearBoring)
    , ((XConfig Layout -> KeyMask
forall (l :: * -> *). XConfig l -> KeyMask
modMask XConfig Layout
x KeyMask -> KeyMask -> KeyMask
forall a. Bits a => a -> a -> a
.|. KeyMask
shiftMask, KeySym
xK_x     ), XPConfig -> X ()
changeDir XPConfig
myXPConfig)
    , ((XConfig Layout -> KeyMask
forall (l :: * -> *). XConfig l -> KeyMask
modMask XConfig Layout
x KeyMask -> KeyMask -> KeyMask
forall a. Bits a => a -> a -> a
.|. KeyMask
shiftMask, KeySym
xK_BackSpace), X ()
removeWorkspace)
    , ((XConfig Layout -> KeyMask
forall (l :: * -> *). XConfig l -> KeyMask
modMask XConfig Layout
x KeyMask -> KeyMask -> KeyMask
forall a. Bits a => a -> a -> a
.|. KeyMask
shiftMask, KeySym
xK_v     ), XPConfig -> X ()
selectWorkspace XPConfig
myXPConfig)
    , ((XConfig Layout -> KeyMask
forall (l :: * -> *). XConfig l -> KeyMask
modMask XConfig Layout
x, KeySym
xK_m     ), XPConfig -> ([Char] -> X ()) -> X ()
withWorkspace XPConfig
myXPConfig ((WindowSet -> WindowSet) -> X ()
windows ((WindowSet -> WindowSet) -> X ())
-> ([Char] -> WindowSet -> WindowSet) -> [Char] -> X ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> WindowSet -> WindowSet
forall a s i l sd.
(Ord a, Eq s, Eq i) =>
i -> StackSet i l a s sd -> StackSet i l a s sd
W.shift))
    , ((XConfig Layout -> KeyMask
forall (l :: * -> *). XConfig l -> KeyMask
modMask XConfig Layout
x KeyMask -> KeyMask -> KeyMask
forall a. Bits a => a -> a -> a
.|. KeyMask
shiftMask, KeySym
xK_m     ), XPConfig -> ([Char] -> X ()) -> X ()
withWorkspace XPConfig
myXPConfig ((WindowSet -> WindowSet) -> X ()
windows ((WindowSet -> WindowSet) -> X ())
-> ([Char] -> WindowSet -> WindowSet) -> [Char] -> X ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> WindowSet -> WindowSet
forall s i a l sd.
(Eq s, Eq i, Eq a) =>
i -> StackSet i l a s sd -> StackSet i l a s sd
copy))
    , ((XConfig Layout -> KeyMask
forall (l :: * -> *). XConfig l -> KeyMask
modMask XConfig Layout
x KeyMask -> KeyMask -> KeyMask
forall a. Bits a => a -> a -> a
.|. KeyMask
shiftMask, KeySym
xK_r), XPConfig -> X ()
renameWorkspace XPConfig
myXPConfig)
    , ((XConfig Layout -> KeyMask
forall (l :: * -> *). XConfig l -> KeyMask
modMask XConfig Layout
x, KeySym
xK_l ), XPConfig -> X ()
layoutPrompt XPConfig
myXPConfig)
    , ((XConfig Layout -> KeyMask
forall (l :: * -> *). XConfig l -> KeyMask
modMask XConfig Layout
x KeyMask -> KeyMask -> KeyMask
forall a. Bits a => a -> a -> a
.|. KeyMask
controlMask, KeySym
xK_space), ToggleLayout -> X ()
forall a. Message a => a -> X ()
sendMessage ToggleLayout
ToggleLayout)
    , ((XConfig Layout -> KeyMask
forall (l :: * -> *). XConfig l -> KeyMask
modMask XConfig Layout
x, KeySym
xK_space), MagnifyMsg -> X ()
forall a. Message a => a -> X ()
sendMessage MagnifyMsg
Toggle)

    ]

    [((KeyMask, KeySym), X ())]
-> [((KeyMask, KeySym), X ())] -> [((KeyMask, KeySym), X ())]
forall a. [a] -> [a] -> [a]
++
    [(KeyMask, KeySym)] -> [X ()] -> [((KeyMask, KeySym), X ())]
forall a b. [a] -> [b] -> [(a, b)]
zip ((KeySym -> (KeyMask, KeySym)) -> [KeySym] -> [(KeyMask, KeySym)]
forall a b. (a -> b) -> [a] -> [b]
map (XConfig Layout -> KeyMask
forall (l :: * -> *). XConfig l -> KeyMask
modMask XConfig Layout
x,) [KeySym
xK_F1..KeySym
xK_F12]) ((Int -> X ()) -> [Int] -> [X ()]
forall a b. (a -> b) -> [a] -> [b]
map (([Char] -> WindowSet -> WindowSet) -> Int -> X ()
withNthWorkspace [Char] -> WindowSet -> WindowSet
forall s i l a sd.
(Eq s, Eq i) =>
i -> StackSet i l a s sd -> StackSet i l a s sd
W.greedyView) [Int
0..])
    [((KeyMask, KeySym), X ())]
-> [((KeyMask, KeySym), X ())] -> [((KeyMask, KeySym), X ())]
forall a. [a] -> [a] -> [a]
++
    [(KeyMask, KeySym)] -> [X ()] -> [((KeyMask, KeySym), X ())]
forall a b. [a] -> [b] -> [(a, b)]
zip ((KeySym -> (KeyMask, KeySym)) -> [KeySym] -> [(KeyMask, KeySym)]
forall a b. (a -> b) -> [a] -> [b]
map (XConfig Layout -> KeyMask
forall (l :: * -> *). XConfig l -> KeyMask
modMask XConfig Layout
x KeyMask -> KeyMask -> KeyMask
forall a. Bits a => a -> a -> a
.|. KeyMask
shiftMask,) [KeySym
xK_F1..KeySym
xK_F12]) ((Int -> X ()) -> [Int] -> [X ()]
forall a b. (a -> b) -> [a] -> [b]
map (([Char] -> WindowSet -> WindowSet) -> Int -> X ()
withNthWorkspace [Char] -> WindowSet -> WindowSet
forall s i a l sd.
(Eq s, Eq i, Eq a) =>
i -> StackSet i l a s sd -> StackSet i l a s sd
copy) [Int
0..])

config :: XConfig
  (ModifiedLayout
     ShowWName
     (ModifiedLayout
        WorkspaceDir
        (ModifiedLayout
           BoringWindows
           (ModifiedLayout
              SmartBorder
              (ModifiedLayout
                 WindowNavigation
                 (ModifiedLayout
                    Magnifier
                    (ToggleLayouts
                       Full
                       (ModifiedLayout
                          AvoidStruts
                          (Choose
                             (ModifiedLayout
                                Rename
                                (ModifiedLayout
                                   (Decoration TabbedDecoration CustomShrink) Simplest))
                             (Choose
                                (ModifiedLayout
                                   Rename
                                   (CombineTwo
                                      (DragPane ())
                                      (ModifiedLayout
                                         (Decoration TabbedDecoration CustomShrink) Simplest)
                                      (CombineTwo
                                         (Square ())
                                         (ModifiedLayout
                                            (Decoration TabbedDecoration CustomShrink) Simplest)
                                         (ModifiedLayout
                                            (Decoration TabbedDecoration CustomShrink) Simplest))))
                                (Choose
                                   (ModifiedLayout
                                      Rename
                                      (CombineTwo
                                         (DragPane ())
                                         (ModifiedLayout
                                            (Decoration TabbedDecoration CustomShrink) Simplest)
                                         (CombineTwo
                                            (DragPane ())
                                            (ModifiedLayout
                                               (Decoration TabbedDecoration CustomShrink) Simplest)
                                            (CombineTwo
                                               (Square ())
                                               (ModifiedLayout
                                                  (Decoration TabbedDecoration CustomShrink)
                                                  Simplest)
                                               (ModifiedLayout
                                                  (Decoration TabbedDecoration CustomShrink)
                                                  Simplest)))))
                                   (ModifiedLayout
                                      Rename
                                      (CombineTwo
                                         (DragPane ())
                                         (CombineTwo
                                            (DragPane ())
                                            (ModifiedLayout
                                               (Decoration TabbedDecoration CustomShrink) Simplest)
                                            (ModifiedLayout
                                               (Decoration TabbedDecoration CustomShrink) Simplest))
                                         (CombineTwo
                                            (Square ())
                                            (ModifiedLayout
                                               (Decoration TabbedDecoration CustomShrink) Simplest)
                                            (ModifiedLayout
                                               (Decoration TabbedDecoration CustomShrink)
                                               Simplest)))))))))))))))
config = XConfig
  (ModifiedLayout
     ShowWName
     (ModifiedLayout
        WorkspaceDir
        (ModifiedLayout
           BoringWindows
           (ModifiedLayout
              SmartBorder
              (ModifiedLayout
                 WindowNavigation
                 (ModifiedLayout
                    Magnifier
                    (ToggleLayouts
                       Full
                       (ModifiedLayout
                          AvoidStruts
                          (Choose
                             (ModifiedLayout
                                Rename
                                (ModifiedLayout
                                   (Decoration TabbedDecoration CustomShrink) Simplest))
                             (Choose
                                (ModifiedLayout
                                   Rename
                                   (CombineTwo
                                      (DragPane ())
                                      (ModifiedLayout
                                         (Decoration TabbedDecoration CustomShrink) Simplest)
                                      (CombineTwo
                                         (Square ())
                                         (ModifiedLayout
                                            (Decoration TabbedDecoration CustomShrink) Simplest)
                                         (ModifiedLayout
                                            (Decoration TabbedDecoration CustomShrink) Simplest))))
                                (Choose
                                   (ModifiedLayout
                                      Rename
                                      (CombineTwo
                                         (DragPane ())
                                         (ModifiedLayout
                                            (Decoration TabbedDecoration CustomShrink) Simplest)
                                         (CombineTwo
                                            (DragPane ())
                                            (ModifiedLayout
                                               (Decoration TabbedDecoration CustomShrink) Simplest)
                                            (CombineTwo
                                               (Square ())
                                               (ModifiedLayout
                                                  (Decoration TabbedDecoration CustomShrink)
                                                  Simplest)
                                               (ModifiedLayout
                                                  (Decoration TabbedDecoration CustomShrink)
                                                  Simplest)))))
                                   (ModifiedLayout
                                      Rename
                                      (CombineTwo
                                         (DragPane ())
                                         (CombineTwo
                                            (DragPane ())
                                            (ModifiedLayout
                                               (Decoration TabbedDecoration CustomShrink) Simplest)
                                            (ModifiedLayout
                                               (Decoration TabbedDecoration CustomShrink) Simplest))
                                         (CombineTwo
                                            (Square ())
                                            (ModifiedLayout
                                               (Decoration TabbedDecoration CustomShrink) Simplest)
                                            (ModifiedLayout
                                               (Decoration TabbedDecoration CustomShrink)
                                               Simplest)))))))))))))))
-> XConfig
     (ModifiedLayout
        ShowWName
        (ModifiedLayout
           WorkspaceDir
           (ModifiedLayout
              BoringWindows
              (ModifiedLayout
                 SmartBorder
                 (ModifiedLayout
                    WindowNavigation
                    (ModifiedLayout
                       Magnifier
                       (ToggleLayouts
                          Full
                          (ModifiedLayout
                             AvoidStruts
                             (Choose
                                (ModifiedLayout
                                   Rename
                                   (ModifiedLayout
                                      (Decoration TabbedDecoration CustomShrink) Simplest))
                                (Choose
                                   (ModifiedLayout
                                      Rename
                                      (CombineTwo
                                         (DragPane ())
                                         (ModifiedLayout
                                            (Decoration TabbedDecoration CustomShrink) Simplest)
                                         (CombineTwo
                                            (Square ())
                                            (ModifiedLayout
                                               (Decoration TabbedDecoration CustomShrink) Simplest)
                                            (ModifiedLayout
                                               (Decoration TabbedDecoration CustomShrink)
                                               Simplest))))
                                   (Choose
                                      (ModifiedLayout
                                         Rename
                                         (CombineTwo
                                            (DragPane ())
                                            (ModifiedLayout
                                               (Decoration TabbedDecoration CustomShrink) Simplest)
                                            (CombineTwo
                                               (DragPane ())
                                               (ModifiedLayout
                                                  (Decoration TabbedDecoration CustomShrink)
                                                  Simplest)
                                               (CombineTwo
                                                  (Square ())
                                                  (ModifiedLayout
                                                     (Decoration TabbedDecoration CustomShrink)
                                                     Simplest)
                                                  (ModifiedLayout
                                                     (Decoration TabbedDecoration CustomShrink)
                                                     Simplest)))))
                                      (ModifiedLayout
                                         Rename
                                         (CombineTwo
                                            (DragPane ())
                                            (CombineTwo
                                               (DragPane ())
                                               (ModifiedLayout
                                                  (Decoration TabbedDecoration CustomShrink)
                                                  Simplest)
                                               (ModifiedLayout
                                                  (Decoration TabbedDecoration CustomShrink)
                                                  Simplest))
                                            (CombineTwo
                                               (Square ())
                                               (ModifiedLayout
                                                  (Decoration TabbedDecoration CustomShrink)
                                                  Simplest)
                                               (ModifiedLayout
                                                  (Decoration TabbedDecoration CustomShrink)
                                                  Simplest)))))))))))))))
forall (a :: * -> *). XConfig a -> XConfig a
docks (XConfig
   (ModifiedLayout
      ShowWName
      (ModifiedLayout
         WorkspaceDir
         (ModifiedLayout
            BoringWindows
            (ModifiedLayout
               SmartBorder
               (ModifiedLayout
                  WindowNavigation
                  (ModifiedLayout
                     Magnifier
                     (ToggleLayouts
                        Full
                        (ModifiedLayout
                           AvoidStruts
                           (Choose
                              (ModifiedLayout
                                 Rename
                                 (ModifiedLayout
                                    (Decoration TabbedDecoration CustomShrink) Simplest))
                              (Choose
                                 (ModifiedLayout
                                    Rename
                                    (CombineTwo
                                       (DragPane ())
                                       (ModifiedLayout
                                          (Decoration TabbedDecoration CustomShrink) Simplest)
                                       (CombineTwo
                                          (Square ())
                                          (ModifiedLayout
                                             (Decoration TabbedDecoration CustomShrink) Simplest)
                                          (ModifiedLayout
                                             (Decoration TabbedDecoration CustomShrink) Simplest))))
                                 (Choose
                                    (ModifiedLayout
                                       Rename
                                       (CombineTwo
                                          (DragPane ())
                                          (ModifiedLayout
                                             (Decoration TabbedDecoration CustomShrink) Simplest)
                                          (CombineTwo
                                             (DragPane ())
                                             (ModifiedLayout
                                                (Decoration TabbedDecoration CustomShrink) Simplest)
                                             (CombineTwo
                                                (Square ())
                                                (ModifiedLayout
                                                   (Decoration TabbedDecoration CustomShrink)
                                                   Simplest)
                                                (ModifiedLayout
                                                   (Decoration TabbedDecoration CustomShrink)
                                                   Simplest)))))
                                    (ModifiedLayout
                                       Rename
                                       (CombineTwo
                                          (DragPane ())
                                          (CombineTwo
                                             (DragPane ())
                                             (ModifiedLayout
                                                (Decoration TabbedDecoration CustomShrink) Simplest)
                                             (ModifiedLayout
                                                (Decoration TabbedDecoration CustomShrink)
                                                Simplest))
                                          (CombineTwo
                                             (Square ())
                                             (ModifiedLayout
                                                (Decoration TabbedDecoration CustomShrink) Simplest)
                                             (ModifiedLayout
                                                (Decoration TabbedDecoration CustomShrink)
                                                Simplest)))))))))))))))
 -> XConfig
      (ModifiedLayout
         ShowWName
         (ModifiedLayout
            WorkspaceDir
            (ModifiedLayout
               BoringWindows
               (ModifiedLayout
                  SmartBorder
                  (ModifiedLayout
                     WindowNavigation
                     (ModifiedLayout
                        Magnifier
                        (ToggleLayouts
                           Full
                           (ModifiedLayout
                              AvoidStruts
                              (Choose
                                 (ModifiedLayout
                                    Rename
                                    (ModifiedLayout
                                       (Decoration TabbedDecoration CustomShrink) Simplest))
                                 (Choose
                                    (ModifiedLayout
                                       Rename
                                       (CombineTwo
                                          (DragPane ())
                                          (ModifiedLayout
                                             (Decoration TabbedDecoration CustomShrink) Simplest)
                                          (CombineTwo
                                             (Square ())
                                             (ModifiedLayout
                                                (Decoration TabbedDecoration CustomShrink) Simplest)
                                             (ModifiedLayout
                                                (Decoration TabbedDecoration CustomShrink)
                                                Simplest))))
                                    (Choose
                                       (ModifiedLayout
                                          Rename
                                          (CombineTwo
                                             (DragPane ())
                                             (ModifiedLayout
                                                (Decoration TabbedDecoration CustomShrink) Simplest)
                                             (CombineTwo
                                                (DragPane ())
                                                (ModifiedLayout
                                                   (Decoration TabbedDecoration CustomShrink)
                                                   Simplest)
                                                (CombineTwo
                                                   (Square ())
                                                   (ModifiedLayout
                                                      (Decoration TabbedDecoration CustomShrink)
                                                      Simplest)
                                                   (ModifiedLayout
                                                      (Decoration TabbedDecoration CustomShrink)
                                                      Simplest)))))
                                       (ModifiedLayout
                                          Rename
                                          (CombineTwo
                                             (DragPane ())
                                             (CombineTwo
                                                (DragPane ())
                                                (ModifiedLayout
                                                   (Decoration TabbedDecoration CustomShrink)
                                                   Simplest)
                                                (ModifiedLayout
                                                   (Decoration TabbedDecoration CustomShrink)
                                                   Simplest))
                                             (CombineTwo
                                                (Square ())
                                                (ModifiedLayout
                                                   (Decoration TabbedDecoration CustomShrink)
                                                   Simplest)
                                                (ModifiedLayout
                                                   (Decoration TabbedDecoration CustomShrink)
                                                   Simplest))))))))))))))))
-> XConfig
     (ModifiedLayout
        ShowWName
        (ModifiedLayout
           WorkspaceDir
           (ModifiedLayout
              BoringWindows
              (ModifiedLayout
                 SmartBorder
                 (ModifiedLayout
                    WindowNavigation
                    (ModifiedLayout
                       Magnifier
                       (ToggleLayouts
                          Full
                          (ModifiedLayout
                             AvoidStruts
                             (Choose
                                (ModifiedLayout
                                   Rename
                                   (ModifiedLayout
                                      (Decoration TabbedDecoration CustomShrink) Simplest))
                                (Choose
                                   (ModifiedLayout
                                      Rename
                                      (CombineTwo
                                         (DragPane ())
                                         (ModifiedLayout
                                            (Decoration TabbedDecoration CustomShrink) Simplest)
                                         (CombineTwo
                                            (Square ())
                                            (ModifiedLayout
                                               (Decoration TabbedDecoration CustomShrink) Simplest)
                                            (ModifiedLayout
                                               (Decoration TabbedDecoration CustomShrink)
                                               Simplest))))
                                   (Choose
                                      (ModifiedLayout
                                         Rename
                                         (CombineTwo
                                            (DragPane ())
                                            (ModifiedLayout
                                               (Decoration TabbedDecoration CustomShrink) Simplest)
                                            (CombineTwo
                                               (DragPane ())
                                               (ModifiedLayout
                                                  (Decoration TabbedDecoration CustomShrink)
                                                  Simplest)
                                               (CombineTwo
                                                  (Square ())
                                                  (ModifiedLayout
                                                     (Decoration TabbedDecoration CustomShrink)
                                                     Simplest)
                                                  (ModifiedLayout
                                                     (Decoration TabbedDecoration CustomShrink)
                                                     Simplest)))))
                                      (ModifiedLayout
                                         Rename
                                         (CombineTwo
                                            (DragPane ())
                                            (CombineTwo
                                               (DragPane ())
                                               (ModifiedLayout
                                                  (Decoration TabbedDecoration CustomShrink)
                                                  Simplest)
                                               (ModifiedLayout
                                                  (Decoration TabbedDecoration CustomShrink)
                                                  Simplest))
                                            (CombineTwo
                                               (Square ())
                                               (ModifiedLayout
                                                  (Decoration TabbedDecoration CustomShrink)
                                                  Simplest)
                                               (ModifiedLayout
                                                  (Decoration TabbedDecoration CustomShrink)
                                                  Simplest)))))))))))))))
-> XConfig
     (ModifiedLayout
        ShowWName
        (ModifiedLayout
           WorkspaceDir
           (ModifiedLayout
              BoringWindows
              (ModifiedLayout
                 SmartBorder
                 (ModifiedLayout
                    WindowNavigation
                    (ModifiedLayout
                       Magnifier
                       (ToggleLayouts
                          Full
                          (ModifiedLayout
                             AvoidStruts
                             (Choose
                                (ModifiedLayout
                                   Rename
                                   (ModifiedLayout
                                      (Decoration TabbedDecoration CustomShrink) Simplest))
                                (Choose
                                   (ModifiedLayout
                                      Rename
                                      (CombineTwo
                                         (DragPane ())
                                         (ModifiedLayout
                                            (Decoration TabbedDecoration CustomShrink) Simplest)
                                         (CombineTwo
                                            (Square ())
                                            (ModifiedLayout
                                               (Decoration TabbedDecoration CustomShrink) Simplest)
                                            (ModifiedLayout
                                               (Decoration TabbedDecoration CustomShrink)
                                               Simplest))))
                                   (Choose
                                      (ModifiedLayout
                                         Rename
                                         (CombineTwo
                                            (DragPane ())
                                            (ModifiedLayout
                                               (Decoration TabbedDecoration CustomShrink) Simplest)
                                            (CombineTwo
                                               (DragPane ())
                                               (ModifiedLayout
                                                  (Decoration TabbedDecoration CustomShrink)
                                                  Simplest)
                                               (CombineTwo
                                                  (Square ())
                                                  (ModifiedLayout
                                                     (Decoration TabbedDecoration CustomShrink)
                                                     Simplest)
                                                  (ModifiedLayout
                                                     (Decoration TabbedDecoration CustomShrink)
                                                     Simplest)))))
                                      (ModifiedLayout
                                         Rename
                                         (CombineTwo
                                            (DragPane ())
                                            (CombineTwo
                                               (DragPane ())
                                               (ModifiedLayout
                                                  (Decoration TabbedDecoration CustomShrink)
                                                  Simplest)
                                               (ModifiedLayout
                                                  (Decoration TabbedDecoration CustomShrink)
                                                  Simplest))
                                            (CombineTwo
                                               (Square ())
                                               (ModifiedLayout
                                                  (Decoration TabbedDecoration CustomShrink)
                                                  Simplest)
                                               (ModifiedLayout
                                                  (Decoration TabbedDecoration CustomShrink)
                                                  Simplest)))))))))))))))
forall a b. (a -> b) -> a -> b
$ XConfig
  (ModifiedLayout
     ShowWName
     (ModifiedLayout
        WorkspaceDir
        (ModifiedLayout
           BoringWindows
           (ModifiedLayout
              SmartBorder
              (ModifiedLayout
                 WindowNavigation
                 (ModifiedLayout
                    Magnifier
                    (ToggleLayouts
                       Full
                       (ModifiedLayout
                          AvoidStruts
                          (Choose
                             (ModifiedLayout
                                Rename
                                (ModifiedLayout
                                   (Decoration TabbedDecoration CustomShrink) Simplest))
                             (Choose
                                (ModifiedLayout
                                   Rename
                                   (CombineTwo
                                      (DragPane ())
                                      (ModifiedLayout
                                         (Decoration TabbedDecoration CustomShrink) Simplest)
                                      (CombineTwo
                                         (Square ())
                                         (ModifiedLayout
                                            (Decoration TabbedDecoration CustomShrink) Simplest)
                                         (ModifiedLayout
                                            (Decoration TabbedDecoration CustomShrink) Simplest))))
                                (Choose
                                   (ModifiedLayout
                                      Rename
                                      (CombineTwo
                                         (DragPane ())
                                         (ModifiedLayout
                                            (Decoration TabbedDecoration CustomShrink) Simplest)
                                         (CombineTwo
                                            (DragPane ())
                                            (ModifiedLayout
                                               (Decoration TabbedDecoration CustomShrink) Simplest)
                                            (CombineTwo
                                               (Square ())
                                               (ModifiedLayout
                                                  (Decoration TabbedDecoration CustomShrink)
                                                  Simplest)
                                               (ModifiedLayout
                                                  (Decoration TabbedDecoration CustomShrink)
                                                  Simplest)))))
                                   (ModifiedLayout
                                      Rename
                                      (CombineTwo
                                         (DragPane ())
                                         (CombineTwo
                                            (DragPane ())
                                            (ModifiedLayout
                                               (Decoration TabbedDecoration CustomShrink) Simplest)
                                            (ModifiedLayout
                                               (Decoration TabbedDecoration CustomShrink) Simplest))
                                         (CombineTwo
                                            (Square ())
                                            (ModifiedLayout
                                               (Decoration TabbedDecoration CustomShrink) Simplest)
                                            (ModifiedLayout
                                               (Decoration TabbedDecoration CustomShrink)
                                               Simplest)))))))))))))))
-> XConfig
     (ModifiedLayout
        ShowWName
        (ModifiedLayout
           WorkspaceDir
           (ModifiedLayout
              BoringWindows
              (ModifiedLayout
                 SmartBorder
                 (ModifiedLayout
                    WindowNavigation
                    (ModifiedLayout
                       Magnifier
                       (ToggleLayouts
                          Full
                          (ModifiedLayout
                             AvoidStruts
                             (Choose
                                (ModifiedLayout
                                   Rename
                                   (ModifiedLayout
                                      (Decoration TabbedDecoration CustomShrink) Simplest))
                                (Choose
                                   (ModifiedLayout
                                      Rename
                                      (CombineTwo
                                         (DragPane ())
                                         (ModifiedLayout
                                            (Decoration TabbedDecoration CustomShrink) Simplest)
                                         (CombineTwo
                                            (Square ())
                                            (ModifiedLayout
                                               (Decoration TabbedDecoration CustomShrink) Simplest)
                                            (ModifiedLayout
                                               (Decoration TabbedDecoration CustomShrink)
                                               Simplest))))
                                   (Choose
                                      (ModifiedLayout
                                         Rename
                                         (CombineTwo
                                            (DragPane ())
                                            (ModifiedLayout
                                               (Decoration TabbedDecoration CustomShrink) Simplest)
                                            (CombineTwo
                                               (DragPane ())
                                               (ModifiedLayout
                                                  (Decoration TabbedDecoration CustomShrink)
                                                  Simplest)
                                               (CombineTwo
                                                  (Square ())
                                                  (ModifiedLayout
                                                     (Decoration TabbedDecoration CustomShrink)
                                                     Simplest)
                                                  (ModifiedLayout
                                                     (Decoration TabbedDecoration CustomShrink)
                                                     Simplest)))))
                                      (ModifiedLayout
                                         Rename
                                         (CombineTwo
                                            (DragPane ())
                                            (CombineTwo
                                               (DragPane ())
                                               (ModifiedLayout
                                                  (Decoration TabbedDecoration CustomShrink)
                                                  Simplest)
                                               (ModifiedLayout
                                                  (Decoration TabbedDecoration CustomShrink)
                                                  Simplest))
                                            (CombineTwo
                                               (Square ())
                                               (ModifiedLayout
                                                  (Decoration TabbedDecoration CustomShrink)
                                                  Simplest)
                                               (ModifiedLayout
                                                  (Decoration TabbedDecoration CustomShrink)
                                                  Simplest)))))))))))))))
forall (a :: * -> *). XConfig a -> XConfig a
ewmh XConfig (Choose Tall (Choose (Mirror Tall) Full))
forall a. Default a => a
def
         { borderWidth = 1 -- Width of the window border in pixels.
         , XMonad.workspaces = ["mutt","iceweasel"]
         , layoutHook = showWName $ workspaceDir "~" $
                        boringWindows $ smartBorders $ windowNavigation $
                        maximizeVertical $ toggleLayouts Full $ avoidStruts $
                        renamed [Replace "tabbed"] mytab |||
                        renamed [Replace "xclock"] (mytab ****//* combineTwo Square mytab mytab) |||
                        renamed [Replace "three"] (mytab **//* mytab *//* combineTwo Square mytab mytab) |||
                        renamed [Replace "widescreen"] ((mytab *||* mytab)
                                                ****//* combineTwo Square mytab mytab) --   |||
                        --mosaic 0.25 0.5
         , terminal = "xterm" -- The preferred terminal program.
         , normalBorderColor = "#222222" -- Border color for unfocused windows.
         , focusedBorderColor = "#00ff00" -- Border color for focused windows.
         , XMonad.modMask = mod1Mask
         , XMonad.keys = keys
         }

mytab :: ModifiedLayout
  (Decoration TabbedDecoration CustomShrink) Simplest KeySym
mytab = CustomShrink
-> Theme
-> ModifiedLayout
     (Decoration TabbedDecoration CustomShrink) Simplest KeySym
forall a s.
(Eq a, Shrinker s) =>
s
-> Theme
-> ModifiedLayout (Decoration TabbedDecoration s) Simplest a
tabbed CustomShrink
CustomShrink Theme
forall a. Default a => a
def

instance Shrinker CustomShrink where
    shrinkIt :: CustomShrink -> [Char] -> [[Char]]
shrinkIt CustomShrink
shr [Char]
s | Just [Char]
s' <- [Char] -> [Char] -> Maybe [Char]
dropFromHead [Char]
" " [Char]
s = CustomShrink -> [Char] -> [[Char]]
forall s. Shrinker s => s -> [Char] -> [[Char]]
shrinkIt CustomShrink
shr [Char]
s'
    shrinkIt CustomShrink
shr [Char]
s | Just [Char]
s' <- [Char] -> [Char] -> Maybe [Char]
dropFromTail [Char]
" " [Char]
s = CustomShrink -> [Char] -> [[Char]]
forall s. Shrinker s => s -> [Char] -> [[Char]]
shrinkIt CustomShrink
shr [Char]
s'
    shrinkIt CustomShrink
shr [Char]
s | Just [Char]
s' <- [Char] -> [Char] -> Maybe [Char]
dropFromTail [Char]
"- Iceweasel" [Char]
s = CustomShrink -> [Char] -> [[Char]]
forall s. Shrinker s => s -> [Char] -> [[Char]]
shrinkIt CustomShrink
shr [Char]
s'
    shrinkIt CustomShrink
shr [Char]
s | Just [Char]
s' <- [Char] -> [Char] -> Maybe [Char]
dropFromTail [Char]
"- KPDF" [Char]
s = CustomShrink -> [Char] -> [[Char]]
forall s. Shrinker s => s -> [Char] -> [[Char]]
shrinkIt CustomShrink
shr [Char]
s'
    shrinkIt CustomShrink
shr [Char]
s | Just [Char]
s' <- [Char] -> [Char] -> Maybe [Char]
dropFromHead [Char]
"file://" [Char]
s = CustomShrink -> [Char] -> [[Char]]
forall s. Shrinker s => s -> [Char] -> [[Char]]
shrinkIt CustomShrink
shr [Char]
s'
    shrinkIt CustomShrink
shr [Char]
s | Just [Char]
s' <- [Char] -> [Char] -> Maybe [Char]
dropFromHead [Char]
"http://" [Char]
s = CustomShrink -> [Char] -> [[Char]]
forall s. Shrinker s => s -> [Char] -> [[Char]]
shrinkIt CustomShrink
shr [Char]
s'
    shrinkIt CustomShrink
_ [Char]
s | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
9 = [Char]
s [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
: (Int -> [Char]) -> [Int] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map Int -> [Char]
cut [Int
2..(Int
halfnInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
3)] [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ DefaultShrinker -> [Char] -> [[Char]]
forall s. Shrinker s => s -> [Char] -> [[Char]]
shrinkIt DefaultShrinker
shrinkText [Char]
s
                 where n :: Int
n = [Char] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char]
s
                       halfn :: Int
halfn = Int
n Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2
                       rs :: [Char]
rs = [Char] -> [Char]
forall a. [a] -> [a]
reverse [Char]
s
                       cut :: Int -> [Char]
cut Int
x = Int -> [Char] -> [Char]
forall a. Int -> [a] -> [a]
take (Int
halfn Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
x) [Char]
s [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"..." [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char] -> [Char]
forall a. [a] -> [a]
reverse (Int -> [Char] -> [Char]
forall a. Int -> [a] -> [a]
take (Int
halfnInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
x) [Char]
rs)
    shrinkIt CustomShrink
_ [Char]
s = DefaultShrinker -> [Char] -> [[Char]]
forall s. Shrinker s => s -> [Char] -> [[Char]]
shrinkIt DefaultShrinker
shrinkText [Char]
s

dropFromTail :: String -> String -> Maybe String
dropFromTail :: [Char] -> [Char] -> Maybe [Char]
dropFromTail [Char]
"" [Char]
_ = Maybe [Char]
forall a. Maybe a
Nothing
dropFromTail [Char]
t [Char]
s | Int -> [Char] -> [Char]
forall a. Int -> [a] -> [a]
drop ([Char] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char]
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- [Char] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char]
t) [Char]
s [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
t = [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just ([Char] -> Maybe [Char]) -> [Char] -> Maybe [Char]
forall a b. (a -> b) -> a -> b
$ Int -> [Char] -> [Char]
forall a. Int -> [a] -> [a]
take ([Char] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char]
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- [Char] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char]
t) [Char]
s
                 | Bool
otherwise = Maybe [Char]
forall a. Maybe a
Nothing

dropFromHead :: String -> String -> Maybe String
dropFromHead :: [Char] -> [Char] -> Maybe [Char]
dropFromHead [Char]
"" [Char]
_ = Maybe [Char]
forall a. Maybe a
Nothing
dropFromHead [Char]
h [Char]
s | Int -> [Char] -> [Char]
forall a. Int -> [a] -> [a]
take ([Char] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char]
h) [Char]
s [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
h = [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just ([Char] -> Maybe [Char]) -> [Char] -> Maybe [Char]
forall a b. (a -> b) -> a -> b
$ Int -> [Char] -> [Char]
forall a. Int -> [a] -> [a]
drop ([Char] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char]
h) [Char]
s
                 | Bool
otherwise = Maybe [Char]
forall a. Maybe a
Nothing

{-
data FocusUrgencyHook = FocusUrgencyHook deriving (Read, Show)

instance UrgencyHook FocusUrgencyHook Window where
    urgencyHook _ w = modify copyAndFocus
        where copyAndFocus s
                  | Just w == W.peek (windowset s) = s
                  | has w $ W.stack $ W.workspace $ W.current $ windowset s =
                      s { windowset = until ((Just w ==) . W.peek)
                                      W.focusUp $ windowset s }
                  | otherwise =
                      let t = W.currentTag $ windowset s
                      in s { windowset = until ((Just w ==) . W.peek)
                             W.focusUp $ copyWindow w t $ windowset s }
              has _ Nothing         = False
              has x (Just (W.Stack t l rr)) = x `elem` (t : l ++ rr)

-}