module XMonad.Actions.MessageFeedback
(
sendSomeMessageB, sendSomeMessage
, sendSomeMessageWithNoRefreshB, sendSomeMessageWithNoRefresh
, sendSomeMessageWithNoRefreshToCurrentB, sendSomeMessageWithNoRefreshToCurrent
, sendMessageB
, sendMessageWithNoRefreshB
, sendMessageWithNoRefreshToCurrentB, sendMessageWithNoRefreshToCurrent
, sendSomeMessagesB, sendSomeMessages, sendMessagesB, sendMessages
, tryInOrderB, tryInOrderWithNoRefreshToCurrentB, tryInOrderWithNoRefreshToCurrent
, tryMessageB, tryMessageWithNoRefreshToCurrentB, tryMessageWithNoRefreshToCurrent
, sm
, send, sendSM, sendSM_
, tryInOrder, tryInOrder_
, tryMessage, tryMessage_
) where
import XMonad ( Window )
import XMonad.Core ( X(), Message, SomeMessage(..), LayoutClass(..), windowset, catchX, WorkspaceId, Layout, whenJust )
import XMonad.Operations ( updateLayout, windowBracket, modifyWindowSet )
import XMonad.Prelude ( isJust, liftA2, void )
import XMonad.StackSet ( Workspace, current, workspace, layout, tag )
import Control.Monad.State ( gets )
sendSomeMessageB :: SomeMessage -> X Bool
sendSomeMessageB :: SomeMessage -> X Bool
sendSomeMessageB SomeMessage
m = (Bool -> Bool) -> X Bool -> X Bool
forall a. (a -> Bool) -> X a -> X a
windowBracket Bool -> Bool
forall a. a -> a
id (X Bool -> X Bool) -> X Bool -> X Bool
forall a b. (a -> b) -> a -> b
$ do
Workspace WorkspaceId (Layout Window) Window
w <- (XState -> Workspace WorkspaceId (Layout Window) Window)
-> X (Workspace WorkspaceId (Layout Window) Window)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ((Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
-> Workspace WorkspaceId (Layout Window) Window
forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
workspace (Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
-> Workspace WorkspaceId (Layout Window) Window)
-> (StackSet
WorkspaceId (Layout Window) Window ScreenId ScreenDetail
-> Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail)
-> StackSet
WorkspaceId (Layout Window) Window ScreenId ScreenDetail
-> Workspace WorkspaceId (Layout Window) Window
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StackSet WorkspaceId (Layout Window) Window ScreenId ScreenDetail
-> Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
current) (StackSet WorkspaceId (Layout Window) Window ScreenId ScreenDetail
-> Workspace WorkspaceId (Layout Window) Window)
-> (XState
-> StackSet
WorkspaceId (Layout Window) Window ScreenId ScreenDetail)
-> XState
-> Workspace WorkspaceId (Layout Window) Window
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XState
-> StackSet
WorkspaceId (Layout Window) Window ScreenId ScreenDetail
windowset)
Maybe (Layout Window)
ml <- Layout Window -> SomeMessage -> X (Maybe (Layout Window))
forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> SomeMessage -> X (Maybe (layout a))
handleMessage (Workspace WorkspaceId (Layout Window) Window -> Layout Window
forall i l a. Workspace i l a -> l
layout Workspace WorkspaceId (Layout Window) Window
w) SomeMessage
m X (Maybe (Layout Window))
-> X (Maybe (Layout Window)) -> X (Maybe (Layout Window))
forall a. X a -> X a -> X a
`catchX` Maybe (Layout Window) -> X (Maybe (Layout Window))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Layout Window)
forall a. Maybe a
Nothing
Maybe (Layout Window) -> (Layout Window -> X ()) -> X ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe (Layout Window)
ml ((Layout Window -> X ()) -> X ())
-> (Layout Window -> X ()) -> X ()
forall a b. (a -> b) -> a -> b
$ \Layout Window
l ->
(StackSet WorkspaceId (Layout Window) Window ScreenId ScreenDetail
-> StackSet
WorkspaceId (Layout Window) Window ScreenId ScreenDetail)
-> X ()
modifyWindowSet ((StackSet WorkspaceId (Layout Window) Window ScreenId ScreenDetail
-> StackSet
WorkspaceId (Layout Window) Window ScreenId ScreenDetail)
-> X ())
-> (StackSet
WorkspaceId (Layout Window) Window ScreenId ScreenDetail
-> StackSet
WorkspaceId (Layout Window) Window ScreenId ScreenDetail)
-> X ()
forall a b. (a -> b) -> a -> b
$ \StackSet WorkspaceId (Layout Window) Window ScreenId ScreenDetail
ws -> StackSet WorkspaceId (Layout Window) Window ScreenId ScreenDetail
ws { current :: Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
current = (StackSet WorkspaceId (Layout Window) Window ScreenId ScreenDetail
-> Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
current StackSet WorkspaceId (Layout Window) Window ScreenId ScreenDetail
ws)
{ workspace :: Workspace WorkspaceId (Layout Window) Window
workspace = (Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
-> Workspace WorkspaceId (Layout Window) Window
forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
workspace (Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
-> Workspace WorkspaceId (Layout Window) Window)
-> Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
-> Workspace WorkspaceId (Layout Window) Window
forall a b. (a -> b) -> a -> b
$ StackSet WorkspaceId (Layout Window) Window ScreenId ScreenDetail
-> Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
current StackSet WorkspaceId (Layout Window) Window ScreenId ScreenDetail
ws)
{ layout :: Layout Window
layout = Layout Window
l }}}
Bool -> X Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> X Bool) -> Bool -> X Bool
forall a b. (a -> b) -> a -> b
$ Maybe (Layout Window) -> Bool
forall a. Maybe a -> Bool
isJust Maybe (Layout Window)
ml
sendSomeMessage :: SomeMessage -> X ()
sendSomeMessage :: SomeMessage -> X ()
sendSomeMessage = X Bool -> X ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (X Bool -> X ()) -> (SomeMessage -> X Bool) -> SomeMessage -> X ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SomeMessage -> X Bool
sendSomeMessageB
sendSomeMessageWithNoRefreshB :: SomeMessage -> Workspace WorkspaceId (Layout Window) Window -> X Bool
sendSomeMessageWithNoRefreshB :: SomeMessage
-> Workspace WorkspaceId (Layout Window) Window -> X Bool
sendSomeMessageWithNoRefreshB SomeMessage
m Workspace WorkspaceId (Layout Window) Window
w
= Layout Window -> SomeMessage -> X (Maybe (Layout Window))
forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> SomeMessage -> X (Maybe (layout a))
handleMessage (Workspace WorkspaceId (Layout Window) Window -> Layout Window
forall i l a. Workspace i l a -> l
layout Workspace WorkspaceId (Layout Window) Window
w) SomeMessage
m X (Maybe (Layout Window))
-> X (Maybe (Layout Window)) -> X (Maybe (Layout Window))
forall a. X a -> X a -> X a
`catchX` Maybe (Layout Window) -> X (Maybe (Layout Window))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Layout Window)
forall a. Maybe a
Nothing
X (Maybe (Layout Window))
-> (Maybe (Layout Window) -> X Bool) -> X Bool
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (X () -> X Bool -> X Bool)
-> (Maybe (Layout Window) -> X ())
-> (Maybe (Layout Window) -> X Bool)
-> Maybe (Layout Window)
-> X Bool
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 X () -> X Bool -> X Bool
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
(>>) (WorkspaceId -> Maybe (Layout Window) -> X ()
updateLayout (WorkspaceId -> Maybe (Layout Window) -> X ())
-> WorkspaceId -> Maybe (Layout Window) -> X ()
forall a b. (a -> b) -> a -> b
$ Workspace WorkspaceId (Layout Window) Window -> WorkspaceId
forall i l a. Workspace i l a -> i
tag Workspace WorkspaceId (Layout Window) Window
w) (Bool -> X Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> X Bool)
-> (Maybe (Layout Window) -> Bool)
-> Maybe (Layout Window)
-> X Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe (Layout Window) -> Bool
forall a. Maybe a -> Bool
isJust)
sendSomeMessageWithNoRefresh :: SomeMessage -> Workspace WorkspaceId (Layout Window) Window -> X ()
sendSomeMessageWithNoRefresh :: SomeMessage -> Workspace WorkspaceId (Layout Window) Window -> X ()
sendSomeMessageWithNoRefresh SomeMessage
m = X Bool -> X ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (X Bool -> X ())
-> (Workspace WorkspaceId (Layout Window) Window -> X Bool)
-> Workspace WorkspaceId (Layout Window) Window
-> X ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SomeMessage
-> Workspace WorkspaceId (Layout Window) Window -> X Bool
sendSomeMessageWithNoRefreshB SomeMessage
m
sendSomeMessageWithNoRefreshToCurrentB :: SomeMessage -> X Bool
sendSomeMessageWithNoRefreshToCurrentB :: SomeMessage -> X Bool
sendSomeMessageWithNoRefreshToCurrentB SomeMessage
m
= (XState -> Workspace WorkspaceId (Layout Window) Window)
-> X (Workspace WorkspaceId (Layout Window) Window)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
-> Workspace WorkspaceId (Layout Window) Window
forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
workspace (Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
-> Workspace WorkspaceId (Layout Window) Window)
-> (XState
-> Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail)
-> XState
-> Workspace WorkspaceId (Layout Window) Window
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StackSet WorkspaceId (Layout Window) Window ScreenId ScreenDetail
-> Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
current (StackSet WorkspaceId (Layout Window) Window ScreenId ScreenDetail
-> Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail)
-> (XState
-> StackSet
WorkspaceId (Layout Window) Window ScreenId ScreenDetail)
-> XState
-> Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XState
-> StackSet
WorkspaceId (Layout Window) Window ScreenId ScreenDetail
windowset)
X (Workspace WorkspaceId (Layout Window) Window)
-> (Workspace WorkspaceId (Layout Window) Window -> X Bool)
-> X Bool
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= SomeMessage
-> Workspace WorkspaceId (Layout Window) Window -> X Bool
sendSomeMessageWithNoRefreshB SomeMessage
m
sendSomeMessageWithNoRefreshToCurrent :: SomeMessage -> X ()
sendSomeMessageWithNoRefreshToCurrent :: SomeMessage -> X ()
sendSomeMessageWithNoRefreshToCurrent = X Bool -> X ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (X Bool -> X ()) -> (SomeMessage -> X Bool) -> SomeMessage -> X ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SomeMessage -> X Bool
sendSomeMessageWithNoRefreshToCurrentB
sendMessageB :: Message a => a -> X Bool
sendMessageB :: a -> X Bool
sendMessageB = SomeMessage -> X Bool
sendSomeMessageB (SomeMessage -> X Bool) -> (a -> SomeMessage) -> a -> X Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> SomeMessage
forall a. Message a => a -> SomeMessage
SomeMessage
sendMessageWithNoRefreshB :: Message a => a -> Workspace WorkspaceId (Layout Window) Window -> X Bool
sendMessageWithNoRefreshB :: a -> Workspace WorkspaceId (Layout Window) Window -> X Bool
sendMessageWithNoRefreshB = SomeMessage
-> Workspace WorkspaceId (Layout Window) Window -> X Bool
sendSomeMessageWithNoRefreshB (SomeMessage
-> Workspace WorkspaceId (Layout Window) Window -> X Bool)
-> (a -> SomeMessage)
-> a
-> Workspace WorkspaceId (Layout Window) Window
-> X Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> SomeMessage
forall a. Message a => a -> SomeMessage
SomeMessage
sendMessageWithNoRefreshToCurrentB :: Message a => a -> X Bool
sendMessageWithNoRefreshToCurrentB :: a -> X Bool
sendMessageWithNoRefreshToCurrentB = SomeMessage -> X Bool
sendSomeMessageWithNoRefreshToCurrentB (SomeMessage -> X Bool) -> (a -> SomeMessage) -> a -> X Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> SomeMessage
forall a. Message a => a -> SomeMessage
SomeMessage
sendMessageWithNoRefreshToCurrent :: Message a => a -> X ()
sendMessageWithNoRefreshToCurrent :: a -> X ()
sendMessageWithNoRefreshToCurrent = X Bool -> X ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (X Bool -> X ()) -> (a -> X Bool) -> a -> X ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> X Bool
forall a. Message a => a -> X Bool
sendMessageWithNoRefreshToCurrentB
sendSomeMessagesB :: [SomeMessage] -> X [Bool]
sendSomeMessagesB :: [SomeMessage] -> X [Bool]
sendSomeMessagesB
= ([Bool] -> Bool) -> X [Bool] -> X [Bool]
forall a. (a -> Bool) -> X a -> X a
windowBracket [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
or
(X [Bool] -> X [Bool])
-> ([SomeMessage] -> X [Bool]) -> [SomeMessage] -> X [Bool]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SomeMessage -> X Bool) -> [SomeMessage] -> X [Bool]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM SomeMessage -> X Bool
sendSomeMessageWithNoRefreshToCurrentB
sendSomeMessages :: [SomeMessage] -> X ()
sendSomeMessages :: [SomeMessage] -> X ()
sendSomeMessages = X [Bool] -> X ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (X [Bool] -> X ())
-> ([SomeMessage] -> X [Bool]) -> [SomeMessage] -> X ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [SomeMessage] -> X [Bool]
sendSomeMessagesB
sendMessagesB :: Message a => [a] -> X [Bool]
sendMessagesB :: [a] -> X [Bool]
sendMessagesB = [SomeMessage] -> X [Bool]
sendSomeMessagesB ([SomeMessage] -> X [Bool])
-> ([a] -> [SomeMessage]) -> [a] -> X [Bool]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> SomeMessage) -> [a] -> [SomeMessage]
forall a b. (a -> b) -> [a] -> [b]
map a -> SomeMessage
forall a. Message a => a -> SomeMessage
SomeMessage
sendMessages :: Message a => [a] -> X ()
sendMessages :: [a] -> X ()
sendMessages = X [Bool] -> X ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (X [Bool] -> X ()) -> ([a] -> X [Bool]) -> [a] -> X ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> X [Bool]
forall a. Message a => [a] -> X [Bool]
sendMessagesB
tryInOrderB :: (SomeMessage -> X Bool) -> [SomeMessage] -> X Bool
tryInOrderB :: (SomeMessage -> X Bool) -> [SomeMessage] -> X Bool
tryInOrderB SomeMessage -> X Bool
_ [] = Bool -> X Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
tryInOrderB SomeMessage -> X Bool
f (SomeMessage
m:[SomeMessage]
ms) = do Bool
b <- SomeMessage -> X Bool
f SomeMessage
m
if Bool
b then Bool -> X Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True else (SomeMessage -> X Bool) -> [SomeMessage] -> X Bool
tryInOrderB SomeMessage -> X Bool
f [SomeMessage]
ms
tryInOrderWithNoRefreshToCurrentB :: [SomeMessage] -> X Bool
tryInOrderWithNoRefreshToCurrentB :: [SomeMessage] -> X Bool
tryInOrderWithNoRefreshToCurrentB = (SomeMessage -> X Bool) -> [SomeMessage] -> X Bool
tryInOrderB SomeMessage -> X Bool
sendSomeMessageWithNoRefreshToCurrentB
tryInOrderWithNoRefreshToCurrent :: [SomeMessage] -> X ()
tryInOrderWithNoRefreshToCurrent :: [SomeMessage] -> X ()
tryInOrderWithNoRefreshToCurrent = X Bool -> X ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (X Bool -> X ())
-> ([SomeMessage] -> X Bool) -> [SomeMessage] -> X ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [SomeMessage] -> X Bool
tryInOrderWithNoRefreshToCurrentB
tryMessageB :: (Message a, Message b) => (SomeMessage -> X Bool) -> a -> b -> X Bool
tryMessageB :: (SomeMessage -> X Bool) -> a -> b -> X Bool
tryMessageB SomeMessage -> X Bool
f a
m1 b
m2 = (SomeMessage -> X Bool) -> [SomeMessage] -> X Bool
tryInOrderB SomeMessage -> X Bool
f [a -> SomeMessage
forall a. Message a => a -> SomeMessage
sm a
m1,b -> SomeMessage
forall a. Message a => a -> SomeMessage
sm b
m2]
tryMessageWithNoRefreshToCurrentB :: (Message a, Message b) => a -> b -> X Bool
tryMessageWithNoRefreshToCurrentB :: a -> b -> X Bool
tryMessageWithNoRefreshToCurrentB = (SomeMessage -> X Bool) -> a -> b -> X Bool
forall a b.
(Message a, Message b) =>
(SomeMessage -> X Bool) -> a -> b -> X Bool
tryMessageB SomeMessage -> X Bool
sendSomeMessageWithNoRefreshToCurrentB
tryMessageWithNoRefreshToCurrent :: (Message a, Message b) => a -> b -> X ()
tryMessageWithNoRefreshToCurrent :: a -> b -> X ()
tryMessageWithNoRefreshToCurrent a
m = X Bool -> X ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (X Bool -> X ()) -> (b -> X Bool) -> b -> X ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b -> X Bool
forall a b. (Message a, Message b) => a -> b -> X Bool
tryMessageWithNoRefreshToCurrentB a
m
sm :: Message a => a -> SomeMessage
sm :: a -> SomeMessage
sm = a -> SomeMessage
forall a. Message a => a -> SomeMessage
SomeMessage
{-# DEPRECATED send "Use sendMessageB instead." #-}
{-# DEPRECATED sendSM "Use sendSomeMessageB instead." #-}
{-# DEPRECATED sendSM_ "Use sendSomeMessage instead." #-}
{-# DEPRECATED tryInOrder "Use tryInOrderWithNoRefreshToCurrentB instead." #-}
{-# DEPRECATED tryInOrder_ "Use tryInOrderWithNoRefreshToCurrent instead." #-}
{-# DEPRECATED tryMessage "Use tryMessageWithNoRefreshToCurrentB instead." #-}
{-# DEPRECATED tryMessage_ "Use tryMessageWithNoRefreshToCurrent instead." #-}
send :: Message a => a -> X Bool
send :: a -> X Bool
send = a -> X Bool
forall a. Message a => a -> X Bool
sendMessageWithNoRefreshToCurrentB
sendSM :: SomeMessage -> X Bool
sendSM :: SomeMessage -> X Bool
sendSM = SomeMessage -> X Bool
sendSomeMessageWithNoRefreshToCurrentB
sendSM_ :: SomeMessage -> X ()
sendSM_ :: SomeMessage -> X ()
sendSM_ = SomeMessage -> X ()
sendSomeMessageWithNoRefreshToCurrent
tryInOrder :: [SomeMessage] -> X Bool
tryInOrder :: [SomeMessage] -> X Bool
tryInOrder = [SomeMessage] -> X Bool
tryInOrderWithNoRefreshToCurrentB
tryInOrder_ :: [SomeMessage] -> X ()
tryInOrder_ :: [SomeMessage] -> X ()
tryInOrder_ = [SomeMessage] -> X ()
tryInOrderWithNoRefreshToCurrent
tryMessage :: (Message a, Message b) => a -> b -> X Bool
tryMessage :: a -> b -> X Bool
tryMessage = a -> b -> X Bool
forall a b. (Message a, Message b) => a -> b -> X Bool
tryMessageWithNoRefreshToCurrentB
tryMessage_ :: (Message a, Message b) => a -> b -> X ()
tryMessage_ :: a -> b -> X ()
tryMessage_ = a -> b -> X ()
forall a b. (Message a, Message b) => a -> b -> X ()
tryMessageWithNoRefreshToCurrent