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

    -----------------------------------------------------------------------------
    -- |
    -- Module      :  XMonad.Layout.Master
    -- Copyright   :  (c) Lukas Mai
    -- License     :  BSD-style (see LICENSE)
    --
    -- Maintainer  :  <l.mai@web.de>
    -- Stability   :  unstable
    -- Portability :  unportable
    --
    -- A layout that adds a distinguished master window to a base layout.
    -----------------------------------------------------------------------------

    module XMonad.Layout.Master (
        -- * Usage
        -- $usage
        mastered,
        Master
    ) where

    import XMonad
    import XMonad.StackSet

    import Data.List
    import Data.Ord

    -- $usage
    -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
    --
    -- > import XMonad.Layout.Master
    --
    -- and add something like
    --
    -- > mastered (1/100) (1/2) $ Grid
    --
    -- to your layouts. This will use the left half of your screen for a master
    -- window and let Grid manage the right half.
    --
    -- For more detailed instructions on editing the layoutHook see
    -- "XMonad.Doc.Extending#Editing_the_layout_hook".
    --
    -- Like 'XMonad.Layout.Tall', 'Master' supports the 'XMonad.Layout.Shrink' and
    -- 'XMonad.Layout.Expand' messages.

    mastered :: (LayoutClass l a)
        => Rational -- ^ @delta@, the ratio of the screen to resize by
        -> Rational -- ^ @frac@, what portion of the screen to reserve for the master window
        -> l a      -- ^ the layout to use for the remaining windows
        -> Master l a
    mastered d f b = Master d f' b
        where
        f' = min 1 . max 0 $ f

    data Master l a =
        Master{
            delta :: Rational,
            frac :: Rational,
            base :: l a
        } deriving (Show, Read, Eq, Ord)

    extractMaster :: Stack a -> (a, Maybe (Stack a))
    extractMaster (Stack x ls rs) = case reverse ls of
        [] -> (x, differentiate rs)
        (m : ls') -> (m, Just $ Stack x (reverse ls') rs)

    area :: Rectangle -> Dimension
    area r = rect_width r * rect_height r

    chop :: D -> Rectangle -> Rectangle
    chop (w, h) (Rectangle rx ry rw rh) =
        let
            r' = maximumBy (comparing area)
                [ Rectangle rx (ry + fromIntegral h) rw (rh - h)
                , Rectangle (rx + fromIntegral w) ry (rw - w) rh]
        in
        r'{ rect_width = max 0 $ rect_width r', rect_height = max 0 $ rect_height r' }

    instance (LayoutClass l Window) => LayoutClass (Master l) Window where
        description m = "Master " ++ description (base m)
        handleMessage m msg
            | Just Shrink <- fromMessage msg =
                return . Just $ m{ frac = max 0 $ frac m - delta m }
            | Just Expand <- fromMessage msg =
                return . Just $ m{ frac = min 1 $ frac m + delta m }
            | otherwise =
                fmap (fmap (\x -> m{ base = x })) $ handleMessage (base m) msg
        runLayout ws rect = do
            (f, ws', rect') <- case fmap extractMaster $ stack ws of
                Nothing ->
                    return (id, ws, rect)
                Just (x, Nothing) -> do
                    f <- mkAdjust x
                    let
                        (w', h') = f (rect_width rect, rect_height rect)
                        xr = rect{ rect_width = w', rect_height = h' }
                    return (((x, xr) :), ws{ stack = Nothing }, Rectangle (rect_x xr + fromIntegral w') (rect_y xr) 0 0)
                Just (x, Just st) -> do
                    f <- mkAdjust x
                    let
                        d@(w', h') = f (scale $ rect_width rect, rect_height rect)
                        xr = rect{ rect_width = w', rect_height = h' }
                    return (((x, xr) :), ws{ stack = Just st }, chop d rect)
            (y, l) <- runLayout ws'{ layout = base m } rect'
            return (f y, fmap (\x -> m{ base = x }) l)
            where
            m = layout ws
            scale = round . (* frac m) . fromIntegral