{-# LANGUAGE DeriveDataTypeable        #-}
{-# LANGUAGE DeriveFunctor             #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE Rank2Types                #-}
{-# LANGUAGE TupleSections             #-}
{-# LANGUAGE ViewPatterns              #-}
{-# OPTIONS_GHC -funbox-strict-fields #-} -- we might as well unbox our Ints.

-- | This module defines the layout manager interface (see 'LayoutManager'). To desgin a new layout manager, just make an instance of this class.
module Yi.Layout
  (
    -- * Concrete layouts
    Layout(..),
    Orientation(..),
    DividerPosition,
    DividerRef,
    RelativeSize,
    dividerPositionA,
    findDivider,

    -- * Layout managers
    -- ** The interface
    LayoutManager(..),
    AnyLayoutManager(..),
    layoutManagerSameType,
    -- ** Standard managers
    wide,
    tall,
    slidyTall,
    slidyWide,
    hPairNStack,
    vPairNStack,
    -- * Utility functions
    -- ** Layouts as rectangles
    Rectangle(..),
    HasNeighborWest,
    layoutToRectangles,
    -- ** Transposing things
    Transposable(..),
    Transposed(..),
    -- ** 'DividerRef' combinators
    -- $divRefCombinators
    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)

-------------------------------- Some design notes ----------------------
-- [Treatment of mini windows]

-- Mini windows are not subject to layout; instead, they are always
-- placed at the bottom of the screen. There are multiple reasons for
-- this, as discussed in
-- https://groups.google.com/d/topic/yi-devel/vhTObC25dpY/discussion, one
-- being that for many layouts, the bottom (or top) of the screen is the
-- only reasonable place for mini windows (for example, think about
-- side-by-side layouts).

-- [Design of the 'Layout' datatype]

-- The 'Layout' datatype is currently implemented in terms of
-- horizontal stacks and vertical stacks. An alternative approach,
-- which xmonad uses, is the following: a 'Layout a' could be a
-- function @a -> Rectangle@ which specifies in coordinates where a
-- window should be placed.
--
-- While this alternative is more flexible than the current approach
-- in allowing spiral layouts and the like, the vty UI doesn't support
-- this: only vertical and horizontal composition of images is
-- allowed.



----------------------------------- Concrete 'Layout's.
-- | UI-agnostic layout schema. The basic constructs are
-- (horizontal/vertical) stacks with fixed ratios between window
-- sizes; and (horizontal/vertical) pairs with a slider in between (if
-- available).
data Layout a
  = SingleWindow a
  | Stack {
      forall a. Layout a -> Orientation
orientation :: !Orientation,              -- ^ Orientation
      forall a. Layout a -> [(Layout a, RelativeSize)]
wins        :: [(Layout a, RelativeSize)] -- ^ The layout stack, with the given weights
        -- TODO: fix strictness for stack (it's still lazy)
      }
  | Pair {
       orientation :: !Orientation,     -- ^ Orientation
       forall a. Layout a -> RelativeSize
divPos      :: !DividerPosition, -- ^ Initial position of the divider
       forall a. Layout a -> Int
divRef      :: !DividerRef,      -- ^ Index of the divider (for updating the divider position)
       forall a. Layout a -> Layout a
pairFst     :: !(Layout a),      -- ^ Upper of of the pair
       forall a. Layout a -> Layout a
pairSnd     :: !(Layout a)       -- ^ Lower of the pair
    }
  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
$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
/= :: Layout a -> Layout a -> Bool
Eq, (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
$cfmap :: forall a b. (a -> b) -> Layout a -> Layout b
fmap :: forall a b. (a -> b) -> Layout a -> Layout b
$c<$ :: forall a b. a -> Layout b -> Layout a
<$ :: forall a b. a -> Layout b -> Layout a
Functor)

-- | Accessor for the 'DividerPosition' with given reference
dividerPositionA :: DividerRef -> Lens' (Layout a) DividerPosition
dividerPositionA :: forall a. Int -> Lens' (Layout a) RelativeSize
dividerPositionA Int
ref = (Layout a -> RelativeSize)
-> (Layout a -> RelativeSize -> Layout a)
-> Lens (Layout a) (Layout a) RelativeSize 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 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 a
_) = Layout a
s
      set' p :: Layout a
p@Pair{} | Layout a -> Int
forall a. Layout a -> Int
divRef Layout a
p Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
ref = Layout a
p{ divPos = pos }
                    | Bool
otherwise       = Layout a
p{ pairFst = set' (pairFst p), pairSnd = set' (pairSnd p) }
      set' s :: Layout a
s@Stack{} = Layout a
s{ wins = fmap (first set') (wins 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 a
_) = Maybe RelativeSize
forall a. Maybe a
Nothing
  get' p :: Layout a
p@Pair{} | Layout a -> Int
forall a. Layout a -> Int
divRef Layout a
p Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
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 a. Maybe a -> Maybe a -> Maybe a
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 b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Maybe RelativeSize -> Maybe RelativeSize -> Maybe RelativeSize
forall a. Maybe a -> Maybe a -> Maybe a
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 a b. (a -> b) -> [a] -> [b]
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 [Char]
"Yi.Layout.dividerPositionA: invalid DividerRef"

-- | Find the divider nearest to a given window, or just the first one
-- in case the argument is 'Nothing'
findDivider :: Eq a => Maybe a -> Layout a -> Maybe DividerRef
findDivider :: forall a. Eq a => Maybe a -> Layout a -> Maybe Int
findDivider Maybe a
mbw = [Int] -> Layout a -> Maybe Int
go [] where
  go :: [Int] -> Layout a -> Maybe Int
go [Int]
path (SingleWindow a
w) = Maybe Int -> (a -> Maybe Int) -> Maybe a -> Maybe Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Maybe Int
forall a. Maybe a
Nothing (\a
w' ->
                               if a
w a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
w' Bool -> Bool -> Bool
&& Bool -> Bool
not ([Int] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Int]
path)
                               then Int -> Maybe Int
forall a. a -> Maybe a
Just ([Int] -> Int
forall a. HasCallStack => [a] -> a
head [Int]
path) else Maybe Int
forall a. Maybe a
Nothing) Maybe a
mbw
  go [Int]
path (Pair Orientation
_ RelativeSize
_ Int
ref Layout a
l1 Layout a
l2) = if Maybe a -> Bool
forall a. Maybe a -> Bool
isNothing Maybe a
mbw then Int -> Maybe Int
forall a. a -> Maybe a
Just Int
ref
                                 else let p' :: [Int]
p' = Int
ref Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: [Int]
path
                                      in [Int] -> Layout a -> Maybe Int
go [Int]
p' Layout a
l1 Maybe Int -> Maybe Int -> Maybe Int
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Int] -> Layout a -> Maybe Int
go [Int]
p' Layout a
l2
  go [Int]
path (Stack Orientation
_ [(Layout a, RelativeSize)]
ws) = (Maybe Int -> Maybe Int -> Maybe Int)
-> Maybe Int -> [Maybe Int] -> Maybe Int
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Maybe Int -> Maybe Int -> Maybe Int
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>) Maybe Int
forall a. Maybe a
Nothing ([Maybe Int] -> Maybe Int) -> [Maybe Int] -> Maybe Int
forall a b. (a -> b) -> a -> b
$ ((Layout a, RelativeSize) -> Maybe Int)
-> [(Layout a, RelativeSize)] -> [Maybe Int]
forall a b. (a -> b) -> [a] -> [b]
map ([Int] -> Layout a -> Maybe Int
go [Int]
path (Layout a -> Maybe Int)
-> ((Layout a, RelativeSize) -> Layout a)
-> (Layout a, RelativeSize)
-> Maybe Int
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 -> [Char]
forall a. Show a => a -> [Char]
show a
a
  show (Stack Orientation
o [(Layout a, RelativeSize)]
s) = Orientation -> [Char]
forall a. Show a => a -> [Char]
show Orientation
o [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
" 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]
" " [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)

-- | The def layout consists of a single window
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

-- | Orientations for 'Stack' and 'Pair'
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
$c== :: Orientation -> Orientation -> Bool
== :: Orientation -> Orientation -> Bool
$c/= :: Orientation -> Orientation -> Bool
/= :: Orientation -> Orientation -> Bool
Eq, Int -> Orientation -> ShowS
[Orientation] -> ShowS
Orientation -> [Char]
(Int -> Orientation -> ShowS)
-> (Orientation -> [Char])
-> ([Orientation] -> ShowS)
-> Show Orientation
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Orientation -> ShowS
showsPrec :: Int -> Orientation -> ShowS
$cshow :: Orientation -> [Char]
show :: Orientation -> [Char]
$cshowList :: [Orientation] -> ShowS
showList :: [Orientation] -> ShowS
Show)

-- | Divider reference
type DividerRef = Int

-- | Divider position, in the range (0,1)
type DividerPosition = Double

-- | Relative sizes, for 'Stack'
type RelativeSize = Double

----------------------------------------------------- Layout managers
-- TODO: add Binary requirement when possible
-- | The type of layout managers. See the layout managers 'tall', 'hPairNStack' and 'slidyTall' for some example implementations.
class (Typeable m, Eq m) => LayoutManager m where
  -- | Given the old layout and the new list of windows, construct a
  -- layout for the new list of windows.
  --
  -- If the layout manager uses sliding dividers, then a user will expect that most
  -- of these dividers don't move when adding a new window. It is the layout
  -- manager's responsibility to ensure that this is the case, and this is the
  -- purpose of the @Layout a@ argument.
  --
  -- The old layout may come from a different layout manager, in which case the layout manager is free to ignore it.
  pureLayout :: m -> Layout a -> [a] -> Layout a
  -- | Describe the layout in a form suitable for the user.
  describeLayout :: m -> String
  -- | Cycles to the next variant, if there is one (the default is 'id')
  nextVariant :: m -> m
  nextVariant = m -> m
forall a. a -> a
id
  -- | Cycles to the previous variant, if there is one (the default is 'id'
  previousVariant :: m -> m
  previousVariant = m -> m
forall a. a -> a
id

-- | Existential wrapper for 'Layout'
data AnyLayoutManager = forall m. LayoutManager m => AnyLayoutManager !m
  deriving(Typeable)

instance Eq AnyLayoutManager where
  (AnyLayoutManager m
l1) == :: AnyLayoutManager -> AnyLayoutManager -> Bool
== (AnyLayoutManager 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 :: forall a. AnyLayoutManager -> Layout a -> [a] -> Layout a
pureLayout (AnyLayoutManager m
l) = m -> Layout a -> [a] -> Layout a
forall a. 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 m
l) = m -> [Char]
forall m. LayoutManager m => m -> [Char]
describeLayout m
l
  nextVariant :: AnyLayoutManager -> AnyLayoutManager
nextVariant (AnyLayoutManager 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 m
l) = m -> AnyLayoutManager
forall m. LayoutManager m => m -> AnyLayoutManager
AnyLayoutManager (m -> m
forall m. LayoutManager m => m -> m
previousVariant m
l)

-- | The default layout is 'tallLayout'
instance Default AnyLayoutManager where
  def :: AnyLayoutManager
def = Int -> AnyLayoutManager
hPairNStack Int
1

-- | True if the internal layout managers have the same type (but are not necessarily equal).
layoutManagerSameType :: AnyLayoutManager -> AnyLayoutManager -> Bool
layoutManagerSameType :: AnyLayoutManager -> AnyLayoutManager -> Bool
layoutManagerSameType (AnyLayoutManager m
l1) (AnyLayoutManager 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

------------------------------ Standard layouts
-- | Tall windows (i.e. places windows side-by-side, equally spaced)
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
$c== :: Tall -> Tall -> Bool
== :: Tall -> Tall -> Bool
$c/= :: Tall -> Tall -> Bool
/= :: Tall -> Tall -> Bool
Eq, Typeable)

-- | Windows placed side-by-side, equally spaced.
tall :: AnyLayoutManager
tall :: AnyLayoutManager
tall = Tall -> AnyLayoutManager
forall m. LayoutManager m => m -> AnyLayoutManager
AnyLayoutManager Tall
Tall

instance LayoutManager Tall where
  pureLayout :: forall a. Tall -> Layout a -> [a] -> Layout a
pureLayout Tall
Tall Layout a
_oldLayout [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 a b. (a -> b) -> [a] -> [b]
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
Tall = [Char]
"Windows positioned side-by-side"

-- | Wide windows (windows placed on top of one another, equally spaced)
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
$c== :: Wide -> Wide -> Bool
== :: Wide -> Wide -> Bool
$c/= :: Wide -> Wide -> Bool
/= :: Wide -> Wide -> Bool
Eq, Typeable)

instance LayoutManager Wide where
  pureLayout :: forall a. Wide -> Layout a -> [a] -> Layout a
pureLayout Wide
Wide Layout a
_oldLayout [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 a b. (a -> b) -> [a] -> [b]
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
Wide = [Char]
"Windows positioned above one another"

-- | Windows placed on top of one another, equally spaced
wide :: AnyLayoutManager
wide :: AnyLayoutManager
wide = Wide -> AnyLayoutManager
forall m. LayoutManager m => m -> AnyLayoutManager
AnyLayoutManager Wide
Wide

-- | Tall windows, with arranged in a balanced binary tree with sliders in between them
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
$c== :: SlidyTall -> SlidyTall -> Bool
== :: SlidyTall -> SlidyTall -> Bool
$c/= :: SlidyTall -> SlidyTall -> Bool
/= :: SlidyTall -> SlidyTall -> Bool
Eq, Typeable)

-- | Tall windows, arranged in a balanced binary tree with sliders in between them.
slidyTall :: AnyLayoutManager
slidyTall :: AnyLayoutManager
slidyTall = SlidyTall -> AnyLayoutManager
forall m. LayoutManager m => m -> AnyLayoutManager
AnyLayoutManager SlidyTall
SlidyTall

instance LayoutManager SlidyTall where
  -- an error on input [] is easier to debug than an infinite loop.
  pureLayout :: forall a. SlidyTall -> Layout a -> [a] -> Layout a
pureLayout SlidyTall
SlidyTall Layout a
_oldLayout [] = [Char] -> Layout a
forall a. HasCallStack => [Char] -> a
error [Char]
"Yi.Layout: empty window list unexpected"
  pureLayout SlidyTall
SlidyTall Layout a
oldLayout [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 Maybe (Layout a)
_layout [a
x] = a -> LayoutM a
forall a. a -> LayoutM a
singleWindow a
x
     go Maybe (Layout a)
layout ([a] -> ([a], [a])
forall a. [a] -> ([a], [a])
splitList -> ([a]
lxs, [a]
rxs)) =
       case Maybe (Layout a)
layout of
           -- if the old layout had a pair in the same point of the tree, use its divider position
           Just (Pair Orientation
Horizontal RelativeSize
pos Int
_ Layout a
l 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)
           -- otherwise, just use divider position 0.5
           Maybe (Layout a)
_ -> Orientation -> RelativeSize -> LayoutM a -> LayoutM a -> LayoutM a
forall a.
Orientation -> RelativeSize -> LayoutM a -> LayoutM a -> LayoutM a
pair Orientation
Horizontal RelativeSize
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
SlidyTall = [Char]
"Slidy tall windows, with balanced-position sliders"

splitList :: [a] -> ([a], [a])
splitList :: forall a. [a] -> ([a], [a])
splitList [a]
xs = Int -> [a] -> ([a], [a])
forall a. Int -> [a] -> ([a], [a])
splitAt (([a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
xs Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2) [a]
xs

-- | Transposed version of 'SlidyTall'
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
$c== :: SlidyWide -> SlidyWide -> Bool
== :: SlidyWide -> SlidyWide -> Bool
$c/= :: SlidyWide -> SlidyWide -> Bool
/= :: SlidyWide -> SlidyWide -> Bool
Eq, Typeable)

-- | Transposed version of 'slidyTall'
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 :: forall a. SlidyWide -> Layout a -> [a] -> Layout a
pureLayout (SlidyWide Transposed SlidyTall
w) = Transposed SlidyTall -> Layout a -> [a] -> Layout a
forall a. 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 SlidyWide
_ = [Char]
"Slidy wide windows, with balanced-position sliders"

-- | Fixed number of \"main\" windows on the left; stack of windows on the right
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
$c== :: HPairNStack -> HPairNStack -> Bool
== :: HPairNStack -> HPairNStack -> Bool
$c/= :: HPairNStack -> HPairNStack -> Bool
/= :: HPairNStack -> HPairNStack -> Bool
Eq, Typeable)

-- | @n@ windows on the left; stack of windows on the right.
hPairNStack :: Int -> AnyLayoutManager
hPairNStack :: Int -> AnyLayoutManager
hPairNStack Int
n | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
1     = [Char] -> AnyLayoutManager
forall a. HasCallStack => [Char] -> a
error [Char]
"Yi.Layout.hPairNStackLayout: n must be at least 1"
                    | Bool
otherwise = HPairNStack -> AnyLayoutManager
forall m. LayoutManager m => m -> AnyLayoutManager
AnyLayoutManager (Int -> HPairNStack
HPairNStack Int
n)

instance LayoutManager HPairNStack where
    pureLayout :: forall a. HPairNStack -> Layout a -> [a] -> Layout a
pureLayout (HPairNStack Int
n) Layout a
oldLayout ((a -> LayoutM a) -> [a] -> [LayoutM a]
forall a b. (a -> b) -> [a] -> [b]
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] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [LayoutM a]
xs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
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 Int -> [LayoutM a] -> ([LayoutM a], [LayoutM a])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
n [LayoutM a]
xs of
              ([LayoutM a]
ls, [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 Orientation
Horizontal RelativeSize
pos' Int
_ Layout a
_ Layout a
_ -> RelativeSize
pos'
              Layout a
_ -> RelativeSize
0.5

    describeLayout :: HPairNStack -> [Char]
describeLayout (HPairNStack Int
n) = Int -> [Char]
forall a. Show a => a -> [Char]
show Int
n [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
" windows on the left; remaining windows on the right"
    nextVariant :: HPairNStack -> HPairNStack
nextVariant (HPairNStack Int
n) = Int -> HPairNStack
HPairNStack (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
    previousVariant :: HPairNStack -> HPairNStack
previousVariant (HPairNStack Int
n) = Int -> HPairNStack
HPairNStack (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) Int
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
$c== :: VPairNStack -> VPairNStack -> Bool
== :: VPairNStack -> VPairNStack -> Bool
$c/= :: VPairNStack -> VPairNStack -> Bool
/= :: VPairNStack -> VPairNStack -> Bool
Eq, Typeable)

-- | Transposed version of 'hPairNStack'.
vPairNStack :: Int -> AnyLayoutManager
vPairNStack :: Int -> AnyLayoutManager
vPairNStack Int
n = VPairNStack -> AnyLayoutManager
forall m. LayoutManager m => m -> AnyLayoutManager
AnyLayoutManager (Transposed HPairNStack -> VPairNStack
VPairNStack (HPairNStack -> Transposed HPairNStack
forall lm. lm -> Transposed lm
Transposed (Int -> HPairNStack
HPairNStack Int
n)))

instance LayoutManager VPairNStack where
    pureLayout :: forall a. VPairNStack -> Layout a -> [a] -> Layout a
pureLayout (VPairNStack Transposed HPairNStack
lm) = Transposed HPairNStack -> Layout a -> [a] -> Layout a
forall a. 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 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 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 Int
n))) = Int -> [Char]
forall a. Show a => a -> [Char]
show Int
n [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
" windows on top; remaining windows beneath"

----------------------- Utils

-- | A general bounding box
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
$c== :: Rectangle -> Rectangle -> Bool
== :: Rectangle -> Rectangle -> Bool
$c/= :: Rectangle -> Rectangle -> Bool
/= :: Rectangle -> Rectangle -> Bool
Eq, Int -> Rectangle -> ShowS
[Rectangle] -> ShowS
Rectangle -> [Char]
(Int -> Rectangle -> ShowS)
-> (Rectangle -> [Char])
-> ([Rectangle] -> ShowS)
-> Show Rectangle
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Rectangle -> ShowS
showsPrec :: Int -> Rectangle -> ShowS
$cshow :: Rectangle -> [Char]
show :: Rectangle -> [Char]
$cshowList :: [Rectangle] -> ShowS
showList :: [Rectangle] -> ShowS
Show)

-- | Used by the vty frontend to draw vertical separators
type HasNeighborWest = Bool

layoutToRectangles :: HasNeighborWest -> Rectangle -> Layout a -> [(a, Rectangle, HasNeighborWest)]
layoutToRectangles :: forall a. Bool -> Rectangle -> Layout a -> [(a, Rectangle, Bool)]
layoutToRectangles Bool
nb Rectangle
bounds (SingleWindow a
a) = [(a
a, Rectangle
bounds, Bool
nb)]
layoutToRectangles Bool
nb Rectangle
bounds (Stack Orientation
o [(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
                       (Layout a
l, RelativeSize
s) : [(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 c
val = ((a, b) -> (a, b, c)) -> [(a, b)] -> [(a, b, c)]
forall a b. (a -> b) -> [a] -> [b]
map (\(a
l, b
s) -> (a
l, b
s, c
val))
layoutToRectangles Bool
nb Rectangle
bounds (Pair Orientation
o RelativeSize
p Int
_ Layout a
a 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,RelativeSize
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 :: forall a.
Orientation
-> Rectangle
-> [(Layout a, RelativeSize, Bool)]
-> [(a, Rectangle, Bool)]
handleStack Orientation
o Rectangle
bounds [(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 :: * -> *) s a b.
Traversable t =>
(s -> a -> (s, b)) -> s -> t a -> (s, t b)
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 
      (RelativeSize
totalSpace, RelativeSize
startPos, RelativeSize -> RelativeSize -> Rectangle
mkBounds) = case Orientation
o of
          Orientation
Vertical   -> (Rectangle -> RelativeSize
rectHeight Rectangle
bounds, Rectangle -> RelativeSize
rectY Rectangle
bounds,
                         \RelativeSize
pos RelativeSize
size -> Rectangle
bounds { rectY = pos, rectHeight = size })
          Orientation
Horizontal -> (Rectangle -> RelativeSize
rectWidth Rectangle
bounds,  Rectangle -> RelativeSize
rectX Rectangle
bounds,
                         \RelativeSize
pos RelativeSize
size -> Rectangle
bounds { rectX = pos, rectWidth  = size })
      totalWeight' :: RelativeSize
totalWeight' = [RelativeSize] -> RelativeSize
forall a. Num a => [a] -> a
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 a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Layout a
_, RelativeSize
s, Bool
_) -> 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
> RelativeSize
0 then RelativeSize
totalWeight'
                    else [Char] -> RelativeSize
forall a. HasCallStack => [Char] -> a
error [Char]
"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 RelativeSize
pos (Layout a
t, RelativeSize
wt, 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)

----------- Flipping things
-- | Things with orientations which can be flipped
class Transposable r where transpose :: r -> r
instance Transposable Orientation where { transpose :: Orientation -> Orientation
transpose Orientation
Horizontal = Orientation
Vertical; transpose Orientation
Vertical = Orientation
Horizontal }
instance Transposable (Layout a) where
    transpose :: Layout a -> Layout a
transpose (SingleWindow a
a) = a -> Layout a
forall a. a -> Layout a
SingleWindow a
a
    transpose (Stack Orientation
o [(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 a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Layout a -> Layout a)
-> (Layout a, RelativeSize) -> (Layout a, RelativeSize)
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 Layout a -> Layout a
forall r. Transposable r => r -> r
transpose) [(Layout a, RelativeSize)]
ws)
    transpose (Pair Orientation
o RelativeSize
p Int
r Layout a
a Layout a
b) = Orientation
-> RelativeSize -> Int -> Layout a -> Layout a -> Layout a
forall a.
Orientation
-> RelativeSize -> Int -> Layout a -> Layout a -> Layout a
Pair (Orientation -> Orientation
forall r. Transposable r => r -> r
transpose Orientation
o) RelativeSize
p Int
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)

-- | Same as 'lm', but with all 'Orientation's 'transpose'd. See 'slidyWide' for an example of its use.
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
$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
/= :: Transposed lm -> Transposed lm -> Bool
Eq, Typeable)

instance LayoutManager lm => LayoutManager (Transposed lm) where
    pureLayout :: forall a. Transposed lm -> Layout a -> [a] -> Layout a
pureLayout (Transposed lm
lm) Layout a
l [a]
ws = Layout a -> Layout a
forall r. Transposable r => r -> r
transpose (lm -> Layout a -> [a] -> Layout a
forall a. 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) = [Char]
"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 -> 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 -> Transposed lm
forall lm. lm -> Transposed lm
Transposed (lm -> lm
forall m. LayoutManager m => m -> m
previousVariant lm
lm)

-------------------- 'DividerRef' combinators
-- $divRefCombinators
-- It is tedious and error-prone for 'LayoutManager's to assign 'DividerRef's themselves. Better is to use these monadic smart constructors for 'Layout'. For example, the layout
--
-- @'Pair' 'Horizontal' 0.5 0 ('Pair' 'Vertical' 0.5 1 ('SingleWindow' w1) ('SingleWindow' w2)) ('SingleWindow' w3)@
--
-- could be with the combinators below as
--
-- @'runLayoutM' $ 'pair' 'Horizontal' 0.5 ('pair' 'Vertical' 0.5 ('singleWindow' w1) ('singleWindow' w2)) ('singleWindow' w3)@
--
-- These combinators do will also ensure strictness of the 'wins' field of 'Stack'. They also tidy up and do some error checking: length-1 stacks are removed (they are unnecessary); length-0 stacks raise errors.

-- | A 'Layout a' wrapped in a state monad for tracking 'DividerRef's. This type is /not/ itself a monad, but should rather be thought of as a 'DividerRef'-free version of the 'Layout' type.
newtype LayoutM a = LayoutM (Monad.State DividerRef (Layout a))

singleWindow :: a -> LayoutM a
singleWindow :: forall a. a -> LayoutM a
singleWindow a
a = State Int (Layout a) -> LayoutM a
forall a. State Int (Layout a) -> LayoutM a
LayoutM (Layout a -> State Int (Layout a)
forall a. a -> StateT Int Identity 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 :: forall a.
Orientation -> RelativeSize -> LayoutM a -> LayoutM a -> LayoutM a
pair Orientation
o RelativeSize
p (LayoutM State Int (Layout a)
l1) (LayoutM State Int (Layout a)
l2) = State Int (Layout a) -> LayoutM a
forall a. State Int (Layout a) -> LayoutM a
LayoutM (State Int (Layout a) -> LayoutM a)
-> State Int (Layout a) -> LayoutM a
forall a b. (a -> b) -> a -> b
$ do
    Int
ref <- StateT Int Identity Int
forall s (m :: * -> *). MonadState s m => m s
Monad.get
    Int -> StateT Int Identity ()
forall s (m :: * -> *). MonadState s m => s -> m ()
Monad.put (Int
refInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
    Orientation
-> RelativeSize -> Int -> Layout a -> Layout a -> Layout a
forall a.
Orientation
-> RelativeSize -> Int -> Layout a -> Layout a -> Layout a
Pair Orientation
o RelativeSize
p Int
ref (Layout a -> Layout a -> Layout a)
-> State Int (Layout a)
-> StateT Int Identity (Layout a -> Layout a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> State Int (Layout a)
l1 StateT Int Identity (Layout a -> Layout a)
-> State Int (Layout a) -> State Int (Layout a)
forall a b.
StateT Int Identity (a -> b)
-> StateT Int Identity a -> StateT Int Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> State Int (Layout a)
l2

stack :: Orientation -> [(LayoutM a, RelativeSize)] -> LayoutM a
stack :: forall a. Orientation -> [(LayoutM a, RelativeSize)] -> LayoutM a
stack Orientation
_ [] = [Char] -> LayoutM a
forall a. HasCallStack => [Char] -> a
error [Char]
"Yi.Layout: Length-0 stack"
stack Orientation
_ [(LayoutM a, RelativeSize)
l] = (LayoutM a, RelativeSize) -> LayoutM a
forall a b. (a, b) -> a
fst (LayoutM a, RelativeSize)
l
stack Orientation
o [(LayoutM a, RelativeSize)]
ls = State Int (Layout a) -> LayoutM a
forall a. State Int (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 Int Identity [(Layout a, RelativeSize)]
-> State Int (Layout a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((LayoutM a, RelativeSize)
 -> StateT Int Identity (Layout a, RelativeSize))
-> [(LayoutM a, RelativeSize)]
-> StateT Int Identity [(Layout a, RelativeSize)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (\(LayoutM State Int (Layout a)
lm,RelativeSize
rs) -> (,RelativeSize
rs) (Layout a -> (Layout a, RelativeSize))
-> State Int (Layout a)
-> StateT Int Identity (Layout a, RelativeSize)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> State Int (Layout a)
lm) [(LayoutM a, RelativeSize)]
ls)

-- | Special case of 'stack' with all 'RelativeSize's equal.
evenStack :: Orientation -> [LayoutM a] -> LayoutM a
evenStack :: forall a. Orientation -> [LayoutM a] -> LayoutM a
evenStack Orientation
o [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 a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\LayoutM a
l -> (LayoutM a
l,RelativeSize
1)) [LayoutM a]
ls)

runLayoutM :: LayoutM a -> Layout a
runLayoutM :: forall a. LayoutM a -> Layout a
runLayoutM (LayoutM State Int (Layout a)
l) = State Int (Layout a) -> Int -> Layout a
forall s a. State s a -> s -> a
Monad.evalState State Int (Layout a)
l Int
0