{-# 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.Named
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\/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 layout hook and key bindings, see
-- "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 = ModifiedLayout
  Rename
  (ModifiedLayout
     (Decoration TabbedDecoration p)
     (Ignore
        ChangeLayout
        (Ignore
           JumpToLayout
           (ModifiedLayout
              UnEscape
              (Choose
                 (ModifiedLayout Rename Tall)
                 (Choose (ModifiedLayout Rename Simplest) Full))))))
  Window
-> ZoomRow
     GroupEQ
     (Group
        (ModifiedLayout
           Rename
           (ModifiedLayout
              (Decoration TabbedDecoration p)
              (Ignore
                 ChangeLayout
                 (Ignore
                    JumpToLayout
                    (ModifiedLayout
                       UnEscape
                       (Choose
                          (ModifiedLayout Rename Tall)
                          (Choose (ModifiedLayout Rename Simplest) Full)))))))
        Window)
-> 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
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 ZoomRow
  GroupEQ
  (Group
     (ModifiedLayout
        Rename
        (ModifiedLayout
           (Decoration TabbedDecoration p)
           (Ignore
              ChangeLayout
              (Ignore
                 JumpToLayout
                 (ModifiedLayout
                    UnEscape
                    (Choose
                       (ModifiedLayout Rename Tall)
                       (Choose (ModifiedLayout Rename Simplest) Full)))))))
     Window)
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 = String -> Tall a -> ModifiedLayout Rename Tall a
forall (l :: * -> *) a. String -> l a -> ModifiedLayout Rename l a
named String
"Column" (Tall a -> ModifiedLayout Rename Tall a)
-> Tall a -> ModifiedLayout Rename Tall a
forall a b. (a -> b) -> a -> b
$ Int -> Rational -> Rational -> Tall a
forall a. Int -> Rational -> Rational -> Tall a
Tall Int
0 (Rational
3Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/Rational
100) (Rational
1Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/Rational
2)
          tabs :: ModifiedLayout Rename Simplest a
tabs = String -> Simplest a -> ModifiedLayout Rename Simplest a
forall (l :: * -> *) a. String -> l a -> ModifiedLayout Rename l a
named String
"Tabs" Simplest a
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 = [Rename Window]
-> ModifiedLayout
     (Decoration TabbedDecoration p)
     (Ignore
        ChangeLayout
        (Ignore
           JumpToLayout
           (ModifiedLayout
              UnEscape
              (Choose
                 (ModifiedLayout Rename Tall)
                 (Choose (ModifiedLayout Rename Simplest) Full)))))
     Window
-> ModifiedLayout
     Rename
     (ModifiedLayout
        (Decoration TabbedDecoration p)
        (Ignore
           ChangeLayout
           (Ignore
              JumpToLayout
              (ModifiedLayout
                 UnEscape
                 (Choose
                    (ModifiedLayout Rename Tall)
                    (Choose (ModifiedLayout Rename Simplest) Full))))))
     Window
forall a (l :: * -> *).
[Rename a] -> l a -> ModifiedLayout Rename l a
renamed [Int -> Rename Window
forall a. Int -> Rename a
CutWordsLeft Int
3]
                        (ModifiedLayout
   (Decoration TabbedDecoration p)
   (Ignore
      ChangeLayout
      (Ignore
         JumpToLayout
         (ModifiedLayout
            UnEscape
            (Choose
               (ModifiedLayout Rename Tall)
               (Choose (ModifiedLayout Rename Simplest) Full)))))
   Window
 -> ModifiedLayout
      Rename
      (ModifiedLayout
         (Decoration TabbedDecoration p)
         (Ignore
            ChangeLayout
            (Ignore
               JumpToLayout
               (ModifiedLayout
                  UnEscape
                  (Choose
                     (ModifiedLayout Rename Tall)
                     (Choose (ModifiedLayout Rename Simplest) Full))))))
      Window)
-> ModifiedLayout
     (Decoration TabbedDecoration p)
     (Ignore
        ChangeLayout
        (Ignore
           JumpToLayout
           (ModifiedLayout
              UnEscape
              (Choose
                 (ModifiedLayout Rename Tall)
                 (Choose (ModifiedLayout Rename Simplest) Full)))))
     Window
-> ModifiedLayout
     Rename
     (ModifiedLayout
        (Decoration TabbedDecoration p)
        (Ignore
           ChangeLayout
           (Ignore
              JumpToLayout
              (ModifiedLayout
                 UnEscape
                 (Choose
                    (ModifiedLayout Rename Tall)
                    (Choose (ModifiedLayout Rename Simplest) Full))))))
     Window
forall a b. (a -> b) -> a -> b
$ p
-> Theme
-> Ignore
     ChangeLayout
     (Ignore
        JumpToLayout
        (ModifiedLayout
           UnEscape
           (Choose
              (ModifiedLayout Rename Tall)
              (Choose (ModifiedLayout Rename Simplest) Full))))
     Window
-> ModifiedLayout
     (Decoration TabbedDecoration p)
     (Ignore
        ChangeLayout
        (Ignore
           JumpToLayout
           (ModifiedLayout
              UnEscape
              (Choose
                 (ModifiedLayout Rename Tall)
                 (Choose (ModifiedLayout Rename Simplest) Full)))))
     Window
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
                        (Ignore
   ChangeLayout
   (Ignore
      JumpToLayout
      (ModifiedLayout
         UnEscape
         (Choose
            (ModifiedLayout Rename Tall)
            (Choose (ModifiedLayout Rename Simplest) Full))))
   Window
 -> ModifiedLayout
      (Decoration TabbedDecoration p)
      (Ignore
         ChangeLayout
         (Ignore
            JumpToLayout
            (ModifiedLayout
               UnEscape
               (Choose
                  (ModifiedLayout Rename Tall)
                  (Choose (ModifiedLayout Rename Simplest) Full)))))
      Window)
-> Ignore
     ChangeLayout
     (Ignore
        JumpToLayout
        (ModifiedLayout
           UnEscape
           (Choose
              (ModifiedLayout Rename Tall)
              (Choose (ModifiedLayout Rename Simplest) Full))))
     Window
-> ModifiedLayout
     (Decoration TabbedDecoration p)
     (Ignore
        ChangeLayout
        (Ignore
           JumpToLayout
           (ModifiedLayout
              UnEscape
              (Choose
                 (ModifiedLayout Rename Tall)
                 (Choose (ModifiedLayout Rename Simplest) Full)))))
     Window
forall a b. (a -> b) -> a -> b
$ ChangeLayout
-> Ignore
     JumpToLayout
     (ModifiedLayout
        UnEscape
        (Choose
           (ModifiedLayout Rename Tall)
           (Choose (ModifiedLayout Rename Simplest) Full)))
     Window
-> Ignore
     ChangeLayout
     (Ignore
        JumpToLayout
        (ModifiedLayout
           UnEscape
           (Choose
              (ModifiedLayout Rename Tall)
              (Choose (ModifiedLayout Rename Simplest) Full))))
     Window
forall m (l :: * -> *) w.
(Message m, LayoutClass l w) =>
m -> l w -> Ignore m l w
ignore ChangeLayout
NextLayout
                        (Ignore
   JumpToLayout
   (ModifiedLayout
      UnEscape
      (Choose
         (ModifiedLayout Rename Tall)
         (Choose (ModifiedLayout Rename Simplest) Full)))
   Window
 -> Ignore
      ChangeLayout
      (Ignore
         JumpToLayout
         (ModifiedLayout
            UnEscape
            (Choose
               (ModifiedLayout Rename Tall)
               (Choose (ModifiedLayout Rename Simplest) Full))))
      Window)
-> Ignore
     JumpToLayout
     (ModifiedLayout
        UnEscape
        (Choose
           (ModifiedLayout Rename Tall)
           (Choose (ModifiedLayout Rename Simplest) Full)))
     Window
-> Ignore
     ChangeLayout
     (Ignore
        JumpToLayout
        (ModifiedLayout
           UnEscape
           (Choose
              (ModifiedLayout Rename Tall)
              (Choose (ModifiedLayout Rename Simplest) Full))))
     Window
forall a b. (a -> b) -> a -> b
$ JumpToLayout
-> ModifiedLayout
     UnEscape
     (Choose
        (ModifiedLayout Rename Tall)
        (Choose (ModifiedLayout Rename Simplest) Full))
     Window
-> Ignore
     JumpToLayout
     (ModifiedLayout
        UnEscape
        (Choose
           (ModifiedLayout Rename Tall)
           (Choose (ModifiedLayout Rename Simplest) Full)))
     Window
forall m (l :: * -> *) w.
(Message m, LayoutClass l w) =>
m -> l w -> Ignore m l w
ignore (String -> JumpToLayout
JumpToLayout String
"") (ModifiedLayout
   UnEscape
   (Choose
      (ModifiedLayout Rename Tall)
      (Choose (ModifiedLayout Rename Simplest) Full))
   Window
 -> Ignore
      JumpToLayout
      (ModifiedLayout
         UnEscape
         (Choose
            (ModifiedLayout Rename Tall)
            (Choose (ModifiedLayout Rename Simplest) Full)))
      Window)
-> ModifiedLayout
     UnEscape
     (Choose
        (ModifiedLayout Rename Tall)
        (Choose (ModifiedLayout Rename Simplest) Full))
     Window
-> Ignore
     JumpToLayout
     (ModifiedLayout
        UnEscape
        (Choose
           (ModifiedLayout Rename Tall)
           (Choose (ModifiedLayout Rename Simplest) Full)))
     Window
forall a b. (a -> b) -> a -> b
$ Choose
  (ModifiedLayout Rename Tall)
  (Choose (ModifiedLayout Rename Simplest) Full)
  Window
-> ModifiedLayout
     UnEscape
     (Choose
        (ModifiedLayout Rename Tall)
        (Choose (ModifiedLayout Rename Simplest) Full))
     Window
forall (l :: * -> *) w.
LayoutClass l w =>
l w -> ModifiedLayout UnEscape l w
unEscape
                           (Choose
   (ModifiedLayout Rename Tall)
   (Choose (ModifiedLayout Rename Simplest) Full)
   Window
 -> ModifiedLayout
      UnEscape
      (Choose
         (ModifiedLayout Rename Tall)
         (Choose (ModifiedLayout Rename Simplest) Full))
      Window)
-> Choose
     (ModifiedLayout Rename Tall)
     (Choose (ModifiedLayout Rename Simplest) Full)
     Window
-> ModifiedLayout
     UnEscape
     (Choose
        (ModifiedLayout Rename Tall)
        (Choose (ModifiedLayout Rename Simplest) Full))
     Window
forall a b. (a -> b) -> a -> b
$ ModifiedLayout Rename Tall Window
forall {a}. ModifiedLayout Rename Tall a
column ModifiedLayout Rename Tall Window
-> Choose (ModifiedLayout Rename Simplest) Full Window
-> Choose
     (ModifiedLayout Rename Tall)
     (Choose (ModifiedLayout Rename Simplest) Full)
     Window
forall (l :: * -> *) a (r :: * -> *). l a -> r a -> Choose l r a
||| ModifiedLayout Rename Simplest Window
forall {a}. ModifiedLayout Rename Simplest a
tabs ModifiedLayout Rename Simplest Window
-> Full Window
-> Choose (ModifiedLayout Rename Simplest) Full Window
forall (l :: * -> *) a (r :: * -> *). l a -> r a -> Choose l r a
||| Full Window
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 = EscapedMessage -> X ()
forall a. Message a => a -> X ()
sendMessage (EscapedMessage -> X ()) -> EscapedMessage -> X ()
forall a b. (a -> b) -> a -> b
$ ChangeLayout -> EscapedMessage
forall m. Message m => m -> EscapedMessage
escape ChangeLayout
NextLayout

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