{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, PatternGuards, TypeSynonymInstances #-}

-----------------------------------------------------------------------------
-- |
-- Module      :  XMonad.Layout.Tabbed
-- Copyright   :  (c) 2007 David Roundy, Andrea Rossato
-- License     :  BSD-style (see xmonad/LICENSE)
--
-- Maintainer  :  andrea.rossato@unibz.it
-- Stability   :  unstable
-- Portability :  unportable
--
-- A tabbed layout for the Xmonad Window Manager
--
-----------------------------------------------------------------------------

module XMonad.Layout.Tabbed
    ( -- * Usage:
      -- $usage
      simpleTabbed, tabbed, addTabs
    , simpleTabbedAlways, tabbedAlways, addTabsAlways
    , simpleTabbedBottom, tabbedBottom, addTabsBottom
    , simpleTabbedLeft, tabbedLeft, addTabsLeft
    , simpleTabbedRight, tabbedRight, addTabsRight
    , simpleTabbedBottomAlways, tabbedBottomAlways, addTabsBottomAlways
    , simpleTabbedLeftAlways, tabbedLeftAlways, addTabsLeftAlways
    , simpleTabbedRightAlways, tabbedRightAlways, addTabsRightAlways
    , Theme (..)
    , def
    , defaultTheme
    , TabbedDecoration (..)
    , shrinkText, CustomShrink(CustomShrink)
    , Shrinker(..)
    , TabbarShown, Direction2D(..)
    ) where

import Data.List

import XMonad
import qualified XMonad.StackSet as S
import XMonad.Layout.Decoration
import XMonad.Layout.Simplest ( Simplest(Simplest) )
import XMonad.Util.Types (Direction2D(..))

-- $usage
-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
--
-- > import XMonad.Layout.Tabbed
--
-- Then edit your @layoutHook@ by adding the Tabbed layout:
--
-- > myLayout = simpleTabbed ||| Full ||| etc..
--
-- or, if you want a specific theme for you tabbed layout:
--
-- > myLayout = tabbed shrinkText def ||| Full ||| etc..
--
-- and then:
--
-- > main = xmonad def { layoutHook = myLayout }
--
-- This layout has hardcoded behaviour for mouse clicks on tab decorations:
-- Left click on the tab switches focus to that window.
-- Middle click on the tab closes the window.
--
-- The default Tabbar behaviour is to hide it when only one window is open
-- on the workspace.  To have it always shown, use one of the layouts or
-- modifiers ending in @Always@.
--
-- For more detailed instructions on editing the layoutHook see:
--
-- "XMonad.Doc.Extending#Editing_the_layout_hook"
--
-- You can also edit the default configuration options.
--
-- > myTabConfig = def { inactiveBorderColor = "#FF0000"
-- >                   , activeTextColor = "#00FF00"}
--
-- and
--
-- > mylayout = tabbed shrinkText myTabConfig ||| Full ||| etc..

-- Layouts

-- | A tabbed layout with the default xmonad Theme.
--
-- This is a minimal working configuration:
--
-- > import XMonad
-- > import XMonad.Layout.Tabbed
-- > main = xmonad def { layoutHook = simpleTabbed }
simpleTabbed :: ModifiedLayout (Decoration TabbedDecoration DefaultShrinker) Simplest Window
simpleTabbed = tabbed shrinkText def

simpleTabbedAlways :: ModifiedLayout (Decoration TabbedDecoration DefaultShrinker) Simplest Window
simpleTabbedAlways = tabbedAlways shrinkText def

-- | A bottom-tabbed layout with the default xmonad Theme.
simpleTabbedBottom :: ModifiedLayout (Decoration TabbedDecoration DefaultShrinker) Simplest Window
simpleTabbedBottom = tabbedBottom shrinkText def

-- | A bottom-tabbed layout with the default xmonad Theme.
simpleTabbedBottomAlways :: ModifiedLayout (Decoration TabbedDecoration DefaultShrinker) Simplest Window
simpleTabbedBottomAlways = tabbedBottomAlways shrinkText def

-- | A side-tabbed layout with the default xmonad Theme.
simpleTabbedLeft, simpleTabbedRight :: ModifiedLayout (Decoration TabbedDecoration DefaultShrinker) 
                                        Simplest Window
simpleTabbedLeft = tabbedLeft shrinkText def
simpleTabbedRight = tabbedRight shrinkText def

-- | A side-tabbed layout with the default xmonad Theme.
simpleTabbedLeftAlways, simpleTabbedRightAlways :: ModifiedLayout (Decoration TabbedDecoration DefaultShrinker) 
                                                  Simplest Window
simpleTabbedLeftAlways = tabbedLeftAlways shrinkText def
simpleTabbedRightAlways = tabbedRightAlways shrinkText def

-- | A layout decorated with tabs and the possibility to set a custom
-- shrinker and theme.
tabbed     :: (Eq a, Shrinker s) => s -> Theme
           -> ModifiedLayout (Decoration TabbedDecoration s) Simplest a
tabbed s c = addTabs s c Simplest

tabbedAlways     :: (Eq a, Shrinker s) => s -> Theme
                 -> ModifiedLayout (Decoration TabbedDecoration s) Simplest a
tabbedAlways s c = addTabsAlways s c Simplest

-- | A layout decorated with tabs at the bottom and the possibility to set a custom
-- shrinker and theme.
tabbedBottom     :: (Eq a, Shrinker s) => s -> Theme
                 -> ModifiedLayout (Decoration TabbedDecoration s) Simplest a
tabbedBottom s c = addTabsBottom s c Simplest

tabbedBottomAlways     :: (Eq a, Shrinker s) => s -> Theme
                       -> ModifiedLayout (Decoration TabbedDecoration s) Simplest a
tabbedBottomAlways s c = addTabsBottomAlways s c Simplest

-- | A layout decorated with tabs and the possibility to set a custom
-- shrinker and theme.
tabbedLeft, tabbedRight :: (Eq a, Shrinker s) => s -> Theme
                        -> ModifiedLayout (Decoration TabbedDecoration s) Simplest a
tabbedLeft s c = addTabsLeft s c Simplest
tabbedRight s c = addTabsRight s c Simplest

-- | A layout decorated with tabs and the possibility to set a custom
-- shrinker and theme.
tabbedLeftAlways, tabbedRightAlways :: (Eq a, Shrinker s) => s -> Theme
                                    -> ModifiedLayout (Decoration TabbedDecoration s) Simplest a
tabbedLeftAlways s c = addTabsLeftAlways s c Simplest
tabbedRightAlways s c = addTabsRightAlways s c Simplest

-- Layout Modifiers

-- | A layout modifier that uses the provided shrinker and theme to add tabs to any layout.
addTabs :: (Eq a, LayoutClass l a, Shrinker s) => s -> Theme -> l a
        -> ModifiedLayout (Decoration TabbedDecoration s) l a
addTabs = createTabs WhenPlural U

addTabsAlways :: (Eq a, LayoutClass l a, Shrinker s) => s -> Theme -> l a
              -> ModifiedLayout (Decoration TabbedDecoration s) l a
addTabsAlways = createTabs Always U

-- | A layout modifier that uses the provided shrinker and theme to add tabs to the bottom of any layout.
addTabsBottom :: (Eq a, LayoutClass l a, Shrinker s) => s -> Theme -> l a
              -> ModifiedLayout (Decoration TabbedDecoration s) l a
addTabsBottom = createTabs WhenPlural D

addTabsBottomAlways :: (Eq a, LayoutClass l a, Shrinker s) => s -> Theme -> l a
                    -> ModifiedLayout (Decoration TabbedDecoration s) l a
addTabsBottomAlways = createTabs Always D

-- | A layout modifier that uses the provided shrinker and theme to add tabs to the side of any layout.
addTabsRight, addTabsLeft :: (Eq a, LayoutClass l a, Shrinker s) => s -> Theme -> l a
                            -> ModifiedLayout (Decoration TabbedDecoration s) l a
addTabsRight = createTabs WhenPlural R
addTabsLeft = createTabs WhenPlural L

addTabsRightAlways, addTabsLeftAlways :: (Eq a, LayoutClass l a, Shrinker s) => s -> Theme -> l a
                                      -> ModifiedLayout (Decoration TabbedDecoration s) l a
addTabsRightAlways = createTabs Always R
addTabsLeftAlways = createTabs Always L

-- Tab creation abstractions.  Internal use only.

-- Create tabbar when required at the given location with the given
-- shrinker and theme to the supplied layout.
createTabs                ::(Eq a, LayoutClass l a, Shrinker s) => TabbarShown -> Direction2D -> s
                          -> Theme -> l a -> ModifiedLayout (Decoration TabbedDecoration s) l a

createTabs sh loc tx th l = decoration tx th (Tabbed loc sh) l

data TabbarShown = Always | WhenPlural deriving (Read, Show, Eq)

data TabbedDecoration a = Tabbed Direction2D TabbarShown deriving (Read, Show)

instance Eq a => DecorationStyle TabbedDecoration a where
    describeDeco (Tabbed U _ ) = "Tabbed"
    describeDeco (Tabbed D _ ) = "Tabbed Bottom"
    describeDeco (Tabbed L _ ) = "Tabbed Left"
    describeDeco (Tabbed R _ ) = "Tabbed Right"
    decorationEventHook _ ds ButtonEvent { ev_window     = ew
                                         , ev_event_type = et
                                         , ev_button     = eb }
        | et == buttonPress
        , Just ((w,_),_) <- findWindowByDecoration ew ds =
           if eb == button2
               then killWindow w
               else focus w
    decorationEventHook _ _ _ = return ()

    pureDecoration (Tabbed lc sh) wt ht _ s wrs (w,r@(Rectangle x y wh hh))
        = if ((sh == Always && numWindows > 0) || numWindows > 1)
          then Just $ case lc of
                        U -> upperTab
                        D -> lowerTab
                        L -> leftTab
                        R -> rightTab
          else Nothing
        where ws = filter (`elem` map fst (filter ((==r) . snd) wrs)) (S.integrate s)
              loc k h i = k + fi ((h * fi i) `div` max 1 (fi $ length ws))
              esize k h = fi $ maybe k (\i -> loc k h (i+1) - loc k h i) $ w `elemIndex` ws
              wid = esize x wh
              hid = esize y hh
              n k h = maybe k (loc k h) $ w `elemIndex` ws
              nx = n x wh
              ny = n y hh
              upperTab = Rectangle nx  y wid (fi ht)
              lowerTab = Rectangle nx (y + fi (hh - ht)) wid (fi ht)
              leftTab = Rectangle x ny (fi wt) hid
              rightTab = Rectangle (x + fi (wh - wt)) ny (fi wt) hid
              numWindows = length ws
    shrink (Tabbed loc _ ) (Rectangle _ _ dw dh) (Rectangle x y w h)
        = case loc of
            U -> Rectangle x (y + fi dh) w (h - dh)
            D -> Rectangle x y w (h - dh)
            L -> Rectangle (x + fi dw) y (w - dw) h
            R -> Rectangle x y (w - dw) h