{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE PatternGuards #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE ScopedTypeVariables #-}
module XMonad.Layout.LayoutBuilder (
layoutN,
layoutR,
layoutP,
layoutAll,
Predicate (..),
Proxy(..),
IncLayoutN (..),
SubMeasure (..),
SubBox (..),
absBox,
relBox,
LayoutB,
LayoutN,
) where
import XMonad
import XMonad.Prelude (foldM, (<|>), isJust, fromMaybe, isNothing, listToMaybe)
import qualified XMonad.StackSet as W
import XMonad.Util.WindowProperties
class Predicate p w where
alwaysTrue :: Proxy w -> p
checkPredicate :: p -> w -> X Bool
instance Predicate () a where
alwaysTrue :: Proxy a -> ()
alwaysTrue Proxy a
_ = ()
checkPredicate :: () -> a -> X Bool
checkPredicate ()
_ a
_ = Bool -> X Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
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
data Proxy a = Proxy
data Limit p = LimitN Int
| LimitR (Rational, Rational)
| LimitP p
deriving (Int -> Limit p -> ShowS
[Limit p] -> ShowS
Limit p -> String
(Int -> Limit p -> ShowS)
-> (Limit p -> String) -> ([Limit p] -> ShowS) -> Show (Limit p)
forall p. Show p => Int -> Limit p -> ShowS
forall p. Show p => [Limit p] -> ShowS
forall p. Show p => Limit p -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Limit p] -> ShowS
$cshowList :: forall p. Show p => [Limit p] -> ShowS
show :: Limit p -> String
$cshow :: forall p. Show p => Limit p -> String
showsPrec :: Int -> Limit p -> ShowS
$cshowsPrec :: forall p. Show p => Int -> Limit p -> ShowS
Show, ReadPrec [Limit p]
ReadPrec (Limit p)
Int -> ReadS (Limit p)
ReadS [Limit p]
(Int -> ReadS (Limit p))
-> ReadS [Limit p]
-> ReadPrec (Limit p)
-> ReadPrec [Limit p]
-> Read (Limit p)
forall p. Read p => ReadPrec [Limit p]
forall p. Read p => ReadPrec (Limit p)
forall p. Read p => Int -> ReadS (Limit p)
forall p. Read p => ReadS [Limit p]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Limit p]
$creadListPrec :: forall p. Read p => ReadPrec [Limit p]
readPrec :: ReadPrec (Limit p)
$creadPrec :: forall p. Read p => ReadPrec (Limit p)
readList :: ReadS [Limit p]
$creadList :: forall p. Read p => ReadS [Limit p]
readsPrec :: Int -> ReadS (Limit p)
$creadsPrec :: forall p. Read p => Int -> ReadS (Limit p)
Read)
data LayoutB l1 l2 p a = LayoutB
{ LayoutB l1 l2 p a -> Maybe a
subFocus :: Maybe a
, LayoutB l1 l2 p a -> Maybe a
nextFocus :: Maybe a
, LayoutB l1 l2 p a -> Limit p
limit :: Limit p
, LayoutB l1 l2 p a -> SubBox
box :: SubBox
, LayoutB l1 l2 p a -> Maybe SubBox
mbox :: Maybe SubBox
, LayoutB l1 l2 p a -> l1 a
sub :: l1 a
, LayoutB l1 l2 p a -> Maybe (l2 a)
next :: Maybe (l2 a)
} deriving (Int -> LayoutB l1 l2 p a -> ShowS
[LayoutB l1 l2 p a] -> ShowS
LayoutB l1 l2 p a -> String
(Int -> LayoutB l1 l2 p a -> ShowS)
-> (LayoutB l1 l2 p a -> String)
-> ([LayoutB l1 l2 p a] -> ShowS)
-> Show (LayoutB l1 l2 p a)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (l1 :: * -> *) (l2 :: * -> *) p a.
(Show a, Show p, Show (l1 a), Show (l2 a)) =>
Int -> LayoutB l1 l2 p a -> ShowS
forall (l1 :: * -> *) (l2 :: * -> *) p a.
(Show a, Show p, Show (l1 a), Show (l2 a)) =>
[LayoutB l1 l2 p a] -> ShowS
forall (l1 :: * -> *) (l2 :: * -> *) p a.
(Show a, Show p, Show (l1 a), Show (l2 a)) =>
LayoutB l1 l2 p a -> String
showList :: [LayoutB l1 l2 p a] -> ShowS
$cshowList :: forall (l1 :: * -> *) (l2 :: * -> *) p a.
(Show a, Show p, Show (l1 a), Show (l2 a)) =>
[LayoutB l1 l2 p a] -> ShowS
show :: LayoutB l1 l2 p a -> String
$cshow :: forall (l1 :: * -> *) (l2 :: * -> *) p a.
(Show a, Show p, Show (l1 a), Show (l2 a)) =>
LayoutB l1 l2 p a -> String
showsPrec :: Int -> LayoutB l1 l2 p a -> ShowS
$cshowsPrec :: forall (l1 :: * -> *) (l2 :: * -> *) p a.
(Show a, Show p, Show (l1 a), Show (l2 a)) =>
Int -> LayoutB l1 l2 p a -> ShowS
Show, ReadPrec [LayoutB l1 l2 p a]
ReadPrec (LayoutB l1 l2 p a)
Int -> ReadS (LayoutB l1 l2 p a)
ReadS [LayoutB l1 l2 p a]
(Int -> ReadS (LayoutB l1 l2 p a))
-> ReadS [LayoutB l1 l2 p a]
-> ReadPrec (LayoutB l1 l2 p a)
-> ReadPrec [LayoutB l1 l2 p a]
-> Read (LayoutB l1 l2 p a)
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
forall (l1 :: * -> *) (l2 :: * -> *) p a.
(Read a, Read p, Read (l1 a), Read (l2 a)) =>
ReadPrec [LayoutB l1 l2 p a]
forall (l1 :: * -> *) (l2 :: * -> *) p a.
(Read a, Read p, Read (l1 a), Read (l2 a)) =>
ReadPrec (LayoutB l1 l2 p a)
forall (l1 :: * -> *) (l2 :: * -> *) p a.
(Read a, Read p, Read (l1 a), Read (l2 a)) =>
Int -> ReadS (LayoutB l1 l2 p a)
forall (l1 :: * -> *) (l2 :: * -> *) p a.
(Read a, Read p, Read (l1 a), Read (l2 a)) =>
ReadS [LayoutB l1 l2 p a]
readListPrec :: ReadPrec [LayoutB l1 l2 p a]
$creadListPrec :: forall (l1 :: * -> *) (l2 :: * -> *) p a.
(Read a, Read p, Read (l1 a), Read (l2 a)) =>
ReadPrec [LayoutB l1 l2 p a]
readPrec :: ReadPrec (LayoutB l1 l2 p a)
$creadPrec :: forall (l1 :: * -> *) (l2 :: * -> *) p a.
(Read a, Read p, Read (l1 a), Read (l2 a)) =>
ReadPrec (LayoutB l1 l2 p a)
readList :: ReadS [LayoutB l1 l2 p a]
$creadList :: forall (l1 :: * -> *) (l2 :: * -> *) p a.
(Read a, Read p, Read (l1 a), Read (l2 a)) =>
ReadS [LayoutB l1 l2 p a]
readsPrec :: Int -> ReadS (LayoutB l1 l2 p a)
$creadsPrec :: forall (l1 :: * -> *) (l2 :: * -> *) p a.
(Read a, Read p, Read (l1 a), Read (l2 a)) =>
Int -> ReadS (LayoutB l1 l2 p a)
Read)
type LayoutN l1 l2 a = LayoutB l1 l2 () a
layoutN :: (Read a, Eq a, LayoutClass l1 a, LayoutClass l2 a, LayoutClass l3 a) =>
Int
-> SubBox
-> Maybe SubBox
-> l1 a
-> LayoutB l2 l3 p a
-> LayoutB l1 (LayoutB l2 l3 p) () a
layoutN :: Int
-> SubBox
-> Maybe SubBox
-> l1 a
-> LayoutB l2 l3 p a
-> LayoutB l1 (LayoutB l2 l3 p) () a
layoutN Int
num SubBox
box Maybe SubBox
mbox l1 a
sub LayoutB l2 l3 p a
next = Maybe a
-> Maybe a
-> Limit ()
-> SubBox
-> Maybe SubBox
-> l1 a
-> Maybe (LayoutB l2 l3 p a)
-> LayoutB l1 (LayoutB l2 l3 p) () a
forall (l1 :: * -> *) (l2 :: * -> *) p a.
Maybe a
-> Maybe a
-> Limit p
-> SubBox
-> Maybe SubBox
-> l1 a
-> Maybe (l2 a)
-> LayoutB l1 l2 p a
LayoutB Maybe a
forall a. Maybe a
Nothing Maybe a
forall a. Maybe a
Nothing (Int -> Limit ()
forall p. Int -> Limit p
LimitN Int
num) SubBox
box Maybe SubBox
mbox l1 a
sub (LayoutB l2 l3 p a -> Maybe (LayoutB l2 l3 p a)
forall a. a -> Maybe a
Just LayoutB l2 l3 p a
next)
layoutR :: (Read a, Eq a, LayoutClass l1 a, LayoutClass l2 a, LayoutClass l3 a) =>
Rational
-> Rational
-> SubBox
-> Maybe SubBox
-> l1 a
-> LayoutB l2 l3 p a
-> LayoutB l1 (LayoutB l2 l3 p) p a
layoutR :: Rational
-> Rational
-> SubBox
-> Maybe SubBox
-> l1 a
-> LayoutB l2 l3 p a
-> LayoutB l1 (LayoutB l2 l3 p) p a
layoutR Rational
numdiff Rational
num SubBox
box Maybe SubBox
mbox l1 a
sub LayoutB l2 l3 p a
next = Maybe a
-> Maybe a
-> Limit p
-> SubBox
-> Maybe SubBox
-> l1 a
-> Maybe (LayoutB l2 l3 p a)
-> LayoutB l1 (LayoutB l2 l3 p) p a
forall (l1 :: * -> *) (l2 :: * -> *) p a.
Maybe a
-> Maybe a
-> Limit p
-> SubBox
-> Maybe SubBox
-> l1 a
-> Maybe (l2 a)
-> LayoutB l1 l2 p a
LayoutB Maybe a
forall a. Maybe a
Nothing Maybe a
forall a. Maybe a
Nothing ((Rational, Rational) -> Limit p
forall p. (Rational, Rational) -> Limit p
LimitR (Rational
numdiff,Rational
num)) SubBox
box Maybe SubBox
mbox l1 a
sub (LayoutB l2 l3 p a -> Maybe (LayoutB l2 l3 p a)
forall a. a -> Maybe a
Just LayoutB l2 l3 p a
next)
layoutP :: (Read a, Eq a, LayoutClass l1 a, LayoutClass l2 a, LayoutClass l3 a, Predicate p a, Predicate p' a) =>
p
-> SubBox
-> Maybe SubBox
-> l1 a
-> LayoutB l2 l3 p' a
-> LayoutB l1 (LayoutB l2 l3 p') p a
layoutP :: p
-> SubBox
-> Maybe SubBox
-> l1 a
-> LayoutB l2 l3 p' a
-> LayoutB l1 (LayoutB l2 l3 p') p a
layoutP p
prop SubBox
box Maybe SubBox
mbox l1 a
sub LayoutB l2 l3 p' a
next = Maybe a
-> Maybe a
-> Limit p
-> SubBox
-> Maybe SubBox
-> l1 a
-> Maybe (LayoutB l2 l3 p' a)
-> LayoutB l1 (LayoutB l2 l3 p') p a
forall (l1 :: * -> *) (l2 :: * -> *) p a.
Maybe a
-> Maybe a
-> Limit p
-> SubBox
-> Maybe SubBox
-> l1 a
-> Maybe (l2 a)
-> LayoutB l1 l2 p a
LayoutB Maybe a
forall a. Maybe a
Nothing Maybe a
forall a. Maybe a
Nothing (p -> Limit p
forall p. p -> Limit p
LimitP p
prop) SubBox
box Maybe SubBox
mbox l1 a
sub (LayoutB l2 l3 p' a -> Maybe (LayoutB l2 l3 p' a)
forall a. a -> Maybe a
Just LayoutB l2 l3 p' a
next)
layoutAll :: (Read a, Eq a, LayoutClass l1 a) =>
SubBox
-> l1 a
-> LayoutB l1 Full () a
layoutAll :: SubBox -> l1 a -> LayoutB l1 Full () a
layoutAll SubBox
box l1 a
sub = Maybe a
-> Maybe a
-> Limit ()
-> SubBox
-> Maybe SubBox
-> l1 a
-> Maybe (Full a)
-> LayoutB l1 Full () a
forall (l1 :: * -> *) (l2 :: * -> *) p a.
Maybe a
-> Maybe a
-> Limit p
-> SubBox
-> Maybe SubBox
-> l1 a
-> Maybe (l2 a)
-> LayoutB l1 l2 p a
LayoutB Maybe a
forall a. Maybe a
Nothing Maybe a
forall a. Maybe a
Nothing ((Rational, Rational) -> Limit ()
forall p. (Rational, Rational) -> Limit p
LimitR (Rational
0,Rational
1)) SubBox
box Maybe SubBox
forall a. Maybe a
Nothing l1 a
sub Maybe (Full a)
forall a. Maybe a
Nothing
newtype IncLayoutN = IncLayoutN Int
instance Message IncLayoutN
data SubMeasure = Abs Int | Rel Rational deriving (Int -> SubMeasure -> ShowS
[SubMeasure] -> ShowS
SubMeasure -> String
(Int -> SubMeasure -> ShowS)
-> (SubMeasure -> String)
-> ([SubMeasure] -> ShowS)
-> Show SubMeasure
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SubMeasure] -> ShowS
$cshowList :: [SubMeasure] -> ShowS
show :: SubMeasure -> String
$cshow :: SubMeasure -> String
showsPrec :: Int -> SubMeasure -> ShowS
$cshowsPrec :: Int -> SubMeasure -> ShowS
Show,ReadPrec [SubMeasure]
ReadPrec SubMeasure
Int -> ReadS SubMeasure
ReadS [SubMeasure]
(Int -> ReadS SubMeasure)
-> ReadS [SubMeasure]
-> ReadPrec SubMeasure
-> ReadPrec [SubMeasure]
-> Read SubMeasure
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SubMeasure]
$creadListPrec :: ReadPrec [SubMeasure]
readPrec :: ReadPrec SubMeasure
$creadPrec :: ReadPrec SubMeasure
readList :: ReadS [SubMeasure]
$creadList :: ReadS [SubMeasure]
readsPrec :: Int -> ReadS SubMeasure
$creadsPrec :: Int -> ReadS SubMeasure
Read)
data SubBox = SubBox SubMeasure SubMeasure SubMeasure SubMeasure deriving (Int -> SubBox -> ShowS
[SubBox] -> ShowS
SubBox -> String
(Int -> SubBox -> ShowS)
-> (SubBox -> String) -> ([SubBox] -> ShowS) -> Show SubBox
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SubBox] -> ShowS
$cshowList :: [SubBox] -> ShowS
show :: SubBox -> String
$cshow :: SubBox -> String
showsPrec :: Int -> SubBox -> ShowS
$cshowsPrec :: Int -> SubBox -> ShowS
Show,ReadPrec [SubBox]
ReadPrec SubBox
Int -> ReadS SubBox
ReadS [SubBox]
(Int -> ReadS SubBox)
-> ReadS [SubBox]
-> ReadPrec SubBox
-> ReadPrec [SubBox]
-> Read SubBox
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SubBox]
$creadListPrec :: ReadPrec [SubBox]
readPrec :: ReadPrec SubBox
$creadPrec :: ReadPrec SubBox
readList :: ReadS [SubBox]
$creadList :: ReadS [SubBox]
readsPrec :: Int -> ReadS SubBox
$creadsPrec :: Int -> ReadS SubBox
Read)
absBox :: Int
-> Int
-> Int
-> Int
-> SubBox
absBox :: Int -> Int -> Int -> Int -> SubBox
absBox Int
x Int
y Int
w Int
h = SubMeasure -> SubMeasure -> SubMeasure -> SubMeasure -> SubBox
SubBox (Int -> SubMeasure
Abs Int
x) (Int -> SubMeasure
Abs Int
y) (Int -> SubMeasure
Abs Int
w) (Int -> SubMeasure
Abs Int
h)
relBox :: Rational
-> Rational
-> Rational
-> Rational
-> SubBox
relBox :: Rational -> Rational -> Rational -> Rational -> SubBox
relBox Rational
x Rational
y Rational
w Rational
h = SubMeasure -> SubMeasure -> SubMeasure -> SubMeasure -> SubBox
SubBox (Rational -> SubMeasure
Rel Rational
x) (Rational -> SubMeasure
Rel Rational
y) (Rational -> SubMeasure
Rel Rational
w) (Rational -> SubMeasure
Rel Rational
h)
instance ( LayoutClass l1 a, LayoutClass l2 a
, Read a, Show a, Show p, Typeable p, Eq a, Typeable a, Predicate p a
) => LayoutClass (LayoutB l1 l2 p) a where
runLayout :: Workspace String (LayoutB l1 l2 p a) a
-> Rectangle -> X ([(a, Rectangle)], Maybe (LayoutB l1 l2 p a))
runLayout (W.Workspace String
_ LayoutB {l1 a
Maybe a
Maybe (l2 a)
Maybe SubBox
SubBox
Limit p
next :: Maybe (l2 a)
sub :: l1 a
mbox :: Maybe SubBox
box :: SubBox
limit :: Limit p
nextFocus :: Maybe a
subFocus :: Maybe a
next :: forall (l1 :: * -> *) (l2 :: * -> *) p a.
LayoutB l1 l2 p a -> Maybe (l2 a)
sub :: forall (l1 :: * -> *) (l2 :: * -> *) p a. LayoutB l1 l2 p a -> l1 a
mbox :: forall (l1 :: * -> *) (l2 :: * -> *) p a.
LayoutB l1 l2 p a -> Maybe SubBox
box :: forall (l1 :: * -> *) (l2 :: * -> *) p a.
LayoutB l1 l2 p a -> SubBox
limit :: forall (l1 :: * -> *) (l2 :: * -> *) p a.
LayoutB l1 l2 p a -> Limit p
nextFocus :: forall (l1 :: * -> *) (l2 :: * -> *) p a.
LayoutB l1 l2 p a -> Maybe a
subFocus :: forall (l1 :: * -> *) (l2 :: * -> *) p a.
LayoutB l1 l2 p a -> Maybe a
..} Maybe (Stack a)
s) Rectangle
rect = do
(Maybe (Stack a)
subs, Maybe (Stack a)
nexts, Maybe a
subFocus', Maybe a
nextFocus') <- Maybe (Stack a)
-> Limit p
-> Maybe a
-> Maybe a
-> X (Maybe (Stack a), Maybe (Stack a), Maybe a, Maybe a)
forall a p.
(Eq a, Predicate p a) =>
Maybe (Stack a)
-> Limit p
-> Maybe a
-> Maybe a
-> X (Maybe (Stack a), Maybe (Stack a), Maybe a, Maybe a)
splitStack Maybe (Stack a)
s Limit p
limit Maybe a
subFocus Maybe a
nextFocus
let selBox :: SubBox
selBox = if Maybe a -> Bool
forall a. Maybe a -> Bool
isJust Maybe a
nextFocus' then SubBox
box else SubBox -> Maybe SubBox -> SubBox
forall a. a -> Maybe a -> a
fromMaybe SubBox
box Maybe SubBox
mbox
([(a, Rectangle)]
sublist, l1 a
sub', Bool
schange) <- l1 a
-> Maybe (Stack a) -> Rectangle -> X ([(a, Rectangle)], l1 a, Bool)
forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a
-> Maybe (Stack a)
-> Rectangle
-> X ([(a, Rectangle)], layout a, Bool)
handle l1 a
sub Maybe (Stack a)
subs (SubBox -> Rectangle -> Rectangle
calcArea SubBox
selBox Rectangle
rect)
([(a, Rectangle)]
nextlist, Maybe (l2 a)
next', Bool
nchange) <- case Maybe (l2 a)
next of
Maybe (l2 a)
Nothing -> ([(a, Rectangle)], Maybe (l2 a), Bool)
-> X ([(a, Rectangle)], Maybe (l2 a), Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return ([], Maybe (l2 a)
forall a. Maybe a
Nothing, Bool
False)
Just l2 a
n -> do ([(a, Rectangle)]
res, l2 a
l, Bool
ch) <- l2 a
-> Maybe (Stack a) -> Rectangle -> X ([(a, Rectangle)], l2 a, Bool)
forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a
-> Maybe (Stack a)
-> Rectangle
-> X ([(a, Rectangle)], layout a, Bool)
handle l2 a
n Maybe (Stack a)
nexts Rectangle
rect
([(a, Rectangle)], Maybe (l2 a), Bool)
-> X ([(a, Rectangle)], Maybe (l2 a), Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return ([(a, Rectangle)]
res, l2 a -> Maybe (l2 a)
forall a. a -> Maybe a
Just l2 a
l, Bool
ch)
let newlist :: [(a, Rectangle)]
newlist = if [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([a] -> (Stack a -> [a]) -> Maybe (Stack a) -> [a]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] Stack a -> [a]
forall a. Stack a -> [a]
W.up Maybe (Stack a)
s) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Maybe (Stack a) -> [a]
forall a. Maybe (Stack a) -> [a]
W.integrate' Maybe (Stack a)
subs)
then [(a, Rectangle)]
sublist[(a, Rectangle)] -> [(a, Rectangle)] -> [(a, Rectangle)]
forall a. [a] -> [a] -> [a]
++[(a, Rectangle)]
nextlist
else [(a, Rectangle)]
nextlist[(a, Rectangle)] -> [(a, Rectangle)] -> [(a, Rectangle)]
forall a. [a] -> [a] -> [a]
++[(a, Rectangle)]
sublist
newstate :: Maybe (LayoutB l1 l2 p a)
newstate = if Maybe a
subFocus' Maybe a -> Maybe a -> Bool
forall a. Eq a => a -> a -> Bool
/= Maybe a
subFocus Bool -> Bool -> Bool
|| Maybe a
nextFocus' Maybe a -> Maybe a -> Bool
forall a. Eq a => a -> a -> Bool
/= Maybe a
nextFocus Bool -> Bool -> Bool
|| Bool
schange Bool -> Bool -> Bool
|| Bool
nchange
then LayoutB l1 l2 p a -> Maybe (LayoutB l1 l2 p a)
forall a. a -> Maybe a
Just (LayoutB l1 l2 p a -> Maybe (LayoutB l1 l2 p a))
-> LayoutB l1 l2 p a -> Maybe (LayoutB l1 l2 p a)
forall a b. (a -> b) -> a -> b
$ Maybe a
-> Maybe a
-> Limit p
-> SubBox
-> Maybe SubBox
-> l1 a
-> Maybe (l2 a)
-> LayoutB l1 l2 p a
forall (l1 :: * -> *) (l2 :: * -> *) p a.
Maybe a
-> Maybe a
-> Limit p
-> SubBox
-> Maybe SubBox
-> l1 a
-> Maybe (l2 a)
-> LayoutB l1 l2 p a
LayoutB Maybe a
subFocus' Maybe a
nextFocus' Limit p
limit SubBox
box Maybe SubBox
mbox l1 a
sub' Maybe (l2 a)
next'
else Maybe (LayoutB l1 l2 p a)
forall a. Maybe a
Nothing
([(a, Rectangle)], Maybe (LayoutB l1 l2 p a))
-> X ([(a, Rectangle)], Maybe (LayoutB l1 l2 p a))
forall (m :: * -> *) a. Monad m => a -> m a
return ([(a, Rectangle)]
newlist, Maybe (LayoutB l1 l2 p a)
newstate)
where
handle :: layout a
-> Maybe (Stack a)
-> Rectangle
-> X ([(a, Rectangle)], layout a, Bool)
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
([(a, Rectangle)], layout a, Bool)
-> X ([(a, Rectangle)], layout a, Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return ([(a, Rectangle)]
res, layout a -> Maybe (layout a) -> layout a
forall a. a -> Maybe a -> a
fromMaybe layout a
l Maybe (layout a)
ml, Maybe (layout a) -> Bool
forall a. Maybe a -> Bool
isNothing Maybe (layout a)
ml)
handleMessage :: LayoutB l1 l2 p a -> SomeMessage -> X (Maybe (LayoutB l1 l2 p a))
handleMessage LayoutB l1 l2 p a
l SomeMessage
m
| Just (IncLayoutN Int
n) <- SomeMessage -> Maybe IncLayoutN
forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m = LayoutB l1 l2 p a
-> SomeMessage -> Int -> X (Maybe (LayoutB l1 l2 p a))
forall (l1 :: * -> *) a (l2 :: * -> *) p.
(LayoutClass l1 a, LayoutClass l2 a, Read a, Show a, Eq a,
Typeable a) =>
LayoutB l1 l2 p a
-> SomeMessage -> Int -> X (Maybe (LayoutB l1 l2 p a))
incLayoutN LayoutB l1 l2 p a
l SomeMessage
m Int
n
| Just (IncMasterN Int
_) <- SomeMessage -> Maybe IncMasterN
forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m = LayoutB l1 l2 p a -> SomeMessage -> X (Maybe (LayoutB l1 l2 p a))
forall (l1 :: * -> *) a (l2 :: * -> *) p.
(LayoutClass l1 a, LayoutClass l2 a, Read a, Show a, Eq a,
Typeable a) =>
LayoutB l1 l2 p a -> SomeMessage -> X (Maybe (LayoutB l1 l2 p a))
sendFocus LayoutB l1 l2 p a
l SomeMessage
m
| Just Resize
Shrink <- SomeMessage -> Maybe Resize
forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m = LayoutB l1 l2 p a -> SomeMessage -> X (Maybe (LayoutB l1 l2 p a))
forall (l1 :: * -> *) a (l2 :: * -> *) p.
(LayoutClass l1 a, LayoutClass l2 a, Read a, Show a, Eq a,
Typeable a) =>
LayoutB l1 l2 p a -> SomeMessage -> X (Maybe (LayoutB l1 l2 p a))
sendFocus LayoutB l1 l2 p a
l SomeMessage
m
| Just Resize
Expand <- SomeMessage -> Maybe Resize
forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m = LayoutB l1 l2 p a -> SomeMessage -> X (Maybe (LayoutB l1 l2 p a))
forall (l1 :: * -> *) a (l2 :: * -> *) p.
(LayoutClass l1 a, LayoutClass l2 a, Read a, Show a, Eq a,
Typeable a) =>
LayoutB l1 l2 p a -> SomeMessage -> X (Maybe (LayoutB l1 l2 p a))
sendFocus LayoutB l1 l2 p a
l SomeMessage
m
| Bool
otherwise = LayoutB l1 l2 p a -> SomeMessage -> X (Maybe (LayoutB l1 l2 p a))
forall (l1 :: * -> *) a (l2 :: * -> *) p.
(LayoutClass l1 a, LayoutClass l2 a, Read a, Show a, Eq a,
Typeable a) =>
LayoutB l1 l2 p a -> SomeMessage -> X (Maybe (LayoutB l1 l2 p a))
sendBoth LayoutB l1 l2 p a
l SomeMessage
m
description :: LayoutB l1 l2 p a -> String
description LayoutB l1 l2 p a
layout = case LayoutB l1 l2 p a
layout of
(LayoutB Maybe a
_ Maybe a
_ Limit p
_ SubBox
_ Maybe SubBox
_ l1 a
sub Maybe (l2 a)
Nothing) ->
String
"layoutAll " String -> ShowS
forall a. [a] -> [a] -> [a]
++ l1 a -> String
forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> String
description l1 a
sub
(LayoutB Maybe a
_ Maybe a
_ (LimitN Int
_) SubBox
_ Maybe SubBox
_ l1 a
sub (Just l2 a
next)) ->
String
"layoutN " String -> ShowS
forall a. [a] -> [a] -> [a]
++ l1 a -> String
forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> String
description l1 a
sub String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ l2 a -> String
forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> String
description l2 a
next
(LayoutB Maybe a
_ Maybe a
_ (LimitR (Rational, Rational)
_) SubBox
_ Maybe SubBox
_ l1 a
sub (Just l2 a
next)) ->
String
"layoutR " String -> ShowS
forall a. [a] -> [a] -> [a]
++ l1 a -> String
forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> String
description l1 a
sub String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ l2 a -> String
forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> String
description l2 a
next
(LayoutB Maybe a
_ Maybe a
_ (LimitP p
_) SubBox
_ Maybe SubBox
_ l1 a
sub (Just l2 a
next)) ->
String
"layoutP " String -> ShowS
forall a. [a] -> [a] -> [a]
++ l1 a -> String
forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> String
description l1 a
sub String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ l2 a -> String
forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> String
description l2 a
next
incLayoutN :: (LayoutClass l1 a, LayoutClass l2 a, Read a, Show a, Eq a, Typeable a)
=> LayoutB l1 l2 p a
-> SomeMessage
-> Int
-> X (Maybe (LayoutB l1 l2 p a))
incLayoutN :: LayoutB l1 l2 p a
-> SomeMessage -> Int -> X (Maybe (LayoutB l1 l2 p a))
incLayoutN layout :: LayoutB l1 l2 p a
layout@LayoutB {l1 a
Maybe a
Maybe (l2 a)
Maybe SubBox
SubBox
Limit p
next :: Maybe (l2 a)
sub :: l1 a
mbox :: Maybe SubBox
box :: SubBox
limit :: Limit p
nextFocus :: Maybe a
subFocus :: Maybe a
next :: forall (l1 :: * -> *) (l2 :: * -> *) p a.
LayoutB l1 l2 p a -> Maybe (l2 a)
sub :: forall (l1 :: * -> *) (l2 :: * -> *) p a. LayoutB l1 l2 p a -> l1 a
mbox :: forall (l1 :: * -> *) (l2 :: * -> *) p a.
LayoutB l1 l2 p a -> Maybe SubBox
box :: forall (l1 :: * -> *) (l2 :: * -> *) p a.
LayoutB l1 l2 p a -> SubBox
limit :: forall (l1 :: * -> *) (l2 :: * -> *) p a.
LayoutB l1 l2 p a -> Limit p
nextFocus :: forall (l1 :: * -> *) (l2 :: * -> *) p a.
LayoutB l1 l2 p a -> Maybe a
subFocus :: forall (l1 :: * -> *) (l2 :: * -> *) p a.
LayoutB l1 l2 p a -> Maybe a
..} SomeMessage
message Int
n = do
Bool
incThis <- Maybe a -> X Bool
forall a. Show a => Maybe a -> X Bool
isFocus Maybe a
subFocus
if Bool
incThis
then Maybe (LayoutB l1 l2 p a) -> X (Maybe (LayoutB l1 l2 p a))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (LayoutB l1 l2 p a) -> X (Maybe (LayoutB l1 l2 p a)))
-> Maybe (LayoutB l1 l2 p a) -> X (Maybe (LayoutB l1 l2 p a))
forall a b. (a -> b) -> a -> b
$ LayoutB l1 l2 p a -> Maybe (LayoutB l1 l2 p a)
forall a. a -> Maybe a
Just LayoutB l1 l2 p a
layout { limit :: Limit p
limit = Limit p
newLimit }
else LayoutB l1 l2 p a -> SomeMessage -> X (Maybe (LayoutB l1 l2 p a))
forall (l1 :: * -> *) a (l2 :: * -> *) p.
(LayoutClass l1 a, LayoutClass l2 a, Read a, Show a, Eq a,
Typeable a) =>
LayoutB l1 l2 p a -> SomeMessage -> X (Maybe (LayoutB l1 l2 p a))
sendNext LayoutB l1 l2 p a
layout SomeMessage
message
where
newLimit :: Limit p
newLimit = case Limit p
limit of
LimitN Int
oldnum -> Int -> Limit p
forall p. Int -> Limit p
LimitN (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
1 (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Int
oldnum Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n)
LimitR (Rational
diff, Rational
oldnum) -> (Rational, Rational) -> Limit p
forall p. (Rational, Rational) -> Limit p
LimitR (Rational
diff, Rational -> Rational -> Rational
forall a. Ord a => a -> a -> a
min Rational
1 (Rational -> Rational) -> Rational -> Rational
forall a b. (a -> b) -> a -> b
$ Rational -> Rational -> Rational
forall a. Ord a => a -> a -> a
max Rational
0 (Rational -> Rational) -> Rational -> Rational
forall a b. (a -> b) -> a -> b
$ Rational
oldnum Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
+ Int -> Rational
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* Rational
diff)
LimitP p
_ -> Limit p
limit
sendSub :: (LayoutClass l1 a, LayoutClass l2 a, Read a, Show a, Eq a, Typeable a) => LayoutB l1 l2 p a -> SomeMessage -> X (Maybe (LayoutB l1 l2 p a))
sendSub :: LayoutB l1 l2 p a -> SomeMessage -> X (Maybe (LayoutB l1 l2 p a))
sendSub (LayoutB Maybe a
subFocus Maybe a
nextFocus Limit p
num 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 (LayoutB l1 l2 p a) -> X (Maybe (LayoutB l1 l2 p a))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (LayoutB l1 l2 p a) -> X (Maybe (LayoutB l1 l2 p a)))
-> Maybe (LayoutB l1 l2 p a) -> X (Maybe (LayoutB l1 l2 p a))
forall a b. (a -> b) -> a -> b
$ if Maybe (l1 a) -> Bool
forall a. Maybe a -> Bool
isJust Maybe (l1 a)
sub'
then LayoutB l1 l2 p a -> Maybe (LayoutB l1 l2 p a)
forall a. a -> Maybe a
Just (LayoutB l1 l2 p a -> Maybe (LayoutB l1 l2 p a))
-> LayoutB l1 l2 p a -> Maybe (LayoutB l1 l2 p a)
forall a b. (a -> b) -> a -> b
$ Maybe a
-> Maybe a
-> Limit p
-> SubBox
-> Maybe SubBox
-> l1 a
-> Maybe (l2 a)
-> LayoutB l1 l2 p a
forall (l1 :: * -> *) (l2 :: * -> *) p a.
Maybe a
-> Maybe a
-> Limit p
-> SubBox
-> Maybe SubBox
-> l1 a
-> Maybe (l2 a)
-> LayoutB l1 l2 p a
LayoutB Maybe a
subFocus Maybe a
nextFocus Limit p
num 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 (LayoutB l1 l2 p a)
forall a. Maybe a
Nothing
sendBoth :: (LayoutClass l1 a, LayoutClass l2 a, Read a, Show a, Eq a, Typeable a) => LayoutB l1 l2 p a -> SomeMessage -> X (Maybe (LayoutB l1 l2 p a))
sendBoth :: LayoutB l1 l2 p a -> SomeMessage -> X (Maybe (LayoutB l1 l2 p a))
sendBoth l :: LayoutB l1 l2 p a
l@(LayoutB Maybe a
_ Maybe a
_ Limit p
_ SubBox
_ Maybe SubBox
_ l1 a
_ Maybe (l2 a)
Nothing) SomeMessage
m = LayoutB l1 l2 p a -> SomeMessage -> X (Maybe (LayoutB l1 l2 p a))
forall (l1 :: * -> *) a (l2 :: * -> *) p.
(LayoutClass l1 a, LayoutClass l2 a, Read a, Show a, Eq a,
Typeable a) =>
LayoutB l1 l2 p a -> SomeMessage -> X (Maybe (LayoutB l1 l2 p a))
sendSub LayoutB l1 l2 p a
l SomeMessage
m
sendBoth (LayoutB Maybe a
subFocus Maybe a
nextFocus Limit p
num 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 (LayoutB l1 l2 p a) -> X (Maybe (LayoutB l1 l2 p a))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (LayoutB l1 l2 p a) -> X (Maybe (LayoutB l1 l2 p a)))
-> Maybe (LayoutB l1 l2 p a) -> X (Maybe (LayoutB l1 l2 p 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 LayoutB l1 l2 p a -> Maybe (LayoutB l1 l2 p a)
forall a. a -> Maybe a
Just (LayoutB l1 l2 p a -> Maybe (LayoutB l1 l2 p a))
-> LayoutB l1 l2 p a -> Maybe (LayoutB l1 l2 p a)
forall a b. (a -> b) -> a -> b
$ Maybe a
-> Maybe a
-> Limit p
-> SubBox
-> Maybe SubBox
-> l1 a
-> Maybe (l2 a)
-> LayoutB l1 l2 p a
forall (l1 :: * -> *) (l2 :: * -> *) p a.
Maybe a
-> Maybe a
-> Limit p
-> SubBox
-> Maybe SubBox
-> l1 a
-> Maybe (l2 a)
-> LayoutB l1 l2 p a
LayoutB Maybe a
subFocus Maybe a
nextFocus Limit p
num 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' Maybe (l2 a) -> Maybe (l2 a) -> Maybe (l2 a)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> l2 a -> Maybe (l2 a)
forall a. a -> Maybe a
Just l2 a
next)
else Maybe (LayoutB l1 l2 p a)
forall a. Maybe a
Nothing
sendNext :: (LayoutClass l1 a, LayoutClass l2 a, Read a, Show a, Eq a, Typeable a) => LayoutB l1 l2 p a -> SomeMessage -> X (Maybe (LayoutB l1 l2 p a))
sendNext :: LayoutB l1 l2 p a -> SomeMessage -> X (Maybe (LayoutB l1 l2 p a))
sendNext (LayoutB Maybe a
_ Maybe a
_ Limit p
_ SubBox
_ Maybe SubBox
_ l1 a
_ Maybe (l2 a)
Nothing) SomeMessage
_ = Maybe (LayoutB l1 l2 p a) -> X (Maybe (LayoutB l1 l2 p a))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (LayoutB l1 l2 p a)
forall a. Maybe a
Nothing
sendNext (LayoutB Maybe a
subFocus Maybe a
nextFocus Limit p
num 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 (LayoutB l1 l2 p a) -> X (Maybe (LayoutB l1 l2 p a))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (LayoutB l1 l2 p a) -> X (Maybe (LayoutB l1 l2 p a)))
-> Maybe (LayoutB l1 l2 p a) -> X (Maybe (LayoutB l1 l2 p a))
forall a b. (a -> b) -> a -> b
$ if Maybe (l2 a) -> Bool
forall a. Maybe a -> Bool
isJust Maybe (l2 a)
next'
then LayoutB l1 l2 p a -> Maybe (LayoutB l1 l2 p a)
forall a. a -> Maybe a
Just (LayoutB l1 l2 p a -> Maybe (LayoutB l1 l2 p a))
-> LayoutB l1 l2 p a -> Maybe (LayoutB l1 l2 p a)
forall a b. (a -> b) -> a -> b
$ Maybe a
-> Maybe a
-> Limit p
-> SubBox
-> Maybe SubBox
-> l1 a
-> Maybe (l2 a)
-> LayoutB l1 l2 p a
forall (l1 :: * -> *) (l2 :: * -> *) p a.
Maybe a
-> Maybe a
-> Limit p
-> SubBox
-> Maybe SubBox
-> l1 a
-> Maybe (l2 a)
-> LayoutB l1 l2 p a
LayoutB Maybe a
subFocus Maybe a
nextFocus Limit p
num SubBox
box Maybe SubBox
mbox l1 a
sub Maybe (l2 a)
next'
else Maybe (LayoutB l1 l2 p a)
forall a. Maybe a
Nothing
sendFocus :: (LayoutClass l1 a, LayoutClass l2 a, Read a, Show a, Eq a, Typeable a) => LayoutB l1 l2 p a -> SomeMessage -> X (Maybe (LayoutB l1 l2 p a))
sendFocus :: LayoutB l1 l2 p a -> SomeMessage -> X (Maybe (LayoutB l1 l2 p a))
sendFocus l :: LayoutB l1 l2 p a
l@(LayoutB Maybe a
subFocus Maybe a
_ Limit 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
subFocus
if Bool
foc
then LayoutB l1 l2 p a -> SomeMessage -> X (Maybe (LayoutB l1 l2 p a))
forall (l1 :: * -> *) a (l2 :: * -> *) p.
(LayoutClass l1 a, LayoutClass l2 a, Read a, Show a, Eq a,
Typeable a) =>
LayoutB l1 l2 p a -> SomeMessage -> X (Maybe (LayoutB l1 l2 p a))
sendSub LayoutB l1 l2 p a
l SomeMessage
m
else LayoutB l1 l2 p a -> SomeMessage -> X (Maybe (LayoutB l1 l2 p a))
forall (l1 :: * -> *) a (l2 :: * -> *) p.
(LayoutClass l1 a, LayoutClass l2 a, Read a, Show a, Eq a,
Typeable a) =>
LayoutB l1 l2 p a -> SomeMessage -> X (Maybe (LayoutB l1 l2 p a))
sendNext LayoutB l1 l2 p 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
calcNum :: Int -> Limit p -> Int
calcNum :: Int -> Limit p -> Int
calcNum Int
tot Limit p
num = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
1 (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ case Limit p
num of LimitN Int
i -> Int
i
LimitR (Rational
_,Rational
r) -> Rational -> Int
forall a b. (RealFrac a, Integral b) => a -> b
ceiling (Rational -> Int) -> Rational -> Int
forall a b. (a -> b) -> a -> b
$ Rational
r Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* Int -> Rational
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
tot
LimitP p
_ -> Int
1
splitBy :: (Predicate p a) => p -> [a] -> X ([a], [a])
splitBy :: p -> [a] -> X ([a], [a])
splitBy p
prop = (([a], [a]) -> a -> X ([a], [a]))
-> ([a], [a]) -> [a] -> X ([a], [a])
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM ([a], [a]) -> a -> X ([a], [a])
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 :: forall a p. (Eq a, Predicate p a)
=> Maybe (W.Stack a)
-> Limit p
-> Maybe a
-> Maybe a
-> X (Maybe (W.Stack a), Maybe (W.Stack a), Maybe a, Maybe a)
splitStack :: Maybe (Stack a)
-> Limit p
-> Maybe a
-> Maybe a
-> X (Maybe (Stack a), Maybe (Stack a), Maybe a, Maybe a)
splitStack Maybe (Stack a)
Nothing Limit p
_ Maybe a
_ Maybe a
_ = (Maybe (Stack a), Maybe (Stack a), Maybe a, Maybe a)
-> X (Maybe (Stack a), Maybe (Stack a), Maybe a, Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Stack a)
forall a. Maybe a
Nothing, Maybe (Stack a)
forall a. Maybe a
Nothing, Maybe a
forall a. Maybe a
Nothing, Maybe a
forall a. Maybe a
Nothing)
splitStack (Just Stack a
s) Limit p
limit Maybe a
subFocus Maybe a
nextFocus =
case Limit p
limit of
LimitN Int
_ -> X (Maybe (Stack a), Maybe (Stack a), Maybe a, Maybe a)
splitN
LimitR (Rational, Rational)
_ -> X (Maybe (Stack a), Maybe (Stack a), Maybe a, Maybe a)
splitN
LimitP p
prop -> p -> X (Maybe (Stack a), Maybe (Stack a), Maybe a, Maybe a)
forall p.
Predicate p a =>
p -> X (Maybe (Stack a), Maybe (Stack a), Maybe a, Maybe a)
splitP p
prop
where
ws :: [a]
ws = Stack a -> [a]
forall a. Stack a -> [a]
W.integrate Stack a
s
n :: Int
n = Int -> Limit p -> Int
forall p. Int -> Limit p -> Int
calcNum ([a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
ws) Limit p
limit
subl :: [a]
subl = Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
take Int
n [a]
ws
nextl :: [a]
nextl = Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
drop Int
n [a]
ws
subFocus' :: [a] -> Maybe a
subFocus' [a]
xs = [a] -> Maybe a -> Maybe a
foc [a]
xs Maybe a
subFocus
nextFocus' :: [a] -> Maybe a
nextFocus' [a]
xs = [a] -> Maybe a -> Maybe a
foc [a]
xs Maybe a
nextFocus
foc :: [a] -> Maybe a -> Maybe a
foc :: [a] -> Maybe a -> Maybe a
foc [] Maybe a
_ = Maybe a
forall a. Maybe a
Nothing
foc [a]
l Maybe a
f | Stack a -> a
forall a. Stack a -> a
W.focus Stack a
s a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [a]
l = a -> Maybe a
forall a. a -> Maybe a
Just (Stack a -> a
forall a. Stack a -> a
W.focus Stack a
s)
| Bool -> (a -> Bool) -> Maybe a -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [a]
l) Maybe a
f = Maybe a
f
| Bool
otherwise = [a] -> Maybe a
forall a. [a] -> Maybe a
listToMaybe [a]
l
splitN :: X (Maybe (Stack a), Maybe (Stack a), Maybe a, Maybe a)
splitN = (Maybe (Stack a), Maybe (Stack a), Maybe a, Maybe a)
-> X (Maybe (Stack a), Maybe (Stack a), Maybe a, Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return ( Maybe a -> [a] -> Maybe (Stack a)
forall q. Eq q => Maybe q -> [q] -> Maybe (Stack q)
differentiate' ([a] -> Maybe a
subFocus' [a]
subl) [a]
subl
, Maybe a -> [a] -> Maybe (Stack a)
forall q. Eq q => Maybe q -> [q] -> Maybe (Stack q)
differentiate' ([a] -> Maybe a
nextFocus' [a]
nextl) [a]
nextl
, [a] -> Maybe a
subFocus' [a]
subl
, [a] -> Maybe a
nextFocus' [a]
nextl
)
splitP :: p -> X (Maybe (Stack a), Maybe (Stack a), Maybe a, Maybe a)
splitP p
prop = do
([a]
this, [a]
other) <- p -> [a] -> X ([a], [a])
forall p a. Predicate p a => p -> [a] -> X ([a], [a])
splitBy p
prop [a]
ws
(Maybe (Stack a), Maybe (Stack a), Maybe a, Maybe a)
-> X (Maybe (Stack a), Maybe (Stack a), Maybe a, Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return ( Maybe a -> [a] -> Maybe (Stack a)
forall q. Eq q => Maybe q -> [q] -> Maybe (Stack q)
differentiate' ([a] -> Maybe a
subFocus' [a]
this) [a]
this
, Maybe a -> [a] -> Maybe (Stack a)
forall q. Eq q => Maybe q -> [q] -> Maybe (Stack q)
differentiate' ([a] -> Maybe a
nextFocus' [a]
other) [a]
other
, [a] -> Maybe a
subFocus' [a]
this
, [a] -> Maybe a
nextFocus' [a]
other
)
calcArea :: SubBox -> Rectangle -> Rectangle
calcArea :: SubBox -> Rectangle -> Rectangle
calcArea (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 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
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
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 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 :: 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