{-# LANGUAGE DeriveFoldable #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE PatternGuards #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  XMonad.Layout.Mosaic
-- Description :  Give each window a specified amount of screen space relative to the others.
-- Copyright   :  (c) 2009 Adam Vogt, 2007 James Webb
-- License     :  BSD-style (see xmonad/LICENSE)
--
-- Maintainer  :  vogt.adam<at>gmail.com
-- Stability   :  unstable
-- Portability :  unportable
--
-- Based on MosaicAlt, but aspect ratio messages always change the aspect
-- ratios, and rearranging the window stack changes the window sizes.
--
-----------------------------------------------------------------------------

module XMonad.Layout.Mosaic (
    -- * Usage
    -- $usage
     Aspect(..)
    ,mosaic
    ,changeMaster
    ,changeFocused

    ,Mosaic
    )
    where

import Prelude hiding (sum)

import XMonad(LayoutClass(doLayout, handleMessage, pureMessage, description),
              Message, X, fromMessage, withWindowSet, Resize(..),
              splitHorizontallyBy, splitVerticallyBy, sendMessage, Rectangle)
import XMonad.Prelude (mplus, on, sortBy, sum)
import qualified XMonad.StackSet as W
import Control.Arrow(second, first)

-- $usage
-- You can use this module with the following in your @xmonad.hs@:
--
-- > import XMonad.Layout.Mosaic
--
-- Then edit your @layoutHook@ by adding the Mosaic layout:
--
-- > myLayout = mosaic 2 [3,2] ||| Full ||| etc..
-- > main = xmonad $ def { layoutHook = myLayout }
--
-- Unfortunately, infinite lists break serialization, so don't use them. And if
-- the list is too short, it is extended with @++ repeat 1@, which covers the
-- main use case.
--
-- To change the choice in aspect ratio and the relative sizes of windows, add
-- to your keybindings:
--
--  > , ((modm, xK_a), sendMessage Taller)
--  > , ((modm, xK_z), sendMessage Wider)
--
--  > , ((modm, xK_r), sendMessage Reset)
--
-- For more detailed instructions on editing the layoutHook see
-- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial> and
-- "XMonad.Doc.Extending#Editing_the_layout_hook".

data Aspect
    = Taller
    | Wider
    | Reset
    | SlopeMod ([Rational] -> [Rational])

instance Message Aspect

-- | The relative magnitudes (the sign is ignored) of the rational numbers in
-- the second argument determine the relative areas that the windows receive.
-- The first number represents the size of the master window, the second is for
-- the next window in the stack, and so on.
--
-- The list is extended with @++ repeat 1@, so @mosaic 1.5 []@ is like a
-- resizable grid.
--
-- The first parameter is the multiplicative factor to use when responding to
-- the 'Expand' message.
mosaic :: Rational -> [Rational] -> Mosaic a
mosaic :: forall a. Rational -> [Rational] -> Mosaic a
mosaic = forall a.
Maybe (Bool, Rational, Int) -> Rational -> [Rational] -> Mosaic a
Mosaic forall a. Maybe a
Nothing

data Mosaic a = -- | True to override the aspect, current index, maximum index
                Mosaic (Maybe(Bool,Rational,Int)) Rational [Rational] deriving (ReadPrec [Mosaic a]
ReadPrec (Mosaic a)
ReadS [Mosaic a]
forall a. ReadPrec [Mosaic a]
forall a. ReadPrec (Mosaic a)
forall a. Int -> ReadS (Mosaic a)
forall a. ReadS [Mosaic a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Mosaic a]
$creadListPrec :: forall a. ReadPrec [Mosaic a]
readPrec :: ReadPrec (Mosaic a)
$creadPrec :: forall a. ReadPrec (Mosaic a)
readList :: ReadS [Mosaic a]
$creadList :: forall a. ReadS [Mosaic a]
readsPrec :: Int -> ReadS (Mosaic a)
$creadsPrec :: forall a. Int -> ReadS (Mosaic a)
Read,Int -> Mosaic a -> ShowS
forall a. Int -> Mosaic a -> ShowS
forall a. [Mosaic a] -> ShowS
forall a. Mosaic a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Mosaic a] -> ShowS
$cshowList :: forall a. [Mosaic a] -> ShowS
show :: Mosaic a -> String
$cshow :: forall a. Mosaic a -> String
showsPrec :: Int -> Mosaic a -> ShowS
$cshowsPrec :: forall a. Int -> Mosaic a -> ShowS
Show)

instance LayoutClass Mosaic a where
    description :: Mosaic a -> String
description = forall a b. a -> b -> a
const String
"Mosaic"

    pureMessage :: Mosaic a -> SomeMessage -> Maybe (Mosaic a)
pureMessage (Mosaic Maybe (Bool, Rational, Int)
Nothing Rational
_ [Rational]
_) SomeMessage
_ = forall a. Maybe a
Nothing
    pureMessage (Mosaic (Just(Bool
_,Rational
ix,Int
mix)) Rational
delta [Rational]
ss) SomeMessage
ms = forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
ms forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall {a}. Aspect -> Maybe (Mosaic a)
ixMod
        where ixMod :: Aspect -> Maybe (Mosaic a)
ixMod Aspect
Taller | forall a b. (RealFrac a, Integral b) => a -> b
round Rational
ix forall a. Ord a => a -> a -> Bool
>= Int
mix = forall a. Maybe a
Nothing
                           | Bool
otherwise = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a.
Maybe (Bool, Rational, Int) -> Rational -> [Rational] -> Mosaic a
Mosaic (forall a. a -> Maybe a
Just(Bool
False,forall a. Enum a => a -> a
succ Rational
ix,Int
mix)) Rational
delta [Rational]
ss
              ixMod Aspect
Wider  | forall a b. (RealFrac a, Integral b) => a -> b
round Rational
ix forall a. Ord a => a -> a -> Bool
<= (Integer
0::Integer) = forall a. Maybe a
Nothing
                           | Bool
otherwise = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a.
Maybe (Bool, Rational, Int) -> Rational -> [Rational] -> Mosaic a
Mosaic (forall a. a -> Maybe a
Just(Bool
False,forall a. Enum a => a -> a
pred Rational
ix,Int
mix)) Rational
delta [Rational]
ss
              ixMod Aspect
Reset              = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a.
Maybe (Bool, Rational, Int) -> Rational -> [Rational] -> Mosaic a
Mosaic forall a. Maybe a
Nothing Rational
delta [Rational]
ss
              ixMod (SlopeMod [Rational] -> [Rational]
f)       = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a.
Maybe (Bool, Rational, Int) -> Rational -> [Rational] -> Mosaic a
Mosaic (forall a. a -> Maybe a
Just(Bool
False,Rational
ix,Int
mix)) Rational
delta ([Rational] -> [Rational]
f [Rational]
ss)

    handleMessage :: Mosaic a -> SomeMessage -> X (Maybe (Mosaic a))
handleMessage l :: Mosaic a
l@(Mosaic Maybe (Bool, Rational, Int)
_ Rational
delta [Rational]
_) SomeMessage
ms
        | Just Resize
Expand <- forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
ms = (Rational -> Rational) -> X ()
changeFocused (forall a. Num a => a -> a -> a
*Rational
delta) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
        | Just Resize
Shrink <- forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
ms = (Rational -> Rational) -> X ()
changeFocused (forall a. Fractional a => a -> a -> a
/Rational
delta) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
        | Bool
otherwise = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> SomeMessage -> Maybe (layout a)
pureMessage Mosaic a
l SomeMessage
ms

    doLayout :: Mosaic a
-> Rectangle -> Stack a -> X ([(a, Rectangle)], Maybe (Mosaic a))
doLayout (Mosaic Maybe (Bool, Rational, Int)
state Rational
delta [Rational]
ss) Rectangle
r Stack a
st = let
        ssExt :: [Rational]
ssExt = forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith forall a b. a -> b -> a
const ([Rational]
ss forall a. [a] -> [a] -> [a]
++ forall a. a -> [a]
repeat Rational
1) forall a b. (a -> b) -> a -> b
$ forall a. Stack a -> [a]
W.integrate Stack a
st
        rects :: [[Rectangle]]
rects = Rectangle -> [Rational] -> [[Rectangle]]
splits Rectangle
r [Rational]
ssExt
        nls :: Int
nls = forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Rectangle]]
rects
        fi :: Int -> Rational
fi = forall a b. (Integral a, Num b) => a -> b
fromIntegral
        nextIx :: (Bool, Rational, Int) -> Rational
nextIx (Bool
ov,Rational
ix,Int
mix)
                | Int
mix forall a. Ord a => a -> a -> Bool
<= Int
0 Bool -> Bool -> Bool
|| Bool
ov = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ Int
nls forall a. Integral a => a -> a -> a
`div` Int
2
                | Bool
otherwise = forall a. Ord a => a -> a -> a
max Rational
0 forall a b. (a -> b) -> a -> b
$ (forall a. Num a => a -> a -> a
*Int -> Rational
fi (forall a. Enum a => a -> a
pred Int
nls)) forall a b. (a -> b) -> a -> b
$ forall a. Ord a => a -> a -> a
min Rational
1 forall a b. (a -> b) -> a -> b
$ Rational
ix forall a. Fractional a => a -> a -> a
/ Int -> Rational
fi Int
mix
        rect :: [Rectangle]
rect = [[Rectangle]]
rects forall a. [a] -> Int -> a
!! forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Int
nls forall a. Integral a => a -> a -> a
`div` Int
2) (forall a b. (RealFrac a, Integral b) => a -> b
round forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool, Rational, Int) -> Rational
nextIx) Maybe (Bool, Rational, Int)
state
        state' :: Maybe (Bool, Rational, Int)
state' = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\x :: (Bool, Rational, Int)
x@(Bool
ov,Rational
_,Int
_) -> (Bool
ov,(Bool, Rational, Int) -> Rational
nextIx (Bool, Rational, Int)
x,forall a. Enum a => a -> a
pred Int
nls)) Maybe (Bool, Rational, Int)
state
                    forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` forall a. a -> Maybe a
Just (Bool
True,forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
nls forall a. Fractional a => a -> a -> a
/ Rational
2,forall a. Enum a => a -> a
pred Int
nls)
        ss' :: [Rational]
ss' = forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Rational]
ss (forall a b. a -> b -> a
const [Rational]
ss forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
`either` forall a b. a -> b -> a
const [Rational]
ssExt) forall a b. (a -> b) -> a -> b
$ forall a b. [a] -> [b] -> Maybe (Either [a] [b])
zipRemain [Rational]
ss [Rational]
ssExt
        in forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. [a] -> [b] -> [(a, b)]
zip (forall a. Stack a -> [a]
W.integrate Stack a
st) [Rectangle]
rect, forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a.
Maybe (Bool, Rational, Int) -> Rational -> [Rational] -> Mosaic a
Mosaic Maybe (Bool, Rational, Int)
state' Rational
delta [Rational]
ss')

zipRemain :: [a] -> [b] -> Maybe (Either [a] [b])
zipRemain :: forall a b. [a] -> [b] -> Maybe (Either [a] [b])
zipRemain (a
_:[a]
xs) (b
_:[b]
ys) = forall a b. [a] -> [b] -> Maybe (Either [a] [b])
zipRemain [a]
xs [b]
ys
zipRemain [] [] = forall a. Maybe a
Nothing
zipRemain [] [b]
y = forall a. a -> Maybe a
Just (forall a b. b -> Either a b
Right [b]
y)
zipRemain [a]
x [] = forall a. a -> Maybe a
Just (forall a b. a -> Either a b
Left [a]
x)

-- | These sample functions are meant to be applied to the list of window sizes
-- through the 'SlopeMod' message.
changeMaster :: (Rational -> Rational) -> X ()
changeMaster :: (Rational -> Rational) -> X ()
changeMaster = forall a. Message a => a -> X ()
sendMessage forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Rational] -> [Rational]) -> Aspect
SlopeMod forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> a) -> [a] -> [a]
onHead

-- | Apply a function to the Rational that represents the currently focused
-- window.
--
-- 'Expand' and 'Shrink' messages are responded to with @changeFocused
-- (*delta)@ or @changeFocused (delta/)@ where @delta@ is the first argument to
-- 'mosaic'.
--
-- This is exported because other functions (ex. @const 1@, @(+1)@) may be
-- useful to apply to the current area.
changeFocused :: (Rational -> Rational) -> X ()
changeFocused :: (Rational -> Rational) -> X ()
changeFocused Rational -> Rational
f = forall a. (WindowSet -> X a) -> X a
withWindowSet forall a b. (a -> b) -> a -> b
$ forall a. Message a => a -> X ()
sendMessage forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Rational] -> [Rational]) -> Aspect
SlopeMod
                    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. a -> a
id (Int -> [Rational] -> [Rational]
mulIx forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Int
length forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Stack a -> [a]
W.up)
                    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a. Workspace i l a -> Maybe (Stack a)
W.stack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
W.workspace forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
W.current
    where mulIx :: Int -> [Rational] -> [Rational]
mulIx Int
i = forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a. [a] -> [a] -> [a]
(++) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second (forall a. (a -> a) -> [a] -> [a]
onHead Rational -> Rational
f) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> ([a], [a])
splitAt Int
i

onHead :: (a -> a) -> [a] -> [a]
onHead :: forall a. (a -> a) -> [a] -> [a]
onHead a -> a
f = forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a. [a] -> [a] -> [a]
(++) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
f) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> ([a], [a])
splitAt Int
1

splits :: Rectangle -> [Rational] -> [[Rectangle]]
splits :: Rectangle -> [Rational] -> [[Rectangle]]
splits Rectangle
rect = forall a b. (a -> b) -> [a] -> [b]
map (forall a. [a] -> [a]
reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (forall a. Ord a => a -> a -> Ordering
compare forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` forall a b. (a, b) -> a
fst))
                forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rectangle -> Tree (Int, Rational) -> [[(Int, Rectangle)]]
splitsL Rectangle
rect forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a1 a. (Num a1, Ord a1) => (a -> a1) -> [a] -> Tree a
makeTree forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. [a] -> [b] -> [(a, b)]
zip [Int
1..]
                forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Fractional a => [a] -> [a]
normalize forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a. Num a => a -> a
abs

splitsL :: Rectangle -> Tree (Int,Rational) -> [[(Int,Rectangle)]]
splitsL :: Rectangle -> Tree (Int, Rational) -> [[(Int, Rectangle)]]
splitsL Rectangle
_rect Tree (Int, Rational)
Empty = []
splitsL Rectangle
rect (Leaf (Int
x,Rational
_)) = [[(Int
x,Rectangle
rect)]]
splitsL Rectangle
rect (Branch Tree (Int, Rational)
l Tree (Int, Rational)
r) = do
    let mkSplit :: (Rational -> Rectangle -> t) -> t
mkSplit Rational -> Rectangle -> t
f = Rational -> Rectangle -> t
f ((forall {a}. Tree (a, Rational) -> Rational
sumSnd Tree (Int, Rational)
l forall a. Fractional a => a -> a -> a
/) forall a b. (a -> b) -> a -> b
$ forall {a}. Tree (a, Rational) -> Rational
sumSnd Tree (Int, Rational)
l forall a. Num a => a -> a -> a
+ forall {a}. Tree (a, Rational) -> Rational
sumSnd Tree (Int, Rational)
r) Rectangle
rect
        sumSnd :: Tree (a, Rational) -> Rational
sumSnd = forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> b
snd
    (Rectangle
rl,Rectangle
rr) <- forall a b. (a -> b) -> [a] -> [b]
map forall {t}. (Rational -> Rectangle -> t) -> t
mkSplit [forall r. RealFrac r => r -> Rectangle -> (Rectangle, Rectangle)
splitVerticallyBy,forall r. RealFrac r => r -> Rectangle -> (Rectangle, Rectangle)
splitHorizontallyBy]
    Rectangle -> Tree (Int, Rational) -> [[(Int, Rectangle)]]
splitsL Rectangle
rl Tree (Int, Rational)
l forall a. [[a]] -> [[a]] -> [[a]]
`interleave` Rectangle -> Tree (Int, Rational) -> [[(Int, Rectangle)]]
splitsL Rectangle
rr Tree (Int, Rational)
r

-- like zipWith (++), but when one list is shorter, its elements are duplicated
-- so that they match
interleave :: [[a]] -> [[a]] -> [[a]]
interleave :: forall a. [[a]] -> [[a]] -> [[a]]
interleave [[a]]
xs [[a]]
ys | Int
lx forall a. Ord a => a -> a -> Bool
> Int
ly = forall a. [[a]] -> [[a]] -> [[a]]
zc [[a]]
xs (forall a. Int -> [a] -> [a]
extend Int
lx [[a]]
ys)
                 | Bool
otherwise = forall a. [[a]] -> [[a]] -> [[a]]
zc (forall a. Int -> [a] -> [a]
extend Int
ly [[a]]
xs) [[a]]
ys
  where lx :: Int
lx = forall (t :: * -> *) a. Foldable t => t a -> Int
length [[a]]
xs
        ly :: Int
ly = forall (t :: * -> *) a. Foldable t => t a -> Int
length [[a]]
ys
        zc :: [[a]] -> [[a]] -> [[a]]
zc = forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith forall a. [a] -> [a] -> [a]
(++)

        extend :: Int -> [a] -> [a]
        extend :: forall a. Int -> [a] -> [a]
extend Int
n [a]
pat = do
            (a
p,Bool
e) <- forall a b. [a] -> [b] -> [(a, b)]
zip [a]
pat forall a b. (a -> b) -> a -> b
$ forall a. Int -> a -> [a]
replicate Int
m Bool
True forall a. [a] -> [a] -> [a]
++ forall a. a -> [a]
repeat Bool
False
            [a
p | Bool
e] forall a. [a] -> [a] -> [a]
++ forall a. Int -> a -> [a]
replicate Int
d a
p
            where (Int
d,Int
m) = Int
n forall a. Integral a => a -> a -> (a, a)
`divMod` forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
pat

normalize :: Fractional a => [a] -> [a]
normalize :: forall a. Fractional a => [a] -> [a]
normalize [a]
x = let s :: a
s = forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [a]
x in forall a b. (a -> b) -> [a] -> [b]
map (forall a. Fractional a => a -> a -> a
/a
s) [a]
x

data Tree a = Branch (Tree a) (Tree a) | Leaf a | Empty
  deriving (forall a b. a -> Tree b -> Tree a
forall a b. (a -> b) -> Tree a -> Tree b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> Tree b -> Tree a
$c<$ :: forall a b. a -> Tree b -> Tree a
fmap :: forall a b. (a -> b) -> Tree a -> Tree b
$cfmap :: forall a b. (a -> b) -> Tree a -> Tree b
Functor, Int -> Tree a -> ShowS
forall a. Show a => Int -> Tree a -> ShowS
forall a. Show a => [Tree a] -> ShowS
forall a. Show a => Tree a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Tree a] -> ShowS
$cshowList :: forall a. Show a => [Tree a] -> ShowS
show :: Tree a -> String
$cshow :: forall a. Show a => Tree a -> String
showsPrec :: Int -> Tree a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Tree a -> ShowS
Show, forall a. Eq a => a -> Tree a -> Bool
forall a. Num a => Tree a -> a
forall a. Ord a => Tree a -> a
forall m. Monoid m => Tree m -> m
forall a. Tree a -> Bool
forall a. Tree a -> Int
forall a. Tree a -> [a]
forall a. (a -> a -> a) -> Tree a -> a
forall m a. Monoid m => (a -> m) -> Tree a -> m
forall b a. (b -> a -> b) -> b -> Tree a -> b
forall a b. (a -> b -> b) -> b -> Tree a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: forall a. Num a => Tree a -> a
$cproduct :: forall a. Num a => Tree a -> a
sum :: forall a. Num a => Tree a -> a
$csum :: forall a. Num a => Tree a -> a
minimum :: forall a. Ord a => Tree a -> a
$cminimum :: forall a. Ord a => Tree a -> a
maximum :: forall a. Ord a => Tree a -> a
$cmaximum :: forall a. Ord a => Tree a -> a
elem :: forall a. Eq a => a -> Tree a -> Bool
$celem :: forall a. Eq a => a -> Tree a -> Bool
length :: forall a. Tree a -> Int
$clength :: forall a. Tree a -> Int
null :: forall a. Tree a -> Bool
$cnull :: forall a. Tree a -> Bool
toList :: forall a. Tree a -> [a]
$ctoList :: forall a. Tree a -> [a]
foldl1 :: forall a. (a -> a -> a) -> Tree a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> Tree a -> a
foldr1 :: forall a. (a -> a -> a) -> Tree a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> Tree a -> a
foldl' :: forall b a. (b -> a -> b) -> b -> Tree a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> Tree a -> b
foldl :: forall b a. (b -> a -> b) -> b -> Tree a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> Tree a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> Tree a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> Tree a -> b
foldr :: forall a b. (a -> b -> b) -> b -> Tree a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> Tree a -> b
foldMap' :: forall m a. Monoid m => (a -> m) -> Tree a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> Tree a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> Tree a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> Tree a -> m
fold :: forall m. Monoid m => Tree m -> m
$cfold :: forall m. Monoid m => Tree m -> m
Foldable)

instance Semigroup (Tree a) where
    Tree a
Empty <> :: Tree a -> Tree a -> Tree a
<> Tree a
x = Tree a
x
    Tree a
x <> Tree a
Empty = Tree a
x
    Tree a
x <> Tree a
y = forall a. Tree a -> Tree a -> Tree a
Branch Tree a
x Tree a
y

instance Monoid (Tree a) where
    mempty :: Tree a
mempty = forall a. Tree a
Empty

makeTree ::  (Num a1, Ord a1) => (a -> a1) -> [a] -> Tree a
makeTree :: forall a1 a. (Num a1, Ord a1) => (a -> a1) -> [a] -> Tree a
makeTree a -> a1
_ [] = forall a. Tree a
Empty
makeTree a -> a1
_ [a
x] = forall a. a -> Tree a
Leaf a
x
makeTree a -> a1
f [a]
xs = forall a. Tree a -> Tree a -> Tree a
Branch (forall a1 a. (Num a1, Ord a1) => (a -> a1) -> [a] -> Tree a
makeTree a -> a1
f [a]
a) (forall a1 a. (Num a1, Ord a1) => (a -> a1) -> [a] -> Tree a
makeTree a -> a1
f [a]
b)
    where (([a]
a,[a]
b),(a1, a1)
_) = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr a -> (([a], [a]), (a1, a1)) -> (([a], [a]), (a1, a1))
go (([],[]),(a1
0,a1
0)) [a]
xs
          go :: a -> (([a], [a]), (a1, a1)) -> (([a], [a]), (a1, a1))
go a
n (([a]
ls,[a]
rs),(a1
l,a1
r))
            | a1
l forall a. Ord a => a -> a -> Bool
> a1
r     = (([a]
ls,a
nforall a. a -> [a] -> [a]
:[a]
rs),(a1
l,a -> a1
f a
nforall a. Num a => a -> a -> a
+a1
r))
            | Bool
otherwise = ((a
nforall a. a -> [a] -> [a]
:[a]
ls,[a]
rs),(a -> a1
f a
nforall a. Num a => a -> a -> a
+a1
l,a1
r))