{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}

-----------------------------------------------------------------------------
-- |
-- Module      :  XMonad.Layout.Accordion
-- Description :  Put non-focused windows in ribbons at the top and bottom of the screen.
-- Copyright   :  (c) glasser@mit.edu
-- License     :  BSD
--
-- Maintainer  :  glasser@mit.edu
-- Stability   :  stable
-- Portability :  unportable
--
-- LayoutClass that puts non-focused windows in ribbons at the top and bottom
-- of the screen.
-----------------------------------------------------------------------------

module XMonad.Layout.Accordion (
    -- * Usage
    -- $usage
    Accordion(Accordion)) where

import XMonad
import qualified XMonad.StackSet as W
import Data.Ratio

-- $usage
-- You can use this module with the following in your @xmonad.hs@:
--
-- > import XMonad.Layout.Accordion
--
-- Then edit your @layoutHook@ by adding the Accordion layout:
--
-- > myLayout = Accordion ||| Full ||| etc..
-- > main = xmonad def { layoutHook = myLayout }
--
-- 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".

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

instance LayoutClass Accordion Window where
    pureLayout :: Accordion Window
-> Rectangle -> Stack Window -> [(Window, Rectangle)]
pureLayout Accordion Window
_ Rectangle
sc Stack Window
ws = forall a b. [a] -> [b] -> [(a, b)]
zip [Window]
ups [Rectangle]
tops forall a. [a] -> [a] -> [a]
++ [(forall a. Stack a -> a
W.focus Stack Window
ws, Rectangle
mainPane)] forall a. [a] -> [a] -> [a]
++ forall a b. [a] -> [b] -> [(a, b)]
zip [Window]
dns [Rectangle]
bottoms
     where
       ups :: [Window]
ups    = forall a. [a] -> [a]
reverse forall a b. (a -> b) -> a -> b
$ forall a. Stack a -> [a]
W.up Stack Window
ws
       dns :: [Window]
dns    = forall a. Stack a -> [a]
W.down Stack Window
ws
       (Rectangle
top,  Rectangle
allButTop) = forall r. RealFrac r => r -> Rectangle -> (Rectangle, Rectangle)
splitVerticallyBy (Int
1forall a. Integral a => a -> a -> Ratio a
%Int
8 :: Ratio Int) Rectangle
sc
       (Rectangle
center,  Rectangle
bottom) = forall r. RealFrac r => r -> Rectangle -> (Rectangle, Rectangle)
splitVerticallyBy (Int
6forall a. Integral a => a -> a -> Ratio a
%Int
7 :: Ratio Int) Rectangle
allButTop
       (Rectangle
allButBottom, Rectangle
_) = forall r. RealFrac r => r -> Rectangle -> (Rectangle, Rectangle)
splitVerticallyBy (Int
7forall a. Integral a => a -> a -> Ratio a
%Int
8 :: Ratio Int) Rectangle
sc
       mainPane :: Rectangle
mainPane | [Window]
ups forall a. Eq a => a -> a -> Bool
/= [] Bool -> Bool -> Bool
&& [Window]
dns forall a. Eq a => a -> a -> Bool
/= [] = Rectangle
center
                | [Window]
ups forall a. Eq a => a -> a -> Bool
/= []              = Rectangle
allButTop
                | [Window]
dns forall a. Eq a => a -> a -> Bool
/= []              = Rectangle
allButBottom
                | Bool
otherwise              = Rectangle
sc
       tops :: [Rectangle]
tops    = if [Window]
ups forall a. Eq a => a -> a -> Bool
/= [] then Int -> Rectangle -> [Rectangle]
splitVertically (forall (t :: * -> *) a. Foldable t => t a -> Int
length [Window]
ups) Rectangle
top    else []
       bottoms :: [Rectangle]
bottoms = if [Window]
dns forall a. Eq a => a -> a -> Bool
/= [] then Int -> Rectangle -> [Rectangle]
splitVertically (forall (t :: * -> *) a. Foldable t => t a -> Int
length [Window]
dns) Rectangle
bottom else []