{-# LANGUAGE DeriveFoldable #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE PatternGuards #-}
module XMonad.Layout.Mosaic (
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)
data Aspect
= Taller
| Wider
| Reset
| SlopeMod ([Rational] -> [Rational])
instance Message Aspect
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 =
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)
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
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
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))