Hello community, here is the log from the commit of package ghc-xmonad-contrib for openSUSE:Factory checked in at 2018-10-25 08:19:36 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/ghc-xmonad-contrib (Old) and /work/SRC/openSUSE:Factory/.ghc-xmonad-contrib.new (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "ghc-xmonad-contrib" Thu Oct 25 08:19:36 2018 rev:2 rq:642908 version:0.15 Changes: -------- --- /work/SRC/openSUSE:Factory/ghc-xmonad-contrib/ghc-xmonad-contrib.changes 2018-08-04 21:53:49.005323870 +0200 +++ /work/SRC/openSUSE:Factory/.ghc-xmonad-contrib.new/ghc-xmonad-contrib.changes 2018-10-25 08:19:38.507983800 +0200 @@ -1,0 +2,42 @@ +Thu Oct 4 09:42:58 UTC 2018 - psim...@suse.com + +- Update xmonad-contrib to version 0.15. + ## 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`. + +------------------------------------------------------------------- @@ -5 +46,0 @@ - Old: ---- xmonad-contrib-0.14.tar.gz New: ---- xmonad-contrib-0.15.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ ghc-xmonad-contrib.spec ++++++ --- /var/tmp/diff_new_pack.pESICg/_old 2018-10-25 08:19:40.003983137 +0200 +++ /var/tmp/diff_new_pack.pESICg/_new 2018-10-25 08:19:40.007983135 +0200 @@ -12,13 +12,13 @@ # license that conforms to the Open Source Definition (Version 1.9) # published by the Open Source Initiative. -# Please submit bugfixes or comments via http://bugs.opensuse.org/ +# Please submit bugfixes or comments via https://bugs.opensuse.org/ # %global pkg_name xmonad-contrib Name: ghc-%{pkg_name} -Version: 0.14 +Version: 0.15 Release: 0 Summary: Third party extensions for xmonad License: BSD-3-Clause ++++++ xmonad-contrib-0.14.tar.gz -> xmonad-contrib-0.15.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/xmonad-contrib-0.14/CHANGES.md new/xmonad-contrib-0.15/CHANGES.md --- old/xmonad-contrib-0.14/CHANGES.md 2018-07-31 15:53:27.000000000 +0200 +++ new/xmonad-contrib-0.15/CHANGES.md 1970-01-01 01:00:00.000000000 +0100 @@ -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 diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/xmonad-contrib-0.14/XMonad/Actions/MessageFeedback.hs new/xmonad-contrib-0.15/XMonad/Actions/MessageFeedback.hs --- old/xmonad-contrib-0.14/XMonad/Actions/MessageFeedback.hs 2018-07-31 15:53:27.000000000 +0200 +++ new/xmonad-contrib-0.15/XMonad/Actions/MessageFeedback.hs 1970-01-01 01:00:00.000000000 +0100 @@ -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 () diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/xmonad-contrib-0.14/XMonad/Actions/PhysicalScreens.hs new/xmonad-contrib-0.15/XMonad/Actions/PhysicalScreens.hs --- old/xmonad-contrib-0.14/XMonad/Actions/PhysicalScreens.hs 2018-07-31 15:53:27.000000000 +0200 +++ new/xmonad-contrib-0.15/XMonad/Actions/PhysicalScreens.hs 1970-01-01 01:00:00.000000000 +0100 @@ -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". diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/xmonad-contrib-0.14/XMonad/Hooks/DebugEvents.hs new/xmonad-contrib-0.15/XMonad/Hooks/DebugEvents.hs --- old/xmonad-contrib-0.14/XMonad/Hooks/DebugEvents.hs 2018-07-31 15:53:27.000000000 +0200 +++ new/xmonad-contrib-0.15/XMonad/Hooks/DebugEvents.hs 1970-01-01 01:00:00.000000000 +0100 @@ -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 diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/xmonad-contrib-0.14/XMonad/Layout/Fullscreen.hs new/xmonad-contrib-0.15/XMonad/Layout/Fullscreen.hs --- old/xmonad-contrib-0.14/XMonad/Layout/Fullscreen.hs 2018-07-31 15:53:27.000000000 +0200 +++ new/xmonad-contrib-0.15/XMonad/Layout/Fullscreen.hs 1970-01-01 01:00:00.000000000 +0100 @@ -30,17 +30,19 @@ ,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 @@ -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) @@ -240,15 +245,6 @@ 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 orP f g (x, y) = f x || g y diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/xmonad-contrib-0.14/XMonad/Layout/Groups/Helpers.hs new/xmonad-contrib-0.15/XMonad/Layout/Groups/Helpers.hs --- old/xmonad-contrib-0.14/XMonad/Layout/Groups/Helpers.hs 2018-07-31 15:53:27.000000000 +0200 +++ new/xmonad-contrib-0.15/XMonad/Layout/Groups/Helpers.hs 1970-01-01 01:00:00.000000000 +0100 @@ -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 diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/xmonad-contrib-0.14/XMonad/Layout/Groups.hs new/xmonad-contrib-0.15/XMonad/Layout/Groups.hs --- old/xmonad-contrib-0.14/XMonad/Layout/Groups.hs 2018-07-31 15:53:27.000000000 +0200 +++ new/xmonad-contrib-0.15/XMonad/Layout/Groups.hs 1970-01-01 01:00:00.000000000 +0100 @@ -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 diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/xmonad-contrib-0.14/XMonad/Prompt.hs new/xmonad-contrib-0.15/XMonad/Prompt.hs --- old/xmonad-contrib-0.14/XMonad/Prompt.hs 2018-07-31 15:53:27.000000000 +0200 +++ new/xmonad-contrib-0.15/XMonad/Prompt.hs 1970-01-01 01:00:00.000000000 +0100 @@ -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. diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/xmonad-contrib-0.14/XMonad/Util/ExtensibleState.hs new/xmonad-contrib-0.15/XMonad/Util/ExtensibleState.hs --- old/xmonad-contrib-0.14/XMonad/Util/ExtensibleState.hs 2018-07-31 15:53:27.000000000 +0200 +++ new/xmonad-contrib-0.15/XMonad/Util/ExtensibleState.hs 1970-01-01 01:00:00.000000000 +0100 @@ -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 diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/xmonad-contrib-0.14/XMonad/Util/PureX.hs new/xmonad-contrib-0.15/XMonad/Util/PureX.hs --- old/xmonad-contrib-0.14/XMonad/Util/PureX.hs 1970-01-01 01:00:00.000000000 +0100 +++ new/xmonad-contrib-0.15/XMonad/Util/PureX.hs 1970-01-01 01:00:00.000000000 +0100 @@ -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') + +-- }}} + diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/xmonad-contrib-0.14/xmonad-contrib.cabal new/xmonad-contrib-0.15/xmonad-contrib.cabal --- old/xmonad-contrib-0.14/xmonad-contrib.cabal 2018-07-31 15:53:27.000000000 +0200 +++ new/xmonad-contrib-0.15/xmonad-contrib.cabal 1970-01-01 01:00:00.000000000 +0100 @@ -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