content: {-# OPTIONS_GHC -fno-warn-name-shadowing -fno-warn-unused-binds #-}
  {-# LANGUAGE FlexibleInstances, MultiParamTypeClasses
    , PatternGuards, DeriveDataTypeable, ExistentialQuantification
    , FlexibleContexts #-}
  
  -----------------------------------------------------------------------------
  -- |
  -- Module      :  XMonad.Layout.ZoomRow
  -- Copyright   :  Quentin Moser <moserq@gmail.com>
  -- License     :  BSD-style (see LICENSE)
  --
  -- Maintainer  :  orphaned
  -- Stability   :  unstable
  -- Portability :  unportable
  --
  -- Row layout with individually resizable elements.
  --
  -----------------------------------------------------------------------------
  
  module XMonad.Layout.ZoomRow ( -- * Usage
                                 -- $usage
                                 ZoomRow
                                 -- * Creation
                               , zoomRow
                                 -- * Messages
                               , ZoomMessage(..)
                               , zoomIn
                               , zoomOut
                               , zoomReset
                                 -- * Use with non-'Eq' elements
                                 -- $noneq
                               , zoomRowWith
                               , EQF(..)
                               , ClassEQ(..)
                               ) where
  
  import XMonad
  import qualified XMonad.StackSet as W
  
  import XMonad.Util.Stack
  import XMonad.Layout.Decoration (fi)
  
  import Data.Maybe (fromMaybe)
  import Control.Arrow (second)
  
  -- $usage
  -- This module provides a layout which places all windows in a single
  -- row; the size occupied by each individual window can be increased
  -- and decreased, and a window can be set to use the whole available
  -- space whenever it has focus.
  --
  -- You can use this module by including  the following in your @~\/.xmonad/xmonad.hs@:
  --
  -- > import XMonad.Layout.ZoomRow
  --
  -- and using 'zoomRow' somewhere in your 'layoutHook', for example:
  --
  -- > myLayout = zoomRow ||| Mirror zoomRow
  --
  -- To be able to resize windows, you can create keybindings to send
  -- the relevant 'ZoomMessage's:
  --
  -- >   -- Increase the size occupied by the focused window
  -- > , ((modMask .|. shifMask, xK_minus), sendMessage zoomIn)
  -- >   -- Decrease the size occupied by the focused window
  -- > , ((modMayk             , xK_minus), sendMessage zoomOut)
  -- >   -- Reset the size occupied by the focused window
  -- > , ((modMask             , xK_equal), sendMessage zoomReset)
  -- >   -- (Un)Maximize the focused window
  -- > , ((modMask             , xK_f    ), sendMessage ToggleZoomFull)
  --
  -- For more information on editing your layout hook and key bindings,
  -- see "XMonad.Doc.Extending".
  
  -- * Creation functions
  
  -- | 'ZoomRow' layout for laying out elements which are instances of
  -- 'Eq'. Perfect for 'Window's.
  zoomRow :: (Eq a, Show a, Read a) => ZoomRow ClassEQ a
  zoomRow = ZC ClassEQ emptyZ
  
  -- $noneq
  -- Haskell's 'Eq' class is usually concerned with structural equality, whereas
  -- what this layout really wants is for its elements to have a unique identity,
  -- even across changes. There are cases (such as, importantly, 'Window's) where
  -- the 'Eq' instance for a type actually does that, but if you want to lay
  -- out something more exotic than windows and your 'Eq' means something else,
  -- you can use the following.
  
  -- | ZoomRow layout with a custom equality predicate. It should
  -- of course satisfy the laws for 'Eq', and you should also make
  -- sure that the layout never has to handle two \"equal\" elements
  -- at the same time (it won't do any huge damage, but might behave
  -- a bit strangely).
  zoomRowWith :: (EQF f a, Show (f a), Read (f a), Show a, Read a)
                 => f a -> ZoomRow f a
  zoomRowWith f = ZC f emptyZ
  
  
  -- * The datatypes
  
  -- | A layout that arranges its windows in a horizontal row,
  -- and allows to change the relative size of each element
  -- independently.
  data ZoomRow f a = ZC { zoomEq ::  f a
                            -- ^ Function to compare elements for
                            -- equality, a real Eq instance might
                            -- not be what you want in some cases
                        , zoomRatios :: (Zipper (Elt a))
                            -- ^ Element specs. The zipper is so we
                            -- know what the focus is when we handle
                            --  a message
                        }
    deriving (Show, Read, Eq)
  
  -- | Class for equivalence relations. Must be transitive, reflexive.
  class EQF f a where
      eq :: f a -> a -> a -> Bool
  
  -- | To use the usual '==':
  data ClassEQ a = ClassEQ
    deriving (Show, Read, Eq)
  
  instance Eq a => EQF ClassEQ a where
      eq _ a b = a == b
  
  -- | Size specification for an element.
  data Elt a = E { elt :: a -- ^ The element
                 , ratio :: Rational -- ^ Its size ratio
                 , full :: Bool -- ^ Whether it should occupy all the
                                -- available space when it has focus.
                 }
    deriving (Show, Read, Eq)
  
  
  -- * Helpers
  
  getRatio :: Elt a -> (a, Rational)
  getRatio (E a r _) = (a,r)
  
  lookupBy :: (a -> a -> Bool) -> a -> [Elt a] -> Maybe (Elt a)
  lookupBy _ _ [] = Nothing
  lookupBy f a (E a' r b : _) | f a a' = Just $ E a r b
  lookupBy f a (_:es) = lookupBy f a es
  
  setFocus :: Zipper a -> a -> Zipper a
  setFocus Nothing a = Just $ W.Stack a [] []
  setFocus (Just s) a = Just s { W.focus = a }
  
  
  -- * Messages
  
  -- | The type of messages accepted by a 'ZoomRow' layout
  data ZoomMessage = Zoom Rational
                   -- ^ Multiply the focused window's size factor
                   -- by the given number.
                   | ZoomTo Rational
                   -- ^ Set the focused window's size factor to the
                   -- given number.
                   | ZoomFull Bool
                   -- ^ Set whether the focused window should occupy
                   -- all available space when it has focus
                   | ZoomFullToggle
                   -- ^ Toggle whether the focused window should
                   -- occupy all available space when it has focus
    deriving (Typeable, Show)
  
  instance Message ZoomMessage
  
  -- | Increase the size of the focused window.
  -- Defined as @Zoom 1.5@
  zoomIn :: ZoomMessage
  zoomIn = Zoom 1.5
  
  -- | Decrease the size of the focused window.
  -- Defined as @Zoom (2/3)@
  zoomOut :: ZoomMessage
  zoomOut = Zoom $ 2/3
  
  -- | Reset the size of the focused window.
  -- Defined as @ZoomTo 1@
  zoomReset :: ZoomMessage
  zoomReset = ZoomTo 1
  
  
  -- * LayoutClass instance
  
  instance (EQF f a, Show a, Read a, Show (f a), Read (f a))
      => LayoutClass (ZoomRow f) a where
      description (ZC _ Nothing) = "ZoomRow"
      description (ZC _ (Just s)) = "ZoomRow" ++ if full $ W.focus s
                                                  then " (Max)"
                                                  else ""
  
      emptyLayout (ZC _ Nothing) _ = return ([], Nothing)
      emptyLayout (ZC f _) _ = return ([], Just $ ZC f Nothing)
  
      doLayout (ZC f zelts) r@(Rectangle _ _ w _) s
          = let elts = W.integrate' zelts
                zelts' = mapZ_ (\a -> fromMaybe (E a 1 False)
                                      $ lookupBy (eq f) a elts) $ Just s
                elts' = W.integrate' zelts'
  
                maybeL' = if zelts `noChange` zelts'
                            then Nothing
                            else Just $ ZC f zelts'
  
                total = sum  $ map ratio elts'
  
                widths =  map (second ((* fi w) . (/total)) . getRatio) elts'
  
            in case getFocusZ zelts' of
                 Just (E a _ True) -> return ([(a, r)], maybeL')
                 _ -> return (makeRects r widths, maybeL')
  
          where makeRects :: Rectangle -> [(a, Rational)] -> [(a, Rectangle)]
                makeRects r pairs = let as = map fst pairs
                                        widths = map snd pairs
                                        discreteWidths = snd $ foldr discretize (0, []) widths
                                        rectangles = snd $ foldr makeRect (r, []) discreteWidths
                                    in zip as rectangles
  
                -- | Make a new rectangle by substracting the given width from the available
                -- space (from the right, since this is a foldr)
                makeRect :: Dimension -> (Rectangle, [Rectangle]) -> (Rectangle, [Rectangle])
                makeRect w (Rectangle x y w0 h, rs) = ( Rectangle x y (w0-w) h
                                                      , Rectangle (x+fi w0-fi w) y w h : rs )
  
                -- | Round a list of fractions in a way that maintains the total.
                -- If you know a better way to do this I'm very interested.
                discretize :: Rational -> (Rational, [Dimension]) -> (Rational, [Dimension])
                discretize r (carry, ds) = let (d, carry') = properFraction $ carry+r
                                           in (carry', d:ds)
  
                noChange z1 z2 = toTags z1 `helper` toTags z2
                    where helper [] [] = True
                          helper (Right a:as) (Right b:bs) = a `sameAs` b && as `helper` bs
                          helper (Left a:as) (Left b:bs) = a `sameAs` b && as `helper` bs
                          helper _ _ = False
                          E a1 r1 b1 `sameAs` E a2 r2 b2 = (eq f a1 a2) && (r1 == r2) && (b1 == b2)
  
      pureMessage (ZC f zelts) sm | Just (ZoomFull False) <- fromMessage sm
                                  , Just (E a r True) <- getFocusZ zelts
          = Just $ ZC f $ setFocus zelts $ E a r False
  
      pureMessage (ZC f zelts) sm | Just (ZoomFull True) <- fromMessage sm
                                  , Just (E a r False) <- getFocusZ zelts
          = Just $ ZC f $ setFocus zelts $ E a r True
  
      pureMessage (ZC f zelts) sm | Just (E a r b) <- getFocusZ zelts
          = case fromMessage sm of
              Just (Zoom r') -> Just $ ZC f $ setFocus zelts $ E a (r*r') b
              Just (ZoomTo r') -> Just $ ZC f $ setFocus zelts $ E a r' b
              Just ZoomFullToggle -> pureMessage (ZC f zelts)
                                       $ SomeMessage $ ZoomFull $ not b
              _ -> Nothing
  
      pureMessage _ _ = Nothing