{-# OPTIONS_GHC -fno-warn-missing-signatures #-}
{-# LANGUAGE MultiParamTypeClasses, Rank2Types #-}

-----------------------------------------------------------------------------
-- |
-- Module      :  XMonad.Layout.Groups.Wmii
-- Description :  A wmii-like layout algorithm.
-- Copyright   :  Quentin Moser <moserq@gmail.com>
-- License     :  BSD-style (see LICENSE)
--
-- Maintainer  :  orphaned
-- Stability   :  stable
-- Portability :  unportable
--
-- A wmii-like layout algorithm.
--
-----------------------------------------------------------------------------

module XMonad.Layout.Groups.Wmii ( -- * Usage
                                   -- $usage

                                   wmii
                                 , zoomGroupIn
                                 , zoomGroupOut
                                 , zoomGroupReset
                                 , toggleGroupFull
                                 , groupToNextLayout
                                 , groupToFullLayout
                                 , groupToTabbedLayout
                                 , groupToVerticalLayout

                                   -- * Useful re-exports
                                 , shrinkText
                                 , def
                                 , module XMonad.Layout.Groups.Helpers ) where

import XMonad

import qualified XMonad.Layout.Groups as G
import XMonad.Layout.Groups.Examples
import XMonad.Layout.Groups.Helpers

import XMonad.Layout.Tabbed
import XMonad.Layout.Renamed
import XMonad.Layout.MessageControl
import XMonad.Layout.Simplest


-- $usage
-- This module provides a layout inspired by the one used by the wmii
-- (<http://wmii.suckless.org>) window manager.
-- Windows are arranged into groups in a horizontal row, and each group can lay out
-- its windows
--
--   * by maximizing the focused one
--
--   * by tabbing them (wmii uses a stacked layout, but I'm too lazy to write it)
--
--   * by arranging them in a column.
--
-- As the groups are arranged in a 'ZoomRow', the relative width of each group can be
-- increased or decreased at will. Groups can also be set to use the whole screen
-- whenever they have focus.
--
-- You can use the contents of this module by adding
--
-- > import XMonad.Layout.Groups.Wmii
--
-- to the top of your @xmonad.hs@, and adding 'wmii'
-- (with a 'Shrinker' and decoration 'Theme' as
-- parameters) to your layout hook, for example:
--
-- > myLayout = wmii shrinkText def
--
-- To be able to zoom in and out of groups, change their inner layout, etc.,
-- create key bindings for the relevant actions:
--
-- > ((modMask, xK_f), toggleGroupFull)
--
-- and so on.
--
-- For more information on how to extend your layoutHook and key bindings, see
-- <https://xmonad.org/TUTORIAL.html the tutorial> and "XMonad.Doc.Extending".
--
-- Finally, you will probably want to be able to move focus and windows
-- between groups in a consistent fashion. For this, you should take a look
-- at the "XMonad.Layout.Groups.Helpers" module, whose contents are re-exported
-- by this module.

-- | A layout inspired by wmii
wmii :: p
-> Theme
-> Groups
     (ModifiedLayout
        Rename
        (ModifiedLayout
           (Decoration TabbedDecoration p)
           (Ignore
              ChangeLayout
              (Ignore
                 JumpToLayout
                 (ModifiedLayout
                    UnEscape
                    (Choose
                       (ModifiedLayout Rename Tall)
                       (Choose (ModifiedLayout Rename Simplest) Full)))))))
     (ZoomRow GroupEQ)
     Window
wmii p
s Theme
t = forall (l :: * -> *) (l2 :: * -> *).
l Window -> l2 (Group l Window) -> Groups l l2 Window
G.group ModifiedLayout
  Rename
  (ModifiedLayout
     (Decoration TabbedDecoration p)
     (Ignore
        ChangeLayout
        (Ignore
           JumpToLayout
           (ModifiedLayout
              UnEscape
              (Choose
                 (ModifiedLayout Rename Tall)
                 (Choose (ModifiedLayout Rename Simplest) Full))))))
  Window
innerLayout forall a (l :: * -> *).
(Eq a, Show a, Read a, Show (l a), Read (l a)) =>
ZoomRow GroupEQ (Group l a)
zoomRowG
    where column :: ModifiedLayout Rename Tall a
column = forall a (l :: * -> *).
[Rename a] -> l a -> ModifiedLayout Rename l a
renamed [forall a. String -> Rename a
Replace String
"Column"] forall a b. (a -> b) -> a -> b
$ forall a. Int -> Rational -> Rational -> Tall a
Tall Int
0 (Rational
3forall a. Fractional a => a -> a -> a
/Rational
100) (Rational
1forall a. Fractional a => a -> a -> a
/Rational
2)
          tabs :: ModifiedLayout Rename Simplest a
tabs = forall a (l :: * -> *).
[Rename a] -> l a -> ModifiedLayout Rename l a
renamed [forall a. String -> Rename a
Replace String
"Tabs"] forall a. Simplest a
Simplest
          innerLayout :: ModifiedLayout
  Rename
  (ModifiedLayout
     (Decoration TabbedDecoration p)
     (Ignore
        ChangeLayout
        (Ignore
           JumpToLayout
           (ModifiedLayout
              UnEscape
              (Choose
                 (ModifiedLayout Rename Tall)
                 (Choose (ModifiedLayout Rename Simplest) Full))))))
  Window
innerLayout = forall a (l :: * -> *).
[Rename a] -> l a -> ModifiedLayout Rename l a
renamed [forall a. Int -> Rename a
CutWordsLeft Int
3]
                        forall a b. (a -> b) -> a -> b
$ forall a (l :: * -> *) s.
(Eq a, LayoutClass l a, Shrinker s) =>
s
-> Theme
-> l a
-> ModifiedLayout (Decoration TabbedDecoration s) l a
addTabs p
s Theme
t
                        forall a b. (a -> b) -> a -> b
$ forall m (l :: * -> *) w.
(Message m, LayoutClass l w) =>
m -> l w -> Ignore m l w
ignore ChangeLayout
NextLayout
                        forall a b. (a -> b) -> a -> b
$ forall m (l :: * -> *) w.
(Message m, LayoutClass l w) =>
m -> l w -> Ignore m l w
ignore (String -> JumpToLayout
JumpToLayout String
"") forall a b. (a -> b) -> a -> b
$ forall (l :: * -> *) w.
LayoutClass l w =>
l w -> ModifiedLayout UnEscape l w
unEscape
                           forall a b. (a -> b) -> a -> b
$ forall {a}. ModifiedLayout Rename Tall a
column forall (l :: * -> *) a (r :: * -> *). l a -> r a -> Choose l r a
||| forall {a}. ModifiedLayout Rename Simplest a
tabs forall (l :: * -> *) a (r :: * -> *). l a -> r a -> Choose l r a
||| forall a. Full a
Full

-- | Increase the width of the focused group
zoomGroupIn :: X ()
zoomGroupIn :: X ()
zoomGroupIn = X ()
zoomColumnIn

-- | Decrease the size of the focused group
zoomGroupOut :: X ()
zoomGroupOut :: X ()
zoomGroupOut = X ()
zoomColumnOut

-- | Reset the size of the focused group to the default
zoomGroupReset :: X ()
zoomGroupReset :: X ()
zoomGroupReset = X ()
zoomColumnReset

-- | Toggle whether the currently focused group should be maximized
-- whenever it has focus.
toggleGroupFull :: X ()
toggleGroupFull :: X ()
toggleGroupFull = X ()
toggleColumnFull

-- | Rotate the layouts in the focused group.
groupToNextLayout :: X ()
groupToNextLayout :: X ()
groupToNextLayout = forall a. Message a => a -> X ()
sendMessage forall a b. (a -> b) -> a -> b
$ forall m. Message m => m -> EscapedMessage
escape ChangeLayout
NextLayout

-- | Switch the focused group to the \"maximized\" layout.
groupToFullLayout :: X ()
groupToFullLayout :: X ()
groupToFullLayout = forall a. Message a => a -> X ()
sendMessage forall a b. (a -> b) -> a -> b
$ forall m. Message m => m -> EscapedMessage
escape forall a b. (a -> b) -> a -> b
$ String -> JumpToLayout
JumpToLayout String
"Full"

-- | Switch the focused group to the \"tabbed\" layout.
groupToTabbedLayout :: X ()
groupToTabbedLayout :: X ()
groupToTabbedLayout = forall a. Message a => a -> X ()
sendMessage forall a b. (a -> b) -> a -> b
$ forall m. Message m => m -> EscapedMessage
escape forall a b. (a -> b) -> a -> b
$ String -> JumpToLayout
JumpToLayout String
"Tabs"

-- | Switch the focused group to the \"column\" layout.
groupToVerticalLayout :: X ()
groupToVerticalLayout :: X ()
groupToVerticalLayout = forall a. Message a => a -> X ()
sendMessage forall a b. (a -> b) -> a -> b
$ forall m. Message m => m -> EscapedMessage
escape forall a b. (a -> b) -> a -> b
$ String -> JumpToLayout
JumpToLayout String
"Column"