{-# LANGUAGE FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, UndecidableInstances, PatternGuards, ScopedTypeVariables #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  XMonad.Layout.LayoutBuilderP
-- Description :  (DEPRECATED) An old version of "XMonad.Layout.LayoutBuilderP".
-- Copyright   :  (c) 2009 Anders Engstrom <ankaan@gmail.com>, 2011 Ilya Portnov <portnov84@rambler.ru>
-- License     :  BSD3-style (see LICENSE)
--
-- Maintainer  :  Ilya Portnov <portnov84@rambler.ru>
-- Stability   :  unstable
-- Portability :  unportable
--
-- DEPRECATED.  Use 'XMonad.Layout.LayoutBuilder' instead.
--
-----------------------------------------------------------------------------

module XMonad.Layout.LayoutBuilderP {-# DEPRECATED "Use XMonad.Layout.LayoutBuilder instead" #-} (
  LayoutP (..),
  layoutP, layoutAll,
  B.relBox, B.absBox,
  -- * Overloading ways to select windows
  -- $selectWin
  Predicate (..), Proxy(..),
  ) where

import XMonad
import XMonad.Prelude hiding (Const)
import qualified XMonad.StackSet as W
import XMonad.Util.WindowProperties

import qualified XMonad.Layout.LayoutBuilder as B

-- $selectWin
--
-- 'Predicate' exists because layouts are required to be serializable, and
-- "XMonad.Util.WindowProperties" is not sufficient (for example it does not
-- allow using regular expressions).
--
-- compare "XMonad.Util.Invisible"

-- | Type class for predicates. This enables us to manage not only Windows,
-- but any objects, for which instance Predicate is defined.
--
-- Another instance exists in XMonad.Util.WindowPropertiesRE in xmonad-extras
class Predicate p w where
  alwaysTrue :: Proxy w -> p         -- ^ A predicate that is always True.
  checkPredicate :: p -> w -> X Bool -- ^ Check if given object (window or smth else) matches that predicate

-- | Contains no actual data, but is needed to help select the correct instance
-- of 'Predicate'
data Proxy a = Proxy

-- | Data type for our layout.
data LayoutP p l1 l2 a =
    LayoutP (Maybe a) (Maybe a) p B.SubBox (Maybe B.SubBox) (l1 a) (Maybe (l2 a))
    deriving (Int -> LayoutP p l1 l2 a -> ShowS
[LayoutP p l1 l2 a] -> ShowS
LayoutP p l1 l2 a -> String
(Int -> LayoutP p l1 l2 a -> ShowS)
-> (LayoutP p l1 l2 a -> String)
-> ([LayoutP p l1 l2 a] -> ShowS)
-> Show (LayoutP p l1 l2 a)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall p (l1 :: * -> *) (l2 :: * -> *) a.
(Show a, Show p, Show (l1 a), Show (l2 a)) =>
Int -> LayoutP p l1 l2 a -> ShowS
forall p (l1 :: * -> *) (l2 :: * -> *) a.
(Show a, Show p, Show (l1 a), Show (l2 a)) =>
[LayoutP p l1 l2 a] -> ShowS
forall p (l1 :: * -> *) (l2 :: * -> *) a.
(Show a, Show p, Show (l1 a), Show (l2 a)) =>
LayoutP p l1 l2 a -> String
showList :: [LayoutP p l1 l2 a] -> ShowS
$cshowList :: forall p (l1 :: * -> *) (l2 :: * -> *) a.
(Show a, Show p, Show (l1 a), Show (l2 a)) =>
[LayoutP p l1 l2 a] -> ShowS
show :: LayoutP p l1 l2 a -> String
$cshow :: forall p (l1 :: * -> *) (l2 :: * -> *) a.
(Show a, Show p, Show (l1 a), Show (l2 a)) =>
LayoutP p l1 l2 a -> String
showsPrec :: Int -> LayoutP p l1 l2 a -> ShowS
$cshowsPrec :: forall p (l1 :: * -> *) (l2 :: * -> *) a.
(Show a, Show p, Show (l1 a), Show (l2 a)) =>
Int -> LayoutP p l1 l2 a -> ShowS
Show,ReadPrec [LayoutP p l1 l2 a]
ReadPrec (LayoutP p l1 l2 a)
Int -> ReadS (LayoutP p l1 l2 a)
ReadS [LayoutP p l1 l2 a]
(Int -> ReadS (LayoutP p l1 l2 a))
-> ReadS [LayoutP p l1 l2 a]
-> ReadPrec (LayoutP p l1 l2 a)
-> ReadPrec [LayoutP p l1 l2 a]
-> Read (LayoutP p l1 l2 a)
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
forall p (l1 :: * -> *) (l2 :: * -> *) a.
(Read a, Read p, Read (l1 a), Read (l2 a)) =>
ReadPrec [LayoutP p l1 l2 a]
forall p (l1 :: * -> *) (l2 :: * -> *) a.
(Read a, Read p, Read (l1 a), Read (l2 a)) =>
ReadPrec (LayoutP p l1 l2 a)
forall p (l1 :: * -> *) (l2 :: * -> *) a.
(Read a, Read p, Read (l1 a), Read (l2 a)) =>
Int -> ReadS (LayoutP p l1 l2 a)
forall p (l1 :: * -> *) (l2 :: * -> *) a.
(Read a, Read p, Read (l1 a), Read (l2 a)) =>
ReadS [LayoutP p l1 l2 a]
readListPrec :: ReadPrec [LayoutP p l1 l2 a]
$creadListPrec :: forall p (l1 :: * -> *) (l2 :: * -> *) a.
(Read a, Read p, Read (l1 a), Read (l2 a)) =>
ReadPrec [LayoutP p l1 l2 a]
readPrec :: ReadPrec (LayoutP p l1 l2 a)
$creadPrec :: forall p (l1 :: * -> *) (l2 :: * -> *) a.
(Read a, Read p, Read (l1 a), Read (l2 a)) =>
ReadPrec (LayoutP p l1 l2 a)
readList :: ReadS [LayoutP p l1 l2 a]
$creadList :: forall p (l1 :: * -> *) (l2 :: * -> *) a.
(Read a, Read p, Read (l1 a), Read (l2 a)) =>
ReadS [LayoutP p l1 l2 a]
readsPrec :: Int -> ReadS (LayoutP p l1 l2 a)
$creadsPrec :: forall p (l1 :: * -> *) (l2 :: * -> *) a.
(Read a, Read p, Read (l1 a), Read (l2 a)) =>
Int -> ReadS (LayoutP p l1 l2 a)
Read)

-- | Use the specified layout in the described area windows that match given predicate and send the rest of the windows to the next layout in the chain.
--   It is possible to supply an alternative area that will then be used instead, if there are no windows to send to the next layout.
{-# DEPRECATED layoutP "Use XMonad.Layout.LayoutBuilder.layoutP instead." #-}
layoutP :: (Read a, Eq a, LayoutClass l1 a, LayoutClass l2 a, LayoutClass l3 a, Predicate p a) =>
       p
    -> B.SubBox                       -- ^ The box to place the windows in
    -> Maybe B.SubBox                 -- ^ Possibly an alternative box that is used when this layout handles all windows that are left
    -> l1 a                         -- ^ The layout to use in the specified area
    -> LayoutP p l2 l3 a              -- ^ Where to send the remaining windows
    -> LayoutP p l1 (LayoutP p l2 l3) a -- ^ The resulting layout
layoutP :: p
-> SubBox
-> Maybe SubBox
-> l1 a
-> LayoutP p l2 l3 a
-> LayoutP p l1 (LayoutP p l2 l3) a
layoutP p
prop SubBox
box Maybe SubBox
mbox l1 a
sub LayoutP p l2 l3 a
next = Maybe a
-> Maybe a
-> p
-> SubBox
-> Maybe SubBox
-> l1 a
-> Maybe (LayoutP p l2 l3 a)
-> LayoutP p l1 (LayoutP p l2 l3) a
forall p (l1 :: * -> *) (l2 :: * -> *) a.
Maybe a
-> Maybe a
-> p
-> SubBox
-> Maybe SubBox
-> l1 a
-> Maybe (l2 a)
-> LayoutP p l1 l2 a
LayoutP Maybe a
forall a. Maybe a
Nothing Maybe a
forall a. Maybe a
Nothing p
prop SubBox
box Maybe SubBox
mbox l1 a
sub (LayoutP p l2 l3 a -> Maybe (LayoutP p l2 l3 a)
forall a. a -> Maybe a
Just LayoutP p l2 l3 a
next)

-- | Use the specified layout in the described area for all remaining windows.
{-# DEPRECATED layoutAll "Use XMonad.Layout.LayoutBuilder.layoutAll instead." #-}
layoutAll :: forall l1 p a. (Read a, Eq a, LayoutClass l1 a, Predicate p a) =>
       B.SubBox             -- ^ The box to place the windows in
    -> l1 a               -- ^ The layout to use in the specified area
    -> LayoutP p l1 Full a  -- ^ The resulting layout
layoutAll :: SubBox -> l1 a -> LayoutP p l1 Full a
layoutAll SubBox
box l1 a
sub =
  let a :: p
a = Proxy a -> p
forall p w. Predicate p w => Proxy w -> p
alwaysTrue (Proxy a
forall a. Proxy a
Proxy :: Proxy a)
  in  Maybe a
-> Maybe a
-> p
-> SubBox
-> Maybe SubBox
-> l1 a
-> Maybe (Full a)
-> LayoutP p l1 Full a
forall p (l1 :: * -> *) (l2 :: * -> *) a.
Maybe a
-> Maybe a
-> p
-> SubBox
-> Maybe SubBox
-> l1 a
-> Maybe (l2 a)
-> LayoutP p l1 l2 a
LayoutP Maybe a
forall a. Maybe a
Nothing Maybe a
forall a. Maybe a
Nothing p
a SubBox
box Maybe SubBox
forall a. Maybe a
Nothing l1 a
sub Maybe (Full a)
forall a. Maybe a
Nothing

instance (LayoutClass l1 w, LayoutClass l2 w, Predicate p w, Show w, Read w, Eq w, Typeable w, Show p, Typeable p) =>
    LayoutClass (LayoutP p l1 l2) w where

        -- | Update window locations.
        runLayout :: Workspace String (LayoutP p l1 l2 w) w
-> Rectangle -> X ([(w, Rectangle)], Maybe (LayoutP p l1 l2 w))
runLayout (W.Workspace String
_ (LayoutP Maybe w
subf Maybe w
nextf p
prop SubBox
box Maybe SubBox
mbox l1 w
sub Maybe (l2 w)
next) Maybe (Stack w)
s) Rectangle
rect
            = do (Maybe (Stack w)
subs,Maybe (Stack w)
nexts,Maybe w
subf',Maybe w
nextf') <- Maybe (Stack w)
-> p
-> Maybe w
-> Maybe w
-> X (Maybe (Stack w), Maybe (Stack w), Maybe w, Maybe w)
forall p w.
(Predicate p w, Eq w) =>
Maybe (Stack w)
-> p
-> Maybe w
-> Maybe w
-> X (Maybe (Stack w), Maybe (Stack w), Maybe w, Maybe w)
splitStack Maybe (Stack w)
s p
prop Maybe w
subf Maybe w
nextf
                 let selBox :: SubBox
selBox = if Maybe w -> Bool
forall a. Maybe a -> Bool
isJust Maybe w
nextf'
                                then SubBox
box
                                else SubBox -> Maybe SubBox -> SubBox
forall a. a -> Maybe a -> a
fromMaybe SubBox
box Maybe SubBox
mbox

                 ([(w, Rectangle)]
sublist,l1 w
sub') <- l1 w -> Maybe (Stack w) -> Rectangle -> X ([(w, Rectangle)], l1 w)
forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a
-> Maybe (Stack a) -> Rectangle -> X ([(a, Rectangle)], layout a)
handle l1 w
sub Maybe (Stack w)
subs (Rectangle -> X ([(w, Rectangle)], l1 w))
-> Rectangle -> X ([(w, Rectangle)], l1 w)
forall a b. (a -> b) -> a -> b
$ SubBox -> Rectangle -> Rectangle
calcArea SubBox
selBox Rectangle
rect

                 ([(w, Rectangle)]
nextlist,Maybe (l2 w)
next') <- case Maybe (l2 w)
next of Maybe (l2 w)
Nothing -> ([(w, Rectangle)], Maybe (l2 w))
-> X ([(w, Rectangle)], Maybe (l2 w))
forall (m :: * -> *) a. Monad m => a -> m a
return ([],Maybe (l2 w)
forall a. Maybe a
Nothing)
                                                  Just l2 w
n -> do ([(w, Rectangle)]
res,l2 w
l) <- l2 w -> Maybe (Stack w) -> Rectangle -> X ([(w, Rectangle)], l2 w)
forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a
-> Maybe (Stack a) -> Rectangle -> X ([(a, Rectangle)], layout a)
handle l2 w
n Maybe (Stack w)
nexts Rectangle
rect
                                                               ([(w, Rectangle)], Maybe (l2 w))
-> X ([(w, Rectangle)], Maybe (l2 w))
forall (m :: * -> *) a. Monad m => a -> m a
return ([(w, Rectangle)]
res,l2 w -> Maybe (l2 w)
forall a. a -> Maybe a
Just l2 w
l)

                 ([(w, Rectangle)], Maybe (LayoutP p l1 l2 w))
-> X ([(w, Rectangle)], Maybe (LayoutP p l1 l2 w))
forall (m :: * -> *) a. Monad m => a -> m a
return ([(w, Rectangle)]
sublist[(w, Rectangle)] -> [(w, Rectangle)] -> [(w, Rectangle)]
forall a. [a] -> [a] -> [a]
++[(w, Rectangle)]
nextlist, LayoutP p l1 l2 w -> Maybe (LayoutP p l1 l2 w)
forall a. a -> Maybe a
Just (LayoutP p l1 l2 w -> Maybe (LayoutP p l1 l2 w))
-> LayoutP p l1 l2 w -> Maybe (LayoutP p l1 l2 w)
forall a b. (a -> b) -> a -> b
$ Maybe w
-> Maybe w
-> p
-> SubBox
-> Maybe SubBox
-> l1 w
-> Maybe (l2 w)
-> LayoutP p l1 l2 w
forall p (l1 :: * -> *) (l2 :: * -> *) a.
Maybe a
-> Maybe a
-> p
-> SubBox
-> Maybe SubBox
-> l1 a
-> Maybe (l2 a)
-> LayoutP p l1 l2 a
LayoutP Maybe w
subf' Maybe w
nextf' p
prop SubBox
box Maybe SubBox
mbox l1 w
sub' Maybe (l2 w)
next' )
              where
                  handle :: layout a
-> Maybe (Stack a) -> Rectangle -> X ([(a, Rectangle)], layout a)
handle layout a
l Maybe (Stack a)
s' Rectangle
r = do ([(a, Rectangle)]
res,Maybe (layout a)
ml) <- Workspace String (layout a) a
-> Rectangle -> X ([(a, Rectangle)], Maybe (layout a))
forall (layout :: * -> *) a.
LayoutClass layout a =>
Workspace String (layout a) a
-> Rectangle -> X ([(a, Rectangle)], Maybe (layout a))
runLayout (String
-> layout a -> Maybe (Stack a) -> Workspace String (layout a) a
forall i l a. i -> l -> Maybe (Stack a) -> Workspace i l a
W.Workspace String
"" layout a
l Maybe (Stack a)
s') Rectangle
r
                                     let l' :: layout a
l' = layout a -> Maybe (layout a) -> layout a
forall a. a -> Maybe a -> a
fromMaybe layout a
l Maybe (layout a)
ml
                                     ([(a, Rectangle)], layout a) -> X ([(a, Rectangle)], layout a)
forall (m :: * -> *) a. Monad m => a -> m a
return ([(a, Rectangle)]
res,layout a
l')

        -- |  Propagate messages.
        handleMessage :: LayoutP p l1 l2 w -> SomeMessage -> X (Maybe (LayoutP p l1 l2 w))
handleMessage LayoutP p l1 l2 w
l SomeMessage
m
            | Just (IncMasterN Int
_) <- SomeMessage -> Maybe IncMasterN
forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m = LayoutP p l1 l2 w -> SomeMessage -> X (Maybe (LayoutP p l1 l2 w))
forall (l1 :: * -> *) a (l2 :: * -> *) p.
(LayoutClass l1 a, LayoutClass l2 a, Read a, Show a, Eq a,
 Typeable a, Predicate p a) =>
LayoutP p l1 l2 a -> SomeMessage -> X (Maybe (LayoutP p l1 l2 a))
sendFocus LayoutP p l1 l2 w
l SomeMessage
m
            | Just Resize
Shrink         <- SomeMessage -> Maybe Resize
forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m = LayoutP p l1 l2 w -> SomeMessage -> X (Maybe (LayoutP p l1 l2 w))
forall (l1 :: * -> *) a (l2 :: * -> *) p.
(LayoutClass l1 a, LayoutClass l2 a, Read a, Show a, Eq a,
 Typeable a, Predicate p a) =>
LayoutP p l1 l2 a -> SomeMessage -> X (Maybe (LayoutP p l1 l2 a))
sendFocus LayoutP p l1 l2 w
l SomeMessage
m
            | Just Resize
Expand         <- SomeMessage -> Maybe Resize
forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m = LayoutP p l1 l2 w -> SomeMessage -> X (Maybe (LayoutP p l1 l2 w))
forall (l1 :: * -> *) a (l2 :: * -> *) p.
(LayoutClass l1 a, LayoutClass l2 a, Read a, Show a, Eq a,
 Typeable a, Predicate p a) =>
LayoutP p l1 l2 a -> SomeMessage -> X (Maybe (LayoutP p l1 l2 a))
sendFocus LayoutP p l1 l2 w
l SomeMessage
m
            | Bool
otherwise = LayoutP p l1 l2 w -> SomeMessage -> X (Maybe (LayoutP p l1 l2 w))
forall (l1 :: * -> *) a (l2 :: * -> *) p.
(LayoutClass l1 a, LayoutClass l2 a, Read a, Show a, Eq a,
 Typeable a, Predicate p a) =>
LayoutP p l1 l2 a -> SomeMessage -> X (Maybe (LayoutP p l1 l2 a))
sendBoth LayoutP p l1 l2 w
l SomeMessage
m

        -- |  Descriptive name for layout.
        description :: LayoutP p l1 l2 w -> String
description (LayoutP Maybe w
_ Maybe w
_ p
_ SubBox
_ Maybe SubBox
_ l1 w
sub (Just l2 w
next)) = String
"layoutP "String -> ShowS
forall a. [a] -> [a] -> [a]
++ l1 w -> String
forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> String
description l1 w
sub String -> ShowS
forall a. [a] -> [a] -> [a]
++String
" "String -> ShowS
forall a. [a] -> [a] -> [a]
++ l2 w -> String
forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> String
description l2 w
next
        description (LayoutP Maybe w
_ Maybe w
_ p
_ SubBox
_ Maybe SubBox
_ l1 w
sub Maybe (l2 w)
Nothing)     = String
"layoutP "String -> ShowS
forall a. [a] -> [a] -> [a]
++ l1 w -> String
forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> String
description l1 w
sub


sendSub :: (LayoutClass l1 a, LayoutClass l2 a, Read a, Show a, Eq a, Typeable a, Predicate p a)
        => LayoutP p l1 l2 a -> SomeMessage -> X (Maybe (LayoutP p l1 l2 a))
sendSub :: LayoutP p l1 l2 a -> SomeMessage -> X (Maybe (LayoutP p l1 l2 a))
sendSub (LayoutP Maybe a
subf Maybe a
nextf p
prop SubBox
box Maybe SubBox
mbox l1 a
sub Maybe (l2 a)
next) SomeMessage
m =
    do Maybe (l1 a)
sub' <- l1 a -> SomeMessage -> X (Maybe (l1 a))
forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> SomeMessage -> X (Maybe (layout a))
handleMessage l1 a
sub SomeMessage
m
       Maybe (LayoutP p l1 l2 a) -> X (Maybe (LayoutP p l1 l2 a))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (LayoutP p l1 l2 a) -> X (Maybe (LayoutP p l1 l2 a)))
-> Maybe (LayoutP p l1 l2 a) -> X (Maybe (LayoutP p l1 l2 a))
forall a b. (a -> b) -> a -> b
$ if Maybe (l1 a) -> Bool
forall a. Maybe a -> Bool
isJust Maybe (l1 a)
sub'
                then LayoutP p l1 l2 a -> Maybe (LayoutP p l1 l2 a)
forall a. a -> Maybe a
Just (LayoutP p l1 l2 a -> Maybe (LayoutP p l1 l2 a))
-> LayoutP p l1 l2 a -> Maybe (LayoutP p l1 l2 a)
forall a b. (a -> b) -> a -> b
$ Maybe a
-> Maybe a
-> p
-> SubBox
-> Maybe SubBox
-> l1 a
-> Maybe (l2 a)
-> LayoutP p l1 l2 a
forall p (l1 :: * -> *) (l2 :: * -> *) a.
Maybe a
-> Maybe a
-> p
-> SubBox
-> Maybe SubBox
-> l1 a
-> Maybe (l2 a)
-> LayoutP p l1 l2 a
LayoutP Maybe a
subf Maybe a
nextf p
prop SubBox
box Maybe SubBox
mbox (l1 a -> Maybe (l1 a) -> l1 a
forall a. a -> Maybe a -> a
fromMaybe l1 a
sub Maybe (l1 a)
sub') Maybe (l2 a)
next
                else Maybe (LayoutP p l1 l2 a)
forall a. Maybe a
Nothing

sendBoth :: (LayoutClass l1 a, LayoutClass l2 a, Read a, Show a, Eq a, Typeable a, Predicate p a)
         => LayoutP p l1 l2 a -> SomeMessage -> X (Maybe (LayoutP p l1 l2 a))
sendBoth :: LayoutP p l1 l2 a -> SomeMessage -> X (Maybe (LayoutP p l1 l2 a))
sendBoth l :: LayoutP p l1 l2 a
l@(LayoutP Maybe a
_ Maybe a
_ p
_ SubBox
_ Maybe SubBox
_ l1 a
_ Maybe (l2 a)
Nothing) SomeMessage
m = LayoutP p l1 l2 a -> SomeMessage -> X (Maybe (LayoutP p l1 l2 a))
forall (l1 :: * -> *) a (l2 :: * -> *) p.
(LayoutClass l1 a, LayoutClass l2 a, Read a, Show a, Eq a,
 Typeable a, Predicate p a) =>
LayoutP p l1 l2 a -> SomeMessage -> X (Maybe (LayoutP p l1 l2 a))
sendSub LayoutP p l1 l2 a
l SomeMessage
m
sendBoth (LayoutP Maybe a
subf Maybe a
nextf p
prop SubBox
box Maybe SubBox
mbox l1 a
sub (Just l2 a
next)) SomeMessage
m =
    do Maybe (l1 a)
sub' <- l1 a -> SomeMessage -> X (Maybe (l1 a))
forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> SomeMessage -> X (Maybe (layout a))
handleMessage l1 a
sub SomeMessage
m
       Maybe (l2 a)
next' <- l2 a -> SomeMessage -> X (Maybe (l2 a))
forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> SomeMessage -> X (Maybe (layout a))
handleMessage l2 a
next SomeMessage
m
       Maybe (LayoutP p l1 l2 a) -> X (Maybe (LayoutP p l1 l2 a))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (LayoutP p l1 l2 a) -> X (Maybe (LayoutP p l1 l2 a)))
-> Maybe (LayoutP p l1 l2 a) -> X (Maybe (LayoutP p l1 l2 a))
forall a b. (a -> b) -> a -> b
$ if Maybe (l1 a) -> Bool
forall a. Maybe a -> Bool
isJust Maybe (l1 a)
sub' Bool -> Bool -> Bool
|| Maybe (l2 a) -> Bool
forall a. Maybe a -> Bool
isJust Maybe (l2 a)
next'
                then LayoutP p l1 l2 a -> Maybe (LayoutP p l1 l2 a)
forall a. a -> Maybe a
Just (LayoutP p l1 l2 a -> Maybe (LayoutP p l1 l2 a))
-> LayoutP p l1 l2 a -> Maybe (LayoutP p l1 l2 a)
forall a b. (a -> b) -> a -> b
$ Maybe a
-> Maybe a
-> p
-> SubBox
-> Maybe SubBox
-> l1 a
-> Maybe (l2 a)
-> LayoutP p l1 l2 a
forall p (l1 :: * -> *) (l2 :: * -> *) a.
Maybe a
-> Maybe a
-> p
-> SubBox
-> Maybe SubBox
-> l1 a
-> Maybe (l2 a)
-> LayoutP p l1 l2 a
LayoutP Maybe a
subf Maybe a
nextf p
prop SubBox
box Maybe SubBox
mbox (l1 a -> Maybe (l1 a) -> l1 a
forall a. a -> Maybe a -> a
fromMaybe l1 a
sub Maybe (l1 a)
sub') (l2 a -> Maybe (l2 a)
forall a. a -> Maybe a
Just (l2 a -> Maybe (l2 a)) -> l2 a -> Maybe (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
next Maybe (l2 a)
next')
                else Maybe (LayoutP p l1 l2 a)
forall a. Maybe a
Nothing

sendNext :: (LayoutClass l1 a, LayoutClass l2 a, Read a, Show a, Eq a, Typeable a, Predicate p a)
         => LayoutP p l1 l2 a -> SomeMessage -> X (Maybe (LayoutP p l1 l2 a))
sendNext :: LayoutP p l1 l2 a -> SomeMessage -> X (Maybe (LayoutP p l1 l2 a))
sendNext (LayoutP Maybe a
_ Maybe a
_ p
_ SubBox
_ Maybe SubBox
_ l1 a
_ Maybe (l2 a)
Nothing) SomeMessage
_ = Maybe (LayoutP p l1 l2 a) -> X (Maybe (LayoutP p l1 l2 a))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (LayoutP p l1 l2 a)
forall a. Maybe a
Nothing
sendNext (LayoutP Maybe a
subf Maybe a
nextf p
prop SubBox
box Maybe SubBox
mbox l1 a
sub (Just l2 a
next)) SomeMessage
m =
    do Maybe (l2 a)
next' <- l2 a -> SomeMessage -> X (Maybe (l2 a))
forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> SomeMessage -> X (Maybe (layout a))
handleMessage l2 a
next SomeMessage
m
       Maybe (LayoutP p l1 l2 a) -> X (Maybe (LayoutP p l1 l2 a))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (LayoutP p l1 l2 a) -> X (Maybe (LayoutP p l1 l2 a)))
-> Maybe (LayoutP p l1 l2 a) -> X (Maybe (LayoutP p l1 l2 a))
forall a b. (a -> b) -> a -> b
$ if Maybe (l2 a) -> Bool
forall a. Maybe a -> Bool
isJust Maybe (l2 a)
next'
                then LayoutP p l1 l2 a -> Maybe (LayoutP p l1 l2 a)
forall a. a -> Maybe a
Just (LayoutP p l1 l2 a -> Maybe (LayoutP p l1 l2 a))
-> LayoutP p l1 l2 a -> Maybe (LayoutP p l1 l2 a)
forall a b. (a -> b) -> a -> b
$ Maybe a
-> Maybe a
-> p
-> SubBox
-> Maybe SubBox
-> l1 a
-> Maybe (l2 a)
-> LayoutP p l1 l2 a
forall p (l1 :: * -> *) (l2 :: * -> *) a.
Maybe a
-> Maybe a
-> p
-> SubBox
-> Maybe SubBox
-> l1 a
-> Maybe (l2 a)
-> LayoutP p l1 l2 a
LayoutP Maybe a
subf Maybe a
nextf p
prop SubBox
box Maybe SubBox
mbox l1 a
sub Maybe (l2 a)
next'
                else Maybe (LayoutP p l1 l2 a)
forall a. Maybe a
Nothing

sendFocus :: (LayoutClass l1 a, LayoutClass l2 a, Read a, Show a, Eq a, Typeable a, Predicate p a)
          => LayoutP p l1 l2 a -> SomeMessage -> X (Maybe (LayoutP p l1 l2 a))
sendFocus :: LayoutP p l1 l2 a -> SomeMessage -> X (Maybe (LayoutP p l1 l2 a))
sendFocus l :: LayoutP p l1 l2 a
l@(LayoutP Maybe a
subf Maybe a
_ p
_ SubBox
_ Maybe SubBox
_ l1 a
_ Maybe (l2 a)
_) SomeMessage
m = do Bool
foc <- Maybe a -> X Bool
forall a. Show a => Maybe a -> X Bool
isFocus Maybe a
subf
                                              if Bool
foc then LayoutP p l1 l2 a -> SomeMessage -> X (Maybe (LayoutP p l1 l2 a))
forall (l1 :: * -> *) a (l2 :: * -> *) p.
(LayoutClass l1 a, LayoutClass l2 a, Read a, Show a, Eq a,
 Typeable a, Predicate p a) =>
LayoutP p l1 l2 a -> SomeMessage -> X (Maybe (LayoutP p l1 l2 a))
sendSub LayoutP p l1 l2 a
l SomeMessage
m
                                                     else LayoutP p l1 l2 a -> SomeMessage -> X (Maybe (LayoutP p l1 l2 a))
forall (l1 :: * -> *) a (l2 :: * -> *) p.
(LayoutClass l1 a, LayoutClass l2 a, Read a, Show a, Eq a,
 Typeable a, Predicate p a) =>
LayoutP p l1 l2 a -> SomeMessage -> X (Maybe (LayoutP p l1 l2 a))
sendNext LayoutP p l1 l2 a
l SomeMessage
m

isFocus :: (Show a) => Maybe a -> X Bool
isFocus :: Maybe a -> X Bool
isFocus Maybe a
Nothing = Bool -> X Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
isFocus (Just a
w) = do Maybe (Stack Window)
ms <- Workspace String (Layout Window) Window -> Maybe (Stack Window)
forall i l a. Workspace i l a -> Maybe (Stack a)
W.stack (Workspace String (Layout Window) Window -> Maybe (Stack Window))
-> (StackSet String (Layout Window) Window ScreenId ScreenDetail
    -> Workspace String (Layout Window) Window)
-> StackSet String (Layout Window) Window ScreenId ScreenDetail
-> Maybe (Stack Window)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Screen String (Layout Window) Window ScreenId ScreenDetail
-> Workspace String (Layout Window) Window
forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
W.workspace (Screen String (Layout Window) Window ScreenId ScreenDetail
 -> Workspace String (Layout Window) Window)
-> (StackSet String (Layout Window) Window ScreenId ScreenDetail
    -> Screen String (Layout Window) Window ScreenId ScreenDetail)
-> StackSet String (Layout Window) Window ScreenId ScreenDetail
-> Workspace String (Layout Window) Window
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StackSet String (Layout Window) Window ScreenId ScreenDetail
-> Screen String (Layout Window) Window ScreenId ScreenDetail
forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
W.current (StackSet String (Layout Window) Window ScreenId ScreenDetail
 -> Maybe (Stack Window))
-> X (StackSet String (Layout Window) Window ScreenId ScreenDetail)
-> X (Maybe (Stack Window))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (XState
 -> StackSet String (Layout Window) Window ScreenId ScreenDetail)
-> X (StackSet String (Layout Window) Window ScreenId ScreenDetail)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets XState
-> StackSet String (Layout Window) Window ScreenId ScreenDetail
windowset
                      Bool -> X Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> X Bool) -> Bool -> X Bool
forall a b. (a -> b) -> a -> b
$ Bool -> (Stack Window -> Bool) -> Maybe (Stack Window) -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (\Stack Window
s -> a -> String
forall a. Show a => a -> String
show a
w String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== Window -> String
forall a. Show a => a -> String
show (Stack Window -> Window
forall a. Stack a -> a
W.focus Stack Window
s)) Maybe (Stack Window)
ms


-- | Split given list of objects (i.e. windows) using predicate.
splitBy :: (Predicate p w) => p -> [w] -> X ([w], [w])
splitBy :: p -> [w] -> X ([w], [w])
splitBy p
prop = (([w], [w]) -> w -> X ([w], [w]))
-> ([w], [w]) -> [w] -> X ([w], [w])
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM ([w], [w]) -> w -> X ([w], [w])
forall a. Predicate p a => ([a], [a]) -> a -> X ([a], [a])
step ([], [])
  where
    step :: ([a], [a]) -> a -> X ([a], [a])
step ([a]
good, [a]
bad) a
w = do
      Bool
ok <- p -> a -> X Bool
forall p w. Predicate p w => p -> w -> X Bool
checkPredicate p
prop a
w
      ([a], [a]) -> X ([a], [a])
forall (m :: * -> *) a. Monad m => a -> m a
return (([a], [a]) -> X ([a], [a])) -> ([a], [a]) -> X ([a], [a])
forall a b. (a -> b) -> a -> b
$ if Bool
ok
                then (a
wa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
good, [a]
bad)
                else ([a]
good,   a
wa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
bad)

splitStack :: (Predicate p w, Eq w) => Maybe (W.Stack w) -> p -> Maybe w -> Maybe w -> X (Maybe (W.Stack w),Maybe (W.Stack w),Maybe w,Maybe w)
splitStack :: Maybe (Stack w)
-> p
-> Maybe w
-> Maybe w
-> X (Maybe (Stack w), Maybe (Stack w), Maybe w, Maybe w)
splitStack Maybe (Stack w)
Nothing p
_ Maybe w
_ Maybe w
_ = (Maybe (Stack w), Maybe (Stack w), Maybe w, Maybe w)
-> X (Maybe (Stack w), Maybe (Stack w), Maybe w, Maybe w)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Stack w)
forall a. Maybe a
Nothing,Maybe (Stack w)
forall a. Maybe a
Nothing,Maybe w
forall a. Maybe a
Nothing,Maybe w
forall a. Maybe a
Nothing)
splitStack (Just Stack w
s) p
prop Maybe w
subf Maybe w
nextf = do
    let ws :: [w]
ws = Stack w -> [w]
forall a. Stack a -> [a]
W.integrate Stack w
s
    ([w]
good, [w]
other) <- p -> [w] -> X ([w], [w])
forall p w. Predicate p w => p -> [w] -> X ([w], [w])
splitBy p
prop [w]
ws
    let subf' :: Maybe w
subf'  = [w] -> Maybe w -> Maybe w
foc [w]
good Maybe w
subf
        nextf' :: Maybe w
nextf' = [w] -> Maybe w -> Maybe w
foc [w]
other Maybe w
nextf
    (Maybe (Stack w), Maybe (Stack w), Maybe w, Maybe w)
-> X (Maybe (Stack w), Maybe (Stack w), Maybe w, Maybe w)
forall (m :: * -> *) a. Monad m => a -> m a
return ( Maybe w -> [w] -> Maybe (Stack w)
forall q. Eq q => Maybe q -> [q] -> Maybe (Stack q)
differentiate' Maybe w
subf' [w]
good
           , Maybe w -> [w] -> Maybe (Stack w)
forall q. Eq q => Maybe q -> [q] -> Maybe (Stack q)
differentiate' Maybe w
nextf' [w]
other
           , Maybe w
subf'
           , Maybe w
nextf'
           )
  where
    foc :: [w] -> Maybe w -> Maybe w
foc [] Maybe w
_ = Maybe w
forall a. Maybe a
Nothing
    foc [w]
l Maybe w
f
      | Stack w -> w
forall a. Stack a -> a
W.focus Stack w
s w -> [w] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [w]
l = w -> Maybe w
forall a. a -> Maybe a
Just (w -> Maybe w) -> w -> Maybe w
forall a b. (a -> b) -> a -> b
$ Stack w -> w
forall a. Stack a -> a
W.focus Stack w
s
      | Bool -> (w -> Bool) -> Maybe w -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (w -> [w] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [w]
l) Maybe w
f = Maybe w
f
      | Bool
otherwise = w -> Maybe w
forall a. a -> Maybe a
Just (w -> Maybe w) -> w -> Maybe w
forall a b. (a -> b) -> a -> b
$ [w] -> w
forall a. [a] -> a
head [w]
l

calcArea :: B.SubBox -> Rectangle -> Rectangle
calcArea :: SubBox -> Rectangle -> Rectangle
calcArea (B.SubBox SubMeasure
xpos SubMeasure
ypos SubMeasure
width SubMeasure
height) Rectangle
rect = Position -> Position -> Dimension -> Dimension -> Rectangle
Rectangle (Rectangle -> Position
rect_x Rectangle
rect Position -> Position -> Position
forall a. Num a => a -> a -> a
+ Dimension -> Position
forall a b. (Integral a, Num b) => a -> b
fromIntegral Dimension
xpos') (Rectangle -> Position
rect_y Rectangle
rect Position -> Position -> Position
forall a. Num a => a -> a -> a
+ Dimension -> Position
forall a b. (Integral a, Num b) => a -> b
fromIntegral Dimension
ypos') Dimension
width' Dimension
height'
    where
        xpos' :: Dimension
xpos' = Bool -> SubMeasure -> Dimension -> Dimension
forall a b. (Integral a, Num b) => Bool -> SubMeasure -> a -> b
calc Bool
False SubMeasure
xpos (Dimension -> Dimension) -> Dimension -> Dimension
forall a b. (a -> b) -> a -> b
$ Rectangle -> Dimension
rect_width Rectangle
rect
        ypos' :: Dimension
ypos' = Bool -> SubMeasure -> Dimension -> Dimension
forall a b. (Integral a, Num b) => Bool -> SubMeasure -> a -> b
calc Bool
False SubMeasure
ypos (Dimension -> Dimension) -> Dimension -> Dimension
forall a b. (a -> b) -> a -> b
$ Rectangle -> Dimension
rect_height Rectangle
rect
        width' :: Dimension
width' = Bool -> SubMeasure -> Dimension -> Dimension
forall a b. (Integral a, Num b) => Bool -> SubMeasure -> a -> b
calc Bool
True SubMeasure
width (Dimension -> Dimension) -> Dimension -> Dimension
forall a b. (a -> b) -> a -> b
$ Rectangle -> Dimension
rect_width Rectangle
rect Dimension -> Dimension -> Dimension
forall a. Num a => a -> a -> a
- Dimension
xpos'
        height' :: Dimension
height' = Bool -> SubMeasure -> Dimension -> Dimension
forall a b. (Integral a, Num b) => Bool -> SubMeasure -> a -> b
calc Bool
True SubMeasure
height (Dimension -> Dimension) -> Dimension -> Dimension
forall a b. (a -> b) -> a -> b
$ Rectangle -> Dimension
rect_height Rectangle
rect Dimension -> Dimension -> Dimension
forall a. Num a => a -> a -> a
- Dimension
ypos'

        calc :: Bool -> SubMeasure -> a -> b
calc Bool
zneg SubMeasure
val a
tot = Int -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> b) -> Int -> b
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int
forall a. Ord a => a -> a -> a
min (a -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
tot) (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$
            case SubMeasure
val of B.Rel Rational
v -> Rational -> Int
forall a b. (RealFrac a, Integral b) => a -> b
floor (Rational -> Int) -> Rational -> Int
forall a b. (a -> b) -> a -> b
$ Rational
v Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* a -> Rational
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
tot
                        B.Abs Int
v -> if Int
vInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<Int
0 Bool -> Bool -> Bool
|| (Bool
zneg Bool -> Bool -> Bool
&& Int
vInt -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==Int
0)
                                 then a -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
totInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
v
                                 else Int
v

differentiate' :: Eq q => Maybe q -> [q] -> Maybe (W.Stack q)
differentiate' :: Maybe q -> [q] -> Maybe (Stack q)
differentiate' Maybe q
_ [] = Maybe (Stack q)
forall a. Maybe a
Nothing
differentiate' Maybe q
Nothing [q]
w = [q] -> Maybe (Stack q)
forall a. [a] -> Maybe (Stack a)
W.differentiate [q]
w
differentiate' (Just q
f) [q]
w
    | q
f q -> [q] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [q]
w = Stack q -> Maybe (Stack q)
forall a. a -> Maybe a
Just (Stack q -> Maybe (Stack q)) -> Stack q -> Maybe (Stack q)
forall a b. (a -> b) -> a -> b
$ Stack :: forall a. a -> [a] -> [a] -> Stack a
W.Stack { focus :: q
W.focus = q
f
                                  , up :: [q]
W.up    = [q] -> [q]
forall a. [a] -> [a]
reverse ([q] -> [q]) -> [q] -> [q]
forall a b. (a -> b) -> a -> b
$ (q -> Bool) -> [q] -> [q]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (q -> q -> Bool
forall a. Eq a => a -> a -> Bool
/=q
f) [q]
w
                                  , down :: [q]
W.down  = [q] -> [q]
forall a. [a] -> [a]
tail ([q] -> [q]) -> [q] -> [q]
forall a b. (a -> b) -> a -> b
$ (q -> Bool) -> [q] -> [q]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (q -> q -> Bool
forall a. Eq a => a -> a -> Bool
/=q
f) [q]
w
                                  }
    | Bool
otherwise = [q] -> Maybe (Stack q)
forall a. [a] -> Maybe (Stack a)
W.differentiate [q]
w

instance Predicate Property Window where
  alwaysTrue :: Proxy Window -> Property
alwaysTrue Proxy Window
_ = Bool -> Property
Const Bool
True
  checkPredicate :: Property -> Window -> X Bool
checkPredicate = Property -> Window -> X Bool
hasProperty