{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}

-----------------------------------------------------------------------------
-- |
-- Module      :  XMonad.Layout.Groups
-- Description :  Modify the description of a layout in a flexible way.
-- Copyright   :  Quentin Moser <moserq@gmail.com>
-- License     :  BSD-style (see LICENSE)
--
-- Maintainer  :  orphaned
-- 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 :: [Rename a] -> l a -> ModifiedLayout Rename l a
renamed = Rename a -> l a -> ModifiedLayout Rename l a
forall (m :: * -> *) (l :: * -> *) a.
m a -> l a -> ModifiedLayout m l a
ModifiedLayout (Rename a -> l a -> ModifiedLayout Rename l a)
-> ([Rename a] -> Rename a)
-> [Rename a]
-> l a
-> ModifiedLayout Rename l a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Rename a] -> Rename a
forall a. [Rename a] -> Rename a
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
              | KeepWordsLeft Int -- ^ Keep a number of words from the left
              | KeepWordsRight Int -- ^ Keep 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 -- ^ Replace with another string
              | Chain [Rename a] -- ^ Apply a list of modifications in left-to-right order
  deriving (Int -> Rename a -> ShowS
[Rename a] -> ShowS
Rename a -> String
(Int -> Rename a -> ShowS)
-> (Rename a -> String) -> ([Rename a] -> ShowS) -> Show (Rename a)
forall a. Int -> Rename a -> ShowS
forall a. [Rename a] -> ShowS
forall a. Rename a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Rename a] -> ShowS
$cshowList :: forall a. [Rename a] -> ShowS
show :: Rename a -> String
$cshow :: forall a. Rename a -> String
showsPrec :: Int -> Rename a -> ShowS
$cshowsPrec :: forall a. Int -> Rename a -> ShowS
Show, ReadPrec [Rename a]
ReadPrec (Rename a)
Int -> ReadS (Rename a)
ReadS [Rename a]
(Int -> ReadS (Rename a))
-> ReadS [Rename a]
-> ReadPrec (Rename a)
-> ReadPrec [Rename a]
-> Read (Rename a)
forall a. ReadPrec [Rename a]
forall a. ReadPrec (Rename a)
forall a. Int -> ReadS (Rename a)
forall a. ReadS [Rename a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Rename a]
$creadListPrec :: forall a. ReadPrec [Rename a]
readPrec :: ReadPrec (Rename a)
$creadPrec :: forall a. ReadPrec (Rename a)
readList :: ReadS [Rename a]
$creadList :: forall a. ReadS [Rename a]
readsPrec :: Int -> ReadS (Rename a)
$creadsPrec :: forall a. Int -> ReadS (Rename a)
Read, Rename a -> Rename a -> Bool
(Rename a -> Rename a -> Bool)
-> (Rename a -> Rename a -> Bool) -> Eq (Rename a)
forall a. Rename a -> Rename a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Rename a -> Rename a -> Bool
$c/= :: forall a. Rename a -> Rename a -> Bool
== :: Rename a -> Rename a -> Bool
$c== :: forall a. Rename a -> Rename a -> Bool
Eq)

apply :: Rename a -> String -> String
apply :: Rename a -> ShowS
apply (CutLeft Int
i) String
s = Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
i String
s
apply (CutRight Int
i) String
s = Int -> ShowS
forall a. Int -> [a] -> [a]
take (String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
i) String
s
apply (CutWordsLeft Int
i) String
s = [String] -> String
unwords ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
drop Int
i ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ String -> [String]
words String
s
apply (CutWordsRight Int
i) String
s = let ws :: [String]
ws = String -> [String]
words String
s
                           in [String] -> String
unwords ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
take ([String] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
ws Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
i) [String]
ws
apply (KeepWordsLeft Int
i) String
s = [String] -> String
unwords ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
take Int
i ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ String -> [String]
words String
s
apply (KeepWordsRight Int
i) String
s = let ws :: [String]
ws = String -> [String]
words String
s
                           in [String] -> String
unwords ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
drop ([String] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
ws Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
i) [String]
ws
apply (Replace String
s) String
_ = String
s
apply (Append String
s') String
s = String
s String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s'
apply (Prepend String
s') String
s = String
s' String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s
apply (AppendWords String
s') String
s = [String] -> String
unwords ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ String -> [String]
words String
s [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
s']
apply (PrependWords String
s') String
s = [String] -> String
unwords ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ String
s' String -> [String] -> [String]
forall a. a -> [a] -> [a]
: String -> [String]
words String
s
apply (Chain [Rename a]
rs) String
s = (ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$String
s) (ShowS -> String) -> ShowS -> String
forall a b. (a -> b) -> a -> b
$ (Rename a -> ShowS -> ShowS) -> ShowS -> [Rename a] -> ShowS
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ((ShowS -> ShowS -> ShowS) -> ShowS -> ShowS -> ShowS
forall a b c. (a -> b -> c) -> b -> a -> c
flip ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
(.) (ShowS -> ShowS -> ShowS)
-> (Rename a -> ShowS) -> Rename a -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rename a -> ShowS
forall a. Rename a -> ShowS
apply) ShowS
forall a. a -> a
id [Rename a]
rs

instance LayoutModifier Rename a where
    modifyDescription :: Rename a -> l a -> String
modifyDescription Rename a
r l a
l = Rename a -> ShowS
forall a. Rename a -> ShowS
apply Rename a
r (l a -> String
forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> String
description l a
l)