{-# 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
(Int -> Move -> ShowS)
-> (Move -> String) -> ([Move] -> ShowS) -> Show Move
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Move -> ShowS
showsPrec :: Int -> Move -> ShowS
$cshow :: Move -> String
show :: Move -> String
$cshowList :: [Move] -> ShowS
showList :: [Move] -> ShowS
Show, ReadPrec [Move]
ReadPrec Move
Int -> ReadS Move
ReadS [Move]
(Int -> ReadS Move)
-> ReadS [Move] -> ReadPrec Move -> ReadPrec [Move] -> Read Move
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Move
readsPrec :: Int -> ReadS Move
$creadList :: ReadS [Move]
readList :: ReadS [Move]
$creadPrec :: ReadPrec Move
readPrec :: ReadPrec Move
$creadListPrec :: ReadPrec [Move]
readListPrec :: ReadPrec [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
(Int -> Resize -> ShowS)
-> (Resize -> String) -> ([Resize] -> ShowS) -> Show Resize
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Resize -> ShowS
showsPrec :: Int -> Resize -> ShowS
$cshow :: Resize -> String
show :: Resize -> String
$cshowList :: [Resize] -> ShowS
showList :: [Resize] -> ShowS
Show, ReadPrec [Resize]
ReadPrec Resize
Int -> ReadS Resize
ReadS [Resize]
(Int -> ReadS Resize)
-> ReadS [Resize]
-> ReadPrec Resize
-> ReadPrec [Resize]
-> Read Resize
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Resize
readsPrec :: Int -> ReadS Resize
$creadList :: ReadS [Resize]
readList :: ReadS [Resize]
$creadPrec :: ReadPrec Resize
readPrec :: ReadPrec Resize
$creadListPrec :: ReadPrec [Resize]
readListPrec :: ReadPrec [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
(Int -> Focus -> ShowS)
-> (Focus -> String) -> ([Focus] -> ShowS) -> Show Focus
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Focus -> ShowS
showsPrec :: Int -> Focus -> ShowS
$cshow :: Focus -> String
show :: Focus -> String
$cshowList :: [Focus] -> ShowS
showList :: [Focus] -> ShowS
Show, ReadPrec [Focus]
ReadPrec Focus
Int -> ReadS Focus
ReadS [Focus]
(Int -> ReadS Focus)
-> ReadS [Focus]
-> ReadPrec Focus
-> ReadPrec [Focus]
-> Read Focus
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Focus
readsPrec :: Int -> ReadS Focus
$creadList :: ReadS [Focus]
readList :: ReadS [Focus]
$creadPrec :: ReadPrec Focus
readPrec :: ReadPrec Focus
$creadListPrec :: ReadPrec [Focus]
readListPrec :: ReadPrec [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
[ColumnsLayout a] -> ShowS
ColumnsLayout a -> String
(Int -> ColumnsLayout a -> ShowS)
-> (ColumnsLayout a -> String)
-> ([ColumnsLayout a] -> ShowS)
-> Show (ColumnsLayout a)
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
$cshowsPrec :: forall a. Int -> ColumnsLayout a -> ShowS
showsPrec :: Int -> ColumnsLayout a -> ShowS
$cshow :: forall a. ColumnsLayout a -> String
show :: ColumnsLayout a -> String
$cshowList :: forall a. [ColumnsLayout a] -> ShowS
showList :: [ColumnsLayout a] -> ShowS
Show, ReadPrec [ColumnsLayout a]
ReadPrec (ColumnsLayout a)
Int -> ReadS (ColumnsLayout a)
ReadS [ColumnsLayout a]
(Int -> ReadS (ColumnsLayout a))
-> ReadS [ColumnsLayout a]
-> ReadPrec (ColumnsLayout a)
-> ReadPrec [ColumnsLayout a]
-> Read (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
$creadsPrec :: forall a. Int -> ReadS (ColumnsLayout a)
readsPrec :: Int -> ReadS (ColumnsLayout a)
$creadList :: forall a. ReadS [ColumnsLayout a]
readList :: ReadS [ColumnsLayout a]
$creadPrec :: forall a. ReadPrec (ColumnsLayout a)
readPrec :: ReadPrec (ColumnsLayout a)
$creadListPrec :: forall a. ReadPrec [ColumnsLayout a]
readListPrec :: ReadPrec [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 =
    ([(Window, Rectangle)], Maybe (ColumnsLayout Window))
-> X ([(Window, Rectangle)], Maybe (ColumnsLayout Window))
forall a. a -> X a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([(Window, Rectangle)]
rectangles, ColumnsLayout Window -> Maybe (ColumnsLayout Window)
forall a. a -> Maybe a
Just (Rational -> Columns -> ColumnsLayout Window
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 = Rectangle -> Columns -> [(Window, Rectangle)]
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'
        | ([Window] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Window] -> Int)
-> (Stack Window -> [Window]) -> Stack Window -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stack Window -> [Window]
forall a. Stack a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Stack Window -> Int) -> Stack Window -> Int
forall a b. (a -> b) -> a -> b
$ Stack Window
stack) Int -> Int -> Bool
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 Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
- Rational
oneWindowWidth) Rational -> Rational -> Rational
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 <- MaybeT X (Stack Window) -> X (Maybe (Stack Window))
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT X (Stack Window) -> X (Maybe (Stack Window)))
-> MaybeT X (Stack Window) -> X (Maybe (Stack Window))
forall a b. (a -> b) -> a -> b
$ Stack Window -> MaybeT X (Stack Window)
handleFocus' (Stack Window -> MaybeT X (Stack Window))
-> MaybeT X (Stack Window) -> MaybeT X (Stack Window)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< MaybeT X (Stack Window)
getStack
    Maybe (ColumnsLayout Window)
changedFocus <- (Stack Window -> X (ColumnsLayout Window))
-> Maybe (Stack Window) -> X (Maybe (ColumnsLayout Window))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Maybe a -> f (Maybe b)
traverse Stack Window -> X (ColumnsLayout Window)
forall {m :: * -> *}.
MonadState XState m =>
Stack Window -> m (ColumnsLayout Window)
updateStack' Maybe (Stack Window)
mbStack

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

    Maybe (ColumnsLayout Window) -> X (Maybe (ColumnsLayout Window))
forall a. a -> X a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (ColumnsLayout Window) -> X (Maybe (ColumnsLayout Window)))
-> Maybe (ColumnsLayout Window) -> X (Maybe (ColumnsLayout Window))
forall a b. (a -> b) -> a -> b
$ Maybe (ColumnsLayout Window)
movedOrResized Maybe (ColumnsLayout Window)
-> Maybe (ColumnsLayout Window) -> Maybe (ColumnsLayout Window)
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe (ColumnsLayout Window)
changedFocus
    where
      getStack :: MaybeT X (Stack Window)
getStack = X (Maybe (Stack Window)) -> MaybeT X (Stack Window)
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (X (Maybe (Stack Window)) -> MaybeT X (Stack Window))
-> ((XState -> Maybe (Stack Window)) -> X (Maybe (Stack Window)))
-> (XState -> Maybe (Stack Window))
-> MaybeT X (Stack Window)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (XState -> Maybe (Stack Window)) -> X (Maybe (Stack Window))
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ((XState -> Maybe (Stack Window)) -> MaybeT X (Stack Window))
-> (XState -> Maybe (Stack Window)) -> MaybeT X (Stack Window)
forall a b. (a -> b) -> a -> b
$ Workspace String (Layout Window) Window -> Maybe (Stack Window)
forall i l a. Workspace i l a -> Maybe (Stack a)
StackSet.stack (Workspace String (Layout Window) Window -> Maybe (Stack Window))
-> (XState -> Workspace String (Layout Window) Window)
-> XState
-> 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
workspace (Screen String (Layout Window) Window ScreenId ScreenDetail
 -> Workspace String (Layout Window) Window)
-> (XState
    -> Screen String (Layout Window) Window ScreenId ScreenDetail)
-> XState
-> Workspace String (Layout Window) Window
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StackSet String (Layout Window) Window ScreenId ScreenDetail
-> Screen String (Layout Window) Window ScreenId ScreenDetail
forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
current (StackSet String (Layout Window) Window ScreenId ScreenDetail
 -> Screen String (Layout Window) Window ScreenId ScreenDetail)
-> (XState
    -> StackSet String (Layout Window) Window ScreenId ScreenDetail)
-> XState
-> Screen String (Layout Window) Window ScreenId ScreenDetail
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XState
-> StackSet String (Layout Window) Window ScreenId ScreenDetail
windowset
      handleFocus' :: Stack Window -> MaybeT X (Stack Window)
handleFocus' = Maybe (Stack Window) -> MaybeT X (Stack Window)
forall {a}. Maybe a -> MaybeT X a
hoistMaybe (Maybe (Stack Window) -> MaybeT X (Stack Window))
-> (Stack Window -> Maybe (Stack Window))
-> Stack Window
-> MaybeT X (Stack Window)
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 = (XState -> XState) -> m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (Stack Window -> XState -> XState
setStack Stack Window
s) m () -> m (ColumnsLayout Window) -> m (ColumnsLayout Window)
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ColumnsLayout Window -> m (ColumnsLayout Window)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ColumnsLayout Window
layout
      peekFocus :: MaybeT X Window
peekFocus = X (Maybe Window) -> MaybeT X Window
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (X (Maybe Window) -> MaybeT X Window)
-> ((XState -> Maybe Window) -> X (Maybe Window))
-> (XState -> Maybe Window)
-> MaybeT X Window
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (XState -> Maybe Window) -> X (Maybe Window)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ((XState -> Maybe Window) -> MaybeT X Window)
-> (XState -> Maybe Window) -> MaybeT X Window
forall a b. (a -> b) -> a -> b
$ StackSet String (Layout Window) Window ScreenId ScreenDetail
-> Maybe Window
forall i l a s sd. StackSet i l a s sd -> Maybe a
peek (StackSet String (Layout Window) Window ScreenId ScreenDetail
 -> Maybe Window)
-> (XState
    -> StackSet String (Layout Window) Window ScreenId ScreenDetail)
-> XState
-> Maybe Window
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XState
-> StackSet String (Layout Window) Window ScreenId ScreenDetail
windowset
      handleMoveOrResize' :: Window -> MaybeT X Columns
handleMoveOrResize' = Maybe Columns -> MaybeT X Columns
forall {a}. Maybe a -> MaybeT X a
hoistMaybe (Maybe Columns -> MaybeT X Columns)
-> (Window -> Maybe Columns) -> Window -> MaybeT X Columns
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 = X (Maybe a) -> MaybeT X a
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (X (Maybe a) -> MaybeT X a)
-> (Maybe a -> X (Maybe a)) -> Maybe a -> MaybeT X a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe a -> X (Maybe a)
forall a. a -> X a
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 =
  Focus
-> (StackSet String (Layout Window) Window ScreenId ScreenDetail
    -> StackSet String (Layout Window) Window ScreenId ScreenDetail)
-> String
-> X ()
forall a.
Message a =>
a
-> (StackSet String (Layout Window) Window ScreenId ScreenDetail
    -> StackSet String (Layout Window) Window ScreenId ScreenDetail)
-> String
-> X ()
sendMsgOrOnWindowsSet Focus
FocusUp StackSet String (Layout Window) Window ScreenId ScreenDetail
-> StackSet String (Layout Window) Window ScreenId ScreenDetail
forall i l a s sd. StackSet i l a s sd -> StackSet i l a s sd
StackSet.focusUp
    (String -> X ()) -> X String -> X ()
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 =
  Focus
-> (StackSet String (Layout Window) Window ScreenId ScreenDetail
    -> StackSet String (Layout Window) Window ScreenId ScreenDetail)
-> String
-> X ()
forall a.
Message a =>
a
-> (StackSet String (Layout Window) Window ScreenId ScreenDetail
    -> StackSet String (Layout Window) Window ScreenId ScreenDetail)
-> String
-> X ()
sendMsgOrOnWindowsSet Focus
FocusDown StackSet String (Layout Window) Window ScreenId ScreenDetail
-> StackSet String (Layout Window) Window ScreenId ScreenDetail
forall i l a s sd. StackSet i l a s sd -> StackSet i l a s sd
StackSet.focusDown
    (String -> X ()) -> X String -> X ()
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
-> (StackSet String (Layout Window) Window ScreenId ScreenDetail
    -> StackSet String (Layout Window) Window ScreenId ScreenDetail)
-> String
-> X ()
sendMsgOrOnWindowsSet a
message StackSet String (Layout Window) Window ScreenId ScreenDetail
-> StackSet String (Layout Window) Window ScreenId ScreenDetail
f String
description'
  | String
description' String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
layoutDescription = a -> X ()
forall a. Message a => a -> X ()
sendMessage a
message
  | Bool
otherwise = (StackSet String (Layout Window) Window ScreenId ScreenDetail
 -> StackSet String (Layout Window) Window ScreenId ScreenDetail)
-> X ()
O.windows StackSet String (Layout Window) Window ScreenId ScreenDetail
-> StackSet String (Layout Window) Window ScreenId ScreenDetail
f

getCurrentLayoutDescription :: X String
getCurrentLayoutDescription :: X String
getCurrentLayoutDescription =
  (XState -> String) -> X String
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets
    ( Layout Window -> String
forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> String
description
        (Layout Window -> String)
-> (XState -> Layout Window) -> XState -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Workspace String (Layout Window) Window -> Layout Window
forall i l a. Workspace i l a -> l
StackSet.layout
        (Workspace String (Layout Window) Window -> Layout Window)
-> (XState -> Workspace String (Layout Window) Window)
-> XState
-> Layout 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
workspace
        (Screen String (Layout Window) Window ScreenId ScreenDetail
 -> Workspace String (Layout Window) Window)
-> (XState
    -> Screen String (Layout Window) Window ScreenId ScreenDetail)
-> XState
-> Workspace String (Layout Window) Window
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StackSet String (Layout Window) Window ScreenId ScreenDetail
-> Screen String (Layout Window) Window ScreenId ScreenDetail
forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
current
        (StackSet String (Layout Window) Window ScreenId ScreenDetail
 -> Screen String (Layout Window) Window ScreenId ScreenDetail)
-> (XState
    -> StackSet String (Layout Window) Window ScreenId ScreenDetail)
-> XState
-> Screen String (Layout Window) Window ScreenId ScreenDetail
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XState
-> StackSet String (Layout Window) Window ScreenId ScreenDetail
windowset
    )

setStack :: Stack Window -> XState -> XState
setStack :: Stack Window -> XState -> XState
setStack Stack Window
stack XState
state =
  XState
state
    { windowset =
        (windowset state)
          { current =
              (current $ windowset state)
                { workspace =
                    (workspace . current $ windowset state)
                      { StackSet.stack = Just 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 <- SomeMessage -> Maybe Focus
forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
message = Stack Window -> Window -> Stack Window
setFocus' Stack Window
stack (Window -> Stack Window) -> Maybe Window -> Maybe (Stack Window)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Window
mbNext
  | Just Focus
FocusUp <- SomeMessage -> Maybe Focus
forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
message = Stack Window -> Window -> Stack Window
setFocus' Stack Window
stack (Window -> Stack Window) -> Maybe Window -> Maybe (Stack Window)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Window
mbPrevious
  | Bool
otherwise = Maybe (Stack Window)
forall a. Maybe a
Nothing
  where
    focused :: Window
focused = Stack Window -> Window
forall a. Stack a -> a
focus Stack Window
stack
    windows :: [Window]
windows = Columns -> [Window]
columnsToWindows Columns
columns
    exists :: Bool
exists = Window
focused Window -> [Window] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Window]
windows
    mbNext :: Maybe Window
mbNext = Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard Bool
exists Maybe () -> Maybe Window -> Maybe Window
forall a b. Maybe a -> Maybe b -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Window -> [Window] -> Maybe Window
forall {t}. Eq t => t -> [t] -> Maybe t
next Window
focused [Window]
windows
    mbPrevious :: Maybe Window
mbPrevious = Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard Bool
exists Maybe () -> Maybe Window -> Maybe Window
forall a b. Maybe a -> Maybe b -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Window -> [Window] -> Maybe Window
forall {t}. Eq t => t -> [t] -> Maybe t
previous Window
focused [Window]
windows
    setFocus' :: Stack Window -> Window -> Stack Window
setFocus' = (Window -> Stack Window -> Stack Window)
-> Stack Window -> Window -> Stack Window
forall a b c. (a -> b -> c) -> b -> a -> c
flip Window -> Stack Window -> Stack Window
forall {b}. Eq b => b -> Stack b -> Stack b
setFocus
    previous :: t -> [t] -> Maybe t
previous t
a = t -> [t] -> Maybe t
forall {t}. Eq t => t -> [t] -> Maybe t
next t
a ([t] -> Maybe t) -> ([t] -> [t]) -> [t] -> Maybe t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [t] -> [t]
forall a. [a] -> [a]
reverse
    setFocus :: b -> Stack b -> Stack b
setFocus b
w = (Stack b -> Bool) -> (Stack b -> Stack b) -> Stack b -> Stack b
forall a. (a -> Bool) -> (a -> a) -> a -> a
until (b -> b -> Bool
forall a. Eq a => a -> a -> Bool
(==) b
w (b -> Bool) -> (Stack b -> b) -> Stack b -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stack b -> b
forall a. Stack a -> a
focus) Stack b -> Stack b
forall a. Stack a -> Stack a
StackSet.focusDown'
    next :: t -> [t] -> Maybe t
next t
_ [] = Maybe t
forall a. Maybe a
Nothing
    next t
a (t
x : [t]
xs)
      | t
a t -> t -> Bool
forall a. Eq a => a -> a -> Bool
== t
x = [t] -> Maybe t
forall a. [a] -> Maybe a
listToMaybe [t]
xs
      | Bool
otherwise = t -> [t] -> Maybe t
next t
a ([t]
xs [t] -> [t] -> [t]
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 = (Window -> Bool) -> [Window] -> [Window]
forall a. (a -> Bool) -> [a] -> [a]
filter (Window -> [Window] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Window]
stackList) [Window]
windows
    new :: [Window]
new = (Window -> Bool) -> [Window] -> [Window]
forall a. (a -> Bool) -> [a] -> [a]
filter (Window -> [Window] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Window]
windows) [Window]
stackList
    stackList :: [Window]
stackList = Stack Window -> [Window]
forall a. Stack a -> [a]
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 Window -> Window -> Bool
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 =
  (RationalRect -> Rectangle) -> (a, RationalRect) -> (a, Rectangle)
forall b c d. (b -> c) -> (d, b) -> (d, c)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second (Rectangle -> RationalRect -> Rectangle
scaleRationalRect Rectangle
rectangle) ((a, RationalRect) -> (a, Rectangle))
-> [(a, RationalRect)] -> [(a, Rectangle)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(a, RationalRect)]
windowsAndRectangles
  where
    offsetsAndRatios :: [(Rational, Rational, [(Rational, Rational, a)])]
offsetsAndRatios = [(Rational, [(Rational, Rational, a)])]
-> [(Rational, Rational, [(Rational, Rational, a)])]
forall a. [(Rational, a)] -> [(Rational, Rational, a)]
toOffsetRatio (([(Rational, a)] -> [(Rational, Rational, a)])
-> (Rational, [(Rational, a)])
-> (Rational, [(Rational, Rational, a)])
forall b c d. (b -> c) -> (d, b) -> (d, c)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second [(Rational, a)] -> [(Rational, Rational, a)]
forall a. [(Rational, a)] -> [(Rational, Rational, a)]
toOffsetRatio ((Rational, [(Rational, a)])
 -> (Rational, [(Rational, Rational, a)]))
-> [(Rational, [(Rational, a)])]
-> [(Rational, [(Rational, Rational, a)])]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Rational, [(Rational, a)])]
columns)
    windowsAndRectangles :: [(a, RationalRect)]
windowsAndRectangles = ((Rational, Rational, [(Rational, Rational, a)])
 -> [(a, RationalRect)])
-> [(Rational, Rational, [(Rational, Rational, a)])]
-> [(a, RationalRect)]
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Rational, Rational, [(Rational, Rational, a)])
-> [(a, RationalRect)]
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)) ((Rational, Rational, a) -> (a, RationalRect))
-> f (Rational, Rational, a) -> f (a, RationalRect)
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) = a -> [a] -> [a] -> Stack a
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) = a -> [a] -> [a] -> Stack a
forall a. a -> [a] -> [a] -> Stack a
Stack (a -> [a] -> [a] -> Stack a) -> m a -> m ([a] -> [a] -> Stack a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> m a
f a
a m ([a] -> [a] -> Stack a) -> m [a] -> m ([a] -> Stack a)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [a] -> m [a]
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [a]
before m ([a] -> Stack a) -> m [a] -> m (Stack a)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [a] -> m [a]
forall a. a -> m a
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) []) = a -> [a] -> [a] -> Stack a
forall a. a -> [a] -> [a] -> Stack a
Stack a
a (a -> a
f a
a' a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
others) []
onFocusedOrPrevious a -> a
f Stack a
stack = (a -> a) -> Stack a -> Stack a
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 <- SomeMessage -> Maybe Move
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 <- SomeMessage -> Maybe Resize
forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
message =
      ((Rational, [(Rational, Window)])
 -> (Rational, [(Rational, Window)]))
-> Stack (Rational, [(Rational, Window)]) -> Columns
forall {a}.
((Rational, a) -> (Rational, a))
-> Stack (Rational, a) -> [(Rational, a)]
onFocusedOrPrevious' (Rational, [(Rational, Window)])
-> (Rational, [(Rational, Window)])
forall {d}. (Rational, d) -> (Rational, d)
shrink (Stack (Rational, [(Rational, Window)]) -> Columns)
-> Maybe (Stack (Rational, [(Rational, Window)])) -> Maybe Columns
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 <- SomeMessage -> Maybe Resize
forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
message =
      ((Rational, [(Rational, Window)])
 -> (Rational, [(Rational, Window)]))
-> Stack (Rational, [(Rational, Window)]) -> Columns
forall {a}.
((Rational, a) -> (Rational, a))
-> Stack (Rational, a) -> [(Rational, a)]
onFocusedOrPrevious' (Rational, [(Rational, Window)])
-> (Rational, [(Rational, Window)])
forall {d}. (Rational, d) -> (Rational, d)
expand (Stack (Rational, [(Rational, Window)]) -> Columns)
-> Maybe (Stack (Rational, [(Rational, Window)])) -> Maybe Columns
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 <- SomeMessage -> Maybe Resize
forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
message =
      ([(Rational, Window)] -> Maybe [(Rational, Window)])
-> Stack (Rational, [(Rational, Window)]) -> Maybe Columns
forall {f :: * -> *} {a} {d}.
Monad f =>
(a -> f a) -> Stack (d, a) -> f [(d, a)]
onFocusedM'
        ((Stack (Rational, Window) -> [(Rational, Window)])
-> Maybe (Stack (Rational, Window)) -> Maybe [(Rational, Window)]
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((Rational, Window) -> (Rational, Window))
-> Stack (Rational, Window) -> [(Rational, Window)]
forall {a}.
((Rational, a) -> (Rational, a))
-> Stack (Rational, a) -> [(Rational, a)]
onFocusedOrPrevious' (Rational, Window) -> (Rational, Window)
forall {d}. (Rational, d) -> (Rational, d)
shrink) (Maybe (Stack (Rational, Window)) -> Maybe [(Rational, Window)])
-> ([(Rational, Window)] -> Maybe (Stack (Rational, Window)))
-> [(Rational, Window)]
-> Maybe [(Rational, Window)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Window -> [(Rational, Window)] -> Maybe (Stack (Rational, Window))
findInColumn Window
window)
        (Stack (Rational, [(Rational, Window)]) -> Maybe Columns)
-> Maybe (Stack (Rational, [(Rational, Window)])) -> Maybe Columns
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 <- SomeMessage -> Maybe Resize
forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
message =
      ([(Rational, Window)] -> Maybe [(Rational, Window)])
-> Stack (Rational, [(Rational, Window)]) -> Maybe Columns
forall {f :: * -> *} {a} {d}.
Monad f =>
(a -> f a) -> Stack (d, a) -> f [(d, a)]
onFocusedM'
        ((Stack (Rational, Window) -> [(Rational, Window)])
-> Maybe (Stack (Rational, Window)) -> Maybe [(Rational, Window)]
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((Rational, Window) -> (Rational, Window))
-> Stack (Rational, Window) -> [(Rational, Window)]
forall {a}.
((Rational, a) -> (Rational, a))
-> Stack (Rational, a) -> [(Rational, a)]
onFocusedOrPrevious' (Rational, Window) -> (Rational, Window)
forall {d}. (Rational, d) -> (Rational, d)
expand) (Maybe (Stack (Rational, Window)) -> Maybe [(Rational, Window)])
-> ([(Rational, Window)] -> Maybe (Stack (Rational, Window)))
-> [(Rational, Window)]
-> Maybe [(Rational, Window)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Window -> [(Rational, Window)] -> Maybe (Stack (Rational, Window))
findInColumn Window
window)
        (Stack (Rational, [(Rational, Window)]) -> Maybe Columns)
-> Maybe (Stack (Rational, [(Rational, Window)])) -> Maybe Columns
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 = Maybe Columns
forall a. Maybe a
Nothing
  where
    expand :: (Rational, d) -> (Rational, d)
expand = (Rational -> Rational) -> (Rational, d) -> (Rational, d)
forall b c d. (b -> c) -> (b, d) -> (c, d)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first ((Rational -> Rational) -> (Rational, d) -> (Rational, d))
-> (Rational -> Rational) -> (Rational, d) -> (Rational, d)
forall a b. (a -> b) -> a -> b
$ (Rational -> Rational -> Rational)
-> Rational -> Rational -> Rational
forall a b c. (a -> b -> c) -> b -> a -> c
flip Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
(+) (Rational
3 Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/ Rational
100)
    shrink :: (Rational, d) -> (Rational, d)
shrink = (Rational -> Rational) -> (Rational, d) -> (Rational, d)
forall b c d. (b -> c) -> (b, d) -> (c, d)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first ((Rational -> Rational) -> (Rational, d) -> (Rational, d))
-> (Rational -> Rational) -> (Rational, d) -> (Rational, d)
forall a b. (a -> b) -> a -> b
$ (Rational -> Rational -> Rational)
-> Rational -> Rational -> Rational
forall a b c. (a -> b -> c) -> b -> a -> c
flip (-) (Rational
3 Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/ Rational
100)
    onFocusedM' :: (a -> f a) -> Stack (d, a) -> f [(d, a)]
onFocusedM' a -> f a
f = (Stack (d, a) -> [(d, a)]) -> f (Stack (d, a)) -> f [(d, a)]
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Stack (d, a) -> [(d, a)]
forall a. Stack a -> [a]
integrate (f (Stack (d, a)) -> f [(d, a)])
-> (Stack (d, a) -> f (Stack (d, a))) -> Stack (d, a) -> f [(d, a)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((d, a) -> f (d, a)) -> Stack (d, a) -> f (Stack (d, a))
forall (m :: * -> *) a.
Monad m =>
(a -> m a) -> Stack a -> m (Stack a)
onFocusedM ((d, f a) -> f (d, a)
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => (d, m a) -> m (d, a)
sequence ((d, f a) -> f (d, a))
-> ((d, a) -> (d, f a)) -> (d, a) -> f (d, a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> f a) -> (d, a) -> (d, f a)
forall b c d. (b -> c) -> (d, b) -> (d, 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 = [(Rational, a)] -> [(Rational, a)]
forall a. [(Rational, a)] -> [(Rational, a)]
sanitize ([(Rational, a)] -> [(Rational, a)])
-> (Stack (Rational, a) -> [(Rational, a)])
-> Stack (Rational, a)
-> [(Rational, a)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stack (Rational, a) -> [(Rational, a)]
forall a. Stack a -> [a]
integrate (Stack (Rational, a) -> [(Rational, a)])
-> (Stack (Rational, a) -> Stack (Rational, a))
-> Stack (Rational, a)
-> [(Rational, a)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Rational, a) -> (Rational, a))
-> Stack (Rational, a) -> Stack (Rational, a)
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
_ [])) -> Maybe Columns
forall a. Maybe a
Nothing
    (Move
MoveLeft, Just (Stack (Rational
_, [(Rational
_, Window
_)]) [] Columns
_)) -> Maybe 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 Columns -> Maybe Columns
forall a. a -> Maybe a
Just (Columns -> Maybe Columns)
-> (Stack (Rational, [(Rational, Window)]) -> Columns)
-> Stack (Rational, [(Rational, Window)])
-> Maybe Columns
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stack (Rational, [(Rational, Window)]) -> Columns
forall a. Stack a -> [a]
integrate (Stack (Rational, [(Rational, Window)]) -> Maybe Columns)
-> Stack (Rational, [(Rational, Window)]) -> Maybe Columns
forall a b. (a -> b) -> a -> b
$ (Rational, [(Rational, Window)])
-> Columns -> Columns -> Stack (Rational, [(Rational, Window)])
forall a. a -> [a] -> [a] -> Stack a
Stack (Rational, [(Rational, Window)])
column' Columns
before ((Rational, [(Rational, Window)])
next' (Rational, [(Rational, Window)]) -> Columns -> Columns
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 Columns -> Maybe Columns
forall a. a -> Maybe a
Just (Columns -> Maybe Columns)
-> (Stack (Rational, [(Rational, Window)]) -> Columns)
-> Stack (Rational, [(Rational, Window)])
-> Maybe Columns
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stack (Rational, [(Rational, Window)]) -> Columns
forall a. Stack a -> [a]
integrate (Stack (Rational, [(Rational, Window)]) -> Maybe Columns)
-> Stack (Rational, [(Rational, Window)]) -> Maybe Columns
forall a b. (a -> b) -> a -> b
$ (Rational, [(Rational, Window)])
-> Columns -> Columns -> Stack (Rational, [(Rational, Window)])
forall a. a -> [a] -> [a] -> Stack a
Stack (Rational, [(Rational, Window)])
column' ((Rational, [(Rational, Window)])
previous' (Rational, [(Rational, Window)]) -> Columns -> Columns
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) = [[(Rational, Window)]]
-> Stack (Rational, [(Rational, Window)])
-> (Columns, Stack (Rational, [(Rational, Window)]))
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 Columns -> Maybe Columns
forall a. a -> Maybe a
Just (Columns -> Maybe Columns)
-> (Stack (Rational, [(Rational, Window)]) -> Columns)
-> Stack (Rational, [(Rational, Window)])
-> Maybe Columns
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stack (Rational, [(Rational, Window)]) -> Columns
forall a. Stack a -> [a]
integrate (Stack (Rational, [(Rational, Window)]) -> Maybe Columns)
-> Stack (Rational, [(Rational, Window)]) -> Maybe Columns
forall a b. (a -> b) -> a -> b
$ (Rational, [(Rational, Window)])
-> Columns -> Columns -> Stack (Rational, [(Rational, Window)])
forall a. a -> [a] -> [a] -> Stack a
Stack (Rational, [(Rational, Window)])
windows Columns
before (Columns
newColumns' Columns -> Columns -> Columns
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) = [[(Rational, Window)]]
-> Stack (Rational, [(Rational, Window)])
-> (Columns, Stack (Rational, [(Rational, Window)]))
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 Columns -> Maybe Columns
forall a. a -> Maybe a
Just (Columns -> Maybe Columns)
-> (Stack (Rational, [(Rational, Window)]) -> Columns)
-> Stack (Rational, [(Rational, Window)])
-> Maybe Columns
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stack (Rational, [(Rational, Window)]) -> Columns
forall a. Stack a -> [a]
integrate (Stack (Rational, [(Rational, Window)]) -> Maybe Columns)
-> Stack (Rational, [(Rational, Window)]) -> Maybe Columns
forall a b. (a -> b) -> a -> b
$ (Rational, [(Rational, Window)])
-> Columns -> Columns -> Stack (Rational, [(Rational, Window)])
forall a. a -> [a] -> [a] -> Stack a
Stack (Rational, [(Rational, Window)])
windows (Columns
newColumns' Columns -> Columns -> Columns
forall a. Semigroup a => a -> a -> a
<> Columns
before) Columns
after
    (Move
MoveUp, Just Stack (Rational, [(Rational, Window)])
stack) -> Stack (Rational, [(Rational, Window)]) -> Columns
forall a. Stack a -> [a]
integrate (Stack (Rational, [(Rational, Window)]) -> Columns)
-> Maybe (Stack (Rational, [(Rational, Window)])) -> Maybe Columns
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Rational, [(Rational, Window)])
 -> Maybe (Rational, [(Rational, Window)]))
-> Stack (Rational, [(Rational, Window)])
-> Maybe (Stack (Rational, [(Rational, Window)]))
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) -> Stack (Rational, [(Rational, Window)]) -> Columns
forall a. Stack a -> [a]
integrate (Stack (Rational, [(Rational, Window)]) -> Columns)
-> Maybe (Stack (Rational, [(Rational, Window)])) -> Maybe Columns
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Rational, [(Rational, Window)])
 -> Maybe (Rational, [(Rational, Window)]))
-> Stack (Rational, [(Rational, Window)])
-> Maybe (Stack (Rational, [(Rational, Window)]))
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)])))
_ -> Maybe Columns
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 = ((Rational, [(Rational, Window)])
 -> (Rational, [(Rational, Window)]))
-> Columns -> Columns
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((Rational, [(Rational, Window)])
  -> (Rational, [(Rational, Window)]))
 -> Columns -> Columns)
-> ((Window -> Window)
    -> (Rational, [(Rational, Window)])
    -> (Rational, [(Rational, Window)]))
-> (Window -> Window)
-> Columns
-> Columns
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([(Rational, Window)] -> [(Rational, Window)])
-> (Rational, [(Rational, Window)])
-> (Rational, [(Rational, Window)])
forall a b. (a -> b) -> (Rational, a) -> (Rational, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (([(Rational, Window)] -> [(Rational, Window)])
 -> (Rational, [(Rational, Window)])
 -> (Rational, [(Rational, Window)]))
-> ((Window -> Window)
    -> [(Rational, Window)] -> [(Rational, Window)])
-> (Window -> Window)
-> (Rational, [(Rational, Window)])
-> (Rational, [(Rational, Window)])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Rational, Window) -> (Rational, Window))
-> [(Rational, Window)] -> [(Rational, Window)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((Rational, Window) -> (Rational, Window))
 -> [(Rational, Window)] -> [(Rational, Window)])
-> ((Window -> Window) -> (Rational, Window) -> (Rational, Window))
-> (Window -> Window)
-> [(Rational, Window)]
-> [(Rational, Window)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Window -> Window) -> (Rational, Window) -> (Rational, Window)
forall a b. (a -> b) -> (Rational, a) -> (Rational, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap

columnsToWindows :: Columns -> [Window]
columnsToWindows :: Columns -> [Window]
columnsToWindows = ((Rational, Window) -> [Window])
-> [(Rational, Window)] -> [Window]
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ((Window -> [Window] -> [Window]
forall a. a -> [a] -> [a]
: []) (Window -> [Window])
-> ((Rational, Window) -> Window) -> (Rational, Window) -> [Window]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Rational, Window) -> Window
forall a b. (a, b) -> b
snd) ([(Rational, Window)] -> [Window])
-> (Columns -> [(Rational, Window)]) -> Columns -> [Window]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Rational, [(Rational, Window)]) -> [(Rational, Window)])
-> Columns -> [(Rational, Window)]
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Rational, [(Rational, Window)]) -> [(Rational, Window)]
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 =
      (Rational, [(Rational, Window)])
-> Maybe (Rational, [(Rational, Window)])
forall a. a -> Maybe a
Just (Rational
width, Stack (Rational, Window) -> [(Rational, Window)]
forall a. Stack a -> [a]
integrate (Stack (Rational, Window) -> [(Rational, Window)])
-> Stack (Rational, Window) -> [(Rational, Window)]
forall a b. (a -> b) -> a -> b
$ (Rational, Window)
-> [(Rational, Window)]
-> [(Rational, Window)]
-> Stack (Rational, Window)
forall a. a -> [a] -> [a] -> Stack a
Stack (Rational, Window)
previous ((Rational
height, Window
window) (Rational, Window) -> [(Rational, Window)] -> [(Rational, Window)]
forall a. a -> [a] -> [a]
: [(Rational, Window)]
before') [(Rational, Window)]
after)
  | Bool
otherwise = Maybe (Rational, [(Rational, Window)])
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 =
      (Rational, [(Rational, Window)])
-> Maybe (Rational, [(Rational, Window)])
forall a. a -> Maybe a
Just (Rational
width, Stack (Rational, Window) -> [(Rational, Window)]
forall a. Stack a -> [a]
integrate (Stack (Rational, Window) -> [(Rational, Window)])
-> Stack (Rational, Window) -> [(Rational, Window)]
forall a b. (a -> b) -> a -> b
$ (Rational, Window)
-> [(Rational, Window)]
-> [(Rational, Window)]
-> Stack (Rational, Window)
forall a. a -> [a] -> [a] -> Stack a
Stack (Rational, Window)
next [(Rational, Window)]
before ((Rational
height, Window
window) (Rational, Window) -> [(Rational, Window)] -> [(Rational, Window)]
forall a. a -> [a] -> [a]
: [(Rational, Window)]
others))
  | Bool
otherwise = Maybe (Rational, [(Rational, Window)])
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 = Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Integer) -> Int -> Integer
forall a b. (a -> b) -> a -> b
$ [a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
new
    nbInColumn :: Integer
nbInColumn = Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Integer) -> Int -> Integer
forall a b. (a -> b) -> a -> b
$ f (Rational, a) -> Int
forall a. f a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length f (Rational, a)
existing
    newRatio :: Rational
newRatio = Integer
nbNew Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% (Integer
nbNew Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
nbInColumn)
    existingRatio :: Rational
existingRatio = Rational
1 Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
- Rational
newRatio
    new' :: [(Rational, a)]
new' = Rational -> [a] -> [(Rational, a)]
forall a. Rational -> [a] -> [(Rational, a)]
fitElements Rational
newRatio [a]
new
    existing' :: f (Rational, a)
existing' = (Rational -> Rational) -> (Rational, a) -> (Rational, a)
forall b c d. (b -> c) -> (b, d) -> (c, d)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first (Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* Rational
existingRatio) ((Rational, a) -> (Rational, a))
-> f (Rational, a) -> f (Rational, a)
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 = ([(Rational, a)] -> [(Rational, a)] -> [(Rational, a)])
-> ([(Rational, a)], [(Rational, a)]) -> [(Rational, a)]
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (([(Rational, a)] -> [(Rational, a)] -> [(Rational, a)])
-> [(Rational, a)] -> [(Rational, a)] -> [(Rational, a)]
forall a b c. (a -> b -> c) -> b -> a -> c
flip [(Rational, a)] -> [(Rational, a)] -> [(Rational, a)]
forall a. Monoid a => a -> a -> a
mappend) ([a] -> [(Rational, a)] -> ([(Rational, a)], [(Rational, a)])
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 = ([(Rational, Window)] -> [(Rational, Window)])
-> (Rational, [(Rational, Window)])
-> (Rational, [(Rational, Window)])
forall b c d. (b -> c) -> (d, b) -> (d, c)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second ([Window] -> [(Rational, Window)] -> [(Rational, Window)]
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',) (a -> (Rational, a)) -> [a] -> [(Rational, a)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [a]
elts
  where
    dimension' :: Rational
dimension' = Rational
dimension Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/ Int -> Rational
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([a] -> Int
forall a. [a] -> Int
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, Rational -> [Window] -> [(Rational, Window)]
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) <- ((Rational, a) -> Bool)
-> [(Rational, a)] -> ([(Rational, a)], [(Rational, a)])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (a -> Bool
predicate (a -> Bool) -> ((Rational, a) -> a) -> (Rational, a) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Rational, a) -> a
forall a b. (a, b) -> b
snd) [(Rational, a)]
list =
      Stack (Rational, a) -> Maybe (Stack (Rational, a))
forall a. a -> Maybe a
Just (Stack (Rational, a) -> Maybe (Stack (Rational, a)))
-> Stack (Rational, a) -> Maybe (Stack (Rational, a))
forall a b. (a -> b) -> a -> b
$ (Rational, a)
-> [(Rational, a)] -> [(Rational, a)] -> Stack (Rational, a)
forall a. a -> [a] -> [a] -> Stack a
Stack (Rational, a)
c ([(Rational, a)] -> [(Rational, a)]
forall a. [a] -> [a]
reverse [(Rational, a)]
before) [(Rational, a)]
after
  | Bool
otherwise = Maybe (Stack (Rational, a))
forall a. Maybe a
Nothing

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

removeWindows :: [Window] -> Columns -> Columns
removeWindows :: [Window] -> Columns -> Columns
removeWindows [Window]
windows = Columns -> Columns
forall {a}. [(Rational, [a])] -> [(Rational, [a])]
removeEmptyColumns (Columns -> Columns) -> (Columns -> Columns) -> Columns -> Columns
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Rational, [(Rational, Window)])
 -> (Rational, [(Rational, Window)]))
-> Columns -> Columns
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (([(Rational, Window)] -> [(Rational, Window)])
-> (Rational, [(Rational, Window)])
-> (Rational, [(Rational, Window)])
forall b c d. (b -> c) -> (d, b) -> (d, c)
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 Window -> [Window] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Window]
windows
    removeWindows' :: [(Rational, Window)] -> [(Rational, Window)]
removeWindows' = [(Rational, Window)] -> [(Rational, Window)]
forall a. [(Rational, a)] -> [(Rational, a)]
normalize ([(Rational, Window)] -> [(Rational, Window)])
-> ([(Rational, Window)] -> [(Rational, Window)])
-> [(Rational, Window)]
-> [(Rational, Window)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Rational, Window) -> Bool)
-> [(Rational, Window)] -> [(Rational, Window)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Rational, Window) -> Bool
forall {a}. (a, Window) -> Bool
inWindows
    removeEmptyColumns :: [(Rational, [a])] -> [(Rational, [a])]
removeEmptyColumns = [(Rational, [a])] -> [(Rational, [a])]
forall a. [(Rational, a)] -> [(Rational, a)]
normalize ([(Rational, [a])] -> [(Rational, [a])])
-> ([(Rational, [a])] -> [(Rational, [a])])
-> [(Rational, [a])]
-> [(Rational, [a])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Rational, [a]) -> Bool) -> [(Rational, [a])] -> [(Rational, [a])]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool)
-> ((Rational, [a]) -> Bool) -> (Rational, [a]) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([a] -> Bool)
-> ((Rational, [a]) -> [a]) -> (Rational, [a]) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Rational, [a]) -> [a]
forall a b. (a, b) -> b
snd)

removeWindow :: Window -> (Rational, Column) -> (Rational, Column)
removeWindow :: Window
-> (Rational, [(Rational, Window)])
-> (Rational, [(Rational, Window)])
removeWindow Window
window = ([(Rational, Window)] -> [(Rational, Window)])
-> (Rational, [(Rational, Window)])
-> (Rational, [(Rational, Window)])
forall b c d. (b -> c) -> (d, b) -> (d, c)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second ([(Rational, Window)] -> [(Rational, Window)]
forall a. [(Rational, a)] -> [(Rational, a)]
normalize ([(Rational, Window)] -> [(Rational, Window)])
-> ([(Rational, Window)] -> [(Rational, Window)])
-> [(Rational, Window)]
-> [(Rational, Window)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Rational, Window) -> Bool)
-> [(Rational, Window)] -> [(Rational, Window)]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Window -> Window -> Bool
forall a. Eq a => a -> a -> Bool
/= Window
window) (Window -> Bool)
-> ((Rational, Window) -> Window) -> (Rational, Window) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Rational, Window) -> Window
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 Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
2, [(Rational, Window)]
windows') (Rational, [(Rational, Window)]) -> Columns -> Columns
forall a. a -> [a] -> [a]
: Rational -> Rational -> [Window] -> Columns
singleColumn (Integer
1 Integer -> Integer -> Rational
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) <- Columns -> Maybe (Columns, (Rational, [(Rational, Window)]))
forall a. [a] -> Maybe ([a], a)
unsnoc Columns
columns =
      Columns -> Columns
sanitizeColumns (Columns -> Columns) -> Columns -> Columns
forall a b. (a -> b) -> a -> b
$ Columns
columns' Columns -> 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 = ((Rational, a) -> (Rational, a))
-> [(Rational, a)] -> [(Rational, a)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Rational -> Rational) -> (Rational, a) -> (Rational, a)
forall b c d. (b -> c) -> (b, d) -> (c, d)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first (Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/ Rational
total)) [(Rational, a)]
elts
  where
    total :: Rational
total = [Rational] -> Rational
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ((Rational, a) -> Rational
forall a b. (a, b) -> a
fst ((Rational, a) -> Rational) -> [(Rational, a)] -> [Rational]
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)) <- [(Rational, a)] -> Maybe ([(Rational, a)], (Rational, a))
forall a. [a] -> Maybe ([a], a)
unsnoc [(Rational, a)]
list = [(Rational, a)]
elts [(Rational, a)] -> [(Rational, a)] -> [(Rational, a)]
forall a. Semigroup a => a -> a -> a
<> [(Rational
1 Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
- [Rational] -> Rational
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ((Rational, a) -> Rational
forall a b. (a, b) -> a
fst ((Rational, a) -> Rational) -> [(Rational, a)] -> [Rational]
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 = Columns -> Columns
forall a. [(Rational, a)] -> [(Rational, a)]
sanitize (Columns -> Columns) -> (Columns -> Columns) -> Columns -> Columns
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Rational, [(Rational, Window)])
 -> (Rational, [(Rational, Window)]))
-> Columns -> Columns
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (([(Rational, Window)] -> [(Rational, Window)])
-> (Rational, [(Rational, Window)])
-> (Rational, [(Rational, Window)])
forall b c d. (b -> c) -> (d, b) -> (d, c)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second [(Rational, Window)] -> [(Rational, Window)]
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 = ((Rational, a) -> Rational -> (Rational, Rational, a))
-> [(Rational, a)] -> [Rational] -> [(Rational, Rational, a)]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (Rational, a) -> Rational -> (Rational, Rational, a)
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 = (Rational -> (Rational, a) -> Rational)
-> Rational -> [(Rational, a)] -> [Rational]
forall b a. (b -> a -> b) -> b -> [a] -> [b]
scanl' (\Rational
position (Rational
dimension, a
_) -> Rational
position Rational -> Rational -> Rational
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 [] = Maybe ([a], a)
forall a. Maybe a
Nothing
unsnoc (a
x : [a]
xs)
  | Just ([a]
is, a
l) <- [a] -> Maybe ([a], a)
forall a. [a] -> Maybe ([a], a)
unsnoc [a]
xs = ([a], a) -> Maybe ([a], a)
forall a. a -> Maybe a
Just (a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
is, a
l)
  | Bool
otherwise = ([a], a) -> Maybe ([a], a)
forall a. a -> Maybe a
Just ([], a
x)