{-# OPTIONS_GHC -fno-warn-name-shadowing -fno-warn-unused-binds #-}
{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses
  , PatternGuards, ExistentialQuantification
  , FlexibleContexts #-}

-----------------------------------------------------------------------------
-- |
-- Module      :  XMonad.Layout.ZoomRow
-- Description :  Row layout with individually resizable elements.
-- Copyright   :  Quentin Moser <moserq@gmail.com>
-- License     :  BSD-style (see LICENSE)
--
-- Maintainer  :  orphaned
-- Stability   :  unstable
-- Portability :  unportable
--
-- Row layout with individually resizable elements.
--
-----------------------------------------------------------------------------

module XMonad.Layout.ZoomRow ( -- * Usage
                               -- $usage
                               ZoomRow
                               -- * Creation
                             , zoomRow
                               -- * Messages
                             , ZoomMessage(..)
                             , zoomIn
                             , zoomOut
                             , zoomReset
                               -- * Use with non-'Eq' elements
                               -- $noneq
                             , zoomRowWith
                             , EQF(..)
                             , ClassEQ(..)
                             ) where

import XMonad
import XMonad.Prelude (fromMaybe, fi)
import qualified XMonad.StackSet as W

import XMonad.Util.Stack

import Control.Arrow (second)

-- $usage
-- This module provides a layout which places all windows in a single
-- row; the size occupied by each individual window can be increased
-- and decreased, and a window can be set to use the whole available
-- space whenever it has focus.
--
-- You can use this module by including  the following in your @xmonad.hs@:
--
-- > import XMonad.Layout.ZoomRow
--
-- and using 'zoomRow' somewhere in your 'layoutHook', for example:
--
-- > myLayout = zoomRow ||| Mirror zoomRow
--
-- To be able to resize windows, you can create keybindings to send
-- the relevant 'ZoomMessage's:
--
-- >   -- Increase the size occupied by the focused window
-- > , ((modMask .|. shifMask, xK_minus), sendMessage zoomIn)
-- >   -- Decrease the size occupied by the focused window
-- > , ((modMayk             , xK_minus), sendMessage zoomOut)
-- >   -- Reset the size occupied by the focused window
-- > , ((modMask             , xK_equal), sendMessage zoomReset)
-- >   -- (Un)Maximize the focused window
-- > , ((modMask             , xK_f    ), sendMessage ToggleZoomFull)
--
-- For more information on editing your layoutHook and key bindings,
-- see <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial>
-- and "XMonad.Doc.Extending".

-- * Creation functions

-- | 'ZoomRow' layout for laying out elements which are instances of
-- 'Eq'. Perfect for 'Window's.
zoomRow :: (Eq a, Show a, Read a) => ZoomRow ClassEQ a
zoomRow :: forall a. (Eq a, Show a, Read a) => ZoomRow ClassEQ a
zoomRow = forall (f :: * -> *) a. f a -> Zipper (Elt a) -> ZoomRow f a
ZC forall a. ClassEQ a
ClassEQ forall a. Zipper a
emptyZ

-- $noneq
-- Haskell's 'Eq' class is usually concerned with structural equality, whereas
-- what this layout really wants is for its elements to have a unique identity,
-- even across changes. There are cases (such as, importantly, 'Window's) where
-- the 'Eq' instance for a type actually does that, but if you want to lay
-- out something more exotic than windows and your 'Eq' means something else,
-- you can use the following.

-- | ZoomRow layout with a custom equality predicate. It should
-- of course satisfy the laws for 'Eq', and you should also make
-- sure that the layout never has to handle two \"equal\" elements
-- at the same time (it won't do any huge damage, but might behave
-- a bit strangely).
zoomRowWith :: (EQF f a, Show (f a), Read (f a), Show a, Read a)
               => f a -> ZoomRow f a
zoomRowWith :: forall (f :: * -> *) a.
(EQF f a, Show (f a), Read (f a), Show a, Read a) =>
f a -> ZoomRow f a
zoomRowWith f a
f = forall (f :: * -> *) a. f a -> Zipper (Elt a) -> ZoomRow f a
ZC f a
f forall a. Zipper a
emptyZ


-- * The datatypes

-- | A layout that arranges its windows in a horizontal row,
-- and allows to change the relative size of each element
-- independently.
data ZoomRow f a = ZC { forall (f :: * -> *) a. ZoomRow f a -> f a
zoomEq ::  f a
                          -- ^ Function to compare elements for
                          -- equality, a real Eq instance might
                          -- not be what you want in some cases
                      , forall (f :: * -> *) a. ZoomRow f a -> Zipper (Elt a)
zoomRatios :: Zipper (Elt a)
                          -- ^ Element specs. The zipper is so we
                          -- know what the focus is when we handle
                          --  a message
                      }
  deriving (Int -> ZoomRow f a -> ShowS
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (f :: * -> *) a.
(Show a, Show (f a)) =>
Int -> ZoomRow f a -> ShowS
forall (f :: * -> *) a.
(Show a, Show (f a)) =>
[ZoomRow f a] -> ShowS
forall (f :: * -> *) a.
(Show a, Show (f a)) =>
ZoomRow f a -> String
showList :: [ZoomRow f a] -> ShowS
$cshowList :: forall (f :: * -> *) a.
(Show a, Show (f a)) =>
[ZoomRow f a] -> ShowS
show :: ZoomRow f a -> String
$cshow :: forall (f :: * -> *) a.
(Show a, Show (f a)) =>
ZoomRow f a -> String
showsPrec :: Int -> ZoomRow f a -> ShowS
$cshowsPrec :: forall (f :: * -> *) a.
(Show a, Show (f a)) =>
Int -> ZoomRow f a -> ShowS
Show, ReadPrec [ZoomRow f a]
ReadPrec (ZoomRow f a)
ReadS [ZoomRow f a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
forall (f :: * -> *) a.
(Read a, Read (f a)) =>
ReadPrec [ZoomRow f a]
forall (f :: * -> *) a.
(Read a, Read (f a)) =>
ReadPrec (ZoomRow f a)
forall (f :: * -> *) a.
(Read a, Read (f a)) =>
Int -> ReadS (ZoomRow f a)
forall (f :: * -> *) a. (Read a, Read (f a)) => ReadS [ZoomRow f a]
readListPrec :: ReadPrec [ZoomRow f a]
$creadListPrec :: forall (f :: * -> *) a.
(Read a, Read (f a)) =>
ReadPrec [ZoomRow f a]
readPrec :: ReadPrec (ZoomRow f a)
$creadPrec :: forall (f :: * -> *) a.
(Read a, Read (f a)) =>
ReadPrec (ZoomRow f a)
readList :: ReadS [ZoomRow f a]
$creadList :: forall (f :: * -> *) a. (Read a, Read (f a)) => ReadS [ZoomRow f a]
readsPrec :: Int -> ReadS (ZoomRow f a)
$creadsPrec :: forall (f :: * -> *) a.
(Read a, Read (f a)) =>
Int -> ReadS (ZoomRow f a)
Read, ZoomRow f a -> ZoomRow f a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (f :: * -> *) a.
(Eq a, Eq (f a)) =>
ZoomRow f a -> ZoomRow f a -> Bool
/= :: ZoomRow f a -> ZoomRow f a -> Bool
$c/= :: forall (f :: * -> *) a.
(Eq a, Eq (f a)) =>
ZoomRow f a -> ZoomRow f a -> Bool
== :: ZoomRow f a -> ZoomRow f a -> Bool
$c== :: forall (f :: * -> *) a.
(Eq a, Eq (f a)) =>
ZoomRow f a -> ZoomRow f a -> Bool
Eq)

-- | Class for equivalence relations. Must be transitive, reflexive.
class EQF f a where
    eq :: f a -> a -> a -> Bool

-- | To use the usual '==':
data ClassEQ a = ClassEQ
  deriving (Int -> ClassEQ a -> ShowS
forall a. Int -> ClassEQ a -> ShowS
forall a. [ClassEQ a] -> ShowS
forall a. ClassEQ a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ClassEQ a] -> ShowS
$cshowList :: forall a. [ClassEQ a] -> ShowS
show :: ClassEQ a -> String
$cshow :: forall a. ClassEQ a -> String
showsPrec :: Int -> ClassEQ a -> ShowS
$cshowsPrec :: forall a. Int -> ClassEQ a -> ShowS
Show, ReadPrec [ClassEQ a]
ReadPrec (ClassEQ a)
ReadS [ClassEQ a]
forall a. ReadPrec [ClassEQ a]
forall a. ReadPrec (ClassEQ a)
forall a. Int -> ReadS (ClassEQ a)
forall a. ReadS [ClassEQ a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ClassEQ a]
$creadListPrec :: forall a. ReadPrec [ClassEQ a]
readPrec :: ReadPrec (ClassEQ a)
$creadPrec :: forall a. ReadPrec (ClassEQ a)
readList :: ReadS [ClassEQ a]
$creadList :: forall a. ReadS [ClassEQ a]
readsPrec :: Int -> ReadS (ClassEQ a)
$creadsPrec :: forall a. Int -> ReadS (ClassEQ a)
Read, ClassEQ a -> ClassEQ a -> Bool
forall a. ClassEQ a -> ClassEQ a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ClassEQ a -> ClassEQ a -> Bool
$c/= :: forall a. ClassEQ a -> ClassEQ a -> Bool
== :: ClassEQ a -> ClassEQ a -> Bool
$c== :: forall a. ClassEQ a -> ClassEQ a -> Bool
Eq)

instance Eq a => EQF ClassEQ a where
    eq :: ClassEQ a -> a -> a -> Bool
eq ClassEQ a
_ a
a a
b = a
a forall a. Eq a => a -> a -> Bool
== a
b

-- | Size specification for an element.
data Elt a = E { forall a. Elt a -> a
elt :: a -- ^ The element
               , forall a. Elt a -> Rational
ratio :: Rational -- ^ Its size ratio
               , forall a. Elt a -> Bool
full :: Bool -- ^ Whether it should occupy all the
                              -- available space when it has focus.
               }
  deriving (Int -> Elt a -> ShowS
forall a. Show a => Int -> Elt a -> ShowS
forall a. Show a => [Elt a] -> ShowS
forall a. Show a => Elt a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Elt a] -> ShowS
$cshowList :: forall a. Show a => [Elt a] -> ShowS
show :: Elt a -> String
$cshow :: forall a. Show a => Elt a -> String
showsPrec :: Int -> Elt a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Elt a -> ShowS
Show, ReadPrec [Elt a]
ReadPrec (Elt a)
ReadS [Elt a]
forall a. Read a => ReadPrec [Elt a]
forall a. Read a => ReadPrec (Elt a)
forall a. Read a => Int -> ReadS (Elt a)
forall a. Read a => ReadS [Elt a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Elt a]
$creadListPrec :: forall a. Read a => ReadPrec [Elt a]
readPrec :: ReadPrec (Elt a)
$creadPrec :: forall a. Read a => ReadPrec (Elt a)
readList :: ReadS [Elt a]
$creadList :: forall a. Read a => ReadS [Elt a]
readsPrec :: Int -> ReadS (Elt a)
$creadsPrec :: forall a. Read a => Int -> ReadS (Elt a)
Read, Elt a -> Elt a -> Bool
forall a. Eq a => Elt a -> Elt a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Elt a -> Elt a -> Bool
$c/= :: forall a. Eq a => Elt a -> Elt a -> Bool
== :: Elt a -> Elt a -> Bool
$c== :: forall a. Eq a => Elt a -> Elt a -> Bool
Eq)


-- * Helpers

getRatio :: Elt a -> (a, Rational)
getRatio :: forall a. Elt a -> (a, Rational)
getRatio (E a
a Rational
r Bool
_) = (a
a,Rational
r)

lookupBy :: (a -> a -> Bool) -> a -> [Elt a] -> Maybe (Elt a)
lookupBy :: forall a. (a -> a -> Bool) -> a -> [Elt a] -> Maybe (Elt a)
lookupBy a -> a -> Bool
_ a
_ [] = forall a. Maybe a
Nothing
lookupBy a -> a -> Bool
f a
a (E a
a' Rational
r Bool
b : [Elt a]
_) | a -> a -> Bool
f a
a a
a' = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. a -> Rational -> Bool -> Elt a
E a
a Rational
r Bool
b
lookupBy a -> a -> Bool
f a
a (Elt a
_:[Elt a]
es) = forall a. (a -> a -> Bool) -> a -> [Elt a] -> Maybe (Elt a)
lookupBy a -> a -> Bool
f a
a [Elt a]
es

setFocus :: Zipper a -> a -> Zipper a
setFocus :: forall a. Zipper a -> a -> Zipper a
setFocus Maybe (Stack a)
Nothing a
a = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. a -> [a] -> [a] -> Stack a
W.Stack a
a [] []
setFocus (Just Stack a
s) a
a = forall a. a -> Maybe a
Just Stack a
s { focus :: a
W.focus = a
a }


-- * Messages

-- | The type of messages accepted by a 'ZoomRow' layout
data ZoomMessage = Zoom Rational
                 -- ^ Multiply the focused window's size factor
                 -- by the given number.
                 | ZoomTo Rational
                 -- ^ Set the focused window's size factor to the
                 -- given number.
                 | ZoomFull Bool
                 -- ^ Set whether the focused window should occupy
                 -- all available space when it has focus
                 | ZoomFullToggle
                 -- ^ Toggle whether the focused window should
                 -- occupy all available space when it has focus
  deriving (Int -> ZoomMessage -> ShowS
[ZoomMessage] -> ShowS
ZoomMessage -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ZoomMessage] -> ShowS
$cshowList :: [ZoomMessage] -> ShowS
show :: ZoomMessage -> String
$cshow :: ZoomMessage -> String
showsPrec :: Int -> ZoomMessage -> ShowS
$cshowsPrec :: Int -> ZoomMessage -> ShowS
Show)

instance Message ZoomMessage

-- | Increase the size of the focused window.
-- Defined as @Zoom 1.5@
zoomIn :: ZoomMessage
zoomIn :: ZoomMessage
zoomIn = Rational -> ZoomMessage
Zoom Rational
1.5

-- | Decrease the size of the focused window.
-- Defined as @Zoom (2/3)@
zoomOut :: ZoomMessage
zoomOut :: ZoomMessage
zoomOut = Rational -> ZoomMessage
Zoom forall a b. (a -> b) -> a -> b
$ Rational
2forall a. Fractional a => a -> a -> a
/Rational
3

-- | Reset the size of the focused window.
-- Defined as @ZoomTo 1@
zoomReset :: ZoomMessage
zoomReset :: ZoomMessage
zoomReset = Rational -> ZoomMessage
ZoomTo Rational
1


-- * LayoutClass instance

instance (EQF f a, Show a, Read a, Show (f a), Read (f a), Typeable f)
    => LayoutClass (ZoomRow f) a where
    description :: ZoomRow f a -> String
description (ZC f a
_ Maybe (Stack (Elt a))
Nothing) = String
"ZoomRow"
    description (ZC f a
_ (Just Stack (Elt a)
s)) = String
"ZoomRow" forall a. [a] -> [a] -> [a]
++ if forall a. Elt a -> Bool
full forall a b. (a -> b) -> a -> b
$ forall a. Stack a -> a
W.focus Stack (Elt a)
s
                                                then String
" (Max)"
                                                else String
""

    emptyLayout :: ZoomRow f a
-> Rectangle -> X ([(a, Rectangle)], Maybe (ZoomRow f a))
emptyLayout (ZC f a
_ Maybe (Stack (Elt a))
Nothing) Rectangle
_ = forall (m :: * -> *) a. Monad m => a -> m a
return ([], forall a. Maybe a
Nothing)
    emptyLayout (ZC f a
f Maybe (Stack (Elt a))
_) Rectangle
_ = forall (m :: * -> *) a. Monad m => a -> m a
return ([], forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. f a -> Zipper (Elt a) -> ZoomRow f a
ZC f a
f forall a. Maybe a
Nothing)

    doLayout :: ZoomRow f a
-> Rectangle
-> Stack a
-> X ([(a, Rectangle)], Maybe (ZoomRow f a))
doLayout (ZC f a
f Maybe (Stack (Elt a))
zelts) r :: Rectangle
r@(Rectangle Position
_ Position
_ Dimension
w Dimension
_) Stack a
s
        = let elts :: [Elt a]
elts = forall a. Maybe (Stack a) -> [a]
W.integrate' Maybe (Stack (Elt a))
zelts
              zelts' :: Maybe (Stack (Elt a))
zelts' = forall a b. (a -> b) -> Zipper a -> Zipper b
mapZ_ (\a
a -> forall a. a -> Maybe a -> a
fromMaybe (forall a. a -> Rational -> Bool -> Elt a
E a
a Rational
1 Bool
False)
                                    forall a b. (a -> b) -> a -> b
$ forall a. (a -> a -> Bool) -> a -> [Elt a] -> Maybe (Elt a)
lookupBy (forall (f :: * -> *) a. EQF f a => f a -> a -> a -> Bool
eq f a
f) a
a [Elt a]
elts) forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just Stack a
s
              elts' :: [Elt a]
elts' = forall a. Maybe (Stack a) -> [a]
W.integrate' Maybe (Stack (Elt a))
zelts'

              maybeL' :: Maybe (ZoomRow f a)
maybeL' = if Maybe (Stack (Elt a))
zelts Maybe (Stack (Elt a)) -> Maybe (Stack (Elt a)) -> Bool
`noChange` Maybe (Stack (Elt a))
zelts'
                          then forall a. Maybe a
Nothing
                          else forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. f a -> Zipper (Elt a) -> ZoomRow f a
ZC f a
f Maybe (Stack (Elt a))
zelts'

              total :: Rational
total = forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum  forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a. Elt a -> Rational
ratio [Elt a]
elts'

              widths :: [(a, Rational)]
widths =  forall a b. (a -> b) -> [a] -> [b]
map (forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second ((forall a. Num a => a -> a -> a
* forall a b. (Integral a, Num b) => a -> b
fi Dimension
w) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Fractional a => a -> a -> a
/Rational
total)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Elt a -> (a, Rational)
getRatio) [Elt a]
elts'

          in case forall a. Zipper a -> Maybe a
getFocusZ Maybe (Stack (Elt a))
zelts' of
               Just (E a
a Rational
_ Bool
True) -> forall (m :: * -> *) a. Monad m => a -> m a
return ([(a
a, Rectangle
r)], Maybe (ZoomRow f a)
maybeL')
               Maybe (Elt a)
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. Rectangle -> [(a, Rational)] -> [(a, Rectangle)]
makeRects Rectangle
r [(a, Rational)]
widths, Maybe (ZoomRow f a)
maybeL')

        where makeRects :: Rectangle -> [(a, Rational)] -> [(a, Rectangle)]
              makeRects :: forall a. Rectangle -> [(a, Rational)] -> [(a, Rectangle)]
makeRects Rectangle
r [(a, Rational)]
pairs = let as :: [a]
as = forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst [(a, Rational)]
pairs
                                      widths :: [Rational]
widths = forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd [(a, Rational)]
pairs
                                      discreteWidths :: [Dimension]
discreteWidths = forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Rational -> (Rational, [Dimension]) -> (Rational, [Dimension])
discretize (Rational
0, []) [Rational]
widths
                                      rectangles :: [Rectangle]
rectangles = forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Dimension -> (Rectangle, [Rectangle]) -> (Rectangle, [Rectangle])
makeRect (Rectangle
r, []) [Dimension]
discreteWidths
                                  in forall a b. [a] -> [b] -> [(a, b)]
zip [a]
as [Rectangle]
rectangles

              -- | Make a new rectangle by substracting the given width from the available
              -- space (from the right, since this is a foldr)
              makeRect :: Dimension -> (Rectangle, [Rectangle]) -> (Rectangle, [Rectangle])
              makeRect :: Dimension -> (Rectangle, [Rectangle]) -> (Rectangle, [Rectangle])
makeRect Dimension
w (Rectangle Position
x Position
y Dimension
w0 Dimension
h, [Rectangle]
rs) = ( Position -> Position -> Dimension -> Dimension -> Rectangle
Rectangle Position
x Position
y (Dimension
w0forall a. Num a => a -> a -> a
-Dimension
w) Dimension
h
                                                    , Position -> Position -> Dimension -> Dimension -> Rectangle
Rectangle (Position
xforall a. Num a => a -> a -> a
+forall a b. (Integral a, Num b) => a -> b
fi Dimension
w0forall a. Num a => a -> a -> a
-forall a b. (Integral a, Num b) => a -> b
fi Dimension
w) Position
y Dimension
w Dimension
h forall a. a -> [a] -> [a]
: [Rectangle]
rs )

              -- | Round a list of fractions in a way that maintains the total.
              -- If you know a better way to do this I'm very interested.
              discretize :: Rational -> (Rational, [Dimension]) -> (Rational, [Dimension])
              discretize :: Rational -> (Rational, [Dimension]) -> (Rational, [Dimension])
discretize Rational
r (Rational
carry, [Dimension]
ds) = let (Dimension
d, Rational
carry') = forall a b. (RealFrac a, Integral b) => a -> (b, a)
properFraction forall a b. (a -> b) -> a -> b
$ Rational
carryforall a. Num a => a -> a -> a
+Rational
r
                                         in (Rational
carry', Dimension
dforall a. a -> [a] -> [a]
:[Dimension]
ds)

              noChange :: Maybe (Stack (Elt a)) -> Maybe (Stack (Elt a)) -> Bool
noChange Maybe (Stack (Elt a))
z1 Maybe (Stack (Elt a))
z2 = forall a. Zipper a -> [Either a a]
toTags Maybe (Stack (Elt a))
z1 [Either (Elt a) (Elt a)] -> [Either (Elt a) (Elt a)] -> Bool
`helper` forall a. Zipper a -> [Either a a]
toTags Maybe (Stack (Elt a))
z2
                  where helper :: [Either (Elt a) (Elt a)] -> [Either (Elt a) (Elt a)] -> Bool
helper [] [] = Bool
True
                        helper (Right Elt a
a:[Either (Elt a) (Elt a)]
as) (Right Elt a
b:[Either (Elt a) (Elt a)]
bs) = Elt a
a Elt a -> Elt a -> Bool
`sameAs` Elt a
b Bool -> Bool -> Bool
&& [Either (Elt a) (Elt a)]
as [Either (Elt a) (Elt a)] -> [Either (Elt a) (Elt a)] -> Bool
`helper` [Either (Elt a) (Elt a)]
bs
                        helper (Left Elt a
a:[Either (Elt a) (Elt a)]
as) (Left Elt a
b:[Either (Elt a) (Elt a)]
bs) = Elt a
a Elt a -> Elt a -> Bool
`sameAs` Elt a
b Bool -> Bool -> Bool
&& [Either (Elt a) (Elt a)]
as [Either (Elt a) (Elt a)] -> [Either (Elt a) (Elt a)] -> Bool
`helper` [Either (Elt a) (Elt a)]
bs
                        helper [Either (Elt a) (Elt a)]
_ [Either (Elt a) (Elt a)]
_ = Bool
False
                        E a
a1 Rational
r1 Bool
b1 sameAs :: Elt a -> Elt a -> Bool
`sameAs` E a
a2 Rational
r2 Bool
b2 = forall (f :: * -> *) a. EQF f a => f a -> a -> a -> Bool
eq f a
f a
a1 a
a2 Bool -> Bool -> Bool
&& (Rational
r1 forall a. Eq a => a -> a -> Bool
== Rational
r2) Bool -> Bool -> Bool
&& (Bool
b1 forall a. Eq a => a -> a -> Bool
== Bool
b2)

    pureMessage :: ZoomRow f a -> SomeMessage -> Maybe (ZoomRow f a)
pureMessage (ZC f a
f Maybe (Stack (Elt a))
zelts) SomeMessage
sm | Just (ZoomFull Bool
False) <- forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
sm
                                , Just (E a
a Rational
r Bool
True) <- forall a. Zipper a -> Maybe a
getFocusZ Maybe (Stack (Elt a))
zelts
        = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. f a -> Zipper (Elt a) -> ZoomRow f a
ZC f a
f forall a b. (a -> b) -> a -> b
$ forall a. Zipper a -> a -> Zipper a
setFocus Maybe (Stack (Elt a))
zelts forall a b. (a -> b) -> a -> b
$ forall a. a -> Rational -> Bool -> Elt a
E a
a Rational
r Bool
False

    pureMessage (ZC f a
f Maybe (Stack (Elt a))
zelts) SomeMessage
sm | Just (ZoomFull Bool
True) <- forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
sm
                                , Just (E a
a Rational
r Bool
False) <- forall a. Zipper a -> Maybe a
getFocusZ Maybe (Stack (Elt a))
zelts
        = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. f a -> Zipper (Elt a) -> ZoomRow f a
ZC f a
f forall a b. (a -> b) -> a -> b
$ forall a. Zipper a -> a -> Zipper a
setFocus Maybe (Stack (Elt a))
zelts forall a b. (a -> b) -> a -> b
$ forall a. a -> Rational -> Bool -> Elt a
E a
a Rational
r Bool
True

    pureMessage (ZC f a
f Maybe (Stack (Elt a))
zelts) SomeMessage
sm | Just (E a
a Rational
r Bool
b) <- forall a. Zipper a -> Maybe a
getFocusZ Maybe (Stack (Elt a))
zelts
        = case forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
sm of
            Just (Zoom Rational
r') -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. f a -> Zipper (Elt a) -> ZoomRow f a
ZC f a
f forall a b. (a -> b) -> a -> b
$ forall a. Zipper a -> a -> Zipper a
setFocus Maybe (Stack (Elt a))
zelts forall a b. (a -> b) -> a -> b
$ forall a. a -> Rational -> Bool -> Elt a
E a
a (Rational
rforall a. Num a => a -> a -> a
*Rational
r') Bool
b
            Just (ZoomTo Rational
r') -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. f a -> Zipper (Elt a) -> ZoomRow f a
ZC f a
f forall a b. (a -> b) -> a -> b
$ forall a. Zipper a -> a -> Zipper a
setFocus Maybe (Stack (Elt a))
zelts forall a b. (a -> b) -> a -> b
$ forall a. a -> Rational -> Bool -> Elt a
E a
a Rational
r' Bool
b
            Just ZoomMessage
ZoomFullToggle -> forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> SomeMessage -> Maybe (layout a)
pureMessage (forall (f :: * -> *) a. f a -> Zipper (Elt a) -> ZoomRow f a
ZC f a
f Maybe (Stack (Elt a))
zelts)
                                     forall a b. (a -> b) -> a -> b
$ forall a. Message a => a -> SomeMessage
SomeMessage forall a b. (a -> b) -> a -> b
$ Bool -> ZoomMessage
ZoomFull forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not Bool
b
            Maybe ZoomMessage
_ -> forall a. Maybe a
Nothing

    pureMessage ZoomRow f a
_ SomeMessage
_ = forall a. Maybe a
Nothing