{-# LANGUAGE FlexibleContexts, FlexibleInstances, MultiParamTypeClasses,
             UndecidableInstances, PatternGuards #-}

-----------------------------------------------------------------------------
-- |
-- Module      :  XMonad.Layout.Combo
-- Description :  A layout that combines multiple layouts.
-- Copyright   :  (c) David Roundy <droundy@darcs.net>
-- License     :  BSD-style (see LICENSE)
--
-- Maintainer  :  none
-- Stability   :  unstable
-- Portability :  unportable
--
-- A layout that combines multiple layouts.
--
-----------------------------------------------------------------------------

module XMonad.Layout.Combo (
                            -- * Usage
                            -- $usage
                            combineTwo,
                            CombineTwo
                           ) where

import XMonad hiding (focus)
import XMonad.Prelude (delete, fromMaybe, intersect, isJust, (\\))
import XMonad.StackSet ( integrate', Workspace (..), Stack(..) )
import XMonad.Layout.WindowNavigation ( MoveWindowToWindow(..) )
import qualified XMonad.StackSet as W ( differentiate )

-- $usage
-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
--
-- > import XMonad.Layout.Combo
--
-- and add something like
--
-- > combineTwo (TwoPane 0.03 0.5) (tabbed shrinkText defaultTConf) (tabbed shrinkText defaultTConf)
--
-- to your layouts.
--
-- For more detailed instructions on editing the layoutHook see:
--
-- "XMonad.Doc.Extending#Editing_the_layout_hook"
--
-- combineTwo is a new simple layout combinator. It allows the
-- combination of two layouts using a third to split the screen
-- between the two, but has the advantage of allowing you to
-- dynamically adjust the layout, in terms of the number of windows in
-- each sublayout. To do this, use "XMonad.Layout.WindowNavigation",
-- and add the following key bindings (or something similar):
--
-- >    , ((modm .|. controlMask .|. shiftMask, xK_Right), sendMessage $ Move R)
-- >    , ((modm .|. controlMask .|. shiftMask, xK_Left ), sendMessage $ Move L)
-- >    , ((modm .|. controlMask .|. shiftMask, xK_Up   ), sendMessage $ Move U)
-- >    , ((modm .|. controlMask .|. shiftMask, xK_Down ), sendMessage $ Move D)
--
-- For detailed instruction on editing the key binding see
-- "XMonad.Doc.Extending#Editing_key_bindings".
--
-- These bindings will move a window into the sublayout that is
-- up\/down\/left\/right of its current position.  Note that there is some
-- weirdness in combineTwo, in that the mod-tab focus order is not very closely
-- related to the layout order. This is because we're forced to keep track of
-- the window positions separately, and this is ugly.  If you don't like this,
-- lobby for hierarchical stacks in core xmonad or go reimplement the core of
-- xmonad yourself.

data CombineTwo l l1 l2 a = C2 [a] [a] l (l1 a) (l2 a)
                            deriving (ReadPrec [CombineTwo l l1 l2 a]
ReadPrec (CombineTwo l l1 l2 a)
Int -> ReadS (CombineTwo l l1 l2 a)
ReadS [CombineTwo l l1 l2 a]
(Int -> ReadS (CombineTwo l l1 l2 a))
-> ReadS [CombineTwo l l1 l2 a]
-> ReadPrec (CombineTwo l l1 l2 a)
-> ReadPrec [CombineTwo l l1 l2 a]
-> Read (CombineTwo l l1 l2 a)
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
forall l (l1 :: * -> *) (l2 :: * -> *) a.
(Read a, Read l, Read (l1 a), Read (l2 a)) =>
ReadPrec [CombineTwo l l1 l2 a]
forall l (l1 :: * -> *) (l2 :: * -> *) a.
(Read a, Read l, Read (l1 a), Read (l2 a)) =>
ReadPrec (CombineTwo l l1 l2 a)
forall l (l1 :: * -> *) (l2 :: * -> *) a.
(Read a, Read l, Read (l1 a), Read (l2 a)) =>
Int -> ReadS (CombineTwo l l1 l2 a)
forall l (l1 :: * -> *) (l2 :: * -> *) a.
(Read a, Read l, Read (l1 a), Read (l2 a)) =>
ReadS [CombineTwo l l1 l2 a]
readListPrec :: ReadPrec [CombineTwo l l1 l2 a]
$creadListPrec :: forall l (l1 :: * -> *) (l2 :: * -> *) a.
(Read a, Read l, Read (l1 a), Read (l2 a)) =>
ReadPrec [CombineTwo l l1 l2 a]
readPrec :: ReadPrec (CombineTwo l l1 l2 a)
$creadPrec :: forall l (l1 :: * -> *) (l2 :: * -> *) a.
(Read a, Read l, Read (l1 a), Read (l2 a)) =>
ReadPrec (CombineTwo l l1 l2 a)
readList :: ReadS [CombineTwo l l1 l2 a]
$creadList :: forall l (l1 :: * -> *) (l2 :: * -> *) a.
(Read a, Read l, Read (l1 a), Read (l2 a)) =>
ReadS [CombineTwo l l1 l2 a]
readsPrec :: Int -> ReadS (CombineTwo l l1 l2 a)
$creadsPrec :: forall l (l1 :: * -> *) (l2 :: * -> *) a.
(Read a, Read l, Read (l1 a), Read (l2 a)) =>
Int -> ReadS (CombineTwo l l1 l2 a)
Read, Int -> CombineTwo l l1 l2 a -> ShowS
[CombineTwo l l1 l2 a] -> ShowS
CombineTwo l l1 l2 a -> String
(Int -> CombineTwo l l1 l2 a -> ShowS)
-> (CombineTwo l l1 l2 a -> String)
-> ([CombineTwo l l1 l2 a] -> ShowS)
-> Show (CombineTwo l l1 l2 a)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall l (l1 :: * -> *) (l2 :: * -> *) a.
(Show a, Show l, Show (l1 a), Show (l2 a)) =>
Int -> CombineTwo l l1 l2 a -> ShowS
forall l (l1 :: * -> *) (l2 :: * -> *) a.
(Show a, Show l, Show (l1 a), Show (l2 a)) =>
[CombineTwo l l1 l2 a] -> ShowS
forall l (l1 :: * -> *) (l2 :: * -> *) a.
(Show a, Show l, Show (l1 a), Show (l2 a)) =>
CombineTwo l l1 l2 a -> String
showList :: [CombineTwo l l1 l2 a] -> ShowS
$cshowList :: forall l (l1 :: * -> *) (l2 :: * -> *) a.
(Show a, Show l, Show (l1 a), Show (l2 a)) =>
[CombineTwo l l1 l2 a] -> ShowS
show :: CombineTwo l l1 l2 a -> String
$cshow :: forall l (l1 :: * -> *) (l2 :: * -> *) a.
(Show a, Show l, Show (l1 a), Show (l2 a)) =>
CombineTwo l l1 l2 a -> String
showsPrec :: Int -> CombineTwo l l1 l2 a -> ShowS
$cshowsPrec :: forall l (l1 :: * -> *) (l2 :: * -> *) a.
(Show a, Show l, Show (l1 a), Show (l2 a)) =>
Int -> CombineTwo l l1 l2 a -> ShowS
Show)

combineTwo :: (Read a, Eq a, LayoutClass super (), LayoutClass l1 a, LayoutClass l2 a) =>
              super () -> l1 a -> l2 a -> CombineTwo (super ()) l1 l2 a
combineTwo :: super () -> l1 a -> l2 a -> CombineTwo (super ()) l1 l2 a
combineTwo = [a]
-> [a] -> super () -> l1 a -> l2 a -> CombineTwo (super ()) l1 l2 a
forall l (l1 :: * -> *) (l2 :: * -> *) a.
[a] -> [a] -> l -> l1 a -> l2 a -> CombineTwo l l1 l2 a
C2 [] []

instance (LayoutClass l (), LayoutClass l1 a, LayoutClass l2 a, Read a, Show a, Eq a, Typeable a)
    => LayoutClass (CombineTwo (l ()) l1 l2) a where
    runLayout :: Workspace String (CombineTwo (l ()) l1 l2 a) a
-> Rectangle
-> X ([(a, Rectangle)], Maybe (CombineTwo (l ()) l1 l2 a))
runLayout (Workspace String
_ (C2 [a]
f [a]
w2 l ()
super l1 a
l1 l2 a
l2) Maybe (Stack a)
s) Rectangle
rinput = [a] -> X ([(a, Rectangle)], Maybe (CombineTwo (l ()) l1 l2 a))
arrange (Maybe (Stack a) -> [a]
forall a. Maybe (Stack a) -> [a]
integrate' Maybe (Stack a)
s)
        where arrange :: [a] -> X ([(a, Rectangle)], Maybe (CombineTwo (l ()) l1 l2 a))
arrange [] = do l1 a
l1' <- l1 a -> Maybe (l1 a) -> l1 a
forall a. a -> Maybe a -> a
fromMaybe l1 a
l1 (Maybe (l1 a) -> l1 a) -> X (Maybe (l1 a)) -> X (l1 a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> l1 a -> SomeMessage -> X (Maybe (l1 a))
forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> SomeMessage -> X (Maybe (layout a))
handleMessage l1 a
l1 (LayoutMessages -> SomeMessage
forall a. Message a => a -> SomeMessage
SomeMessage LayoutMessages
ReleaseResources)
                              l2 a
l2' <- l2 a -> Maybe (l2 a) -> l2 a
forall a. a -> Maybe a -> a
fromMaybe l2 a
l2 (Maybe (l2 a) -> l2 a) -> X (Maybe (l2 a)) -> X (l2 a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> l2 a -> SomeMessage -> X (Maybe (l2 a))
forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> SomeMessage -> X (Maybe (layout a))
handleMessage l2 a
l2 (LayoutMessages -> SomeMessage
forall a. Message a => a -> SomeMessage
SomeMessage LayoutMessages
ReleaseResources)
                              l ()
super' <- l () -> Maybe (l ()) -> l ()
forall a. a -> Maybe a -> a
fromMaybe l ()
super (Maybe (l ()) -> l ()) -> X (Maybe (l ())) -> X (l ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                                        l () -> SomeMessage -> X (Maybe (l ()))
forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> SomeMessage -> X (Maybe (layout a))
handleMessage l ()
super (LayoutMessages -> SomeMessage
forall a. Message a => a -> SomeMessage
SomeMessage LayoutMessages
ReleaseResources)
                              ([(a, Rectangle)], Maybe (CombineTwo (l ()) l1 l2 a))
-> X ([(a, Rectangle)], Maybe (CombineTwo (l ()) l1 l2 a))
forall (m :: * -> *) a. Monad m => a -> m a
return ([], CombineTwo (l ()) l1 l2 a -> Maybe (CombineTwo (l ()) l1 l2 a)
forall a. a -> Maybe a
Just (CombineTwo (l ()) l1 l2 a -> Maybe (CombineTwo (l ()) l1 l2 a))
-> CombineTwo (l ()) l1 l2 a -> Maybe (CombineTwo (l ()) l1 l2 a)
forall a b. (a -> b) -> a -> b
$ [a] -> [a] -> l () -> l1 a -> l2 a -> CombineTwo (l ()) l1 l2 a
forall l (l1 :: * -> *) (l2 :: * -> *) a.
[a] -> [a] -> l -> l1 a -> l2 a -> CombineTwo l l1 l2 a
C2 [] [] l ()
super' l1 a
l1' l2 a
l2')
              arrange [a
w] = do l1 a
l1' <- l1 a -> Maybe (l1 a) -> l1 a
forall a. a -> Maybe a -> a
fromMaybe l1 a
l1 (Maybe (l1 a) -> l1 a) -> X (Maybe (l1 a)) -> X (l1 a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> l1 a -> SomeMessage -> X (Maybe (l1 a))
forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> SomeMessage -> X (Maybe (layout a))
handleMessage l1 a
l1 (LayoutMessages -> SomeMessage
forall a. Message a => a -> SomeMessage
SomeMessage LayoutMessages
ReleaseResources)
                               l2 a
l2' <- l2 a -> Maybe (l2 a) -> l2 a
forall a. a -> Maybe a -> a
fromMaybe l2 a
l2 (Maybe (l2 a) -> l2 a) -> X (Maybe (l2 a)) -> X (l2 a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> l2 a -> SomeMessage -> X (Maybe (l2 a))
forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> SomeMessage -> X (Maybe (layout a))
handleMessage l2 a
l2 (LayoutMessages -> SomeMessage
forall a. Message a => a -> SomeMessage
SomeMessage LayoutMessages
ReleaseResources)
                               l ()
super' <- l () -> Maybe (l ()) -> l ()
forall a. a -> Maybe a -> a
fromMaybe l ()
super (Maybe (l ()) -> l ()) -> X (Maybe (l ())) -> X (l ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                                         l () -> SomeMessage -> X (Maybe (l ()))
forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> SomeMessage -> X (Maybe (layout a))
handleMessage l ()
super (LayoutMessages -> SomeMessage
forall a. Message a => a -> SomeMessage
SomeMessage LayoutMessages
ReleaseResources)
                               ([(a, Rectangle)], Maybe (CombineTwo (l ()) l1 l2 a))
-> X ([(a, Rectangle)], Maybe (CombineTwo (l ()) l1 l2 a))
forall (m :: * -> *) a. Monad m => a -> m a
return ([(a
w,Rectangle
rinput)], CombineTwo (l ()) l1 l2 a -> Maybe (CombineTwo (l ()) l1 l2 a)
forall a. a -> Maybe a
Just (CombineTwo (l ()) l1 l2 a -> Maybe (CombineTwo (l ()) l1 l2 a))
-> CombineTwo (l ()) l1 l2 a -> Maybe (CombineTwo (l ()) l1 l2 a)
forall a b. (a -> b) -> a -> b
$ [a] -> [a] -> l () -> l1 a -> l2 a -> CombineTwo (l ()) l1 l2 a
forall l (l1 :: * -> *) (l2 :: * -> *) a.
[a] -> [a] -> l -> l1 a -> l2 a -> CombineTwo l l1 l2 a
C2 [a
w] [a
w] l ()
super' l1 a
l1' l2 a
l2')
              arrange [a]
origws =
                  do let w2' :: [a]
w2' = case [a]
origws [a] -> [a] -> [a]
forall a. Eq a => [a] -> [a] -> [a]
`intersect` [a]
w2 of [] -> [[a] -> a
forall a. [a] -> a
head [a]
origws]
                                                             [a
x] -> [a
x]
                                                             [a]
x -> case [a]
origws [a] -> [a] -> [a]
forall a. Eq a => [a] -> [a] -> [a]
\\ [a]
x of
                                                                  [] -> [a] -> [a]
forall a. [a] -> [a]
init [a]
x
                                                                  [a]
_ -> [a]
x
                         superstack :: Stack ()
superstack = Stack :: forall a. a -> [a] -> [a] -> Stack a
Stack { focus :: ()
focus=(), up :: [()]
up=[], down :: [()]
down=[()] }
                         s1 :: Maybe (Stack a)
s1 = [a] -> [a] -> Maybe (Stack a)
forall q. Eq q => [q] -> [q] -> Maybe (Stack q)
differentiate [a]
f' ([a]
origws [a] -> [a] -> [a]
forall a. Eq a => [a] -> [a] -> [a]
\\ [a]
w2')
                         s2 :: Maybe (Stack a)
s2 = [a] -> [a] -> Maybe (Stack a)
forall q. Eq q => [q] -> [q] -> Maybe (Stack q)
differentiate [a]
f' [a]
w2'
                         f' :: [a]
f' = case Maybe (Stack a)
s of (Just Stack a
s') -> Stack a -> a
forall a. Stack a -> a
focus Stack a
s'a -> [a] -> [a]
forall a. a -> [a] -> [a]
:a -> [a] -> [a]
forall a. Eq a => a -> [a] -> [a]
delete (Stack a -> a
forall a. Stack a -> a
focus Stack a
s') [a]
f
                                        Maybe (Stack a)
Nothing -> [a]
f
                     ([((),Rectangle
r1),((),Rectangle
r2)], Maybe (l ())
msuper') <- Workspace String (l ()) ()
-> Rectangle -> X ([((), Rectangle)], Maybe (l ()))
forall (layout :: * -> *) a.
LayoutClass layout a =>
Workspace String (layout a) a
-> Rectangle -> X ([(a, Rectangle)], Maybe (layout a))
runLayout (String -> l () -> Maybe (Stack ()) -> Workspace String (l ()) ()
forall i l a. i -> l -> Maybe (Stack a) -> Workspace i l a
Workspace String
"" l ()
super (Stack () -> Maybe (Stack ())
forall a. a -> Maybe a
Just Stack ()
superstack)) Rectangle
rinput
                     ([(a, Rectangle)]
wrs1, Maybe (l1 a)
ml1') <- Workspace String (l1 a) a
-> Rectangle -> X ([(a, Rectangle)], Maybe (l1 a))
forall (layout :: * -> *) a.
LayoutClass layout a =>
Workspace String (layout a) a
-> Rectangle -> X ([(a, Rectangle)], Maybe (layout a))
runLayout (String -> l1 a -> Maybe (Stack a) -> Workspace String (l1 a) a
forall i l a. i -> l -> Maybe (Stack a) -> Workspace i l a
Workspace String
"" l1 a
l1 Maybe (Stack a)
s1) Rectangle
r1
                     ([(a, Rectangle)]
wrs2, Maybe (l2 a)
ml2') <- Workspace String (l2 a) a
-> Rectangle -> X ([(a, Rectangle)], Maybe (l2 a))
forall (layout :: * -> *) a.
LayoutClass layout a =>
Workspace String (layout a) a
-> Rectangle -> X ([(a, Rectangle)], Maybe (layout a))
runLayout (String -> l2 a -> Maybe (Stack a) -> Workspace String (l2 a) a
forall i l a. i -> l -> Maybe (Stack a) -> Workspace i l a
Workspace String
"" l2 a
l2 Maybe (Stack a)
s2) Rectangle
r2
                     ([(a, Rectangle)], Maybe (CombineTwo (l ()) l1 l2 a))
-> X ([(a, Rectangle)], Maybe (CombineTwo (l ()) l1 l2 a))
forall (m :: * -> *) a. Monad m => a -> m a
return ([(a, Rectangle)]
wrs1[(a, Rectangle)] -> [(a, Rectangle)] -> [(a, Rectangle)]
forall a. [a] -> [a] -> [a]
++[(a, Rectangle)]
wrs2, CombineTwo (l ()) l1 l2 a -> Maybe (CombineTwo (l ()) l1 l2 a)
forall a. a -> Maybe a
Just (CombineTwo (l ()) l1 l2 a -> Maybe (CombineTwo (l ()) l1 l2 a))
-> CombineTwo (l ()) l1 l2 a -> Maybe (CombineTwo (l ()) l1 l2 a)
forall a b. (a -> b) -> a -> b
$ [a] -> [a] -> l () -> l1 a -> l2 a -> CombineTwo (l ()) l1 l2 a
forall l (l1 :: * -> *) (l2 :: * -> *) a.
[a] -> [a] -> l -> l1 a -> l2 a -> CombineTwo l l1 l2 a
C2 [a]
f' [a]
w2'
                                     (l () -> Maybe (l ()) -> l ()
forall a. a -> Maybe a -> a
fromMaybe l ()
super Maybe (l ())
msuper') (l1 a -> Maybe (l1 a) -> l1 a
forall a. a -> Maybe a -> a
fromMaybe l1 a
l1 Maybe (l1 a)
ml1') (l2 a -> Maybe (l2 a) -> l2 a
forall a. a -> Maybe a -> a
fromMaybe l2 a
l2 Maybe (l2 a)
ml2'))
    handleMessage :: CombineTwo (l ()) l1 l2 a
-> SomeMessage -> X (Maybe (CombineTwo (l ()) l1 l2 a))
handleMessage (C2 [a]
f [a]
ws2 l ()
super l1 a
l1 l2 a
l2) SomeMessage
m
        | Just (MoveWindowToWindow a
w1 a
w2) <- SomeMessage -> Maybe (MoveWindowToWindow a)
forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m,
          a
w1 a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [a]
ws2,
          a
w2 a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [a]
ws2 = do l1 a
l1' <- l1 a -> Maybe (l1 a) -> l1 a
forall a. a -> Maybe a -> a
fromMaybe l1 a
l1 (Maybe (l1 a) -> l1 a) -> X (Maybe (l1 a)) -> X (l1 a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> l1 a -> SomeMessage -> X (Maybe (l1 a))
forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> SomeMessage -> X (Maybe (layout a))
handleMessage l1 a
l1 SomeMessage
m
                             l2 a
l2' <- l2 a -> Maybe (l2 a) -> l2 a
forall a. a -> Maybe a -> a
fromMaybe l2 a
l2 (Maybe (l2 a) -> l2 a) -> X (Maybe (l2 a)) -> X (l2 a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> l2 a -> SomeMessage -> X (Maybe (l2 a))
forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> SomeMessage -> X (Maybe (layout a))
handleMessage l2 a
l2 SomeMessage
m
                             Maybe (CombineTwo (l ()) l1 l2 a)
-> X (Maybe (CombineTwo (l ()) l1 l2 a))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (CombineTwo (l ()) l1 l2 a)
 -> X (Maybe (CombineTwo (l ()) l1 l2 a)))
-> Maybe (CombineTwo (l ()) l1 l2 a)
-> X (Maybe (CombineTwo (l ()) l1 l2 a))
forall a b. (a -> b) -> a -> b
$ CombineTwo (l ()) l1 l2 a -> Maybe (CombineTwo (l ()) l1 l2 a)
forall a. a -> Maybe a
Just (CombineTwo (l ()) l1 l2 a -> Maybe (CombineTwo (l ()) l1 l2 a))
-> CombineTwo (l ()) l1 l2 a -> Maybe (CombineTwo (l ()) l1 l2 a)
forall a b. (a -> b) -> a -> b
$ [a] -> [a] -> l () -> l1 a -> l2 a -> CombineTwo (l ()) l1 l2 a
forall l (l1 :: * -> *) (l2 :: * -> *) a.
[a] -> [a] -> l -> l1 a -> l2 a -> CombineTwo l l1 l2 a
C2 [a]
f (a
w1a -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
ws2) l ()
super l1 a
l1' l2 a
l2'
        | Just (MoveWindowToWindow a
w1 a
w2) <- SomeMessage -> Maybe (MoveWindowToWindow a)
forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m,
          a
w1 a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [a]
ws2,
          a
w2 a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [a]
ws2 = do l1 a
l1' <- l1 a -> Maybe (l1 a) -> l1 a
forall a. a -> Maybe a -> a
fromMaybe l1 a
l1 (Maybe (l1 a) -> l1 a) -> X (Maybe (l1 a)) -> X (l1 a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> l1 a -> SomeMessage -> X (Maybe (l1 a))
forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> SomeMessage -> X (Maybe (layout a))
handleMessage l1 a
l1 SomeMessage
m
                                l2 a
l2' <- l2 a -> Maybe (l2 a) -> l2 a
forall a. a -> Maybe a -> a
fromMaybe l2 a
l2 (Maybe (l2 a) -> l2 a) -> X (Maybe (l2 a)) -> X (l2 a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> l2 a -> SomeMessage -> X (Maybe (l2 a))
forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> SomeMessage -> X (Maybe (layout a))
handleMessage l2 a
l2 SomeMessage
m
                                let ws2' :: [a]
ws2' = case a -> [a] -> [a]
forall a. Eq a => a -> [a] -> [a]
delete a
w1 [a]
ws2 of [] -> [a
w2]
                                                                 [a]
x -> [a]
x
                                Maybe (CombineTwo (l ()) l1 l2 a)
-> X (Maybe (CombineTwo (l ()) l1 l2 a))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (CombineTwo (l ()) l1 l2 a)
 -> X (Maybe (CombineTwo (l ()) l1 l2 a)))
-> Maybe (CombineTwo (l ()) l1 l2 a)
-> X (Maybe (CombineTwo (l ()) l1 l2 a))
forall a b. (a -> b) -> a -> b
$ CombineTwo (l ()) l1 l2 a -> Maybe (CombineTwo (l ()) l1 l2 a)
forall a. a -> Maybe a
Just (CombineTwo (l ()) l1 l2 a -> Maybe (CombineTwo (l ()) l1 l2 a))
-> CombineTwo (l ()) l1 l2 a -> Maybe (CombineTwo (l ()) l1 l2 a)
forall a b. (a -> b) -> a -> b
$ [a] -> [a] -> l () -> l1 a -> l2 a -> CombineTwo (l ()) l1 l2 a
forall l (l1 :: * -> *) (l2 :: * -> *) a.
[a] -> [a] -> l -> l1 a -> l2 a -> CombineTwo l l1 l2 a
C2 [a]
f [a]
ws2' l ()
super l1 a
l1' l2 a
l2'
        | Bool
otherwise = do Maybe [l1 a]
ml1' <- SomeMessage -> [l1 a] -> X (Maybe [l1 a])
forall (l :: * -> *) b.
LayoutClass l b =>
SomeMessage -> [l b] -> X (Maybe [l b])
broadcastPrivate SomeMessage
m [l1 a
l1]
                         Maybe [l2 a]
ml2' <- SomeMessage -> [l2 a] -> X (Maybe [l2 a])
forall (l :: * -> *) b.
LayoutClass l b =>
SomeMessage -> [l b] -> X (Maybe [l b])
broadcastPrivate SomeMessage
m [l2 a
l2]
                         Maybe [l ()]
msuper' <- SomeMessage -> [l ()] -> X (Maybe [l ()])
forall (l :: * -> *) b.
LayoutClass l b =>
SomeMessage -> [l b] -> X (Maybe [l b])
broadcastPrivate SomeMessage
m [l ()
super]
                         if Maybe [l ()] -> Bool
forall a. Maybe a -> Bool
isJust Maybe [l ()]
msuper' Bool -> Bool -> Bool
|| Maybe [l1 a] -> Bool
forall a. Maybe a -> Bool
isJust Maybe [l1 a]
ml1' Bool -> Bool -> Bool
|| Maybe [l2 a] -> Bool
forall a. Maybe a -> Bool
isJust Maybe [l2 a]
ml2'
                            then Maybe (CombineTwo (l ()) l1 l2 a)
-> X (Maybe (CombineTwo (l ()) l1 l2 a))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (CombineTwo (l ()) l1 l2 a)
 -> X (Maybe (CombineTwo (l ()) l1 l2 a)))
-> Maybe (CombineTwo (l ()) l1 l2 a)
-> X (Maybe (CombineTwo (l ()) l1 l2 a))
forall a b. (a -> b) -> a -> b
$ CombineTwo (l ()) l1 l2 a -> Maybe (CombineTwo (l ()) l1 l2 a)
forall a. a -> Maybe a
Just (CombineTwo (l ()) l1 l2 a -> Maybe (CombineTwo (l ()) l1 l2 a))
-> CombineTwo (l ()) l1 l2 a -> Maybe (CombineTwo (l ()) l1 l2 a)
forall a b. (a -> b) -> a -> b
$ [a] -> [a] -> l () -> l1 a -> l2 a -> CombineTwo (l ()) l1 l2 a
forall l (l1 :: * -> *) (l2 :: * -> *) a.
[a] -> [a] -> l -> l1 a -> l2 a -> CombineTwo l l1 l2 a
C2 [a]
f [a]
ws2
                                                 (l () -> ([l ()] -> l ()) -> Maybe [l ()] -> l ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe l ()
super [l ()] -> l ()
forall a. [a] -> a
head Maybe [l ()]
msuper')
                                                 (l1 a -> ([l1 a] -> l1 a) -> Maybe [l1 a] -> l1 a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe l1 a
l1 [l1 a] -> l1 a
forall a. [a] -> a
head Maybe [l1 a]
ml1')
                                                 (l2 a -> ([l2 a] -> l2 a) -> Maybe [l2 a] -> l2 a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe l2 a
l2 [l2 a] -> l2 a
forall a. [a] -> a
head Maybe [l2 a]
ml2')
                            else Maybe (CombineTwo (l ()) l1 l2 a)
-> X (Maybe (CombineTwo (l ()) l1 l2 a))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (CombineTwo (l ()) l1 l2 a)
forall a. Maybe a
Nothing
    description :: CombineTwo (l ()) l1 l2 a -> String
description (C2 [a]
_ [a]
_ l ()
super l1 a
l1 l2 a
l2) = String
"combining "String -> ShowS
forall a. [a] -> [a] -> [a]
++ l1 a -> String
forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> String
description l1 a
l1 String -> ShowS
forall a. [a] -> [a] -> [a]
++String
" and "String -> ShowS
forall a. [a] -> [a] -> [a]
++
                                       l2 a -> String
forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> String
description l2 a
l2 String -> ShowS
forall a. [a] -> [a] -> [a]
++String
" with "String -> ShowS
forall a. [a] -> [a] -> [a]
++ l () -> String
forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> String
description l ()
super


differentiate :: Eq q => [q] -> [q] -> Maybe (Stack q)
differentiate :: [q] -> [q] -> Maybe (Stack q)
differentiate (q
z:[q]
zs) [q]
xs | q
z q -> [q] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [q]
xs = Stack q -> Maybe (Stack q)
forall a. a -> Maybe a
Just (Stack q -> Maybe (Stack q)) -> Stack q -> Maybe (Stack q)
forall a b. (a -> b) -> a -> b
$ Stack :: forall a. a -> [a] -> [a] -> Stack a
Stack { focus :: q
focus=q
z
                                                     , up :: [q]
up = [q] -> [q]
forall a. [a] -> [a]
reverse ([q] -> [q]) -> [q] -> [q]
forall a b. (a -> b) -> a -> b
$ (q -> Bool) -> [q] -> [q]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (q -> q -> Bool
forall a. Eq a => a -> a -> Bool
/=q
z) [q]
xs
                                                     , down :: [q]
down = [q] -> [q]
forall a. [a] -> [a]
tail ([q] -> [q]) -> [q] -> [q]
forall a b. (a -> b) -> a -> b
$ (q -> Bool) -> [q] -> [q]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (q -> q -> Bool
forall a. Eq a => a -> a -> Bool
/=q
z) [q]
xs }
                        | Bool
otherwise = [q] -> [q] -> Maybe (Stack q)
forall q. Eq q => [q] -> [q] -> Maybe (Stack q)
differentiate [q]
zs [q]
xs
differentiate [] [q]
xs = [q] -> Maybe (Stack q)
forall a. [a] -> Maybe (Stack a)
W.differentiate [q]
xs

broadcastPrivate :: LayoutClass l b => SomeMessage -> [l b] -> X (Maybe [l b])
broadcastPrivate :: SomeMessage -> [l b] -> X (Maybe [l b])
broadcastPrivate SomeMessage
a [l b]
ol = do [Maybe (l b)]
nml <- (l b -> X (Maybe (l b))) -> [l b] -> X [Maybe (l b)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM l b -> X (Maybe (l b))
forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> X (Maybe (layout a))
f [l b]
ol
                           if (Maybe (l b) -> Bool) -> [Maybe (l b)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Maybe (l b) -> Bool
forall a. Maybe a -> Bool
isJust [Maybe (l b)]
nml
                              then Maybe [l b] -> X (Maybe [l b])
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe [l b] -> X (Maybe [l b])) -> Maybe [l b] -> X (Maybe [l b])
forall a b. (a -> b) -> a -> b
$ [l b] -> Maybe [l b]
forall a. a -> Maybe a
Just ([l b] -> Maybe [l b]) -> [l b] -> Maybe [l b]
forall a b. (a -> b) -> a -> b
$ (l b -> Maybe (l b) -> l b) -> [l b] -> [Maybe (l b)] -> [l b]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (l b -> (l b -> l b) -> Maybe (l b) -> l b
forall b a. b -> (a -> b) -> Maybe a -> b
`maybe` l b -> l b
forall a. a -> a
id) [l b]
ol [Maybe (l b)]
nml
                              else Maybe [l b] -> X (Maybe [l b])
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe [l b]
forall a. Maybe a
Nothing
    where f :: layout a -> X (Maybe (layout a))
f layout a
l = layout a -> SomeMessage -> X (Maybe (layout a))
forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> SomeMessage -> X (Maybe (layout a))
handleMessage layout a
l SomeMessage
a X (Maybe (layout a))
-> X (Maybe (layout a)) -> X (Maybe (layout a))
forall a. X a -> X a -> X a
`catchX` Maybe (layout a) -> X (Maybe (layout a))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (layout a)
forall a. Maybe a
Nothing