{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  XMonad.Layout.TabBarDecoration
-- Description :  A layout modifier to add a bar of tabs to your layouts.
-- Copyright   :  (c) 2007 Andrea Rossato
-- License     :  BSD-style (see xmonad/LICENSE)
--
-- Maintainer  :  andrea.rossato@unibz.it
-- Stability   :  unstable
-- Portability :  unportable
--
-- A layout modifier to add a bar of tabs to your layouts.
-----------------------------------------------------------------------------

module XMonad.Layout.TabBarDecoration
    ( -- * Usage
      -- $usage
      simpleTabBar, tabBar
    , def, shrinkText
    , TabBarDecoration (..), XPPosition (..)
    , module XMonad.Layout.ResizeScreen
    ) where

import XMonad.Prelude
import XMonad
import qualified XMonad.StackSet as S
import XMonad.Layout.Decoration
import XMonad.Layout.ResizeScreen
import XMonad.Prompt ( XPPosition (..) )

-- $usage
-- You can use this module with the following in your
-- @xmonad.hs@:
--
-- > import XMonad.Layout.TabBarDecoration
--
-- Then edit your @layoutHook@ by adding the layout you want:
--
-- > main = xmonad def { layoutHook = simpleTabBar $ layoutHook def}
--
-- For more detailed instructions on editing the layoutHook see
-- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial> and
-- "XMonad.Doc.Extending#Editing_the_layout_hook".
--
-- 'tabBar' will give you the possibility of setting a custom shrinker
-- and a custom theme.
--
-- The deafult theme can be dynamically change with the xmonad theme
-- selector. See "XMonad.Prompt.Theme". For more themse, look at
-- "XMonad.Util.Themes"

-- | Add, on the top of the screen, a simple bar of tabs to a given
-- | layout, with the default theme and the default shrinker.
simpleTabBar :: Eq a => l a -> ModifiedLayout (Decoration TabBarDecoration DefaultShrinker)
                (ModifiedLayout ResizeScreen l) a
simpleTabBar :: forall a (l :: * -> *).
Eq a =>
l a
-> ModifiedLayout
     (Decoration TabBarDecoration DefaultShrinker)
     (ModifiedLayout ResizeScreen l)
     a
simpleTabBar = DefaultShrinker
-> Theme
-> TabBarDecoration a
-> ModifiedLayout ResizeScreen l a
-> ModifiedLayout
     (Decoration TabBarDecoration DefaultShrinker)
     (ModifiedLayout ResizeScreen l)
     a
forall (ds :: * -> *) a s (l :: * -> *).
(DecorationStyle ds a, Shrinker s) =>
s -> Theme -> ds a -> l a -> ModifiedLayout (Decoration ds s) l a
decoration DefaultShrinker
shrinkText Theme
forall a. Default a => a
def (XPPosition -> TabBarDecoration a
forall a. XPPosition -> TabBarDecoration a
TabBar XPPosition
Top) (ModifiedLayout ResizeScreen l a
 -> ModifiedLayout
      (Decoration TabBarDecoration DefaultShrinker)
      (ModifiedLayout ResizeScreen l)
      a)
-> (l a -> ModifiedLayout ResizeScreen l a)
-> l a
-> ModifiedLayout
     (Decoration TabBarDecoration DefaultShrinker)
     (ModifiedLayout ResizeScreen l)
     a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> l a -> ModifiedLayout ResizeScreen l a
forall (l :: * -> *) a.
Int -> l a -> ModifiedLayout ResizeScreen l a
resizeVertical Int
20

-- | Same of 'simpleTabBar', but with the possibility of setting a
-- custom shrinker, a custom theme and the position: 'Top' or
-- 'Bottom'.
tabBar :: (Eq a, Shrinker s) => s -> Theme -> XPPosition -> l a -> ModifiedLayout (Decoration TabBarDecoration s) l a
tabBar :: forall a s (l :: * -> *).
(Eq a, Shrinker s) =>
s
-> Theme
-> XPPosition
-> l a
-> ModifiedLayout (Decoration TabBarDecoration s) l a
tabBar s
s Theme
t XPPosition
p = s
-> Theme
-> TabBarDecoration a
-> l a
-> ModifiedLayout (Decoration TabBarDecoration s) l a
forall (ds :: * -> *) a s (l :: * -> *).
(DecorationStyle ds a, Shrinker s) =>
s -> Theme -> ds a -> l a -> ModifiedLayout (Decoration ds s) l a
decoration s
s Theme
t (XPPosition -> TabBarDecoration a
forall a. XPPosition -> TabBarDecoration a
TabBar XPPosition
p)

newtype TabBarDecoration a = TabBar XPPosition deriving (ReadPrec [TabBarDecoration a]
ReadPrec (TabBarDecoration a)
Int -> ReadS (TabBarDecoration a)
ReadS [TabBarDecoration a]
(Int -> ReadS (TabBarDecoration a))
-> ReadS [TabBarDecoration a]
-> ReadPrec (TabBarDecoration a)
-> ReadPrec [TabBarDecoration a]
-> Read (TabBarDecoration a)
forall a. ReadPrec [TabBarDecoration a]
forall a. ReadPrec (TabBarDecoration a)
forall a. Int -> ReadS (TabBarDecoration a)
forall a. ReadS [TabBarDecoration a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: forall a. Int -> ReadS (TabBarDecoration a)
readsPrec :: Int -> ReadS (TabBarDecoration a)
$creadList :: forall a. ReadS [TabBarDecoration a]
readList :: ReadS [TabBarDecoration a]
$creadPrec :: forall a. ReadPrec (TabBarDecoration a)
readPrec :: ReadPrec (TabBarDecoration a)
$creadListPrec :: forall a. ReadPrec [TabBarDecoration a]
readListPrec :: ReadPrec [TabBarDecoration a]
Read, Int -> TabBarDecoration a -> ShowS
[TabBarDecoration a] -> ShowS
TabBarDecoration a -> String
(Int -> TabBarDecoration a -> ShowS)
-> (TabBarDecoration a -> String)
-> ([TabBarDecoration a] -> ShowS)
-> Show (TabBarDecoration a)
forall a. Int -> TabBarDecoration a -> ShowS
forall a. [TabBarDecoration a] -> ShowS
forall a. TabBarDecoration a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Int -> TabBarDecoration a -> ShowS
showsPrec :: Int -> TabBarDecoration a -> ShowS
$cshow :: forall a. TabBarDecoration a -> String
show :: TabBarDecoration a -> String
$cshowList :: forall a. [TabBarDecoration a] -> ShowS
showList :: [TabBarDecoration a] -> ShowS
Show)

instance Eq a => DecorationStyle TabBarDecoration a where
    describeDeco :: TabBarDecoration a -> String
describeDeco  TabBarDecoration a
_ = String
"TabBar"
    shrink :: TabBarDecoration a -> Rectangle -> Rectangle -> Rectangle
shrink    TabBarDecoration a
_ Rectangle
_ Rectangle
r = Rectangle
r
    decorationCatchClicksHook :: TabBarDecoration a -> Window -> Int -> Int -> X Bool
decorationCatchClicksHook TabBarDecoration a
_ Window
mainw Int
_ Int
_ = Window -> X ()
focus Window
mainw X () -> X Bool -> X Bool
forall a b. X a -> X b -> X b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> X Bool
forall a. a -> X a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
    pureDecoration :: TabBarDecoration a
-> Dimension
-> Dimension
-> Rectangle
-> Stack a
-> [(a, Rectangle)]
-> (a, Rectangle)
-> Maybe Rectangle
pureDecoration (TabBar XPPosition
p) Dimension
_ Dimension
dht (Rectangle Position
x Position
y Dimension
wh Dimension
ht) Stack a
s [(a, Rectangle)]
_ (a
w,Rectangle
_) =
        if Stack a -> a -> Bool
forall a. Eq a => Stack a -> a -> Bool
isInStack Stack a
s a
w then Rectangle -> Maybe Rectangle
forall a. a -> Maybe a
Just (Rectangle -> Maybe Rectangle) -> Rectangle -> Maybe Rectangle
forall a b. (a -> b) -> a -> b
$ Position -> Position -> Dimension -> Dimension -> Rectangle
Rectangle Position
nx Position
ny Dimension
wid (Dimension -> Dimension
forall a b. (Integral a, Num b) => a -> b
fi Dimension
dht) else Maybe Rectangle
forall a. Maybe a
Nothing
        where wrs :: [a]
wrs = Stack a -> [a]
forall a. Stack a -> [a]
S.integrate Stack a
s
              loc :: a -> Dimension
loc a
i = (Dimension
wh Dimension -> Dimension -> Dimension
forall a. Num a => a -> a -> a
* a -> Dimension
forall a b. (Integral a, Num b) => a -> b
fi a
i) Dimension -> Dimension -> Dimension
forall a. Integral a => a -> a -> a
`div` Dimension -> Dimension -> Dimension
forall a. Ord a => a -> a -> a
max Dimension
1 (Int -> Dimension
forall a b. (Integral a, Num b) => a -> b
fi (Int -> Dimension) -> Int -> Dimension
forall a b. (a -> b) -> a -> b
$ [a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
wrs)
              wid :: Dimension
wid = Dimension -> (Int -> Dimension) -> Maybe Int -> Dimension
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Position -> Dimension
forall a b. (Integral a, Num b) => a -> b
fi Position
x) (\Int
i -> Int -> Dimension
forall {a}. Integral a => a -> Dimension
loc (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Dimension -> Dimension -> Dimension
forall a. Num a => a -> a -> a
- Int -> Dimension
forall {a}. Integral a => a -> Dimension
loc Int
i) (Maybe Int -> Dimension) -> Maybe Int -> Dimension
forall a b. (a -> b) -> a -> b
$ a
w a -> [a] -> Maybe Int
forall a. Eq a => a -> [a] -> Maybe Int
`elemIndex` [a]
wrs
              ny :: Position
ny  = case XPPosition
p of
                     XPPosition
Top    -> Position
y
                     XPPosition
Bottom -> Position
y Position -> Position -> Position
forall a. Num a => a -> a -> a
+ Dimension -> Position
forall a b. (Integral a, Num b) => a -> b
fi Dimension
ht Position -> Position -> Position
forall a. Num a => a -> a -> a
- Dimension -> Position
forall a b. (Integral a, Num b) => a -> b
fi Dimension
dht
                     XPPosition
_      -> String -> Position
forall a. HasCallStack => String -> a
error String
"Position must be 'Top' or 'Bottom'"
              nx :: Position
nx  = (Position
x Position -> Position -> Position
forall a. Num a => a -> a -> a
+) (Position -> Position) -> Position -> Position
forall a b. (a -> b) -> a -> b
$ Position -> (Int -> Position) -> Maybe Int -> Position
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Position
0 (Dimension -> Position
forall a b. (Integral a, Num b) => a -> b
fi (Dimension -> Position) -> (Int -> Dimension) -> Int -> Position
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Dimension
forall {a}. Integral a => a -> Dimension
loc) (Maybe Int -> Position) -> Maybe Int -> Position
forall a b. (a -> b) -> a -> b
$ a
w a -> [a] -> Maybe Int
forall a. Eq a => a -> [a] -> Maybe Int
`elemIndex` [a]
wrs