{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}

-----------------------------------------------------------------------------
-- |
-- Module      :  XMonad.Layout.PerScreen
-- Description :  Configure layouts based on the width of your screen.
-- Copyright   :  (c) Edward Z. Yang
-- License     :  BSD-style (see LICENSE)
--
-- Maintainer  :  <ezyang@cs.stanford.edu>
-- Stability   :  unstable
-- Portability :  unportable
--
-- Configure layouts based on the width of your screen; use your
-- favorite multi-column layout for wide screens and a full-screen
-- layout for small ones.
-----------------------------------------------------------------------------

module XMonad.Layout.PerScreen
    ( -- * Usage
      -- $usage
      PerScreen,
      ifWider
    ) where

import XMonad
import qualified XMonad.StackSet as W

import XMonad.Prelude (fromMaybe)

-- $usage
-- You can use this module by importing it into your ~\/.xmonad\/xmonad.hs file:
--
-- > import XMonad.Layout.PerScreen
--
-- and modifying your layoutHook as follows (for example):
--
-- > layoutHook = ifWider 1280 (Tall 1 (3/100) (1/2) ||| Full) Full
--
-- Replace any of the layouts with any arbitrarily complicated layout.
-- ifWider can also be used inside other layout combinators.

ifWider :: (LayoutClass l1 a, LayoutClass l2 a)
               => Dimension   -- ^ target screen width
               -> l1 a        -- ^ layout to use when the screen is wide enough
               -> l2 a        -- ^ layout to use otherwise
               -> PerScreen l1 l2 a
ifWider :: Dimension -> l1 a -> l2 a -> PerScreen l1 l2 a
ifWider Dimension
w = Dimension -> Bool -> l1 a -> l2 a -> PerScreen l1 l2 a
forall (l1 :: * -> *) (l2 :: * -> *) a.
Dimension -> Bool -> l1 a -> l2 a -> PerScreen l1 l2 a
PerScreen Dimension
w Bool
False

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

-- | Construct new PerScreen values with possibly modified layouts.
mkNewPerScreenT :: PerScreen l1 l2 a -> Maybe (l1 a) ->
                      PerScreen l1 l2 a
mkNewPerScreenT :: PerScreen l1 l2 a -> Maybe (l1 a) -> PerScreen l1 l2 a
mkNewPerScreenT (PerScreen Dimension
w Bool
_ l1 a
lt l2 a
lf) Maybe (l1 a)
mlt' =
    (\l1 a
lt' -> Dimension -> Bool -> l1 a -> l2 a -> PerScreen l1 l2 a
forall (l1 :: * -> *) (l2 :: * -> *) a.
Dimension -> Bool -> l1 a -> l2 a -> PerScreen l1 l2 a
PerScreen Dimension
w Bool
True l1 a
lt' l2 a
lf) (l1 a -> PerScreen l1 l2 a) -> l1 a -> PerScreen l1 l2 a
forall a b. (a -> b) -> a -> b
$ l1 a -> Maybe (l1 a) -> l1 a
forall a. a -> Maybe a -> a
fromMaybe l1 a
lt Maybe (l1 a)
mlt'

mkNewPerScreenF :: PerScreen l1 l2 a -> Maybe (l2 a) ->
                      PerScreen l1 l2 a
mkNewPerScreenF :: PerScreen l1 l2 a -> Maybe (l2 a) -> PerScreen l1 l2 a
mkNewPerScreenF (PerScreen Dimension
w Bool
_ l1 a
lt l2 a
lf) Maybe (l2 a)
mlf' =
    Dimension -> Bool -> l1 a -> l2 a -> PerScreen l1 l2 a
forall (l1 :: * -> *) (l2 :: * -> *) a.
Dimension -> Bool -> l1 a -> l2 a -> PerScreen l1 l2 a
PerScreen Dimension
w Bool
False l1 a
lt (l2 a -> PerScreen l1 l2 a) -> l2 a -> PerScreen l1 l2 a
forall a b. (a -> b) -> a -> b
$ l2 a -> Maybe (l2 a) -> l2 a
forall a. a -> Maybe a -> a
fromMaybe l2 a
lf Maybe (l2 a)
mlf'

instance (LayoutClass l1 a, LayoutClass l2 a, Show a) => LayoutClass (PerScreen l1 l2) a where
    runLayout :: Workspace String (PerScreen l1 l2 a) a
-> Rectangle -> X ([(a, Rectangle)], Maybe (PerScreen l1 l2 a))
runLayout (W.Workspace String
i p :: PerScreen l1 l2 a
p@(PerScreen Dimension
w Bool
_ l1 a
lt l2 a
lf) Maybe (Stack a)
ms) Rectangle
r
        | Rectangle -> Dimension
rect_width Rectangle
r Dimension -> Dimension -> Bool
forall a. Ord a => a -> a -> Bool
> Dimension
w    = do ([(a, Rectangle)]
wrs, Maybe (l1 a)
mlt') <- Workspace String (l1 a) a
-> Rectangle -> X ([(a, Rectangle)], Maybe (l1 a))
forall (layout :: * -> *) a.
LayoutClass layout a =>
Workspace String (layout a) a
-> Rectangle -> X ([(a, Rectangle)], Maybe (layout a))
runLayout (String -> l1 a -> Maybe (Stack a) -> Workspace String (l1 a) a
forall i l a. i -> l -> Maybe (Stack a) -> Workspace i l a
W.Workspace String
i l1 a
lt Maybe (Stack a)
ms) Rectangle
r
                                   ([(a, Rectangle)], Maybe (PerScreen l1 l2 a))
-> X ([(a, Rectangle)], Maybe (PerScreen l1 l2 a))
forall (m :: * -> *) a. Monad m => a -> m a
return ([(a, Rectangle)]
wrs, PerScreen l1 l2 a -> Maybe (PerScreen l1 l2 a)
forall a. a -> Maybe a
Just (PerScreen l1 l2 a -> Maybe (PerScreen l1 l2 a))
-> PerScreen l1 l2 a -> Maybe (PerScreen l1 l2 a)
forall a b. (a -> b) -> a -> b
$ PerScreen l1 l2 a -> Maybe (l1 a) -> PerScreen l1 l2 a
forall (l1 :: * -> *) (l2 :: * -> *) a.
PerScreen l1 l2 a -> Maybe (l1 a) -> PerScreen l1 l2 a
mkNewPerScreenT PerScreen l1 l2 a
p Maybe (l1 a)
mlt')
        | Bool
otherwise           = do ([(a, Rectangle)]
wrs, Maybe (l2 a)
mlt') <- Workspace String (l2 a) a
-> Rectangle -> X ([(a, Rectangle)], Maybe (l2 a))
forall (layout :: * -> *) a.
LayoutClass layout a =>
Workspace String (layout a) a
-> Rectangle -> X ([(a, Rectangle)], Maybe (layout a))
runLayout (String -> l2 a -> Maybe (Stack a) -> Workspace String (l2 a) a
forall i l a. i -> l -> Maybe (Stack a) -> Workspace i l a
W.Workspace String
i l2 a
lf Maybe (Stack a)
ms) Rectangle
r
                                   ([(a, Rectangle)], Maybe (PerScreen l1 l2 a))
-> X ([(a, Rectangle)], Maybe (PerScreen l1 l2 a))
forall (m :: * -> *) a. Monad m => a -> m a
return ([(a, Rectangle)]
wrs, PerScreen l1 l2 a -> Maybe (PerScreen l1 l2 a)
forall a. a -> Maybe a
Just (PerScreen l1 l2 a -> Maybe (PerScreen l1 l2 a))
-> PerScreen l1 l2 a -> Maybe (PerScreen l1 l2 a)
forall a b. (a -> b) -> a -> b
$ PerScreen l1 l2 a -> Maybe (l2 a) -> PerScreen l1 l2 a
forall (l1 :: * -> *) (l2 :: * -> *) a.
PerScreen l1 l2 a -> Maybe (l2 a) -> PerScreen l1 l2 a
mkNewPerScreenF PerScreen l1 l2 a
p Maybe (l2 a)
mlt')

    handleMessage :: PerScreen l1 l2 a -> SomeMessage -> X (Maybe (PerScreen l1 l2 a))
handleMessage (PerScreen Dimension
w Bool
bool l1 a
lt l2 a
lf) SomeMessage
m
        | Bool
bool      = l1 a -> SomeMessage -> X (Maybe (l1 a))
forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> SomeMessage -> X (Maybe (layout a))
handleMessage l1 a
lt SomeMessage
m X (Maybe (l1 a))
-> (Maybe (l1 a) -> X (Maybe (PerScreen l1 l2 a)))
-> X (Maybe (PerScreen l1 l2 a))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= X (Maybe (PerScreen l1 l2 a))
-> (l1 a -> X (Maybe (PerScreen l1 l2 a)))
-> Maybe (l1 a)
-> X (Maybe (PerScreen l1 l2 a))
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Maybe (PerScreen l1 l2 a) -> X (Maybe (PerScreen l1 l2 a))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (PerScreen l1 l2 a)
forall a. Maybe a
Nothing) (\l1 a
nt -> Maybe (PerScreen l1 l2 a) -> X (Maybe (PerScreen l1 l2 a))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (PerScreen l1 l2 a) -> X (Maybe (PerScreen l1 l2 a)))
-> (PerScreen l1 l2 a -> Maybe (PerScreen l1 l2 a))
-> PerScreen l1 l2 a
-> X (Maybe (PerScreen l1 l2 a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PerScreen l1 l2 a -> Maybe (PerScreen l1 l2 a)
forall a. a -> Maybe a
Just (PerScreen l1 l2 a -> X (Maybe (PerScreen l1 l2 a)))
-> PerScreen l1 l2 a -> X (Maybe (PerScreen l1 l2 a))
forall a b. (a -> b) -> a -> b
$ Dimension -> Bool -> l1 a -> l2 a -> PerScreen l1 l2 a
forall (l1 :: * -> *) (l2 :: * -> *) a.
Dimension -> Bool -> l1 a -> l2 a -> PerScreen l1 l2 a
PerScreen Dimension
w Bool
bool l1 a
nt l2 a
lf)
        | Bool
otherwise = l2 a -> SomeMessage -> X (Maybe (l2 a))
forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> SomeMessage -> X (Maybe (layout a))
handleMessage l2 a
lf SomeMessage
m X (Maybe (l2 a))
-> (Maybe (l2 a) -> X (Maybe (PerScreen l1 l2 a)))
-> X (Maybe (PerScreen l1 l2 a))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= X (Maybe (PerScreen l1 l2 a))
-> (l2 a -> X (Maybe (PerScreen l1 l2 a)))
-> Maybe (l2 a)
-> X (Maybe (PerScreen l1 l2 a))
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Maybe (PerScreen l1 l2 a) -> X (Maybe (PerScreen l1 l2 a))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (PerScreen l1 l2 a)
forall a. Maybe a
Nothing) (Maybe (PerScreen l1 l2 a) -> X (Maybe (PerScreen l1 l2 a))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (PerScreen l1 l2 a) -> X (Maybe (PerScreen l1 l2 a)))
-> (l2 a -> Maybe (PerScreen l1 l2 a))
-> l2 a
-> X (Maybe (PerScreen l1 l2 a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PerScreen l1 l2 a -> Maybe (PerScreen l1 l2 a)
forall a. a -> Maybe a
Just (PerScreen l1 l2 a -> Maybe (PerScreen l1 l2 a))
-> (l2 a -> PerScreen l1 l2 a) -> l2 a -> Maybe (PerScreen l1 l2 a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Dimension -> Bool -> l1 a -> l2 a -> PerScreen l1 l2 a
forall (l1 :: * -> *) (l2 :: * -> *) a.
Dimension -> Bool -> l1 a -> l2 a -> PerScreen l1 l2 a
PerScreen Dimension
w Bool
bool l1 a
lt)

    description :: PerScreen l1 l2 a -> String
description (PerScreen Dimension
_ Bool
True  l1 a
l1 l2 a
_) = l1 a -> String
forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> String
description l1 a
l1
    description (PerScreen Dimension
_ Bool
_     l1 a
_ l2 a
l2) = l2 a -> String
forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> String
description l2 a
l2