{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE ViewPatterns #-}
{-# OPTIONS_GHC -funbox-strict-fields #-}
module Yi.Layout
(
Layout(..),
Orientation(..),
DividerPosition,
DividerRef,
RelativeSize,
dividerPositionA,
findDivider,
LayoutManager(..),
AnyLayoutManager(..),
layoutManagerSameType,
wide,
tall,
slidyTall,
slidyWide,
hPairNStack,
vPairNStack,
Rectangle(..),
HasNeighborWest,
layoutToRectangles,
Transposable(..),
Transposed(..),
LayoutM,
pair,
singleWindow,
stack,
evenStack,
runLayoutM,
)
where
import Control.Applicative ((<|>))
import Control.Arrow (first)
import Lens.Micro.Platform (Lens', lens)
import qualified Control.Monad.State.Strict as Monad (State, evalState, get, put)
import Data.Default (Default, def)
import Data.List (foldl', mapAccumL)
import Data.Maybe (fromMaybe, isNothing)
import Data.Typeable (Typeable, cast, typeOf)
data Layout a
= SingleWindow a
| Stack {
Layout a -> Orientation
orientation :: !Orientation,
Layout a -> [(Layout a, RelativeSize)]
wins :: [(Layout a, RelativeSize)]
}
| Pair {
orientation :: !Orientation,
Layout a -> RelativeSize
divPos :: !DividerPosition,
Layout a -> DividerRef
divRef :: !DividerRef,
Layout a -> Layout a
pairFst :: !(Layout a),
Layout a -> Layout a
pairSnd :: !(Layout a)
}
deriving(Typeable, Layout a -> Layout a -> Bool
(Layout a -> Layout a -> Bool)
-> (Layout a -> Layout a -> Bool) -> Eq (Layout a)
forall a. Eq a => Layout a -> Layout a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Layout a -> Layout a -> Bool
$c/= :: forall a. Eq a => Layout a -> Layout a -> Bool
== :: Layout a -> Layout a -> Bool
$c== :: forall a. Eq a => Layout a -> Layout a -> Bool
Eq, a -> Layout b -> Layout a
(a -> b) -> Layout a -> Layout b
(forall a b. (a -> b) -> Layout a -> Layout b)
-> (forall a b. a -> Layout b -> Layout a) -> Functor Layout
forall a b. a -> Layout b -> Layout a
forall a b. (a -> b) -> Layout a -> Layout b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Layout b -> Layout a
$c<$ :: forall a b. a -> Layout b -> Layout a
fmap :: (a -> b) -> Layout a -> Layout b
$cfmap :: forall a b. (a -> b) -> Layout a -> Layout b
Functor)
dividerPositionA :: DividerRef -> Lens' (Layout a) DividerPosition
dividerPositionA :: DividerRef -> Lens' (Layout a) RelativeSize
dividerPositionA ref :: DividerRef
ref = (Layout a -> RelativeSize)
-> (Layout a -> RelativeSize -> Layout a)
-> Lens' (Layout a) RelativeSize
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Layout a -> RelativeSize
forall a. Layout a -> RelativeSize
getter ((RelativeSize -> Layout a -> Layout a)
-> Layout a -> RelativeSize -> Layout a
forall a b c. (a -> b -> c) -> b -> a -> c
flip RelativeSize -> Layout a -> Layout a
forall a. RelativeSize -> Layout a -> Layout a
setter) where
setter :: RelativeSize -> Layout a -> Layout a
setter pos :: RelativeSize
pos = Layout a -> Layout a
forall a. Layout a -> Layout a
set'
where
set' :: Layout a -> Layout a
set' s :: Layout a
s@(SingleWindow _) = Layout a
s
set' p :: Layout a
p@Pair{} | Layout a -> DividerRef
forall a. Layout a -> DividerRef
divRef Layout a
p DividerRef -> DividerRef -> Bool
forall a. Eq a => a -> a -> Bool
== DividerRef
ref = Layout a
p{ divPos :: RelativeSize
divPos = RelativeSize
pos }
| Bool
otherwise = Layout a
p{ pairFst :: Layout a
pairFst = Layout a -> Layout a
set' (Layout a -> Layout a
forall a. Layout a -> Layout a
pairFst Layout a
p), pairSnd :: Layout a
pairSnd = Layout a -> Layout a
set' (Layout a -> Layout a
forall a. Layout a -> Layout a
pairSnd Layout a
p) }
set' s :: Layout a
s@Stack{} = Layout a
s{ wins :: [(Layout a, RelativeSize)]
wins = ((Layout a, RelativeSize) -> (Layout a, RelativeSize))
-> [(Layout a, RelativeSize)] -> [(Layout a, RelativeSize)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Layout a -> Layout a)
-> (Layout a, RelativeSize) -> (Layout a, RelativeSize)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first Layout a -> Layout a
set') (Layout a -> [(Layout a, RelativeSize)]
forall a. Layout a -> [(Layout a, RelativeSize)]
wins Layout a
s) }
getter :: Layout a -> RelativeSize
getter = RelativeSize -> Maybe RelativeSize -> RelativeSize
forall a. a -> Maybe a -> a
fromMaybe RelativeSize
forall a. a
invalidRef (Maybe RelativeSize -> RelativeSize)
-> (Layout a -> Maybe RelativeSize) -> Layout a -> RelativeSize
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Layout a -> Maybe RelativeSize
forall a. Layout a -> Maybe RelativeSize
get'
get' :: Layout a -> Maybe RelativeSize
get' (SingleWindow _) = Maybe RelativeSize
forall a. Maybe a
Nothing
get' p :: Layout a
p@Pair{} | Layout a -> DividerRef
forall a. Layout a -> DividerRef
divRef Layout a
p DividerRef -> DividerRef -> Bool
forall a. Eq a => a -> a -> Bool
== DividerRef
ref = RelativeSize -> Maybe RelativeSize
forall a. a -> Maybe a
Just (Layout a -> RelativeSize
forall a. Layout a -> RelativeSize
divPos Layout a
p)
| Bool
otherwise = Layout a -> Maybe RelativeSize
get' (Layout a -> Layout a
forall a. Layout a -> Layout a
pairFst Layout a
p) Maybe RelativeSize -> Maybe RelativeSize -> Maybe RelativeSize
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Layout a -> Maybe RelativeSize
get' (Layout a -> Layout a
forall a. Layout a -> Layout a
pairSnd Layout a
p)
get' s :: Layout a
s@Stack{} = (Maybe RelativeSize -> Maybe RelativeSize -> Maybe RelativeSize)
-> Maybe RelativeSize -> [Maybe RelativeSize] -> Maybe RelativeSize
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Maybe RelativeSize -> Maybe RelativeSize -> Maybe RelativeSize
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>) Maybe RelativeSize
forall a. Maybe a
Nothing (((Layout a, RelativeSize) -> Maybe RelativeSize)
-> [(Layout a, RelativeSize)] -> [Maybe RelativeSize]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Layout a -> Maybe RelativeSize
get' (Layout a -> Maybe RelativeSize)
-> ((Layout a, RelativeSize) -> Layout a)
-> (Layout a, RelativeSize)
-> Maybe RelativeSize
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Layout a, RelativeSize) -> Layout a
forall a b. (a, b) -> a
fst) (Layout a -> [(Layout a, RelativeSize)]
forall a. Layout a -> [(Layout a, RelativeSize)]
wins Layout a
s))
invalidRef :: a
invalidRef = [Char] -> a
forall a. HasCallStack => [Char] -> a
error "Yi.Layout.dividerPositionA: invalid DividerRef"
findDivider :: Eq a => Maybe a -> Layout a -> Maybe DividerRef
findDivider :: Maybe a -> Layout a -> Maybe DividerRef
findDivider mbw :: Maybe a
mbw = [DividerRef] -> Layout a -> Maybe DividerRef
go [] where
go :: [DividerRef] -> Layout a -> Maybe DividerRef
go path :: [DividerRef]
path (SingleWindow w :: a
w) = Maybe DividerRef
-> (a -> Maybe DividerRef) -> Maybe a -> Maybe DividerRef
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Maybe DividerRef
forall a. Maybe a
Nothing (\w' :: a
w' ->
if a
w a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
w' Bool -> Bool -> Bool
&& Bool -> Bool
not ([DividerRef] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [DividerRef]
path)
then DividerRef -> Maybe DividerRef
forall a. a -> Maybe a
Just ([DividerRef] -> DividerRef
forall a. [a] -> a
head [DividerRef]
path) else Maybe DividerRef
forall a. Maybe a
Nothing) Maybe a
mbw
go path :: [DividerRef]
path (Pair _ _ ref :: DividerRef
ref l1 :: Layout a
l1 l2 :: Layout a
l2) = if Maybe a -> Bool
forall a. Maybe a -> Bool
isNothing Maybe a
mbw then DividerRef -> Maybe DividerRef
forall a. a -> Maybe a
Just DividerRef
ref
else let p' :: [DividerRef]
p' = DividerRef
ref DividerRef -> [DividerRef] -> [DividerRef]
forall a. a -> [a] -> [a]
: [DividerRef]
path
in [DividerRef] -> Layout a -> Maybe DividerRef
go [DividerRef]
p' Layout a
l1 Maybe DividerRef -> Maybe DividerRef -> Maybe DividerRef
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [DividerRef] -> Layout a -> Maybe DividerRef
go [DividerRef]
p' Layout a
l2
go path :: [DividerRef]
path (Stack _ ws :: [(Layout a, RelativeSize)]
ws) = (Maybe DividerRef -> Maybe DividerRef -> Maybe DividerRef)
-> Maybe DividerRef -> [Maybe DividerRef] -> Maybe DividerRef
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Maybe DividerRef -> Maybe DividerRef -> Maybe DividerRef
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>) Maybe DividerRef
forall a. Maybe a
Nothing ([Maybe DividerRef] -> Maybe DividerRef)
-> [Maybe DividerRef] -> Maybe DividerRef
forall a b. (a -> b) -> a -> b
$ ((Layout a, RelativeSize) -> Maybe DividerRef)
-> [(Layout a, RelativeSize)] -> [Maybe DividerRef]
forall a b. (a -> b) -> [a] -> [b]
map ([DividerRef] -> Layout a -> Maybe DividerRef
go [DividerRef]
path (Layout a -> Maybe DividerRef)
-> ((Layout a, RelativeSize) -> Layout a)
-> (Layout a, RelativeSize)
-> Maybe DividerRef
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Layout a, RelativeSize) -> Layout a
forall a b. (a, b) -> a
fst) [(Layout a, RelativeSize)]
ws
instance Show a => Show (Layout a) where
show :: Layout a -> [Char]
show (SingleWindow a :: a
a) = a -> [Char]
forall a. Show a => a -> [Char]
show a
a
show (Stack o :: Orientation
o s :: [(Layout a, RelativeSize)]
s) = Orientation -> [Char]
forall a. Show a => a -> [Char]
show Orientation
o [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ " stack " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [(Layout a, RelativeSize)] -> [Char]
forall a. Show a => a -> [Char]
show [(Layout a, RelativeSize)]
s
show p :: Layout a
p@(Pair{}) = Orientation -> [Char]
forall a. Show a => a -> [Char]
show (Layout a -> Orientation
forall a. Layout a -> Orientation
orientation Layout a
p) [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ " " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ (Layout a, Layout a) -> [Char]
forall a. Show a => a -> [Char]
show (Layout a -> Layout a
forall a. Layout a -> Layout a
pairFst Layout a
p, Layout a -> Layout a
forall a. Layout a -> Layout a
pairSnd Layout a
p)
instance Default a => Default (Layout a) where
def :: Layout a
def = a -> Layout a
forall a. a -> Layout a
SingleWindow a
forall a. Default a => a
def
data Orientation
= Horizontal
| Vertical
deriving(Orientation -> Orientation -> Bool
(Orientation -> Orientation -> Bool)
-> (Orientation -> Orientation -> Bool) -> Eq Orientation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Orientation -> Orientation -> Bool
$c/= :: Orientation -> Orientation -> Bool
== :: Orientation -> Orientation -> Bool
$c== :: Orientation -> Orientation -> Bool
Eq, DividerRef -> Orientation -> ShowS
[Orientation] -> ShowS
Orientation -> [Char]
(DividerRef -> Orientation -> ShowS)
-> (Orientation -> [Char])
-> ([Orientation] -> ShowS)
-> Show Orientation
forall a.
(DividerRef -> a -> ShowS)
-> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [Orientation] -> ShowS
$cshowList :: [Orientation] -> ShowS
show :: Orientation -> [Char]
$cshow :: Orientation -> [Char]
showsPrec :: DividerRef -> Orientation -> ShowS
$cshowsPrec :: DividerRef -> Orientation -> ShowS
Show)
type DividerRef = Int
type DividerPosition = Double
type RelativeSize = Double
class (Typeable m, Eq m) => LayoutManager m where
pureLayout :: m -> Layout a -> [a] -> Layout a
describeLayout :: m -> String
nextVariant :: m -> m
nextVariant = m -> m
forall a. a -> a
id
previousVariant :: m -> m
previousVariant = m -> m
forall a. a -> a
id
data AnyLayoutManager = forall m. LayoutManager m => AnyLayoutManager !m
deriving(Typeable)
instance Eq AnyLayoutManager where
(AnyLayoutManager l1 :: m
l1) == :: AnyLayoutManager -> AnyLayoutManager -> Bool
== (AnyLayoutManager l2 :: m
l2) = Bool -> (m -> Bool) -> Maybe m -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (m -> m -> Bool
forall a. Eq a => a -> a -> Bool
== m
l2) (m -> Maybe m
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast m
l1)
instance LayoutManager (AnyLayoutManager) where
pureLayout :: AnyLayoutManager -> Layout a -> [a] -> Layout a
pureLayout (AnyLayoutManager l :: m
l) = m -> Layout a -> [a] -> Layout a
forall m a. LayoutManager m => m -> Layout a -> [a] -> Layout a
pureLayout m
l
describeLayout :: AnyLayoutManager -> [Char]
describeLayout (AnyLayoutManager l :: m
l) = m -> [Char]
forall m. LayoutManager m => m -> [Char]
describeLayout m
l
nextVariant :: AnyLayoutManager -> AnyLayoutManager
nextVariant (AnyLayoutManager l :: m
l) = m -> AnyLayoutManager
forall m. LayoutManager m => m -> AnyLayoutManager
AnyLayoutManager (m -> m
forall m. LayoutManager m => m -> m
nextVariant m
l)
previousVariant :: AnyLayoutManager -> AnyLayoutManager
previousVariant (AnyLayoutManager l :: m
l) = m -> AnyLayoutManager
forall m. LayoutManager m => m -> AnyLayoutManager
AnyLayoutManager (m -> m
forall m. LayoutManager m => m -> m
previousVariant m
l)
instance Default AnyLayoutManager where
def :: AnyLayoutManager
def = DividerRef -> AnyLayoutManager
hPairNStack 1
layoutManagerSameType :: AnyLayoutManager -> AnyLayoutManager -> Bool
layoutManagerSameType :: AnyLayoutManager -> AnyLayoutManager -> Bool
layoutManagerSameType (AnyLayoutManager l1 :: m
l1) (AnyLayoutManager l2 :: m
l2) = m -> TypeRep
forall a. Typeable a => a -> TypeRep
typeOf m
l1 TypeRep -> TypeRep -> Bool
forall a. Eq a => a -> a -> Bool
== m -> TypeRep
forall a. Typeable a => a -> TypeRep
typeOf m
l2
data Tall = Tall
deriving(Tall -> Tall -> Bool
(Tall -> Tall -> Bool) -> (Tall -> Tall -> Bool) -> Eq Tall
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Tall -> Tall -> Bool
$c/= :: Tall -> Tall -> Bool
== :: Tall -> Tall -> Bool
$c== :: Tall -> Tall -> Bool
Eq, Typeable)
tall :: AnyLayoutManager
tall :: AnyLayoutManager
tall = Tall -> AnyLayoutManager
forall m. LayoutManager m => m -> AnyLayoutManager
AnyLayoutManager Tall
Tall
instance LayoutManager Tall where
pureLayout :: Tall -> Layout a -> [a] -> Layout a
pureLayout Tall _oldLayout :: Layout a
_oldLayout ws :: [a]
ws = LayoutM a -> Layout a
forall a. LayoutM a -> Layout a
runLayoutM (LayoutM a -> Layout a) -> LayoutM a -> Layout a
forall a b. (a -> b) -> a -> b
$ Orientation -> [LayoutM a] -> LayoutM a
forall a. Orientation -> [LayoutM a] -> LayoutM a
evenStack Orientation
Horizontal ((a -> LayoutM a) -> [a] -> [LayoutM a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> LayoutM a
forall a. a -> LayoutM a
singleWindow [a]
ws)
describeLayout :: Tall -> [Char]
describeLayout Tall = "Windows positioned side-by-side"
data Wide = Wide
deriving(Wide -> Wide -> Bool
(Wide -> Wide -> Bool) -> (Wide -> Wide -> Bool) -> Eq Wide
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Wide -> Wide -> Bool
$c/= :: Wide -> Wide -> Bool
== :: Wide -> Wide -> Bool
$c== :: Wide -> Wide -> Bool
Eq, Typeable)
instance LayoutManager Wide where
pureLayout :: Wide -> Layout a -> [a] -> Layout a
pureLayout Wide _oldLayout :: Layout a
_oldLayout ws :: [a]
ws = LayoutM a -> Layout a
forall a. LayoutM a -> Layout a
runLayoutM (LayoutM a -> Layout a) -> LayoutM a -> Layout a
forall a b. (a -> b) -> a -> b
$ Orientation -> [LayoutM a] -> LayoutM a
forall a. Orientation -> [LayoutM a] -> LayoutM a
evenStack Orientation
Vertical ((a -> LayoutM a) -> [a] -> [LayoutM a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> LayoutM a
forall a. a -> LayoutM a
singleWindow [a]
ws)
describeLayout :: Wide -> [Char]
describeLayout Wide = "Windows positioned above one another"
wide :: AnyLayoutManager
wide :: AnyLayoutManager
wide = Wide -> AnyLayoutManager
forall m. LayoutManager m => m -> AnyLayoutManager
AnyLayoutManager Wide
Wide
data SlidyTall = SlidyTall
deriving(SlidyTall -> SlidyTall -> Bool
(SlidyTall -> SlidyTall -> Bool)
-> (SlidyTall -> SlidyTall -> Bool) -> Eq SlidyTall
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SlidyTall -> SlidyTall -> Bool
$c/= :: SlidyTall -> SlidyTall -> Bool
== :: SlidyTall -> SlidyTall -> Bool
$c== :: SlidyTall -> SlidyTall -> Bool
Eq, Typeable)
slidyTall :: AnyLayoutManager
slidyTall :: AnyLayoutManager
slidyTall = SlidyTall -> AnyLayoutManager
forall m. LayoutManager m => m -> AnyLayoutManager
AnyLayoutManager SlidyTall
SlidyTall
instance LayoutManager SlidyTall where
pureLayout :: SlidyTall -> Layout a -> [a] -> Layout a
pureLayout SlidyTall _oldLayout :: Layout a
_oldLayout [] = [Char] -> Layout a
forall a. HasCallStack => [Char] -> a
error "Yi.Layout: empty window list unexpected"
pureLayout SlidyTall oldLayout :: Layout a
oldLayout xs :: [a]
xs = LayoutM a -> Layout a
forall a. LayoutM a -> Layout a
runLayoutM (Maybe (Layout a) -> [a] -> LayoutM a
forall a a. Maybe (Layout a) -> [a] -> LayoutM a
go (Layout a -> Maybe (Layout a)
forall a. a -> Maybe a
Just Layout a
oldLayout) [a]
xs) where
go :: Maybe (Layout a) -> [a] -> LayoutM a
go _layout :: Maybe (Layout a)
_layout [x :: a
x] = a -> LayoutM a
forall a. a -> LayoutM a
singleWindow a
x
go layout :: Maybe (Layout a)
layout ([a] -> ([a], [a])
forall a. [a] -> ([a], [a])
splitList -> (lxs :: [a]
lxs, rxs :: [a]
rxs)) =
case Maybe (Layout a)
layout of
Just (Pair Horizontal pos :: RelativeSize
pos _ l :: Layout a
l r :: Layout a
r) -> Orientation -> RelativeSize -> LayoutM a -> LayoutM a -> LayoutM a
forall a.
Orientation -> RelativeSize -> LayoutM a -> LayoutM a -> LayoutM a
pair Orientation
Horizontal RelativeSize
pos (Maybe (Layout a) -> [a] -> LayoutM a
go (Layout a -> Maybe (Layout a)
forall a. a -> Maybe a
Just Layout a
l) [a]
lxs) (Maybe (Layout a) -> [a] -> LayoutM a
go (Layout a -> Maybe (Layout a)
forall a. a -> Maybe a
Just Layout a
r) [a]
rxs)
_ -> Orientation -> RelativeSize -> LayoutM a -> LayoutM a -> LayoutM a
forall a.
Orientation -> RelativeSize -> LayoutM a -> LayoutM a -> LayoutM a
pair Orientation
Horizontal 0.5 (Maybe (Layout a) -> [a] -> LayoutM a
go Maybe (Layout a)
forall a. Maybe a
Nothing [a]
lxs) (Maybe (Layout a) -> [a] -> LayoutM a
go Maybe (Layout a)
forall a. Maybe a
Nothing [a]
rxs)
describeLayout :: SlidyTall -> [Char]
describeLayout SlidyTall = "Slidy tall windows, with balanced-position sliders"
splitList :: [a] -> ([a], [a])
splitList :: [a] -> ([a], [a])
splitList xs :: [a]
xs = DividerRef -> [a] -> ([a], [a])
forall a. DividerRef -> [a] -> ([a], [a])
splitAt (([a] -> DividerRef
forall (t :: * -> *) a. Foldable t => t a -> DividerRef
length [a]
xs DividerRef -> DividerRef -> DividerRef
forall a. Num a => a -> a -> a
+ 1) DividerRef -> DividerRef -> DividerRef
forall a. Integral a => a -> a -> a
`div` 2) [a]
xs
newtype SlidyWide = SlidyWide (Transposed SlidyTall)
deriving(SlidyWide -> SlidyWide -> Bool
(SlidyWide -> SlidyWide -> Bool)
-> (SlidyWide -> SlidyWide -> Bool) -> Eq SlidyWide
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SlidyWide -> SlidyWide -> Bool
$c/= :: SlidyWide -> SlidyWide -> Bool
== :: SlidyWide -> SlidyWide -> Bool
$c== :: SlidyWide -> SlidyWide -> Bool
Eq, Typeable)
slidyWide :: AnyLayoutManager
slidyWide :: AnyLayoutManager
slidyWide = SlidyWide -> AnyLayoutManager
forall m. LayoutManager m => m -> AnyLayoutManager
AnyLayoutManager (Transposed SlidyTall -> SlidyWide
SlidyWide (SlidyTall -> Transposed SlidyTall
forall lm. lm -> Transposed lm
Transposed SlidyTall
SlidyTall))
instance LayoutManager SlidyWide where
pureLayout :: SlidyWide -> Layout a -> [a] -> Layout a
pureLayout (SlidyWide w :: Transposed SlidyTall
w) = Transposed SlidyTall -> Layout a -> [a] -> Layout a
forall m a. LayoutManager m => m -> Layout a -> [a] -> Layout a
pureLayout Transposed SlidyTall
w
describeLayout :: SlidyWide -> [Char]
describeLayout _ = "Slidy wide windows, with balanced-position sliders"
data HPairNStack = HPairNStack !Int
deriving(HPairNStack -> HPairNStack -> Bool
(HPairNStack -> HPairNStack -> Bool)
-> (HPairNStack -> HPairNStack -> Bool) -> Eq HPairNStack
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HPairNStack -> HPairNStack -> Bool
$c/= :: HPairNStack -> HPairNStack -> Bool
== :: HPairNStack -> HPairNStack -> Bool
$c== :: HPairNStack -> HPairNStack -> Bool
Eq, Typeable)
hPairNStack :: Int -> AnyLayoutManager
hPairNStack :: DividerRef -> AnyLayoutManager
hPairNStack n :: DividerRef
n | DividerRef
n DividerRef -> DividerRef -> Bool
forall a. Ord a => a -> a -> Bool
< 1 = [Char] -> AnyLayoutManager
forall a. HasCallStack => [Char] -> a
error "Yi.Layout.hPairNStackLayout: n must be at least 1"
| Bool
otherwise = HPairNStack -> AnyLayoutManager
forall m. LayoutManager m => m -> AnyLayoutManager
AnyLayoutManager (DividerRef -> HPairNStack
HPairNStack DividerRef
n)
instance LayoutManager HPairNStack where
pureLayout :: HPairNStack -> Layout a -> [a] -> Layout a
pureLayout (HPairNStack n :: DividerRef
n) oldLayout :: Layout a
oldLayout ((a -> LayoutM a) -> [a] -> [LayoutM a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> LayoutM a
forall a. a -> LayoutM a
singleWindow -> [LayoutM a]
xs)
| [LayoutM a] -> DividerRef
forall (t :: * -> *) a. Foldable t => t a -> DividerRef
length [LayoutM a]
xs DividerRef -> DividerRef -> Bool
forall a. Ord a => a -> a -> Bool
<= DividerRef
n = LayoutM a -> Layout a
forall a. LayoutM a -> Layout a
runLayoutM (LayoutM a -> Layout a) -> LayoutM a -> Layout a
forall a b. (a -> b) -> a -> b
$ Orientation -> [LayoutM a] -> LayoutM a
forall a. Orientation -> [LayoutM a] -> LayoutM a
evenStack Orientation
Vertical [LayoutM a]
xs
| Bool
otherwise = LayoutM a -> Layout a
forall a. LayoutM a -> Layout a
runLayoutM (LayoutM a -> Layout a) -> LayoutM a -> Layout a
forall a b. (a -> b) -> a -> b
$ case DividerRef -> [LayoutM a] -> ([LayoutM a], [LayoutM a])
forall a. DividerRef -> [a] -> ([a], [a])
splitAt DividerRef
n [LayoutM a]
xs of
(ls :: [LayoutM a]
ls, rs :: [LayoutM a]
rs) -> Orientation -> RelativeSize -> LayoutM a -> LayoutM a -> LayoutM a
forall a.
Orientation -> RelativeSize -> LayoutM a -> LayoutM a -> LayoutM a
pair Orientation
Horizontal RelativeSize
pos
(Orientation -> [LayoutM a] -> LayoutM a
forall a. Orientation -> [LayoutM a] -> LayoutM a
evenStack Orientation
Vertical [LayoutM a]
ls)
(Orientation -> [LayoutM a] -> LayoutM a
forall a. Orientation -> [LayoutM a] -> LayoutM a
evenStack Orientation
Vertical [LayoutM a]
rs)
where
pos :: RelativeSize
pos = case Layout a
oldLayout of
Pair Horizontal pos' :: RelativeSize
pos' _ _ _ -> RelativeSize
pos'
_ -> 0.5
describeLayout :: HPairNStack -> [Char]
describeLayout (HPairNStack n :: DividerRef
n) = DividerRef -> [Char]
forall a. Show a => a -> [Char]
show DividerRef
n [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ " windows on the left; remaining windows on the right"
nextVariant :: HPairNStack -> HPairNStack
nextVariant (HPairNStack n :: DividerRef
n) = DividerRef -> HPairNStack
HPairNStack (DividerRef
nDividerRef -> DividerRef -> DividerRef
forall a. Num a => a -> a -> a
+1)
previousVariant :: HPairNStack -> HPairNStack
previousVariant (HPairNStack n :: DividerRef
n) = DividerRef -> HPairNStack
HPairNStack (DividerRef -> DividerRef -> DividerRef
forall a. Ord a => a -> a -> a
max (DividerRef
nDividerRef -> DividerRef -> DividerRef
forall a. Num a => a -> a -> a
-1) 1)
newtype VPairNStack = VPairNStack (Transposed HPairNStack)
deriving(VPairNStack -> VPairNStack -> Bool
(VPairNStack -> VPairNStack -> Bool)
-> (VPairNStack -> VPairNStack -> Bool) -> Eq VPairNStack
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: VPairNStack -> VPairNStack -> Bool
$c/= :: VPairNStack -> VPairNStack -> Bool
== :: VPairNStack -> VPairNStack -> Bool
$c== :: VPairNStack -> VPairNStack -> Bool
Eq, Typeable)
vPairNStack :: Int -> AnyLayoutManager
vPairNStack :: DividerRef -> AnyLayoutManager
vPairNStack n :: DividerRef
n = VPairNStack -> AnyLayoutManager
forall m. LayoutManager m => m -> AnyLayoutManager
AnyLayoutManager (Transposed HPairNStack -> VPairNStack
VPairNStack (HPairNStack -> Transposed HPairNStack
forall lm. lm -> Transposed lm
Transposed (DividerRef -> HPairNStack
HPairNStack DividerRef
n)))
instance LayoutManager VPairNStack where
pureLayout :: VPairNStack -> Layout a -> [a] -> Layout a
pureLayout (VPairNStack lm :: Transposed HPairNStack
lm) = Transposed HPairNStack -> Layout a -> [a] -> Layout a
forall m a. LayoutManager m => m -> Layout a -> [a] -> Layout a
pureLayout Transposed HPairNStack
lm
previousVariant :: VPairNStack -> VPairNStack
previousVariant (VPairNStack lm :: Transposed HPairNStack
lm) = Transposed HPairNStack -> VPairNStack
VPairNStack (Transposed HPairNStack -> Transposed HPairNStack
forall m. LayoutManager m => m -> m
previousVariant Transposed HPairNStack
lm)
nextVariant :: VPairNStack -> VPairNStack
nextVariant (VPairNStack lm :: Transposed HPairNStack
lm) = Transposed HPairNStack -> VPairNStack
VPairNStack (Transposed HPairNStack -> Transposed HPairNStack
forall m. LayoutManager m => m -> m
nextVariant Transposed HPairNStack
lm)
describeLayout :: VPairNStack -> [Char]
describeLayout (VPairNStack (Transposed (HPairNStack n :: DividerRef
n))) = DividerRef -> [Char]
forall a. Show a => a -> [Char]
show DividerRef
n [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ " windows on top; remaining windows beneath"
data Rectangle = Rectangle { Rectangle -> RelativeSize
rectX, Rectangle -> RelativeSize
rectY, Rectangle -> RelativeSize
rectWidth, Rectangle -> RelativeSize
rectHeight :: !Double }
deriving(Rectangle -> Rectangle -> Bool
(Rectangle -> Rectangle -> Bool)
-> (Rectangle -> Rectangle -> Bool) -> Eq Rectangle
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Rectangle -> Rectangle -> Bool
$c/= :: Rectangle -> Rectangle -> Bool
== :: Rectangle -> Rectangle -> Bool
$c== :: Rectangle -> Rectangle -> Bool
Eq, DividerRef -> Rectangle -> ShowS
[Rectangle] -> ShowS
Rectangle -> [Char]
(DividerRef -> Rectangle -> ShowS)
-> (Rectangle -> [Char])
-> ([Rectangle] -> ShowS)
-> Show Rectangle
forall a.
(DividerRef -> a -> ShowS)
-> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [Rectangle] -> ShowS
$cshowList :: [Rectangle] -> ShowS
show :: Rectangle -> [Char]
$cshow :: Rectangle -> [Char]
showsPrec :: DividerRef -> Rectangle -> ShowS
$cshowsPrec :: DividerRef -> Rectangle -> ShowS
Show)
type HasNeighborWest = Bool
layoutToRectangles :: HasNeighborWest -> Rectangle -> Layout a -> [(a, Rectangle, HasNeighborWest)]
layoutToRectangles :: Bool -> Rectangle -> Layout a -> [(a, Rectangle, Bool)]
layoutToRectangles nb :: Bool
nb bounds :: Rectangle
bounds (SingleWindow a :: a
a) = [(a
a, Rectangle
bounds, Bool
nb)]
layoutToRectangles nb :: Bool
nb bounds :: Rectangle
bounds (Stack o :: Orientation
o ts :: [(Layout a, RelativeSize)]
ts) = Orientation
-> Rectangle
-> [(Layout a, RelativeSize, Bool)]
-> [(a, Rectangle, Bool)]
forall a.
Orientation
-> Rectangle
-> [(Layout a, RelativeSize, Bool)]
-> [(a, Rectangle, Bool)]
handleStack Orientation
o Rectangle
bounds [(Layout a, RelativeSize, Bool)]
ts'
where ts' :: [(Layout a, RelativeSize, Bool)]
ts' = if Orientation
o Orientation -> Orientation -> Bool
forall a. Eq a => a -> a -> Bool
== Orientation
Vertical then Bool
-> [(Layout a, RelativeSize)] -> [(Layout a, RelativeSize, Bool)]
forall c a b. c -> [(a, b)] -> [(a, b, c)]
setNbs Bool
nb [(Layout a, RelativeSize)]
ts
else case [(Layout a, RelativeSize)]
ts of
(l :: Layout a
l, s :: RelativeSize
s) : xs :: [(Layout a, RelativeSize)]
xs -> (Layout a
l, RelativeSize
s, Bool
nb) (Layout a, RelativeSize, Bool)
-> [(Layout a, RelativeSize, Bool)]
-> [(Layout a, RelativeSize, Bool)]
forall a. a -> [a] -> [a]
: Bool
-> [(Layout a, RelativeSize)] -> [(Layout a, RelativeSize, Bool)]
forall c a b. c -> [(a, b)] -> [(a, b, c)]
setNbs Bool
True [(Layout a, RelativeSize)]
xs
[] -> []
setNbs :: c -> [(a, b)] -> [(a, b, c)]
setNbs val :: c
val = ((a, b) -> (a, b, c)) -> [(a, b)] -> [(a, b, c)]
forall a b. (a -> b) -> [a] -> [b]
map (\(l :: a
l, s :: b
s) -> (a
l, b
s, c
val))
layoutToRectangles nb :: Bool
nb bounds :: Rectangle
bounds (Pair o :: Orientation
o p :: RelativeSize
p _ a :: Layout a
a b :: Layout a
b) = Orientation
-> Rectangle
-> [(Layout a, RelativeSize, Bool)]
-> [(a, Rectangle, Bool)]
forall a.
Orientation
-> Rectangle
-> [(Layout a, RelativeSize, Bool)]
-> [(a, Rectangle, Bool)]
handleStack Orientation
o Rectangle
bounds [(Layout a
a,RelativeSize
p,Bool
nb), (Layout a
b,1RelativeSize -> RelativeSize -> RelativeSize
forall a. Num a => a -> a -> a
-RelativeSize
p,Bool
nb')]
where nb' :: Bool
nb' = if Orientation
o Orientation -> Orientation -> Bool
forall a. Eq a => a -> a -> Bool
== Orientation
Horizontal then Bool
True else Bool
nb
handleStack :: Orientation -> Rectangle
-> [(Layout a, RelativeSize, HasNeighborWest)]
-> [(a, Rectangle, HasNeighborWest)]
handleStack :: Orientation
-> Rectangle
-> [(Layout a, RelativeSize, Bool)]
-> [(a, Rectangle, Bool)]
handleStack o :: Orientation
o bounds :: Rectangle
bounds tiles :: [(Layout a, RelativeSize, Bool)]
tiles = [[(a, Rectangle, Bool)]] -> [(a, Rectangle, Bool)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[(a, Rectangle, Bool)]] -> [(a, Rectangle, Bool)])
-> ([(Layout a, RelativeSize, Bool)] -> [[(a, Rectangle, Bool)]])
-> [(Layout a, RelativeSize, Bool)]
-> [(a, Rectangle, Bool)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (RelativeSize, [[(a, Rectangle, Bool)]])
-> [[(a, Rectangle, Bool)]]
forall a b. (a, b) -> b
snd ((RelativeSize, [[(a, Rectangle, Bool)]])
-> [[(a, Rectangle, Bool)]])
-> ([(Layout a, RelativeSize, Bool)]
-> (RelativeSize, [[(a, Rectangle, Bool)]]))
-> [(Layout a, RelativeSize, Bool)]
-> [[(a, Rectangle, Bool)]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (RelativeSize
-> (Layout a, RelativeSize, Bool)
-> (RelativeSize, [(a, Rectangle, Bool)]))
-> RelativeSize
-> [(Layout a, RelativeSize, Bool)]
-> (RelativeSize, [[(a, Rectangle, Bool)]])
forall (t :: * -> *) a b c.
Traversable t =>
(a -> b -> (a, c)) -> a -> t b -> (a, t c)
mapAccumL RelativeSize
-> (Layout a, RelativeSize, Bool)
-> (RelativeSize, [(a, Rectangle, Bool)])
forall a.
RelativeSize
-> (Layout a, RelativeSize, Bool)
-> (RelativeSize, [(a, Rectangle, Bool)])
doTile RelativeSize
startPos ([(Layout a, RelativeSize, Bool)] -> [(a, Rectangle, Bool)])
-> [(Layout a, RelativeSize, Bool)] -> [(a, Rectangle, Bool)]
forall a b. (a -> b) -> a -> b
$ [(Layout a, RelativeSize, Bool)]
tiles
where
(totalSpace :: RelativeSize
totalSpace, startPos :: RelativeSize
startPos, mkBounds :: RelativeSize -> RelativeSize -> Rectangle
mkBounds) = case Orientation
o of
Vertical -> (Rectangle -> RelativeSize
rectHeight Rectangle
bounds, Rectangle -> RelativeSize
rectY Rectangle
bounds,
\pos :: RelativeSize
pos size :: RelativeSize
size -> Rectangle
bounds { rectY :: RelativeSize
rectY = RelativeSize
pos, rectHeight :: RelativeSize
rectHeight = RelativeSize
size })
Horizontal -> (Rectangle -> RelativeSize
rectWidth Rectangle
bounds, Rectangle -> RelativeSize
rectX Rectangle
bounds,
\pos :: RelativeSize
pos size :: RelativeSize
size -> Rectangle
bounds { rectX :: RelativeSize
rectX = RelativeSize
pos, rectWidth :: RelativeSize
rectWidth = RelativeSize
size })
totalWeight' :: RelativeSize
totalWeight' = [RelativeSize] -> RelativeSize
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([RelativeSize] -> RelativeSize)
-> ([(Layout a, RelativeSize, Bool)] -> [RelativeSize])
-> [(Layout a, RelativeSize, Bool)]
-> RelativeSize
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Layout a, RelativeSize, Bool) -> RelativeSize)
-> [(Layout a, RelativeSize, Bool)] -> [RelativeSize]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(_, s :: RelativeSize
s, _) -> RelativeSize
s) ([(Layout a, RelativeSize, Bool)] -> RelativeSize)
-> [(Layout a, RelativeSize, Bool)] -> RelativeSize
forall a b. (a -> b) -> a -> b
$ [(Layout a, RelativeSize, Bool)]
tiles
totalWeight :: RelativeSize
totalWeight = if RelativeSize
totalWeight' RelativeSize -> RelativeSize -> Bool
forall a. Ord a => a -> a -> Bool
> 0 then RelativeSize
totalWeight'
else [Char] -> RelativeSize
forall a. HasCallStack => [Char] -> a
error "Yi.Layout: Stacks must have positive weights"
spacePerWeight :: RelativeSize
spacePerWeight = RelativeSize
totalSpace RelativeSize -> RelativeSize -> RelativeSize
forall a. Fractional a => a -> a -> a
/ RelativeSize
totalWeight
doTile :: RelativeSize
-> (Layout a, RelativeSize, Bool)
-> (RelativeSize, [(a, Rectangle, Bool)])
doTile pos :: RelativeSize
pos (t :: Layout a
t, wt :: RelativeSize
wt, nb :: Bool
nb) = (RelativeSize
pos RelativeSize -> RelativeSize -> RelativeSize
forall a. Num a => a -> a -> a
+ RelativeSize
wt RelativeSize -> RelativeSize -> RelativeSize
forall a. Num a => a -> a -> a
* RelativeSize
spacePerWeight,
Bool -> Rectangle -> Layout a -> [(a, Rectangle, Bool)]
forall a. Bool -> Rectangle -> Layout a -> [(a, Rectangle, Bool)]
layoutToRectangles Bool
nb (RelativeSize -> RelativeSize -> Rectangle
mkBounds RelativeSize
pos (RelativeSize
wt RelativeSize -> RelativeSize -> RelativeSize
forall a. Num a => a -> a -> a
* RelativeSize
spacePerWeight)) Layout a
t)
class Transposable r where transpose :: r -> r
instance Transposable Orientation where { transpose :: Orientation -> Orientation
transpose Horizontal = Orientation
Vertical; transpose Vertical = Orientation
Horizontal }
instance Transposable (Layout a) where
transpose :: Layout a -> Layout a
transpose (SingleWindow a :: a
a) = a -> Layout a
forall a. a -> Layout a
SingleWindow a
a
transpose (Stack o :: Orientation
o ws :: [(Layout a, RelativeSize)]
ws) = Orientation -> [(Layout a, RelativeSize)] -> Layout a
forall a. Orientation -> [(Layout a, RelativeSize)] -> Layout a
Stack (Orientation -> Orientation
forall r. Transposable r => r -> r
transpose Orientation
o) (((Layout a, RelativeSize) -> (Layout a, RelativeSize))
-> [(Layout a, RelativeSize)] -> [(Layout a, RelativeSize)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Layout a -> Layout a)
-> (Layout a, RelativeSize) -> (Layout a, RelativeSize)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first Layout a -> Layout a
forall r. Transposable r => r -> r
transpose) [(Layout a, RelativeSize)]
ws)
transpose (Pair o :: Orientation
o p :: RelativeSize
p r :: DividerRef
r a :: Layout a
a b :: Layout a
b) = Orientation
-> RelativeSize -> DividerRef -> Layout a -> Layout a -> Layout a
forall a.
Orientation
-> RelativeSize -> DividerRef -> Layout a -> Layout a -> Layout a
Pair (Orientation -> Orientation
forall r. Transposable r => r -> r
transpose Orientation
o) RelativeSize
p DividerRef
r (Layout a -> Layout a
forall r. Transposable r => r -> r
transpose Layout a
a) (Layout a -> Layout a
forall r. Transposable r => r -> r
transpose Layout a
b)
newtype Transposed lm = Transposed lm
deriving(Transposed lm -> Transposed lm -> Bool
(Transposed lm -> Transposed lm -> Bool)
-> (Transposed lm -> Transposed lm -> Bool) -> Eq (Transposed lm)
forall lm. Eq lm => Transposed lm -> Transposed lm -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Transposed lm -> Transposed lm -> Bool
$c/= :: forall lm. Eq lm => Transposed lm -> Transposed lm -> Bool
== :: Transposed lm -> Transposed lm -> Bool
$c== :: forall lm. Eq lm => Transposed lm -> Transposed lm -> Bool
Eq, Typeable)
instance LayoutManager lm => LayoutManager (Transposed lm) where
pureLayout :: Transposed lm -> Layout a -> [a] -> Layout a
pureLayout (Transposed lm :: lm
lm) l :: Layout a
l ws :: [a]
ws = Layout a -> Layout a
forall r. Transposable r => r -> r
transpose (lm -> Layout a -> [a] -> Layout a
forall m a. LayoutManager m => m -> Layout a -> [a] -> Layout a
pureLayout lm
lm (Layout a -> Layout a
forall r. Transposable r => r -> r
transpose Layout a
l) [a]
ws)
describeLayout :: Transposed lm -> [Char]
describeLayout (Transposed lm :: lm
lm) = "Transposed version of: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ lm -> [Char]
forall m. LayoutManager m => m -> [Char]
describeLayout lm
lm
nextVariant :: Transposed lm -> Transposed lm
nextVariant (Transposed lm :: lm
lm) = lm -> Transposed lm
forall lm. lm -> Transposed lm
Transposed (lm -> lm
forall m. LayoutManager m => m -> m
nextVariant lm
lm)
previousVariant :: Transposed lm -> Transposed lm
previousVariant (Transposed lm :: lm
lm) = lm -> Transposed lm
forall lm. lm -> Transposed lm
Transposed (lm -> lm
forall m. LayoutManager m => m -> m
previousVariant lm
lm)
newtype LayoutM a = LayoutM (Monad.State DividerRef (Layout a))
singleWindow :: a -> LayoutM a
singleWindow :: a -> LayoutM a
singleWindow a :: a
a = State DividerRef (Layout a) -> LayoutM a
forall a. State DividerRef (Layout a) -> LayoutM a
LayoutM (Layout a -> State DividerRef (Layout a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> Layout a
forall a. a -> Layout a
SingleWindow a
a))
pair :: Orientation -> DividerPosition -> LayoutM a -> LayoutM a -> LayoutM a
pair :: Orientation -> RelativeSize -> LayoutM a -> LayoutM a -> LayoutM a
pair o :: Orientation
o p :: RelativeSize
p (LayoutM l1 :: State DividerRef (Layout a)
l1) (LayoutM l2 :: State DividerRef (Layout a)
l2) = State DividerRef (Layout a) -> LayoutM a
forall a. State DividerRef (Layout a) -> LayoutM a
LayoutM (State DividerRef (Layout a) -> LayoutM a)
-> State DividerRef (Layout a) -> LayoutM a
forall a b. (a -> b) -> a -> b
$ do
DividerRef
ref <- StateT DividerRef Identity DividerRef
forall s (m :: * -> *). MonadState s m => m s
Monad.get
DividerRef -> StateT DividerRef Identity ()
forall s (m :: * -> *). MonadState s m => s -> m ()
Monad.put (DividerRef
refDividerRef -> DividerRef -> DividerRef
forall a. Num a => a -> a -> a
+1)
Orientation
-> RelativeSize -> DividerRef -> Layout a -> Layout a -> Layout a
forall a.
Orientation
-> RelativeSize -> DividerRef -> Layout a -> Layout a -> Layout a
Pair Orientation
o RelativeSize
p DividerRef
ref (Layout a -> Layout a -> Layout a)
-> State DividerRef (Layout a)
-> StateT DividerRef Identity (Layout a -> Layout a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> State DividerRef (Layout a)
l1 StateT DividerRef Identity (Layout a -> Layout a)
-> State DividerRef (Layout a) -> State DividerRef (Layout a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> State DividerRef (Layout a)
l2
stack :: Orientation -> [(LayoutM a, RelativeSize)] -> LayoutM a
stack :: Orientation -> [(LayoutM a, RelativeSize)] -> LayoutM a
stack _ [] = [Char] -> LayoutM a
forall a. HasCallStack => [Char] -> a
error "Yi.Layout: Length-0 stack"
stack _ [l :: (LayoutM a, RelativeSize)
l] = (LayoutM a, RelativeSize) -> LayoutM a
forall a b. (a, b) -> a
fst (LayoutM a, RelativeSize)
l
stack o :: Orientation
o ls :: [(LayoutM a, RelativeSize)]
ls = State DividerRef (Layout a) -> LayoutM a
forall a. State DividerRef (Layout a) -> LayoutM a
LayoutM (Orientation -> [(Layout a, RelativeSize)] -> Layout a
forall a. Orientation -> [(Layout a, RelativeSize)] -> Layout a
Stack Orientation
o ([(Layout a, RelativeSize)] -> Layout a)
-> StateT DividerRef Identity [(Layout a, RelativeSize)]
-> State DividerRef (Layout a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((LayoutM a, RelativeSize)
-> StateT DividerRef Identity (Layout a, RelativeSize))
-> [(LayoutM a, RelativeSize)]
-> StateT DividerRef Identity [(Layout a, RelativeSize)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\(LayoutM lm :: State DividerRef (Layout a)
lm,rs :: RelativeSize
rs) -> (,RelativeSize
rs) (Layout a -> (Layout a, RelativeSize))
-> State DividerRef (Layout a)
-> StateT DividerRef Identity (Layout a, RelativeSize)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> State DividerRef (Layout a)
lm) [(LayoutM a, RelativeSize)]
ls)
evenStack :: Orientation -> [LayoutM a] -> LayoutM a
evenStack :: Orientation -> [LayoutM a] -> LayoutM a
evenStack o :: Orientation
o ls :: [LayoutM a]
ls = Orientation -> [(LayoutM a, RelativeSize)] -> LayoutM a
forall a. Orientation -> [(LayoutM a, RelativeSize)] -> LayoutM a
stack Orientation
o ((LayoutM a -> (LayoutM a, RelativeSize))
-> [LayoutM a] -> [(LayoutM a, RelativeSize)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\l :: LayoutM a
l -> (LayoutM a
l,1)) [LayoutM a]
ls)
runLayoutM :: LayoutM a -> Layout a
runLayoutM :: LayoutM a -> Layout a
runLayoutM (LayoutM l :: State DividerRef (Layout a)
l) = State DividerRef (Layout a) -> DividerRef -> Layout a
forall s a. State s a -> s -> a
Monad.evalState State DividerRef (Layout a)
l 0