{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}
module XMonad.Layout.Columns
(
ColumnsLayout (..),
Focus (..),
Move (..),
Resize (..),
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
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
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
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
type Column = [(Rational, Window)]
type Columns = [(Rational, Column)]
data ColumnsLayout a = Columns
{
forall a. ColumnsLayout a -> Rational
coOneWindowWidth :: Rational,
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'
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
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"
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
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
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
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
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
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
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
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)
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 = []
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)