{-# LANGUAGE PatternGuards #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE DoAndIfThenElse #-}
{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  XMonad.Layout.BinarySpacePartition
-- Description :  New windows split the focused window in half; based off of BSPWM.
-- Copyright   :  (c) 2013 Ben Weitzman    <benweitzman@gmail.com>
--                    2015 Anton Pirogov   <anton.pirogov@gmail.com>
--                    2019 Mateusz Karbowy <obszczymucha@gmail.com
-- License     :  BSD3-style (see LICENSE)
--
-- Maintainer  :  Ben Weitzman <benweitzman@gmail.com>
-- Stability   :  unstable
-- Portability :  unportable
--
-- Layout where new windows will split the focused window in half, based off of BSPWM
--
-----------------------------------------------------------------------------

module XMonad.Layout.BinarySpacePartition (
  -- * Usage
  -- $usage
    emptyBSP
  , BinarySpacePartition
  , Rotate(..)
  , Swap(..)
  , ResizeDirectional(.., ExpandTowards, ShrinkFrom, MoveSplit)
  , TreeRotate(..)
  , TreeBalance(..)
  , FocusParent(..)
  , SelectMoveNode(..)
  , Direction2D(..)
  , SplitShiftDirectional(..)
  ) where

import XMonad
import XMonad.Prelude hiding (insert)
import qualified XMonad.StackSet as W
import XMonad.Hooks.ManageHelpers (isMinimized)
import XMonad.Util.Stack hiding (Zipper)
import XMonad.Util.Types

-- for mouse resizing
import XMonad.Layout.WindowArranger (WindowArrangerMsg(SetGeometry))
-- for "focus parent" node border
import XMonad.Util.XUtils

import qualified Data.Map as M
import qualified Data.Set as S
import Data.Ratio ((%))

-- $usage
-- You can use this module with the following in your @xmonad.hs@:
--
-- > import XMonad.Layout.BinarySpacePartition
--
-- Then add the layout, using the default BSP (BinarySpacePartition)
--
-- > myLayout = emptyBSP ||| etc ..
--
-- It may be a good idea to use "XMonad.Actions.Navigation2D" to move between the windows.
--
-- This layout responds to SetGeometry and is compatible with e.g. "XMonad.Actions.MouseResize"
-- or "XMonad.Layout.BorderResize". You should probably try both to decide which is better for you,
-- if you want to be able to resize the splits with the mouse.
--
-- If you don't want to use the mouse, add the following key bindings to resize the splits with the keyboard:
--
-- > , ((modm .|. altMask,                 xK_l     ), sendMessage $ ExpandTowards R)
-- > , ((modm .|. altMask,                 xK_h     ), sendMessage $ ExpandTowards L)
-- > , ((modm .|. altMask,                 xK_j     ), sendMessage $ ExpandTowards D)
-- > , ((modm .|. altMask,                 xK_k     ), sendMessage $ ExpandTowards U)
-- > , ((modm .|. altMask .|. ctrlMask ,   xK_l     ), sendMessage $ ShrinkFrom R)
-- > , ((modm .|. altMask .|. ctrlMask ,   xK_h     ), sendMessage $ ShrinkFrom L)
-- > , ((modm .|. altMask .|. ctrlMask ,   xK_j     ), sendMessage $ ShrinkFrom D)
-- > , ((modm .|. altMask .|. ctrlMask ,   xK_k     ), sendMessage $ ShrinkFrom U)
-- > , ((modm,                             xK_r     ), sendMessage Rotate)
-- > , ((modm,                             xK_s     ), sendMessage Swap)
-- > , ((modm,                             xK_n     ), sendMessage FocusParent)
-- > , ((modm .|. ctrlMask,                xK_n     ), sendMessage SelectNode)
-- > , ((modm .|. shiftMask,               xK_n     ), sendMessage MoveNode)
-- > , ((modm .|. shiftMask .|. ctrlMask , xK_j     ), sendMessage $ SplitShift Prev)
-- > , ((modm .|. shiftMask .|. ctrlMask , xK_k     ), sendMessage $ SplitShift Next)
--
-- Here's an alternative key mapping, this time using additionalKeysP,
-- arrow keys, and slightly different behavior when resizing windows
--
-- > , ("M-M1-<Left>",    sendMessage $ ExpandTowards L)
-- > , ("M-M1-<Right>",   sendMessage $ ShrinkFrom L)
-- > , ("M-M1-<Up>",      sendMessage $ ExpandTowards U)
-- > , ("M-M1-<Down>",    sendMessage $ ShrinkFrom U)
-- > , ("M-M1-C-<Left>",  sendMessage $ ShrinkFrom R)
-- > , ("M-M1-C-<Right>", sendMessage $ ExpandTowards R)
-- > , ("M-M1-C-<Up>",    sendMessage $ ShrinkFrom D)
-- > , ("M-M1-C-<Down>",  sendMessage $ ExpandTowards D)
-- > , ("M-s",            sendMessage $ Swap)
-- > , ("M-M1-s",         sendMessage $ Rotate)
-- > , ("M-S-C-j",        sendMessage $ SplitShift Prev)
-- > , ("M-S-C-k",        sendMessage $ SplitShift Next)
--
-- Note that @ExpandTowards x@, @ShrinkFrom x@, and @MoveSplit x@ are
-- the same as respectively @ExpandTowardsBy x 0.05@, @ShrinkFromBy x 0.05@
-- and @MoveSplitBy x 0.05@.
--
-- If you have many windows open and the layout begins to look too hard to manage, you can 'Balance'
-- the layout, so that the current splittings are discarded and windows are tiled freshly in a way that
-- the split depth is minimized. You can combine this with 'Equalize', which does not change your tree,
-- but tunes the split ratios in a way that each window gets the same amount of space:
--
-- > , ((myModMask,               xK_a),     sendMessage Balance)
-- > , ((myModMask .|. shiftMask, xK_a),     sendMessage Equalize)
--

-- | Message for rotating the binary tree around the parent node of the window to the left or right
data TreeRotate = RotateL | RotateR
instance Message TreeRotate

-- | Message to balance the tree in some way (Balance retiles the windows, Equalize changes ratios)
data TreeBalance = Balance | Equalize
instance Message TreeBalance

-- | Message for resizing one of the cells in the BSP
data ResizeDirectional =
        ExpandTowardsBy Direction2D Rational
      | ShrinkFromBy Direction2D Rational
      | MoveSplitBy Direction2D Rational
instance Message ResizeDirectional

-- | @ExpandTowards x@ is now the equivalent of @ExpandTowardsBy x 0.05@
pattern ExpandTowards :: Direction2D -> ResizeDirectional
pattern $mExpandTowards :: forall {r}.
ResizeDirectional -> (Direction2D -> r) -> ((# #) -> r) -> r
$bExpandTowards :: Direction2D -> ResizeDirectional
ExpandTowards d = ExpandTowardsBy d 0.05

-- | @ShrinkFrom x@ is now the equivalent of @ShrinkFromBy x 0.05@
pattern ShrinkFrom :: Direction2D -> ResizeDirectional
pattern $mShrinkFrom :: forall {r}.
ResizeDirectional -> (Direction2D -> r) -> ((# #) -> r) -> r
$bShrinkFrom :: Direction2D -> ResizeDirectional
ShrinkFrom d = ShrinkFromBy d 0.05

-- | @MoveSplit x@ is now the equivalent of @MoveSplitBy x 0.05@
pattern MoveSplit :: Direction2D -> ResizeDirectional
pattern $mMoveSplit :: forall {r}.
ResizeDirectional -> (Direction2D -> r) -> ((# #) -> r) -> r
$bMoveSplit :: Direction2D -> ResizeDirectional
MoveSplit d = MoveSplitBy d 0.05

-- | Message for rotating a split (horizontal/vertical) in the BSP
data Rotate = Rotate
instance Message Rotate

-- | Message for swapping the left child of a split with the right child of split
data Swap = Swap
instance Message Swap

-- | Message to cyclically select the parent node instead of the leaf
data FocusParent = FocusParent
instance Message FocusParent

-- | Message to move nodes inside the tree
data SelectMoveNode = SelectNode | MoveNode
instance Message SelectMoveNode

data Axis = Horizontal | Vertical deriving (Int -> Axis -> ShowS
[Axis] -> ShowS
Axis -> String
(Int -> Axis -> ShowS)
-> (Axis -> String) -> ([Axis] -> ShowS) -> Show Axis
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Axis -> ShowS
showsPrec :: Int -> Axis -> ShowS
$cshow :: Axis -> String
show :: Axis -> String
$cshowList :: [Axis] -> ShowS
showList :: [Axis] -> ShowS
Show, ReadPrec [Axis]
ReadPrec Axis
Int -> ReadS Axis
ReadS [Axis]
(Int -> ReadS Axis)
-> ReadS [Axis] -> ReadPrec Axis -> ReadPrec [Axis] -> Read Axis
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Axis
readsPrec :: Int -> ReadS Axis
$creadList :: ReadS [Axis]
readList :: ReadS [Axis]
$creadPrec :: ReadPrec Axis
readPrec :: ReadPrec Axis
$creadListPrec :: ReadPrec [Axis]
readListPrec :: ReadPrec [Axis]
Read, Axis -> Axis -> Bool
(Axis -> Axis -> Bool) -> (Axis -> Axis -> Bool) -> Eq Axis
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Axis -> Axis -> Bool
== :: Axis -> Axis -> Bool
$c/= :: Axis -> Axis -> Bool
/= :: Axis -> Axis -> Bool
Eq)

-- | Message for shifting window by splitting its neighbour
newtype SplitShiftDirectional = SplitShift Direction1D
instance Message SplitShiftDirectional

oppositeDirection :: Direction2D -> Direction2D
oppositeDirection :: Direction2D -> Direction2D
oppositeDirection Direction2D
U = Direction2D
D
oppositeDirection Direction2D
D = Direction2D
U
oppositeDirection Direction2D
L = Direction2D
R
oppositeDirection Direction2D
R = Direction2D
L

oppositeAxis :: Axis -> Axis
oppositeAxis :: Axis -> Axis
oppositeAxis Axis
Vertical = Axis
Horizontal
oppositeAxis Axis
Horizontal = Axis
Vertical

toAxis :: Direction2D -> Axis
toAxis :: Direction2D -> Axis
toAxis Direction2D
U = Axis
Horizontal
toAxis Direction2D
D = Axis
Horizontal
toAxis Direction2D
L = Axis
Vertical
toAxis Direction2D
R = Axis
Vertical

split :: Axis -> Rational -> Rectangle -> (Rectangle, Rectangle)
split :: Axis -> Rational -> Rectangle -> (Rectangle, Rectangle)
split Axis
Horizontal Rational
r (Rectangle Position
sx Position
sy Dimension
sw Dimension
sh) = (Rectangle
r1, Rectangle
r2) where
    r1 :: Rectangle
r1 = Position -> Position -> Dimension -> Dimension -> Rectangle
Rectangle Position
sx Position
sy Dimension
sw Dimension
sh'
    r2 :: Rectangle
r2 = Position -> Position -> Dimension -> Dimension -> Rectangle
Rectangle Position
sx (Position
sy Position -> Position -> Position
forall a. Num a => a -> a -> a
+ Dimension -> Position
forall a b. (Integral a, Num b) => a -> b
fromIntegral Dimension
sh') Dimension
sw (Dimension
sh Dimension -> Dimension -> Dimension
forall a. Num a => a -> a -> a
- Dimension
sh')
    sh' :: Dimension
sh' = Rational -> Dimension
forall b. Integral b => Rational -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor (Rational -> Dimension) -> Rational -> Dimension
forall a b. (a -> b) -> a -> b
$ Dimension -> Rational
forall a b. (Integral a, Num b) => a -> b
fromIntegral Dimension
sh Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* Rational
r
split Axis
Vertical Rational
r (Rectangle Position
sx Position
sy Dimension
sw Dimension
sh) = (Rectangle
r1, Rectangle
r2) where
    r1 :: Rectangle
r1 = Position -> Position -> Dimension -> Dimension -> Rectangle
Rectangle Position
sx Position
sy Dimension
sw' Dimension
sh
    r2 :: Rectangle
r2 = Position -> Position -> Dimension -> Dimension -> Rectangle
Rectangle (Position
sx Position -> Position -> Position
forall a. Num a => a -> a -> a
+ Dimension -> Position
forall a b. (Integral a, Num b) => a -> b
fromIntegral Dimension
sw') Position
sy (Dimension
sw Dimension -> Dimension -> Dimension
forall a. Num a => a -> a -> a
- Dimension
sw') Dimension
sh
    sw' :: Dimension
sw' = Rational -> Dimension
forall b. Integral b => Rational -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor (Rational -> Dimension) -> Rational -> Dimension
forall a b. (a -> b) -> a -> b
$ Dimension -> Rational
forall a b. (Integral a, Num b) => a -> b
fromIntegral Dimension
sw Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* Rational
r

data Split = Split { Split -> Axis
axis :: Axis
                   , Split -> Rational
ratio :: Rational
                   } deriving (Int -> Split -> ShowS
[Split] -> ShowS
Split -> String
(Int -> Split -> ShowS)
-> (Split -> String) -> ([Split] -> ShowS) -> Show Split
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Split -> ShowS
showsPrec :: Int -> Split -> ShowS
$cshow :: Split -> String
show :: Split -> String
$cshowList :: [Split] -> ShowS
showList :: [Split] -> ShowS
Show, ReadPrec [Split]
ReadPrec Split
Int -> ReadS Split
ReadS [Split]
(Int -> ReadS Split)
-> ReadS [Split]
-> ReadPrec Split
-> ReadPrec [Split]
-> Read Split
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Split
readsPrec :: Int -> ReadS Split
$creadList :: ReadS [Split]
readList :: ReadS [Split]
$creadPrec :: ReadPrec Split
readPrec :: ReadPrec Split
$creadListPrec :: ReadPrec [Split]
readListPrec :: ReadPrec [Split]
Read, Split -> Split -> Bool
(Split -> Split -> Bool) -> (Split -> Split -> Bool) -> Eq Split
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Split -> Split -> Bool
== :: Split -> Split -> Bool
$c/= :: Split -> Split -> Bool
/= :: Split -> Split -> Bool
Eq)

oppositeSplit :: Split -> Split
oppositeSplit :: Split -> Split
oppositeSplit (Split Axis
d Rational
r) = Axis -> Rational -> Split
Split (Axis -> Axis
oppositeAxis Axis
d) Rational
r

increaseRatio :: Split -> Rational -> Split
increaseRatio :: Split -> Rational -> Split
increaseRatio (Split Axis
d Rational
r) Rational
delta = Axis -> Rational -> Split
Split Axis
d (Rational -> Rational -> Rational
forall a. Ord a => a -> a -> a
min Rational
0.9 (Rational -> Rational -> Rational
forall a. Ord a => a -> a -> a
max Rational
0.1 (Rational
r Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
+ Rational
delta)))

data Tree a = Leaf Int | Node { forall a. Tree a -> a
value :: a
                          , forall a. Tree a -> Tree a
left :: Tree a
                          , forall a. Tree a -> Tree a
right :: Tree a
                          } deriving (Int -> Tree a -> ShowS
[Tree a] -> ShowS
Tree a -> String
(Int -> Tree a -> ShowS)
-> (Tree a -> String) -> ([Tree a] -> ShowS) -> Show (Tree a)
forall a. Show a => Int -> Tree a -> ShowS
forall a. Show a => [Tree a] -> ShowS
forall a. Show a => Tree a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> Tree a -> ShowS
showsPrec :: Int -> Tree a -> ShowS
$cshow :: forall a. Show a => Tree a -> String
show :: Tree a -> String
$cshowList :: forall a. Show a => [Tree a] -> ShowS
showList :: [Tree a] -> ShowS
Show, ReadPrec [Tree a]
ReadPrec (Tree a)
Int -> ReadS (Tree a)
ReadS [Tree a]
(Int -> ReadS (Tree a))
-> ReadS [Tree a]
-> ReadPrec (Tree a)
-> ReadPrec [Tree a]
-> Read (Tree a)
forall a. Read a => ReadPrec [Tree a]
forall a. Read a => ReadPrec (Tree a)
forall a. Read a => Int -> ReadS (Tree a)
forall a. Read a => ReadS [Tree a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: forall a. Read a => Int -> ReadS (Tree a)
readsPrec :: Int -> ReadS (Tree a)
$creadList :: forall a. Read a => ReadS [Tree a]
readList :: ReadS [Tree a]
$creadPrec :: forall a. Read a => ReadPrec (Tree a)
readPrec :: ReadPrec (Tree a)
$creadListPrec :: forall a. Read a => ReadPrec [Tree a]
readListPrec :: ReadPrec [Tree a]
Read, Tree a -> Tree a -> Bool
(Tree a -> Tree a -> Bool)
-> (Tree a -> Tree a -> Bool) -> Eq (Tree a)
forall a. Eq a => Tree a -> Tree a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => Tree a -> Tree a -> Bool
== :: Tree a -> Tree a -> Bool
$c/= :: forall a. Eq a => Tree a -> Tree a -> Bool
/= :: Tree a -> Tree a -> Bool
Eq)

numLeaves :: Tree a -> Int
numLeaves :: forall a. Tree a -> Int
numLeaves (Leaf Int
_) = Int
1
numLeaves (Node a
_ Tree a
l Tree a
r) = Tree a -> Int
forall a. Tree a -> Int
numLeaves Tree a
l Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Tree a -> Int
forall a. Tree a -> Int
numLeaves Tree a
r

-- right or left rotation of a (sub)tree, no effect if rotation not possible
rotTree :: Direction2D -> Tree a -> Tree a
rotTree :: forall a. Direction2D -> Tree a -> Tree a
rotTree Direction2D
_ (Leaf Int
n) = Int -> Tree a
forall a. Int -> Tree a
Leaf Int
n
rotTree Direction2D
R n :: Tree a
n@(Node a
_ (Leaf Int
_) Tree a
_) = Tree a
n
rotTree Direction2D
L n :: Tree a
n@(Node a
_ Tree a
_ (Leaf Int
_)) = Tree a
n
rotTree Direction2D
R (Node a
sp (Node a
sp2 Tree a
l2 Tree a
r2) Tree a
r) = a -> Tree a -> Tree a -> Tree a
forall a. a -> Tree a -> Tree a -> Tree a
Node a
sp2 Tree a
l2 (a -> Tree a -> Tree a -> Tree a
forall a. a -> Tree a -> Tree a -> Tree a
Node a
sp Tree a
r2 Tree a
r)
rotTree Direction2D
L (Node a
sp Tree a
l (Node a
sp2 Tree a
l2 Tree a
r2)) = a -> Tree a -> Tree a -> Tree a
forall a. a -> Tree a -> Tree a -> Tree a
Node a
sp2 (a -> Tree a -> Tree a -> Tree a
forall a. a -> Tree a -> Tree a -> Tree a
Node a
sp Tree a
l Tree a
l2) Tree a
r2
rotTree Direction2D
_ Tree a
t = Tree a
t


data Crumb a = LeftCrumb a (Tree a) | RightCrumb a (Tree a) deriving (Int -> Crumb a -> ShowS
[Crumb a] -> ShowS
Crumb a -> String
(Int -> Crumb a -> ShowS)
-> (Crumb a -> String) -> ([Crumb a] -> ShowS) -> Show (Crumb a)
forall a. Show a => Int -> Crumb a -> ShowS
forall a. Show a => [Crumb a] -> ShowS
forall a. Show a => Crumb a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> Crumb a -> ShowS
showsPrec :: Int -> Crumb a -> ShowS
$cshow :: forall a. Show a => Crumb a -> String
show :: Crumb a -> String
$cshowList :: forall a. Show a => [Crumb a] -> ShowS
showList :: [Crumb a] -> ShowS
Show, ReadPrec [Crumb a]
ReadPrec (Crumb a)
Int -> ReadS (Crumb a)
ReadS [Crumb a]
(Int -> ReadS (Crumb a))
-> ReadS [Crumb a]
-> ReadPrec (Crumb a)
-> ReadPrec [Crumb a]
-> Read (Crumb a)
forall a. Read a => ReadPrec [Crumb a]
forall a. Read a => ReadPrec (Crumb a)
forall a. Read a => Int -> ReadS (Crumb a)
forall a. Read a => ReadS [Crumb a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: forall a. Read a => Int -> ReadS (Crumb a)
readsPrec :: Int -> ReadS (Crumb a)
$creadList :: forall a. Read a => ReadS [Crumb a]
readList :: ReadS [Crumb a]
$creadPrec :: forall a. Read a => ReadPrec (Crumb a)
readPrec :: ReadPrec (Crumb a)
$creadListPrec :: forall a. Read a => ReadPrec [Crumb a]
readListPrec :: ReadPrec [Crumb a]
Read, Crumb a -> Crumb a -> Bool
(Crumb a -> Crumb a -> Bool)
-> (Crumb a -> Crumb a -> Bool) -> Eq (Crumb a)
forall a. Eq a => Crumb a -> Crumb a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => Crumb a -> Crumb a -> Bool
== :: Crumb a -> Crumb a -> Bool
$c/= :: forall a. Eq a => Crumb a -> Crumb a -> Bool
/= :: Crumb a -> Crumb a -> Bool
Eq)

swapCrumb :: Crumb a -> Crumb a
swapCrumb :: forall a. Crumb a -> Crumb a
swapCrumb (LeftCrumb a
s Tree a
t) = a -> Tree a -> Crumb a
forall a. a -> Tree a -> Crumb a
RightCrumb a
s Tree a
t
swapCrumb (RightCrumb a
s Tree a
t) = a -> Tree a -> Crumb a
forall a. a -> Tree a -> Crumb a
LeftCrumb a
s Tree a
t

parentVal :: Crumb a -> a
parentVal :: forall a. Crumb a -> a
parentVal (LeftCrumb a
s Tree a
_) = a
s
parentVal (RightCrumb a
s Tree a
_) = a
s

modifyParentVal :: (a -> a) -> Crumb a -> Crumb a
modifyParentVal :: forall a. (a -> a) -> Crumb a -> Crumb a
modifyParentVal a -> a
f (LeftCrumb a
s Tree a
t) = a -> Tree a -> Crumb a
forall a. a -> Tree a -> Crumb a
LeftCrumb (a -> a
f a
s) Tree a
t
modifyParentVal a -> a
f (RightCrumb a
s Tree a
t) = a -> Tree a -> Crumb a
forall a. a -> Tree a -> Crumb a
RightCrumb (a -> a
f a
s) Tree a
t

type Zipper a = (Tree a, [Crumb a])

toZipper :: Tree a -> Zipper a
toZipper :: forall a. Tree a -> Zipper a
toZipper Tree a
t = (Tree a
t, [])

goLeft :: Zipper a -> Maybe (Zipper a)
goLeft :: forall a. Zipper a -> Maybe (Zipper a)
goLeft (Leaf Int
_, [Crumb a]
_) = Maybe (Tree a, [Crumb a])
forall a. Maybe a
Nothing
goLeft (Node a
x Tree a
l Tree a
r, [Crumb a]
bs) = (Tree a, [Crumb a]) -> Maybe (Tree a, [Crumb a])
forall a. a -> Maybe a
Just (Tree a
l, a -> Tree a -> Crumb a
forall a. a -> Tree a -> Crumb a
LeftCrumb a
x Tree a
rCrumb a -> [Crumb a] -> [Crumb a]
forall a. a -> [a] -> [a]
:[Crumb a]
bs)

goRight :: Zipper a -> Maybe (Zipper a)
goRight :: forall a. Zipper a -> Maybe (Zipper a)
goRight (Leaf Int
_, [Crumb a]
_) = Maybe (Tree a, [Crumb a])
forall a. Maybe a
Nothing
goRight (Node a
x Tree a
l Tree a
r, [Crumb a]
bs) = (Tree a, [Crumb a]) -> Maybe (Tree a, [Crumb a])
forall a. a -> Maybe a
Just (Tree a
r, a -> Tree a -> Crumb a
forall a. a -> Tree a -> Crumb a
RightCrumb a
x Tree a
lCrumb a -> [Crumb a] -> [Crumb a]
forall a. a -> [a] -> [a]
:[Crumb a]
bs)

goUp :: Zipper a -> Maybe (Zipper a)
goUp :: forall a. Zipper a -> Maybe (Zipper a)
goUp (Tree a
_, []) = Maybe (Tree a, [Crumb a])
forall a. Maybe a
Nothing
goUp (Tree a
t, LeftCrumb a
x Tree a
r:[Crumb a]
cs) = (Tree a, [Crumb a]) -> Maybe (Tree a, [Crumb a])
forall a. a -> Maybe a
Just (a -> Tree a -> Tree a -> Tree a
forall a. a -> Tree a -> Tree a -> Tree a
Node a
x Tree a
t Tree a
r, [Crumb a]
cs)
goUp (Tree a
t, RightCrumb a
x Tree a
l:[Crumb a]
cs) = (Tree a, [Crumb a]) -> Maybe (Tree a, [Crumb a])
forall a. a -> Maybe a
Just (a -> Tree a -> Tree a -> Tree a
forall a. a -> Tree a -> Tree a -> Tree a
Node a
x Tree a
l Tree a
t, [Crumb a]
cs)

goSibling :: Zipper a -> Maybe (Zipper a)
goSibling :: forall a. Zipper a -> Maybe (Zipper a)
goSibling (Tree a
_, []) = Maybe (Tree a, [Crumb a])
forall a. Maybe a
Nothing
goSibling z :: (Tree a, [Crumb a])
z@(Tree a
_, LeftCrumb a
_ Tree a
_:[Crumb a]
_) = (Tree a, [Crumb a]) -> Maybe (Tree a, [Crumb a])
forall a. a -> Maybe a
Just (Tree a, [Crumb a])
z Maybe (Tree a, [Crumb a])
-> ((Tree a, [Crumb a]) -> Maybe (Tree a, [Crumb a]))
-> Maybe (Tree a, [Crumb a])
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Tree a, [Crumb a]) -> Maybe (Tree a, [Crumb a])
forall a. Zipper a -> Maybe (Zipper a)
goUp Maybe (Tree a, [Crumb a])
-> ((Tree a, [Crumb a]) -> Maybe (Tree a, [Crumb a]))
-> Maybe (Tree a, [Crumb a])
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Tree a, [Crumb a]) -> Maybe (Tree a, [Crumb a])
forall a. Zipper a -> Maybe (Zipper a)
goRight
goSibling z :: (Tree a, [Crumb a])
z@(Tree a
_, RightCrumb a
_ Tree a
_:[Crumb a]
_) = (Tree a, [Crumb a]) -> Maybe (Tree a, [Crumb a])
forall a. a -> Maybe a
Just (Tree a, [Crumb a])
z Maybe (Tree a, [Crumb a])
-> ((Tree a, [Crumb a]) -> Maybe (Tree a, [Crumb a]))
-> Maybe (Tree a, [Crumb a])
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Tree a, [Crumb a]) -> Maybe (Tree a, [Crumb a])
forall a. Zipper a -> Maybe (Zipper a)
goUp Maybe (Tree a, [Crumb a])
-> ((Tree a, [Crumb a]) -> Maybe (Tree a, [Crumb a]))
-> Maybe (Tree a, [Crumb a])
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Tree a, [Crumb a]) -> Maybe (Tree a, [Crumb a])
forall a. Zipper a -> Maybe (Zipper a)
goLeft

top :: Zipper a -> Zipper a
top :: forall a. Zipper a -> Zipper a
top Zipper a
z = Zipper a -> (Zipper a -> Zipper a) -> Maybe (Zipper a) -> Zipper a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Zipper a
z Zipper a -> Zipper a
forall a. Zipper a -> Zipper a
top (Zipper a -> Maybe (Zipper a)
forall a. Zipper a -> Maybe (Zipper a)
goUp Zipper a
z)

toTree :: Zipper a -> Tree a
toTree :: forall a. Zipper a -> Tree a
toTree = (Tree a, [Crumb a]) -> Tree a
forall a b. (a, b) -> a
fst ((Tree a, [Crumb a]) -> Tree a)
-> ((Tree a, [Crumb a]) -> (Tree a, [Crumb a]))
-> (Tree a, [Crumb a])
-> Tree a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Tree a, [Crumb a]) -> (Tree a, [Crumb a])
forall a. Zipper a -> Zipper a
top

goToNthLeaf :: Int -> Zipper a -> Maybe (Zipper a)
goToNthLeaf :: forall a. Int -> Zipper a -> Maybe (Zipper a)
goToNthLeaf Int
_ z :: Zipper a
z@(Leaf Int
_, [Crumb a]
_) = Zipper a -> Maybe (Zipper a)
forall a. a -> Maybe a
Just Zipper a
z
goToNthLeaf Int
n z :: Zipper a
z@(Tree a
t, [Crumb a]
_) =
  if Tree a -> Int
forall a. Tree a -> Int
numLeaves (Tree a -> Tree a
forall a. Tree a -> Tree a
left Tree a
t) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
n
  then do Zipper a
z' <- Zipper a -> Maybe (Zipper a)
forall a. Zipper a -> Maybe (Zipper a)
goLeft Zipper a
z
          Int -> Zipper a -> Maybe (Zipper a)
forall a. Int -> Zipper a -> Maybe (Zipper a)
goToNthLeaf Int
n Zipper a
z'
  else do Zipper a
z' <- Zipper a -> Maybe (Zipper a)
forall a. Zipper a -> Maybe (Zipper a)
goRight Zipper a
z
          Int -> Zipper a -> Maybe (Zipper a)
forall a. Int -> Zipper a -> Maybe (Zipper a)
goToNthLeaf (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- (Tree a -> Int
forall a. Tree a -> Int
numLeaves (Tree a -> Int) -> (Tree a -> Tree a) -> Tree a -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tree a -> Tree a
forall a. Tree a -> Tree a
left (Tree a -> Int) -> Tree a -> Int
forall a b. (a -> b) -> a -> b
$ Tree a
t)) Zipper a
z'

toggleSplits :: Tree Split -> Tree Split
toggleSplits :: Tree Split -> Tree Split
toggleSplits (Leaf Int
l) = Int -> Tree Split
forall a. Int -> Tree a
Leaf Int
l
toggleSplits (Node Split
s Tree Split
l Tree Split
r) = Split -> Tree Split -> Tree Split -> Tree Split
forall a. a -> Tree a -> Tree a -> Tree a
Node (Split -> Split
oppositeSplit Split
s) (Tree Split -> Tree Split
toggleSplits Tree Split
l) (Tree Split -> Tree Split
toggleSplits Tree Split
r)

splitCurrent :: Zipper Split -> Maybe (Zipper Split)
splitCurrent :: Zipper Split -> Maybe (Zipper Split)
splitCurrent (Leaf Int
_, []) = Zipper Split -> Maybe (Zipper Split)
forall a. a -> Maybe a
Just (Split -> Tree Split -> Tree Split -> Tree Split
forall a. a -> Tree a -> Tree a -> Tree a
Node (Axis -> Rational -> Split
Split Axis
Vertical Rational
0.5) (Int -> Tree Split
forall a. Int -> Tree a
Leaf Int
0) (Int -> Tree Split
forall a. Int -> Tree a
Leaf Int
0), [])
splitCurrent (Leaf Int
_, Crumb Split
crumb:[Crumb Split]
cs) = Zipper Split -> Maybe (Zipper Split)
forall a. a -> Maybe a
Just (Split -> Tree Split -> Tree Split -> Tree Split
forall a. a -> Tree a -> Tree a -> Tree a
Node (Axis -> Rational -> Split
Split (Axis -> Axis
oppositeAxis (Axis -> Axis) -> (Crumb Split -> Axis) -> Crumb Split -> Axis
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Split -> Axis
axis (Split -> Axis) -> (Crumb Split -> Split) -> Crumb Split -> Axis
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Crumb Split -> Split
forall a. Crumb a -> a
parentVal (Crumb Split -> Axis) -> Crumb Split -> Axis
forall a b. (a -> b) -> a -> b
$ Crumb Split
crumb) Rational
0.5) (Int -> Tree Split
forall a. Int -> Tree a
Leaf Int
0) (Int -> Tree Split
forall a. Int -> Tree a
Leaf Int
0), Crumb Split
crumbCrumb Split -> [Crumb Split] -> [Crumb Split]
forall a. a -> [a] -> [a]
:[Crumb Split]
cs)
splitCurrent (Tree Split
n, []) = Zipper Split -> Maybe (Zipper Split)
forall a. a -> Maybe a
Just (Split -> Tree Split -> Tree Split -> Tree Split
forall a. a -> Tree a -> Tree a -> Tree a
Node (Axis -> Rational -> Split
Split Axis
Vertical Rational
0.5) (Int -> Tree Split
forall a. Int -> Tree a
Leaf Int
0) (Tree Split -> Tree Split
toggleSplits Tree Split
n), [])
splitCurrent (Tree Split
n, Crumb Split
crumb:[Crumb Split]
cs) = Zipper Split -> Maybe (Zipper Split)
forall a. a -> Maybe a
Just (Split -> Tree Split -> Tree Split -> Tree Split
forall a. a -> Tree a -> Tree a -> Tree a
Node (Axis -> Rational -> Split
Split (Axis -> Axis
oppositeAxis (Axis -> Axis) -> (Crumb Split -> Axis) -> Crumb Split -> Axis
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Split -> Axis
axis (Split -> Axis) -> (Crumb Split -> Split) -> Crumb Split -> Axis
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Crumb Split -> Split
forall a. Crumb a -> a
parentVal (Crumb Split -> Axis) -> Crumb Split -> Axis
forall a b. (a -> b) -> a -> b
$ Crumb Split
crumb) Rational
0.5) (Int -> Tree Split
forall a. Int -> Tree a
Leaf Int
0) (Tree Split -> Tree Split
toggleSplits Tree Split
n), Crumb Split
crumbCrumb Split -> [Crumb Split] -> [Crumb Split]
forall a. a -> [a] -> [a]
:[Crumb Split]
cs)

removeCurrent :: Zipper a -> Maybe (Zipper a)
removeCurrent :: forall a. Zipper a -> Maybe (Zipper a)
removeCurrent (Leaf Int
_, LeftCrumb a
_ Tree a
r:[Crumb a]
cs) = (Tree a, [Crumb a]) -> Maybe (Tree a, [Crumb a])
forall a. a -> Maybe a
Just (Tree a
r, [Crumb a]
cs)
removeCurrent (Leaf Int
_, RightCrumb a
_ Tree a
l:[Crumb a]
cs) = (Tree a, [Crumb a]) -> Maybe (Tree a, [Crumb a])
forall a. a -> Maybe a
Just (Tree a
l, [Crumb a]
cs)
removeCurrent (Leaf Int
_, []) = Maybe (Tree a, [Crumb a])
forall a. Maybe a
Nothing
removeCurrent (Node a
_ (Leaf Int
_) r :: Tree a
r@Node{}, [Crumb a]
cs) = (Tree a, [Crumb a]) -> Maybe (Tree a, [Crumb a])
forall a. a -> Maybe a
Just (Tree a
r, [Crumb a]
cs)
removeCurrent (Node a
_ l :: Tree a
l@Node{} (Leaf Int
_), [Crumb a]
cs) = (Tree a, [Crumb a]) -> Maybe (Tree a, [Crumb a])
forall a. a -> Maybe a
Just (Tree a
l, [Crumb a]
cs)
removeCurrent (Node a
_ (Leaf Int
_) (Leaf Int
_), [Crumb a]
cs) = (Tree a, [Crumb a]) -> Maybe (Tree a, [Crumb a])
forall a. a -> Maybe a
Just (Int -> Tree a
forall a. Int -> Tree a
Leaf Int
0, [Crumb a]
cs)
removeCurrent z :: (Tree a, [Crumb a])
z@(Node{}, [Crumb a]
_) = (Tree a, [Crumb a]) -> Maybe (Tree a, [Crumb a])
forall a. Zipper a -> Maybe (Zipper a)
goLeft (Tree a, [Crumb a])
z Maybe (Tree a, [Crumb a])
-> ((Tree a, [Crumb a]) -> Maybe (Tree a, [Crumb a]))
-> Maybe (Tree a, [Crumb a])
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Tree a, [Crumb a]) -> Maybe (Tree a, [Crumb a])
forall a. Zipper a -> Maybe (Zipper a)
removeCurrent

rotateCurrent :: Zipper Split -> Maybe (Zipper Split)
rotateCurrent :: Zipper Split -> Maybe (Zipper Split)
rotateCurrent l :: Zipper Split
l@(Tree Split
_, []) = Zipper Split -> Maybe (Zipper Split)
forall a. a -> Maybe a
Just Zipper Split
l
rotateCurrent (Tree Split
n, Crumb Split
c:[Crumb Split]
cs) = Zipper Split -> Maybe (Zipper Split)
forall a. a -> Maybe a
Just (Tree Split
n, (Split -> Split) -> Crumb Split -> Crumb Split
forall a. (a -> a) -> Crumb a -> Crumb a
modifyParentVal Split -> Split
oppositeSplit Crumb Split
cCrumb Split -> [Crumb Split] -> [Crumb Split]
forall a. a -> [a] -> [a]
:[Crumb Split]
cs)

swapCurrent :: Zipper a -> Maybe (Zipper a)
swapCurrent :: forall a. Zipper a -> Maybe (Zipper a)
swapCurrent l :: Zipper a
l@(Tree a
_, []) = Zipper a -> Maybe (Zipper a)
forall a. a -> Maybe a
Just Zipper a
l
swapCurrent (Tree a
n, Crumb a
c:[Crumb a]
cs) = Zipper a -> Maybe (Zipper a)
forall a. a -> Maybe a
Just (Tree a
n, Crumb a -> Crumb a
forall a. Crumb a -> Crumb a
swapCrumb Crumb a
cCrumb a -> [Crumb a] -> [Crumb a]
forall a. a -> [a] -> [a]
:[Crumb a]
cs)

insertLeftLeaf :: Tree Split -> Zipper Split -> Maybe (Zipper Split)
insertLeftLeaf :: Tree Split -> Zipper Split -> Maybe (Zipper Split)
insertLeftLeaf (Leaf Int
n) (Node Split
x Tree Split
l Tree Split
r, Crumb Split
crumb:[Crumb Split]
cs) = Zipper Split -> Maybe (Zipper Split)
forall a. a -> Maybe a
Just (Split -> Tree Split -> Tree Split -> Tree Split
forall a. a -> Tree a -> Tree a -> Tree a
Node (Axis -> Rational -> Split
Split (Axis -> Axis
oppositeAxis (Axis -> Axis) -> (Crumb Split -> Axis) -> Crumb Split -> Axis
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Split -> Axis
axis (Split -> Axis) -> (Crumb Split -> Split) -> Crumb Split -> Axis
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Crumb Split -> Split
forall a. Crumb a -> a
parentVal (Crumb Split -> Axis) -> Crumb Split -> Axis
forall a b. (a -> b) -> a -> b
$ Crumb Split
crumb) Rational
0.5) (Int -> Tree Split
forall a. Int -> Tree a
Leaf Int
n) (Split -> Tree Split -> Tree Split -> Tree Split
forall a. a -> Tree a -> Tree a -> Tree a
Node Split
x Tree Split
l Tree Split
r), Crumb Split
crumbCrumb Split -> [Crumb Split] -> [Crumb Split]
forall a. a -> [a] -> [a]
:[Crumb Split]
cs)
insertLeftLeaf (Leaf Int
n) (Leaf Int
x, Crumb Split
crumb:[Crumb Split]
cs) = Zipper Split -> Maybe (Zipper Split)
forall a. a -> Maybe a
Just (Split -> Tree Split -> Tree Split -> Tree Split
forall a. a -> Tree a -> Tree a -> Tree a
Node (Axis -> Rational -> Split
Split (Axis -> Axis
oppositeAxis (Axis -> Axis) -> (Crumb Split -> Axis) -> Crumb Split -> Axis
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Split -> Axis
axis (Split -> Axis) -> (Crumb Split -> Split) -> Crumb Split -> Axis
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Crumb Split -> Split
forall a. Crumb a -> a
parentVal (Crumb Split -> Axis) -> Crumb Split -> Axis
forall a b. (a -> b) -> a -> b
$ Crumb Split
crumb) Rational
0.5) (Int -> Tree Split
forall a. Int -> Tree a
Leaf Int
n) (Int -> Tree Split
forall a. Int -> Tree a
Leaf Int
x), Crumb Split
crumbCrumb Split -> [Crumb Split] -> [Crumb Split]
forall a. a -> [a] -> [a]
:[Crumb Split]
cs)
insertLeftLeaf Node{} Zipper Split
z = Zipper Split -> Maybe (Zipper Split)
forall a. a -> Maybe a
Just Zipper Split
z
insertLeftLeaf Tree Split
_ Zipper Split
_ = Maybe (Zipper Split)
forall a. Maybe a
Nothing

insertRightLeaf :: Tree Split -> Zipper Split -> Maybe (Zipper Split)
insertRightLeaf :: Tree Split -> Zipper Split -> Maybe (Zipper Split)
insertRightLeaf (Leaf Int
n) (Node Split
x Tree Split
l Tree Split
r, Crumb Split
crumb:[Crumb Split]
cs) = Zipper Split -> Maybe (Zipper Split)
forall a. a -> Maybe a
Just (Split -> Tree Split -> Tree Split -> Tree Split
forall a. a -> Tree a -> Tree a -> Tree a
Node (Axis -> Rational -> Split
Split (Axis -> Axis
oppositeAxis (Axis -> Axis) -> (Crumb Split -> Axis) -> Crumb Split -> Axis
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Split -> Axis
axis (Split -> Axis) -> (Crumb Split -> Split) -> Crumb Split -> Axis
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Crumb Split -> Split
forall a. Crumb a -> a
parentVal (Crumb Split -> Axis) -> Crumb Split -> Axis
forall a b. (a -> b) -> a -> b
$ Crumb Split
crumb) Rational
0.5) (Split -> Tree Split -> Tree Split -> Tree Split
forall a. a -> Tree a -> Tree a -> Tree a
Node Split
x Tree Split
l Tree Split
r) (Int -> Tree Split
forall a. Int -> Tree a
Leaf Int
n), Crumb Split
crumbCrumb Split -> [Crumb Split] -> [Crumb Split]
forall a. a -> [a] -> [a]
:[Crumb Split]
cs)
insertRightLeaf (Leaf Int
n) (Leaf Int
x, Crumb Split
crumb:[Crumb Split]
cs) = Zipper Split -> Maybe (Zipper Split)
forall a. a -> Maybe a
Just (Split -> Tree Split -> Tree Split -> Tree Split
forall a. a -> Tree a -> Tree a -> Tree a
Node (Axis -> Rational -> Split
Split (Axis -> Axis
oppositeAxis (Axis -> Axis) -> (Crumb Split -> Axis) -> Crumb Split -> Axis
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Split -> Axis
axis (Split -> Axis) -> (Crumb Split -> Split) -> Crumb Split -> Axis
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Crumb Split -> Split
forall a. Crumb a -> a
parentVal (Crumb Split -> Axis) -> Crumb Split -> Axis
forall a b. (a -> b) -> a -> b
$ Crumb Split
crumb) Rational
0.5) (Int -> Tree Split
forall a. Int -> Tree a
Leaf Int
x) (Int -> Tree Split
forall a. Int -> Tree a
Leaf Int
n), Crumb Split
crumbCrumb Split -> [Crumb Split] -> [Crumb Split]
forall a. a -> [a] -> [a]
:[Crumb Split]
cs)
insertRightLeaf Node{} Zipper Split
z = Zipper Split -> Maybe (Zipper Split)
forall a. a -> Maybe a
Just Zipper Split
z
insertRightLeaf Tree Split
_ Zipper Split
_ = Maybe (Zipper Split)
forall a. Maybe a
Nothing

findRightLeaf :: Zipper Split -> Maybe (Zipper Split)
findRightLeaf :: Zipper Split -> Maybe (Zipper Split)
findRightLeaf n :: Zipper Split
n@(Node{}, [Crumb Split]
_) = Zipper Split -> Maybe (Zipper Split)
forall a. Zipper a -> Maybe (Zipper a)
goRight Zipper Split
n Maybe (Zipper Split)
-> (Zipper Split -> Maybe (Zipper Split)) -> Maybe (Zipper Split)
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Zipper Split -> Maybe (Zipper Split)
findRightLeaf
findRightLeaf l :: Zipper Split
l@(Leaf Int
_, [Crumb Split]
_) = Zipper Split -> Maybe (Zipper Split)
forall a. a -> Maybe a
Just Zipper Split
l

findLeftLeaf :: Zipper Split -> Maybe (Zipper Split)
findLeftLeaf :: Zipper Split -> Maybe (Zipper Split)
findLeftLeaf n :: Zipper Split
n@(Node{}, [Crumb Split]
_) = Zipper Split -> Maybe (Zipper Split)
forall a. Zipper a -> Maybe (Zipper a)
goLeft Zipper Split
n
findLeftLeaf l :: Zipper Split
l@(Leaf Int
_, [Crumb Split]
_) = Zipper Split -> Maybe (Zipper Split)
forall a. a -> Maybe a
Just Zipper Split
l

findTheClosestLeftmostLeaf :: Zipper Split -> Maybe (Zipper Split)
findTheClosestLeftmostLeaf :: Zipper Split -> Maybe (Zipper Split)
findTheClosestLeftmostLeaf s :: Zipper Split
s@(Tree Split
_, (RightCrumb Split
_ Tree Split
_):[Crumb Split]
_) = Zipper Split -> Maybe (Zipper Split)
forall a. Zipper a -> Maybe (Zipper a)
goUp Zipper Split
s Maybe (Zipper Split)
-> (Zipper Split -> Maybe (Zipper Split)) -> Maybe (Zipper Split)
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Zipper Split -> Maybe (Zipper Split)
forall a. Zipper a -> Maybe (Zipper a)
goLeft Maybe (Zipper Split)
-> (Zipper Split -> Maybe (Zipper Split)) -> Maybe (Zipper Split)
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Zipper Split -> Maybe (Zipper Split)
findRightLeaf
findTheClosestLeftmostLeaf s :: Zipper Split
s@(Tree Split
_, (LeftCrumb Split
_ Tree Split
_):[Crumb Split]
_) = Zipper Split -> Maybe (Zipper Split)
forall a. Zipper a -> Maybe (Zipper a)
goUp Zipper Split
s Maybe (Zipper Split)
-> (Zipper Split -> Maybe (Zipper Split)) -> Maybe (Zipper Split)
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Zipper Split -> Maybe (Zipper Split)
findTheClosestLeftmostLeaf
findTheClosestLeftmostLeaf Zipper Split
_ = Maybe (Zipper Split)
forall a. Maybe a
Nothing

findTheClosestRightmostLeaf :: Zipper Split -> Maybe (Zipper Split)
findTheClosestRightmostLeaf :: Zipper Split -> Maybe (Zipper Split)
findTheClosestRightmostLeaf s :: Zipper Split
s@(Tree Split
_, (RightCrumb Split
_ Tree Split
_):[Crumb Split]
_) = Zipper Split -> Maybe (Zipper Split)
forall a. Zipper a -> Maybe (Zipper a)
goUp Zipper Split
s Maybe (Zipper Split)
-> (Zipper Split -> Maybe (Zipper Split)) -> Maybe (Zipper Split)
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Zipper Split -> Maybe (Zipper Split)
findTheClosestRightmostLeaf
findTheClosestRightmostLeaf s :: Zipper Split
s@(Tree Split
_, (LeftCrumb Split
_ Tree Split
_):[Crumb Split]
_) = Zipper Split -> Maybe (Zipper Split)
forall a. Zipper a -> Maybe (Zipper a)
goUp Zipper Split
s Maybe (Zipper Split)
-> (Zipper Split -> Maybe (Zipper Split)) -> Maybe (Zipper Split)
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Zipper Split -> Maybe (Zipper Split)
forall a. Zipper a -> Maybe (Zipper a)
goRight Maybe (Zipper Split)
-> (Zipper Split -> Maybe (Zipper Split)) -> Maybe (Zipper Split)
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Zipper Split -> Maybe (Zipper Split)
findLeftLeaf
findTheClosestRightmostLeaf Zipper Split
_ = Maybe (Zipper Split)
forall a. Maybe a
Nothing

splitShiftLeftCurrent :: Zipper Split -> Maybe (Zipper Split)
splitShiftLeftCurrent :: Zipper Split -> Maybe (Zipper Split)
splitShiftLeftCurrent l :: Zipper Split
l@(Tree Split
_, []) = Zipper Split -> Maybe (Zipper Split)
forall a. a -> Maybe a
Just Zipper Split
l
splitShiftLeftCurrent l :: Zipper Split
l@(Tree Split
_, (RightCrumb Split
_ Tree Split
_):[Crumb Split]
_) = Zipper Split -> Maybe (Zipper Split)
forall a. a -> Maybe a
Just Zipper Split
l -- Do nothing. We can swap windows instead.
splitShiftLeftCurrent l :: Zipper Split
l@(Tree Split
n, [Crumb Split]
_) = Zipper Split -> Maybe (Zipper Split)
forall a. Zipper a -> Maybe (Zipper a)
removeCurrent Zipper Split
l Maybe (Zipper Split)
-> (Zipper Split -> Maybe (Zipper Split)) -> Maybe (Zipper Split)
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Zipper Split -> Maybe (Zipper Split)
findTheClosestLeftmostLeaf Maybe (Zipper Split)
-> (Zipper Split -> Maybe (Zipper Split)) -> Maybe (Zipper Split)
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Tree Split -> Zipper Split -> Maybe (Zipper Split)
insertRightLeaf Tree Split
n

splitShiftRightCurrent :: Zipper Split -> Maybe (Zipper Split)
splitShiftRightCurrent :: Zipper Split -> Maybe (Zipper Split)
splitShiftRightCurrent l :: Zipper Split
l@(Tree Split
_, []) = Zipper Split -> Maybe (Zipper Split)
forall a. a -> Maybe a
Just Zipper Split
l
splitShiftRightCurrent l :: Zipper Split
l@(Tree Split
_, (LeftCrumb Split
_ Tree Split
_):[Crumb Split]
_) = Zipper Split -> Maybe (Zipper Split)
forall a. a -> Maybe a
Just Zipper Split
l -- Do nothing. We can swap windows instead.
splitShiftRightCurrent l :: Zipper Split
l@(Tree Split
n, [Crumb Split]
_) = Zipper Split -> Maybe (Zipper Split)
forall a. Zipper a -> Maybe (Zipper a)
removeCurrent Zipper Split
l Maybe (Zipper Split)
-> (Zipper Split -> Maybe (Zipper Split)) -> Maybe (Zipper Split)
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Zipper Split -> Maybe (Zipper Split)
findTheClosestRightmostLeaf Maybe (Zipper Split)
-> (Zipper Split -> Maybe (Zipper Split)) -> Maybe (Zipper Split)
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Tree Split -> Zipper Split -> Maybe (Zipper Split)
insertLeftLeaf Tree Split
n

isAllTheWay :: Direction2D -> Rational -> Zipper Split -> Bool
isAllTheWay :: Direction2D -> Rational -> Zipper Split -> Bool
isAllTheWay Direction2D
_ Rational
_ (Tree Split
_, []) = Bool
True
isAllTheWay Direction2D
R Rational
_ (Tree Split
_, LeftCrumb Split
s Tree Split
_:[Crumb Split]
_)
  | Split -> Axis
axis Split
s Axis -> Axis -> Bool
forall a. Eq a => a -> a -> Bool
== Axis
Vertical = Bool
False
isAllTheWay Direction2D
L Rational
_ (Tree Split
_, RightCrumb Split
s Tree Split
_:[Crumb Split]
_)
  | Split -> Axis
axis Split
s Axis -> Axis -> Bool
forall a. Eq a => a -> a -> Bool
== Axis
Vertical = Bool
False
isAllTheWay Direction2D
D Rational
_ (Tree Split
_, LeftCrumb Split
s Tree Split
_:[Crumb Split]
_)
  | Split -> Axis
axis Split
s Axis -> Axis -> Bool
forall a. Eq a => a -> a -> Bool
== Axis
Horizontal = Bool
False
isAllTheWay Direction2D
U Rational
_ (Tree Split
_, RightCrumb Split
s Tree Split
_:[Crumb Split]
_)
  | Split -> Axis
axis Split
s Axis -> Axis -> Bool
forall a. Eq a => a -> a -> Bool
== Axis
Horizontal = Bool
False
isAllTheWay Direction2D
dir Rational
diff Zipper Split
z = Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
False (Maybe Bool -> Bool) -> Maybe Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Zipper Split -> Maybe (Zipper Split)
forall a. Zipper a -> Maybe (Zipper a)
goUp Zipper Split
z Maybe (Zipper Split) -> (Zipper Split -> Maybe Bool) -> Maybe Bool
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Bool -> Maybe Bool
forall a. a -> Maybe a
Just (Bool -> Maybe Bool)
-> (Zipper Split -> Bool) -> Zipper Split -> Maybe Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Direction2D -> Rational -> Zipper Split -> Bool
isAllTheWay Direction2D
dir Rational
diff

expandTreeTowards :: Direction2D -> Rational -> Zipper Split -> Maybe (Zipper Split)
expandTreeTowards :: Direction2D -> Rational -> Zipper Split -> Maybe (Zipper Split)
expandTreeTowards Direction2D
_ Rational
_ z :: Zipper Split
z@(Tree Split
_, []) = Zipper Split -> Maybe (Zipper Split)
forall a. a -> Maybe a
Just Zipper Split
z
expandTreeTowards Direction2D
dir Rational
diff Zipper Split
z
  | Direction2D -> Rational -> Zipper Split -> Bool
isAllTheWay Direction2D
dir Rational
diff Zipper Split
z = Direction2D -> Rational -> Zipper Split -> Maybe (Zipper Split)
shrinkTreeFrom (Direction2D -> Direction2D
oppositeDirection Direction2D
dir) Rational
diff Zipper Split
z
expandTreeTowards Direction2D
R Rational
diff (Tree Split
t, LeftCrumb Split
s Tree Split
r:[Crumb Split]
cs)
  | Split -> Axis
axis Split
s Axis -> Axis -> Bool
forall a. Eq a => a -> a -> Bool
== Axis
Vertical = Zipper Split -> Maybe (Zipper Split)
forall a. a -> Maybe a
Just (Tree Split
t, Split -> Tree Split -> Crumb Split
forall a. a -> Tree a -> Crumb a
LeftCrumb (Split -> Rational -> Split
increaseRatio Split
s Rational
diff) Tree Split
rCrumb Split -> [Crumb Split] -> [Crumb Split]
forall a. a -> [a] -> [a]
:[Crumb Split]
cs)
expandTreeTowards Direction2D
L Rational
diff (Tree Split
t, RightCrumb Split
s Tree Split
l:[Crumb Split]
cs)
  | Split -> Axis
axis Split
s Axis -> Axis -> Bool
forall a. Eq a => a -> a -> Bool
== Axis
Vertical = Zipper Split -> Maybe (Zipper Split)
forall a. a -> Maybe a
Just (Tree Split
t, Split -> Tree Split -> Crumb Split
forall a. a -> Tree a -> Crumb a
RightCrumb (Split -> Rational -> Split
increaseRatio Split
s (-Rational
diff)) Tree Split
lCrumb Split -> [Crumb Split] -> [Crumb Split]
forall a. a -> [a] -> [a]
:[Crumb Split]
cs)
expandTreeTowards Direction2D
D Rational
diff (Tree Split
t, LeftCrumb Split
s Tree Split
r:[Crumb Split]
cs)
  | Split -> Axis
axis Split
s Axis -> Axis -> Bool
forall a. Eq a => a -> a -> Bool
== Axis
Horizontal = Zipper Split -> Maybe (Zipper Split)
forall a. a -> Maybe a
Just (Tree Split
t, Split -> Tree Split -> Crumb Split
forall a. a -> Tree a -> Crumb a
LeftCrumb (Split -> Rational -> Split
increaseRatio Split
s Rational
diff) Tree Split
rCrumb Split -> [Crumb Split] -> [Crumb Split]
forall a. a -> [a] -> [a]
:[Crumb Split]
cs)
expandTreeTowards Direction2D
U Rational
diff (Tree Split
t, RightCrumb Split
s Tree Split
l:[Crumb Split]
cs)
  | Split -> Axis
axis Split
s Axis -> Axis -> Bool
forall a. Eq a => a -> a -> Bool
== Axis
Horizontal = Zipper Split -> Maybe (Zipper Split)
forall a. a -> Maybe a
Just (Tree Split
t, Split -> Tree Split -> Crumb Split
forall a. a -> Tree a -> Crumb a
RightCrumb (Split -> Rational -> Split
increaseRatio Split
s (-Rational
diff)) Tree Split
lCrumb Split -> [Crumb Split] -> [Crumb Split]
forall a. a -> [a] -> [a]
:[Crumb Split]
cs)
expandTreeTowards Direction2D
dir Rational
diff Zipper Split
z = Zipper Split -> Maybe (Zipper Split)
forall a. Zipper a -> Maybe (Zipper a)
goUp Zipper Split
z Maybe (Zipper Split)
-> (Zipper Split -> Maybe (Zipper Split)) -> Maybe (Zipper Split)
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Direction2D -> Rational -> Zipper Split -> Maybe (Zipper Split)
expandTreeTowards Direction2D
dir Rational
diff

shrinkTreeFrom :: Direction2D -> Rational -> Zipper Split -> Maybe (Zipper Split)
shrinkTreeFrom :: Direction2D -> Rational -> Zipper Split -> Maybe (Zipper Split)
shrinkTreeFrom Direction2D
_ Rational
_ z :: Zipper Split
z@(Tree Split
_, []) = Zipper Split -> Maybe (Zipper Split)
forall a. a -> Maybe a
Just Zipper Split
z
shrinkTreeFrom Direction2D
R Rational
diff z :: Zipper Split
z@(Tree Split
_, LeftCrumb Split
s Tree Split
_:[Crumb Split]
_)
  | Split -> Axis
axis Split
s Axis -> Axis -> Bool
forall a. Eq a => a -> a -> Bool
== Axis
Vertical = Zipper Split -> Maybe (Zipper Split)
forall a. a -> Maybe a
Just Zipper Split
z Maybe (Zipper Split)
-> (Zipper Split -> Maybe (Zipper Split)) -> Maybe (Zipper Split)
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Zipper Split -> Maybe (Zipper Split)
forall a. Zipper a -> Maybe (Zipper a)
goSibling Maybe (Zipper Split)
-> (Zipper Split -> Maybe (Zipper Split)) -> Maybe (Zipper Split)
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Direction2D -> Rational -> Zipper Split -> Maybe (Zipper Split)
expandTreeTowards Direction2D
L Rational
diff
shrinkTreeFrom Direction2D
L Rational
diff z :: Zipper Split
z@(Tree Split
_, RightCrumb Split
s Tree Split
_:[Crumb Split]
_)
  | Split -> Axis
axis Split
s Axis -> Axis -> Bool
forall a. Eq a => a -> a -> Bool
== Axis
Vertical = Zipper Split -> Maybe (Zipper Split)
forall a. a -> Maybe a
Just Zipper Split
z Maybe (Zipper Split)
-> (Zipper Split -> Maybe (Zipper Split)) -> Maybe (Zipper Split)
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Zipper Split -> Maybe (Zipper Split)
forall a. Zipper a -> Maybe (Zipper a)
goSibling Maybe (Zipper Split)
-> (Zipper Split -> Maybe (Zipper Split)) -> Maybe (Zipper Split)
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Direction2D -> Rational -> Zipper Split -> Maybe (Zipper Split)
expandTreeTowards Direction2D
R Rational
diff
shrinkTreeFrom Direction2D
D Rational
diff z :: Zipper Split
z@(Tree Split
_, LeftCrumb Split
s Tree Split
_:[Crumb Split]
_)
  | Split -> Axis
axis Split
s Axis -> Axis -> Bool
forall a. Eq a => a -> a -> Bool
== Axis
Horizontal = Zipper Split -> Maybe (Zipper Split)
forall a. a -> Maybe a
Just Zipper Split
z Maybe (Zipper Split)
-> (Zipper Split -> Maybe (Zipper Split)) -> Maybe (Zipper Split)
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Zipper Split -> Maybe (Zipper Split)
forall a. Zipper a -> Maybe (Zipper a)
goSibling Maybe (Zipper Split)
-> (Zipper Split -> Maybe (Zipper Split)) -> Maybe (Zipper Split)
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Direction2D -> Rational -> Zipper Split -> Maybe (Zipper Split)
expandTreeTowards Direction2D
U Rational
diff
shrinkTreeFrom Direction2D
U Rational
diff z :: Zipper Split
z@(Tree Split
_, RightCrumb Split
s Tree Split
_:[Crumb Split]
_)
  | Split -> Axis
axis Split
s Axis -> Axis -> Bool
forall a. Eq a => a -> a -> Bool
== Axis
Horizontal = Zipper Split -> Maybe (Zipper Split)
forall a. a -> Maybe a
Just Zipper Split
z Maybe (Zipper Split)
-> (Zipper Split -> Maybe (Zipper Split)) -> Maybe (Zipper Split)
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Zipper Split -> Maybe (Zipper Split)
forall a. Zipper a -> Maybe (Zipper a)
goSibling Maybe (Zipper Split)
-> (Zipper Split -> Maybe (Zipper Split)) -> Maybe (Zipper Split)
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Direction2D -> Rational -> Zipper Split -> Maybe (Zipper Split)
expandTreeTowards Direction2D
D Rational
diff
shrinkTreeFrom Direction2D
dir Rational
diff Zipper Split
z = Zipper Split -> Maybe (Zipper Split)
forall a. Zipper a -> Maybe (Zipper a)
goUp Zipper Split
z Maybe (Zipper Split)
-> (Zipper Split -> Maybe (Zipper Split)) -> Maybe (Zipper Split)
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Direction2D -> Rational -> Zipper Split -> Maybe (Zipper Split)
shrinkTreeFrom Direction2D
dir Rational
diff

-- Direction2D refers to which direction the divider should move.
autoSizeTree :: Direction2D -> Rational -> Zipper Split -> Maybe (Zipper Split)
autoSizeTree :: Direction2D -> Rational -> Zipper Split -> Maybe (Zipper Split)
autoSizeTree Direction2D
_ Rational
_ z :: Zipper Split
z@(Tree Split
_, []) = Zipper Split -> Maybe (Zipper Split)
forall a. a -> Maybe a
Just Zipper Split
z
autoSizeTree Direction2D
d Rational
f Zipper Split
z =
    Zipper Split -> Maybe (Zipper Split)
forall a. a -> Maybe a
Just Zipper Split
z Maybe (Zipper Split)
-> (Zipper Split -> Maybe (Zipper Split)) -> Maybe (Zipper Split)
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Axis -> Zipper Split -> Maybe (Zipper Split)
getSplit (Direction2D -> Axis
toAxis Direction2D
d) Maybe (Zipper Split)
-> (Zipper Split -> Maybe (Zipper Split)) -> Maybe (Zipper Split)
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Direction2D -> Rational -> Zipper Split -> Maybe (Zipper Split)
resizeTree Direction2D
d Rational
f

-- resizing once found the correct split. YOU MUST FIND THE RIGHT SPLIT FIRST.
resizeTree :: Direction2D -> Rational -> Zipper Split -> Maybe (Zipper Split)
resizeTree :: Direction2D -> Rational -> Zipper Split -> Maybe (Zipper Split)
resizeTree Direction2D
_ Rational
_ z :: Zipper Split
z@(Tree Split
_, []) = Zipper Split -> Maybe (Zipper Split)
forall a. a -> Maybe a
Just Zipper Split
z
resizeTree Direction2D
R Rational
diff z :: Zipper Split
z@(Tree Split
_, LeftCrumb Split
_ Tree Split
_:[Crumb Split]
_) =
  Zipper Split -> Maybe (Zipper Split)
forall a. a -> Maybe a
Just Zipper Split
z Maybe (Zipper Split)
-> (Zipper Split -> Maybe (Zipper Split)) -> Maybe (Zipper Split)
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Direction2D -> Rational -> Zipper Split -> Maybe (Zipper Split)
expandTreeTowards Direction2D
R Rational
diff
resizeTree Direction2D
L Rational
diff z :: Zipper Split
z@(Tree Split
_, LeftCrumb Split
_ Tree Split
_:[Crumb Split]
_) =
  Zipper Split -> Maybe (Zipper Split)
forall a. a -> Maybe a
Just Zipper Split
z Maybe (Zipper Split)
-> (Zipper Split -> Maybe (Zipper Split)) -> Maybe (Zipper Split)
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Direction2D -> Rational -> Zipper Split -> Maybe (Zipper Split)
shrinkTreeFrom    Direction2D
R Rational
diff
resizeTree Direction2D
U Rational
diff z :: Zipper Split
z@(Tree Split
_, LeftCrumb Split
_ Tree Split
_:[Crumb Split]
_) =
  Zipper Split -> Maybe (Zipper Split)
forall a. a -> Maybe a
Just Zipper Split
z Maybe (Zipper Split)
-> (Zipper Split -> Maybe (Zipper Split)) -> Maybe (Zipper Split)
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Direction2D -> Rational -> Zipper Split -> Maybe (Zipper Split)
shrinkTreeFrom    Direction2D
D Rational
diff
resizeTree Direction2D
D Rational
diff z :: Zipper Split
z@(Tree Split
_, LeftCrumb Split
_ Tree Split
_:[Crumb Split]
_) =
  Zipper Split -> Maybe (Zipper Split)
forall a. a -> Maybe a
Just Zipper Split
z Maybe (Zipper Split)
-> (Zipper Split -> Maybe (Zipper Split)) -> Maybe (Zipper Split)
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Direction2D -> Rational -> Zipper Split -> Maybe (Zipper Split)
expandTreeTowards Direction2D
D Rational
diff
resizeTree Direction2D
R Rational
diff z :: Zipper Split
z@(Tree Split
_, RightCrumb Split
_ Tree Split
_:[Crumb Split]
_) =
  Zipper Split -> Maybe (Zipper Split)
forall a. a -> Maybe a
Just Zipper Split
z Maybe (Zipper Split)
-> (Zipper Split -> Maybe (Zipper Split)) -> Maybe (Zipper Split)
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Direction2D -> Rational -> Zipper Split -> Maybe (Zipper Split)
shrinkTreeFrom    Direction2D
L Rational
diff
resizeTree Direction2D
L Rational
diff z :: Zipper Split
z@(Tree Split
_, RightCrumb Split
_ Tree Split
_:[Crumb Split]
_) =
  Zipper Split -> Maybe (Zipper Split)
forall a. a -> Maybe a
Just Zipper Split
z Maybe (Zipper Split)
-> (Zipper Split -> Maybe (Zipper Split)) -> Maybe (Zipper Split)
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Direction2D -> Rational -> Zipper Split -> Maybe (Zipper Split)
expandTreeTowards Direction2D
L Rational
diff
resizeTree Direction2D
U Rational
diff z :: Zipper Split
z@(Tree Split
_, RightCrumb Split
_ Tree Split
_:[Crumb Split]
_) =
  Zipper Split -> Maybe (Zipper Split)
forall a. a -> Maybe a
Just Zipper Split
z Maybe (Zipper Split)
-> (Zipper Split -> Maybe (Zipper Split)) -> Maybe (Zipper Split)
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Direction2D -> Rational -> Zipper Split -> Maybe (Zipper Split)
expandTreeTowards Direction2D
U Rational
diff
resizeTree Direction2D
D Rational
diff z :: Zipper Split
z@(Tree Split
_, RightCrumb Split
_ Tree Split
_:[Crumb Split]
_) =
  Zipper Split -> Maybe (Zipper Split)
forall a. a -> Maybe a
Just Zipper Split
z Maybe (Zipper Split)
-> (Zipper Split -> Maybe (Zipper Split)) -> Maybe (Zipper Split)
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Direction2D -> Rational -> Zipper Split -> Maybe (Zipper Split)
shrinkTreeFrom    Direction2D
U Rational
diff

getSplit :: Axis -> Zipper Split -> Maybe (Zipper Split)
getSplit :: Axis -> Zipper Split -> Maybe (Zipper Split)
getSplit Axis
_ (Tree Split
_, []) = Maybe (Zipper Split)
forall a. Maybe a
Nothing
getSplit Axis
d Zipper Split
z =
 do let fs :: Maybe (Zipper Split)
fs = Axis -> Zipper Split -> Maybe (Zipper Split)
findSplit Axis
d Zipper Split
z
    if Maybe (Zipper Split) -> Bool
forall a. Maybe a -> Bool
isNothing Maybe (Zipper Split)
fs
      then Axis -> Zipper Split -> Maybe (Zipper Split)
findClosest Axis
d Zipper Split
z
      else Maybe (Zipper Split)
fs

findClosest :: Axis -> Zipper Split -> Maybe (Zipper Split)
findClosest :: Axis -> Zipper Split -> Maybe (Zipper Split)
findClosest Axis
_ z :: Zipper Split
z@(Tree Split
_, []) = Zipper Split -> Maybe (Zipper Split)
forall a. a -> Maybe a
Just Zipper Split
z
findClosest Axis
d z :: Zipper Split
z@(Tree Split
_, LeftCrumb Split
s Tree Split
_:[Crumb Split]
_)
  | Split -> Axis
axis Split
s Axis -> Axis -> Bool
forall a. Eq a => a -> a -> Bool
== Axis
d = Zipper Split -> Maybe (Zipper Split)
forall a. a -> Maybe a
Just Zipper Split
z
findClosest Axis
d z :: Zipper Split
z@(Tree Split
_, RightCrumb Split
s Tree Split
_:[Crumb Split]
_)
  | Split -> Axis
axis Split
s Axis -> Axis -> Bool
forall a. Eq a => a -> a -> Bool
== Axis
d = Zipper Split -> Maybe (Zipper Split)
forall a. a -> Maybe a
Just Zipper Split
z
findClosest Axis
d Zipper Split
z = Zipper Split -> Maybe (Zipper Split)
forall a. Zipper a -> Maybe (Zipper a)
goUp Zipper Split
z Maybe (Zipper Split)
-> (Zipper Split -> Maybe (Zipper Split)) -> Maybe (Zipper Split)
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Axis -> Zipper Split -> Maybe (Zipper Split)
findClosest Axis
d

findSplit :: Axis -> Zipper Split -> Maybe (Zipper Split)
findSplit :: Axis -> Zipper Split -> Maybe (Zipper Split)
findSplit Axis
_ (Tree Split
_, []) = Maybe (Zipper Split)
forall a. Maybe a
Nothing
findSplit Axis
d z :: Zipper Split
z@(Tree Split
_, LeftCrumb Split
s Tree Split
_:[Crumb Split]
_)
  | Split -> Axis
axis Split
s Axis -> Axis -> Bool
forall a. Eq a => a -> a -> Bool
== Axis
d = Zipper Split -> Maybe (Zipper Split)
forall a. a -> Maybe a
Just Zipper Split
z
findSplit Axis
d Zipper Split
z = Zipper Split -> Maybe (Zipper Split)
forall a. Zipper a -> Maybe (Zipper a)
goUp Zipper Split
z Maybe (Zipper Split)
-> (Zipper Split -> Maybe (Zipper Split)) -> Maybe (Zipper Split)
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Axis -> Zipper Split -> Maybe (Zipper Split)
findSplit Axis
d

resizeSplit :: Direction2D -> (Rational,Rational) -> Zipper Split -> Maybe (Zipper Split)
resizeSplit :: Direction2D
-> (Rational, Rational) -> Zipper Split -> Maybe (Zipper Split)
resizeSplit Direction2D
_ (Rational, Rational)
_ z :: Zipper Split
z@(Tree Split
_, []) = Zipper Split -> Maybe (Zipper Split)
forall a. a -> Maybe a
Just Zipper Split
z
resizeSplit Direction2D
dir (Rational
xsc,Rational
ysc) Zipper Split
z = case Direction2D -> Zipper Split -> Maybe (Zipper Split)
goToBorder Direction2D
dir Zipper Split
z of
  Maybe (Zipper Split)
Nothing -> Zipper Split -> Maybe (Zipper Split)
forall a. a -> Maybe a
Just Zipper Split
z
  Just (t :: Tree Split
t@Node{}, [Crumb Split]
crumb) -> Zipper Split -> Maybe (Zipper Split)
forall a. a -> Maybe a
Just (Zipper Split -> Maybe (Zipper Split))
-> Zipper Split -> Maybe (Zipper Split)
forall a b. (a -> b) -> a -> b
$ case Direction2D
dir of
    Direction2D
R -> (Tree Split
t{value=sp{ratio=scaleRatio (ratio sp) xsc}}, [Crumb Split]
crumb)
    Direction2D
D -> (Tree Split
t{value=sp{ratio=scaleRatio (ratio sp) ysc}}, [Crumb Split]
crumb)
    Direction2D
L -> (Tree Split
t{value=sp{ratio=1-scaleRatio (1-ratio sp) xsc}}, [Crumb Split]
crumb)
    Direction2D
U -> (Tree Split
t{value=sp{ratio=1-scaleRatio (1-ratio sp) ysc}}, [Crumb Split]
crumb)
    where sp :: Split
sp = Tree Split -> Split
forall a. Tree a -> a
value Tree Split
t
          scaleRatio :: a -> a -> a
scaleRatio a
r a
fac = a -> a -> a
forall a. Ord a => a -> a -> a
min a
0.9 (a -> a) -> a -> a
forall a b. (a -> b) -> a -> b
$ a -> a -> a
forall a. Ord a => a -> a -> a
max a
0.1 (a -> a) -> a -> a
forall a b. (a -> b) -> a -> b
$ a
ra -> a -> a
forall a. Num a => a -> a -> a
*a
fac
  Just (Leaf{}, [Crumb Split]
_) ->
    Maybe (Zipper Split)
forall a. HasCallStack => a
undefined -- silence -Wincomplete-uni-patterns (goToBorder/goUp never return a Leaf)

-- starting from a leaf, go to node representing a border of the according window
goToBorder :: Direction2D -> Zipper Split -> Maybe (Zipper Split)
goToBorder :: Direction2D -> Zipper Split -> Maybe (Zipper Split)
goToBorder Direction2D
L z :: Zipper Split
z@(Tree Split
_, RightCrumb (Split Axis
Vertical Rational
_) Tree Split
_:[Crumb Split]
_) = Zipper Split -> Maybe (Zipper Split)
forall a. Zipper a -> Maybe (Zipper a)
goUp Zipper Split
z
goToBorder Direction2D
L Zipper Split
z = Zipper Split -> Maybe (Zipper Split)
forall a. Zipper a -> Maybe (Zipper a)
goUp Zipper Split
z Maybe (Zipper Split)
-> (Zipper Split -> Maybe (Zipper Split)) -> Maybe (Zipper Split)
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Direction2D -> Zipper Split -> Maybe (Zipper Split)
goToBorder Direction2D
L
goToBorder Direction2D
R z :: Zipper Split
z@(Tree Split
_, LeftCrumb  (Split Axis
Vertical Rational
_) Tree Split
_:[Crumb Split]
_) = Zipper Split -> Maybe (Zipper Split)
forall a. Zipper a -> Maybe (Zipper a)
goUp Zipper Split
z
goToBorder Direction2D
R Zipper Split
z = Zipper Split -> Maybe (Zipper Split)
forall a. Zipper a -> Maybe (Zipper a)
goUp Zipper Split
z Maybe (Zipper Split)
-> (Zipper Split -> Maybe (Zipper Split)) -> Maybe (Zipper Split)
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Direction2D -> Zipper Split -> Maybe (Zipper Split)
goToBorder Direction2D
R
goToBorder Direction2D
U z :: Zipper Split
z@(Tree Split
_, RightCrumb (Split Axis
Horizontal Rational
_) Tree Split
_:[Crumb Split]
_) = Zipper Split -> Maybe (Zipper Split)
forall a. Zipper a -> Maybe (Zipper a)
goUp Zipper Split
z
goToBorder Direction2D
U Zipper Split
z = Zipper Split -> Maybe (Zipper Split)
forall a. Zipper a -> Maybe (Zipper a)
goUp Zipper Split
z Maybe (Zipper Split)
-> (Zipper Split -> Maybe (Zipper Split)) -> Maybe (Zipper Split)
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Direction2D -> Zipper Split -> Maybe (Zipper Split)
goToBorder Direction2D
U
goToBorder Direction2D
D z :: Zipper Split
z@(Tree Split
_, LeftCrumb  (Split Axis
Horizontal Rational
_) Tree Split
_:[Crumb Split]
_) = Zipper Split -> Maybe (Zipper Split)
forall a. Zipper a -> Maybe (Zipper a)
goUp Zipper Split
z
goToBorder Direction2D
D Zipper Split
z = Zipper Split -> Maybe (Zipper Split)
forall a. Zipper a -> Maybe (Zipper a)
goUp Zipper Split
z Maybe (Zipper Split)
-> (Zipper Split -> Maybe (Zipper Split)) -> Maybe (Zipper Split)
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Direction2D -> Zipper Split -> Maybe (Zipper Split)
goToBorder Direction2D
D

-- takes a list of indices and numerates the leaves of a given tree
numerate :: [Int] -> Tree a -> Tree a
numerate :: forall a. [Int] -> Tree a -> Tree a
numerate [Int]
ns Tree a
t = ([Int], Tree a) -> Tree a
forall a b. (a, b) -> b
snd (([Int], Tree a) -> Tree a) -> ([Int], Tree a) -> Tree a
forall a b. (a -> b) -> a -> b
$ [Int] -> Tree a -> ([Int], Tree a)
forall {a}. [Int] -> Tree a -> ([Int], Tree a)
num [Int]
ns Tree a
t
  where num :: [Int] -> Tree a -> ([Int], Tree a)
num (Int
n:[Int]
nns) (Leaf Int
_) = ([Int]
nns, Int -> Tree a
forall a. Int -> Tree a
Leaf Int
n)
        num [] (Leaf Int
_) = ([], Int -> Tree a
forall a. Int -> Tree a
Leaf Int
0)
        num [Int]
n (Node a
s Tree a
l Tree a
r) = ([Int]
n'', a -> Tree a -> Tree a -> Tree a
forall a. a -> Tree a -> Tree a -> Tree a
Node a
s Tree a
nl Tree a
nr)
          where ([Int]
n', Tree a
nl)  = [Int] -> Tree a -> ([Int], Tree a)
num [Int]
n Tree a
l
                ([Int]
n'', Tree a
nr) = [Int] -> Tree a -> ([Int], Tree a)
num [Int]
n' Tree a
r

-- return values of leaves from left to right as list
flatten :: Tree a -> [Int]
flatten :: forall a. Tree a -> [Int]
flatten (Leaf Int
n) = [Int
n]
flatten (Node a
_ Tree a
l Tree a
r) = Tree a -> [Int]
forall a. Tree a -> [Int]
flatten Tree a
l[Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++Tree a -> [Int]
forall a. Tree a -> [Int]
flatten Tree a
r

-- adjust ratios to make window areas equal
equalize :: Zipper Split -> Maybe (Zipper Split)
equalize :: Zipper Split -> Maybe (Zipper Split)
equalize (Tree Split
t, [Crumb Split]
cs) = Zipper Split -> Maybe (Zipper Split)
forall a. a -> Maybe a
Just (Tree Split -> Tree Split
eql Tree Split
t, [Crumb Split]
cs)
  where eql :: Tree Split -> Tree Split
eql (Leaf Int
n) = Int -> Tree Split
forall a. Int -> Tree a
Leaf Int
n
        eql n :: Tree Split
n@(Node Split
s Tree Split
l Tree Split
r) = Split -> Tree Split -> Tree Split -> Tree Split
forall a. a -> Tree a -> Tree a -> Tree a
Node Split
s{ratio=fromIntegral (numLeaves l) % fromIntegral (numLeaves n)}
                                  (Tree Split -> Tree Split
eql Tree Split
l) (Tree Split -> Tree Split
eql Tree Split
r)

-- generate a symmetrical balanced tree for n leaves from given tree, preserving leaf labels
balancedTree :: Zipper Split -> Maybe (Zipper Split)
balancedTree :: Zipper Split -> Maybe (Zipper Split)
balancedTree (Tree Split
t, [Crumb Split]
cs) =  Zipper Split -> Maybe (Zipper Split)
forall a. a -> Maybe a
Just ([Int] -> Tree Split -> Tree Split
forall a. [Int] -> Tree a -> Tree a
numerate (Tree Split -> [Int]
forall a. Tree a -> [Int]
flatten Tree Split
t) (Tree Split -> Tree Split) -> Tree Split -> Tree Split
forall a b. (a -> b) -> a -> b
$ Int -> Tree Split
forall {t}. Integral t => t -> Tree Split
balanced (Tree Split -> Int
forall a. Tree a -> Int
numLeaves Tree Split
t), [Crumb Split]
cs)
  where balanced :: t -> Tree Split
balanced t
1 = Int -> Tree Split
forall a. Int -> Tree a
Leaf Int
0
        balanced t
2 = Split -> Tree Split -> Tree Split -> Tree Split
forall a. a -> Tree a -> Tree a -> Tree a
Node (Axis -> Rational -> Split
Split Axis
Horizontal Rational
0.5) (Int -> Tree Split
forall a. Int -> Tree a
Leaf Int
0) (Int -> Tree Split
forall a. Int -> Tree a
Leaf Int
0)
        balanced t
m = Split -> Tree Split -> Tree Split -> Tree Split
forall a. a -> Tree a -> Tree a -> Tree a
Node (Axis -> Rational -> Split
Split Axis
Horizontal Rational
0.5) (t -> Tree Split
balanced (t
mt -> t -> t
forall a. Integral a => a -> a -> a
`div`t
2)) (t -> Tree Split
balanced (t
mt -> t -> t
forall a. Num a => a -> a -> a
-t
mt -> t -> t
forall a. Integral a => a -> a -> a
`div`t
2))

-- attempt to rotate splits optimally in order choose more quad-like rects
optimizeOrientation :: Rectangle -> Zipper Split -> Maybe (Zipper Split)
optimizeOrientation :: Rectangle -> Zipper Split -> Maybe (Zipper Split)
optimizeOrientation Rectangle
rct (Tree Split
t, [Crumb Split]
cs) = Zipper Split -> Maybe (Zipper Split)
forall a. a -> Maybe a
Just (Tree Split -> Rectangle -> Tree Split
opt Tree Split
t Rectangle
rct, [Crumb Split]
cs)
  where opt :: Tree Split -> Rectangle -> Tree Split
opt (Leaf Int
v) Rectangle
_ = Int -> Tree Split
forall a. Int -> Tree a
Leaf Int
v
        opt (Node Split
sp Tree Split
l Tree Split
r) Rectangle
rect = Split -> Tree Split -> Tree Split -> Tree Split
forall a. a -> Tree a -> Tree a -> Tree a
Node Split
sp' (Tree Split -> Rectangle -> Tree Split
opt Tree Split
l Rectangle
lrect) (Tree Split -> Rectangle -> Tree Split
opt Tree Split
r Rectangle
rrect)
         where (Rectangle Position
_ Position
_ Dimension
w1 Dimension
h1,Rectangle Position
_ Position
_ Dimension
w2 Dimension
h2) = Axis -> Rational -> Rectangle -> (Rectangle, Rectangle)
split (Split -> Axis
axis Split
sp) (Split -> Rational
ratio Split
sp) Rectangle
rect
               (Rectangle Position
_ Position
_ Dimension
w3 Dimension
h3,Rectangle Position
_ Position
_ Dimension
w4 Dimension
h4) = Axis -> Rational -> Rectangle -> (Rectangle, Rectangle)
split (Split -> Axis
axis (Split -> Axis) -> Split -> Axis
forall a b. (a -> b) -> a -> b
$ Split -> Split
oppositeSplit Split
sp) (Split -> Rational
ratio Split
sp) Rectangle
rect
               f :: a -> a -> Double
f a
w a
h = if a
w a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
h then Double
w'Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
h' else Double
h'Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
w' where (Double
w',Double
h') = (a -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
w :: Double, a -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
h :: Double)
               wratio :: Double
wratio = Double -> Double -> Double
forall a. Ord a => a -> a -> a
min (Dimension -> Dimension -> Double
forall {a}. Integral a => a -> a -> Double
f Dimension
w1 Dimension
h1) (Dimension -> Dimension -> Double
forall {a}. Integral a => a -> a -> Double
f Dimension
w2 Dimension
h2)
               wratio' :: Double
wratio' = Double -> Double -> Double
forall a. Ord a => a -> a -> a
min (Dimension -> Dimension -> Double
forall {a}. Integral a => a -> a -> Double
f Dimension
w3 Dimension
h3) (Dimension -> Dimension -> Double
forall {a}. Integral a => a -> a -> Double
f Dimension
w4 Dimension
h4)
               sp' :: Split
sp' = if Double
wratioDouble -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<Double
wratio' then Split
sp else Split -> Split
oppositeSplit Split
sp
               (Rectangle
lrect, Rectangle
rrect) = Axis -> Rational -> Rectangle -> (Rectangle, Rectangle)
split (Split -> Axis
axis Split
sp') (Split -> Rational
ratio Split
sp') Rectangle
rect


-- initially focused leaf, path from root to selected node, window ids of borders highlighting the selection
data NodeRef = NodeRef { NodeRef -> Int
refLeaf :: Int, NodeRef -> [Direction2D]
refPath :: [Direction2D], NodeRef -> [Window]
refWins :: [Window] } deriving (Int -> NodeRef -> ShowS
[NodeRef] -> ShowS
NodeRef -> String
(Int -> NodeRef -> ShowS)
-> (NodeRef -> String) -> ([NodeRef] -> ShowS) -> Show NodeRef
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> NodeRef -> ShowS
showsPrec :: Int -> NodeRef -> ShowS
$cshow :: NodeRef -> String
show :: NodeRef -> String
$cshowList :: [NodeRef] -> ShowS
showList :: [NodeRef] -> ShowS
Show,ReadPrec [NodeRef]
ReadPrec NodeRef
Int -> ReadS NodeRef
ReadS [NodeRef]
(Int -> ReadS NodeRef)
-> ReadS [NodeRef]
-> ReadPrec NodeRef
-> ReadPrec [NodeRef]
-> Read NodeRef
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS NodeRef
readsPrec :: Int -> ReadS NodeRef
$creadList :: ReadS [NodeRef]
readList :: ReadS [NodeRef]
$creadPrec :: ReadPrec NodeRef
readPrec :: ReadPrec NodeRef
$creadListPrec :: ReadPrec [NodeRef]
readListPrec :: ReadPrec [NodeRef]
Read,NodeRef -> NodeRef -> Bool
(NodeRef -> NodeRef -> Bool)
-> (NodeRef -> NodeRef -> Bool) -> Eq NodeRef
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: NodeRef -> NodeRef -> Bool
== :: NodeRef -> NodeRef -> Bool
$c/= :: NodeRef -> NodeRef -> Bool
/= :: NodeRef -> NodeRef -> Bool
Eq)
noRef :: NodeRef
noRef :: NodeRef
noRef = Int -> [Direction2D] -> [Window] -> NodeRef
NodeRef (-Int
1) [] []

goToNode :: NodeRef -> Zipper a -> Maybe (Zipper a)
goToNode :: forall a. NodeRef -> Zipper a -> Maybe (Zipper a)
goToNode (NodeRef Int
_ [Direction2D]
dirs [Window]
_) Zipper a
z = (Zipper a -> Direction2D -> Maybe (Zipper a))
-> Zipper a -> [Direction2D] -> Maybe (Zipper a)
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM Zipper a -> Direction2D -> Maybe (Zipper a)
forall {a}. Zipper a -> Direction2D -> Maybe (Zipper a)
gofun Zipper a
z [Direction2D]
dirs
  where gofun :: Zipper a -> Direction2D -> Maybe (Zipper a)
gofun Zipper a
z' Direction2D
L = Zipper a -> Maybe (Zipper a)
forall a. Zipper a -> Maybe (Zipper a)
goLeft Zipper a
z'
        gofun Zipper a
z' Direction2D
R = Zipper a -> Maybe (Zipper a)
forall a. Zipper a -> Maybe (Zipper a)
goRight Zipper a
z'
        gofun Zipper a
_ Direction2D
_ = Maybe (Zipper a)
forall a. Maybe a
Nothing

toNodeRef :: Int -> Maybe (Zipper Split) -> NodeRef
toNodeRef :: Int -> Maybe (Zipper Split) -> NodeRef
toNodeRef Int
_ Maybe (Zipper Split)
Nothing = NodeRef
noRef
toNodeRef Int
l (Just (Tree Split
_, [Crumb Split]
cs)) = Int -> [Direction2D] -> [Window] -> NodeRef
NodeRef Int
l ([Direction2D] -> [Direction2D]
forall a. [a] -> [a]
reverse ([Direction2D] -> [Direction2D]) -> [Direction2D] -> [Direction2D]
forall a b. (a -> b) -> a -> b
$ (Crumb Split -> Direction2D) -> [Crumb Split] -> [Direction2D]
forall a b. (a -> b) -> [a] -> [b]
map Crumb Split -> Direction2D
forall {a}. Crumb a -> Direction2D
crumbToDir [Crumb Split]
cs) []
  where crumbToDir :: Crumb a -> Direction2D
crumbToDir (LeftCrumb a
_ Tree a
_) = Direction2D
L
        crumbToDir (RightCrumb a
_ Tree a
_) = Direction2D
R

-- returns the leaf a noderef is leading to, if any
nodeRefToLeaf :: NodeRef -> Maybe (Zipper a) -> Maybe Int
nodeRefToLeaf :: forall a. NodeRef -> Maybe (Zipper a) -> Maybe Int
nodeRefToLeaf NodeRef
n (Just Zipper a
z) = case NodeRef -> Zipper a -> Maybe (Zipper a)
forall a. NodeRef -> Zipper a -> Maybe (Zipper a)
goToNode NodeRef
n Zipper a
z of
  Just (Leaf Int
l, [Crumb a]
_) -> Int -> Maybe Int
forall a. a -> Maybe a
Just Int
l
  Just (Node{}, [Crumb a]
_) -> Maybe Int
forall a. Maybe a
Nothing
  Maybe (Zipper a)
Nothing -> Maybe Int
forall a. Maybe a
Nothing
nodeRefToLeaf NodeRef
_ Maybe (Zipper a)
Nothing = Maybe Int
forall a. Maybe a
Nothing

leafToNodeRef :: Int -> BinarySpacePartition a -> NodeRef
leafToNodeRef :: forall a. Int -> BinarySpacePartition a -> NodeRef
leafToNodeRef Int
l BinarySpacePartition a
b = Int -> Maybe (Zipper Split) -> NodeRef
toNodeRef Int
l (BinarySpacePartition a -> Maybe (Zipper Split)
forall a. BinarySpacePartition a -> Maybe (Zipper Split)
makeZipper BinarySpacePartition a
b Maybe (Zipper Split)
-> (Zipper Split -> Maybe (Zipper Split)) -> Maybe (Zipper Split)
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> Zipper Split -> Maybe (Zipper Split)
forall a. Int -> Zipper a -> Maybe (Zipper a)
goToNthLeaf Int
l)

data BinarySpacePartition a = BinarySpacePartition { forall a. BinarySpacePartition a -> [(Window, Rectangle)]
getOldRects :: [(Window,Rectangle)]
                                                   , forall a. BinarySpacePartition a -> NodeRef
getFocusedNode :: NodeRef
                                                   , forall a. BinarySpacePartition a -> NodeRef
getSelectedNode :: NodeRef
                                                   , forall a. BinarySpacePartition a -> Maybe (Tree Split)
getTree :: Maybe (Tree Split) } deriving (Int -> BinarySpacePartition a -> ShowS
[BinarySpacePartition a] -> ShowS
BinarySpacePartition a -> String
(Int -> BinarySpacePartition a -> ShowS)
-> (BinarySpacePartition a -> String)
-> ([BinarySpacePartition a] -> ShowS)
-> Show (BinarySpacePartition a)
forall a. Int -> BinarySpacePartition a -> ShowS
forall a. [BinarySpacePartition a] -> ShowS
forall a. BinarySpacePartition a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Int -> BinarySpacePartition a -> ShowS
showsPrec :: Int -> BinarySpacePartition a -> ShowS
$cshow :: forall a. BinarySpacePartition a -> String
show :: BinarySpacePartition a -> String
$cshowList :: forall a. [BinarySpacePartition a] -> ShowS
showList :: [BinarySpacePartition a] -> ShowS
Show, ReadPrec [BinarySpacePartition a]
ReadPrec (BinarySpacePartition a)
Int -> ReadS (BinarySpacePartition a)
ReadS [BinarySpacePartition a]
(Int -> ReadS (BinarySpacePartition a))
-> ReadS [BinarySpacePartition a]
-> ReadPrec (BinarySpacePartition a)
-> ReadPrec [BinarySpacePartition a]
-> Read (BinarySpacePartition a)
forall a. ReadPrec [BinarySpacePartition a]
forall a. ReadPrec (BinarySpacePartition a)
forall a. Int -> ReadS (BinarySpacePartition a)
forall a. ReadS [BinarySpacePartition a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: forall a. Int -> ReadS (BinarySpacePartition a)
readsPrec :: Int -> ReadS (BinarySpacePartition a)
$creadList :: forall a. ReadS [BinarySpacePartition a]
readList :: ReadS [BinarySpacePartition a]
$creadPrec :: forall a. ReadPrec (BinarySpacePartition a)
readPrec :: ReadPrec (BinarySpacePartition a)
$creadListPrec :: forall a. ReadPrec [BinarySpacePartition a]
readListPrec :: ReadPrec [BinarySpacePartition a]
Read,BinarySpacePartition a -> BinarySpacePartition a -> Bool
(BinarySpacePartition a -> BinarySpacePartition a -> Bool)
-> (BinarySpacePartition a -> BinarySpacePartition a -> Bool)
-> Eq (BinarySpacePartition a)
forall a. BinarySpacePartition a -> BinarySpacePartition a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. BinarySpacePartition a -> BinarySpacePartition a -> Bool
== :: BinarySpacePartition a -> BinarySpacePartition a -> Bool
$c/= :: forall a. BinarySpacePartition a -> BinarySpacePartition a -> Bool
/= :: BinarySpacePartition a -> BinarySpacePartition a -> Bool
Eq)

-- | an empty BinarySpacePartition to use as a default for adding windows to.
emptyBSP :: BinarySpacePartition a
emptyBSP :: forall a. BinarySpacePartition a
emptyBSP = [(Window, Rectangle)]
-> NodeRef
-> NodeRef
-> Maybe (Tree Split)
-> BinarySpacePartition a
forall a.
[(Window, Rectangle)]
-> NodeRef
-> NodeRef
-> Maybe (Tree Split)
-> BinarySpacePartition a
BinarySpacePartition [] NodeRef
noRef NodeRef
noRef Maybe (Tree Split)
forall a. Maybe a
Nothing

makeBSP :: Tree Split -> BinarySpacePartition a
makeBSP :: forall a. Tree Split -> BinarySpacePartition a
makeBSP = [(Window, Rectangle)]
-> NodeRef
-> NodeRef
-> Maybe (Tree Split)
-> BinarySpacePartition a
forall a.
[(Window, Rectangle)]
-> NodeRef
-> NodeRef
-> Maybe (Tree Split)
-> BinarySpacePartition a
BinarySpacePartition [] NodeRef
noRef NodeRef
noRef (Maybe (Tree Split) -> BinarySpacePartition a)
-> (Tree Split -> Maybe (Tree Split))
-> Tree Split
-> BinarySpacePartition a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tree Split -> Maybe (Tree Split)
forall a. a -> Maybe a
Just

makeZipper :: BinarySpacePartition a -> Maybe (Zipper Split)
makeZipper :: forall a. BinarySpacePartition a -> Maybe (Zipper Split)
makeZipper (BinarySpacePartition [(Window, Rectangle)]
_ NodeRef
_ NodeRef
_ Maybe (Tree Split)
Nothing) = Maybe (Zipper Split)
forall a. Maybe a
Nothing
makeZipper (BinarySpacePartition [(Window, Rectangle)]
_ NodeRef
_ NodeRef
_ (Just Tree Split
t)) = Zipper Split -> Maybe (Zipper Split)
forall a. a -> Maybe a
Just (Zipper Split -> Maybe (Zipper Split))
-> (Tree Split -> Zipper Split)
-> Tree Split
-> Maybe (Zipper Split)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tree Split -> Zipper Split
forall a. Tree a -> Zipper a
toZipper (Tree Split -> Maybe (Zipper Split))
-> Tree Split -> Maybe (Zipper Split)
forall a b. (a -> b) -> a -> b
$ Tree Split
t

size :: BinarySpacePartition a -> Int
size :: forall a. BinarySpacePartition a -> Int
size = Int -> (Tree Split -> Int) -> Maybe (Tree Split) -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
0 Tree Split -> Int
forall a. Tree a -> Int
numLeaves (Maybe (Tree Split) -> Int)
-> (BinarySpacePartition a -> Maybe (Tree Split))
-> BinarySpacePartition a
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BinarySpacePartition a -> Maybe (Tree Split)
forall a. BinarySpacePartition a -> Maybe (Tree Split)
getTree

zipperToBinarySpacePartition :: Maybe (Zipper Split) -> BinarySpacePartition b
zipperToBinarySpacePartition :: forall b. Maybe (Zipper Split) -> BinarySpacePartition b
zipperToBinarySpacePartition Maybe (Zipper Split)
Nothing = BinarySpacePartition b
forall a. BinarySpacePartition a
emptyBSP
zipperToBinarySpacePartition (Just Zipper Split
z) = [(Window, Rectangle)]
-> NodeRef
-> NodeRef
-> Maybe (Tree Split)
-> BinarySpacePartition b
forall a.
[(Window, Rectangle)]
-> NodeRef
-> NodeRef
-> Maybe (Tree Split)
-> BinarySpacePartition a
BinarySpacePartition [] NodeRef
noRef NodeRef
noRef (Maybe (Tree Split) -> BinarySpacePartition b)
-> (Zipper Split -> Maybe (Tree Split))
-> Zipper Split
-> BinarySpacePartition b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tree Split -> Maybe (Tree Split)
forall a. a -> Maybe a
Just (Tree Split -> Maybe (Tree Split))
-> (Zipper Split -> Tree Split)
-> Zipper Split
-> Maybe (Tree Split)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Zipper Split -> Tree Split
forall a. Zipper a -> Tree a
toTree (Zipper Split -> Tree Split)
-> (Zipper Split -> Zipper Split) -> Zipper Split -> Tree Split
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Zipper Split -> Zipper Split
forall a. Zipper a -> Zipper a
top (Zipper Split -> BinarySpacePartition b)
-> Zipper Split -> BinarySpacePartition b
forall a b. (a -> b) -> a -> b
$ Zipper Split
z

rectangles :: BinarySpacePartition a -> Rectangle -> [Rectangle]
rectangles :: forall a. BinarySpacePartition a -> Rectangle -> [Rectangle]
rectangles (BinarySpacePartition [(Window, Rectangle)]
_ NodeRef
_ NodeRef
_ Maybe (Tree Split)
Nothing) Rectangle
_ = []
rectangles (BinarySpacePartition [(Window, Rectangle)]
_ NodeRef
_ NodeRef
_ (Just (Leaf Int
_))) Rectangle
rootRect = [Rectangle
rootRect]
rectangles (BinarySpacePartition [(Window, Rectangle)]
_ NodeRef
_ NodeRef
_ (Just Tree Split
node)) Rectangle
rootRect =
    BinarySpacePartition Any -> Rectangle -> [Rectangle]
forall a. BinarySpacePartition a -> Rectangle -> [Rectangle]
rectangles (Tree Split -> BinarySpacePartition Any
forall a. Tree Split -> BinarySpacePartition a
makeBSP (Tree Split -> BinarySpacePartition Any)
-> (Tree Split -> Tree Split)
-> Tree Split
-> BinarySpacePartition Any
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tree Split -> Tree Split
forall a. Tree a -> Tree a
left (Tree Split -> BinarySpacePartition Any)
-> Tree Split -> BinarySpacePartition Any
forall a b. (a -> b) -> a -> b
$ Tree Split
node) Rectangle
leftBox [Rectangle] -> [Rectangle] -> [Rectangle]
forall a. [a] -> [a] -> [a]
++
    BinarySpacePartition Any -> Rectangle -> [Rectangle]
forall a. BinarySpacePartition a -> Rectangle -> [Rectangle]
rectangles (Tree Split -> BinarySpacePartition Any
forall a. Tree Split -> BinarySpacePartition a
makeBSP (Tree Split -> BinarySpacePartition Any)
-> (Tree Split -> Tree Split)
-> Tree Split
-> BinarySpacePartition Any
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tree Split -> Tree Split
forall a. Tree a -> Tree a
right (Tree Split -> BinarySpacePartition Any)
-> Tree Split -> BinarySpacePartition Any
forall a b. (a -> b) -> a -> b
$ Tree Split
node) Rectangle
rightBox
    where (Rectangle
leftBox, Rectangle
rightBox) = Axis -> Rational -> Rectangle -> (Rectangle, Rectangle)
split (Split -> Axis
axis Split
info) (Split -> Rational
ratio Split
info) Rectangle
rootRect
          info :: Split
info = Tree Split -> Split
forall a. Tree a -> a
value Tree Split
node

getNodeRect :: BinarySpacePartition a -> Rectangle -> NodeRef -> Rectangle
getNodeRect :: forall a.
BinarySpacePartition a -> Rectangle -> NodeRef -> Rectangle
getNodeRect BinarySpacePartition a
b Rectangle
r NodeRef
n = Rectangle -> Maybe Rectangle -> Rectangle
forall a. a -> Maybe a -> a
fromMaybe (Position -> Position -> Dimension -> Dimension -> Rectangle
Rectangle Position
0 Position
0 Dimension
1 Dimension
1) (BinarySpacePartition a -> Maybe (Zipper Split)
forall a. BinarySpacePartition a -> Maybe (Zipper Split)
makeZipper BinarySpacePartition a
b Maybe (Zipper Split)
-> (Zipper Split -> Maybe (Zipper Split)) -> Maybe (Zipper Split)
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= NodeRef -> Zipper Split -> Maybe (Zipper Split)
forall a. NodeRef -> Zipper a -> Maybe (Zipper a)
goToNode NodeRef
n Maybe (Zipper Split)
-> (Zipper Split -> Maybe Rectangle) -> Maybe Rectangle
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [(Split, (Rectangle, Rectangle) -> Rectangle)]
-> Zipper Split -> Maybe Rectangle
getRect [])
  where getRect :: [(Split, (Rectangle, Rectangle) -> Rectangle)]
-> Zipper Split -> Maybe Rectangle
getRect [(Split, (Rectangle, Rectangle) -> Rectangle)]
ls (Tree Split
_, []) = Rectangle -> Maybe Rectangle
forall a. a -> Maybe a
Just (Rectangle -> Maybe Rectangle) -> Rectangle -> Maybe Rectangle
forall a b. (a -> b) -> a -> b
$ (Rectangle
 -> (Split, (Rectangle, Rectangle) -> Rectangle) -> Rectangle)
-> Rectangle
-> [(Split, (Rectangle, Rectangle) -> Rectangle)]
-> Rectangle
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\Rectangle
r' (Split
s,(Rectangle, Rectangle) -> Rectangle
f) -> (Rectangle, Rectangle) -> Rectangle
f ((Rectangle, Rectangle) -> Rectangle)
-> (Rectangle, Rectangle) -> Rectangle
forall a b. (a -> b) -> a -> b
$ Split -> Rectangle -> (Rectangle, Rectangle)
split' Split
s Rectangle
r') Rectangle
r [(Split, (Rectangle, Rectangle) -> Rectangle)]
ls
        getRect [(Split, (Rectangle, Rectangle) -> Rectangle)]
ls z :: Zipper Split
z@(Tree Split
_, LeftCrumb Split
s Tree Split
_:[Crumb Split]
_) = Zipper Split -> Maybe (Zipper Split)
forall a. Zipper a -> Maybe (Zipper a)
goUp Zipper Split
z Maybe (Zipper Split)
-> (Zipper Split -> Maybe Rectangle) -> Maybe Rectangle
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [(Split, (Rectangle, Rectangle) -> Rectangle)]
-> Zipper Split -> Maybe Rectangle
getRect ((Split
s,(Rectangle, Rectangle) -> Rectangle
forall a b. (a, b) -> a
fst)(Split, (Rectangle, Rectangle) -> Rectangle)
-> [(Split, (Rectangle, Rectangle) -> Rectangle)]
-> [(Split, (Rectangle, Rectangle) -> Rectangle)]
forall a. a -> [a] -> [a]
:[(Split, (Rectangle, Rectangle) -> Rectangle)]
ls)
        getRect [(Split, (Rectangle, Rectangle) -> Rectangle)]
ls z :: Zipper Split
z@(Tree Split
_, RightCrumb Split
s Tree Split
_:[Crumb Split]
_) = Zipper Split -> Maybe (Zipper Split)
forall a. Zipper a -> Maybe (Zipper a)
goUp Zipper Split
z Maybe (Zipper Split)
-> (Zipper Split -> Maybe Rectangle) -> Maybe Rectangle
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [(Split, (Rectangle, Rectangle) -> Rectangle)]
-> Zipper Split -> Maybe Rectangle
getRect ((Split
s,(Rectangle, Rectangle) -> Rectangle
forall a b. (a, b) -> b
snd)(Split, (Rectangle, Rectangle) -> Rectangle)
-> [(Split, (Rectangle, Rectangle) -> Rectangle)]
-> [(Split, (Rectangle, Rectangle) -> Rectangle)]
forall a. a -> [a] -> [a]
:[(Split, (Rectangle, Rectangle) -> Rectangle)]
ls)
        split' :: Split -> Rectangle -> (Rectangle, Rectangle)
split' Split
s = Axis -> Rational -> Rectangle -> (Rectangle, Rectangle)
split (Split -> Axis
axis Split
s) (Split -> Rational
ratio Split
s)

doToNth :: (Zipper Split -> Maybe (Zipper Split)) -> BinarySpacePartition a -> BinarySpacePartition a
doToNth :: forall a.
(Zipper Split -> Maybe (Zipper Split))
-> BinarySpacePartition a -> BinarySpacePartition a
doToNth Zipper Split -> Maybe (Zipper Split)
f BinarySpacePartition a
b = BinarySpacePartition a
b{getTree=getTree $ zipperToBinarySpacePartition $ makeZipper b >>= goToNode (getFocusedNode b) >>= f}

splitNth :: BinarySpacePartition a -> BinarySpacePartition a
splitNth :: forall a. BinarySpacePartition a -> BinarySpacePartition a
splitNth (BinarySpacePartition [(Window, Rectangle)]
_ NodeRef
_ NodeRef
_ Maybe (Tree Split)
Nothing) = Tree Split -> BinarySpacePartition a
forall a. Tree Split -> BinarySpacePartition a
makeBSP (Int -> Tree Split
forall a. Int -> Tree a
Leaf Int
0)
splitNth BinarySpacePartition a
b = (Zipper Split -> Maybe (Zipper Split))
-> BinarySpacePartition a -> BinarySpacePartition a
forall a.
(Zipper Split -> Maybe (Zipper Split))
-> BinarySpacePartition a -> BinarySpacePartition a
doToNth Zipper Split -> Maybe (Zipper Split)
splitCurrent BinarySpacePartition a
b

removeNth :: BinarySpacePartition a -> BinarySpacePartition a
removeNth :: forall a. BinarySpacePartition a -> BinarySpacePartition a
removeNth (BinarySpacePartition [(Window, Rectangle)]
_ NodeRef
_ NodeRef
_ Maybe (Tree Split)
Nothing) = BinarySpacePartition a
forall a. BinarySpacePartition a
emptyBSP
removeNth (BinarySpacePartition [(Window, Rectangle)]
_ NodeRef
_ NodeRef
_ (Just (Leaf Int
_))) = BinarySpacePartition a
forall a. BinarySpacePartition a
emptyBSP
removeNth BinarySpacePartition a
b = (Zipper Split -> Maybe (Zipper Split))
-> BinarySpacePartition a -> BinarySpacePartition a
forall a.
(Zipper Split -> Maybe (Zipper Split))
-> BinarySpacePartition a -> BinarySpacePartition a
doToNth Zipper Split -> Maybe (Zipper Split)
forall a. Zipper a -> Maybe (Zipper a)
removeCurrent BinarySpacePartition a
b

rotateNth :: BinarySpacePartition a -> BinarySpacePartition a
rotateNth :: forall a. BinarySpacePartition a -> BinarySpacePartition a
rotateNth (BinarySpacePartition [(Window, Rectangle)]
_ NodeRef
_ NodeRef
_ Maybe (Tree Split)
Nothing) = BinarySpacePartition a
forall a. BinarySpacePartition a
emptyBSP
rotateNth b :: BinarySpacePartition a
b@(BinarySpacePartition [(Window, Rectangle)]
_ NodeRef
_ NodeRef
_ (Just (Leaf Int
_))) = BinarySpacePartition a
b
rotateNth BinarySpacePartition a
b = (Zipper Split -> Maybe (Zipper Split))
-> BinarySpacePartition a -> BinarySpacePartition a
forall a.
(Zipper Split -> Maybe (Zipper Split))
-> BinarySpacePartition a -> BinarySpacePartition a
doToNth Zipper Split -> Maybe (Zipper Split)
rotateCurrent BinarySpacePartition a
b

swapNth :: BinarySpacePartition a -> BinarySpacePartition a
swapNth :: forall a. BinarySpacePartition a -> BinarySpacePartition a
swapNth (BinarySpacePartition [(Window, Rectangle)]
_ NodeRef
_ NodeRef
_ Maybe (Tree Split)
Nothing) = BinarySpacePartition a
forall a. BinarySpacePartition a
emptyBSP
swapNth b :: BinarySpacePartition a
b@(BinarySpacePartition [(Window, Rectangle)]
_ NodeRef
_ NodeRef
_ (Just (Leaf Int
_))) = BinarySpacePartition a
b
swapNth BinarySpacePartition a
b = (Zipper Split -> Maybe (Zipper Split))
-> BinarySpacePartition a -> BinarySpacePartition a
forall a.
(Zipper Split -> Maybe (Zipper Split))
-> BinarySpacePartition a -> BinarySpacePartition a
doToNth Zipper Split -> Maybe (Zipper Split)
forall a. Zipper a -> Maybe (Zipper a)
swapCurrent BinarySpacePartition a
b

splitShiftNth :: Direction1D -> BinarySpacePartition a -> BinarySpacePartition a
splitShiftNth :: forall a.
Direction1D -> BinarySpacePartition a -> BinarySpacePartition a
splitShiftNth Direction1D
_ (BinarySpacePartition [(Window, Rectangle)]
_ NodeRef
_ NodeRef
_ Maybe (Tree Split)
Nothing) = BinarySpacePartition a
forall a. BinarySpacePartition a
emptyBSP
splitShiftNth Direction1D
_ b :: BinarySpacePartition a
b@(BinarySpacePartition [(Window, Rectangle)]
_ NodeRef
_ NodeRef
_ (Just (Leaf Int
_))) = BinarySpacePartition a
b
splitShiftNth Direction1D
Prev BinarySpacePartition a
b = (Zipper Split -> Maybe (Zipper Split))
-> BinarySpacePartition a -> BinarySpacePartition a
forall a.
(Zipper Split -> Maybe (Zipper Split))
-> BinarySpacePartition a -> BinarySpacePartition a
doToNth Zipper Split -> Maybe (Zipper Split)
splitShiftLeftCurrent BinarySpacePartition a
b
splitShiftNth Direction1D
Next BinarySpacePartition a
b = (Zipper Split -> Maybe (Zipper Split))
-> BinarySpacePartition a -> BinarySpacePartition a
forall a.
(Zipper Split -> Maybe (Zipper Split))
-> BinarySpacePartition a -> BinarySpacePartition a
doToNth Zipper Split -> Maybe (Zipper Split)
splitShiftRightCurrent BinarySpacePartition a
b

growNthTowards :: Direction2D -> Rational -> BinarySpacePartition a -> BinarySpacePartition a
growNthTowards :: forall a.
Direction2D
-> Rational -> BinarySpacePartition a -> BinarySpacePartition a
growNthTowards Direction2D
_ Rational
_ (BinarySpacePartition [(Window, Rectangle)]
_ NodeRef
_ NodeRef
_ Maybe (Tree Split)
Nothing) = BinarySpacePartition a
forall a. BinarySpacePartition a
emptyBSP
growNthTowards Direction2D
_ Rational
_ b :: BinarySpacePartition a
b@(BinarySpacePartition [(Window, Rectangle)]
_ NodeRef
_ NodeRef
_ (Just (Leaf Int
_))) = BinarySpacePartition a
b
growNthTowards Direction2D
dir Rational
diff BinarySpacePartition a
b = (Zipper Split -> Maybe (Zipper Split))
-> BinarySpacePartition a -> BinarySpacePartition a
forall a.
(Zipper Split -> Maybe (Zipper Split))
-> BinarySpacePartition a -> BinarySpacePartition a
doToNth (Direction2D -> Rational -> Zipper Split -> Maybe (Zipper Split)
expandTreeTowards Direction2D
dir Rational
diff) BinarySpacePartition a
b

shrinkNthFrom :: Direction2D -> Rational -> BinarySpacePartition a -> BinarySpacePartition a
shrinkNthFrom :: forall a.
Direction2D
-> Rational -> BinarySpacePartition a -> BinarySpacePartition a
shrinkNthFrom Direction2D
_ Rational
_ (BinarySpacePartition [(Window, Rectangle)]
_ NodeRef
_ NodeRef
_ Maybe (Tree Split)
Nothing)= BinarySpacePartition a
forall a. BinarySpacePartition a
emptyBSP
shrinkNthFrom Direction2D
_ Rational
_ b :: BinarySpacePartition a
b@(BinarySpacePartition [(Window, Rectangle)]
_ NodeRef
_ NodeRef
_ (Just (Leaf Int
_))) = BinarySpacePartition a
b
shrinkNthFrom Direction2D
dir Rational
diff BinarySpacePartition a
b = (Zipper Split -> Maybe (Zipper Split))
-> BinarySpacePartition a -> BinarySpacePartition a
forall a.
(Zipper Split -> Maybe (Zipper Split))
-> BinarySpacePartition a -> BinarySpacePartition a
doToNth (Direction2D -> Rational -> Zipper Split -> Maybe (Zipper Split)
shrinkTreeFrom Direction2D
dir Rational
diff) BinarySpacePartition a
b

autoSizeNth :: Direction2D -> Rational -> BinarySpacePartition a -> BinarySpacePartition a
autoSizeNth :: forall a.
Direction2D
-> Rational -> BinarySpacePartition a -> BinarySpacePartition a
autoSizeNth Direction2D
_ Rational
_ (BinarySpacePartition [(Window, Rectangle)]
_ NodeRef
_ NodeRef
_ Maybe (Tree Split)
Nothing) = BinarySpacePartition a
forall a. BinarySpacePartition a
emptyBSP
autoSizeNth Direction2D
_ Rational
_ b :: BinarySpacePartition a
b@(BinarySpacePartition [(Window, Rectangle)]
_ NodeRef
_ NodeRef
_ (Just (Leaf Int
_))) = BinarySpacePartition a
b
autoSizeNth Direction2D
dir Rational
diff BinarySpacePartition a
b = (Zipper Split -> Maybe (Zipper Split))
-> BinarySpacePartition a -> BinarySpacePartition a
forall a.
(Zipper Split -> Maybe (Zipper Split))
-> BinarySpacePartition a -> BinarySpacePartition a
doToNth (Direction2D -> Rational -> Zipper Split -> Maybe (Zipper Split)
autoSizeTree Direction2D
dir Rational
diff) BinarySpacePartition a
b

resizeSplitNth :: Direction2D -> (Rational,Rational) -> BinarySpacePartition a -> BinarySpacePartition a
resizeSplitNth :: forall a.
Direction2D
-> (Rational, Rational)
-> BinarySpacePartition a
-> BinarySpacePartition a
resizeSplitNth Direction2D
_ (Rational, Rational)
_ (BinarySpacePartition [(Window, Rectangle)]
_ NodeRef
_ NodeRef
_ Maybe (Tree Split)
Nothing) = BinarySpacePartition a
forall a. BinarySpacePartition a
emptyBSP
resizeSplitNth Direction2D
_ (Rational, Rational)
_ b :: BinarySpacePartition a
b@(BinarySpacePartition [(Window, Rectangle)]
_ NodeRef
_ NodeRef
_ (Just (Leaf Int
_))) = BinarySpacePartition a
b
resizeSplitNth Direction2D
dir (Rational, Rational)
sc BinarySpacePartition a
b = (Zipper Split -> Maybe (Zipper Split))
-> BinarySpacePartition a -> BinarySpacePartition a
forall a.
(Zipper Split -> Maybe (Zipper Split))
-> BinarySpacePartition a -> BinarySpacePartition a
doToNth (Direction2D
-> (Rational, Rational) -> Zipper Split -> Maybe (Zipper Split)
resizeSplit Direction2D
dir (Rational, Rational)
sc) BinarySpacePartition a
b

-- rotate tree left or right around parent of nth leaf
rotateTreeNth :: Direction2D -> BinarySpacePartition a -> BinarySpacePartition a
rotateTreeNth :: forall a.
Direction2D -> BinarySpacePartition a -> BinarySpacePartition a
rotateTreeNth Direction2D
_ (BinarySpacePartition [(Window, Rectangle)]
_ NodeRef
_ NodeRef
_ Maybe (Tree Split)
Nothing) = BinarySpacePartition a
forall a. BinarySpacePartition a
emptyBSP
rotateTreeNth Direction2D
U BinarySpacePartition a
b = BinarySpacePartition a
b
rotateTreeNth Direction2D
D BinarySpacePartition a
b = BinarySpacePartition a
b
rotateTreeNth Direction2D
dir b :: BinarySpacePartition a
b@(BinarySpacePartition [(Window, Rectangle)]
_ NodeRef
_ NodeRef
_ (Just Tree Split
_)) =
  (Zipper Split -> Maybe (Zipper Split))
-> BinarySpacePartition a -> BinarySpacePartition a
forall a.
(Zipper Split -> Maybe (Zipper Split))
-> BinarySpacePartition a -> BinarySpacePartition a
doToNth (\Zipper Split
t -> case Zipper Split -> Maybe (Zipper Split)
forall a. Zipper a -> Maybe (Zipper a)
goUp Zipper Split
t of
                Maybe (Zipper Split)
Nothing     -> Zipper Split -> Maybe (Zipper Split)
forall a. a -> Maybe a
Just Zipper Split
t
                Just (Tree Split
t', [Crumb Split]
c) -> Zipper Split -> Maybe (Zipper Split)
forall a. a -> Maybe a
Just (Direction2D -> Tree Split -> Tree Split
forall a. Direction2D -> Tree a -> Tree a
rotTree Direction2D
dir Tree Split
t', [Crumb Split]
c)) BinarySpacePartition a
b

equalizeNth :: BinarySpacePartition a -> BinarySpacePartition a
equalizeNth :: forall a. BinarySpacePartition a -> BinarySpacePartition a
equalizeNth (BinarySpacePartition [(Window, Rectangle)]
_ NodeRef
_ NodeRef
_ Maybe (Tree Split)
Nothing) = BinarySpacePartition a
forall a. BinarySpacePartition a
emptyBSP
equalizeNth b :: BinarySpacePartition a
b@(BinarySpacePartition [(Window, Rectangle)]
_ NodeRef
_ NodeRef
_ (Just (Leaf Int
_))) = BinarySpacePartition a
b
equalizeNth BinarySpacePartition a
b = (Zipper Split -> Maybe (Zipper Split))
-> BinarySpacePartition a -> BinarySpacePartition a
forall a.
(Zipper Split -> Maybe (Zipper Split))
-> BinarySpacePartition a -> BinarySpacePartition a
doToNth Zipper Split -> Maybe (Zipper Split)
equalize BinarySpacePartition a
b

rebalanceNth :: BinarySpacePartition a -> Rectangle -> BinarySpacePartition a
rebalanceNth :: forall a.
BinarySpacePartition a -> Rectangle -> BinarySpacePartition a
rebalanceNth (BinarySpacePartition [(Window, Rectangle)]
_ NodeRef
_ NodeRef
_ Maybe (Tree Split)
Nothing) Rectangle
_ = BinarySpacePartition a
forall a. BinarySpacePartition a
emptyBSP
rebalanceNth b :: BinarySpacePartition a
b@(BinarySpacePartition [(Window, Rectangle)]
_ NodeRef
_ NodeRef
_ (Just (Leaf Int
_))) Rectangle
_ = BinarySpacePartition a
b
rebalanceNth BinarySpacePartition a
b Rectangle
r = (Zipper Split -> Maybe (Zipper Split))
-> BinarySpacePartition a -> BinarySpacePartition a
forall a.
(Zipper Split -> Maybe (Zipper Split))
-> BinarySpacePartition a -> BinarySpacePartition a
doToNth (Zipper Split -> Maybe (Zipper Split)
balancedTree (Zipper Split -> Maybe (Zipper Split))
-> (Zipper Split -> Maybe (Zipper Split))
-> Zipper Split
-> Maybe (Zipper Split)
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Rectangle -> Zipper Split -> Maybe (Zipper Split)
optimizeOrientation Rectangle
r) BinarySpacePartition a
b

flattenLeaves :: BinarySpacePartition a -> [Int]
flattenLeaves :: forall a. BinarySpacePartition a -> [Int]
flattenLeaves (BinarySpacePartition [(Window, Rectangle)]
_ NodeRef
_ NodeRef
_ Maybe (Tree Split)
Nothing) = []
flattenLeaves (BinarySpacePartition [(Window, Rectangle)]
_ NodeRef
_ NodeRef
_ (Just Tree Split
t)) = Tree Split -> [Int]
forall a. Tree a -> [Int]
flatten Tree Split
t

-- we do this before an action to look afterwards which leaves moved where
numerateLeaves :: BinarySpacePartition a -> BinarySpacePartition a
numerateLeaves :: forall a. BinarySpacePartition a -> BinarySpacePartition a
numerateLeaves b :: BinarySpacePartition a
b@(BinarySpacePartition [(Window, Rectangle)]
_ NodeRef
_ NodeRef
_ Maybe (Tree Split)
Nothing) = BinarySpacePartition a
b
numerateLeaves b :: BinarySpacePartition a
b@(BinarySpacePartition [(Window, Rectangle)]
_ NodeRef
_ NodeRef
_ (Just Tree Split
t)) = BinarySpacePartition a
b{getTree=Just $ numerate ns t}
  where ns :: [Int]
ns = [Int
0..(Tree Split -> Int
forall a. Tree a -> Int
numLeaves Tree Split
tInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)]

-- if there is a selected and focused node and the focused is not a part of selected,
-- move selected node to be a child of focused node
moveNode :: BinarySpacePartition a -> BinarySpacePartition a
moveNode :: forall a. BinarySpacePartition a -> BinarySpacePartition a
moveNode b :: BinarySpacePartition a
b@(BinarySpacePartition [(Window, Rectangle)]
_ (NodeRef (-1) [Direction2D]
_ [Window]
_) NodeRef
_ Maybe (Tree Split)
_) = BinarySpacePartition a
b
moveNode b :: BinarySpacePartition a
b@(BinarySpacePartition [(Window, Rectangle)]
_ NodeRef
_ (NodeRef (-1) [Direction2D]
_ [Window]
_) Maybe (Tree Split)
_) = BinarySpacePartition a
b
moveNode b :: BinarySpacePartition a
b@(BinarySpacePartition [(Window, Rectangle)]
_ NodeRef
_ NodeRef
_ Maybe (Tree Split)
Nothing) = BinarySpacePartition a
b
moveNode b :: BinarySpacePartition a
b@(BinarySpacePartition [(Window, Rectangle)]
_ NodeRef
f NodeRef
s (Just Tree Split
ot)) =
  case BinarySpacePartition a -> Maybe (Zipper Split)
forall a. BinarySpacePartition a -> Maybe (Zipper Split)
makeZipper BinarySpacePartition a
b Maybe (Zipper Split)
-> (Zipper Split -> Maybe (Zipper Split)) -> Maybe (Zipper Split)
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= NodeRef -> Zipper Split -> Maybe (Zipper Split)
forall a. NodeRef -> Zipper a -> Maybe (Zipper a)
goToNode NodeRef
s of
    Just (Tree Split
n, LeftCrumb Split
_ Tree Split
t:[Crumb Split]
cs)  -> BinarySpacePartition a
b{getTree=Just $ insert n $ top (t, cs)}
    Just (Tree Split
n, RightCrumb Split
_ Tree Split
t:[Crumb Split]
cs) -> BinarySpacePartition a
b{getTree=Just $ insert n $ top (t, cs)}
    Maybe (Zipper Split)
_ -> BinarySpacePartition a
b
  where insert :: Tree Split -> Zipper Split -> Tree Split
insert Tree Split
t Zipper Split
z = case NodeRef -> Zipper Split -> Maybe (Zipper Split)
forall a. NodeRef -> Zipper a -> Maybe (Zipper a)
goToNode NodeRef
f Zipper Split
z of
          Maybe (Zipper Split)
Nothing -> Tree Split
ot --return original tree (abort)
          Just (Tree Split
n, Crumb Split
c:[Crumb Split]
cs) -> Zipper Split -> Tree Split
forall a. Zipper a -> Tree a
toTree (Split -> Tree Split -> Tree Split -> Tree Split
forall a. a -> Tree a -> Tree a -> Tree a
Node (Axis -> Rational -> Split
Split (Axis -> Axis
oppositeAxis (Axis -> Axis) -> (Crumb Split -> Axis) -> Crumb Split -> Axis
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Split -> Axis
axis (Split -> Axis) -> (Crumb Split -> Split) -> Crumb Split -> Axis
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Crumb Split -> Split
forall a. Crumb a -> a
parentVal (Crumb Split -> Axis) -> Crumb Split -> Axis
forall a b. (a -> b) -> a -> b
$ Crumb Split
c) Rational
0.5) Tree Split
t Tree Split
n, Crumb Split
cCrumb Split -> [Crumb Split] -> [Crumb Split]
forall a. a -> [a] -> [a]
:[Crumb Split]
cs)
          Just (Tree Split
n, []) -> Zipper Split -> Tree Split
forall a. Zipper a -> Tree a
toTree (Split -> Tree Split -> Tree Split -> Tree Split
forall a. a -> Tree a -> Tree a -> Tree a
Node (Axis -> Rational -> Split
Split Axis
Vertical Rational
0.5) Tree Split
t Tree Split
n, [])

------------------------------------------

-- returns index of focused window or 0 for empty stack
index :: W.Stack a -> Int
index :: forall a. Stack a -> Int
index Stack a
s = case Zipper a -> ([a], Maybe Int)
forall a. Zipper a -> ([a], Maybe Int)
toIndex (Stack a -> Zipper a
forall a. a -> Maybe a
Just Stack a
s) of
            ([a]
_, Maybe Int
Nothing) -> Int
0
            ([a]
_, Just Int
int) -> Int
int

--move windows to new positions according to tree transformations, keeping focus on originally focused window
--CAREFUL here! introduce a bug here and have fun debugging as your windows start to disappear or explode
adjustStack :: Maybe (W.Stack Window)  --original stack
            -> Maybe (W.Stack Window)  --stack without floating windows
            -> [Window]                --just floating windows of this WS
            -> Maybe (BinarySpacePartition Window) -- Tree with numbered leaves telling what to move where
            -> Maybe (W.Stack Window)  --resulting stack
adjustStack :: Maybe (Stack Window)
-> Maybe (Stack Window)
-> [Window]
-> Maybe (BinarySpacePartition Window)
-> Maybe (Stack Window)
adjustStack Maybe (Stack Window)
orig Maybe (Stack Window)
Nothing [Window]
_ Maybe (BinarySpacePartition Window)
_ = Maybe (Stack Window)
orig    --no new stack -> no changes
adjustStack Maybe (Stack Window)
orig Maybe (Stack Window)
_ [Window]
_ Maybe (BinarySpacePartition Window)
Nothing = Maybe (Stack Window)
orig    --empty tree   -> no changes
adjustStack Maybe (Stack Window)
orig Maybe (Stack Window)
s [Window]
fw (Just BinarySpacePartition Window
b) =
 if [Int] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
lsInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<[Window] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Window]
ws then Maybe (Stack Window)
orig      --less leaves than non-floating windows -> tree incomplete, no changes
 else [Window] -> Int -> Maybe (Stack Window)
forall a. [a] -> Int -> Zipper a
fromIndex [Window]
ws' Int
fid'
 where ws' :: [Window]
ws' = (Int -> Maybe Window) -> [Int] -> [Window]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Int -> Map Int Window -> Maybe Window
forall k a. Ord k => k -> Map k a -> Maybe a
`M.lookup` Map Int Window
wsmap) [Int]
ls [Window] -> [Window] -> [Window]
forall a. [a] -> [a] -> [a]
++ [Window]
fw
       fid' :: Int
fid' = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
0 (Maybe Int -> Int) -> Maybe Int -> Int
forall a b. (a -> b) -> a -> b
$ Window -> [Window] -> Maybe Int
forall a. Eq a => a -> [a] -> Maybe Int
elemIndex Window
focused [Window]
ws'
       wsmap :: Map Int Window
wsmap = [(Int, Window)] -> Map Int Window
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(Int, Window)] -> Map Int Window)
-> [(Int, Window)] -> Map Int Window
forall a b. (a -> b) -> a -> b
$ [Int] -> [Window] -> [(Int, Window)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] [Window]
ws -- map: old index in list -> window
       ls :: [Int]
ls = BinarySpacePartition Window -> [Int]
forall a. BinarySpacePartition a -> [Int]
flattenLeaves BinarySpacePartition Window
b              -- get new index ordering from tree
       ([Window]
ws,Maybe Int
fid) = Maybe (Stack Window) -> ([Window], Maybe Int)
forall a. Zipper a -> ([a], Maybe Int)
toIndex Maybe (Stack Window)
s
       focused :: Window
focused = [Window]
ws [Window] -> Int -> Window
forall a. HasCallStack => [a] -> Int -> a
!! Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
0 Maybe Int
fid

--replace the window stack of the managed workspace with our modified stack
replaceStack :: Maybe (W.Stack Window) -> X ()
replaceStack :: Maybe (Stack Window) -> X ()
replaceStack Maybe (Stack Window)
s = do
  XState
st <- X XState
forall s (m :: * -> *). MonadState s m => m s
get
  let wset :: WindowSet
wset = XState -> WindowSet
windowset XState
st
      cur :: Screen String (Layout Window) Window ScreenId ScreenDetail
cur  = WindowSet
-> 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 WindowSet
wset
      wsp :: Workspace String (Layout Window) Window
wsp  = 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
cur
  XState -> X ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put XState
st{windowset=wset{W.current=cur{W.workspace=wsp{W.stack=s}}}}

replaceFloating :: M.Map Window W.RationalRect -> X ()
replaceFloating :: Map Window RationalRect -> X ()
replaceFloating Map Window RationalRect
wsm = do
  XState
st <- X XState
forall s (m :: * -> *). MonadState s m => m s
get
  let wset :: WindowSet
wset = XState -> WindowSet
windowset XState
st
  XState -> X ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put XState
st{windowset=wset{W.floating=wsm}}

-- some helpers to filter windows
--
getFloating :: X [Window]
getFloating :: X [Window]
getFloating = Map Window RationalRect -> [Window]
forall k a. Map k a -> [k]
M.keys (Map Window RationalRect -> [Window])
-> (WindowSet -> Map Window RationalRect) -> WindowSet -> [Window]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WindowSet -> Map Window RationalRect
forall i l a sid sd. StackSet i l a sid sd -> Map a RationalRect
W.floating (WindowSet -> [Window]) -> X WindowSet -> X [Window]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (XState -> WindowSet) -> X WindowSet
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets XState -> WindowSet
windowset -- all floating windows

getHidden :: X [Window]
getHidden :: X [Window]
getHidden = X (Maybe (Stack Window))
getStackSet X (Maybe (Stack Window))
-> (Maybe (Stack Window) -> X [Window]) -> X [Window]
forall a b. X a -> (a -> X b) -> X b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Window -> X Bool) -> [Window] -> X [Window]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM (Query Bool -> Window -> X Bool
forall a. Query a -> Window -> X a
runQuery Query Bool
isMinimized) ([Window] -> X [Window])
-> (Maybe (Stack Window) -> [Window])
-> Maybe (Stack Window)
-> X [Window]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe (Stack Window) -> [Window]
forall a. Maybe (Stack a) -> [a]
W.integrate'

getStackSet :: X (Maybe (W.Stack Window))
getStackSet :: X (Maybe (Stack Window))
getStackSet = 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))
-> (WindowSet -> Workspace String (Layout Window) Window)
-> WindowSet
-> 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)
-> (WindowSet
    -> Screen String (Layout Window) Window ScreenId ScreenDetail)
-> WindowSet
-> Workspace String (Layout Window) Window
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WindowSet
-> 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 (WindowSet -> Maybe (Stack Window))
-> X WindowSet -> X (Maybe (Stack Window))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (XState -> WindowSet) -> X WindowSet
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets XState -> WindowSet
windowset -- windows on this WS (with floating)

getScreenRect :: X Rectangle
getScreenRect :: X Rectangle
getScreenRect = ScreenDetail -> Rectangle
screenRect (ScreenDetail -> Rectangle)
-> (WindowSet -> ScreenDetail) -> WindowSet -> Rectangle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Screen String (Layout Window) Window ScreenId ScreenDetail
-> ScreenDetail
forall i l a sid sd. Screen i l a sid sd -> sd
W.screenDetail (Screen String (Layout Window) Window ScreenId ScreenDetail
 -> ScreenDetail)
-> (WindowSet
    -> Screen String (Layout Window) Window ScreenId ScreenDetail)
-> WindowSet
-> ScreenDetail
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WindowSet
-> 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 (WindowSet -> Rectangle) -> X WindowSet -> X Rectangle
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (XState -> WindowSet) -> X WindowSet
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets XState -> WindowSet
windowset

withoutFloating :: [Window] -> [Window] -> Maybe (W.Stack Window) -> Maybe (W.Stack Window)
withoutFloating :: [Window]
-> [Window] -> Maybe (Stack Window) -> Maybe (Stack Window)
withoutFloating [Window]
fs [Window]
hs = Maybe (Stack Window)
-> (Stack Window -> Maybe (Stack Window))
-> Maybe (Stack Window)
-> Maybe (Stack Window)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Maybe (Stack Window)
forall a. Maybe a
Nothing ([Window] -> [Window] -> Stack Window -> Maybe (Stack Window)
unfloat [Window]
fs [Window]
hs)

-- ignore messages if current focus is on floating window, otherwise return stack without floating
unfloat :: [Window] -> [Window] -> W.Stack Window -> Maybe (W.Stack Window)
unfloat :: [Window] -> [Window] -> Stack Window -> Maybe (Stack Window)
unfloat [Window]
fs [Window]
hs Stack Window
s = if Stack Window -> Window
forall a. Stack a -> a
W.focus Stack Window
s Window -> [Window] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Window]
fs
      then Maybe (Stack Window)
forall a. Maybe a
Nothing
      else Stack Window -> Maybe (Stack Window)
forall a. a -> Maybe a
Just (Stack Window -> Maybe (Stack Window))
-> Stack Window -> Maybe (Stack Window)
forall a b. (a -> b) -> a -> b
$ Stack Window
s{W.up = W.up s \\ (fs ++ hs), W.down = W.down s \\ (fs ++ hs)}

instance LayoutClass BinarySpacePartition Window where
  doLayout :: BinarySpacePartition Window
-> Rectangle
-> Stack Window
-> X ([(Window, Rectangle)], Maybe (BinarySpacePartition Window))
doLayout BinarySpacePartition Window
b Rectangle
r Stack Window
s = do
    let b' :: BinarySpacePartition Window
b' = BinarySpacePartition Window -> BinarySpacePartition Window
forall a. BinarySpacePartition a -> BinarySpacePartition a
layout BinarySpacePartition Window
b
    BinarySpacePartition Window
b'' <- BinarySpacePartition Window
-> Bool -> Rectangle -> X (BinarySpacePartition Window)
updateNodeRef BinarySpacePartition Window
b' (BinarySpacePartition Window -> Int
forall a. BinarySpacePartition a -> Int
size BinarySpacePartition Window
bInt -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/=BinarySpacePartition Window -> Int
forall a. BinarySpacePartition a -> Int
size BinarySpacePartition Window
b') Rectangle
r
    let rs :: [Rectangle]
rs = BinarySpacePartition Window -> Rectangle -> [Rectangle]
forall a. BinarySpacePartition a -> Rectangle -> [Rectangle]
rectangles BinarySpacePartition Window
b'' Rectangle
r
        wrs :: [(Window, Rectangle)]
wrs = [Window] -> [Rectangle] -> [(Window, Rectangle)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Window]
ws [Rectangle]
rs
    ([(Window, Rectangle)], Maybe (BinarySpacePartition Window))
-> X ([(Window, Rectangle)], Maybe (BinarySpacePartition Window))
forall a. a -> X a
forall (m :: * -> *) a. Monad m => a -> m a
return ([(Window, Rectangle)]
wrs, BinarySpacePartition Window -> Maybe (BinarySpacePartition Window)
forall a. a -> Maybe a
Just BinarySpacePartition Window
b''{getOldRects=wrs})
    where
      ws :: [Window]
ws = Stack Window -> [Window]
forall a. Stack a -> [a]
W.integrate Stack Window
s
      l :: Int
l = [Window] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Window]
ws
      layout :: BinarySpacePartition a -> BinarySpacePartition a
layout BinarySpacePartition a
bsp
        | Int
l Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
sz = BinarySpacePartition a
bsp
        | Int
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
sz = BinarySpacePartition a -> BinarySpacePartition a
layout (BinarySpacePartition a -> BinarySpacePartition a)
-> BinarySpacePartition a -> BinarySpacePartition a
forall a b. (a -> b) -> a -> b
$ BinarySpacePartition a -> BinarySpacePartition a
forall a. BinarySpacePartition a -> BinarySpacePartition a
splitNth BinarySpacePartition a
bsp
        | Bool
otherwise = BinarySpacePartition a -> BinarySpacePartition a
layout (BinarySpacePartition a -> BinarySpacePartition a)
-> BinarySpacePartition a -> BinarySpacePartition a
forall a b. (a -> b) -> a -> b
$ BinarySpacePartition a -> BinarySpacePartition a
forall a. BinarySpacePartition a -> BinarySpacePartition a
removeNth BinarySpacePartition a
bsp
        where sz :: Int
sz = BinarySpacePartition a -> Int
forall a. BinarySpacePartition a -> Int
size BinarySpacePartition a
bsp

  handleMessage :: BinarySpacePartition Window
-> SomeMessage -> X (Maybe (BinarySpacePartition Window))
handleMessage BinarySpacePartition Window
b_orig SomeMessage
m
   | Just msg :: WindowArrangerMsg
msg@(SetGeometry Rectangle
_) <- SomeMessage -> Maybe WindowArrangerMsg
forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m = BinarySpacePartition Window
-> WindowArrangerMsg -> X (Maybe (BinarySpacePartition Window))
handleResize BinarySpacePartition Window
b WindowArrangerMsg
msg
   | Just FocusParent
FocusParent <- SomeMessage -> Maybe FocusParent
forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m = do
       let n :: NodeRef
n = BinarySpacePartition Window -> NodeRef
forall a. BinarySpacePartition a -> NodeRef
getFocusedNode BinarySpacePartition Window
b
       let n' :: NodeRef
n' = Int -> Maybe (Zipper Split) -> NodeRef
toNodeRef (NodeRef -> Int
refLeaf NodeRef
n) (BinarySpacePartition Window -> Maybe (Zipper Split)
forall a. BinarySpacePartition a -> Maybe (Zipper Split)
makeZipper BinarySpacePartition Window
b Maybe (Zipper Split)
-> (Zipper Split -> Maybe (Zipper Split)) -> Maybe (Zipper Split)
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= NodeRef -> Zipper Split -> Maybe (Zipper Split)
forall a. NodeRef -> Zipper a -> Maybe (Zipper a)
goToNode NodeRef
n Maybe (Zipper Split)
-> (Zipper Split -> Maybe (Zipper Split)) -> Maybe (Zipper Split)
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Zipper Split -> Maybe (Zipper Split)
forall a. Zipper a -> Maybe (Zipper a)
goUp)
       Maybe (BinarySpacePartition Window)
-> X (Maybe (BinarySpacePartition Window))
forall a. a -> X a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (BinarySpacePartition Window)
 -> X (Maybe (BinarySpacePartition Window)))
-> Maybe (BinarySpacePartition Window)
-> X (Maybe (BinarySpacePartition Window))
forall a b. (a -> b) -> a -> b
$ BinarySpacePartition Window -> Maybe (BinarySpacePartition Window)
forall a. a -> Maybe a
Just BinarySpacePartition Window
b{getFocusedNode=n'{refWins=refWins n}}
   | Just SelectMoveNode
SelectNode <- SomeMessage -> Maybe SelectMoveNode
forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m = do
       let n :: NodeRef
n = BinarySpacePartition Window -> NodeRef
forall a. BinarySpacePartition a -> NodeRef
getFocusedNode BinarySpacePartition Window
b
       let s :: NodeRef
s = BinarySpacePartition Window -> NodeRef
forall a. BinarySpacePartition a -> NodeRef
getSelectedNode BinarySpacePartition Window
b
       [Window] -> X ()
removeBorder ([Window] -> X ()) -> [Window] -> X ()
forall a b. (a -> b) -> a -> b
$ NodeRef -> [Window]
refWins NodeRef
s
       let s' :: NodeRef
s' = if NodeRef -> Int
refLeaf NodeRef
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== NodeRef -> Int
refLeaf NodeRef
s Bool -> Bool -> Bool
&& NodeRef -> [Direction2D]
refPath NodeRef
n [Direction2D] -> [Direction2D] -> Bool
forall a. Eq a => a -> a -> Bool
== NodeRef -> [Direction2D]
refPath NodeRef
s
                then NodeRef
noRef else NodeRef
n{refWins=[]}
       Maybe (BinarySpacePartition Window)
-> X (Maybe (BinarySpacePartition Window))
forall a. a -> X a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (BinarySpacePartition Window)
 -> X (Maybe (BinarySpacePartition Window)))
-> Maybe (BinarySpacePartition Window)
-> X (Maybe (BinarySpacePartition Window))
forall a b. (a -> b) -> a -> b
$ BinarySpacePartition Window -> Maybe (BinarySpacePartition Window)
forall a. a -> Maybe a
Just BinarySpacePartition Window
b{getSelectedNode=s'}
   | Bool
otherwise = do
       Maybe (Stack Window)
ws <- X (Maybe (Stack Window))
getStackSet
       [Window]
fs <- X [Window]
getFloating
       [Window]
hs <- X [Window]
getHidden
       Rectangle
r <- X Rectangle
getScreenRect
       -- removeBorder $ refWins $ getSelectedNode b
       let lws :: Maybe (Stack Window)
lws = [Window]
-> [Window] -> Maybe (Stack Window) -> Maybe (Stack Window)
withoutFloating [Window]
fs [Window]
hs Maybe (Stack Window)
ws                                 -- tiled windows on WS
           lfs :: [Window]
lfs = [Window]
-> (Stack Window -> [Window]) -> Maybe (Stack Window) -> [Window]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] Stack Window -> [Window]
forall a. Stack a -> [a]
W.integrate Maybe (Stack Window)
ws [Window] -> [Window] -> [Window]
forall a. Eq a => [a] -> [a] -> [a]
\\ [Window]
-> (Stack Window -> [Window]) -> Maybe (Stack Window) -> [Window]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] Stack Window -> [Window]
forall a. Stack a -> [a]
W.integrate Maybe (Stack Window)
lws      -- untiled windows on WS
           b' :: Maybe (BinarySpacePartition Window)
b'  = Rectangle -> Maybe (BinarySpacePartition Window)
handleMesg Rectangle
r                -- transform tree (concerns only tiled windows)
           ws' :: Maybe (Stack Window)
ws' = Maybe (Stack Window)
-> Maybe (Stack Window)
-> [Window]
-> Maybe (BinarySpacePartition Window)
-> Maybe (Stack Window)
adjustStack Maybe (Stack Window)
ws Maybe (Stack Window)
lws [Window]
lfs Maybe (BinarySpacePartition Window)
b'   -- apply transformation to window stack, reintegrate floating wins
       Maybe (Stack Window) -> X ()
replaceStack Maybe (Stack Window)
ws'
       Maybe (BinarySpacePartition Window)
-> X (Maybe (BinarySpacePartition Window))
forall a. a -> X a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (BinarySpacePartition Window)
b'
    where handleMesg :: Rectangle -> Maybe (BinarySpacePartition Window)
handleMesg Rectangle
r = [Maybe (BinarySpacePartition Window)]
-> Maybe (BinarySpacePartition Window)
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum [ (ResizeDirectional -> BinarySpacePartition Window)
-> Maybe ResizeDirectional -> Maybe (BinarySpacePartition Window)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ResizeDirectional -> BinarySpacePartition Window
resize        (SomeMessage -> Maybe ResizeDirectional
forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m)
                              , (Rotate -> BinarySpacePartition Window)
-> Maybe Rotate -> Maybe (BinarySpacePartition Window)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Rotate -> BinarySpacePartition Window
forall {a}. Rotate -> BinarySpacePartition a
rotate        (SomeMessage -> Maybe Rotate
forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m)
                              , (Swap -> BinarySpacePartition Window)
-> Maybe Swap -> Maybe (BinarySpacePartition Window)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Swap -> BinarySpacePartition Window
forall {a}. Swap -> BinarySpacePartition a
swap          (SomeMessage -> Maybe Swap
forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m)
                              , (TreeRotate -> BinarySpacePartition Window)
-> Maybe TreeRotate -> Maybe (BinarySpacePartition Window)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TreeRotate -> BinarySpacePartition Window
forall {a}. TreeRotate -> BinarySpacePartition a
rotateTr      (SomeMessage -> Maybe TreeRotate
forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m)
                              , (TreeBalance -> BinarySpacePartition Window)
-> Maybe TreeBalance -> Maybe (BinarySpacePartition Window)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Rectangle -> TreeBalance -> BinarySpacePartition Window
forall {a}. Rectangle -> TreeBalance -> BinarySpacePartition a
balanceTr Rectangle
r) (SomeMessage -> Maybe TreeBalance
forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m)
                              , (SelectMoveNode -> BinarySpacePartition Window)
-> Maybe SelectMoveNode -> Maybe (BinarySpacePartition Window)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SelectMoveNode -> BinarySpacePartition Window
move          (SomeMessage -> Maybe SelectMoveNode
forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m)
                              , (SplitShiftDirectional -> BinarySpacePartition Window)
-> Maybe SplitShiftDirectional
-> Maybe (BinarySpacePartition Window)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SplitShiftDirectional -> BinarySpacePartition Window
forall {a}. SplitShiftDirectional -> BinarySpacePartition a
splitShift    (SomeMessage -> Maybe SplitShiftDirectional
forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m)
                              ]
          resize :: ResizeDirectional -> BinarySpacePartition Window
resize (ExpandTowardsBy Direction2D
dir Rational
diff) = Direction2D
-> Rational
-> BinarySpacePartition Window
-> BinarySpacePartition Window
forall a.
Direction2D
-> Rational -> BinarySpacePartition a -> BinarySpacePartition a
growNthTowards Direction2D
dir Rational
diff BinarySpacePartition Window
b
          resize (ShrinkFromBy Direction2D
dir Rational
diff) = Direction2D
-> Rational
-> BinarySpacePartition Window
-> BinarySpacePartition Window
forall a.
Direction2D
-> Rational -> BinarySpacePartition a -> BinarySpacePartition a
shrinkNthFrom Direction2D
dir Rational
diff BinarySpacePartition Window
b
          resize (MoveSplitBy Direction2D
dir Rational
diff) = Direction2D
-> Rational
-> BinarySpacePartition Window
-> BinarySpacePartition Window
forall a.
Direction2D
-> Rational -> BinarySpacePartition a -> BinarySpacePartition a
autoSizeNth Direction2D
dir Rational
diff BinarySpacePartition Window
b
          rotate :: Rotate -> BinarySpacePartition a
rotate Rotate
Rotate = BinarySpacePartition Window -> BinarySpacePartition a
forall {a} {a}. BinarySpacePartition a -> BinarySpacePartition a
resetFoc (BinarySpacePartition Window -> BinarySpacePartition a)
-> BinarySpacePartition Window -> BinarySpacePartition a
forall a b. (a -> b) -> a -> b
$ BinarySpacePartition Window -> BinarySpacePartition Window
forall a. BinarySpacePartition a -> BinarySpacePartition a
rotateNth BinarySpacePartition Window
b
          swap :: Swap -> BinarySpacePartition a
swap Swap
Swap = BinarySpacePartition Window -> BinarySpacePartition a
forall {a} {a}. BinarySpacePartition a -> BinarySpacePartition a
resetFoc (BinarySpacePartition Window -> BinarySpacePartition a)
-> BinarySpacePartition Window -> BinarySpacePartition a
forall a b. (a -> b) -> a -> b
$ BinarySpacePartition Window -> BinarySpacePartition Window
forall a. BinarySpacePartition a -> BinarySpacePartition a
swapNth BinarySpacePartition Window
b
          rotateTr :: TreeRotate -> BinarySpacePartition a
rotateTr TreeRotate
RotateL = BinarySpacePartition Window -> BinarySpacePartition a
forall {a} {a}. BinarySpacePartition a -> BinarySpacePartition a
resetFoc (BinarySpacePartition Window -> BinarySpacePartition a)
-> BinarySpacePartition Window -> BinarySpacePartition a
forall a b. (a -> b) -> a -> b
$ Direction2D
-> BinarySpacePartition Window -> BinarySpacePartition Window
forall a.
Direction2D -> BinarySpacePartition a -> BinarySpacePartition a
rotateTreeNth Direction2D
L BinarySpacePartition Window
b
          rotateTr TreeRotate
RotateR = BinarySpacePartition Window -> BinarySpacePartition a
forall {a} {a}. BinarySpacePartition a -> BinarySpacePartition a
resetFoc (BinarySpacePartition Window -> BinarySpacePartition a)
-> BinarySpacePartition Window -> BinarySpacePartition a
forall a b. (a -> b) -> a -> b
$ Direction2D
-> BinarySpacePartition Window -> BinarySpacePartition Window
forall a.
Direction2D -> BinarySpacePartition a -> BinarySpacePartition a
rotateTreeNth Direction2D
R BinarySpacePartition Window
b
          balanceTr :: Rectangle -> TreeBalance -> BinarySpacePartition a
balanceTr Rectangle
_ TreeBalance
Equalize = BinarySpacePartition Window -> BinarySpacePartition a
forall {a} {a}. BinarySpacePartition a -> BinarySpacePartition a
resetFoc (BinarySpacePartition Window -> BinarySpacePartition a)
-> BinarySpacePartition Window -> BinarySpacePartition a
forall a b. (a -> b) -> a -> b
$ BinarySpacePartition Window -> BinarySpacePartition Window
forall a. BinarySpacePartition a -> BinarySpacePartition a
equalizeNth BinarySpacePartition Window
b
          balanceTr Rectangle
r TreeBalance
Balance  = BinarySpacePartition Window -> BinarySpacePartition a
forall {a} {a}. BinarySpacePartition a -> BinarySpacePartition a
resetFoc (BinarySpacePartition Window -> BinarySpacePartition a)
-> BinarySpacePartition Window -> BinarySpacePartition a
forall a b. (a -> b) -> a -> b
$ BinarySpacePartition Window
-> Rectangle -> BinarySpacePartition Window
forall a.
BinarySpacePartition a -> Rectangle -> BinarySpacePartition a
rebalanceNth BinarySpacePartition Window
b Rectangle
r
          move :: SelectMoveNode -> BinarySpacePartition Window
move SelectMoveNode
MoveNode = BinarySpacePartition Window -> BinarySpacePartition Window
forall {a} {a}. BinarySpacePartition a -> BinarySpacePartition a
resetFoc (BinarySpacePartition Window -> BinarySpacePartition Window)
-> BinarySpacePartition Window -> BinarySpacePartition Window
forall a b. (a -> b) -> a -> b
$ BinarySpacePartition Window -> BinarySpacePartition Window
forall a. BinarySpacePartition a -> BinarySpacePartition a
moveNode BinarySpacePartition Window
b
          move SelectMoveNode
SelectNode = BinarySpacePartition Window
b --should not happen here, is done above, as we need X monad
          splitShift :: SplitShiftDirectional -> BinarySpacePartition a
splitShift (SplitShift Direction1D
dir) = BinarySpacePartition Window -> BinarySpacePartition a
forall {a} {a}. BinarySpacePartition a -> BinarySpacePartition a
resetFoc (BinarySpacePartition Window -> BinarySpacePartition a)
-> BinarySpacePartition Window -> BinarySpacePartition a
forall a b. (a -> b) -> a -> b
$ Direction1D
-> BinarySpacePartition Window -> BinarySpacePartition Window
forall a.
Direction1D -> BinarySpacePartition a -> BinarySpacePartition a
splitShiftNth Direction1D
dir BinarySpacePartition Window
b

          b :: BinarySpacePartition Window
b = BinarySpacePartition Window -> BinarySpacePartition Window
forall a. BinarySpacePartition a -> BinarySpacePartition a
numerateLeaves BinarySpacePartition Window
b_orig
          resetFoc :: BinarySpacePartition a -> BinarySpacePartition a
resetFoc BinarySpacePartition a
bsp = BinarySpacePartition a
bsp{getFocusedNode=(getFocusedNode bsp){refLeaf= -1}
                            ,getSelectedNode=(getSelectedNode bsp){refLeaf= -1}}

  description :: BinarySpacePartition Window -> String
description BinarySpacePartition Window
_  = String
"BSP"

-- React to SetGeometry message to work with BorderResize/MouseResize
handleResize :: BinarySpacePartition Window -> WindowArrangerMsg -> X (Maybe (BinarySpacePartition Window))
handleResize :: BinarySpacePartition Window
-> WindowArrangerMsg -> X (Maybe (BinarySpacePartition Window))
handleResize BinarySpacePartition Window
b (SetGeometry newrect :: Rectangle
newrect@(Rectangle Position
_ Position
_ Dimension
w Dimension
h)) = do
  Maybe (Stack Window)
ws <- X (Maybe (Stack Window))
getStackSet
  [Window]
fs <- X [Window]
getFloating
  [Window]
hs <- X [Window]
getHidden
  case Stack Window -> Window
forall a. Stack a -> a
W.focus (Stack Window -> Window) -> Maybe (Stack Window) -> Maybe Window
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Stack Window)
ws of
    Maybe Window
Nothing -> Maybe (BinarySpacePartition Window)
-> X (Maybe (BinarySpacePartition Window))
forall a. a -> X a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (BinarySpacePartition Window)
forall a. Maybe a
Nothing
    Just Window
win -> do
      (Bool
_,Window
_,Window
_,CInt
_,CInt
_,CInt
mx,CInt
my,Modifier
_) <- (Display
 -> X (Bool, Window, Window, CInt, CInt, CInt, CInt, Modifier))
-> X (Bool, Window, Window, CInt, CInt, CInt, CInt, Modifier)
forall a. (Display -> X a) -> X a
withDisplay (\Display
d -> IO (Bool, Window, Window, CInt, CInt, CInt, CInt, Modifier)
-> X (Bool, Window, Window, CInt, CInt, CInt, CInt, Modifier)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO (Bool, Window, Window, CInt, CInt, CInt, CInt, Modifier)
 -> X (Bool, Window, Window, CInt, CInt, CInt, CInt, Modifier))
-> IO (Bool, Window, Window, CInt, CInt, CInt, CInt, Modifier)
-> X (Bool, Window, Window, CInt, CInt, CInt, CInt, Modifier)
forall a b. (a -> b) -> a -> b
$ Display
-> Window
-> IO (Bool, Window, Window, CInt, CInt, CInt, CInt, Modifier)
queryPointer Display
d Window
win)
      let oldrect :: Rectangle
oldrect@(Rectangle Position
_ Position
_ Dimension
ow Dimension
oh) = Rectangle -> Maybe Rectangle -> Rectangle
forall a. a -> Maybe a -> a
fromMaybe (Position -> Position -> Dimension -> Dimension -> Rectangle
Rectangle Position
0 Position
0 Dimension
0 Dimension
0) (Maybe Rectangle -> Rectangle) -> Maybe Rectangle -> Rectangle
forall a b. (a -> b) -> a -> b
$ Window -> [(Window, Rectangle)] -> Maybe Rectangle
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Window
win ([(Window, Rectangle)] -> Maybe Rectangle)
-> [(Window, Rectangle)] -> Maybe Rectangle
forall a b. (a -> b) -> a -> b
$ BinarySpacePartition Window -> [(Window, Rectangle)]
forall a. BinarySpacePartition a -> [(Window, Rectangle)]
getOldRects BinarySpacePartition Window
b
      let (Rational
xsc,Rational
ysc)   = (Dimension -> Integer
forall a b. (Integral a, Num b) => a -> b
fi Dimension
w Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Dimension -> Integer
forall a b. (Integral a, Num b) => a -> b
fi Dimension
ow, Dimension -> Integer
forall a b. (Integral a, Num b) => a -> b
fi Dimension
h Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Dimension -> Integer
forall a b. (Integral a, Num b) => a -> b
fi Dimension
oh)
          (Rational
xsc',Rational
ysc') = (Rational -> Rational
forall {a}. (Ord a, Fractional a) => a -> a
rough Rational
xsc, Rational -> Rational
forall {a}. (Ord a, Fractional a) => a -> a
rough Rational
ysc)
          dirs :: [Direction2D]
dirs = Rectangle -> Rectangle -> (Int, Int) -> [Direction2D]
changedDirs Rectangle
oldrect Rectangle
newrect (CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fi CInt
mx,CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fi CInt
my)
          n :: Maybe Int
n = Window -> [Window] -> Maybe Int
forall a. Eq a => a -> [a] -> Maybe Int
elemIndex Window
win ([Window] -> Maybe Int) -> [Window] -> Maybe Int
forall a b. (a -> b) -> a -> b
$ [Window]
-> (Stack Window -> [Window]) -> Maybe (Stack Window) -> [Window]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] Stack Window -> [Window]
forall a. Stack a -> [a]
W.integrate (Maybe (Stack Window) -> [Window])
-> Maybe (Stack Window) -> [Window]
forall a b. (a -> b) -> a -> b
$ [Window]
-> [Window] -> Maybe (Stack Window) -> Maybe (Stack Window)
withoutFloating [Window]
fs [Window]
hs Maybe (Stack Window)
ws
      -- unless (isNothing dir) $ debug $
      --       show (fi x-fi ox,fi y-fi oy) ++ show (fi w-fi ow,fi h-fi oh)
      --       ++ show dir ++ " " ++ show win ++ " " ++ show (mx,my)
      Maybe (BinarySpacePartition Window)
-> X (Maybe (BinarySpacePartition Window))
forall a. a -> X a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (BinarySpacePartition Window)
 -> X (Maybe (BinarySpacePartition Window)))
-> Maybe (BinarySpacePartition Window)
-> X (Maybe (BinarySpacePartition Window))
forall a b. (a -> b) -> a -> b
$ case Maybe Int
n of
                Just Int
_ -> BinarySpacePartition Window -> Maybe (BinarySpacePartition Window)
forall a. a -> Maybe a
Just (BinarySpacePartition Window
 -> Maybe (BinarySpacePartition Window))
-> BinarySpacePartition Window
-> Maybe (BinarySpacePartition Window)
forall a b. (a -> b) -> a -> b
$ (BinarySpacePartition Window
 -> Direction2D -> BinarySpacePartition Window)
-> BinarySpacePartition Window
-> [Direction2D]
-> BinarySpacePartition Window
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\BinarySpacePartition Window
b' Direction2D
d -> Direction2D
-> (Rational, Rational)
-> BinarySpacePartition Window
-> BinarySpacePartition Window
forall a.
Direction2D
-> (Rational, Rational)
-> BinarySpacePartition a
-> BinarySpacePartition a
resizeSplitNth Direction2D
d (Rational
xsc',Rational
ysc') BinarySpacePartition Window
b') BinarySpacePartition Window
b [Direction2D]
dirs
                Maybe Int
Nothing -> Maybe (BinarySpacePartition Window)
forall a. Maybe a
Nothing --focused window is floating -> ignore
  where rough :: a -> a
rough a
v = a -> a -> a
forall a. Ord a => a -> a -> a
min a
1.5 (a -> a) -> a -> a
forall a b. (a -> b) -> a -> b
$ a -> a -> a
forall a. Ord a => a -> a -> a
max a
0.75 a
v -- extreme scale factors are forbidden
handleResize BinarySpacePartition Window
_ WindowArrangerMsg
_ = Maybe (BinarySpacePartition Window)
-> X (Maybe (BinarySpacePartition Window))
forall a. a -> X a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (BinarySpacePartition Window)
forall a. Maybe a
Nothing

-- find out which borders have been pulled. We need the old and new rects and the mouse coordinates
changedDirs :: Rectangle -> Rectangle -> (Int,Int) -> [Direction2D]
changedDirs :: Rectangle -> Rectangle -> (Int, Int) -> [Direction2D]
changedDirs (Rectangle Position
_ Position
_ Dimension
ow Dimension
oh) (Rectangle Position
_ Position
_ Dimension
w Dimension
h) (Int
mx,Int
my) = [Maybe Direction2D] -> [Direction2D]
forall a. [Maybe a] -> [a]
catMaybes [Maybe Direction2D
lr, Maybe Direction2D
ud]
 where lr :: Maybe Direction2D
lr = if Dimension
owDimension -> Dimension -> Bool
forall a. Eq a => a -> a -> Bool
==Dimension
w then Maybe Direction2D
forall a. Maybe a
Nothing
            else Direction2D -> Maybe Direction2D
forall a. a -> Maybe a
Just (if (Int -> Double
forall a b. (Integral a, Num b) => a -> b
fi Int
mx :: Double) Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>  (Dimension -> Double
forall a b. (Integral a, Num b) => a -> b
fi Dimension
ow :: Double)Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
2 then Direction2D
R else Direction2D
L)
       ud :: Maybe Direction2D
ud = if Dimension
ohDimension -> Dimension -> Bool
forall a. Eq a => a -> a -> Bool
==Dimension
h then Maybe Direction2D
forall a. Maybe a
Nothing
            else Direction2D -> Maybe Direction2D
forall a. a -> Maybe a
Just (if (Int -> Double
forall a b. (Integral a, Num b) => a -> b
fi Int
my :: Double) Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> (Dimension -> Double
forall a b. (Integral a, Num b) => a -> b
fi Dimension
oh :: Double)Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
2 then Direction2D
D else Direction2D
U)

-- node focus border helpers
----------------------------
updateNodeRef :: BinarySpacePartition Window -> Bool -> Rectangle -> X (BinarySpacePartition Window)
updateNodeRef :: BinarySpacePartition Window
-> Bool -> Rectangle -> X (BinarySpacePartition Window)
updateNodeRef BinarySpacePartition Window
b Bool
force Rectangle
r = do
    let n :: NodeRef
n = BinarySpacePartition Window -> NodeRef
forall a. BinarySpacePartition a -> NodeRef
getFocusedNode BinarySpacePartition Window
b
    let s :: NodeRef
s = BinarySpacePartition Window -> NodeRef
forall a. BinarySpacePartition a -> NodeRef
getSelectedNode BinarySpacePartition Window
b
    [Window] -> X ()
removeBorder (NodeRef -> [Window]
refWins NodeRef
n[Window] -> [Window] -> [Window]
forall a. [a] -> [a] -> [a]
++NodeRef -> [Window]
refWins NodeRef
s)
    Int
l <- X Int
getCurrFocused
    BinarySpacePartition Window
b' <- if NodeRef -> Int
refLeaf NodeRef
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
l Bool -> Bool -> Bool
|| NodeRef -> Int
refLeaf NodeRef
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== (-Int
1) Bool -> Bool -> Bool
|| Bool
force
            then BinarySpacePartition Window -> X (BinarySpacePartition Window)
forall a. a -> X a
forall (m :: * -> *) a. Monad m => a -> m a
return BinarySpacePartition Window
b{getFocusedNode=leafToNodeRef l b}
            else BinarySpacePartition Window -> X (BinarySpacePartition Window)
forall a. a -> X a
forall (m :: * -> *) a. Monad m => a -> m a
return BinarySpacePartition Window
b
    BinarySpacePartition Window
b'' <- if Bool
force then BinarySpacePartition Window -> X (BinarySpacePartition Window)
forall a. a -> X a
forall (m :: * -> *) a. Monad m => a -> m a
return BinarySpacePartition Window
b'{getSelectedNode=noRef} else BinarySpacePartition Window -> X (BinarySpacePartition Window)
forall a. a -> X a
forall (m :: * -> *) a. Monad m => a -> m a
return BinarySpacePartition Window
b'
    Rectangle
-> BinarySpacePartition Window -> X (BinarySpacePartition Window)
forall a.
Rectangle -> BinarySpacePartition a -> X (BinarySpacePartition a)
renderBorders Rectangle
r BinarySpacePartition Window
b''
  where getCurrFocused :: X Int
getCurrFocused = Int -> (Stack Window -> Int) -> Maybe (Stack Window) -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
0 Stack Window -> Int
forall a. Stack a -> Int
index (Maybe (Stack Window) -> Int) -> X (Maybe (Stack Window)) -> X Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Window]
-> [Window] -> Maybe (Stack Window) -> Maybe (Stack Window)
withoutFloating ([Window]
 -> [Window] -> Maybe (Stack Window) -> Maybe (Stack Window))
-> X [Window]
-> X ([Window] -> Maybe (Stack Window) -> Maybe (Stack Window))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> X [Window]
getFloating X ([Window] -> Maybe (Stack Window) -> Maybe (Stack Window))
-> X [Window] -> X (Maybe (Stack Window) -> Maybe (Stack Window))
forall a b. X (a -> b) -> X a -> X b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> X [Window]
getHidden X (Maybe (Stack Window) -> Maybe (Stack Window))
-> X (Maybe (Stack Window)) -> X (Maybe (Stack Window))
forall a b. X (a -> b) -> X a -> X b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> X (Maybe (Stack Window))
getStackSet)

-- create border around focused node if necessary
renderBorders :: Rectangle -> BinarySpacePartition a -> X (BinarySpacePartition a)
renderBorders :: forall a.
Rectangle -> BinarySpacePartition a -> X (BinarySpacePartition a)
renderBorders Rectangle
r BinarySpacePartition a
b = do
  let l :: Maybe Int
l = NodeRef -> Maybe (Zipper Split) -> Maybe Int
forall a. NodeRef -> Maybe (Zipper a) -> Maybe Int
nodeRefToLeaf (BinarySpacePartition a -> NodeRef
forall a. BinarySpacePartition a -> NodeRef
getFocusedNode BinarySpacePartition a
b) (Maybe (Zipper Split) -> Maybe Int)
-> Maybe (Zipper Split) -> Maybe Int
forall a b. (a -> b) -> a -> b
$ BinarySpacePartition a -> Maybe (Zipper Split)
forall a. BinarySpacePartition a -> Maybe (Zipper Split)
makeZipper BinarySpacePartition a
b
  [Window]
wssel <- if NodeRef -> Int
refLeaf (BinarySpacePartition a -> NodeRef
forall a. BinarySpacePartition a -> NodeRef
getSelectedNode BinarySpacePartition a
b)Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/=(-Int
1)
           then Rectangle -> Maybe String -> X [Window]
createBorder (BinarySpacePartition a -> Rectangle -> NodeRef -> Rectangle
forall a.
BinarySpacePartition a -> Rectangle -> NodeRef -> Rectangle
getNodeRect BinarySpacePartition a
b Rectangle
r (BinarySpacePartition a -> NodeRef
forall a. BinarySpacePartition a -> NodeRef
getSelectedNode BinarySpacePartition a
b)) (Maybe String -> X [Window]) -> Maybe String -> X [Window]
forall a b. (a -> b) -> a -> b
$ String -> Maybe String
forall a. a -> Maybe a
Just String
"#00ff00"
           else [Window] -> X [Window]
forall a. a -> X a
forall (m :: * -> *) a. Monad m => a -> m a
return []
  let b' :: BinarySpacePartition a
b' = BinarySpacePartition a
b{getSelectedNode=(getSelectedNode b){refWins=wssel}}
  if NodeRef -> Int
refLeaf (BinarySpacePartition Any -> NodeRef
forall a. BinarySpacePartition a -> NodeRef
getFocusedNode BinarySpacePartition Any
forall a. BinarySpacePartition a
b')Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==(-Int
1) Bool -> Bool -> Bool
|| Maybe Int -> Bool
forall a. Maybe a -> Bool
isJust Maybe Int
l Bool -> Bool -> Bool
|| BinarySpacePartition Any -> Int
forall a. BinarySpacePartition a -> Int
size BinarySpacePartition Any
forall a. BinarySpacePartition a
b'Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<Int
2 then BinarySpacePartition a -> X (BinarySpacePartition a)
forall a. a -> X a
forall (m :: * -> *) a. Monad m => a -> m a
return BinarySpacePartition a
forall a. BinarySpacePartition a
b'
    else do
      [Window]
ws' <- Rectangle -> Maybe String -> X [Window]
createBorder (BinarySpacePartition Any -> Rectangle -> NodeRef -> Rectangle
forall a.
BinarySpacePartition a -> Rectangle -> NodeRef -> Rectangle
getNodeRect BinarySpacePartition Any
forall a. BinarySpacePartition a
b' Rectangle
r (BinarySpacePartition Any -> NodeRef
forall a. BinarySpacePartition a -> NodeRef
getFocusedNode BinarySpacePartition Any
forall a. BinarySpacePartition a
b')) Maybe String
forall a. Maybe a
Nothing
      BinarySpacePartition a -> X (BinarySpacePartition a)
forall a. a -> X a
forall (m :: * -> *) a. Monad m => a -> m a
return BinarySpacePartition Any
forall a. BinarySpacePartition a
b'{getFocusedNode=(getFocusedNode b'){refWins=ws'}}

-- create a window for each border line, show, add into stack and set floating
createBorder :: Rectangle -> Maybe String -> X [Window]
createBorder :: Rectangle -> Maybe String -> X [Window]
createBorder (Rectangle Position
wx Position
wy Dimension
ww Dimension
wh) Maybe String
c = do
  Dimension
bw <- (XConf -> Dimension) -> X Dimension
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (XConfig Layout -> Dimension
forall (l :: * -> *). XConfig l -> Dimension
borderWidth(XConfig Layout -> Dimension)
-> (XConf -> XConfig Layout) -> XConf -> Dimension
forall b c a. (b -> c) -> (a -> b) -> a -> c
.XConf -> XConfig Layout
config)
  String
bc <- case Maybe String
c of
         Maybe String
Nothing -> (XConf -> String) -> X String
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (XConfig Layout -> String
forall (l :: * -> *). XConfig l -> String
focusedBorderColor(XConfig Layout -> String)
-> (XConf -> XConfig Layout) -> XConf -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.XConf -> XConfig Layout
config)
         Just String
s -> String -> X String
forall a. a -> X a
forall (m :: * -> *) a. Monad m => a -> m a
return String
s
  let rects :: [Rectangle]
rects = [ Position -> Position -> Dimension -> Dimension -> Rectangle
Rectangle Position
wx Position
wy Dimension
ww (Dimension -> Dimension
forall a b. (Integral a, Num b) => a -> b
fi Dimension
bw)
              , Position -> Position -> Dimension -> Dimension -> Rectangle
Rectangle Position
wx Position
wy (Dimension -> Dimension
forall a b. (Integral a, Num b) => a -> b
fi Dimension
bw) Dimension
wh
              , Position -> Position -> Dimension -> Dimension -> Rectangle
Rectangle Position
wx (Position
wyPosition -> Position -> Position
forall a. Num a => a -> a -> a
+Dimension -> Position
forall a b. (Integral a, Num b) => a -> b
fi Dimension
whPosition -> Position -> Position
forall a. Num a => a -> a -> a
-Dimension -> Position
forall a b. (Integral a, Num b) => a -> b
fi Dimension
bw) Dimension
ww (Dimension -> Dimension
forall a b. (Integral a, Num b) => a -> b
fi Dimension
bw)
              , Position -> Position -> Dimension -> Dimension -> Rectangle
Rectangle (Position
wxPosition -> Position -> Position
forall a. Num a => a -> a -> a
+Dimension -> Position
forall a b. (Integral a, Num b) => a -> b
fi Dimension
wwPosition -> Position -> Position
forall a. Num a => a -> a -> a
-Dimension -> Position
forall a b. (Integral a, Num b) => a -> b
fi Dimension
bw) Position
wy (Dimension -> Dimension
forall a b. (Integral a, Num b) => a -> b
fi Dimension
bw) Dimension
wh
              ]
  [Window]
ws <- (Rectangle -> X Window) -> [Rectangle] -> X [Window]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (\Rectangle
r -> Rectangle -> Maybe Window -> String -> Bool -> X Window
createNewWindow Rectangle
r Maybe Window
forall a. Maybe a
Nothing String
bc Bool
False) [Rectangle]
rects
  [Window] -> X ()
showWindows [Window]
ws
  Maybe (Stack Window) -> X ()
replaceStack (Maybe (Stack Window) -> X ())
-> (Maybe (Stack Window) -> Maybe (Stack Window))
-> Maybe (Stack Window)
-> X ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe (Stack Window)
-> (Stack Window -> Maybe (Stack Window))
-> Maybe (Stack Window)
-> Maybe (Stack Window)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Maybe (Stack Window)
forall a. Maybe a
Nothing (\Stack Window
s -> Stack Window -> Maybe (Stack Window)
forall a. a -> Maybe a
Just Stack Window
s{W.down=W.down s ++ ws}) (Maybe (Stack Window) -> X ()) -> X (Maybe (Stack Window)) -> X ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< X (Maybe (Stack Window))
getStackSet
  Map Window RationalRect -> X ()
replaceFloating (Map Window RationalRect -> X ())
-> (XState -> Map Window RationalRect) -> XState -> X ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map Window RationalRect
-> Map Window RationalRect -> Map Window RationalRect
forall k a. Ord k => Map k a -> Map k a -> Map k a
M.union ([(Window, RationalRect)] -> Map Window RationalRect
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(Window, RationalRect)] -> Map Window RationalRect)
-> [(Window, RationalRect)] -> Map Window RationalRect
forall a b. (a -> b) -> a -> b
$ [Window] -> [RationalRect] -> [(Window, RationalRect)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Window]
ws ([RationalRect] -> [(Window, RationalRect)])
-> [RationalRect] -> [(Window, RationalRect)]
forall a b. (a -> b) -> a -> b
$ (Rectangle -> RationalRect) -> [Rectangle] -> [RationalRect]
forall a b. (a -> b) -> [a] -> [b]
map Rectangle -> RationalRect
toRR [Rectangle]
rects) (Map Window RationalRect -> Map Window RationalRect)
-> (XState -> Map Window RationalRect)
-> XState
-> Map Window RationalRect
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WindowSet -> Map Window RationalRect
forall i l a sid sd. StackSet i l a sid sd -> Map a RationalRect
W.floating (WindowSet -> Map Window RationalRect)
-> (XState -> WindowSet) -> XState -> Map Window RationalRect
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XState -> WindowSet
windowset (XState -> X ()) -> X XState -> X ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< X XState
forall s (m :: * -> *). MonadState s m => m s
get
  (XState -> XState) -> X ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\XState
s -> XState
s{mapped=mapped s `S.union` S.fromList ws})
  -- show <$> mapM isClient ws >>= debug
  [Window] -> X [Window]
forall a. a -> X a
forall (m :: * -> *) a. Monad m => a -> m a
return [Window]
ws
  where toRR :: Rectangle -> RationalRect
toRR (Rectangle Position
x Position
y Dimension
w Dimension
h) = Rational -> Rational -> Rational -> Rational -> RationalRect
W.RationalRect (Position -> Rational
forall a b. (Integral a, Num b) => a -> b
fi Position
x) (Position -> Rational
forall a b. (Integral a, Num b) => a -> b
fi Position
y) (Dimension -> Rational
forall a b. (Integral a, Num b) => a -> b
fi Dimension
w) (Dimension -> Rational
forall a b. (Integral a, Num b) => a -> b
fi Dimension
h)

-- remove border line windows from stack + floating, kill
removeBorder :: [Window] -> X ()
removeBorder :: [Window] -> X ()
removeBorder [Window]
ws = do
  (XState -> XState) -> X ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\XState
s -> XState
s{mapped = mapped s `S.difference` S.fromList ws})
  Map Window RationalRect -> X ()
replaceFloating (Map Window RationalRect -> X ())
-> (XState -> Map Window RationalRect) -> XState -> X ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map Window RationalRect -> [Window] -> Map Window RationalRect)
-> [Window] -> Map Window RationalRect -> Map Window RationalRect
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((Map Window RationalRect -> Window -> Map Window RationalRect)
-> Map Window RationalRect -> [Window] -> Map Window RationalRect
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl ((Window -> Map Window RationalRect -> Map Window RationalRect)
-> Map Window RationalRect -> Window -> Map Window RationalRect
forall a b c. (a -> b -> c) -> b -> a -> c
flip Window -> Map Window RationalRect -> Map Window RationalRect
forall k a. Ord k => k -> Map k a -> Map k a
M.delete)) [Window]
ws (Map Window RationalRect -> Map Window RationalRect)
-> (XState -> Map Window RationalRect)
-> XState
-> Map Window RationalRect
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WindowSet -> Map Window RationalRect
forall i l a sid sd. StackSet i l a sid sd -> Map a RationalRect
W.floating (WindowSet -> Map Window RationalRect)
-> (XState -> WindowSet) -> XState -> Map Window RationalRect
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XState -> WindowSet
windowset (XState -> X ()) -> X XState -> X ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< X XState
forall s (m :: * -> *). MonadState s m => m s
get
  Maybe (Stack Window) -> X ()
replaceStack (Maybe (Stack Window) -> X ())
-> (Maybe (Stack Window) -> Maybe (Stack Window))
-> Maybe (Stack Window)
-> X ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe (Stack Window)
-> (Stack Window -> Maybe (Stack Window))
-> Maybe (Stack Window)
-> Maybe (Stack Window)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Maybe (Stack Window)
forall a. Maybe a
Nothing (\Stack Window
s -> Stack Window -> Maybe (Stack Window)
forall a. a -> Maybe a
Just Stack Window
s{W.down=W.down s \\ ws}) (Maybe (Stack Window) -> X ()) -> X (Maybe (Stack Window)) -> X ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< X (Maybe (Stack Window))
getStackSet
  [Window] -> X ()
deleteWindows [Window]
ws