{-# LANGUAGE PatternGuards, FlexibleInstances, MultiParamTypeClasses #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  XMonad.Layout.WindowArranger
-- Description :  A layout modifier to move and resize windows with the keyboard.
-- Copyright   :  (c) Andrea Rossato 2007
-- License     :  BSD-style (see xmonad/LICENSE)
--
-- Maintainer  :  andrea.rossato@unibz.it
-- Stability   :  unstable
-- Portability :  unportable
--
-- This is a pure layout modifier that will let you move and resize
-- windows with the keyboard in any layout.
-----------------------------------------------------------------------------

module XMonad.Layout.WindowArranger
    ( -- * Usage
      -- $usage
      windowArrange
    , windowArrangeAll
    , WindowArrangerMsg (..)
    , WindowArranger
    , memberFromList
    , listFromList
    , diff
    ) where

import XMonad
import XMonad.Prelude
import qualified XMonad.StackSet as S
import XMonad.Layout.LayoutModifier

import Control.Arrow ((***), (>>>), (&&&), first)

-- $usage
-- You can use this module with the following in your
-- @xmonad.hs@:
--
-- > import XMonad.Layout.WindowArranger
-- > myLayout = layoutHook def
-- > main = xmonad def { layoutHook = windowArrange myLayout }
--
-- or
--
-- > main = xmonad def { layoutHook = windowArrangeAll myLayout }
--
-- For more detailed instructions on editing the layoutHook see
-- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial> and
-- "XMonad.Doc.Extending#Editing_the_layout_hook".
--
-- You may also want to define some key binding to move or resize
-- windows. These are good defaults:
--
-- >        , ((modm .|. controlMask              , xK_s    ), sendMessage  Arrange         )
-- >        , ((modm .|. controlMask .|. shiftMask, xK_s    ), sendMessage  DeArrange       )
-- >        , ((modm .|. controlMask              , xK_Left ), sendMessage (MoveLeft      1))
-- >        , ((modm .|. controlMask              , xK_Right), sendMessage (MoveRight     1))
-- >        , ((modm .|. controlMask              , xK_Down ), sendMessage (MoveDown      1))
-- >        , ((modm .|. controlMask              , xK_Up   ), sendMessage (MoveUp        1))
-- >        , ((modm                 .|. shiftMask, xK_Left ), sendMessage (IncreaseLeft  1))
-- >        , ((modm                 .|. shiftMask, xK_Right), sendMessage (IncreaseRight 1))
-- >        , ((modm                 .|. shiftMask, xK_Down ), sendMessage (IncreaseDown  1))
-- >        , ((modm                 .|. shiftMask, xK_Up   ), sendMessage (IncreaseUp    1))
-- >        , ((modm .|. controlMask .|. shiftMask, xK_Left ), sendMessage (DecreaseLeft  1))
-- >        , ((modm .|. controlMask .|. shiftMask, xK_Right), sendMessage (DecreaseRight 1))
-- >        , ((modm .|. controlMask .|. shiftMask, xK_Down ), sendMessage (DecreaseDown  1))
-- >        , ((modm .|. controlMask .|. shiftMask, xK_Up   ), sendMessage (DecreaseUp    1))
--
-- For detailed instructions on editing your key bindings, see
-- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial>.

-- | A layout modifier to float the windows in a workspace
windowArrange :: l a -> ModifiedLayout WindowArranger l a
windowArrange :: forall (l :: * -> *) a. l a -> ModifiedLayout WindowArranger l a
windowArrange = WindowArranger a -> l a -> ModifiedLayout WindowArranger l a
forall (m :: * -> *) (l :: * -> *) a.
m a -> l a -> ModifiedLayout m l a
ModifiedLayout (Bool -> Bool -> [ArrangedWindow a] -> WindowArranger a
forall a. Bool -> Bool -> [ArrangedWindow a] -> WindowArranger a
WA Bool
True Bool
False [])

-- | A layout modifier to float all the windows in a workspace
windowArrangeAll :: l a -> ModifiedLayout WindowArranger l a
windowArrangeAll :: forall (l :: * -> *) a. l a -> ModifiedLayout WindowArranger l a
windowArrangeAll = WindowArranger a -> l a -> ModifiedLayout WindowArranger l a
forall (m :: * -> *) (l :: * -> *) a.
m a -> l a -> ModifiedLayout m l a
ModifiedLayout (Bool -> Bool -> [ArrangedWindow a] -> WindowArranger a
forall a. Bool -> Bool -> [ArrangedWindow a] -> WindowArranger a
WA Bool
True Bool
True [])

data WindowArrangerMsg = DeArrange
                       | Arrange
                       | IncreaseLeft  Int
                       | IncreaseRight Int
                       | IncreaseUp    Int
                       | IncreaseDown  Int
                       | DecreaseLeft  Int
                       | DecreaseRight Int
                       | DecreaseUp    Int
                       | DecreaseDown  Int
                       | MoveLeft      Int
                       | MoveRight     Int
                       | MoveUp        Int
                       | MoveDown      Int
                       | SetGeometry   Rectangle
instance Message WindowArrangerMsg

data ArrangedWindow a = WR   (a, Rectangle)
                      | AWR  (a, Rectangle)
                        deriving (ReadPrec [ArrangedWindow a]
ReadPrec (ArrangedWindow a)
Int -> ReadS (ArrangedWindow a)
ReadS [ArrangedWindow a]
(Int -> ReadS (ArrangedWindow a))
-> ReadS [ArrangedWindow a]
-> ReadPrec (ArrangedWindow a)
-> ReadPrec [ArrangedWindow a]
-> Read (ArrangedWindow a)
forall a. Read a => ReadPrec [ArrangedWindow a]
forall a. Read a => ReadPrec (ArrangedWindow a)
forall a. Read a => Int -> ReadS (ArrangedWindow a)
forall a. Read a => ReadS [ArrangedWindow a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: forall a. Read a => Int -> ReadS (ArrangedWindow a)
readsPrec :: Int -> ReadS (ArrangedWindow a)
$creadList :: forall a. Read a => ReadS [ArrangedWindow a]
readList :: ReadS [ArrangedWindow a]
$creadPrec :: forall a. Read a => ReadPrec (ArrangedWindow a)
readPrec :: ReadPrec (ArrangedWindow a)
$creadListPrec :: forall a. Read a => ReadPrec [ArrangedWindow a]
readListPrec :: ReadPrec [ArrangedWindow a]
Read, Int -> ArrangedWindow a -> ShowS
[ArrangedWindow a] -> ShowS
ArrangedWindow a -> String
(Int -> ArrangedWindow a -> ShowS)
-> (ArrangedWindow a -> String)
-> ([ArrangedWindow a] -> ShowS)
-> Show (ArrangedWindow a)
forall a. Show a => Int -> ArrangedWindow a -> ShowS
forall a. Show a => [ArrangedWindow a] -> ShowS
forall a. Show a => ArrangedWindow a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> ArrangedWindow a -> ShowS
showsPrec :: Int -> ArrangedWindow a -> ShowS
$cshow :: forall a. Show a => ArrangedWindow a -> String
show :: ArrangedWindow a -> String
$cshowList :: forall a. Show a => [ArrangedWindow a] -> ShowS
showList :: [ArrangedWindow a] -> ShowS
Show)

type ArrangeAll = Bool
data WindowArranger a = WA Bool ArrangeAll [ArrangedWindow a] deriving (ReadPrec [WindowArranger a]
ReadPrec (WindowArranger a)
Int -> ReadS (WindowArranger a)
ReadS [WindowArranger a]
(Int -> ReadS (WindowArranger a))
-> ReadS [WindowArranger a]
-> ReadPrec (WindowArranger a)
-> ReadPrec [WindowArranger a]
-> Read (WindowArranger a)
forall a. Read a => ReadPrec [WindowArranger a]
forall a. Read a => ReadPrec (WindowArranger a)
forall a. Read a => Int -> ReadS (WindowArranger a)
forall a. Read a => ReadS [WindowArranger a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: forall a. Read a => Int -> ReadS (WindowArranger a)
readsPrec :: Int -> ReadS (WindowArranger a)
$creadList :: forall a. Read a => ReadS [WindowArranger a]
readList :: ReadS [WindowArranger a]
$creadPrec :: forall a. Read a => ReadPrec (WindowArranger a)
readPrec :: ReadPrec (WindowArranger a)
$creadListPrec :: forall a. Read a => ReadPrec [WindowArranger a]
readListPrec :: ReadPrec [WindowArranger a]
Read, Int -> WindowArranger a -> ShowS
[WindowArranger a] -> ShowS
WindowArranger a -> String
(Int -> WindowArranger a -> ShowS)
-> (WindowArranger a -> String)
-> ([WindowArranger a] -> ShowS)
-> Show (WindowArranger a)
forall a. Show a => Int -> WindowArranger a -> ShowS
forall a. Show a => [WindowArranger a] -> ShowS
forall a. Show a => WindowArranger a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> WindowArranger a -> ShowS
showsPrec :: Int -> WindowArranger a -> ShowS
$cshow :: forall a. Show a => WindowArranger a -> String
show :: WindowArranger a -> String
$cshowList :: forall a. Show a => [WindowArranger a] -> ShowS
showList :: [WindowArranger a] -> ShowS
Show)

instance (Show a, Read a, Eq a) => LayoutModifier WindowArranger a where
    pureModifier :: WindowArranger a
-> Rectangle
-> Maybe (Stack a)
-> [(a, Rectangle)]
-> ([(a, Rectangle)], Maybe (WindowArranger a))
pureModifier (WA Bool
True Bool
b   []) Rectangle
_ (Just Stack a
_)               [(a, Rectangle)]
wrs = Bool
-> [(a, Rectangle)] -> ([(a, Rectangle)], Maybe (WindowArranger a))
forall a.
Bool
-> [(a, Rectangle)] -> ([(a, Rectangle)], Maybe (WindowArranger a))
arrangeWindows Bool
b [(a, Rectangle)]
wrs

    pureModifier (WA Bool
True Bool
b [ArrangedWindow a]
awrs) Rectangle
_ (Just (S.Stack a
w [a]
_ [a]
_)) [(a, Rectangle)]
wrs = (([(a, Rectangle)], [ArrangedWindow a])
 -> ([(a, Rectangle)], Maybe (WindowArranger a)))
-> [(a, Rectangle)]
-> [ArrangedWindow a]
-> ([(a, Rectangle)], Maybe (WindowArranger a))
forall a b c. ((a, b) -> c) -> a -> b -> c
curry ([(a, Rectangle)], [ArrangedWindow a])
-> ([(a, Rectangle)], Maybe (WindowArranger a))
process [(a, Rectangle)]
wrs [ArrangedWindow a]
awrs
        where
          wins :: ([(b, b)], [ArrangedWindow b]) -> ([b], [b])
wins         = ((b, b) -> b) -> [(b, b)] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map (b, b) -> b
forall a b. (a, b) -> a
fst       ([(b, b)] -> [b])
-> ([ArrangedWindow b] -> [b])
-> ([(b, b)], [ArrangedWindow b])
-> ([b], [b])
forall b c b' c'. (b -> c) -> (b' -> c') -> (b, b') -> (c, c')
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** (ArrangedWindow b -> b) -> [ArrangedWindow b] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map ArrangedWindow b -> b
forall a. ArrangedWindow a -> a
awrWin
          update :: ([a], [a])
-> ([(a, Rectangle)], [ArrangedWindow a]) -> [ArrangedWindow a]
update ([a]
a,[a]
r) = Bool -> [a] -> [(a, Rectangle)] -> [ArrangedWindow a]
forall a.
Eq a =>
Bool -> [a] -> [(a, Rectangle)] -> [ArrangedWindow a]
mkNewAWRs Bool
b [a]
a ([(a, Rectangle)] -> [ArrangedWindow a])
-> ([ArrangedWindow a] -> [ArrangedWindow a])
-> ([(a, Rectangle)], [ArrangedWindow a])
-> ([ArrangedWindow a], [ArrangedWindow a])
forall b c b' c'. (b -> c) -> (b' -> c') -> (b, b') -> (c, c')
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** [a] -> [ArrangedWindow a] -> [ArrangedWindow a]
forall a. Eq a => [a] -> [ArrangedWindow a] -> [ArrangedWindow a]
removeAWRs [a]
r (([(a, Rectangle)], [ArrangedWindow a])
 -> ([ArrangedWindow a], [ArrangedWindow a]))
-> (([ArrangedWindow a], [ArrangedWindow a]) -> [ArrangedWindow a])
-> ([(a, Rectangle)], [ArrangedWindow a])
-> [ArrangedWindow a]
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> ([ArrangedWindow a] -> [ArrangedWindow a] -> [ArrangedWindow a])
-> ([ArrangedWindow a], [ArrangedWindow a]) -> [ArrangedWindow a]
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry [ArrangedWindow a] -> [ArrangedWindow a] -> [ArrangedWindow a]
forall a. [a] -> [a] -> [a]
(++)
          process :: ([(a, Rectangle)], [ArrangedWindow a])
-> ([(a, Rectangle)], Maybe (WindowArranger a))
process      = ([(a, Rectangle)], [ArrangedWindow a]) -> ([a], [a])
forall {b} {b} {b}. ([(b, b)], [ArrangedWindow b]) -> ([b], [b])
wins (([(a, Rectangle)], [ArrangedWindow a]) -> ([a], [a]))
-> (([(a, Rectangle)], [ArrangedWindow a])
    -> ([(a, Rectangle)], [ArrangedWindow a]))
-> ([(a, Rectangle)], [ArrangedWindow a])
-> (([a], [a]), ([(a, Rectangle)], [ArrangedWindow a]))
forall b c c'. (b -> c) -> (b -> c') -> b -> (c, c')
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&&  ([(a, Rectangle)], [ArrangedWindow a])
-> ([(a, Rectangle)], [ArrangedWindow a])
forall a. a -> a
id  (([(a, Rectangle)], [ArrangedWindow a])
 -> (([a], [a]), ([(a, Rectangle)], [ArrangedWindow a])))
-> ((([a], [a]), ([(a, Rectangle)], [ArrangedWindow a]))
    -> ([(a, Rectangle)], Maybe (WindowArranger a)))
-> ([(a, Rectangle)], [ArrangedWindow a])
-> ([(a, Rectangle)], Maybe (WindowArranger a))
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> (([a], [a]) -> ([a], [a]))
-> (([a], [a]), ([(a, Rectangle)], [ArrangedWindow a]))
-> (([a], [a]), ([(a, Rectangle)], [ArrangedWindow a]))
forall b c d. (b -> c) -> (b, d) -> (c, d)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first ([a], [a]) -> ([a], [a])
forall a. Eq a => ([a], [a]) -> ([a], [a])
diff   ((([a], [a]), ([(a, Rectangle)], [ArrangedWindow a]))
 -> (([a], [a]), ([(a, Rectangle)], [ArrangedWindow a])))
-> ((([a], [a]), ([(a, Rectangle)], [ArrangedWindow a]))
    -> ([(a, Rectangle)], Maybe (WindowArranger a)))
-> (([a], [a]), ([(a, Rectangle)], [ArrangedWindow a]))
-> ([(a, Rectangle)], Maybe (WindowArranger a))
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> (([a], [a])
 -> ([(a, Rectangle)], [ArrangedWindow a]) -> [ArrangedWindow a])
-> (([a], [a]), ([(a, Rectangle)], [ArrangedWindow a]))
-> [ArrangedWindow a]
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ([a], [a])
-> ([(a, Rectangle)], [ArrangedWindow a]) -> [ArrangedWindow a]
forall {a}.
Eq a =>
([a], [a])
-> ([(a, Rectangle)], [ArrangedWindow a]) -> [ArrangedWindow a]
update ((([a], [a]), ([(a, Rectangle)], [ArrangedWindow a]))
 -> [ArrangedWindow a])
-> ([ArrangedWindow a]
    -> ([(a, Rectangle)], Maybe (WindowArranger a)))
-> (([a], [a]), ([(a, Rectangle)], [ArrangedWindow a]))
-> ([(a, Rectangle)], Maybe (WindowArranger a))
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
                         [(a, Rectangle)] -> [ArrangedWindow a] -> [ArrangedWindow a]
forall a.
Eq a =>
[(a, Rectangle)] -> [ArrangedWindow a] -> [ArrangedWindow a]
replaceWR [(a, Rectangle)]
wrs ([ArrangedWindow a] -> [ArrangedWindow a])
-> ([ArrangedWindow a]
    -> ([(a, Rectangle)], Maybe (WindowArranger a)))
-> [ArrangedWindow a]
-> ([(a, Rectangle)], Maybe (WindowArranger a))
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> a -> [ArrangedWindow a] -> [ArrangedWindow a]
forall a. Eq a => a -> [ArrangedWindow a] -> [ArrangedWindow a]
putOnTop a
w   ([ArrangedWindow a] -> [ArrangedWindow a])
-> ([ArrangedWindow a]
    -> ([(a, Rectangle)], Maybe (WindowArranger a)))
-> [ArrangedWindow a]
-> ([(a, Rectangle)], Maybe (WindowArranger a))
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> (ArrangedWindow a -> (a, Rectangle))
-> [ArrangedWindow a] -> [(a, Rectangle)]
forall a b. (a -> b) -> [a] -> [b]
map ArrangedWindow a -> (a, Rectangle)
forall a. ArrangedWindow a -> (a, Rectangle)
fromAWR ([ArrangedWindow a] -> [(a, Rectangle)])
-> ([ArrangedWindow a] -> Maybe (WindowArranger a))
-> [ArrangedWindow a]
-> ([(a, Rectangle)], Maybe (WindowArranger a))
forall b c c'. (b -> c) -> (b -> c') -> b -> (c, c')
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& WindowArranger a -> Maybe (WindowArranger a)
forall a. a -> Maybe a
Just (WindowArranger a -> Maybe (WindowArranger a))
-> ([ArrangedWindow a] -> WindowArranger a)
-> [ArrangedWindow a]
-> Maybe (WindowArranger a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Bool -> [ArrangedWindow a] -> WindowArranger a
forall a. Bool -> Bool -> [ArrangedWindow a] -> WindowArranger a
WA Bool
True Bool
b

    pureModifier WindowArranger a
_ Rectangle
_ Maybe (Stack a)
_ [(a, Rectangle)]
wrs = ([(a, Rectangle)]
wrs, Maybe (WindowArranger a)
forall a. Maybe a
Nothing)

    pureMess :: WindowArranger a -> SomeMessage -> Maybe (WindowArranger a)
pureMess (WA Bool
True Bool
b (ArrangedWindow a
wr:[ArrangedWindow a]
wrs)) SomeMessage
m
        -- increase the window's size
        | Just (IncreaseRight Int
i) <- Maybe WindowArrangerMsg
fm, (a
win, Rectangle Position
x Position
y Dimension
w Dimension
h) <- (a, Rectangle)
fa = a
-> Position
-> Position
-> Dimension
-> Dimension
-> Maybe (WindowArranger a)
res a
win  Position
x         Position
y        (Dimension
w Dimension -> Dimension -> Dimension
forall a. Num a => a -> a -> a
+ Int -> Dimension
forall a b. (Integral a, Num b) => a -> b
fi Int
i) Dimension
h
        | Just (IncreaseLeft  Int
i) <- Maybe WindowArrangerMsg
fm, (a
win, Rectangle Position
x Position
y Dimension
w Dimension
h) <- (a, Rectangle)
fa = a
-> Position
-> Position
-> Dimension
-> Dimension
-> Maybe (WindowArranger a)
res a
win (Position
x Position -> Position -> Position
forall a. Num a => a -> a -> a
- Int -> Position
forall a b. (Integral a, Num b) => a -> b
fi Int
i) Position
y        (Dimension
w Dimension -> Dimension -> Dimension
forall a. Num a => a -> a -> a
+ Int -> Dimension
forall a b. (Integral a, Num b) => a -> b
fi Int
i) Dimension
h
        | Just (IncreaseUp    Int
i) <- Maybe WindowArrangerMsg
fm, (a
win, Rectangle Position
x Position
y Dimension
w Dimension
h) <- (a, Rectangle)
fa = a
-> Position
-> Position
-> Dimension
-> Dimension
-> Maybe (WindowArranger a)
res a
win  Position
x        (Position
y Position -> Position -> Position
forall a. Num a => a -> a -> a
- Int -> Position
forall a b. (Integral a, Num b) => a -> b
fi Int
i) Dimension
w        (Dimension
h Dimension -> Dimension -> Dimension
forall a. Num a => a -> a -> a
+ Int -> Dimension
forall a b. (Integral a, Num b) => a -> b
fi Int
i)
        | Just (IncreaseDown  Int
i) <- Maybe WindowArrangerMsg
fm, (a
win, Rectangle Position
x Position
y Dimension
w Dimension
h) <- (a, Rectangle)
fa = a
-> Position
-> Position
-> Dimension
-> Dimension
-> Maybe (WindowArranger a)
res a
win  Position
x         Position
y         Dimension
w        (Dimension
h Dimension -> Dimension -> Dimension
forall a. Num a => a -> a -> a
+ Int -> Dimension
forall a b. (Integral a, Num b) => a -> b
fi Int
i)
        -- decrease the window's size
        | Just (DecreaseRight Int
i) <- Maybe WindowArrangerMsg
fm, (a
win, Rectangle Position
x Position
y Dimension
w Dimension
h) <- (a, Rectangle)
fa = a
-> Position
-> Position
-> Dimension
-> Dimension
-> Maybe (WindowArranger a)
res a
win (Position
x Position -> Position -> Position
forall a. Num a => a -> a -> a
+ Int -> Position
forall a b. (Integral a, Num b) => a -> b
fi Int
i) Position
y        (Dimension -> Int -> Dimension
forall {a} {a} {b}. (Integral a, Integral a, Num b) => a -> a -> b
chk  Dimension
w Int
i) Dimension
h
        | Just (DecreaseLeft  Int
i) <- Maybe WindowArrangerMsg
fm, (a
win, Rectangle Position
x Position
y Dimension
w Dimension
h) <- (a, Rectangle)
fa = a
-> Position
-> Position
-> Dimension
-> Dimension
-> Maybe (WindowArranger a)
res a
win  Position
x         Position
y        (Dimension -> Int -> Dimension
forall {a} {a} {b}. (Integral a, Integral a, Num b) => a -> a -> b
chk  Dimension
w Int
i) Dimension
h
        | Just (DecreaseUp    Int
i) <- Maybe WindowArrangerMsg
fm, (a
win, Rectangle Position
x Position
y Dimension
w Dimension
h) <- (a, Rectangle)
fa = a
-> Position
-> Position
-> Dimension
-> Dimension
-> Maybe (WindowArranger a)
res a
win  Position
x         Position
y         Dimension
w        (Dimension -> Int -> Dimension
forall {a} {a} {b}. (Integral a, Integral a, Num b) => a -> a -> b
chk Dimension
h Int
i)
        | Just (DecreaseDown  Int
i) <- Maybe WindowArrangerMsg
fm, (a
win, Rectangle Position
x Position
y Dimension
w Dimension
h) <- (a, Rectangle)
fa = a
-> Position
-> Position
-> Dimension
-> Dimension
-> Maybe (WindowArranger a)
res a
win  Position
x        (Position
y Position -> Position -> Position
forall a. Num a => a -> a -> a
+ Int -> Position
forall a b. (Integral a, Num b) => a -> b
fi Int
i) Dimension
w        (Dimension -> Int -> Dimension
forall {a} {a} {b}. (Integral a, Integral a, Num b) => a -> a -> b
chk Dimension
h Int
i)
        --move the window around
        | Just (MoveRight     Int
i) <- Maybe WindowArrangerMsg
fm, (a
win, Rectangle Position
x Position
y Dimension
w Dimension
h) <- (a, Rectangle)
fa = a
-> Position
-> Position
-> Dimension
-> Dimension
-> Maybe (WindowArranger a)
res a
win (Position
x Position -> Position -> Position
forall a. Num a => a -> a -> a
+ Int -> Position
forall a b. (Integral a, Num b) => a -> b
fi Int
i) Position
y         Dimension
w         Dimension
h
        | Just (MoveLeft      Int
i) <- Maybe WindowArrangerMsg
fm, (a
win, Rectangle Position
x Position
y Dimension
w Dimension
h) <- (a, Rectangle)
fa = a
-> Position
-> Position
-> Dimension
-> Dimension
-> Maybe (WindowArranger a)
res a
win (Position
x Position -> Position -> Position
forall a. Num a => a -> a -> a
- Int -> Position
forall a b. (Integral a, Num b) => a -> b
fi Int
i) Position
y         Dimension
w         Dimension
h
        | Just (MoveUp        Int
i) <- Maybe WindowArrangerMsg
fm, (a
win, Rectangle Position
x Position
y Dimension
w Dimension
h) <- (a, Rectangle)
fa = a
-> Position
-> Position
-> Dimension
-> Dimension
-> Maybe (WindowArranger a)
res a
win  Position
x        (Position
y Position -> Position -> Position
forall a. Num a => a -> a -> a
- Int -> Position
forall a b. (Integral a, Num b) => a -> b
fi Int
i) Dimension
w         Dimension
h
        | Just (MoveDown      Int
i) <- Maybe WindowArrangerMsg
fm, (a
win, Rectangle Position
x Position
y Dimension
w Dimension
h) <- (a, Rectangle)
fa = a
-> Position
-> Position
-> Dimension
-> Dimension
-> Maybe (WindowArranger a)
res a
win  Position
x        (Position
y Position -> Position -> Position
forall a. Num a => a -> a -> a
+ Int -> Position
forall a b. (Integral a, Num b) => a -> b
fi Int
i) Dimension
w         Dimension
h

        where res :: a
-> Position
-> Position
-> Dimension
-> Dimension
-> Maybe (WindowArranger a)
res a
wi Position
x Position
y Dimension
w Dimension
h = WindowArranger a -> Maybe (WindowArranger a)
forall a. a -> Maybe a
Just (WindowArranger a -> Maybe (WindowArranger a))
-> ([ArrangedWindow a] -> WindowArranger a)
-> [ArrangedWindow a]
-> Maybe (WindowArranger a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Bool -> [ArrangedWindow a] -> WindowArranger a
forall a. Bool -> Bool -> [ArrangedWindow a] -> WindowArranger a
WA Bool
True Bool
b ([ArrangedWindow a] -> Maybe (WindowArranger a))
-> [ArrangedWindow a] -> Maybe (WindowArranger a)
forall a b. (a -> b) -> a -> b
$ (a, Rectangle) -> ArrangedWindow a
forall a. (a, Rectangle) -> ArrangedWindow a
AWR (a
wi,Position -> Position -> Dimension -> Dimension -> Rectangle
Rectangle Position
x Position
y Dimension
w Dimension
h)ArrangedWindow a -> [ArrangedWindow a] -> [ArrangedWindow a]
forall a. a -> [a] -> [a]
:[ArrangedWindow a]
wrs
              fm :: Maybe WindowArrangerMsg
fm             = SomeMessage -> Maybe WindowArrangerMsg
forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m
              fa :: (a, Rectangle)
fa             = ArrangedWindow a -> (a, Rectangle)
forall a. ArrangedWindow a -> (a, Rectangle)
fromAWR     ArrangedWindow a
wr
              chk :: a -> a -> b
chk        a
x a
y = a -> b
forall a b. (Integral a, Num b) => a -> b
fi (a -> b) -> a -> b
forall a b. (a -> b) -> a -> b
$ a -> a -> a
forall a. Ord a => a -> a -> a
max a
1 (a -> a
forall a b. (Integral a, Num b) => a -> b
fi a
x a -> a -> a
forall a. Num a => a -> a -> a
- a
y)

    pureMess (WA Bool
t Bool
b (ArrangedWindow a
wr:[ArrangedWindow a]
wrs)) SomeMessage
m
        | Just (SetGeometry   Rectangle
r) <- SomeMessage -> Maybe WindowArrangerMsg
forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m, (a
w,Rectangle
_) <- ArrangedWindow a -> (a, Rectangle)
forall a. ArrangedWindow a -> (a, Rectangle)
fromAWR ArrangedWindow a
wr = WindowArranger a -> Maybe (WindowArranger a)
forall a. a -> Maybe a
Just (WindowArranger a -> Maybe (WindowArranger a))
-> ([ArrangedWindow a] -> WindowArranger a)
-> [ArrangedWindow a]
-> Maybe (WindowArranger a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Bool -> [ArrangedWindow a] -> WindowArranger a
forall a. Bool -> Bool -> [ArrangedWindow a] -> WindowArranger a
WA Bool
t Bool
b ([ArrangedWindow a] -> Maybe (WindowArranger a))
-> [ArrangedWindow a] -> Maybe (WindowArranger a)
forall a b. (a -> b) -> a -> b
$ (a, Rectangle) -> ArrangedWindow a
forall a. (a, Rectangle) -> ArrangedWindow a
AWR (a
w,Rectangle
r)ArrangedWindow a -> [ArrangedWindow a] -> [ArrangedWindow a]
forall a. a -> [a] -> [a]
:[ArrangedWindow a]
wrs

    pureMess (WA Bool
_ Bool
b [ArrangedWindow a]
l) SomeMessage
m
        | Just WindowArrangerMsg
DeArrange <- SomeMessage -> Maybe WindowArrangerMsg
forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m = WindowArranger a -> Maybe (WindowArranger a)
forall a. a -> Maybe a
Just (WindowArranger a -> Maybe (WindowArranger a))
-> WindowArranger a -> Maybe (WindowArranger a)
forall a b. (a -> b) -> a -> b
$ Bool -> Bool -> [ArrangedWindow a] -> WindowArranger a
forall a. Bool -> Bool -> [ArrangedWindow a] -> WindowArranger a
WA Bool
False Bool
b [ArrangedWindow a]
l
        | Just WindowArrangerMsg
Arrange   <- SomeMessage -> Maybe WindowArrangerMsg
forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m = WindowArranger a -> Maybe (WindowArranger a)
forall a. a -> Maybe a
Just (WindowArranger a -> Maybe (WindowArranger a))
-> WindowArranger a -> Maybe (WindowArranger a)
forall a b. (a -> b) -> a -> b
$ Bool -> Bool -> [ArrangedWindow a] -> WindowArranger a
forall a. Bool -> Bool -> [ArrangedWindow a] -> WindowArranger a
WA Bool
True  Bool
b [ArrangedWindow a]
l
        | Bool
otherwise                       = Maybe (WindowArranger a)
forall a. Maybe a
Nothing

arrangeWindows :: ArrangeAll -> [(a,Rectangle)] -> ([(a, Rectangle)], Maybe (WindowArranger a))
arrangeWindows :: forall a.
Bool
-> [(a, Rectangle)] -> ([(a, Rectangle)], Maybe (WindowArranger a))
arrangeWindows Bool
b [(a, Rectangle)]
wrs = ([(a, Rectangle)]
wrs, WindowArranger a -> Maybe (WindowArranger a)
forall a. a -> Maybe a
Just (WindowArranger a -> Maybe (WindowArranger a))
-> WindowArranger a -> Maybe (WindowArranger a)
forall a b. (a -> b) -> a -> b
$ Bool -> Bool -> [ArrangedWindow a] -> WindowArranger a
forall a. Bool -> Bool -> [ArrangedWindow a] -> WindowArranger a
WA Bool
True Bool
b (((a, Rectangle) -> ArrangedWindow a)
-> [(a, Rectangle)] -> [ArrangedWindow a]
forall a b. (a -> b) -> [a] -> [b]
map (a, Rectangle) -> ArrangedWindow a
forall a. (a, Rectangle) -> ArrangedWindow a
t [(a, Rectangle)]
wrs))
    where t :: (a, Rectangle) -> ArrangedWindow a
t = if Bool
b then (a, Rectangle) -> ArrangedWindow a
forall a. (a, Rectangle) -> ArrangedWindow a
AWR else (a, Rectangle) -> ArrangedWindow a
forall a. (a, Rectangle) -> ArrangedWindow a
WR

fromAWR :: ArrangedWindow a -> (a, Rectangle)
fromAWR :: forall a. ArrangedWindow a -> (a, Rectangle)
fromAWR (WR   (a, Rectangle)
x) = (a, Rectangle)
x
fromAWR (AWR  (a, Rectangle)
x) = (a, Rectangle)
x

awrWin :: ArrangedWindow a -> a
awrWin :: forall a. ArrangedWindow a -> a
awrWin = (a, Rectangle) -> a
forall a b. (a, b) -> a
fst ((a, Rectangle) -> a)
-> (ArrangedWindow a -> (a, Rectangle)) -> ArrangedWindow a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ArrangedWindow a -> (a, Rectangle)
forall a. ArrangedWindow a -> (a, Rectangle)
fromAWR

getAWR :: Eq a => a -> [ArrangedWindow a] -> [ArrangedWindow a]
getAWR :: forall a. Eq a => a -> [ArrangedWindow a] -> [ArrangedWindow a]
getAWR = (ArrangedWindow a -> a)
-> (a -> a -> Bool)
-> a
-> [ArrangedWindow a]
-> [ArrangedWindow a]
forall b c a. (b -> c) -> (c -> a -> Bool) -> a -> [b] -> [b]
memberFromList ArrangedWindow a -> a
forall a. ArrangedWindow a -> a
awrWin a -> a -> Bool
forall a. Eq a => a -> a -> Bool
(==)

getWR ::  Eq a => a -> [(a,Rectangle)] -> [(a,Rectangle)]
getWR :: forall a. Eq a => a -> [(a, Rectangle)] -> [(a, Rectangle)]
getWR = ((a, Rectangle) -> a)
-> (a -> a -> Bool) -> a -> [(a, Rectangle)] -> [(a, Rectangle)]
forall b c a. (b -> c) -> (c -> a -> Bool) -> a -> [b] -> [b]
memberFromList (a, Rectangle) -> a
forall a b. (a, b) -> a
fst a -> a -> Bool
forall a. Eq a => a -> a -> Bool
(==)

mkNewAWRs :: Eq a => ArrangeAll -> [a] -> [(a,Rectangle)] -> [ArrangedWindow a]
mkNewAWRs :: forall a.
Eq a =>
Bool -> [a] -> [(a, Rectangle)] -> [ArrangedWindow a]
mkNewAWRs Bool
b [a]
w [(a, Rectangle)]
wrs = ((a, Rectangle) -> ArrangedWindow a)
-> [(a, Rectangle)] -> [ArrangedWindow a]
forall a b. (a -> b) -> [a] -> [b]
map (a, Rectangle) -> ArrangedWindow a
forall a. (a, Rectangle) -> ArrangedWindow a
t ([(a, Rectangle)] -> [ArrangedWindow a])
-> ([a] -> [(a, Rectangle)]) -> [a] -> [ArrangedWindow a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> [(a, Rectangle)]) -> [a] -> [(a, Rectangle)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (a -> [(a, Rectangle)] -> [(a, Rectangle)]
forall a. Eq a => a -> [(a, Rectangle)] -> [(a, Rectangle)]
`getWR` [(a, Rectangle)]
wrs) ([a] -> [ArrangedWindow a]) -> [a] -> [ArrangedWindow a]
forall a b. (a -> b) -> a -> b
$ [a]
w
    where t :: (a, Rectangle) -> ArrangedWindow a
t = if Bool
b then (a, Rectangle) -> ArrangedWindow a
forall a. (a, Rectangle) -> ArrangedWindow a
AWR else (a, Rectangle) -> ArrangedWindow a
forall a. (a, Rectangle) -> ArrangedWindow a
WR

removeAWRs :: Eq a => [a] -> [ArrangedWindow a] -> [ArrangedWindow a]
removeAWRs :: forall a. Eq a => [a] -> [ArrangedWindow a] -> [ArrangedWindow a]
removeAWRs = (ArrangedWindow a -> a)
-> (a -> [a] -> Bool)
-> [a]
-> [ArrangedWindow a]
-> [ArrangedWindow a]
forall b c a. (b -> c) -> (c -> [a] -> Bool) -> [a] -> [b] -> [b]
listFromList ArrangedWindow a -> a
forall a. ArrangedWindow a -> a
awrWin a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
notElem

putOnTop :: Eq a => a -> [ArrangedWindow a] -> [ArrangedWindow a]
putOnTop :: forall a. Eq a => a -> [ArrangedWindow a] -> [ArrangedWindow a]
putOnTop a
w [ArrangedWindow a]
awrs = [ArrangedWindow a]
awr [ArrangedWindow a] -> [ArrangedWindow a] -> [ArrangedWindow a]
forall a. [a] -> [a] -> [a]
++ [ArrangedWindow a]
nawrs
    where awr :: [ArrangedWindow a]
awr   = a -> [ArrangedWindow a] -> [ArrangedWindow a]
forall a. Eq a => a -> [ArrangedWindow a] -> [ArrangedWindow a]
getAWR a
w [ArrangedWindow a]
awrs
          nawrs :: [ArrangedWindow a]
nawrs = (ArrangedWindow a -> Bool)
-> [ArrangedWindow a] -> [ArrangedWindow a]
forall a. (a -> Bool) -> [a] -> [a]
filter ((a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/=a
w) (a -> Bool) -> (ArrangedWindow a -> a) -> ArrangedWindow a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ArrangedWindow a -> a
forall a. ArrangedWindow a -> a
awrWin) [ArrangedWindow a]
awrs

replaceWR :: Eq a => [(a, Rectangle)] -> [ArrangedWindow a] -> [ArrangedWindow a]
replaceWR :: forall a.
Eq a =>
[(a, Rectangle)] -> [ArrangedWindow a] -> [ArrangedWindow a]
replaceWR [(a, Rectangle)]
wrs = (ArrangedWindow a -> [ArrangedWindow a] -> [ArrangedWindow a])
-> [ArrangedWindow a] -> [ArrangedWindow a] -> [ArrangedWindow a]
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ArrangedWindow a -> [ArrangedWindow a] -> [ArrangedWindow a]
r []
    where r :: ArrangedWindow a -> [ArrangedWindow a] -> [ArrangedWindow a]
r ArrangedWindow a
x [ArrangedWindow a]
xs
              | WR (a, Rectangle)
wr <- ArrangedWindow a
x = case (a, Rectangle) -> a
forall a b. (a, b) -> a
fst (a, Rectangle)
wr a -> [a] -> Maybe Int
forall a. Eq a => a -> [a] -> Maybe Int
`elemIndex` ((a, Rectangle) -> a) -> [(a, Rectangle)] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (a, Rectangle) -> a
forall a b. (a, b) -> a
fst [(a, Rectangle)]
wrs of
                               Just Int
i  -> (a, Rectangle) -> ArrangedWindow a
forall a. (a, Rectangle) -> ArrangedWindow a
WR ([(a, Rectangle)]
wrs [(a, Rectangle)] -> Int -> (a, Rectangle)
forall a. HasCallStack => [a] -> Int -> a
!! Int
i)ArrangedWindow a -> [ArrangedWindow a] -> [ArrangedWindow a]
forall a. a -> [a] -> [a]
:[ArrangedWindow a]
xs
                               Maybe Int
Nothing -> ArrangedWindow a
xArrangedWindow a -> [ArrangedWindow a] -> [ArrangedWindow a]
forall a. a -> [a] -> [a]
:[ArrangedWindow a]
xs
              | Bool
otherwise  = ArrangedWindow a
xArrangedWindow a -> [ArrangedWindow a] -> [ArrangedWindow a]
forall a. a -> [a] -> [a]
:[ArrangedWindow a]
xs

-- | Given a function to be applied to each member of a list, and a
-- function to check a condition by processing this transformed member
-- with the members of a list, you get the list of members that
-- satisfy the condition.
listFromList :: (b -> c) -> (c -> [a] -> Bool) -> [a] -> [b] -> [b]
listFromList :: forall b c a. (b -> c) -> (c -> [a] -> Bool) -> [a] -> [b] -> [b]
listFromList b -> c
f c -> [a] -> Bool
g [a]
l = (b -> [b] -> [b]) -> [b] -> [b] -> [b]
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ([a] -> b -> [b] -> [b]
h [a]
l) []
    where h :: [a] -> b -> [b] -> [b]
h [a]
x b
y [b]
ys = if c -> [a] -> Bool
g (b -> c
f b
y) [a]
x then b
yb -> [b] -> [b]
forall a. a -> [a] -> [a]
:[b]
ys else [b]
ys

-- | Given a function to be applied to each member of ta list, and a
-- function to check a condition by processing this transformed member
-- with something, you get the first member that satisfy the condition,
-- or an empty list.
memberFromList :: (b -> c) -> (c -> a -> Bool) -> a -> [b] -> [b]
memberFromList :: forall b c a. (b -> c) -> (c -> a -> Bool) -> a -> [b] -> [b]
memberFromList b -> c
f c -> a -> Bool
g a
l = (b -> [b] -> [b]) -> [b] -> [b] -> [b]
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (a -> b -> [b] -> [b]
h a
l) []
    where h :: a -> b -> [b] -> [b]
h a
x b
y [b]
ys = if c -> a -> Bool
g (b -> c
f b
y) a
x then [b
y] else [b]
ys

-- | Get the list of elements to be deleted and the list of elements to
-- be added to the first list in order to get the second list.
diff :: Eq a => ([a],[a]) -> ([a],[a])
diff :: forall a. Eq a => ([a], [a]) -> ([a], [a])
diff ([a]
x,[a]
y) = ([a]
x [a] -> [a] -> [a]
forall a. Eq a => [a] -> [a] -> [a]
\\ [a]
y, [a]
y [a] -> [a] -> [a]
forall a. Eq a => [a] -> [a] -> [a]
\\ [a]
x)