{-# 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
                             , named
                             , Rename(..) ) where

import XMonad
import XMonad.Layout.LayoutModifier

-- $usage
-- You can use this module by adding
--
-- > import XMonad.Layout.Renamed
--
-- to your @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 :: forall a (l :: * -> *).
[Rename a] -> l a -> ModifiedLayout Rename l a
renamed = forall (m :: * -> *) (l :: * -> *) a.
m a -> l a -> ModifiedLayout m l a
ModifiedLayout forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [Rename a] -> Rename a
Chain

-- | Rename a layout. (Convenience alias for @renamed [Replace s]@.)
named :: String -> l a -> ModifiedLayout Rename l a
named :: forall (l :: * -> *) a. String -> l a -> ModifiedLayout Rename l a
named String
s = forall a (l :: * -> *).
[Rename a] -> l a -> ModifiedLayout Rename l a
renamed [forall a. String -> Rename a
Replace String
s]

-- | 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
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)
ReadS [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
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 :: forall a. Rename a -> ShowS
apply (CutLeft Int
i) String
s = forall a. Int -> [a] -> [a]
drop Int
i String
s
apply (CutRight Int
i) String
s = forall a. Int -> [a] -> [a]
take (forall (t :: * -> *) a. Foldable t => t a -> Int
length String
s forall a. Num a => a -> a -> a
- Int
i) String
s
apply (CutWordsLeft Int
i) String
s = [String] -> String
unwords forall a b. (a -> b) -> a -> b
$ forall a. Int -> [a] -> [a]
drop Int
i 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 forall a b. (a -> b) -> a -> b
$ forall a. Int -> [a] -> [a]
take (forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
ws forall a. Num a => a -> a -> a
- Int
i) [String]
ws
apply (KeepWordsLeft Int
i) String
s = [String] -> String
unwords forall a b. (a -> b) -> a -> b
$ forall a. Int -> [a] -> [a]
take Int
i 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 forall a b. (a -> b) -> a -> b
$ forall a. Int -> [a] -> [a]
drop (forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
ws 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 forall a. [a] -> [a] -> [a]
++ String
s'
apply (Prepend String
s') String
s = String
s' forall a. [a] -> [a] -> [a]
++ String
s
apply (AppendWords String
s') String
s = [String] -> String
unwords forall a b. (a -> b) -> a -> b
$ String -> [String]
words String
s forall a. [a] -> [a] -> [a]
++ [String
s']
apply (PrependWords String
s') String
s = [String] -> String
unwords forall a b. (a -> b) -> a -> b
$ String
s' forall a. a -> [a] -> [a]
: String -> [String]
words String
s
apply (Chain [Rename a]
rs) String
s = (forall a b. (a -> b) -> a -> b
$ String
s) forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall b c a. (b -> c) -> (a -> b) -> a -> c
(.) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Rename a -> ShowS
apply) forall a. a -> a
id [Rename a]
rs

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