-----------------------------------------------------------------------------
-- |
-- Module       : XMonad.Actions.MessageFeedback
-- Description :  An alternative @sendMessage@.
-- Copyright    : (c) --   Quentin Moser <moserq@gmail.com>
--                    2018 Yclept Nemo
-- License      : BSD3
--
-- Maintainer   : orphaned
-- Stability    : unstable
-- Portability  : unportable
--
-- Alternative to 'XMonad.Operations.sendMessage' that provides knowledge
-- of whether the message was handled, and utility functions based on
-- this facility.
-----------------------------------------------------------------------------

module XMonad.Actions.MessageFeedback
    ( -- * Usage
      -- $usage

      -- * Messaging variants

      -- ** 'SomeMessage'
      sendSomeMessageB, sendSomeMessage
    , sendSomeMessageWithNoRefreshB, sendSomeMessageWithNoRefresh
    , sendSomeMessageWithNoRefreshToCurrentB, sendSomeMessageWithNoRefreshToCurrent

      -- ** 'Message'
    , sendMessageB
    , sendMessageWithNoRefreshB
    , sendMessageWithNoRefreshToCurrentB, sendMessageWithNoRefreshToCurrent

      -- * Utility Functions

      -- ** Send All
    , sendSomeMessagesB, sendSomeMessages, sendMessagesB, sendMessages

      -- ** Send Until
    , tryInOrderB, tryInOrderWithNoRefreshToCurrentB, tryInOrderWithNoRefreshToCurrent
    , tryMessageB, tryMessageWithNoRefreshToCurrentB, tryMessageWithNoRefreshToCurrent

      -- ** Aliases
    , sm
    ) 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
import XMonad.StackSet      ( Workspace, current, workspace, layout, tag )

import Control.Monad.State  ( gets )

-- $usage
-- You can use this module with the following in your @xmonad.hs@:
--
-- > import XMonad.Actions.MessageFeedback
--
-- You can then use this module's functions wherever an action is expected. All
-- feedback variants are supported:
--
-- * message to any workspace with no refresh
-- * message to current workspace with no refresh
-- * message to current workspace with refresh
--
-- Except "message to any workspace with refresh" which makes little sense.
--
-- Note that most functions in this module have a return type of @X Bool@
-- whereas configuration options will expect a @X ()@ action. For example, the
-- key binding:
--
-- > -- Shrink the master area of a tiled layout, or move the focused window
-- > -- to the left in a WindowArranger-based layout
-- > ((modKey, xK_Left), tryMessageWithNoRefreshToCurrentB Shrink (MoveLeft 50))
--
-- is mis-typed. For this reason, this module provides alternatives (not ending
-- with an uppercase \"B\", e.g. 'XMonad.Operations.sendMessage' rather than
-- 'sendMessageB') that discard their boolean result and return an @X ()@. For
-- example, to correct the previous example:
--
-- > ((modKey, xK_Left), tryMessageWithNoRefreshToCurrent Shrink (MoveLeft 50))
--
-- This module also provides 'SomeMessage' variants of each 'Message' function
-- for when the messages are of differing types (but still instances of
-- 'Message'). First box each message using 'SomeMessage' or the convenience
-- alias 'sm'. Then, for example, to send each message:
--
-- > sendSomeMessages [sm messageOfTypeA, sm messageOfTypeB]
--
-- This is /not/ equivalent to the following example, which will not refresh
-- the workspace unless the last message is handled:
--
-- > sendMessageWithNoRefreshToCurrent messageOfTypeA >> sendMessage messageOfTypeB


-- | Variant of 'XMonad.Operations.sendMessage'. Accepts 'SomeMessage'; to use
-- 'Message' see 'sendMessageB'. Returns @True@ if the message was handled,
-- @False@ otherwise. Instead of using 'sendSomeMessageWithNoRefreshToCurrentB'
-- for efficiency this is pretty much an exact copy of the
-- 'XMonad.Operations.sendMessage' code - foregoes the O(n) 'updateLayout'.
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 a. a -> X a
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 = (current ws)
                                { workspace = (workspace $ current ws)
                                    { layout = l }}}
    Bool -> X Bool
forall a. a -> X a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> X Bool) -> Bool -> X Bool
forall a b. (a -> b) -> a -> b
$ Maybe (Layout Window) -> Bool
forall a. Maybe a -> Bool
isJust Maybe (Layout Window)
ml

-- | Variant of 'sendSomeMessageB' that discards the result.
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

-- | Variant of 'XMonad.Operations.sendMessageWithNoRefresh'. Accepts
-- 'SomeMessage'; to use 'Message' see 'sendMessageWithNoRefreshB'. Returns
-- @True@ if the message was handled, @False@ otherwise.
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 a. a -> X a
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 a b. X a -> (a -> X b) -> X b
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 a b c.
(a -> b -> c)
-> (Maybe (Layout Window) -> a)
-> (Maybe (Layout Window) -> b)
-> Maybe (Layout Window)
-> c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 X () -> X Bool -> X Bool
forall a b. X a -> X b -> X b
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 a. a -> X a
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)

-- | Variant of 'sendSomeMessageWithNoRefreshB' that discards the result.
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

-- | Variant of 'XMonad.Operations.sendMessageWithNoRefresh' that sends the
-- message to the current layout. Accepts 'SomeMessage'; to use 'Message' see
-- 'sendMessageWithNoRefreshToCurrentB'. Returns @True@ if the message was
-- handled, @False@ otherwise. This function is somewhat of a cross between
-- 'XMonad.Operations.sendMessage' (sends to the current layout) and
-- 'XMonad.Operations.sendMessageWithNoRefresh' (does not refresh).
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 a b. X a -> (a -> X b) -> X b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= SomeMessage
-> Workspace WorkspaceId (Layout Window) Window -> X Bool
sendSomeMessageWithNoRefreshB SomeMessage
m

-- | Variant of 'sendSomeMessageWithNoRefreshToCurrentB' that discards the
-- result.
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


-- | Variant of 'sendSomeMessageB' which like 'XMonad.Operations.sendMessage'
-- accepts 'Message' rather than 'SomeMessage'. Returns @True@ if the message
-- was handled, @False@ otherwise.
sendMessageB :: Message a => a -> X Bool
sendMessageB :: forall a. Message a => 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

-- | Variant of 'sendSomeMessageWithNoRefreshB' which like
-- 'XMonad.Operations.sendMessageWithNoRefresh' accepts 'Message' rather than
-- 'SomeMessage'. Returns @True@ if the message was handled, @False@ otherwise.
sendMessageWithNoRefreshB :: Message a => a -> Workspace WorkspaceId (Layout Window) Window -> X Bool
sendMessageWithNoRefreshB :: forall a.
Message a =>
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

-- | Variant of 'sendSomeMessageWithNoRefreshToCurrentB' which accepts
-- 'Message' rather than 'SomeMessage'. Returns @True@ if the message was
-- handled, @False@ otherwise.
sendMessageWithNoRefreshToCurrentB :: Message a => a -> X Bool
sendMessageWithNoRefreshToCurrentB :: forall a. Message a => 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

-- | Variant of 'sendMessageWithNoRefreshToCurrentB' that discards the result.
sendMessageWithNoRefreshToCurrent :: Message a => a -> X ()
sendMessageWithNoRefreshToCurrent :: forall a. Message a => 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


-- | Send each 'SomeMessage' to the current layout without refresh (using
-- 'sendSomeMessageWithNoRefreshToCurrentB') and collect the results. If any
-- message was handled, refresh. If you want to sequence a series of messages
-- that would have otherwise used 'XMonad.Operations.sendMessage' while
-- minimizing refreshes, use this.
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)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM SomeMessage -> X Bool
sendSomeMessageWithNoRefreshToCurrentB

-- | Variant of 'sendSomeMessagesB' that discards the results.
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

-- | Variant of 'sendSomeMessagesB' which accepts 'Message' rather than
-- 'SomeMessage'. Use this if all the messages are of the same type.
sendMessagesB :: Message a => [a] -> X [Bool]
sendMessagesB :: forall a. Message a => [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

-- | Variant of 'sendMessagesB' that discards the results.
sendMessages :: Message a => [a] -> X ()
sendMessages :: forall a. Message a => [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


-- | Apply the dispatch function in order to each message of the list until one
-- is handled. Returns @True@ if so, @False@ otherwise.
tryInOrderB :: (SomeMessage -> X Bool) -> [SomeMessage] -> X Bool
tryInOrderB :: (SomeMessage -> X Bool) -> [SomeMessage] -> X Bool
tryInOrderB SomeMessage -> X Bool
_ []     = Bool -> X Bool
forall a. a -> X a
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 a. a -> X a
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

-- | Variant of 'tryInOrderB' that sends messages to the current layout without
-- refresh using 'sendSomeMessageWithNoRefreshToCurrentB'.
tryInOrderWithNoRefreshToCurrentB :: [SomeMessage] -> X Bool
tryInOrderWithNoRefreshToCurrentB :: [SomeMessage] -> X Bool
tryInOrderWithNoRefreshToCurrentB = (SomeMessage -> X Bool) -> [SomeMessage] -> X Bool
tryInOrderB SomeMessage -> X Bool
sendSomeMessageWithNoRefreshToCurrentB

-- | Variant of 'tryInOrderWithNoRefreshToCurrent' that discards the results.
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

-- | Apply the dispatch function to the first message, and if it was not
-- handled, apply it to the second. Returns @True@ if either message was
-- handled, @False@ otherwise.
tryMessageB :: (Message a, Message b) => (SomeMessage -> X Bool) -> a -> b -> X Bool
tryMessageB :: forall a b.
(Message a, Message b) =>
(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]

-- | Variant of 'tryMessageB' that sends messages to the current layout without
-- refresh using 'sendMessageWithNoRefreshToCurrentB'.
tryMessageWithNoRefreshToCurrentB :: (Message a, Message b) => a -> b -> X Bool
tryMessageWithNoRefreshToCurrentB :: forall a b. (Message a, Message b) => 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

-- | Variant of 'tryMessage' that discards the results.
tryMessageWithNoRefreshToCurrent :: (Message a, Message b) => a -> b -> X ()
tryMessageWithNoRefreshToCurrent :: forall a b. (Message a, Message b) => 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


-- | Convenience shorthand for 'SomeMessage'.
sm :: Message a => a -> SomeMessage
sm :: forall a. Message a => a -> SomeMessage
sm = a -> SomeMessage
forall a. Message a => a -> SomeMessage
SomeMessage