New module: X.L.Renamed

XMonad/Layout/Renamed.hs

@@ -0,0 +1,71 @@
+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Layout.Groups
+-- Copyright   :  Quentin Moser <moserq@gmail.com>
+-- License     :  BSD-style (see LICENSE)
+--
+-- Maintainer  :  Quentin Moser <moserq@gmail.com>
+-- Stability   :  unstable
+-- Portability :  unportable
+--
+-- Layout modifier that can modify the description of its underlying
+-- layout on a (hopefully) flexible way.
+--
+-----------------------------------------------------------------------------
+
+module XMonad.Layout.Renamed ( -- * Usage
+                               -- $usage
+                               renamed
+                             , Rename(..) ) where
+
+import XMonad
+import XMonad.Layout.LayoutModifier
+
+-- $usage
+-- You can use this module by adding 
+--
+-- > import XMonad.Layout.Renamed
+--
+-- to your @~\/.xmonad\/xmonad.hs@.
+--
+-- You can then use 'renamed' to modify the description of your
+-- layouts. For example:
+--
+-- > myLayout = renamed [PrependWords "Awesome"] $ tiled ||| Mirror tiled ||| Full
+
+-- | Apply a list of 'Rename' values to a layout, from left to right.
+renamed :: [Rename a] -> l a -> ModifiedLayout Rename l a
+renamed = ModifiedLayout . Chain
+
+-- | The available renaming operations
+data Rename a = CutLeft Int -- ^ Remove a number of characters from the left
+              | CutRight Int -- ^ Remove a number of characters from the right
+              | Append String -- ^ Add a string on the right
+              | Prepend String -- ^ Add a string on the left
+              | CutWordsLeft Int -- ^ Remove a number of words from the left
+              | CutWordsRight Int -- ^ Remove a number of words from the right
+              | AppendWords String -- ^ Add a string to the right, prepending a space to it
+                                   -- if necessary
+              | PrependWords String -- ^ Add a string to the left, appending a space to it if
+                                    -- necessary
+              | Replace String -- ^ Repace with another wtring
+              | Chain [Rename a] -- ^ Apply a list of modifications in left-to-right order
+  deriving (Show, Read, Eq)
+
+apply :: Rename a -> String -> String
+apply (CutLeft i) s = drop i s
+apply (CutRight i) s = take (length s - i) s
+apply (CutWordsLeft i) s = unwords $ drop i $ words s
+apply (CutWordsRight i) s = let ws = words s
+                           in unwords $ take (length ws - i) ws
+apply (Replace s) _ = s
+apply (Append s') s = s ++ s'
+apply (Prepend s') s = s' ++ s
+apply (AppendWords s') s = unwords $ words s ++ [s']
+apply (PrependWords s') s = unwords $ s' : words s
+apply (Chain rs) s = ($s) $ foldr (flip (.)) id $ map apply rs
+
+instance LayoutModifier Rename a where
+    modifyDescription r l = apply r (description l)