{-# 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 = 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 forall a. a -> [a] -> [a]
: forall a. Int -> [a] -> [[a]]
chunksOf Int
i [a]
rest
  where !([a]
chunk, [a]
rest) = 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 forall a. Ord a => a -> a -> Bool
< Int
0 = forall a. Maybe a
Nothing
          | Bool
otherwise = forall a. [a] -> Maybe a
listToMaybe forall a b. (a -> b) -> a -> b
$ 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
(.:) = forall b c a. (b -> c) -> (a -> b) -> a -> c
(.) forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\a
x -> forall (m :: * -> *) a. Monad m => m Bool -> m a -> m a -> m a
ifM (a -> m Bool
p a
x) (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just a
x)) (forall (f :: * -> *) a. Applicative f => a -> f a
pure 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 [] = forall a. HasCallStack => String -> a
error String
"unexpected empty list"
notEmpty (a
x:[a]
xs) = a
x 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 = forall a. (Display -> X a) -> X a
withDisplay forall a b. (a -> b) -> a -> b
$ \Display
dpy -> forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr WindowAttributes
p ->
  Display -> KeySym -> Ptr WindowAttributes -> IO Status
xGetWindowAttributes Display
dpy KeySym
w Ptr WindowAttributes
p forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Status
0 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
    Status
_ -> forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
io IO String
getHomeDirectory
  case String
ps of
    Char
'/'       : String
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure String
ps
    Char
'~' : Char
'/' : String
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (String
home forall a. Semigroup a => a -> a -> a
<> forall a. Int -> [a] -> [a]
drop Int
1 String
ps)
    Char
'$'       : String
_ -> let (String
v,String
ps') = forall a. (a -> Bool) -> [a] -> ([a], [a])
span (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (String
"_"forall a. Semigroup a => a -> a -> a
<>[Char
'A'..Char
'Z']forall a. Semigroup a => a -> a -> a
<>[Char
'a'..Char
'z']forall a. Semigroup a => a -> a -> a
<>[Char
'0'..Char
'9'])) (forall a. Int -> [a] -> [a]
drop Int
1 String
ps)
                      in forall (m :: * -> *) a. MonadIO m => IO a -> m a
io ((\(SomeException
_ :: SomeException) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure String
"") forall e a. Exception e => (e -> IO a) -> IO a -> IO a
`handle` String -> IO String
getEnv String
v) forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
Exports.<&> (forall a. Semigroup a => a -> a -> a
<> String
ps')
    String
_             -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (String
home forall a. Semigroup a => a -> a -> a
<> (Char
'/' 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 =
  forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (KeyMask, String) -> ([String], KeyMask) -> ([String], KeyMask)
go ([], KeyMask
msk) forall a b. (a -> b) -> a -> b
$ [(KeyMask, String)]
masks
 where
  masks :: [(KeyMask, String)]
  masks :: [(KeyMask, String)]
masks = forall a b. (a -> b) -> [a] -> [b]
map (\KeyMask
m -> (KeyMask
m, forall a. Show a => a -> String
show KeyMask
m))
              [KeyMask
0 .. forall a. Enum a => Int -> a
toEnum (forall b. FiniteBits b => b -> Int
finiteBitSize KeyMask
msk forall a. Num a => a -> a -> a
- Int
1)]
       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 forall a. Eq a => a -> a -> Bool
== KeyMask
0       = ([String], KeyMask)
a
    | KeyMask
v forall a. Bits a => a -> a -> a
.&. KeyMask
m forall a. Eq a => a -> a -> Bool
== KeyMask
m = (String
s forall a. a -> [a] -> [a]
: [String]
ss, KeyMask
v forall a. Bits a => a -> a -> a
.&. 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 = forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a. [a] -> [a] -> [a]
(++) forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 forall k a. Ord k => Map k a -> k -> Maybe a
Map.!? KeySym
x of
    Just String
s  -> String
"<" forall a. Semigroup a => a -> a -> a
<> String
s forall a. Semigroup a => a -> a -> a
<> String
">"
    Maybe String
Nothing -> case Map KeySym String
regularMap 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 = forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> (b, a)
swap [(String, KeySym)]
regularKeys)
  specialMap :: Map KeySym String
specialMap = forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList (forall a b. (a -> b) -> [a] -> [b]
map 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' forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 forall a. Bits a => a -> a -> a
.&. forall a. Bits a => a -> a
complement (KeyMask
numLockMask forall a. Bits a => a -> a -> a
.|. KeyMask
lockMask) forall a. Bits a => a -> a -> a
.&. (KeyMask
button1Mask forall a. Num a => a -> a -> a
- KeyMask
1)

-- | A list of "regular" (extended ASCII) keys.
regularKeys :: [(String, KeySym)]
regularKeys :: [(String, KeySym)]
regularKeys = forall a b. (a -> b) -> [a] -> [b]
map (forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first (forall a. a -> [a] -> [a]
:[]))
            forall a b. (a -> b) -> a -> b
$ forall a b. [a] -> [b] -> [(a, b)]
zip [Char
'!'             .. Char
'~'          ] -- ASCII
                  [KeySym
xK_exclam       .. KeySym
xK_asciitilde]
           forall a. Semigroup a => a -> a -> a
<> 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 forall a. Semigroup a => a -> a -> a
<> [(String, KeySym)]
specialKeys 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' forall a. a -> [a] -> [a]
: forall a. Show a => a -> String
show Int
n, KeySym
k)
               | (Int
n,KeySym
k) <- 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 = forall a. (a -> Bool) -> [a] -> [a]
filter ((forall a. Eq a => a -> a -> Bool
/= KeySym
noSymbol) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall a. a -> a
id forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& String -> KeySym
stringToKeysym) 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 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 forall a. a -> Stream a -> Stream a
:~ forall l. IsList l => [Item l] -> l
fromList [a]
xs
  fromList []       = 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 forall a. a -> [a] -> [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 = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr 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 forall a. a -> Stream a -> Stream a
:~ [a]
xs 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 = forall a. Int -> [a] -> [a]
take Int
n forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall l. IsList l => l -> [Item l]
toList