aboutsummaryrefslogtreecommitdiffstats
path: root/XMonad/Util
diff options
context:
space:
mode:
authorquentin.moser <quentin.moser@unifr.ch>2010-01-17 01:21:04 +0100
committerquentin.moser <quentin.moser@unifr.ch>2010-01-17 01:21:04 +0100
commitfea3cf2c9db76dce6a7eb18b638e0a6efa4befd6 (patch)
treedb49dbeff1e9aa65bd84ddffb394a57b0577c47f /XMonad/Util
parent22531f2914139818e98fc08b14b5a9dfb8c292bb (diff)
downloadXMonadContrib-fea3cf2c9db76dce6a7eb18b638e0a6efa4befd6.tar.gz
XMonadContrib-fea3cf2c9db76dce6a7eb18b638e0a6efa4befd6.tar.xz
XMonadContrib-fea3cf2c9db76dce6a7eb18b638e0a6efa4befd6.zip
New module: X.U.Stack
Ignore-this: e0c3969042ca5e1e8b9e50436519e52a Utility functions for working with Maybe Stacks, including: - useful conversions to and from lists - insertUp/Down, swapUp/Down, focusUp/Down, etc - maps, filters and folds darcs-hash:20100117002104-5ccef-eb425a7d8e0d0adff233997a15a4bfc88eb5311c.gz
Diffstat (limited to 'XMonad/Util')
-rw-r--r--XMonad/Util/Stack.hs340
1 files changed, 340 insertions, 0 deletions
diff --git a/XMonad/Util/Stack.hs b/XMonad/Util/Stack.hs
new file mode 100644
index 0000000..8feeb2d
--- /dev/null
+++ b/XMonad/Util/Stack.hs
@@ -0,0 +1,340 @@
+{-# LANGUAGE PatternGuards #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module : XMonad.Util.Stack
+-- Copyright : Quentin Moser <moserq@gmail.com>
+-- License : BSD-style (see LICENSE)
+--
+-- Maintainer : Quentin Moser <quentin.moser@unifr.ch>
+-- Stability : unstable
+-- Portability : unportable
+--
+-- Utility functions for manipulating @Maybe Stack@s.
+--
+-----------------------------------------------------------------------------
+
+module XMonad.Util.Stack ( -- * Usage
+ -- | This is a developer-oriented module, intended to be used
+ -- for writing new extentions.
+ Zipper
+ , emptyZ
+ , singletonZ
+
+ -- * Conversions
+ , fromIndex
+ , toIndex
+ , fromTags
+ , toTags
+
+ -- * 'Zipper' manipulation functions
+ -- ** Insertion, movement
+ , insertUpZ
+ , insertDownZ
+ , swapUpZ
+ , swapDownZ
+ , swapMasterZ
+ -- ** Focus movement
+ , focusUpZ
+ , focusDownZ
+ , focusMasterZ
+ -- ** Extraction
+ , getFocusZ
+ , getIZ
+ -- ** Sorting
+ , sortZ
+ , sortByZ
+ -- ** Maps
+ , mapZ
+ , mapZ_
+ , mapZM
+ , mapZM_
+ , onFocusedZ
+ , onFocusedZM
+ , onIndexZ
+ , onIndexZM
+ -- ** Filters
+ , filterZ
+ , filterZ_
+ , deleteFocusedZ
+ , deleteIndexZ
+ -- ** Folds
+ , foldrZ
+ , foldlZ
+ , foldrZ_
+ , foldlZ_
+ , elemZ
+
+ -- * Other utility functions
+ , getI
+ , tagBy
+ , fromE
+ , mapE
+ , mapE_
+ , mapEM
+ , mapEM_
+ ) where
+
+import qualified XMonad.StackSet as W
+import Control.Monad (liftM)
+import Data.List (sortBy)
+
+
+
+type Zipper a = Maybe (W.Stack a)
+
+emptyZ :: Zipper a
+emptyZ = Nothing
+
+singletonZ :: a -> Zipper a
+singletonZ a = Just $ W.Stack a [] []
+
+-- * Conversions
+
+-- | Create a stack from a list, and the 0-based index of the focused element.
+-- If the index is out of bounds, focus will go to the first element.
+fromIndex :: [a] -> Int -> Zipper a
+fromIndex as i = fromTags $ zipWith ($) (replicate i Left ++ [Right] ++ repeat Left) as
+
+-- | Turn a stack into a list and the index of its focused element.
+toIndex :: Zipper a -> ([a], Maybe Int)
+toIndex Nothing = ([], Nothing)
+toIndex (Just s) = (W.integrate s, Just $ length $ W.up s)
+
+-- | Create a stack from a list of 'Either'-tagged values. Focus will go to
+-- the first 'Right' value, or if there is none, to the first 'Left' one.
+fromTags :: [Either a a] -> Zipper a
+fromTags = finalize . foldr step ([], Nothing, [])
+ where step (Right a) (u, Just f, d) = ([], Just a, u++f:d)
+ step (Right a) (u, Nothing, d) = (u, Just a, d)
+ step (Left a) (u, Just f, d) = (a:u, Just f, d)
+ step (Left a) (u, Nothing, d) = (u, Nothing, a:d)
+ finalize (u, Just f, d) = Just $ W.Stack f (reverse u) d
+ finalize (u, Nothing, a:d) = Just $ W.Stack a (reverse u) d
+ finalize (_, Nothing, []) = Nothing
+
+-- | Turn a stack into an 'Either'-tagged list. The focused element
+-- will be tagged with 'Right', the others with 'Left'.
+toTags :: Zipper a -> [Either a a]
+toTags Nothing = []
+toTags (Just s) = map Left (reverse . W.up $ s) ++ [Right . W.focus $ s]
+ ++ map Left (W.down s)
+
+
+-- * Zipper functions
+
+-- ** Insertion, movement
+
+-- | Insert an element before the focused one, and focus it
+insertUpZ :: a -> Zipper a -> Zipper a
+insertUpZ a Nothing = W.differentiate [a]
+insertUpZ a (Just s) = Just s { W.focus = a , W.down = W.focus s : W.down s }
+
+-- | Insert an element after the focused one, and focus it
+insertDownZ :: a -> Zipper a -> Zipper a
+insertDownZ a Nothing = W.differentiate [a]
+insertDownZ a (Just s) = Just s { W.focus = a, W.up = W.focus s : W.up s }
+
+-- | Swap the focused element with the previous one
+swapUpZ :: Zipper a -> Zipper a
+swapUpZ Nothing = Nothing
+swapUpZ (Just s) | u:up <- W.up s = Just s { W.up = up, W.down = u:W.down s}
+swapUpZ (Just s) = Just s { W.up = reverse (W.down s), W.down = [] }
+
+-- | Swap the focused element with the next one
+swapDownZ :: Zipper a -> Zipper a
+swapDownZ Nothing = Nothing
+swapDownZ (Just s) | d:down <- W.down s = Just s { W.down = down, W.up = d:W.up s }
+swapDownZ (Just s) = Just s { W.up = [], W.down = reverse (W.up s) }
+
+-- | Swap the focused element with the first one
+swapMasterZ :: Zipper a -> Zipper a
+swapMasterZ Nothing = Nothing
+swapMasterZ (Just (W.Stack f up down)) = Just $ W.Stack f [] (reverse up ++ down)
+
+-- ** Focus movement
+
+-- | Move the focus to the previous element
+focusUpZ :: Zipper a -> Zipper a
+focusUpZ Nothing = Nothing
+focusUpZ (Just s) | u:up <- W.up s = Just $ W.Stack u up (W.focus s:W.down s)
+focusUpZ (Just s) | null $ W.down s = Just s
+focusUpZ (Just (W.Stack f _ down)) = Just $ W.Stack (last down) (reverse (init down) ++ [f]) []
+
+-- | Move the focus to the next element
+focusDownZ :: Zipper a -> Zipper a
+focusDownZ Nothing = Nothing
+focusDownZ (Just s) | d:down <- W.down s = Just $ W.Stack d (W.focus s:W.up s) down
+focusDownZ (Just s) | null $ W.up s = Just s
+focusDownZ (Just (W.Stack f up _)) = Just $ W.Stack (last up) [] (reverse (init up) ++ [f])
+
+-- | Move the focus to the first element
+focusMasterZ :: Zipper a -> Zipper a
+focusMasterZ Nothing = Nothing
+focusMasterZ (Just (W.Stack f up down)) | not $ null up
+ = Just $ W.Stack (last up) [] (reverse (init up) ++ [f] ++ down)
+focusMasterZ (Just s) = Just s
+
+-- ** Extraction
+
+-- | Get the focused element
+getFocusZ :: Zipper a -> Maybe a
+getFocusZ = fmap W.focus
+
+-- | Get the element at a given index
+getIZ :: Int -> Zipper a -> Maybe a
+getIZ i = getI i . W.integrate'
+
+-- ** Sorting
+
+-- | Sort a stack of elements supporting 'Ord'
+sortZ :: Ord a => Zipper a -> Zipper a
+sortZ = sortByZ compare
+
+-- | Sort a stack with an arbitrary sorting function
+sortByZ :: (a -> a -> Ordering) -> Zipper a -> Zipper a
+sortByZ f = fromTags . sortBy (adapt f) . toTags
+ where adapt g e1 e2 = g (fromE e1) (fromE e2)
+
+-- ** Maps
+
+-- | Map a function over a stack. The boolean argument indcates whether
+-- the current element is the focused one
+mapZ :: (Bool -> a -> b) -> Zipper a -> Zipper b
+mapZ f as = fromTags . map (mapE f) . toTags $ as
+
+-- | 'mapZ' without the 'Bool' argument
+mapZ_ :: (a -> b) -> Zipper a -> Zipper b
+mapZ_ = mapZ . const
+
+-- | Monadic version of 'mapZ'
+mapZM :: Monad m => (Bool -> a -> m b) -> Zipper a -> m (Zipper b)
+mapZM f as = fromTags `liftM` (mapM (mapEM f) . toTags) as
+
+
+-- | Monadic version of 'mapZ_'
+mapZM_ :: Monad m => (a -> m b) -> Zipper a -> m (Zipper b)
+mapZM_ = mapZM . const
+
+-- | Apply a function to the focused element
+onFocusedZ :: (a -> a) -> Zipper a -> Zipper a
+onFocusedZ f = mapZ $ \b a -> if b then f a else a
+
+-- | Monadic version of 'onFocusedZ'
+onFocusedZM :: Monad m => (a -> m a) -> Zipper a -> m (Zipper a)
+onFocusedZM f = mapZM $ \b a -> if b then f a else return a
+
+-- | Apply a function to the element at the given index
+onIndexZ :: Int -> (a -> a) -> Zipper a -> Zipper a
+onIndexZ i _ as | i < 0 = as
+onIndexZ i f as = case splitAt i $ toTags as of
+ (before, []) -> fromTags before
+ (before, a:after) -> fromTags $ before ++ mapE (const f) a : after
+
+-- | Monadic version of 'onIndexZ'
+onIndexZM :: Monad m => Int -> (a -> m a) -> Zipper a -> m (Zipper a)
+onIndexZM i f as = case splitAt i $ toTags as of
+ (before, []) -> return $ fromTags before
+ (before, a:after) -> do a' <- mapEM (const f) a
+ return $ fromTags $ before ++ a' : after
+
+-- ** Filters
+
+-- | Fiter a stack according to a predicate. The refocusing behavior
+-- mimics XMonad's usual one. The boolean argument indicates whether the current
+-- element is the focused one.
+filterZ :: (Bool -> a -> Bool) -> Zipper a -> Zipper a
+filterZ _ Nothing = Nothing
+filterZ p (Just s) = case ( p True (W.focus s)
+ , filter (p False) (W.up s)
+ , filter (p False) (W.down s) ) of
+ (True, up', down') -> Just s { W.up = up', W.down = down' }
+ (False, [], []) -> Nothing
+ (False, f:up', []) -> Just s { W.focus = f, W.up = up', W.down = [] }
+ (False, up', f:down') -> Just s { W.focus = f
+ , W.up = up'
+ , W.down = down' }
+
+-- | 'filterZ' without the 'Bool' argument
+filterZ_ :: (a -> Bool) -> Zipper a -> Zipper a
+filterZ_ = filterZ . const
+
+-- | Delete the focused element
+deleteFocusedZ :: Zipper a -> Zipper a
+deleteFocusedZ = filterZ (\b _ -> not b)
+
+-- | Delete the ith element
+deleteIndexZ :: Int -> Zipper a -> Zipper a
+deleteIndexZ i z = let numbered = (fromTags . zipWith number [0..] . toTags) z
+ number j ea = mapE (\_ a -> (j,a)) ea
+ in mapZ_ snd $ filterZ_ ((/=i) . fst) numbered
+
+-- ** Folds
+
+-- | Analogous to 'foldr'. The 'Bool' argument to the step functions indicates
+-- whether the current element is the focused one
+foldrZ :: (Bool -> a -> b -> b) -> b -> Zipper a -> b
+foldrZ _ b Nothing = b
+foldrZ f b (Just s) = let b1 = foldr (f False) b (W.down s)
+ b2 = f True (W.focus s) b1
+ b3 = foldl (flip $ f False) b2 (W.up s)
+ in b3
+
+-- | Analogous to 'foldl'. The 'Bool' argument to the step functions indicates
+-- whether the current element is the focused one
+foldlZ :: (Bool -> b -> a -> b) -> b -> Zipper a -> b
+foldlZ _ b Nothing = b
+foldlZ f b (Just s) = let b1 = foldr (flip $ f False) b (W.up s)
+ b2 = f True b1 (W.focus s)
+ b3 = foldl (f False) b2 (W.down s)
+ in b3
+
+-- | 'foldrZ' without the 'Bool' argument.
+foldrZ_ :: (a -> b -> b) -> b -> Zipper a -> b
+foldrZ_ = foldrZ . const
+
+-- | 'foldlZ' without the 'Bool' argument.
+foldlZ_ :: (b -> a -> b) -> b -> Zipper a -> b
+foldlZ_ = foldlZ . const
+
+-- | Find whether an element is present in a stack.
+elemZ :: Eq a => a -> Zipper a -> Bool
+elemZ a as = foldlZ_ step False as
+ where step True _ = True
+ step False a' = a' == a
+
+
+-- * Other utility functions
+
+-- | Safe version of '!!'
+getI :: Int -> [a] -> Maybe a
+getI _ [] = Nothing
+getI 0 (a:_) = Just a
+getI i (_:as) = getI (i-1) as
+
+-- | Map a function across both 'Left's and 'Right's.
+-- The 'Bool' argument is 'True' in a 'Right', 'False'
+-- in a 'Left'.
+mapE :: (Bool -> a -> b) -> Either a a -> Either b b
+mapE f (Left a) = Left $ f False a
+mapE f (Right a) = Right $ f True a
+
+mapE_ :: (a -> b) -> Either a a -> Either b b
+mapE_ = mapE . const
+
+-- | Monadic version of 'mapE'
+mapEM :: Monad m => (Bool -> a -> m b) -> Either a a -> m (Either b b)
+mapEM f (Left a) = Left `liftM` f False a
+mapEM f (Right a) = Right `liftM` f True a
+
+mapEM_ :: Monad m => (a -> m b) -> Either a a -> m (Either b b)
+mapEM_ = mapEM . const
+
+-- | Get the @a@ from an @Either a a@
+fromE :: Either a a -> a
+fromE (Right a) = a
+fromE (Left a) = a
+
+-- | Tag the element with 'Right' if the property is true, 'Left' otherwise
+tagBy :: (a -> Bool) -> a -> Either a a
+tagBy p a = if p a then Right a else Left a