{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}

-----------------------------------------------------------------------------
-- |
-- Module      :  XMonad.Layout.OnlyFor
-- Copyright   :  (c) Brandon S Allbery
-- License     :  BSD-style (see LICENSE)
--
-- Maintainer  :  <allbery.b@gmail.com>
-- Stability   :  unstable
-- Portability :  nonportable (MultiParamTypeClasses)
--
-- Apply a layout modifier only when there is either one or more than one
-- window in the workspace.
--
-----------------------------------------------------------------------------

module XMonad.Layout.OnlyFor (
                              -- * Usage
                              -- $usage

                              onlyFor
                             ,OnlyFor
                             ,HowMany(..)

                             ) where

import XMonad
import XMonad.Layout.LayoutModifier
import XMonad.StackSet (Stack(..), Workspace(..))

-- $usage
-- You can use this module by importing it into your @~\/.xmonad\/xmonad.hs@ file:
--
-- > import XMonad.Layout.OnlyFor
--
-- and modifying your layoutHook as follows (for example):
--
-- > layoutHook = onlyFor Multiple (spacing 2) $ Tall 1 (3/100) (1/2)
-- >                      -- put a 2px space around every window,
-- >                      -- but only when there's more than one
--
-- Note that the modifier must be an XMonad.Layout.LayoutModifier.  This
-- means that the Mirror modifier can't be used, since it is implemented
-- directly as a LayoutClass.  (Not that Mirror is useful here, but there
-- may be others.)

-- This is a dummy modifier used to simplify the below (i.e. I don't
-- have to duplicate LayoutModifier.hs)
data Id a = Id deriving (Show, Read)
instance LayoutModifier Id a where

-- | Specify how many windows to trigger on.
data HowMany = One | Multiple deriving (Show, Read)

-- | Apply the specified layout modifier only when there are the specified
--   number of windows.  (Zero isn't supported because there is already
--   an emptyLayout layout method.  Should I support it anyway for
--   symmetry?)
onlyFor     :: HowMany -> m -> l a -> ModifiedLayout (OnlyFor (m a)) l a
onlyFor n m =  ModifiedLayout (OnlyFor n m)

data OnlyFor m a = OnlyFor HowMany m deriving (Show, Read)

instance LayoutModifier m a => LayoutModifier (OnlyFor (m a)) a where
    -- get to reimplement all of them, wheee
    modifyLayout (OnlyFor One      m) w@(Workspace _ _ (Just (Stack _ [] []))) r =
        modifyLayout m  w r
    modifyLayout (OnlyFor One      _) w                                        r =
        modifyLayout Id w r
    modifyLayout (OnlyFor Multiple _) w@(Workspace _ _ (Just (Stack _ [] []))) r =
        modifyLayout Id w r
    modifyLayout (OnlyFor Multiple m) w                                        r =
        modifyLayout m  w r

    modifyLayoutWithUpdate   (OnlyFor One      m) w@(Workspace _ _ (Just (Stack _ [] []))) r = do
        (wrs,m') <- modifyLayoutWithUpdate m w r
        return (wrs,OnlyFor One `fmap` m')
    modifyLayoutWithUpdate m@(OnlyFor One      _) w                                        r =
        flip (,) Nothing `fmap` modifyLayout m w r
    modifyLayoutWithUpdate m@(OnlyFor Multiple _) w@(Workspace _ _ (Just (Stack _ [] []))) r =
        flip (,) Nothing `fmap` modifyLayout m w r
    modifyLayoutWithUpdate   (OnlyFor Multiple m) w                                        r = do
        (wrs,m') <- modifyLayoutWithUpdate m w r
        return (wrs,OnlyFor Multiple `fmap` m')

    -- messages are always passed on
    handleMess                (OnlyFor n m) mess =
        (OnlyFor n `fmap`) `fmap` handleMess m mess
    handleMessOrMaybeModifyIt (OnlyFor n m) mess = do
        r <- handleMessOrMaybeModifyIt m mess
        case r of
          Nothing            -> return  Nothing
          Just (Left  m'   ) -> return (Just    (Left  (OnlyFor n m')))
          Just (Right mess') -> return (Just    (Right  mess'        ))
    pureMess                  (OnlyFor n m) mess =
        OnlyFor n `fmap` pureMess m mess

    -- have to handle the Id case specially because of (a) the hook,
    -- (b) m' would be the wrong type (might be able to finesse that)
    redoLayout (OnlyFor One      m) r s@(Just (Stack _ [] [])) rs = do
        (wrs,m') <- redoLayout m r s rs
        return (wrs,OnlyFor One `fmap` m')
    redoLayout (OnlyFor One      m) r s                        rs = do
        (wrs,_ ) <- redoLayout Id r s rs
        hook m >> return (wrs,OnlyFor One `fmap` Just m)
    redoLayout (OnlyFor Multiple m) r s@(Just (Stack _ [] [])) rs = do
        (wrs,_ ) <- redoLayout Id r s rs
        hook m >> return (wrs,OnlyFor Multiple `fmap` Just m)
    redoLayout (OnlyFor Multiple m) r s                        rs = do
        (wrs,m') <- redoLayout m r s rs
        return (wrs,OnlyFor One `fmap` m')

    -- (b) above applies here too
    pureModifier (OnlyFor One      m) r s@(Just (Stack _ [] [])) rs =
        let (wrs,m') = pureModifier m r s rs
         in (wrs,OnlyFor One `fmap` m')
    pureModifier (OnlyFor One      m) r s                        rs =
        let (wrs,_ ) = pureModifier Id r s rs
         in (wrs,OnlyFor One `fmap` Just m)
    pureModifier (OnlyFor Multiple m) r s@(Just (Stack _ [] [])) rs =
        let (wrs,_ ) = pureModifier Id r s rs
         in (wrs,OnlyFor One `fmap` Just m)
    pureModifier (OnlyFor Multiple m) r s                        rs =
        let (wrs,m') = pureModifier m r s rs
         in (wrs,OnlyFor Multiple `fmap` m')

    -- I am assuming hook needs to always be run, since unhook does
    hook   (OnlyFor _ m) = hook   m
    unhook (OnlyFor _ m) = unhook m

    -- ideally this would figure out whether the modifier is active
    -- or not, but since it's pure we can't do that
    modifierDescription (OnlyFor n m)   = "OnlyFor " ++ show n ++ " " ++ show m

    -- default modifyDescription does the right thing