{-# LANGUAGE TypeSynonymInstances, FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, UndecidableInstances, PatternGuards, DeriveDataTypeable, ScopedTypeVariables #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  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 Control.Monad
import Data.Maybe (isJust)

import XMonad
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 prop :: p
prop box :: SubBox
box mbox :: Maybe SubBox
mbox sub :: l1 a
sub next :: 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 box :: SubBox
box sub :: 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) =>
    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 _ (LayoutP subf :: Maybe w
subf nextf :: Maybe w
nextf prop :: p
prop box :: SubBox
box mbox :: Maybe SubBox
mbox sub :: l1 w
sub next :: Maybe (l2 w)
next) s :: Maybe (Stack w)
s) rect :: Rectangle
rect
            = do (subs :: Maybe (Stack w)
subs,nexts :: Maybe (Stack w)
nexts,subf' :: Maybe w
subf',nextf' :: 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 -> (SubBox -> SubBox) -> Maybe SubBox -> SubBox
forall b a. b -> (a -> b) -> Maybe a -> b
maybe SubBox
box SubBox -> SubBox
forall a. a -> a
id Maybe SubBox
mbox

                 (sublist :: [(w, Rectangle)]
sublist,sub' :: 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

                 (nextlist :: [(w, Rectangle)]
nextlist,next' :: Maybe (l2 w)
next') <- case Maybe (l2 w)
next of 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 n :: l2 w
n -> do (res :: [(w, Rectangle)]
res,l :: 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 l :: layout a
l s' :: Maybe (Stack a)
s' r :: Rectangle
r = do (res :: [(a, Rectangle)]
res,ml :: 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 "" layout a
l Maybe (Stack a)
s') Rectangle
r
                                     layout a
l' <- layout a -> X (layout a)
forall (m :: * -> *) a. Monad m => a -> m a
return (layout a -> X (layout a)) -> layout a -> X (layout a)
forall a b. (a -> b) -> a -> b
$ layout a -> (layout a -> layout a) -> Maybe (layout a) -> layout a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe layout a
l layout a -> layout a
forall a. a -> a
id 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 l :: LayoutP p l1 l2 w
l m :: SomeMessage
m
            | Just (IncMasterN _) <- 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 _ _ _ _ _ sub :: l1 w
sub (Just next :: l2 w
next)) = "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 -> ShowS
forall a. [a] -> [a] -> [a]
++ l2 w -> String
forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> String
description l2 w
next
        description (LayoutP _ _ _ _ _ sub :: l1 w
sub Nothing)     = "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 subf :: Maybe a
subf nextf :: Maybe a
nextf prop :: p
prop box :: SubBox
box mbox :: Maybe SubBox
mbox sub :: l1 a
sub next :: Maybe (l2 a)
next) m :: 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 -> (l1 a -> l1 a) -> Maybe (l1 a) -> l1 a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe l1 a
sub l1 a -> l1 a
forall a. a -> a
id 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 _ _ _ _ _ _ Nothing) m :: 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 subf :: Maybe a
subf nextf :: Maybe a
nextf prop :: p
prop box :: SubBox
box mbox :: Maybe SubBox
mbox sub :: l1 a
sub (Just next :: l2 a
next)) m :: 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 -> (l1 a -> l1 a) -> Maybe (l1 a) -> l1 a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe l1 a
sub l1 a -> l1 a
forall a. a -> a
id 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 -> (l2 a -> l2 a) -> Maybe (l2 a) -> l2 a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe l2 a
next l2 a -> l2 a
forall a. a -> a
id 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 _ _ _ _ _ _ Nothing) _ = 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 subf :: Maybe a
subf nextf :: Maybe a
nextf prop :: p
prop box :: SubBox
box mbox :: Maybe SubBox
mbox sub :: l1 a
sub (Just next :: l2 a
next)) m :: 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 subf :: Maybe a
subf _ _ _ _ _ _) m :: 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 Nothing = Bool -> X Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
isFocus (Just w :: 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
`fmap` (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 (\s :: 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 (Window -> String) -> Window -> String
forall a b. (a -> b) -> a -> b
$ 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 prop :: p
prop ws :: [w]
ws = (([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 ([], []) [w]
ws
  where
    step :: ([a], [a]) -> a -> X ([a], [a])
step (good :: [a]
good, bad :: [a]
bad) w :: 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 Nothing _ _ _ = (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 s :: Stack w
s) prop :: p
prop subf :: Maybe w
subf nextf :: Maybe w
nextf = do
    let ws :: [w]
ws = Stack w -> [w]
forall a. Stack a -> [a]
W.integrate Stack w
s
    (good :: [w]
good, other :: [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
forall a. Maybe a
Nothing
    foc l :: [w]
l f :: Maybe w
f = if 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
              then 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
              else if 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
                   then Maybe w
f
                   else 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 xpos :: SubMeasure
xpos ypos :: SubMeasure
ypos width :: SubMeasure
width height :: SubMeasure
height) rect :: Rectangle
rect = Position -> Position -> Window -> Window -> Rectangle
Rectangle (Rectangle -> Position
rect_x Rectangle
rect Position -> Position -> Position
forall a. Num a => a -> a -> a
+ Window -> Position
forall a b. (Integral a, Num b) => a -> b
fromIntegral Window
xpos') (Rectangle -> Position
rect_y Rectangle
rect Position -> Position -> Position
forall a. Num a => a -> a -> a
+ Window -> Position
forall a b. (Integral a, Num b) => a -> b
fromIntegral Window
ypos') Window
width' Window
height'
    where
        xpos' :: Window
xpos' = Bool -> SubMeasure -> Window -> Window
forall a b. (Integral a, Num b) => Bool -> SubMeasure -> a -> b
calc Bool
False SubMeasure
xpos (Window -> Window) -> Window -> Window
forall a b. (a -> b) -> a -> b
$ Rectangle -> Window
rect_width Rectangle
rect
        ypos' :: Window
ypos' = Bool -> SubMeasure -> Window -> Window
forall a b. (Integral a, Num b) => Bool -> SubMeasure -> a -> b
calc Bool
False SubMeasure
ypos (Window -> Window) -> Window -> Window
forall a b. (a -> b) -> a -> b
$ Rectangle -> Window
rect_height Rectangle
rect
        width' :: Window
width' = Bool -> SubMeasure -> Window -> Window
forall a b. (Integral a, Num b) => Bool -> SubMeasure -> a -> b
calc Bool
True SubMeasure
width (Window -> Window) -> Window -> Window
forall a b. (a -> b) -> a -> b
$ Rectangle -> Window
rect_width Rectangle
rect Window -> Window -> Window
forall a. Num a => a -> a -> a
- Window
xpos'
        height' :: Window
height' = Bool -> SubMeasure -> Window -> Window
forall a b. (Integral a, Num b) => Bool -> SubMeasure -> a -> b
calc Bool
True SubMeasure
height (Window -> Window) -> Window -> Window
forall a b. (a -> b) -> a -> b
$ Rectangle -> Window
rect_height Rectangle
rect Window -> Window -> Window
forall a. Num a => a -> a -> a
- Window
ypos'

        calc :: Bool -> SubMeasure -> a -> b
calc zneg :: Bool
zneg val :: SubMeasure
val tot :: 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 0 (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$
            case SubMeasure
val of B.Rel v :: 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 v :: Int
v -> if Int
vInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<0 Bool -> Bool -> Bool
|| (Bool
zneg Bool -> Bool -> Bool
&& Int
vInt -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==0)
                                 then (a -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
tot)Int -> 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 (Stack q)
forall a. Maybe a
Nothing
differentiate' Nothing w :: [q]
w = [q] -> Maybe (Stack q)
forall a. [a] -> Maybe (Stack a)
W.differentiate [q]
w
differentiate' (Just f :: q
f) w :: [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
$ $WStack :: 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 _ = Bool -> Property
Const Bool
True
  checkPredicate :: Property -> Window -> X Bool
checkPredicate = Property -> Window -> X Bool
hasProperty