{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}

-- |
-- Module: XMonad.Layout.Columns
-- Description: A layout which tiles the windows in columns.
-- Copyright: Jean-Charles Quillet
-- License: BSD-style (see LICENSE)
--
-- Maintainer: none
-- Stability: unstable
-- Portability: unportable
--
-- A layout which tiles the windows in columns. The windows can be moved and
-- resized in every directions.
--
-- The first window appears in a single column in the center of the screen. Its
-- width is configurable (See 'coOneWindowWidth').
--
-- The second window appears in a second column. Starting with two columns, they
-- fill up the screen.
--
-- Subsequent windows appear on the bottom of the last columns.
module XMonad.Layout.Columns
  ( -- * Usage
    -- $usage
    ColumnsLayout (..),

    -- * Messages
    Focus (..),
    Move (..),
    Resize (..),

    -- * Tools
    focusDown,
    focusUp,
  )
where

import Control.Applicative ((<|>))
import Control.Arrow (Arrow (first), second)
import Control.Monad (guard)
import Control.Monad.State (modify)
import Control.Monad.Trans.Maybe (MaybeT (..))
import Data.Foldable (Foldable (..))
import Data.List (scanl')
import Data.Maybe (listToMaybe)
import Data.Ratio ((%))
import XMonad
  ( LayoutClass (..),
    Message,
    Rectangle (..),
    SomeMessage,
    Window,
    WindowSet,
    X,
    XState (..),
    fromMessage,
    gets,
    scaleRationalRect,
    sendMessage,
  )
import qualified XMonad.Operations as O
import XMonad.StackSet
  ( RationalRect (..),
    Screen (..),
    Stack (..),
    StackSet (..),
    integrate,
    peek,
  )
import qualified XMonad.StackSet as StackSet

-- $usage
-- Add 'Columns' to your @layoutHook@ with an initial empty state:
--
-- > myLayout = Full ||| Columns 1 []
--
-- Here is an example of keybindings:
--
-- > -- Focus up/down
-- > ((modm, xK_Tab), focusDown),
-- > ((modm .|. shiftMask, xK_Tab), focusUp),
-- > -- Move windows around
-- > ((modm .|. shiftMask, xK_l), sendMessage MoveRight),
-- > ((modm .|. shiftMask, xK_h), sendMessage MoveLeft),
-- > ((modm .|. shiftMask, xK_k), sendMessage MoveUp),
-- > ((modm .|. shiftMask, xK_j), sendMessage MoveDown),
-- > -- Resize them
-- > ((modm .|. controlMask, xK_l), sendMessage HorizontalExpand),
-- > ((modm .|. controlMask, xK_h), sendMessage HorizontalShrink),
-- > ((modm .|. controlMask, xK_k), sendMessage VerticalExpand),
-- > ((modm .|. controlMask, xK_j), sendMessage VerticalShrink),
--
-- This layout is known to work with:
--
-- * "XMonad.Layout.WindowNavigation" for changing focus with a direction using
-- 'XMonad.Layout.WindowNavigation.Go' messages.
-- * 'XMonad.Layout.SubLayouts.subTabbed' for docking windows together with
-- tabs. Note that sometimes when undocking windows, the layout is reset. This is
-- a minor annoyance caused by the difficulty to track windows in the sublayout.

-- | The windows can be moved in every directions.
--
-- Horizontally, a window alone in its column cannot be moved before the first
-- or after the last column. If not alone, moving the window outside those
-- limits will create a new column.
-- The windows can also be moved vertically in their column.
data Move = MoveLeft | MoveRight | MoveUp | MoveDown deriving (Int -> Move -> ShowS
[Move] -> ShowS
Move -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Move] -> ShowS
$cshowList :: [Move] -> ShowS
show :: Move -> String
$cshow :: Move -> String
showsPrec :: Int -> Move -> ShowS
$cshowsPrec :: Int -> Move -> ShowS
Show, ReadPrec [Move]
ReadPrec Move
Int -> ReadS Move
ReadS [Move]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Move]
$creadListPrec :: ReadPrec [Move]
readPrec :: ReadPrec Move
$creadPrec :: ReadPrec Move
readList :: ReadS [Move]
$creadList :: ReadS [Move]
readsPrec :: Int -> ReadS Move
$creadsPrec :: Int -> ReadS Move
Read)

instance Message Move

-- | The windows can be resized in every directions.
--
-- When resizing horizontally:
--
-- * if the window to be resized is not in the last column
--
--      * then the right side of the window will be moved
--      * the last column will compensate the size change
--
-- * if the window is in the last column
--
--      * then the left side of the window will be moved
--      * the column on the left of the current one will compensate the size change
--
-- The same applies when resizing vertically using the bottom side of the
-- window unless it is the last window in the column in which case we use the
-- top side.
data Resize
  = VerticalShrink
  | VerticalExpand
  | HorizontalShrink
  | HorizontalExpand
  deriving (Int -> Resize -> ShowS
[Resize] -> ShowS
Resize -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Resize] -> ShowS
$cshowList :: [Resize] -> ShowS
show :: Resize -> String
$cshow :: Resize -> String
showsPrec :: Int -> Resize -> ShowS
$cshowsPrec :: Int -> Resize -> ShowS
Show, ReadPrec [Resize]
ReadPrec Resize
Int -> ReadS Resize
ReadS [Resize]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Resize]
$creadListPrec :: ReadPrec [Resize]
readPrec :: ReadPrec Resize
$creadPrec :: ReadPrec Resize
readList :: ReadS [Resize]
$creadList :: ReadS [Resize]
readsPrec :: Int -> ReadS Resize
$creadsPrec :: Int -> ReadS Resize
Read)

instance Message Resize

-- | The layout handles focus change messages.
--
-- Built-in focus cannot be used here because @XMonad@ does not make it easy to
-- change the order of windows in the focus list. See also 'focusUp' and
-- 'focusDown' functions.
data Focus = FocusUp | FocusDown
  deriving (Int -> Focus -> ShowS
[Focus] -> ShowS
Focus -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Focus] -> ShowS
$cshowList :: [Focus] -> ShowS
show :: Focus -> String
$cshow :: Focus -> String
showsPrec :: Int -> Focus -> ShowS
$cshowsPrec :: Int -> Focus -> ShowS
Show, ReadPrec [Focus]
ReadPrec Focus
Int -> ReadS Focus
ReadS [Focus]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Focus]
$creadListPrec :: ReadPrec [Focus]
readPrec :: ReadPrec Focus
$creadPrec :: ReadPrec Focus
readList :: ReadS [Focus]
$creadList :: ReadS [Focus]
readsPrec :: Int -> ReadS Focus
$creadsPrec :: Int -> ReadS Focus
Read)

instance Message Focus

-- | A column is a list of windows with their relative vertical dimensions.
type Column = [(Rational, Window)]

-- | The layout is a list of 'Column' with their relative horizontal dimensions.
type Columns = [(Rational, Column)]

data ColumnsLayout a = Columns
  { -- | With of the first column when there is only one window. Usefull on wide
    -- screens.
    forall a. ColumnsLayout a -> Rational
coOneWindowWidth :: Rational,
    -- | The current state
    forall a. ColumnsLayout a -> Columns
coColumns :: Columns
  }
  deriving (Int -> ColumnsLayout a -> ShowS
forall a. Int -> ColumnsLayout a -> ShowS
forall a. [ColumnsLayout a] -> ShowS
forall a. ColumnsLayout a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ColumnsLayout a] -> ShowS
$cshowList :: forall a. [ColumnsLayout a] -> ShowS
show :: ColumnsLayout a -> String
$cshow :: forall a. ColumnsLayout a -> String
showsPrec :: Int -> ColumnsLayout a -> ShowS
$cshowsPrec :: forall a. Int -> ColumnsLayout a -> ShowS
Show, ReadPrec [ColumnsLayout a]
ReadPrec (ColumnsLayout a)
ReadS [ColumnsLayout a]
forall a. ReadPrec [ColumnsLayout a]
forall a. ReadPrec (ColumnsLayout a)
forall a. Int -> ReadS (ColumnsLayout a)
forall a. ReadS [ColumnsLayout a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ColumnsLayout a]
$creadListPrec :: forall a. ReadPrec [ColumnsLayout a]
readPrec :: ReadPrec (ColumnsLayout a)
$creadPrec :: forall a. ReadPrec (ColumnsLayout a)
readList :: ReadS [ColumnsLayout a]
$creadList :: forall a. ReadS [ColumnsLayout a]
readsPrec :: Int -> ReadS (ColumnsLayout a)
$creadsPrec :: forall a. Int -> ReadS (ColumnsLayout a)
Read)

instance LayoutClass ColumnsLayout Window where
  description :: ColumnsLayout Window -> String
description ColumnsLayout Window
_ = String
layoutDescription

  doLayout :: ColumnsLayout Window
-> Rectangle
-> Stack Window
-> X ([(Window, Rectangle)], Maybe (ColumnsLayout Window))
doLayout (Columns Rational
oneWindowWidth Columns
columns) Rectangle
rectangle Stack Window
stack =
    forall (f :: * -> *) a. Applicative f => a -> f a
pure ([(Window, Rectangle)]
rectangles, forall a. a -> Maybe a
Just (forall a. Rational -> Columns -> ColumnsLayout a
Columns Rational
oneWindowWidth Columns
columns'))
    where
      hackedColumns :: Columns
hackedColumns = Columns -> Stack Window -> Columns
hackForTabs Columns
columns Stack Window
stack
      columns' :: Columns
columns' = Columns -> Stack Window -> Columns
updateWindowList Columns
hackedColumns Stack Window
stack
      rectangles :: [(Window, Rectangle)]
rectangles = forall a.
Rectangle -> [(Rational, [(Rational, a)])] -> [(a, Rectangle)]
toRectangles Rectangle
rectangle' Columns
columns'
      -- If there is only one window, we set the destination rectangle according
      -- to the width in the layout setting.
      rectangle' :: Rectangle
rectangle'
        | (forall (t :: * -> *) a. Foldable t => t a -> Int
length forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> [a]
toList forall a b. (a -> b) -> a -> b
$ Stack Window
stack) forall a. Eq a => a -> a -> Bool
== Int
1 =
            Rectangle -> RationalRect -> Rectangle
scaleRationalRect Rectangle
rectangle RationalRect
singleColumnRR
        | Bool
otherwise = Rectangle
rectangle
      singleColumnOffset :: Rational
singleColumnOffset = (Rational
1 forall a. Num a => a -> a -> a
- Rational
oneWindowWidth) forall a. Fractional a => a -> a -> a
/ Rational
2
      singleColumnRR :: RationalRect
singleColumnRR = Rational -> Rational -> Rational -> Rational -> RationalRect
RationalRect Rational
singleColumnOffset Rational
0 Rational
oneWindowWidth Rational
1

  handleMessage :: ColumnsLayout Window
-> SomeMessage -> X (Maybe (ColumnsLayout Window))
handleMessage layout :: ColumnsLayout Window
layout@(Columns Rational
oneWindowWidth Columns
columns) SomeMessage
message = do
    Maybe (Stack Window)
mbStack <- forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT forall a b. (a -> b) -> a -> b
$ Stack Window -> MaybeT X (Stack Window)
handleFocus' forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< MaybeT X (Stack Window)
getStack
    Maybe (ColumnsLayout Window)
changedFocus <- forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall {m :: * -> *}.
MonadState XState m =>
Stack Window -> m (ColumnsLayout Window)
updateStack' Maybe (Stack Window)
mbStack

    Maybe (ColumnsLayout Window)
movedOrResized <-
      forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT forall a b. (a -> b) -> a -> b
$
        forall a. Rational -> Columns -> ColumnsLayout a
Columns Rational
oneWindowWidth
          forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Window -> MaybeT X Columns
handleMoveOrResize' forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< MaybeT X Window
peekFocus)

    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Maybe (ColumnsLayout Window)
movedOrResized forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe (ColumnsLayout Window)
changedFocus
    where
      getStack :: MaybeT X (Stack Window)
getStack = forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets forall a b. (a -> b) -> a -> b
$ forall i l a. Workspace i l a -> Maybe (Stack a)
StackSet.stack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
workspace forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
current forall b c a. (b -> c) -> (a -> b) -> a -> c
. XState -> WindowSet
windowset
      handleFocus' :: Stack Window -> MaybeT X (Stack Window)
handleFocus' = forall {a}. Maybe a -> MaybeT X a
hoistMaybe forall b c a. (b -> c) -> (a -> b) -> a -> c
. Columns -> SomeMessage -> Stack Window -> Maybe (Stack Window)
handleFocus Columns
columns SomeMessage
message
      -- A 'Just' needs to be return for the new stack to be taken into account
      updateStack' :: Stack Window -> m (ColumnsLayout Window)
updateStack' Stack Window
s = forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (Stack Window -> XState -> XState
setStack Stack Window
s) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (f :: * -> *) a. Applicative f => a -> f a
pure ColumnsLayout Window
layout
      peekFocus :: MaybeT X Window
peekFocus = forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets forall a b. (a -> b) -> a -> b
$ forall i l a s sd. StackSet i l a s sd -> Maybe a
peek forall b c a. (b -> c) -> (a -> b) -> a -> c
. XState -> WindowSet
windowset
      handleMoveOrResize' :: Window -> MaybeT X Columns
handleMoveOrResize' = forall {a}. Maybe a -> MaybeT X a
hoistMaybe forall b c a. (b -> c) -> (a -> b) -> a -> c
. Columns -> SomeMessage -> Window -> Maybe Columns
handleMoveOrResize Columns
columns SomeMessage
message
      hoistMaybe :: Maybe a -> MaybeT X a
hoistMaybe = forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Applicative f => a -> f a
pure

layoutDescription :: String
layoutDescription :: String
layoutDescription = String
"Columns"

-- | Change the keyboard focus to the previous window
focusUp :: X ()
focusUp :: X ()
focusUp =
  forall a.
Message a =>
a -> (WindowSet -> WindowSet) -> String -> X ()
sendMsgOrOnWindowsSet Focus
FocusUp forall i l a s sd. StackSet i l a s sd -> StackSet i l a s sd
StackSet.focusUp
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< X String
getCurrentLayoutDescription

-- | Change the keyboard focus to the next window
focusDown :: X ()
focusDown :: X ()
focusDown =
  forall a.
Message a =>
a -> (WindowSet -> WindowSet) -> String -> X ()
sendMsgOrOnWindowsSet Focus
FocusDown forall i l a s sd. StackSet i l a s sd -> StackSet i l a s sd
StackSet.focusDown
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< X String
getCurrentLayoutDescription

sendMsgOrOnWindowsSet :: (Message a) => a -> (WindowSet -> WindowSet) -> String -> X ()
sendMsgOrOnWindowsSet :: forall a.
Message a =>
a -> (WindowSet -> WindowSet) -> String -> X ()
sendMsgOrOnWindowsSet a
message WindowSet -> WindowSet
f String
description'
  | String
description' forall a. Eq a => a -> a -> Bool
== String
layoutDescription = forall a. Message a => a -> X ()
sendMessage a
message
  | Bool
otherwise = (WindowSet -> WindowSet) -> X ()
O.windows WindowSet -> WindowSet
f

getCurrentLayoutDescription :: X String
getCurrentLayoutDescription :: X String
getCurrentLayoutDescription =
  forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets
    ( forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> String
description
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a. Workspace i l a -> l
StackSet.layout
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
workspace
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
current
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. XState -> WindowSet
windowset
    )

setStack :: Stack Window -> XState -> XState
setStack :: Stack Window -> XState -> XState
setStack Stack Window
stack XState
state =
  XState
state
    { windowset :: WindowSet
windowset =
        (XState -> WindowSet
windowset XState
state)
          { current :: Screen String (Layout Window) Window ScreenId ScreenDetail
current =
              (forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
current forall a b. (a -> b) -> a -> b
$ XState -> WindowSet
windowset XState
state)
                { workspace :: Workspace String (Layout Window) Window
workspace =
                    (forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
workspace forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
current forall a b. (a -> b) -> a -> b
$ XState -> WindowSet
windowset XState
state)
                      { stack :: Maybe (Stack Window)
StackSet.stack = forall a. a -> Maybe a
Just Stack Window
stack
                      }
                }
          }
    }

handleFocus :: Columns -> SomeMessage -> Stack Window -> Maybe (Stack Window)
handleFocus :: Columns -> SomeMessage -> Stack Window -> Maybe (Stack Window)
handleFocus Columns
columns SomeMessage
message Stack Window
stack
  | Just Focus
FocusDown <- forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
message = Stack Window -> Window -> Stack Window
setFocus' Stack Window
stack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Window
mbNext
  | Just Focus
FocusUp <- forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
message = Stack Window -> Window -> Stack Window
setFocus' Stack Window
stack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Window
mbPrevious
  | Bool
otherwise = forall a. Maybe a
Nothing
  where
    focused :: Window
focused = forall a. Stack a -> a
focus Stack Window
stack
    windows :: [Window]
windows = Columns -> [Window]
columnsToWindows Columns
columns
    exists :: Bool
exists = Window
focused forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Window]
windows
    mbNext :: Maybe Window
mbNext = forall (f :: * -> *). Alternative f => Bool -> f ()
guard Bool
exists forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall {t}. Eq t => t -> [t] -> Maybe t
next Window
focused [Window]
windows
    mbPrevious :: Maybe Window
mbPrevious = forall (f :: * -> *). Alternative f => Bool -> f ()
guard Bool
exists forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall {t}. Eq t => t -> [t] -> Maybe t
previous Window
focused [Window]
windows
    setFocus' :: Stack Window -> Window -> Stack Window
setFocus' = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall {b}. Eq b => b -> Stack b -> Stack b
setFocus
    previous :: t -> [t] -> Maybe t
previous t
a = forall {t}. Eq t => t -> [t] -> Maybe t
next t
a forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
reverse
    setFocus :: b -> Stack b -> Stack b
setFocus b
w = forall a. (a -> Bool) -> (a -> a) -> a -> a
until (forall a. Eq a => a -> a -> Bool
(==) b
w forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Stack a -> a
focus) forall a. Stack a -> Stack a
StackSet.focusDown'
    next :: t -> [t] -> Maybe t
next t
_ [] = forall a. Maybe a
Nothing
    next t
a (t
x : [t]
xs)
      | t
a forall a. Eq a => a -> a -> Bool
== t
x = forall a. [a] -> Maybe a
listToMaybe [t]
xs
      | Bool
otherwise = t -> [t] -> Maybe t
next t
a ([t]
xs forall a. Semigroup a => a -> a -> a
<> [t
x])

oldNewWindows :: Columns -> Stack Window -> ([Window], [Window])
oldNewWindows :: Columns -> Stack Window -> ([Window], [Window])
oldNewWindows Columns
columns Stack Window
stack = ([Window]
old, [Window]
new)
  where
    old :: [Window]
old = forall a. (a -> Bool) -> [a] -> [a]
filter (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Window]
stackList) [Window]
windows
    new :: [Window]
new = forall a. (a -> Bool) -> [a] -> [a]
filter (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Window]
windows) [Window]
stackList
    stackList :: [Window]
stackList = forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Stack Window
stack
    windows :: [Window]
windows = Columns -> [Window]
columnsToWindows Columns
columns

-- | Add the new windows to the layout and remove the old ones.
updateWindowList :: Columns -> Stack Window -> Columns
updateWindowList :: Columns -> Stack Window -> Columns
updateWindowList Columns
columns Stack Window
stack = [Window] -> Columns -> Columns
addWindows [Window]
newWindows ([Window] -> Columns -> Columns
removeWindows [Window]
oldWindows Columns
columns)
  where
    ([Window]
oldWindows, [Window]
newWindows) = Columns -> Stack Window -> ([Window], [Window])
oldNewWindows Columns
columns Stack Window
stack

-- | If one window disappeared and another appeared, we assume that the sublayout
-- tabs just changed focused.
hackForTabs :: Columns -> Stack Window -> Columns
hackForTabs :: Columns -> Stack Window -> Columns
hackForTabs Columns
columns Stack Window
stack = (Window -> Window) -> Columns -> Columns
mapWindow Window -> Window
replace Columns
columns
  where
    replace :: Window -> Window
replace Window
window
      | (Window
w1 : [Window]
_, [Window
w2]) <- Columns -> Stack Window -> ([Window], [Window])
oldNewWindows Columns
columns Stack Window
stack =
          if Window
window forall a. Eq a => a -> a -> Bool
== Window
w1
            then Window
w2
            else Window
window
      | Bool
otherwise = Window
window

toRectangles :: Rectangle -> [(Rational, [(Rational, a)])] -> [(a, Rectangle)]
toRectangles :: forall a.
Rectangle -> [(Rational, [(Rational, a)])] -> [(a, Rectangle)]
toRectangles Rectangle
rectangle [(Rational, [(Rational, a)])]
columns =
  forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second (Rectangle -> RationalRect -> Rectangle
scaleRationalRect Rectangle
rectangle) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(a, RationalRect)]
windowsAndRectangles
  where
    offsetsAndRatios :: [(Rational, Rational, [(Rational, Rational, a)])]
offsetsAndRatios = forall a. [(Rational, a)] -> [(Rational, Rational, a)]
toOffsetRatio (forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second forall a. [(Rational, a)] -> [(Rational, Rational, a)]
toOffsetRatio forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Rational, [(Rational, a)])]
columns)
    windowsAndRectangles :: [(a, RationalRect)]
windowsAndRectangles = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap forall {f :: * -> *} {a}.
Functor f =>
(Rational, Rational, f (Rational, Rational, a))
-> f (a, RationalRect)
toWindowAndRectangle [(Rational, Rational, [(Rational, Rational, a)])]
offsetsAndRatios
    toWindowAndRectangle :: (Rational, Rational, f (Rational, Rational, a))
-> f (a, RationalRect)
toWindowAndRectangle (Rational
x, Rational
w, f (Rational, Rational, a)
cs) = (\(Rational
y, Rational
h, a
ws) -> (a
ws, Rational -> Rational -> Rational -> Rational -> RationalRect
RationalRect Rational
x Rational
y Rational
w Rational
h)) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f (Rational, Rational, a)
cs

onFocused :: (a -> a) -> Stack a -> Stack a
onFocused :: forall a. (a -> a) -> Stack a -> Stack a
onFocused a -> a
f (Stack a
a [a]
before [a]
after) = forall a. a -> [a] -> [a] -> Stack a
Stack (a -> a
f a
a) [a]
before [a]
after

onFocusedM :: (Monad m) => (a -> m a) -> Stack a -> m (Stack a)
onFocusedM :: forall (m :: * -> *) a.
Monad m =>
(a -> m a) -> Stack a -> m (Stack a)
onFocusedM a -> m a
f (Stack a
a [a]
before [a]
after) = forall a. a -> [a] -> [a] -> Stack a
Stack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> m a
f a
a forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure [a]
before forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure [a]
after

onFocusedOrPrevious :: (a -> a) -> Stack a -> Stack a
onFocusedOrPrevious :: forall a. (a -> a) -> Stack a -> Stack a
onFocusedOrPrevious a -> a
f (Stack a
a (a
a' : [a]
others) []) = forall a. a -> [a] -> [a] -> Stack a
Stack a
a (a -> a
f a
a' forall a. a -> [a] -> [a]
: [a]
others) []
onFocusedOrPrevious a -> a
f Stack a
stack = forall a. (a -> a) -> Stack a -> Stack a
onFocused a -> a
f Stack a
stack

handleMoveOrResize :: Columns -> SomeMessage -> Window -> Maybe Columns
handleMoveOrResize :: Columns -> SomeMessage -> Window -> Maybe Columns
handleMoveOrResize Columns
columns SomeMessage
message Window
window
  | Just Move
msg <- forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
message = Move -> Window -> Columns -> Maybe Columns
move Move
msg Window
window Columns
columns
  | Just Resize
HorizontalShrink <- forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
message =
      forall {a}.
((Rational, a) -> (Rational, a))
-> Stack (Rational, a) -> [(Rational, a)]
onFocusedOrPrevious' forall {d}. (Rational, d) -> (Rational, d)
shrink forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Window -> Columns -> Maybe (Stack (Rational, [(Rational, Window)]))
findInColumns Window
window Columns
columns
  | Just Resize
HorizontalExpand <- forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
message =
      forall {a}.
((Rational, a) -> (Rational, a))
-> Stack (Rational, a) -> [(Rational, a)]
onFocusedOrPrevious' forall {d}. (Rational, d) -> (Rational, d)
expand forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Window -> Columns -> Maybe (Stack (Rational, [(Rational, Window)]))
findInColumns Window
window Columns
columns
  | Just Resize
VerticalExpand <- forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
message =
      forall {f :: * -> *} {a} {d}.
Monad f =>
(a -> f a) -> Stack (d, a) -> f [(d, a)]
onFocusedM'
        (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall {a}.
((Rational, a) -> (Rational, a))
-> Stack (Rational, a) -> [(Rational, a)]
onFocusedOrPrevious' forall {d}. (Rational, d) -> (Rational, d)
shrink) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Window -> [(Rational, Window)] -> Maybe (Stack (Rational, Window))
findInColumn Window
window)
        forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Window -> Columns -> Maybe (Stack (Rational, [(Rational, Window)]))
findInColumns Window
window Columns
columns
  | Just Resize
VerticalShrink <- forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
message =
      forall {f :: * -> *} {a} {d}.
Monad f =>
(a -> f a) -> Stack (d, a) -> f [(d, a)]
onFocusedM'
        (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall {a}.
((Rational, a) -> (Rational, a))
-> Stack (Rational, a) -> [(Rational, a)]
onFocusedOrPrevious' forall {d}. (Rational, d) -> (Rational, d)
expand) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Window -> [(Rational, Window)] -> Maybe (Stack (Rational, Window))
findInColumn Window
window)
        forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Window -> Columns -> Maybe (Stack (Rational, [(Rational, Window)]))
findInColumns Window
window Columns
columns
  | Bool
otherwise = forall a. Maybe a
Nothing
  where
    expand :: (Rational, d) -> (Rational, d)
expand = forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. Num a => a -> a -> a
(+) (Rational
3 forall a. Fractional a => a -> a -> a
/ Rational
100)
    shrink :: (Rational, d) -> (Rational, d)
shrink = forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> b -> a -> c
flip (-) (Rational
3 forall a. Fractional a => a -> a -> a
/ Rational
100)
    onFocusedM' :: (a -> f a) -> Stack (d, a) -> f [(d, a)]
onFocusedM' a -> f a
f = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Stack a -> [a]
integrate forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a.
Monad m =>
(a -> m a) -> Stack a -> m (Stack a)
onFocusedM (forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second a -> f a
f)
    onFocusedOrPrevious' :: ((Rational, a) -> (Rational, a))
-> Stack (Rational, a) -> [(Rational, a)]
onFocusedOrPrevious' (Rational, a) -> (Rational, a)
f = forall a. [(Rational, a)] -> [(Rational, a)]
sanitize forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Stack a -> [a]
integrate forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> a) -> Stack a -> Stack a
onFocusedOrPrevious (Rational, a) -> (Rational, a)
f

move :: Move -> Window -> Columns -> Maybe Columns
move :: Move -> Window -> Columns -> Maybe Columns
move Move
direction Window
window Columns
columns =
  case (Move
direction, Window -> Columns -> Maybe (Stack (Rational, [(Rational, Window)]))
findInColumns Window
window Columns
columns) of
    (Move
MoveRight, Just (Stack (Rational
_, [(Rational
_, Window
_)]) Columns
_ [])) -> forall a. Maybe a
Nothing
    (Move
MoveLeft, Just (Stack (Rational
_, [(Rational
_, Window
_)]) [] Columns
_)) -> forall a. Maybe a
Nothing
    (Move
MoveRight, Just (Stack column :: (Rational, [(Rational, Window)])
column@(Rational
_, [(Rational
_, Window
_)]) Columns
before ((Rational, [(Rational, Window)])
next : Columns
others))) ->
      let ((Rational, [(Rational, Window)])
column', (Rational, [(Rational, Window)])
next') = Window
-> (Rational, [(Rational, Window)])
-> (Rational, [(Rational, Window)])
-> ((Rational, [(Rational, Window)]),
    (Rational, [(Rational, Window)]))
swapWindowBetween Window
window (Rational, [(Rational, Window)])
column (Rational, [(Rational, Window)])
next
       in forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Stack a -> [a]
integrate forall a b. (a -> b) -> a -> b
$ forall a. a -> [a] -> [a] -> Stack a
Stack (Rational, [(Rational, Window)])
column' Columns
before ((Rational, [(Rational, Window)])
next' forall a. a -> [a] -> [a]
: Columns
others)
    (Move
MoveLeft, Just (Stack column :: (Rational, [(Rational, Window)])
column@(Rational
_, [(Rational
_, Window
_)]) ((Rational, [(Rational, Window)])
previous : Columns
others) Columns
after)) ->
      let ((Rational, [(Rational, Window)])
column', (Rational, [(Rational, Window)])
previous') = Window
-> (Rational, [(Rational, Window)])
-> (Rational, [(Rational, Window)])
-> ((Rational, [(Rational, Window)]),
    (Rational, [(Rational, Window)]))
swapWindowBetween Window
window (Rational, [(Rational, Window)])
column (Rational, [(Rational, Window)])
previous
       in forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Stack a -> [a]
integrate forall a b. (a -> b) -> a -> b
$ forall a. a -> [a] -> [a] -> Stack a
Stack (Rational, [(Rational, Window)])
column' ((Rational, [(Rational, Window)])
previous' forall a. a -> [a] -> [a]
: Columns
others) Columns
after
    (Move
MoveRight, Just Stack (Rational, [(Rational, Window)])
stack) ->
      let (Columns
newColumns', Stack (Rational, [(Rational, Window)])
column Columns
before Columns
after) = forall (f :: * -> *) a.
(Functor f, Foldable f) =>
[a] -> f (Rational, a) -> ([(Rational, a)], f (Rational, a))
rationalize [[(Rational, Window)]]
newColumns Stack (Rational, [(Rational, Window)])
stack
          windows :: (Rational, [(Rational, Window)])
windows = Window
-> (Rational, [(Rational, Window)])
-> (Rational, [(Rational, Window)])
removeWindow Window
window (Rational, [(Rational, Window)])
column
       in forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Stack a -> [a]
integrate forall a b. (a -> b) -> a -> b
$ forall a. a -> [a] -> [a] -> Stack a
Stack (Rational, [(Rational, Window)])
windows Columns
before (Columns
newColumns' forall a. Semigroup a => a -> a -> a
<> Columns
after)
    (Move
MoveLeft, Just Stack (Rational, [(Rational, Window)])
stack) ->
      let (Columns
newColumns', Stack (Rational, [(Rational, Window)])
column Columns
before Columns
after) = forall (f :: * -> *) a.
(Functor f, Foldable f) =>
[a] -> f (Rational, a) -> ([(Rational, a)], f (Rational, a))
rationalize [[(Rational, Window)]]
newColumns Stack (Rational, [(Rational, Window)])
stack
          windows :: (Rational, [(Rational, Window)])
windows = Window
-> (Rational, [(Rational, Window)])
-> (Rational, [(Rational, Window)])
removeWindow Window
window (Rational, [(Rational, Window)])
column
       in forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Stack a -> [a]
integrate forall a b. (a -> b) -> a -> b
$ forall a. a -> [a] -> [a] -> Stack a
Stack (Rational, [(Rational, Window)])
windows (Columns
newColumns' forall a. Semigroup a => a -> a -> a
<> Columns
before) Columns
after
    (Move
MoveUp, Just Stack (Rational, [(Rational, Window)])
stack) -> forall a. Stack a -> [a]
integrate forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a.
Monad m =>
(a -> m a) -> Stack a -> m (Stack a)
onFocusedM (Window
-> (Rational, [(Rational, Window)])
-> Maybe (Rational, [(Rational, Window)])
swapWindowUp Window
window) Stack (Rational, [(Rational, Window)])
stack
    (Move
MoveDown, Just Stack (Rational, [(Rational, Window)])
stack) -> forall a. Stack a -> [a]
integrate forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a.
Monad m =>
(a -> m a) -> Stack a -> m (Stack a)
onFocusedM (Window
-> (Rational, [(Rational, Window)])
-> Maybe (Rational, [(Rational, Window)])
swapWindowDown Window
window) Stack (Rational, [(Rational, Window)])
stack
    (Move, Maybe (Stack (Rational, [(Rational, Window)])))
_ -> forall a. Maybe a
Nothing
  where
    newColumns :: [[(Rational, Window)]]
newColumns = [[(Rational
1, Window
window)]]

mapWindow :: (Window -> Window) -> Columns -> Columns
mapWindow :: (Window -> Window) -> Columns -> Columns
mapWindow = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap

columnsToWindows :: Columns -> [Window]
columnsToWindows :: Columns -> [Window]
columnsToWindows = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ((forall a. a -> [a] -> [a]
: []) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap forall a b. (a, b) -> b
snd

swapWindowBetween ::
  Window ->
  (Rational, Column) ->
  (Rational, Column) ->
  ((Rational, Column), (Rational, Column))
swapWindowBetween :: Window
-> (Rational, [(Rational, Window)])
-> (Rational, [(Rational, Window)])
-> ((Rational, [(Rational, Window)]),
    (Rational, [(Rational, Window)]))
swapWindowBetween Window
window (Rational, [(Rational, Window)])
from (Rational, [(Rational, Window)])
to = ((Rational, [(Rational, Window)])
removed, (Rational, [(Rational, Window)])
added)
  where
    removed :: (Rational, [(Rational, Window)])
removed = Window
-> (Rational, [(Rational, Window)])
-> (Rational, [(Rational, Window)])
removeWindow Window
window (Rational, [(Rational, Window)])
from
    added :: (Rational, [(Rational, Window)])
added = [Window]
-> (Rational, [(Rational, Window)])
-> (Rational, [(Rational, Window)])
appendWindows [Window
window] (Rational, [(Rational, Window)])
to

swapWindowUp :: Window -> (Rational, Column) -> Maybe (Rational, Column)
swapWindowUp :: Window
-> (Rational, [(Rational, Window)])
-> Maybe (Rational, [(Rational, Window)])
swapWindowUp Window
window (Rational
width, [(Rational, Window)]
column)
  | Just (Stack (Rational
height, Window
_) ((Rational, Window)
previous : [(Rational, Window)]
before') [(Rational, Window)]
after) <- Window -> [(Rational, Window)] -> Maybe (Stack (Rational, Window))
findInColumn Window
window [(Rational, Window)]
column =
      forall a. a -> Maybe a
Just (Rational
width, forall a. Stack a -> [a]
integrate forall a b. (a -> b) -> a -> b
$ forall a. a -> [a] -> [a] -> Stack a
Stack (Rational, Window)
previous ((Rational
height, Window
window) forall a. a -> [a] -> [a]
: [(Rational, Window)]
before') [(Rational, Window)]
after)
  | Bool
otherwise = forall a. Maybe a
Nothing

swapWindowDown :: Window -> (Rational, Column) -> Maybe (Rational, Column)
swapWindowDown :: Window
-> (Rational, [(Rational, Window)])
-> Maybe (Rational, [(Rational, Window)])
swapWindowDown Window
window (Rational
width, [(Rational, Window)]
column)
  | Just (Stack (Rational
height, Window
_) [(Rational, Window)]
before ((Rational, Window)
next : [(Rational, Window)]
others)) <- Window -> [(Rational, Window)] -> Maybe (Stack (Rational, Window))
findInColumn Window
window [(Rational, Window)]
column =
      forall a. a -> Maybe a
Just (Rational
width, forall a. Stack a -> [a]
integrate forall a b. (a -> b) -> a -> b
$ forall a. a -> [a] -> [a] -> Stack a
Stack (Rational, Window)
next [(Rational, Window)]
before ((Rational
height, Window
window) forall a. a -> [a] -> [a]
: [(Rational, Window)]
others))
  | Bool
otherwise = forall a. Maybe a
Nothing

-- | Adjust the ratio of a list or a stack of elts so that when adding new
--  elements:
-- - the new elements are distributed according to the total number of elements
-- - the existing elements keep their proportion in the remaining space
rationalize ::
  (Functor f, Foldable f) =>
  [a] ->
  f (Rational, a) ->
  ([(Rational, a)], f (Rational, a))
rationalize :: forall (f :: * -> *) a.
(Functor f, Foldable f) =>
[a] -> f (Rational, a) -> ([(Rational, a)], f (Rational, a))
rationalize [a]
new f (Rational, a)
existing = ([(Rational, a)]
new', f (Rational, a)
existing')
  where
    nbNew :: Integer
nbNew = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
new
    nbInColumn :: Integer
nbInColumn = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
length f (Rational, a)
existing
    newRatio :: Rational
newRatio = Integer
nbNew forall a. Integral a => a -> a -> Ratio a
% (Integer
nbNew forall a. Num a => a -> a -> a
+ Integer
nbInColumn)
    existingRatio :: Rational
existingRatio = Rational
1 forall a. Num a => a -> a -> a
- Rational
newRatio
    new' :: [(Rational, a)]
new' = forall a. Rational -> [a] -> [(Rational, a)]
fitElements Rational
newRatio [a]
new
    existing' :: f (Rational, a)
existing' = forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first (forall a. Num a => a -> a -> a
* Rational
existingRatio) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f (Rational, a)
existing

append :: [a] -> [(Rational, a)] -> [(Rational, a)]
append :: forall a. [a] -> [(Rational, a)] -> [(Rational, a)]
append [a]
new [(Rational, a)]
existing = forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. Monoid a => a -> a -> a
mappend) (forall (f :: * -> *) a.
(Functor f, Foldable f) =>
[a] -> f (Rational, a) -> ([(Rational, a)], f (Rational, a))
rationalize [a]
new [(Rational, a)]
existing)

appendWindows ::
  [Window] ->
  (Rational, [(Rational, Window)]) ->
  (Rational, [(Rational, Window)])
appendWindows :: [Window]
-> (Rational, [(Rational, Window)])
-> (Rational, [(Rational, Window)])
appendWindows [Window]
windows = forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second (forall a. [a] -> [(Rational, a)] -> [(Rational, a)]
append [Window]
windows)

fitElements :: Rational -> [a] -> [(Rational, a)]
fitElements :: forall a. Rational -> [a] -> [(Rational, a)]
fitElements Rational
dimension [a]
elts = (Rational
dimension',) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [a]
elts
  where
    dimension' :: Rational
dimension' = Rational
dimension forall a. Fractional a => a -> a -> a
/ forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
elts)

singleColumn :: Rational -> Rational -> [Window] -> Columns
singleColumn :: Rational -> Rational -> [Window] -> Columns
singleColumn Rational
width Rational
height [Window]
windows = [(Rational
width, forall a. Rational -> [a] -> [(Rational, a)]
fitElements Rational
height [Window]
windows)]

findElement' :: (a -> Bool) -> [(Rational, a)] -> Maybe (Stack (Rational, a))
findElement' :: forall a.
(a -> Bool) -> [(Rational, a)] -> Maybe (Stack (Rational, a))
findElement' a -> Bool
predicate [(Rational, a)]
list
  | ([(Rational, a)]
before, (Rational, a)
c : [(Rational, a)]
after) <- forall a. (a -> Bool) -> [a] -> ([a], [a])
break (a -> Bool
predicate forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) [(Rational, a)]
list =
      forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. a -> [a] -> [a] -> Stack a
Stack (Rational, a)
c (forall a. [a] -> [a]
reverse [(Rational, a)]
before) [(Rational, a)]
after
  | Bool
otherwise = forall a. Maybe a
Nothing

findInColumns :: Window -> Columns -> Maybe (Stack (Rational, Column))
findInColumns :: Window -> Columns -> Maybe (Stack (Rational, [(Rational, Window)]))
findInColumns Window
window = forall a.
(a -> Bool) -> [(Rational, a)] -> Maybe (Stack (Rational, a))
findElement' (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((forall a. Eq a => a -> a -> Bool
== Window
window) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd))

findInColumn :: Window -> Column -> Maybe (Stack (Rational, Window))
findInColumn :: Window -> [(Rational, Window)] -> Maybe (Stack (Rational, Window))
findInColumn Window
window = forall a.
(a -> Bool) -> [(Rational, a)] -> Maybe (Stack (Rational, a))
findElement' (forall a. Eq a => a -> a -> Bool
== Window
window)

removeWindows :: [Window] -> Columns -> Columns
removeWindows :: [Window] -> Columns -> Columns
removeWindows [Window]
windows = forall {a}. [(Rational, [a])] -> [(Rational, [a])]
removeEmptyColumns forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second [(Rational, Window)] -> [(Rational, Window)]
removeWindows')
  where
    inWindows :: (a, Window) -> Bool
inWindows (a
_, Window
window) = Window
window forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Window]
windows
    removeWindows' :: [(Rational, Window)] -> [(Rational, Window)]
removeWindows' = forall a. [(Rational, a)] -> [(Rational, a)]
normalize forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter forall {a}. (a, Window) -> Bool
inWindows
    removeEmptyColumns :: [(Rational, [a])] -> [(Rational, [a])]
removeEmptyColumns = forall a. [(Rational, a)] -> [(Rational, a)]
normalize forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Bool
null forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd)

removeWindow :: Window -> (Rational, Column) -> (Rational, Column)
removeWindow :: Window
-> (Rational, [(Rational, Window)])
-> (Rational, [(Rational, Window)])
removeWindow Window
window = forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second (forall a. [(Rational, a)] -> [(Rational, a)]
normalize forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter ((forall a. Eq a => a -> a -> Bool
/= Window
window) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd))

addWindows :: [Window] -> Columns -> Columns
addWindows :: [Window] -> Columns -> Columns
addWindows [] Columns
columns = Columns
columns
-- When there is only one column, create a new one on the right
addWindows [Window]
windows [(Rational
_, [(Rational, Window)]
windows')] = (Integer
1 forall a. Integral a => a -> a -> Ratio a
% Integer
2, [(Rational, Window)]
windows') forall a. a -> [a] -> [a]
: Rational -> Rational -> [Window] -> Columns
singleColumn (Integer
1 forall a. Integral a => a -> a -> Ratio a
% Integer
2) Rational
1 [Window]
windows
-- When there is more, append the windows to the last column
addWindows [Window]
windows Columns
columns
  | Just (Columns
columns', (Rational, [(Rational, Window)])
column) <- forall a. [a] -> Maybe ([a], a)
unsnoc Columns
columns =
      Columns -> Columns
sanitizeColumns forall a b. (a -> b) -> a -> b
$ Columns
columns' forall a. Semigroup a => a -> a -> a
<> [[Window]
-> (Rational, [(Rational, Window)])
-> (Rational, [(Rational, Window)])
appendWindows [Window]
windows (Rational, [(Rational, Window)])
column]
  | Bool
otherwise = Rational -> Rational -> [Window] -> Columns
singleColumn Rational
1 Rational
1 [Window]
windows

-- | Make sure the sum of all dimensions is 1
normalize :: [(Rational, a)] -> [(Rational, a)]
normalize :: forall a. [(Rational, a)] -> [(Rational, a)]
normalize [(Rational, a)]
elts = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first (forall a. Fractional a => a -> a -> a
/ Rational
total)) [(Rational, a)]
elts
  where
    total :: Rational
total = forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum (forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Rational, a)]
elts)

-- | Update the last dimension so that the sum of all dimensions is 1
sanitize :: [(Rational, a)] -> [(Rational, a)]
sanitize :: forall a. [(Rational, a)] -> [(Rational, a)]
sanitize [(Rational, a)]
list
  | Just ([(Rational, a)]
elts, (Rational
_, a
a)) <- forall a. [a] -> Maybe ([a], a)
unsnoc [(Rational, a)]
list = [(Rational, a)]
elts forall a. Semigroup a => a -> a -> a
<> [(Rational
1 forall a. Num a => a -> a -> a
- forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum (forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Rational, a)]
elts), a
a)]
  | Bool
otherwise = []

-- | Same on the whole layout
sanitizeColumns :: Columns -> Columns
sanitizeColumns :: Columns -> Columns
sanitizeColumns = forall a. [(Rational, a)] -> [(Rational, a)]
sanitize forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second forall a. [(Rational, a)] -> [(Rational, a)]
sanitize)

toOffsetRatio :: [(Rational, a)] -> [(Rational, Rational, a)]
toOffsetRatio :: forall a. [(Rational, a)] -> [(Rational, Rational, a)]
toOffsetRatio [(Rational, a)]
ra = forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith forall {b} {c} {a}. (b, c) -> a -> (a, b, c)
toTruple [(Rational, a)]
ra [Rational]
positions
  where
    toTruple :: (b, c) -> a -> (a, b, c)
toTruple (b
dimension, c
a) a
position = (a
position, b
dimension, c
a)
    positions :: [Rational]
positions = forall b a. (b -> a -> b) -> b -> [a] -> [b]
scanl' (\Rational
position (Rational
dimension, a
_) -> Rational
position forall a. Num a => a -> a -> a
+ Rational
dimension) Rational
0 [(Rational, a)]
ra

unsnoc :: [a] -> Maybe ([a], a)
unsnoc :: forall a. [a] -> Maybe ([a], a)
unsnoc [] = forall a. Maybe a
Nothing
unsnoc (a
x : [a]
xs)
  | Just ([a]
is, a
l) <- forall a. [a] -> Maybe ([a], a)
unsnoc [a]
xs = forall a. a -> Maybe a
Just (a
x forall a. a -> [a] -> [a]
: [a]
is, a
l)
  | Bool
otherwise = forall a. a -> Maybe a
Just ([], a
x)