{-# OPTIONS_GHC -Wno-dodgy-imports #-}
{-# LANGUAGE BangPatterns        #-}
{-# LANGUAGE InstanceSigs        #-}
{-# LANGUAGE LambdaCase          #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies        #-}
--------------------------------------------------------------------
-- |
-- Module      :  XMonad.Prelude
-- Description :  Utility functions and re-exports.
-- Copyright   :  (c) 2021  Tony Zorman
-- License     :  BSD3-style (see LICENSE)
--
-- Maintainer  :  Tony Zorman <soliditsallgood@mailbox.org>
--
-- Utility functions and re-exports for a more ergonomic developing
-- experience.  Users themselves will not find much use here.
--
--------------------------------------------------------------------
module XMonad.Prelude (
    module Exports,
    fi,
    chunksOf,
    (.:),
    (!?),
    NonEmpty((:|)),
    notEmpty,
    safeGetWindowAttributes,
    mkAbsolutePath,
    findM,

    -- * Keys
    keyToString,
    keymaskToString,
    cleanKeyMask,
    regularKeys,
    allSpecialKeys,
    specialKeys,
    multimediaKeys,
    functionKeys,
    WindowScreen,

    -- * Infinite streams
    Stream(..),
    (+~),
    cycleS,
    takeS,
    toList,
    fromList,
) where

import Foreign (alloca, peek)
import XMonad

import Control.Applicative as Exports
import Control.Monad       as Exports
import Data.Bool           as Exports
import Data.Char           as Exports
import Data.Foldable       as Exports hiding (toList)
import Data.Function       as Exports
import Data.Functor        as Exports hiding (unzip)
import Data.List           as Exports hiding ((!?))
import Data.Maybe          as Exports
import Data.Monoid         as Exports
import Data.Traversable    as Exports

import qualified Data.Map.Strict as Map

import Control.Arrow ((&&&), first)
import Control.Exception (SomeException, handle)
import Data.Bifunctor (bimap)
import Data.Bits
import Data.List.NonEmpty (NonEmpty ((:|)))
import Data.Tuple (swap)
import GHC.Exts (IsList(..))
import GHC.Stack
import System.Directory (getHomeDirectory)
import System.Environment (getEnv)
import qualified XMonad.StackSet as W

-- | Short for 'fromIntegral'.
fi :: (Integral a, Num b) => a -> b
fi :: forall a b. (Integral a, Num b) => a -> b
fi = a -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral

-- | Given a maximum length, splits a list into sublists
--
-- >>> chunksOf 5 (take 30 $ repeat 'a')
-- ["aaaaa","aaaaa","aaaaa","aaaaa","aaaaa","aaaaa"]
chunksOf :: Int -> [a] -> [[a]]
chunksOf :: forall a. Int -> [a] -> [[a]]
chunksOf Int
_ [] = []
chunksOf Int
i [a]
xs = [a]
chunk [a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
: Int -> [a] -> [[a]]
forall a. Int -> [a] -> [[a]]
chunksOf Int
i [a]
rest
  where !([a]
chunk, [a]
rest) = Int -> [a] -> ([a], [a])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
i [a]
xs

-- | Safe version of '(!!)'.
(!?) :: [a] -> Int -> Maybe a
!? :: forall a. [a] -> Int -> Maybe a
(!?) [a]
xs Int
n | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = Maybe a
forall a. Maybe a
Nothing
          | Bool
otherwise = [a] -> Maybe a
forall a. [a] -> Maybe a
listToMaybe ([a] -> Maybe a) -> [a] -> Maybe a
forall a b. (a -> b) -> a -> b
$ Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
drop Int
n [a]
xs

-- | Multivariable composition.
--
-- > f .: g ≡ (f .) . g ≡ \c d -> f (g c d)
(.:) :: (a -> b) -> (c -> d -> a) -> c -> d -> b
.: :: forall a b c d. (a -> b) -> (c -> d -> a) -> c -> d -> b
(.:) = ((d -> a) -> d -> b) -> (c -> d -> a) -> c -> d -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
(.) (((d -> a) -> d -> b) -> (c -> d -> a) -> c -> d -> b)
-> ((a -> b) -> (d -> a) -> d -> b)
-> (a -> b)
-> (c -> d -> a)
-> c
-> d
-> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> b) -> (d -> a) -> d -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
(.)

-- | Like 'find', but takes a monadic function instead; retains the
-- short-circuiting behaviour of the non-monadic version.
--
-- For example,
--
-- > findM (\a -> putStr (show a <> " ") >> pure False) [1..10]
--
-- would print "1 2 3 4 5 6 7 8 9 10" and return @Nothing@, while
--
-- > findM (\a -> putStr (show a <> " ") >> pure True) [1..10]
--
-- would print @"1"@ and return @Just 1@.
findM :: Monad m => (a -> m Bool) -> [a] -> m (Maybe a)
findM :: forall (m :: * -> *) a.
Monad m =>
(a -> m Bool) -> [a] -> m (Maybe a)
findM a -> m Bool
p = (a -> m (Maybe a) -> m (Maybe a))
-> m (Maybe a) -> [a] -> m (Maybe a)
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\a
x -> m Bool -> m (Maybe a) -> m (Maybe a) -> m (Maybe a)
forall (m :: * -> *) a. Monad m => m Bool -> m a -> m a -> m a
ifM (a -> m Bool
p a
x) (Maybe a -> m (Maybe a)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe a -> m (Maybe a)) -> Maybe a -> m (Maybe a)
forall a b. (a -> b) -> a -> b
$ a -> Maybe a
forall a. a -> Maybe a
Just a
x)) (Maybe a -> m (Maybe a)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
forall a. Maybe a
Nothing)

-- | 'Data.List.NonEmpty.fromList' with a better error message. Useful to
-- silence GHC's Pattern match(es) are non-exhaustive warning in places where
-- the programmer knows it's always non-empty, but it's infeasible to express
-- that in the type system.
notEmpty :: HasCallStack => [a] -> NonEmpty a
notEmpty :: forall a. HasCallStack => [a] -> NonEmpty a
notEmpty [] = String -> NonEmpty a
forall a. HasCallStack => String -> a
error String
"unexpected empty list"
notEmpty (a
x:[a]
xs) = a
x a -> [a] -> NonEmpty a
forall a. a -> [a] -> NonEmpty a
:| [a]
xs

-- | A safe version of 'Graphics.X11.Xlib.Extras.getWindowAttributes'.
safeGetWindowAttributes :: Window -> X (Maybe WindowAttributes)
safeGetWindowAttributes :: KeySym -> X (Maybe WindowAttributes)
safeGetWindowAttributes KeySym
w = (Display -> X (Maybe WindowAttributes))
-> X (Maybe WindowAttributes)
forall a. (Display -> X a) -> X a
withDisplay ((Display -> X (Maybe WindowAttributes))
 -> X (Maybe WindowAttributes))
-> (Display -> X (Maybe WindowAttributes))
-> X (Maybe WindowAttributes)
forall a b. (a -> b) -> a -> b
$ \Display
dpy -> IO (Maybe WindowAttributes) -> X (Maybe WindowAttributes)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO (Maybe WindowAttributes) -> X (Maybe WindowAttributes))
-> ((Ptr WindowAttributes -> IO (Maybe WindowAttributes))
    -> IO (Maybe WindowAttributes))
-> (Ptr WindowAttributes -> IO (Maybe WindowAttributes))
-> X (Maybe WindowAttributes)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Ptr WindowAttributes -> IO (Maybe WindowAttributes))
-> IO (Maybe WindowAttributes)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr WindowAttributes -> IO (Maybe WindowAttributes))
 -> X (Maybe WindowAttributes))
-> (Ptr WindowAttributes -> IO (Maybe WindowAttributes))
-> X (Maybe WindowAttributes)
forall a b. (a -> b) -> a -> b
$ \Ptr WindowAttributes
p ->
  Display -> KeySym -> Ptr WindowAttributes -> IO Status
xGetWindowAttributes Display
dpy KeySym
w Ptr WindowAttributes
p IO Status
-> (Status -> IO (Maybe WindowAttributes))
-> IO (Maybe WindowAttributes)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Status
0 -> Maybe WindowAttributes -> IO (Maybe WindowAttributes)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe WindowAttributes
forall a. Maybe a
Nothing
    Status
_ -> WindowAttributes -> Maybe WindowAttributes
forall a. a -> Maybe a
Just (WindowAttributes -> Maybe WindowAttributes)
-> IO WindowAttributes -> IO (Maybe WindowAttributes)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr WindowAttributes -> IO WindowAttributes
forall a. Storable a => Ptr a -> IO a
peek Ptr WindowAttributes
p

-- | (Naïvely) turn a relative path into an absolute one.
--
-- * If the path starts with @\/@, do nothing.
--
-- * If it starts with @~\/@, replace that with the actual home
-- * directory.
--
-- * If it starts with @$@, read the name of an environment
-- * variable and replace it with the contents of that.
--
-- * Otherwise, prepend the home directory and @\/@ to the path.
mkAbsolutePath :: MonadIO m => FilePath -> m FilePath
mkAbsolutePath :: forall (m :: * -> *). MonadIO m => String -> m String
mkAbsolutePath String
ps = do
  String
home <- IO String -> m String
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io IO String
getHomeDirectory
  case String
ps of
    Char
'/'       : String
_ -> String -> m String
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure String
ps
    Char
'~' : Char
'/' : String
_ -> String -> m String
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String
home String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
1 String
ps)
    Char
'$'       : String
_ -> let (String
v,String
ps') = (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (Char -> String -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (String
"_"String -> String -> String
forall a. Semigroup a => a -> a -> a
<>[Char
'A'..Char
'Z']String -> String -> String
forall a. Semigroup a => a -> a -> a
<>[Char
'a'..Char
'z']String -> String -> String
forall a. Semigroup a => a -> a -> a
<>[Char
'0'..Char
'9'])) (Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
1 String
ps)
                      in IO String -> m String
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io ((\(SomeException
_ :: SomeException) -> String -> IO String
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure String
"") (SomeException -> IO String) -> IO String -> IO String
forall e a. Exception e => (e -> IO a) -> IO a -> IO a
`handle` String -> IO String
getEnv String
v) m String -> (String -> String) -> m String
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
Exports.<&> (String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
ps')
    String
_             -> String -> m String
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String
home String -> String -> String
forall a. Semigroup a => a -> a -> a
<> (Char
'/' Char -> String -> String
forall a. a -> [a] -> [a]
: String
ps))
{-# SPECIALISE mkAbsolutePath :: FilePath -> IO FilePath #-}
{-# SPECIALISE mkAbsolutePath :: FilePath -> X  FilePath #-}

-----------------------------------------------------------------------
-- Keys

-- | Convert a modifier mask into a useful string.
keymaskToString :: KeyMask -- ^ Num lock mask
                -> KeyMask -- ^ Modifier mask
                -> String
keymaskToString :: KeyMask -> KeyMask -> String
keymaskToString KeyMask
numLockMask KeyMask
msk =
  [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([String] -> String)
-> ([(KeyMask, String)] -> [String])
-> [(KeyMask, String)]
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> [String]
forall a. [a] -> [a]
reverse ([String] -> [String])
-> ([(KeyMask, String)] -> [String])
-> [(KeyMask, String)]
-> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([String], KeyMask) -> [String]
forall a b. (a, b) -> a
fst (([String], KeyMask) -> [String])
-> ([(KeyMask, String)] -> ([String], KeyMask))
-> [(KeyMask, String)]
-> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((KeyMask, String) -> ([String], KeyMask) -> ([String], KeyMask))
-> ([String], KeyMask)
-> [(KeyMask, String)]
-> ([String], KeyMask)
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (KeyMask, String) -> ([String], KeyMask) -> ([String], KeyMask)
go ([], KeyMask
msk) ([(KeyMask, String)] -> String) -> [(KeyMask, String)] -> String
forall a b. (a -> b) -> a -> b
$ [(KeyMask, String)]
masks
 where
  masks :: [(KeyMask, String)]
  masks :: [(KeyMask, String)]
masks = (KeyMask -> (KeyMask, String)) -> [KeyMask] -> [(KeyMask, String)]
forall a b. (a -> b) -> [a] -> [b]
map (\KeyMask
m -> (KeyMask
m, KeyMask -> String
forall a. Show a => a -> String
show KeyMask
m))
              [KeyMask
0 .. Int -> KeyMask
forall a. Enum a => Int -> a
toEnum (KeyMask -> Int
forall b. FiniteBits b => b -> Int
finiteBitSize KeyMask
msk Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)]
       [(KeyMask, String)] -> [(KeyMask, String)] -> [(KeyMask, String)]
forall a. [a] -> [a] -> [a]
++ [ (KeyMask
numLockMask, String
"num-" )
          , (KeyMask
lockMask,    String
"lock-")
          , (KeyMask
controlMask, String
"C-"   )
          , (KeyMask
shiftMask,   String
"S-"   )
          , (KeyMask
mod5Mask,    String
"M5-"  )
          , (KeyMask
mod4Mask,    String
"M4-"  )
          , (KeyMask
mod3Mask,    String
"M3-"  )
          , (KeyMask
mod2Mask,    String
"M2-"  )
          , (KeyMask
mod1Mask,    String
"M1-"  )
          ]

  go :: (KeyMask, String) -> ([String], KeyMask) -> ([String], KeyMask)
  go :: (KeyMask, String) -> ([String], KeyMask) -> ([String], KeyMask)
go (KeyMask
m, String
s) a :: ([String], KeyMask)
a@([String]
ss, KeyMask
v)
    | KeyMask
v KeyMask -> KeyMask -> Bool
forall a. Eq a => a -> a -> Bool
== KeyMask
0       = ([String], KeyMask)
a
    | KeyMask
v KeyMask -> KeyMask -> KeyMask
forall a. Bits a => a -> a -> a
.&. KeyMask
m KeyMask -> KeyMask -> Bool
forall a. Eq a => a -> a -> Bool
== KeyMask
m = (String
s String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
ss, KeyMask
v KeyMask -> KeyMask -> KeyMask
forall a. Bits a => a -> a -> a
.&. KeyMask -> KeyMask
forall a. Bits a => a -> a
complement KeyMask
m)
    | Bool
otherwise    = ([String], KeyMask)
a

-- | Convert a full key combination; i.e., a 'KeyMask' and 'KeySym'
-- pair, into a string.
keyToString :: (KeyMask, KeySym) -> String
keyToString :: (KeyMask, KeySym) -> String
keyToString = (String -> String -> String) -> (String, String) -> String
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry String -> String -> String
forall a. [a] -> [a] -> [a]
(++) ((String, String) -> String)
-> ((KeyMask, KeySym) -> (String, String))
-> (KeyMask, KeySym)
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (KeyMask -> String)
-> (KeySym -> String) -> (KeyMask, KeySym) -> (String, String)
forall a b c d. (a -> b) -> (c -> d) -> (a, c) -> (b, d)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap (KeyMask -> KeyMask -> String
keymaskToString KeyMask
0) KeySym -> String
ppKeysym
 where
  ppKeysym :: KeySym -> String
  ppKeysym :: KeySym -> String
ppKeysym KeySym
x = case Map KeySym String
specialMap Map KeySym String -> KeySym -> Maybe String
forall k a. Ord k => Map k a -> k -> Maybe a
Map.!? KeySym
x of
    Just String
s  -> String
"<" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
s String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
">"
    Maybe String
Nothing -> case Map KeySym String
regularMap Map KeySym String -> KeySym -> Maybe String
forall k a. Ord k => Map k a -> k -> Maybe a
Map.!? KeySym
x of
      Maybe String
Nothing -> KeySym -> String
keysymToString KeySym
x
      Just String
s  -> String
s

  regularMap :: Map KeySym String
regularMap = [(KeySym, String)] -> Map KeySym String
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList (((String, KeySym) -> (KeySym, String))
-> [(String, KeySym)] -> [(KeySym, String)]
forall a b. (a -> b) -> [a] -> [b]
map (String, KeySym) -> (KeySym, String)
forall a b. (a, b) -> (b, a)
swap [(String, KeySym)]
regularKeys)
  specialMap :: Map KeySym String
specialMap = [(KeySym, String)] -> Map KeySym String
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList (((String, KeySym) -> (KeySym, String))
-> [(String, KeySym)] -> [(KeySym, String)]
forall a b. (a -> b) -> [a] -> [b]
map (String, KeySym) -> (KeySym, String)
forall a b. (a, b) -> (b, a)
swap [(String, KeySym)]
allSpecialKeys)

-- | Strip numlock, capslock, mouse buttons and XKB group from a 'KeyMask',
-- leaving only modifier keys like Shift, Control, Super, Hyper in the mask
-- (hence the \"Key\" in \"cleanKeyMask\").
--
-- Core's 'cleanMask' only strips the first two because key events from
-- passive grabs (key bindings) are stripped of mouse buttons and XKB group by
-- the X server already for compatibility reasons. For more info, see:
-- <https://www.x.org/releases/X11R7.7/doc/kbproto/xkbproto.html#Delivering_a_Key_or_Button_Event_to_a_Client>
cleanKeyMask :: X (KeyMask -> KeyMask)
cleanKeyMask :: X (KeyMask -> KeyMask)
cleanKeyMask = KeyMask -> KeyMask -> KeyMask
cleanKeyMask' (KeyMask -> KeyMask -> KeyMask)
-> X KeyMask -> X (KeyMask -> KeyMask)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (XState -> KeyMask) -> X KeyMask
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets XState -> KeyMask
numberlockMask

cleanKeyMask' :: KeyMask -> KeyMask -> KeyMask
cleanKeyMask' :: KeyMask -> KeyMask -> KeyMask
cleanKeyMask' KeyMask
numLockMask KeyMask
mask =
    KeyMask
mask KeyMask -> KeyMask -> KeyMask
forall a. Bits a => a -> a -> a
.&. KeyMask -> KeyMask
forall a. Bits a => a -> a
complement (KeyMask
numLockMask KeyMask -> KeyMask -> KeyMask
forall a. Bits a => a -> a -> a
.|. KeyMask
lockMask) KeyMask -> KeyMask -> KeyMask
forall a. Bits a => a -> a -> a
.&. (KeyMask
button1Mask KeyMask -> KeyMask -> KeyMask
forall a. Num a => a -> a -> a
- KeyMask
1)

-- | A list of "regular" (extended ASCII) keys.
regularKeys :: [(String, KeySym)]
regularKeys :: [(String, KeySym)]
regularKeys = ((Char, KeySym) -> (String, KeySym))
-> [(Char, KeySym)] -> [(String, KeySym)]
forall a b. (a -> b) -> [a] -> [b]
map ((Char -> String) -> (Char, KeySym) -> (String, KeySym)
forall b c d. (b -> c) -> (b, d) -> (c, d)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first (Char -> String -> String
forall a. a -> [a] -> [a]
:[]))
            ([(Char, KeySym)] -> [(String, KeySym)])
-> [(Char, KeySym)] -> [(String, KeySym)]
forall a b. (a -> b) -> a -> b
$ String -> [KeySym] -> [(Char, KeySym)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Char
'!'             .. Char
'~'          ] -- ASCII
                  [KeySym
xK_exclam       .. KeySym
xK_asciitilde]
           [(Char, KeySym)] -> [(Char, KeySym)] -> [(Char, KeySym)]
forall a. Semigroup a => a -> a -> a
<> String -> [KeySym] -> [(Char, KeySym)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Char
'\xa0'          .. Char
'\xff'       ] -- Latin1
                  [KeySym
xK_nobreakspace .. KeySym
xK_ydiaeresis]

-- | A list of all special key names and their associated KeySyms.
allSpecialKeys :: [(String, KeySym)]
allSpecialKeys :: [(String, KeySym)]
allSpecialKeys = [(String, KeySym)]
functionKeys [(String, KeySym)] -> [(String, KeySym)] -> [(String, KeySym)]
forall a. Semigroup a => a -> a -> a
<> [(String, KeySym)]
specialKeys [(String, KeySym)] -> [(String, KeySym)] -> [(String, KeySym)]
forall a. Semigroup a => a -> a -> a
<> [(String, KeySym)]
multimediaKeys

-- | A list pairing function key descriptor strings (e.g. @\"\<F2\>\"@)
-- with the associated KeySyms.
functionKeys :: [(String, KeySym)]
functionKeys :: [(String, KeySym)]
functionKeys = [ (Char
'F' Char -> String -> String
forall a. a -> [a] -> [a]
: Int -> String
forall a. Show a => a -> String
show Int
n, KeySym
k)
               | (Int
n,KeySym
k) <- [Int] -> [KeySym] -> [(Int, KeySym)]
forall a b. [a] -> [b] -> [(a, b)]
zip ([Int
1..Int
24] :: [Int]) [KeySym
xK_F1..]
               ]

-- | A list of special key names and their corresponding KeySyms.
specialKeys :: [(String, KeySym)]
specialKeys :: [(String, KeySym)]
specialKeys =
  [ (String
"Backspace"  , KeySym
xK_BackSpace)
  , (String
"Tab"        , KeySym
xK_Tab)
  , (String
"Return"     , KeySym
xK_Return)
  , (String
"Pause"      , KeySym
xK_Pause)
  , (String
"Num_Lock"   , KeySym
xK_Num_Lock)
  , (String
"Caps_Lock"  , KeySym
xK_Caps_Lock)
  , (String
"Scroll_lock", KeySym
xK_Scroll_Lock)
  , (String
"Sys_Req"    , KeySym
xK_Sys_Req)
  , (String
"Print"      , KeySym
xK_Print)
  , (String
"Escape"     , KeySym
xK_Escape)
  , (String
"Esc"        , KeySym
xK_Escape)
  , (String
"Delete"     , KeySym
xK_Delete)
  , (String
"Home"       , KeySym
xK_Home)
  , (String
"Left"       , KeySym
xK_Left)
  , (String
"Up"         , KeySym
xK_Up)
  , (String
"Right"      , KeySym
xK_Right)
  , (String
"Down"       , KeySym
xK_Down)
  , (String
"L"          , KeySym
xK_Left)
  , (String
"U"          , KeySym
xK_Up)
  , (String
"R"          , KeySym
xK_Right)
  , (String
"D"          , KeySym
xK_Down)
  , (String
"Page_Up"    , KeySym
xK_Page_Up)
  , (String
"Page_Down"  , KeySym
xK_Page_Down)
  , (String
"End"        , KeySym
xK_End)
  , (String
"Insert"     , KeySym
xK_Insert)
  , (String
"Break"      , KeySym
xK_Break)
  , (String
"Space"      , KeySym
xK_space)
  , (String
"Control_L"  , KeySym
xK_Control_L)
  , (String
"Control_R"  , KeySym
xK_Control_R)
  , (String
"Shift_L"    , KeySym
xK_Shift_L)
  , (String
"Shift_R"    , KeySym
xK_Shift_R)
  , (String
"Alt_L"      , KeySym
xK_Alt_L)
  , (String
"Alt_R"      , KeySym
xK_Alt_R)
  , (String
"Meta_L"     , KeySym
xK_Meta_L)
  , (String
"Meta_R"     , KeySym
xK_Meta_R)
  , (String
"Super_L"    , KeySym
xK_Super_L)
  , (String
"Super_R"    , KeySym
xK_Super_R)
  , (String
"Hyper_L"    , KeySym
xK_Hyper_L)
  , (String
"Hyper_R"    , KeySym
xK_Hyper_R)
  , (String
"KP_Space"   , KeySym
xK_KP_Space)
  , (String
"KP_Tab"     , KeySym
xK_KP_Tab)
  , (String
"KP_Enter"   , KeySym
xK_KP_Enter)
  , (String
"KP_F1"      , KeySym
xK_KP_F1)
  , (String
"KP_F2"      , KeySym
xK_KP_F2)
  , (String
"KP_F3"      , KeySym
xK_KP_F3)
  , (String
"KP_F4"      , KeySym
xK_KP_F4)
  , (String
"KP_Home"    , KeySym
xK_KP_Home)
  , (String
"KP_Left"    , KeySym
xK_KP_Left)
  , (String
"KP_Up"      , KeySym
xK_KP_Up)
  , (String
"KP_Right"   , KeySym
xK_KP_Right)
  , (String
"KP_Down"    , KeySym
xK_KP_Down)
  , (String
"KP_Prior"   , KeySym
xK_KP_Prior)
  , (String
"KP_Page_Up" , KeySym
xK_KP_Page_Up)
  , (String
"KP_Next"    , KeySym
xK_KP_Next)
  , (String
"KP_Page_Down", KeySym
xK_KP_Page_Down)
  , (String
"KP_End"     , KeySym
xK_KP_End)
  , (String
"KP_Begin"   , KeySym
xK_KP_Begin)
  , (String
"KP_Insert"  , KeySym
xK_KP_Insert)
  , (String
"KP_Delete"  , KeySym
xK_KP_Delete)
  , (String
"KP_Equal"   , KeySym
xK_KP_Equal)
  , (String
"KP_Multiply", KeySym
xK_KP_Multiply)
  , (String
"KP_Add"     , KeySym
xK_KP_Add)
  , (String
"KP_Separator", KeySym
xK_KP_Separator)
  , (String
"KP_Subtract", KeySym
xK_KP_Subtract)
  , (String
"KP_Decimal" , KeySym
xK_KP_Decimal)
  , (String
"KP_Divide"  , KeySym
xK_KP_Divide)
  , (String
"KP_0"       , KeySym
xK_KP_0)
  , (String
"KP_1"       , KeySym
xK_KP_1)
  , (String
"KP_2"       , KeySym
xK_KP_2)
  , (String
"KP_3"       , KeySym
xK_KP_3)
  , (String
"KP_4"       , KeySym
xK_KP_4)
  , (String
"KP_5"       , KeySym
xK_KP_5)
  , (String
"KP_6"       , KeySym
xK_KP_6)
  , (String
"KP_7"       , KeySym
xK_KP_7)
  , (String
"KP_8"       , KeySym
xK_KP_8)
  , (String
"KP_9"       , KeySym
xK_KP_9)
  ]

-- | List of multimedia keys. If Xlib does not know about some keysym
-- it's omitted from the list ('stringToKeysym' returns 'noSymbol' in
-- this case).
multimediaKeys :: [(String, KeySym)]
multimediaKeys :: [(String, KeySym)]
multimediaKeys = ((String, KeySym) -> Bool)
-> [(String, KeySym)] -> [(String, KeySym)]
forall a. (a -> Bool) -> [a] -> [a]
filter ((KeySym -> KeySym -> Bool
forall a. Eq a => a -> a -> Bool
/= KeySym
noSymbol) (KeySym -> Bool)
-> ((String, KeySym) -> KeySym) -> (String, KeySym) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, KeySym) -> KeySym
forall a b. (a, b) -> b
snd) ([(String, KeySym)] -> [(String, KeySym)])
-> ([String] -> [(String, KeySym)])
-> [String]
-> [(String, KeySym)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> (String, KeySym)) -> [String] -> [(String, KeySym)]
forall a b. (a -> b) -> [a] -> [b]
map (String -> String
forall a. a -> a
id (String -> String)
-> (String -> KeySym) -> String -> (String, KeySym)
forall b c c'. (b -> c) -> (b -> c') -> b -> (c, c')
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& String -> KeySym
stringToKeysym) ([String] -> [(String, KeySym)]) -> [String] -> [(String, KeySym)]
forall a b. (a -> b) -> a -> b
$
  [ String
"XF86ModeLock"
  , String
"XF86MonBrightnessUp"
  , String
"XF86MonBrightnessDown"
  , String
"XF86KbdLightOnOff"
  , String
"XF86KbdBrightnessUp"
  , String
"XF86KbdBrightnessDown"
  , String
"XF86Standby"
  , String
"XF86AudioLowerVolume"
  , String
"XF86AudioMute"
  , String
"XF86AudioRaiseVolume"
  , String
"XF86AudioPlay"
  , String
"XF86AudioStop"
  , String
"XF86AudioPrev"
  , String
"XF86AudioNext"
  , String
"XF86HomePage"
  , String
"XF86Mail"
  , String
"XF86Start"
  , String
"XF86Search"
  , String
"XF86AudioRecord"
  , String
"XF86Calculator"
  , String
"XF86Memo"
  , String
"XF86ToDoList"
  , String
"XF86Calendar"
  , String
"XF86PowerDown"
  , String
"XF86ContrastAdjust"
  , String
"XF86RockerUp"
  , String
"XF86RockerDown"
  , String
"XF86RockerEnter"
  , String
"XF86Back"
  , String
"XF86Forward"
  , String
"XF86Stop"
  , String
"XF86Refresh"
  , String
"XF86PowerOff"
  , String
"XF86WakeUp"
  , String
"XF86Eject"
  , String
"XF86ScreenSaver"
  , String
"XF86WWW"
  , String
"XF86Sleep"
  , String
"XF86Favorites"
  , String
"XF86AudioPause"
  , String
"XF86AudioMedia"
  , String
"XF86MyComputer"
  , String
"XF86VendorHome"
  , String
"XF86LightBulb"
  , String
"XF86Shop"
  , String
"XF86History"
  , String
"XF86OpenURL"
  , String
"XF86AddFavorite"
  , String
"XF86HotLinks"
  , String
"XF86BrightnessAdjust"
  , String
"XF86Finance"
  , String
"XF86Community"
  , String
"XF86AudioRewind"
  , String
"XF86BackForward"
  , String
"XF86Launch0"
  , String
"XF86Launch1"
  , String
"XF86Launch2"
  , String
"XF86Launch3"
  , String
"XF86Launch4"
  , String
"XF86Launch5"
  , String
"XF86Launch6"
  , String
"XF86Launch7"
  , String
"XF86Launch8"
  , String
"XF86Launch9"
  , String
"XF86LaunchA"
  , String
"XF86LaunchB"
  , String
"XF86LaunchC"
  , String
"XF86LaunchD"
  , String
"XF86LaunchE"
  , String
"XF86LaunchF"
  , String
"XF86ApplicationLeft"
  , String
"XF86ApplicationRight"
  , String
"XF86Book"
  , String
"XF86CD"
  , String
"XF86Calculater"
  , String
"XF86Clear"
  , String
"XF86Close"
  , String
"XF86Copy"
  , String
"XF86Cut"
  , String
"XF86Display"
  , String
"XF86DOS"
  , String
"XF86Documents"
  , String
"XF86Excel"
  , String
"XF86Explorer"
  , String
"XF86Game"
  , String
"XF86Go"
  , String
"XF86iTouch"
  , String
"XF86LogOff"
  , String
"XF86Market"
  , String
"XF86Meeting"
  , String
"XF86MenuKB"
  , String
"XF86MenuPB"
  , String
"XF86MySites"
  , String
"XF86New"
  , String
"XF86News"
  , String
"XF86OfficeHome"
  , String
"XF86Open"
  , String
"XF86Option"
  , String
"XF86Paste"
  , String
"XF86Phone"
  , String
"XF86Q"
  , String
"XF86Reply"
  , String
"XF86Reload"
  , String
"XF86RotateWindows"
  , String
"XF86RotationPB"
  , String
"XF86RotationKB"
  , String
"XF86Save"
  , String
"XF86ScrollUp"
  , String
"XF86ScrollDown"
  , String
"XF86ScrollClick"
  , String
"XF86Send"
  , String
"XF86Spell"
  , String
"XF86SplitScreen"
  , String
"XF86Support"
  , String
"XF86TaskPane"
  , String
"XF86Terminal"
  , String
"XF86Tools"
  , String
"XF86Travel"
  , String
"XF86UserPB"
  , String
"XF86User1KB"
  , String
"XF86User2KB"
  , String
"XF86Video"
  , String
"XF86WheelButton"
  , String
"XF86Word"
  , String
"XF86Xfer"
  , String
"XF86ZoomIn"
  , String
"XF86ZoomOut"
  , String
"XF86Away"
  , String
"XF86Messenger"
  , String
"XF86WebCam"
  , String
"XF86MailForward"
  , String
"XF86Pictures"
  , String
"XF86Music"
  , String
"XF86TouchpadToggle"
  , String
"XF86AudioMicMute"
  , String
"XF86_Switch_VT_1"
  , String
"XF86_Switch_VT_2"
  , String
"XF86_Switch_VT_3"
  , String
"XF86_Switch_VT_4"
  , String
"XF86_Switch_VT_5"
  , String
"XF86_Switch_VT_6"
  , String
"XF86_Switch_VT_7"
  , String
"XF86_Switch_VT_8"
  , String
"XF86_Switch_VT_9"
  , String
"XF86_Switch_VT_10"
  , String
"XF86_Switch_VT_11"
  , String
"XF86_Switch_VT_12"
  , String
"XF86_Ungrab"
  , String
"XF86_ClearGrab"
  , String
"XF86_Next_VMode"
  , String
"XF86_Prev_VMode"
  , String
"XF86Bluetooth"
  ]

-- | The specialized 'W.Screen' derived from 'WindowSet'.
type WindowScreen -- FIXME move to core
    = W.Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail

-- | An infinite stream type
data Stream a = !a :~ Stream a
infixr 5 :~

instance Functor Stream where
  fmap :: (a -> b) -> Stream a -> Stream b
  fmap :: forall a b. (a -> b) -> Stream a -> Stream b
fmap a -> b
f = Stream a -> Stream b
go
   where go :: Stream a -> Stream b
go (a
x :~ Stream a
xs) = a -> b
f a
x b -> Stream b -> Stream b
forall a. a -> Stream a -> Stream a
:~ Stream a -> Stream b
go Stream a
xs

instance IsList (Stream a) where
  type (Item (Stream a)) = a

  fromList :: [a] -> Stream a
  fromList :: [a] -> Stream a
fromList (a
x : [a]
xs) = a
x a -> Stream a -> Stream a
forall a. a -> Stream a -> Stream a
:~ [Item (Stream a)] -> Stream a
forall l. IsList l => [Item l] -> l
fromList [a]
[Item (Stream a)]
xs
  fromList []       = String -> Stream a
forall a. String -> a
errorWithoutStackTrace String
"XMonad.Prelude.Stream.fromList: Can't create stream out of finite list."

  toList :: Stream a -> [a]
  toList :: Stream a -> [a]
toList (a
x :~ Stream a
xs) = a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: Stream a -> [Item (Stream a)]
forall l. IsList l => l -> [Item l]
toList Stream a
xs

-- | Absorb a list into an infinite stream.
(+~) :: [a] -> Stream a -> Stream a
[a]
xs +~ :: forall a. [a] -> Stream a -> Stream a
+~ Stream a
s = (a -> Stream a -> Stream a) -> Stream a -> [a] -> Stream a
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr a -> Stream a -> Stream a
forall a. a -> Stream a -> Stream a
(:~) Stream a
s [a]
xs
infixr 5 +~

-- | Absorb a non-empty list into an infinite stream.
cycleS :: NonEmpty a -> Stream a
cycleS :: forall a. NonEmpty a -> Stream a
cycleS (a
x :| [a]
xs) = Stream a
s where s :: Stream a
s = a
x a -> Stream a -> Stream a
forall a. a -> Stream a -> Stream a
:~ [a]
xs [a] -> Stream a -> Stream a
forall a. [a] -> Stream a -> Stream a
+~ Stream a
s

-- | @takeS n stream@ returns the first @n@ elements of @stream@; if @n < 0@,
-- this returns the empty list.
takeS :: Int -> Stream a -> [a]
takeS :: forall a. Int -> Stream a -> [a]
takeS Int
n = Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
take Int
n ([a] -> [a]) -> (Stream a -> [a]) -> Stream a -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stream a -> [a]
Stream a -> [Item (Stream a)]
forall l. IsList l => l -> [Item l]
toList