packages feed

xmonad-contrib 0.14 → 0.15

raw patch · 11 files changed

+417/−98 lines, 11 filesdep ~basedep ~containersdep ~xmonadPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: base, containers, xmonad

API changes (from Hackage documentation)

+ XMonad.Config.Prime: modifyWindowSet :: WindowSet -> WindowSet -> X ()
+ XMonad.Config.Prime: windowBracket :: () => a -> Bool -> X a -> X a
+ XMonad.Config.Prime: windowBracket_ :: X Any -> X ()
+ XMonad.Util.PureX: (&>) :: Applicative f => f Any -> f Any -> f Any
+ XMonad.Util.PureX: (<?) :: Monad m => m Any -> m a -> m Any
+ XMonad.Util.PureX: class (MonadReader XConf m, MonadState XState m) => XLike m
+ XMonad.Util.PureX: curScreen :: XLike m => m (Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail)
+ XMonad.Util.PureX: curScreenId :: XLike m => m ScreenId
+ XMonad.Util.PureX: curTag :: XLike m => m WorkspaceId
+ XMonad.Util.PureX: curWorkspace :: XLike m => m WindowSpace
+ XMonad.Util.PureX: data PureX a
+ XMonad.Util.PureX: defile :: PureX Any -> X ()
+ XMonad.Util.PureX: getStack :: XLike m => m (Maybe (Stack Window))
+ XMonad.Util.PureX: greedyView :: XLike m => WorkspaceId -> m Any
+ XMonad.Util.PureX: handlingRefresh :: X () -> X ()
+ XMonad.Util.PureX: infixl 1 &>
+ XMonad.Util.PureX: infixl 4 <?
+ XMonad.Util.PureX: instance Control.Monad.Reader.Class.MonadReader XMonad.Core.XConf XMonad.Util.PureX.PureX
+ XMonad.Util.PureX: instance Control.Monad.State.Class.MonadState XMonad.Core.XState XMonad.Util.PureX.PureX
+ XMonad.Util.PureX: instance GHC.Base.Applicative XMonad.Util.PureX.PureX
+ XMonad.Util.PureX: instance GHC.Base.Functor XMonad.Util.PureX.PureX
+ XMonad.Util.PureX: instance GHC.Base.Monad XMonad.Util.PureX.PureX
+ XMonad.Util.PureX: instance GHC.Base.Monoid a => GHC.Base.Monoid (XMonad.Util.PureX.PureX a)
+ XMonad.Util.PureX: instance GHC.Base.Semigroup a => GHC.Base.Semigroup (XMonad.Util.PureX.PureX a)
+ XMonad.Util.PureX: instance XMonad.Util.PureX.XLike XMonad.Core.X
+ XMonad.Util.PureX: instance XMonad.Util.PureX.XLike XMonad.Util.PureX.PureX
+ XMonad.Util.PureX: invisiView :: XLike m => WorkspaceId -> m Any
+ XMonad.Util.PureX: modify'' :: (Maybe (Stack a) -> Maybe (Stack a)) -> (StackSet i l a s sd -> StackSet i l a s sd)
+ XMonad.Util.PureX: modifyWindowSet' :: XLike m => (WindowSet -> WindowSet) -> m ()
+ XMonad.Util.PureX: peek :: XLike m => m (Maybe Window)
+ XMonad.Util.PureX: putStack :: XLike m => Maybe (Stack Window) -> m ()
+ XMonad.Util.PureX: runPureX :: PureX a -> XConf -> XState -> (a, XState)
+ XMonad.Util.PureX: shift :: XLike m => WorkspaceId -> m Any
+ XMonad.Util.PureX: toX :: XLike m => m a -> X a
+ XMonad.Util.PureX: toXLike :: XLike m => PureX a -> m a
+ XMonad.Util.PureX: view :: XLike m => WorkspaceId -> m Any
+ XMonad.Util.PureX: when' :: (Monad m, Monoid a) => Bool -> m a -> m a
+ XMonad.Util.PureX: whenJust' :: (Monad m, Monoid b) => Maybe a -> (a -> m b) -> m b
+ XMonad.Util.PureX: whenM' :: (Monad m, Monoid a) => m Bool -> m a -> m a
+ XMonad.Util.PureX: windowBracket' :: XLike m => (a -> Bool) -> m a -> X a
+ XMonad.Util.PureX: withFocii :: (XLike m, Monoid a) => (WorkspaceId -> Window -> m a) -> m a
+ XMonad.Util.PureX: withWindowSet' :: XLike m => (WindowSet -> m a) -> m a
- XMonad.Util.ExtensibleState: get :: ExtensionClass a => X a
+ XMonad.Util.ExtensibleState: get :: (ExtensionClass a, XLike m) => m a
- XMonad.Util.ExtensibleState: gets :: ExtensionClass a => (a -> b) -> X b
+ XMonad.Util.ExtensibleState: gets :: (ExtensionClass a, XLike m) => (a -> b) -> m b
- XMonad.Util.ExtensibleState: modified :: (ExtensionClass a, Eq a) => (a -> a) -> X Bool
+ XMonad.Util.ExtensibleState: modified :: (ExtensionClass a, Eq a, XLike m) => (a -> a) -> m Bool
- XMonad.Util.ExtensibleState: modify :: ExtensionClass a => (a -> a) -> X ()
+ XMonad.Util.ExtensibleState: modify :: (ExtensionClass a, XLike m) => (a -> a) -> m ()
- XMonad.Util.ExtensibleState: put :: ExtensionClass a => a -> X ()
+ XMonad.Util.ExtensibleState: put :: (ExtensionClass a, XLike m) => a -> m ()
- XMonad.Util.ExtensibleState: remove :: ExtensionClass a => a -> X ()
+ XMonad.Util.ExtensibleState: remove :: (ExtensionClass a, XLike m) => a -> m ()

Files

CHANGES.md view
@@ -1,5 +1,43 @@ # Change Log / Release Notes +## unknown++## 0.15++### Breaking Changes++  * `XMonad.Layout.Groups` & `XMonad.Layout.Groups.Helpers`+    The layout will no longer perform refreshes inside of its message handling.+    If you have been relying on it to in your xmonad.hs, you will need to start+    sending its messages in a manner that properly handles refreshing, e.g. with+    `sendMessage`.++### New Modules++  * `XMonad.Util.Purex`++    Unlike the opaque `IO` actions that `X` actions can wrap, regular reads from+    the `XConf` and modifications to the `XState` are fundamentally pure --+    contrary to the current treatment of such actions in most xmonad code. Pure+    modifications to the `WindowSet` can be readily composed, but due to the+    need for those modifications to be properly handled by `windows`, other pure+    changes to the `XState` cannot be interleaved with those changes to the+    `WindowSet` without superfluous refreshes, hence breaking composability.++    This module aims to rectify that situation by drawing attention to it and+    providing `PureX`: a pure type with the same monadic interface to state as+    `X`. The `XLike` typeclass enables writing actions generic over the two+    monads; if pure, existing `X` actions can be generalised with only a change+    to the type signature. Various other utilities are provided, in particular+    the `defile` function which is needed by end-users.++### Bug Fixes and Minor Changes++  * Add support for GHC 8.6.1.++  * `XMonad.Actions.MessageHandling`+    Refresh-performing functions updated to better reflect the new `sendMessage`.+ ## 0.14  ### Breaking Changes
XMonad/Actions/MessageFeedback.hs view
@@ -52,10 +52,10 @@ import XMonad               ( Window ) import XMonad.Core          ( X(), Message, SomeMessage(..), LayoutClass(..), windowset, catchX, WorkspaceId, Layout, whenJust ) import XMonad.StackSet      ( Workspace, current, workspace, layout, tag )-import XMonad.Operations    ( updateLayout, refresh, windows )+import XMonad.Operations    ( updateLayout, windowBracket, modifyWindowSet )  import Data.Maybe           ( isJust )-import Control.Monad        ( when, void )+import Control.Monad        ( void ) import Control.Monad.State  ( gets ) import Control.Applicative  ( (<$>), liftA2 ) @@ -107,11 +107,11 @@ -- 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 m = do+sendSomeMessageB m = windowBracket id $ do     w  <- workspace . current <$> gets windowset     ml <- handleMessage (layout w) m `catchX` return Nothing     whenJust ml $ \l ->-        windows $ \ws -> ws { current = (current ws)+        modifyWindowSet $ \ws -> ws { current = (current ws)                                 { workspace = (workspace $ current ws)                                     { layout = l }}}     return $ isJust ml@@ -178,9 +178,9 @@ -- that would have otherwise used 'XMonad.Operations.sendMessage' while -- minimizing refreshes, use this. sendSomeMessagesB :: [SomeMessage] -> X [Bool]-sendSomeMessagesB m-    =   mapM sendSomeMessageWithNoRefreshToCurrentB m-    >>= liftA2 (>>) (flip when refresh . or) return+sendSomeMessagesB+    = windowBracket or+    . mapM sendSomeMessageWithNoRefreshToCurrentB  -- | Variant of 'sendSomeMessagesB' that discards the results. sendSomeMessages :: [SomeMessage] -> X ()
XMonad/Actions/PhysicalScreens.hs view
@@ -63,7 +63,7 @@ > -- > [((modm .|. mask, key), f sc) >     | (key, sc) <- zip [xK_w, xK_e, xK_r] [0..]->     , (f, mask) <- [(viewScreen, 0), (sendToScreen def, shiftMask)]]+>     , (f, mask) <- [(viewScreen def, 0), (sendToScreen def, shiftMask)]]  For detailed instructions on editing your key bindings, see "XMonad.Doc.Extending#Editing_key_bindings".
XMonad/Hooks/DebugEvents.hs view
@@ -34,6 +34,7 @@ import           Control.Monad.State import           Control.Monad.Reader import           Data.Char                                   (isDigit)+import           Data.Maybe                                  (fromJust) import           Data.List                                   (genericIndex                                                              ,genericLength                                                              ,unfoldr@@ -696,30 +697,31 @@ dumpString :: Decoder Bool dumpString =  do   fmt <- asks pType-  [cOMPOUND_TEXT,uTF8_STRING] <- inX $ mapM getAtom ["COMPOUND_TEXT","UTF8_STRING"]-  case () of-    () | fmt == cOMPOUND_TEXT -> guardSize 16 (...)-       | fmt == sTRING        -> guardSize  8 $ do-                                   vs <- gets value-                                   modify (\r -> r {value = []})-                                   let ss = flip unfoldr (map twiddle vs) $-                                            \s -> if null s-                                                  then Nothing-                                                  else let (w,s'') = break (== '\NUL') s-                                                           s'      = if null s''-                                                                     then s''-                                                                     else tail s''-                                                        in Just (w,s')-                                   case ss of-                                     [s] -> append $ show s-                                     ss' -> let go (s:ss'') c = append c        >>-                                                                append (show s) >>-                                                                go ss'' ","-                                                go []       _ = append "]"-                                             in append "[" >> go ss' ""-       | fmt == uTF8_STRING   -> dumpUTF -- duplicate type test instead of code :)-       | otherwise            -> (inX $ atomName fmt) >>=-                                 failure . ("unrecognized string type " ++)+  x <- inX $ mapM getAtom ["COMPOUND_TEXT","UTF8_STRING"]+  case x of+    [cOMPOUND_TEXT,uTF8_STRING] -> case () of+      () | fmt == cOMPOUND_TEXT -> guardSize 16 (...)+         | fmt == sTRING        -> guardSize  8 $ do+                                     vs <- gets value+                                     modify (\r -> r {value = []})+                                     let ss = flip unfoldr (map twiddle vs) $+                                              \s -> if null s+                                                    then Nothing+                                                    else let (w,s'') = break (== '\NUL') s+                                                             s'      = if null s''+                                                                       then s''+                                                                       else tail s''+                                                          in Just (w,s')+                                     case ss of+                                       [s] -> append $ show s+                                       ss' -> let go (s:ss'') c = append c        >>+                                                                  append (show s) >>+                                                                  go ss'' ","+                                                  go []       _ = append "]"+                                               in append "[" >> go ss' ""+         | fmt == uTF8_STRING   -> dumpUTF -- duplicate type test instead of code :)+         | otherwise            -> (inX $ atomName fmt) >>=+                                   failure . ("unrecognized string type " ++)  -- show who owns a selection dumpSelection :: Decoder Bool@@ -917,7 +919,7 @@     let w = (length (value sp) - length vs) * 8     -- now we get to reparse again so we get our copy of it     put sp-    Just v <- getInt' w+    v <- fmap fromJust (getInt' w)     -- and after all that, we can process the exception list     dumpExcept' xs that v @@ -1176,20 +1178,23 @@ -- @@@@@@@@@ evil beyond evil.  there *has* to be a better way inhale    :: Int -> Decoder Integer inhale  8 =  do-               [b] <- eat 1-               return $ fromIntegral b+               x <- eat 1+               case x of+                 [b] -> return $ fromIntegral b inhale 16 =  do-               [b0,b1] <- eat 2-               io $ allocaArray 2 $ \p -> do-                 pokeArray p [b0,b1]-                 [v] <- peekArray 1 (castPtr p :: Ptr Word16)-                 return $ fromIntegral v+               x <- eat 2+               case x of+                 [b0,b1] -> io $ allocaArray 2 $ \p -> do+                              pokeArray p [b0,b1]+                              [v] <- peekArray 1 (castPtr p :: Ptr Word16)+                              return $ fromIntegral v inhale 32 =  do-               [b0,b1,b2,b3] <- eat 4-               io $ allocaArray 4 $ \p -> do-                 pokeArray p [b0,b1,b2,b3]-                 [v] <- peekArray 1 (castPtr p :: Ptr Word32)-                 return $ fromIntegral v+               x <- eat 4+               case x of+                 [b0,b1,b2,b3] -> io $ allocaArray 4 $ \p -> do+                                    pokeArray p [b0,b1,b2,b3]+                                    [v] <- peekArray 1 (castPtr p :: Ptr Word32)+                                    return $ fromIntegral v inhale  b =  error $ "inhale " ++ show b  eat   :: Int -> Decoder Raw
XMonad/Layout/Fullscreen.hs view
@@ -30,18 +30,20 @@     ,FullscreenFloat, FullscreenFocus, FullscreenFull     ) where -import XMonad-import XMonad.Layout.LayoutModifier-import XMonad.Util.WindowProperties-import XMonad.Hooks.ManageHelpers (isFullscreen)-import qualified XMonad.StackSet as W-import Data.List-import Data.Maybe-import Data.Monoid-import qualified Data.Map as M-import Control.Monad-import Control.Arrow (second)+import           XMonad+import           XMonad.Layout.LayoutModifier+import           XMonad.Hooks.ManageHelpers     (isFullscreen)+import           XMonad.Util.WindowProperties+import qualified XMonad.Util.Rectangle          as R+import qualified XMonad.StackSet                as W +import           Data.List+import           Data.Maybe+import           Data.Monoid+import qualified Data.Map                       as M+import           Control.Monad+import           Control.Arrow                  (second)+ -- $usage -- Provides a ManageHook and an EventHook that sends layout messages -- with information about fullscreening windows. This allows layouts@@ -107,9 +109,12 @@     _ -> Nothing    pureModifier (FullscreenFull frect fulls) rect _ list =-    (map (flip (,) rect') visfulls ++ rest, Nothing)-    where visfulls = intersect fulls $ map fst list-          rest = filter (not . (flip elem visfulls `orP` covers rect')) list+    (visfulls' ++ rest', Nothing)+    where (visfulls,rest) = partition (flip elem fulls . fst) list+          visfulls' = map (second $ const rect') visfulls+          rest' = if null visfulls'+                  then rest+                  else filter (not . R.supersetOf rect' . snd) rest           rect' = scaleRationalRect rect frect  instance LayoutModifier FullscreenFocus Window where@@ -122,7 +127,7 @@   pureModifier (FullscreenFocus frect fulls) rect (Just (W.Stack {W.focus = f})) list      | f `elem` fulls = ((f, rect') : rest, Nothing)      | otherwise = (list, Nothing)-     where rest = filter (not . ((== f) `orP` covers rect')) list+     where rest = filter (not . orP (== f) (R.supersetOf rect')) list            rect' = scaleRationalRect rect frect   pureModifier _ _ Nothing list = (list, Nothing) @@ -239,15 +244,6 @@     cw <- (W.workspace . W.current) `fmap` gets windowset     sendMessageWithNoRefresh FullscreenChanged cw   idHook---- | True iff one rectangle completely contains another.-covers :: Rectangle -> Rectangle -> Bool-(Rectangle x1 y1 w1 h1) `covers` (Rectangle x2 y2 w2 h2) =-  let fi = fromIntegral-      in x1 <= x2 &&-         y1 <= y2 &&-         x1 + fi w1 >= x2 + fi w2 &&-         y1 + fi h1 >= y2 + fi h2  -- | Applies a pair of predicates to a pair of operands, combining them with ||. orP :: (a -> Bool) -> (b -> Bool) -> (a, b) -> Bool
XMonad/Layout/Groups.hs view
@@ -61,8 +61,8 @@ import Data.Maybe (isJust, isNothing, fromMaybe, catMaybes, fromJust) import Data.List ((\\)) import Control.Arrow ((>>>))-import Control.Applicative ((<$>))-import Control.Monad (forM)+import Control.Applicative ((<$>),(<|>),(<$))+import Control.Monad (forM,void)  -- $usage -- This module provides a layout combinator that allows you@@ -311,12 +311,12 @@               Just (ToGroup i sm') -> do mg's <- handleOnIndex i sm' z                                          return $ maybeMakeNew l Nothing mg's               Just (Modify spec) -> case applySpec spec l of-                                      Just l' -> refocus l' >> return (Just l')-                                      Nothing -> return $ Just l-              Just (ModifyX spec) -> applySpecX spec l >>= \case-                                      Just l' -> refocus l' >> return (Just l')-                                      Nothing -> return $ Just l-              Just Refocus -> refocus l >> return (Just l)+                                      Just l' -> refocus l'+                                      Nothing -> return Nothing+              Just (ModifyX spec) -> do ml' <- applySpecX spec l+                                        whenJust ml' (void . refocus)+                                        return (ml' <|> Just l)+              Just Refocus -> refocus l               Just _ -> return Nothing               Nothing -> handleMessage l $ SomeMessage (ToFocused sm)             where handleOnFocused sm z = mapZM step $ Just z@@ -343,10 +343,10 @@ maybeMakeNew _ Nothing ml's | all isNothing ml's = Nothing maybeMakeNew g mpart' ml's = justMakeNew g mpart' ml's -refocus :: Groups l l2 Window -> X ()-refocus g = case getFocusZ $ gZipper $ W.focus $ groups g-            of Just w -> focus w-               Nothing -> return ()+refocus :: Groups l l2 Window -> X (Maybe (Groups l l2 Window))+refocus g =+  let mw = (getFocusZ . gZipper . W.focus . groups) g+  in  g <$ mw <$ whenJust mw (modifyWindowSet . W.focusWindow)  -- ** ModifySpec type 
XMonad/Layout/Groups/Helpers.hs view
@@ -45,7 +45,7 @@  import qualified XMonad.Layout.Groups as G -import XMonad.Actions.MessageFeedback+import XMonad.Actions.MessageFeedback (sendMessageB)  import Control.Monad (unless) import qualified Data.Map as M@@ -92,7 +92,7 @@ alt f g = alt2 (G.Modify f) $ windows g  alt2 :: G.GroupsMessage -> X () -> X ()-alt2 m x = do b <- send m+alt2 m x = do b <- sendMessageB m               unless b x  -- | Swap the focused window with the previous one
XMonad/Prompt.hs view
@@ -1215,7 +1215,7 @@ -- name satisfies the given predicate. historyCompletionP :: (String -> Bool) -> ComplFunction historyCompletionP p x = fmap (toComplList . M.filterWithKey (const . p)) readHistory-    where toComplList = deleteConsecutive . filter (isInfixOf x) . M.fold (++) []+    where toComplList = deleteConsecutive . filter (isInfixOf x) . M.foldr (++) []  -- | Sort a list and remove duplicates. Like 'deleteAllDuplicates', but trades off --   laziness and stability for efficiency.
XMonad/Util/ExtensibleState.hs view
@@ -27,6 +27,7 @@ import Data.Typeable (typeOf,cast) import qualified Data.Map as M import XMonad.Core+import XMonad.Util.PureX import qualified Control.Monad.State as State import Data.Maybe (fromMaybe) @@ -75,27 +76,29 @@ --  -- | Modify the map of state extensions by applying the given function.-modifyStateExts :: (M.Map String (Either String StateExtension)-                   -> M.Map String (Either String StateExtension))-                -> X ()+modifyStateExts+  :: XLike m+  => (M.Map String (Either String StateExtension)+  -> M.Map String (Either String StateExtension))+  -> m () modifyStateExts f = State.modify $ \st -> st { extensibleState = f (extensibleState st) }  -- | Apply a function to a stored value of the matching type or the initial value if there -- is none.-modify :: ExtensionClass a => (a -> a) -> X ()+modify :: (ExtensionClass a, XLike m) => (a -> a) -> m () modify f = put . f =<< get  -- | Add a value to the extensible state field. A previously stored value with the same -- type will be overwritten. (More precisely: A value whose string representation of its type -- is equal to the new one's)-put :: ExtensionClass a => a -> X ()+put :: (ExtensionClass a, XLike m) => a -> m () put v = modifyStateExts . M.insert (show . typeOf $ v) . Right . extensionType $ v  -- | Try to retrieve a value of the requested type, return an initial value if there is no such value.-get :: ExtensionClass a => X a+get :: (ExtensionClass a, XLike m) => m a get = getState' undefined -- `trick' to avoid needing -XScopedTypeVariables   where toValue val = maybe initialValue id $ cast val-        getState' :: ExtensionClass a => a -> X a+        getState' :: (ExtensionClass a, XLike m) => a -> m a         getState' k = do           v <- State.gets $ M.lookup (show . typeOf $ k) . extensibleState           case v of@@ -110,14 +113,14 @@                          [(x,"")] -> Just x                          _ -> Nothing -gets :: ExtensionClass a => (a -> b) -> X b+gets :: (ExtensionClass a, XLike m) => (a -> b) -> m b gets = flip fmap get  -- | Remove the value from the extensible state field that has the same type as the supplied argument-remove :: ExtensionClass a => a -> X ()+remove :: (ExtensionClass a, XLike m) => a -> m () remove wit = modifyStateExts $ M.delete (show . typeOf $ wit) -modified :: (ExtensionClass a, Eq a) => (a -> a) -> X Bool+modified :: (ExtensionClass a, Eq a, XLike m) => (a -> a) -> m Bool modified f = do     v <- get     case f v of
+ XMonad/Util/PureX.hs view
@@ -0,0 +1,276 @@+{-# LANGUAGE GeneralizedNewtypeDeriving, FlexibleContexts #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Util.PureX+-- Copyright   :  L. S. Leary 2018+-- License     :  BSD3-style (see LICENSE)+--+-- Maintainer  :  L. S. Leary+-- Stability   :  unstable+-- Portability :  not portable+--+-- Unlike the opaque @IO@ actions that @X@ actions can wrap, regular reads from+-- the 'XConf' and modifications to the 'XState' are fundamentally pure—contrary+-- to the current treatment of such actions in most xmonad code. Pure+-- modifications to the 'WindowSet' can be readily composed, but due to the need+-- for those modifications to be properly handled by 'windows', other pure+-- changes to the @XState@ cannot be interleaved with those changes to the+-- @WindowSet@ without superfluous refreshes, hence breaking composability.+--+-- This module aims to rectify that situation by drawing attention to it and+-- providing 'PureX': a pure type with the same monadic interface to state as+-- @X@. The 'XLike' typeclass enables writing actions generic over the two+-- monads; if pure, existing @X@ actions can be generalised with only a change+-- to the type signature. Various other utilities are provided, in particular+-- the 'defile' function which is needed by end-users.+--+-----------------------------------------------------------------------------++-- --< Imports & Exports >-- {{{++module XMonad.Util.PureX (+  -- * Usage+  -- $Usage+  PureX, XLike(..), defile,+  windowBracket', handlingRefresh,+  runPureX, toXLike,+  -- * Utility+  -- ** Generalised when* functions+  when', whenM', whenJust',+  -- ** Infix operators+  (<?), (&>),+  -- ** @WindowSet@ operations+  withWindowSet', withFocii,+  modify'', modifyWindowSet',+  getStack, putStack, peek,+  view, greedyView, invisiView,+  shift, curScreen, curWorkspace,+  curTag, curScreenId,+) where++-- xmonad+import XMonad+import qualified XMonad.StackSet as W++-- mtl+import Control.Monad.State+import Control.Monad.Reader++-- base+import Data.Semigroup (Semigroup(..), Any(..))+import Control.Applicative (liftA2)++-- }}}++-- --< Usage >-- {{{++-- $Usage+--+-- The suggested pattern of usage for this module is to write composable, pure+-- actions as @XLike m => m Any@ or @PureX Any@ values, where the encapsulated+-- @Any@ value encodes whether or not a refresh is needed to properly institute+-- changes. These values can then be combined monoidally (i.e. with '<>' AKA+-- '<+>') or with operators such as '<*', '*>', '<?' and '&>' to build seamless+-- new actions. The end user can run and handle the effects of the pure actions+-- in the @X@ monad by applying the @defile@ function, which you may want to+-- re-export. Alternatively, if an action does not make stackset changes that+-- need to be handled by @windows@, it can be written with as an+-- @XLike m => m ()@ and used directly.+--+-- Unfortunately since layouts must handle messages in the @X@ monad, this+-- approach does not quite apply to actions involving them. However a relatively+-- direct translation to impure actions is possible: you can write composable,+-- refresh-tracking actions as @X Any@ values, making sure to eschew+-- refresh-inducing functions like @windows@ and @sendMessage@ in favour of+-- 'modifyWindowSet' and utilities provided by "XMonad.Actions.MessageFeedback".+-- The 'windowBracket_' function recently added to "XMonad.Operations" is the+-- impure analogue of @defile@. Note that @PureX Any@ actions can be composed+-- into impure ones after applying 'toX'; don't use @defile@ for this. E.g.+--+-- > windowBracket_ (composableImpureAction <> toX composablePureAction)+--+-- Although both @X@ and @PureX@ have Monoid instances over monoidal values,+-- @(XLike m, Monoid a)@ is not enough to infer @Monoid (m a)@ (due to the+-- open-world assumption). Hence a @Monoid (m Any)@ constraint may need to be+-- used when working with @XLike m => m Any@ where no context is forcing @m@ to+-- unify with @X@ or @PureX@. This can also be avoided by working with+-- @PureX Any@ values and generalising them with 'toXLike' where necessary.+--+-- @PureX@ also enables a more monadic style when writing windowset operations;+-- see the implementation of the utilities in this module for examples.+-- For an example of a whole module written in terms of this one, see+-- "XMonad.Hooks.RefocusLast".+--++-- }}}++-- --< Core >-- {{{++-- | The @PureX@ newtype over @ReaderT XConf (State XState) a@.+newtype PureX a = PureX (ReaderT XConf (State XState) a)+  deriving (Functor, Applicative, Monad, MonadReader XConf, MonadState XState)++instance Semigroup a => Semigroup (PureX a) where+  (<>) = liftA2 (<>)++instance Monoid a => Monoid (PureX a) where+  mappend = liftA2 mappend+  mempty  = return mempty++-- | The @XLike@ typeclass over monads reading @XConf@ values and tracking+--   @XState@ state.+class (MonadReader XConf m, MonadState XState m) => XLike m where+  toX :: m a -> X a++instance XLike X where+  toX = id++instance XLike PureX where+  toX = toXLike++-- | Consume a @PureX a@.+runPureX :: PureX a -> XConf -> XState -> (a, XState)+runPureX (PureX m) = runState . runReaderT m++-- | Despite appearing less general, @PureX a@ is actually isomorphic to+--   @XLike m => m a@.+toXLike :: XLike m => PureX a -> m a+toXLike pa = state =<< runPureX pa <$> ask++-- | A generalisation of 'windowBracket'. Handles refreshing for an action that+--   __performs no refresh of its own__ but can indicate that it needs one+--   through a return value that's tested against the supplied predicate. The+--   action can interleave changes to the @WindowSet@ with @IO@ or changes to+--   the @XState@.+windowBracket' :: XLike m => (a -> Bool) -> m a -> X a+windowBracket' p = windowBracket p . toX++-- | A version of @windowBracket'@ specialised to take a @PureX Any@ action and+--   handle windowset changes with a refresh when the @Any@ holds @True@.+--   Analogous to 'windowBracket_'. Don't bake this into your action; it's for+--   the end-user.+defile :: PureX Any -> X ()+defile = void . windowBracket' getAny++-- | A version of @windowBracket@ specialised to take an @X ()@ action and+--   perform a refresh handling any changes it makes.+handlingRefresh :: X () -> X ()+handlingRefresh = windowBracket (\_ -> True)++-- }}}++-- --< Utility >-- {{{++-- | A 'when' that accepts a monoidal return value.+when' :: (Monad m, Monoid a) => Bool -> m a -> m a+when' b ma = if b then ma else return mempty++-- | A @whenX@/@whenM@ that accepts a monoidal return value.+whenM' :: (Monad m, Monoid a) => m Bool -> m a -> m a+whenM' mb m = when' <$> mb >>= ($ m)++-- | A 'whenJust' that accepts a monoidal return value.+whenJust' :: (Monad m, Monoid b) => Maybe a -> (a -> m b) -> m b+whenJust' = flip $ maybe (return mempty)++-- | Akin to @<*@. Discarding the wrapped value in the second argument either+--   way, keep its effects iff the first argument returns @Any True@.+(<?) :: Monad m => m Any -> m a -> m Any+ifthis <? thenthis = do+  Any b <- ifthis+  when' b (Any b <$ thenthis)+infixl 4 <?++-- | Akin to a low precedence @<>@. Combines applicative effects left-to-right+--   and wrapped @Bool@s with @&&@ (instead of @||@).+(&>) :: Applicative f => f Any -> f Any -> f Any+(&>) = liftA2 $ \(Any b1) (Any b2) -> Any (b1 && b2)+infixl 1 &>++-- | A generalisation of 'withWindowSet'.+withWindowSet' :: XLike m => (WindowSet -> m a) -> m a+withWindowSet' = (=<< gets windowset)++-- | If there is a current tag and a focused window, perform an operation with+--   them, otherwise return mempty.+withFocii :: (XLike m, Monoid a) => (WorkspaceId -> Window -> m a) -> m a+withFocii f = join $ (whenJust' <$> peek) <*> (f <$> curTag)++-- | A generalisation of 'modifyWindowSet'.+modifyWindowSet' :: XLike m => (WindowSet -> WindowSet) -> m ()+modifyWindowSet' f = modify $ \xs -> xs { windowset = f (windowset xs) }++-- | A variant of @W.modify@ and @W.modify'@ handling the @Nothing@ and @Just@+--   cases uniformly.+modify''+  :: (Maybe (W.Stack a) -> Maybe (W.Stack a))+  -> (W.StackSet i l a s sd -> W.StackSet i l a s sd)+modify'' f = W.modify (f Nothing) (f . Just)++-- | Get the stack from the current workspace.+getStack :: XLike m => m (Maybe (W.Stack Window))+getStack = W.stack <$> curWorkspace++-- | Set the stack on the current workspace.+putStack :: XLike m => Maybe (W.Stack Window) -> m ()+putStack mst = modifyWindowSet' . modify'' $ \_ -> mst++-- | Get the focused window if there is one.+peek :: XLike m => m (Maybe Window)+peek = withWindowSet' (return . W.peek)++-- | Get the current screen.+curScreen+  :: XLike m+  => m (W.Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail)+curScreen = withWindowSet' (return . W.current)++-- | Get the current workspace.+curWorkspace :: XLike m => m WindowSpace+curWorkspace = W.workspace <$> curScreen++-- | Get the current tag.+curTag :: XLike m => m WorkspaceId+curTag = W.tag <$> curWorkspace++-- | Get the current @ScreenId@.+curScreenId :: XLike m => m ScreenId+curScreenId = W.screen <$> curScreen++-- | Internal. Refresh-tracking logic of view operations.+viewWith+  :: XLike m => (WorkspaceId -> WindowSet -> WindowSet) -> WorkspaceId -> m Any+viewWith viewer tag = do+  itag <- curTag+  when' (tag /= itag) $ do+    modifyWindowSet' (viewer tag)+    Any . (tag ==) <$> curTag++-- | A version of @W.view@ that tracks the need to refresh.+view :: XLike m => WorkspaceId -> m Any+view = viewWith W.view++-- | A version of @W.greedyView@ that tracks the need to refresh.+greedyView :: XLike m => WorkspaceId -> m Any+greedyView = viewWith W.greedyView++-- | View a workspace if it's not visible. An alternative to @view@ and+--   @greedyView@ that—rather than changing the current screen or affecting+--   another—opts not to act.+invisiView :: XLike m => WorkspaceId -> m Any+invisiView = viewWith $ \tag ws ->+  if   tag `elem` (W.tag . W.workspace <$> W.current ws : W.visible ws)+  then W.view tag ws+  else ws++-- | A refresh-tracking version of @W.Shift@.+shift :: XLike m => WorkspaceId -> m Any+shift tag = withFocii $ \ctag fw ->+  when' (tag /= ctag) $ do+    modifyWindowSet' (W.shiftWin tag fw)+    mfw' <- peek+    return (Any $ Just fw /= mfw')++-- }}}+
xmonad-contrib.cabal view
@@ -1,5 +1,5 @@ name:               xmonad-contrib-version:            0.14+version:            0.15 homepage:           http://xmonad.org/ synopsis:           Third party extensions for xmonad description:@@ -36,7 +36,7 @@ build-type:         Simple bug-reports:        https://github.com/xmonad/xmonad-contrib/issues -tested-with: GHC==7.8.4, GHC==7.10.3, GHC==8.0.1, GHC==8.2.2, GHC==8.4.3+tested-with: GHC==7.8.4, GHC==7.10.3, GHC==8.0.1, GHC==8.2.2, GHC==8.4.3, GHC==8.6.1  source-repository head   type:     git@@ -54,7 +54,7 @@ library     build-depends: base >= 4.5 && < 5,                    bytestring >= 0.10 && < 0.11,-                   containers >= 0.5 && < 0.6,+                   containers >= 0.5 && < 0.7,                    directory,                    extensible-exceptions,                    filepath,@@ -65,7 +65,7 @@                    mtl >= 1 && < 3,                    unix,                    X11>=1.6.1 && < 1.10,-                   xmonad>=0.14   && < 0.15,+                   xmonad >= 0.15 && < 0.16,                    utf8-string,                    semigroups @@ -329,6 +329,7 @@                         XMonad.Util.NoTaskbar                         XMonad.Util.Paste                         XMonad.Util.PositionStore+                        XMonad.Util.PureX                         XMonad.Util.Rectangle                         XMonad.Util.RemoteWindows                         XMonad.Util.Replace